ASMB,R,B,L,C
      HED *** DOS CROSS-REFERENCE SYMBOL GENERATOR ***
      NAM XREF,3,1
      EXT EXEC,.OPSY
* THIS PROGRAM PRODUCES A CROSS REFERENCE TABLE FOR AN PROGRAM
* WRITTEN IN HP-2116 ASSEMBLY LANGUAGE (HPAP). THE TABLE CON- 
* SISTS OF A LIST OF SYMBOLS, IN ALPHABETIC ORDER, EACH FOLLOWED
* BY ITS LOCATION IN THE PROGRAM, AND A LIST OF REFERENCES TO 
* THAT SYMBOL. EACH LOCATION IS A 5-DIGIT SEQUENCE NUMBER, FOL- 
* LOWED BY THE NUMBER OF THE TAPE ON WHICH IT APPEARS.  THESE TWO 
* ARE SEPARATED BY A SLASH.  THE TAPE NUMBER IS NOT  PRINTED WHEN 
* ONE TAPE ONLY EXISTS. 
* 
* THE METHOD USED IS TO READ IN THE HPAP SOURCE PROGRAM AND 
* BUILD A TABLE OF REFERENCES. THERE ARE TWO INTERNAL TABLES, THE 
* LABEL TABLE (LTAB) AND THE CROSS REFERENCE TABLE (XTAB). THESE
* TABLES ARE ORGANIZED AS FOLLOWS:
* 
*     LTAB: EACH ENTRY CONTAINS THE LABEL NAME AS FOLLOWS:
*              WORD COUNT     CHAR.1
*              CHAR.2         CHAR.3    (OPTIONAL)
*              CHAR.4         CHAR.5    (OPTIONAL)
*              CHAR.6         CHAR.7          (OPTIONAL)
* 
*           THE WORD COUNT MAY BE 1,2,3, OR 4 
* 
*     XTAB: EACH ENTRY CONTAINS THE FOLLOWING:
*              -NUMBER OF WORDS IN ENTRY  (-N-2)
*              LABEL SEQUENCE NUMBER
*              REF.1     "      " 
*                ...
*              REF.N     "      " 
* 
* NO LINKAGE BETWEEN THE 2 TABLES IS REQUIRED BECAUSE THE ENTRIES 
* ARE IN THE SAME ORDER AND CORRESPOND 1 FOR 1. 
* NOTE THAT LTAB BEGINS IN LOW CORE AND XTAB IN HIGH CORE, SO THAT
* BOTH ARE OPEN-ENDED.
* 
* A LABEL WHICH HAS BEEN DEFINED BUT NEVER REFERENCED IS SIGNIFIED BY 
* A "@" IN COLUMN #1 PRECEEDING THE LABEL.
* 
* A LABEL WHICH HAS BEEN REFERENCED BUT NEVER DEFINED WILL HAVE A 
* DEFINITION FIELD OF QUESTION MARKS "?????". 
* 
* ANY INSTRUCTION THAT WILL HAVE AN EFFECT UPON THE PROGRAM LISTING 
* AS ORG, ORB, ORR, IFN, IFZ, XIF, ETC. WILL BE DEFINED AS FOLLOWS; 
* " **XXX *****    NNNNN     NNNNN " WHERE XXX IS THE TYPE OF INSTR.
* AND NNNNN IS THE ADDRESS OF THE INSTRUCTION.
* 
* A LITERAL INSTRUCTION WILL BE DEFINED AS A LABEL WITH ITS DEFINITION
* FILLED WITH DOTS, OTHER SEQUENCE NUMBERS DEFINE WHERE THEY WERE USED. 
* 
* PARAMETERS:   :PROG,XREF(A,B,C,D) 
*          #1. :PROG,XREF,A(,B,C,D) 
*                  A = 0 OR NOT SPECIFIED WILL INPUT FROM THE WORK AREA 
*                  A = 2 WILL INPUT FROM A SOURCE FILE. 
*                  A = N WILL INPUT FROM LU #N. 
* 
*          #2. :PROG,XREF,A,B(,C,D) 
*                  B = 0 WILL ASK FOR NO ALPHA LIMITS.
*                  B # 0 WILL ASK "ENTER LIMITS OR /E"
*                       THE OPERATOR SHOULD ENTER TWO ALPHA CHARACTERS
*                       REPRESENTING THE BEGINNING AND LAST SYMBOLS 
*                       OF THIS PASS. THE MESSAGE WILL CONTINUE AFTER 
*                       EACH PASS UNTIL A /E IS ENTERED.
* 
*          #3. :PROG,XREF,A,B,C(,D) 
*                  C = 0 WILL GIVE TAPE NUMBERS WITH SEQUENCE NUMBERS 
*                  C = N WILL GIVE NO TAPE NUMBERS THUS ALLOWING
*                        LARGER SEQUENCE NUMBERS
* 
*          #4. :PROG,XREF,A,B,C,D 
*                   D = 0 WILL GIVE 57 LINES PER PAGE.
*                   D = N WILL GIVE N LINES PER PAGE. 
* 
      SKP 
*     THE X-REF PROGRAM RUNS UNDER THE FOLLOWING OPTIONS: 
* 
*        1. :PROG,XREF(,0,M)
*                   THIS OPTION ASSUMES SOURCE DATA IN WORK AREA
*                   FROM  ASSEMBLY JUST PRECEDING THIS CARD 
* 
*        2. :PROG,XREF,2(,M)
*                   THIS OPTION ASSUMES SOURCE DATA IN FILE SET VIA 
*                   :JFILE REQUEST. 
* 
*        3.  :PROG,XREF,N(,M) 
*                   THIS OPTION ASSUMES SOURCE DATA TO BE READ IN 
*                   FROM UNIT N 
* 
XREF  LDA B,I      GET CONTROL PARAMETER
      STA SAVE.     STORE LU# IN SAVE.
      INB 
      LDA B,I      GET LIMIT PARAMETER
      STA LETOP    SAVE LIMIT PARAMETER 
      INB          INCREMENT THE PARAMETER POINTER
      LDA B,I      GET THE TATE NUMBER OPTION PARAMETER 
      STA .TAPE    SAVE THE TAPE NUMBER OPTION PARAMETER
      INB          INCREMENT TO NEXT PARAMETER
      LDA B,I      LOAD A WITH LINES PARAMETER
      CPA ZERO     IS PARAMETER A ZERO
      JMP *+4      YES; SKIP OVER THE STORE INSTRUCTIONS
      CMA,INA      MAKE NUMBER NEGATIVE FOR COUNTERS
      STA MIN57    SAVE IN LINE COUNTER 
      STA LNSKP    SAVE IN LINE SKIP COUNTER
      LDB FXEND     GET "CODED" END OF OP-CODE TABLE
      STB ETAB        AND INITIALIZE CURRENT END
*                                       OF TABLE ADDRESS. 
      LDA CUDSC     GET CURRENT 
      STA SVSUB       SUBCHANNEL # AND SAVE.
      JSB .OPSY 
      STA STYPE     0 = DOS, 1 = IOMEC/DOS, -2 = RTE
      SSA 
      JMP .CONT    NOT DOS
      SLA,RSS 
      JMP .CONT    DOS
      LDB =D128     IOMEC/DOS.  BUFFER SIZE = 128 
      STB PSIZE 
      CMB,INB 
      STB MSIZE 
      LDB =D3 
      STB .2OR3     LOGICAL UNIT = 3 FOR DOS-M
.CONT LDA SAVE.     LOAD A WITH LU# PARAMETER 
      LDB DEFS,I
      STB TDEFS     SAVE CURRENT JFILS
      LDB DEFC,I
      STB TDEFC    SAVE CURRENT FFILC 
      SZA 
      JMP XR10     NOT CURRENT WORK AREA
      LDA .2
      STA IO/LU    SET I/O CHANNEL FOR INPUT
      STA .2OR3    SET LU TO 2 FOR WORK AREA
      JMP XR20
XR10  STA IO/LU 
      CPA .2       CHECK IF USER FILE 
      RSS          SET FOR NO TAPE NUMBERS
      JMP FGLLL    SET FOR TAPE NUMBERS 
      LDA JFILC     IF IT IS
      SZA,RSS         A MULTI-FILE SOURCE 
      JMP FGLLL         GO SET UP FOR TAPE NUMBERS. 
XR11  LDA RM1      LOAD A WITH MASK OF 077777B
      STA MSK12     SET SEQ # MASK
      LDA RM2 
      STA TAPE1    SET TAPE # ADD VALUE 
      LDA RM3 
     STA ROTAT    SET ROTATE INSTRUCTION -RAL-
      JMP FGSET 
O700  OCT 700 
UPCTL NOP         SET DEVICE UP 
XR20  JSB EXEC
      DEF *+5      GET WORK AREA LIMITS 
      DEF .17 
      DEF FTRAK 
      DEF LTRAK 
      DEF SIZE
      LDA FTRAK 
      ALF,ALF 
      LDB DEFS     SET JFILS
      JSB EXEC
      DEF *+2 
      DEF N19 
      JSB EXEC
      DEF *+2 
      DEF N19 
FGLLL LDA .TAPE    LOAD A WITH THIRD PARAMETER
      SZA          IS THIRD PARAMETER ZERO
      JMP XR11      NO; SET FOR NO TAPE NUMBERS 
      LDA RM4       YES; SET FOR TAPE NUMBERS 
      STA MSK12    SET SEQ # MADK 
      LDA RM5 
      STA TAPE1     SET TAPE # ADD VALUES 
      LDA RM6 
      STA ROTAT     SET ROTATE INSTR -ALF,RAL-
      LDA O700
      IOR IO/LU 
      STA UPCTL 
      JSB EXEC      SET INPUT DEVICE TO IGNORE LEADR
      DEF *+3 
      DEF .3
      DEF UPCTL 
FGSET CLA          LOAD A WITH ZERO 
      STA PAGNO    SET PAGE NUMBER TO ZERO
      STA RUN      SET LIMIT DD COUNT TO ZERO 
      LDA DEFCB    INITIALIZE CONSTANTS 
      ADA DEFCB 
      STA CHAR1 
      STA OUTBF 
      LDA A....    LOAD A WITH A ""A" 
      STA PGNUM+2  TO INITIALIZE MULTI-PAGE COUNTER 
      LDA DEFLB 
      ADA DEFLB 
      STA LABCH 
      LDA EXPG+6    SET FWA OF LTAB 
      STA FWA 
      LDA BLBL      SET BLANKS IN 
      STA NAME        NAME LOCATION 
      STA NAME+1
      STA NAME+2
      CCA          SET A TO -1
      STA LINES    SET LINES TO -1
      CLA           INITIALIZE
      STA SEQNO      SEQUENCE NUMBER &
      STA LABCT      NUMBER OF LABELS TO ZERO 
      STA DDFLG     CLEAR DOUBLE DEFINES FLAG 
      STA LOBND     SET LOWER BOUND OF LLOWED SYMBS 0 
      STA TAPNO    INITIALIZE TAPE NUMBER 
      LDA MASK8    SET UPPER BOUND OF ALLOWED 
      STA HIBND       SYMBOLS.
      LDA FWA        BOUNDS OF
      STA LTAB.        LABEL TABLE
      LDA LWA        BOUNDS OF CROSS
      STA .XTAB        REFERENCE TABLE
      LDA LETOP    CHECK IF XREF LIMITS SPECIFIED 
      SZA,RSS 
      JMP RAC      THEYRE NOT--USE 0 AND 377,I.E.,ALL.
      JSB EXEC
      DEF *+5 
      DEF .2
      DEF .1
      DEF EMESG 
      DEF NINE
      LDA TWO 
      LDB BUFAD    READ TWO CHARS FROM KEYBOARD.
      JSB KEYBD 
      LDA CBUF
      CPA SLSHE 
      JMP STOP
      LDA CBUF     PLACE THE TWO CHARS IN LOBND 
      AND MASK8       AND HIBND.
      STA HIBND 
      XOR CBUF
      ALF,ALF 
      STA LOBND 
      SPC 1 
* RECORD INPUT SECTION *
      SPC 1 
RAC   CLA           INITIALIZE NEXT TO ZERO TO PRE- 
      STA NEXT      VENT ERROR FROM OCCURING IN ID. 
      LDA DEC72     NUMBER OF CHARACTERS TO BE READ.
      LDB BUFAD     ADDRESS OF CHARACTER BUFFER 
      JSB READ
      SZA 
      SPC 0 
      JMP DOCRD     GO TO PROCESS RECORD
      SPC 2 
* END OF TAPE SECTION * 
      SPC 1 
      LDA .TAPE    LOAD A WITH TAPE # PARAMETER 
      SZA          SKIP IF PARAMETER IS ZERO
      JMP RAC      IF NOT ZERO SKIP EOT ROUTINE 
      LDB SEQNO     IF SEQUENCE # IS ZERO 
      SZB,RSS         ASSUME A EOF HAS BEEN 
      JMP RAC           ENCOUNTERED AS 1ST RECORD.
      STA SEQNO     RESET SEQ.NO. TO ZERO 
      LDA TAPNO     OTHERWISE BUMP TAPE NUMBER
      ADA TAPE1       BY ONE
      STA TAPNO         AND 
      SPC 0 
      SPC 0 
      SPC 0 
      SPC 0 
      JMP RAC         PROCEED.
      SPC 2 
* RECORD PROCESSING SECTION * 
      SPC 1 
DOCRD ISZ SEQNO     ADD 1 TO SEQUENCE NUMBER. 
      CMA           INITIALIZE CCNT TO
      STA CCNT        -1-# OF CHARACTERS IN RECORD
      LDA SAVE.     LOAD A WITH WITH LU# PARAMETER
      SZA          IS LU # ZERO 
      JMP RETRX    NO, RETURN 
      LDA RM1      YES, LOAD A WITH RM1 MASK
      CPA MSK12    IS IT THE SAME AS MASK 12
      JMP RETRX    YES, RETURN
      LDA SEQNO    NO, LOAD A WITH SEQUENCE NUMBER
      CPA =D2048   IS SEQUENCE NUMBER 2048
      JMP CHNG.    YES, CHANGE TO NO TAPE NUMBERS 
RETRX LDB CHAR1     GET THE FIRST 
      STB CPNTR 
      JSB BUF2A       CHARACTER.
      CPA STAR      IF A STAR, GO TO READ THE 
      JMP RAC         NEXT RECORD.
      CPA BLANK     IF A BLANK, SKIP OVER LABEL 
      JMP DOOP        SECTION.
      JSB ID        GO GET THE LABEL
      JMP RAC       ILLEGAL LABEL.
      CPA COMMA     IS NEXT CHARACTER A COMMA ? 
      JMP RAC         IF SO, IGNORE "ASMB" CARD.
      JSB CHEKR 
      JMP DOOP
      JSB LLKUP     FIND THE LABEL IN LTAB. 
      CCB           SET B TO POINT AT LABEL SEQUENCE
      JSB PUTSQ       NUMBER AND PUT IN XTAB. 
      SPC 1 
* OPERATOR PROCESSING SECTION * 
      SPC 1 
DOOP  JSB ID        GO GET THE OPERATOR.
      JMP RAC       ILLEGAL OPERATOR. 
      JSB LOOK      FIND IN OPERATOR TABLE
      DEF OPBEG 
ETAB  DEF * 
      LDB A         GET INDEX VALUE 
      CMB             IF IT IS EQUAL
      ADB MICOP         OR GREATER
      ELB                 THAN
      SEZ                   CONSTANT, USE 
      LDA MICOP               CONSTANT AS INDEX BASE
      LDB OPCNT     GET # OF OPERANDS FOR CURRENT 
*                                     OP-CODE.
      SZB           IF NOT ZERO 
      JMP DOOP1       GO MAKE # NEGATIVE. 
      SEZ,RSS       IF NOT A MIC-OP 
      INB,RSS         INCR BY 1 AND SKIP
      RSS 
DOOP1 CMB,INB       MAKE# NEGATIVE AND
      STB TEMP2     SAVE FOR FUTURE REFERENCE 
      ADA SWICH 
      JMP 0,I       GO TO PROCESSING ROUTINE. 
CHNG. LDA RM1      CHANGE 
      STA MSK12      FOR
      LDA RM2          NO 
      STA TAPE1          TAPE 
      LDA RM3              NUMBERS
      STA ROTAT 
      STA .TAPE     SET TAPE NUMBER TO NOT ZERO 
      JMP RETRX    RETURN 
      SPC 2 
*  CHEKR TESTS FOR WHETHER THE CURRENT LABEL IS BETWEEN THE 
* BOUNDS OF ACCEPTABILITY.  THAT IS, WHETER ITS FIRST CHAR
* IS BETWEEN LOBND AND HIBND.  IF IT IS, WE RETURN TO 
* NORMAL +1, OTHERWISE TO NORMAL
      SPC 1 
CHEKR NOP 
      LDA LABEL    GET THE FIRST CHARACTER
      AND MASK8 
      CMA,INA      -CHAR
      ADA HIBND    HIBND-CHAR 
      SSA          TEST HIGH END
      JMP CHEKR,I    TOO HIGH.
      CMA,INA      CHAR-HIBND 
      ADA HIBND    CHAR 
      CMA          -CHAR-1
      ADA LOBND    LOBND-CHAR-1 
      SSA          TEST LOW END 
      ISZ CHEKR    FORCE THE SKIP IF OKAY.
      JMP CHEKR,I 
PSUDO NOP 
      LDA LABEL+1   LOAD CHARACTERS 2 AND 3 
      STA LABEL+2   STORE AS CHARACTERS 2 AND 5 
      LDA LABEL     LOAD THE FIRST CHARACTER
      IOR SSTAR     SET THE WORD COUNT TO "*".
      STA LABEL+1   STORE AS CHARACTERS 2 AND 3 
      LDA SPCLB     LOAD WORD COINT/ASTERISK
      STA LABEL     STORE FIRST CHARACTER WORD
      JSB CHEKR     GO CHECK FOR CURRENT BOUNDS 
      JMP PSUDO,I   GO IGNORE CURRENT OPERATOR
      JSB LLKUP     GO GET SYMBOL ORDINAL 
      JMP PSUDO,I   RETURN
DOSP1 CLA,RSS       ENTER A=0 
DOSPC CCA          ENTER: A=-1
      STA SOP      STORE THE OPERAND OPTION FLAG. 
      JSB PSUDO     GO PROCESS PSUEDO OP-CODE 
      CLB           ENTER B=0 
      JSB PUTSQ     GO INSERT SEQ, # IN XTAB. 
      ISZ SOP       IS AN OPERAND TO BE PROCESSED?
      SPC 2 
* PROCESS SINGLE AND MULTIPLE OPERANDS
      SPC 1 
DOSOP JSB SOP       PROCESS OPERAND(S)
      JMP RAC       GO TO NEXT RECORD.
      SPC 2 
* ROUTINE TO HANDLE SINGLE AND MULTIPLE OPERANDS
      SPC 1 
SOP   NOP 
      LDA TEMP2     IF NO OPERANDS
      SZA,RSS         WERE SPECIFIED
      JMP SOP,I         RETURN. 
CLIND CLA 
      STA INDIR     CLEAR INDIRECT INDICATOR
DONXT JSB ID        GET A SYMBOL
      JMP NXOPR     NOT SYMBOLIC
      LDA INDIR     IF INDIRECT INDICATOR 
      SZA             IS SET, GO CLEAR AND
      JMP CLIND         GO GET NEXT SYMBOL. 
      JSB CHEKR 
      JMP NXOPR 
      JSB LLKUP     GET SYMBOL'S ORDINAL IN A 
      CLB             AND CREATE A SEQ. NO. IN
      JSB PUTSQ         XTAB. 
NXOPR LDA NEXT      IS NEXT CHARACTER 
      CPA PLUS        A PLUS
      JMP DONXT         YES-GO GET NEXT SYMBOL
      CPA MINUS           NO-IS IT A MINUS? 
      JMP DONXT             YES-GO GET NEXT SYMBOL
      CPA COMMA               NO-IS IT A COMMA? 
      JMP STIND                 YES-GO SET INDIR. 
      CPA BLANK                   NO-IS IT A SPACE? 
      JMP BPCNT                     YES-GO DECR CNTR
      JMP SOP,I                       NO-GO GET NEXT
STIND STA INDIR     SET INDIRECT INDICATOR
BPCNT ISZ TEMP2     DECR COUNTER BY 1 
      JMP DONXT     GO GET NEXT OPERAND 
      JMP SOP,I     GO GET NEXT STATEMENT TEMP2 = 0 
      SPC 3 
* MIC PROCESSOR 
      SPC 3 
DOMIC JSB PSUDO     GO PROCESS PSUEDO OP-CODE 
      CLB           ENTER B=0 
      JSB PUTSQ      GO INSERT SEQ # IN XTAB. 
      JSB ID        GET OP-CODE 
      JMP RAC       GO TO PROCESS NEXT RECORD 
      LDA LABEL     GET 1ST CHAR OF OP-CODE 
      LDB ETAB      GET CURRENT END OF OP-CODE TABLE
      STA B,I       STORE 1ST CHAR OF OP-CODE 
      INB           INCR CURRENT END OF OP-CODE TABLE 
      LDA LABEL+1 
      STA B,I       STORE LAST 2 CHARS OF OP-CODE 
      JSB PSUDO     GO PROCESS AS PSUEDO OP-CODE
      CCB           SET B TO POINT AT LABEL SEQUENCE
      JSB PUTSQ       NUMBER AND PUT IN ETAB. 
      LDA NEXT      IS NEXT CHAR
      CPA COMMA       EQUAL TO A COMMA? 
      RSS           YES - GO GET NEXT PARAM 
      JMP RAC           NO - GO GET NEXT STATEMENT. 
GSEC  JSB ID        GO GET NEXT SYMBOL
      JMP *+1       SKIP SECOND PARAMETER 
      LDA NEXT      IS NEXT CHAR
      CPA BLANK       EQUAL TO SPACE
      JMP RAC           YES - GO GET NEXT STATEMENT 
      CPA FEED            IS IT A LINE FEED 
      JMP RAC               YES - GO GET NEXT STATEMENT 
      CPA COMMA               IS IT A COMMA 
      RSS                       YES - GO GET NEXT CHAR
      JMP GSEC                    NO - GO GET NEXT SYMBOL 
GTLEN JSB CHAR      GET # OF OPERANDS PARAMETER 
      CPA BLANK     SKIP
      JMP GTLEN       BLANKS. 
      CPA FEED      END OF CARD?
      JMP FLEN        YES - CONTINUE. 
      JSB DIGIT     GO CHECK SEE IF IT IS A DIGIT 
      RSS           YES - IT IS A DIGIT CONTINUE
FLEN  CLA,INA,RSS   SYMBOLIC - SET # OF OPERANDS TO 1.
      AND .7        CONVERT ASCII DIGIT TO OCTAL. 
      ALF 
      ALF,ALF 
      STA NEXT
      LDB ETAB
      LDA B,I       GET FIRST CHAR OF CURRENT OP-CODE 
      IOR NEXT      "OR" IN NUMBER OF OPERANDS
      STA B,I       RESTORE ENTRY IN TABLE
      ALF,ALF       UPDATE POINTER
      AND .15         TO NEXT 
      ADB A             ENTRY IN OP-CODE
      STB ETAB            TABLE.
      JMP RAC       GO GET NEXT STATEMENT 
      SPC 2 
* EXT PROCESSOR 
      SPC 1 
DOEXT JSB ID        GO GET A SYMBOL 
      JMP RAC       END OF STATEMENT. 
      JSB CHEKR 
      JMP DOEXX 
      JSB LLKUP     PUT IN LABEL TABLE. 
      JSB ORDLK     GET ADDRESS OF LABEL SEQUENCE 
      ADA MIN1
      LDB 0,I         NUMBER AND SEE IF IT'S ZERO.
      SZB,RSS       IF IT IS, PLACE THE CURRENT 
      JSB MKSEQ       SEQNO THERE.
DOEXX LDA NEXT     IF NEXT CHARACTER IS A 
      CPA COMMA       COMMA,
      JMP DOEXT     GO GET THE NEXT SYMBOL, 
      JMP RAC         ELSE GO TO READ NEXT LINE.
      SPC 2 
* ENT PROCESSOR * 
      SPC 1 
DOENT JSB SOP       GO PROCESS A SYMBOL 
      CPA COMMA     IF NEXT CHARACTER IS A COMMA, 
      RSS             SKIP NEXT INST #2 
      JMP RAC         ELSE GO TO READ NEXT CARD.
      CCA           REFRESH # OF OPERANDS COUNTER 
      STA TEMP2 
      JMP DOENT     GO GET NEXT SYMBOL
      SPC 2 
* COM PROCESSOR * 
      SPC 1 
DOCOM JSB ID        GO GET A SYMBOL 
      JMP RAC       END OF STATEMENT. 
      JSB CHEKR 
      JMP DOCM1 
      JSB LLKUP     PUT IN LABEL TABLE. 
      CCB 
      JSB PUTSQ     PUT SEQUENCE NUMBER IN XTAB.
DOCM1 LDA NEXT     IF NEXT CHARACTER IS A 
      CPA LPREN       LEFT PARENTHESIS, 
      JMP COMRG     GO TO PROCESS ARGUMENT. 
COM1  CPA COMMA     IF A COMMA, 
      JMP DOCOM       GO GET NEXT COMMON ENTRY. 
      JMP RAC       ELSE GET NEXT RECORD. 
      SPC 2 
COMRG JSB CHAR      PROCESS ARGUMENT. 
      CPA RPREN     IF NEXT CHAR. IS A RIGHT PAREN, 
      JMP *+4        GO GET NEXT COM ENTRY. 
      CPA FEED         IF A LINE FEED, THEN 
      JMP RAC              END OF CARD. 
      JMP COMRG         ELSE GET NEXT CHARACTER.
      SPC 2 
      JSB CHAR
      JMP COM1
      SPC 2 
* NAM PROCESSOR * 
      SPC 1 
DONAM JSB ID        GO GET A SYMBOL 
      JMP RAC       NOT THERE 
      LDA LABEL     GET FIRST CHARACTER OF NAME 
      AND MASK8 
      IOR UPBLN     AND PRECEDE IT BY A BLANK.
      STA NAME      MOVE TO NAME LOCATION.
      LDA LABEL+1 
      STA NAME+1
      LDA LABEL+2 
      STA NAME+2
      JMP RAC 
      SPC 2 
* END PROCESSOR * 
      SPC 1 
DOEND JSB SOP       PROCESS ELEMENT FOLLOWING END.
      LDA MAXLN     GET A MINUS 57
      ADA DDFLG    ADD CONTENTS OF DD COUNTER 
      STA LNSKP    STORE RESULTS IN LINE COUNTER
      CLA 
      STA DDFLG     CLEAR DOUBLE DEFINES FLAG 
      LDA TAPNO    SET TAPE NUMBER
      STA TPCNT    TO TAPE COUNT
      SPC 1 
* OUTPUT SECTION *
                                                                                                                                                                                                                                                          