         PCC       0
         SYSTEM    SIG7
         SYSTEM   BPM
,BPM0,BPM1        ;
         M:PT     1                 SET PROTECTION TYPE TO 1 FOR SYS BPM
         DEF      BPM0,BPM1,C,D
MAX      EQU       1000             MAX # DECLARATIONS PER ROM.
LEN      EQU       5                # OF WORDS IN NAMES.
         ERROR,7,LEN>13    'YOU CAN''T DO THIS.'
*
*                  CROSS-REFERENCE PROGRAM
*
*                  AUTHOR:  T. S. MARTNER
*
*                  MODIFIED BY MICHAEL HITCH AND PAUL STENDAL TO LIST
*                  MULTIPLE REFERENCES ON EACH LISTING LINE.
*
*                  MODIFIED BY PAUL STENDAL TO:
*                  1.  ACCEPT LOAD MODULES IN ADDITION TO ROMS AS INPUT.
*                  2.  ENHANCE IT'S ON-LINE RUNNING CAPABILITIES.
*                  3.  TO FLAG SYMBOLS WHEN REFERENCES ARE ALL SREFS
*                      AND/OR ARE ALL UNUSED.
*                  4.  TO LIST, IN THE SUMMARY, THE NUMBER OF
*                      UNDEFINED SYMBOLS.
*                  5.  TO ALLOW ACCOUNT NUMBERS TO BE SPECIFIED ON THE
*                      FILENAME CARDS.
*                  6.  TO DISPLAY THE SEVERITY LEVEL IN THE ROM OR
*                      LOAD MODULE.
*
*    THIS PROGRAM READS ROM FILES AND/OR LOAD MODULES AND CREATES
*    A LIST OF THE EXTERNAL REFERENCES, EXTERNAL DEFINITIONS,
*    AND CONTROL SECTIONS.
*
*    OUTPUT IS SORTED IN ALPHABETICAL ORDER OF DECLARATION NAMES.
*
*    ANOTHER OPTIONAL LISTING, IN DECLARATION NUMBER ORDER WITHIN
*    ROM, CAN BE MADE.
*
*
*  WARNING: THIS PROGRAM CONTAINS A SUPERSECRET HORRIBLE KLUDGE AT
*    'HEXES'.  IF ANYBODY KNOWS A WAY AROUND IT, PLEASE LET ME KNOW.
         TITLE     '     '
*  INPUT IS FROM M:C, M:SI, AND M:EI.
*    M:C--  CONTROL CARD.
*      THE CONTROL CARD IS FIXED-FORMAT:
*        COL.10=1 TO OUTPUT UNUSED DECLARATIONS.
*                  (E.G. ' REF PQR', WITH PQR NOT OTHERWISE MENTIONED).
*        COL.11=1 TO OUTPUT CSECT AND DSECT DECLARATIONS.
*        COL.12=1 FOR OUTPUT TO M:SO.  (SEE NEXT PAGE)
*        COL.13= NUMBER OF WORDS IN FILE NAMES.
*                 FILENAME CARDS (SEE BELOW) CONTAIN A FILE NAME
*                 STARTING IN COLUMN 2.  THE FIELD CONTAINING THE
*                 FILE NAME WILL EXTEND THRU COLUMN (THIS NUMBER * 4).
*        COL.14= DISPLACEMENT OF ID.  FILE NAME CARDS CONTAIN AN
*                 IDENTIFICATION FIELD; THE CONTENTS OF THE ID
*                 FIELD, RATHER THAN THE FILE NAME ITSELF, ARE USED TO
*                 IDENTIFY DECLARATIONS ON OUTPUT.
*                 THE ID STARTS IN COLUMN (THIS NUMBER * 4 + 1).
*        COL.15= SIZE IN WORDS OF ID FIELD.
*        COL.16=1 FOR SORTED OUTPUT TO M:LO.  (SEE NEXT PAGE)
*        COL.17=1 FOR SAVEING SORTED FILE
*        COL.18=1 FOR DOUBLE SPACEING
*        COL.19= THE MINIMUM NUMBER OF REFERENCES TO CAUSE THE FLAGGING
*                 OF ALL SREFS AND/OR ALL UNUSEDS.  THE DEFAULT IS
*                 NO FLAGGING.  0 ALSO SPECIFIES NO FLAGGING.
*      DEFAULT AND ALLOWABLE VALUES:
*        NO UNUSED, NO CSECT/DSECT, NO SO OUTPUT, DELETE SORTED FILE.
*        4-WORD FILE NAMES.  (2 MINIMUM, 8 MAXIMUM).
*        4-WORD ID DISPLACEMENT.  (0 MINIMUM, 9 MAXIMUM).
*        6-WORD ID FIELD.  (1 MINIMUM, 6 MAXIMUM).
*        I.E., DEFAULT IS FILENAMES COL.2-16, ID COL.17-40.
*    M:SI--  FILE NAME CARDS.
*        FORMAT OF THESE CARDS IS AS INDICATED ABOVE.  THESE CARDS ARE
*        USED TO SELECT WHICH FILES ARE TO BE READ FROM M:EI.
*        NOTE:  ONE FILE MAY CONTAIN MORE THAN ONE ROM.  IN SUCH A
*        CASE, THERE MUST BE AS MANY FILENAME CARDS FOR THE FILE AS
*        THERE ARE ROMS IN THE FILE, THEY MUST BE IN THE PROPER
*        SEQUENCE (OTHERWISE THE ID'S WILL BE WRONG), AND THEY
*        MUST BE ADJACENT.
*    M:EI--  RELOCATABLE OBJECT MODULE (ROM) AND/OR LOAD MODULE FILES.
*        IF M:EI IS ASSIGNED TO A LABELED TAPE, FILES WILL BE READ
*        FROM THE TAPE.  IF M:EI IS ASSIGNED TO A RAD FILE IN ANOTHER
*        ACCOUNT, FILES WILL BE READ FROM THAT ACCOUNT ON THE RAD.
*        IF AN ACCOUNT IS SPECIFIED ON THE FILENAME CARD, THAT
*        ACCOUNT WILL OVER-RIDE THE ASSIGNED OR DEFAULT ACCOUNT
*        FOR THIS FILE ONLY.
*        OTHERWISE, FILES WILL COME FROM DISC UNDER THE RUN ACCT.
         PAGE
*  OUTPUT IS TO F:SR, AND TO M:SO IF COL.12 OF CONTROL CARD = 1.
*        OUTPUT RECORDS ARE 48 CHARACTERS LONG.
*        THEY CONTAIN A DECLARATION NAME, A DECLARATION TYPE,
*          THE ID, AND A USED/UNUSED FLAG.
*        THE NAME FIELD IS 16 COLUMNS LONG.
*        NAMES LONGER THAN 16 CHARACTERS ARE TRUNCATED ON THE RIGHT.
*        COL. 1-16 CONTAIN NAMES OF REFS/DEFS, SIZE OF CSECTS/DSECTS.
*        COL.18    IS 'U' IF THE ITEM IS UNUSED (OR UNDEFINED)
*                  IN THIS MODULE, OTHERWISE BLANK.
*        COL.19-24 CONTAIN DECLARATION TYPE: 'DEF   ', 'REF   ',
*                  'SREF  ', 'DSECT ', OR 'CSECT '.
*        COL.25-48 CONTAIN IDENTIFICATION, LEFT-JUSTIFIED IF
*                 SHORTER THAN 6-WORD FIELD.
*
*  F:SR IS THEN SORTED: NAME MAJOR, TYPE INTERMEDIATE, ID MINOR.
*        THE DEFAULT FOR F:SR IS (FILE,XREFSORT).
*        IF YOU REASSIGN IT, BE SURE TO ASSIGN IT TO A FILE OR TAPE;
*          XREF CREATES AND PASSES IT TO SORT TO REBUILD, SO IT
*          MUST BE CAPABLE OF BEING RE-READ.
*
*  M:LO WILL BE USED FOR A FORMATTED COPY OF THE SORTED FILE IF LO
*        SPECIFIED.  DEFAULT FOR M:LO IS (DEVICE,LO),(VFC).
         PAGE
*  M:LL IS USED TO LIST FILENAME CARDS AND ERROR MESSAGES.
*    ERROR MESSAGES:
*        'I/O ERR XXXX ON M:C'    JOB IS ERRORED; NO OUTPUT.
*        'I/O ERR XXXX ON M:SI'  CONTINUE AS IF IT HAD BEEN EOF.
*        'I/O ERR XXXX ON M:EI'  CURRENT ROM IS LOST; JOB CONTINUES.
*        'ILLEGAL ROM LANGUAGE'  CURRENT ROM IS USED UP TO POINT
*            OF ERROR; JOB CONTINUES.
*        'TABLE OVERFLOW'  SEE 'ILL ROM'.  AN INTERNAL TABLE OF
*            DECLARATIONS HAS OVERFLOWED.  IT CAN BE MADE LARGER BY
*            REASSEMBLING THE PROGRAM, REPLACING LINE 5 BY
*            'MAX EQU XXXX'.  (XXXX=1000 IN STANDARD VERSION).
*        'SKIPPED; ERROR EARLIER IN FILE'  AN ERROR WAS ENCOUNTERED
*            WITHIN A PREVIOUS ROM IN THIS FILE; THE CURRENT ROM CANNOT
*            BE REACHED, AND IS LOST.
*        'SORT ERROR X'  SORT HAD TROUBLES; SEE SORT REFERENCE MANUAL.
*        'NO DECLARATIONS; NO OUTPUT'  F:SR IS EMPTY AFTER EOF ON M:SI.
*        'I/O ERR XXXX ON F:SR'  PROBLEMS READING F:SR AFTER SORT.
*            M:LO WILL BE CLOSED AND SAVED AT THIS POINT.
         PAGE
TXT      CNAME
         PROC
LF       EQU      %
         DO       AF
         TEXT     ' '
         LIST     0
         FIN
         LIST     1
         PEND
         TITLE     '     .....     M:C      .....     '
*  HOME-MADE M:C DCB FOR SHORT LENGTH.
M:C      DSECT     1
         GEN,8,24  M:CTTL,3         TTL,DEV
         GEN,15,17 1,1              IN,C
         GEN,8,24  5,INPUT          TRIES,BUF
         GEN,15,17 80,C:ERR         RSZ,ERR
         DATA      C:ERR            ABN
         GEN,2,22,4,4  2,0,1,1      SAVE,CONSEC,SEQUEN
         DATA      M:CFLP
         DATA     ,,,M:CKBUF
         DATA      0,0,0,0,0,0,0,0,0,0,0
M:CFLP   GEN,8,24 1,8               FILENAME
         RES      8
         GEN,8,24 2,2               ACCOUNT NUMBER
         RES      2
         GEN,8,8,16  7,1,3          INSN
         RES       3
M:CKBUF  RES      8
M:CTTL   EQU       %-M:C
         TITLE     '     .....     M:SI     .....     '
*  HOME-MADE M:SI DCB TO BE SHORT AND HAVE BUILT-IN ERR/ABN'S.
M:SI     DSECT     1
         GEN,8,24  M:SITTL,3        TTL,DEVICE
         GEN,15,17 1,9              IN,SI
         GEN,8,24  5,INPUT          TRIES,BUF
         GEN,15,17 80,SI:ERR        RSZ,ERR
         DATA      SI:ERR           ABN
         GEN,2,22,4,4  2,0,1,1      SAVE,CONSEC,SEQUEN
         DATA      M:SIFLP
         DATA      0,0,0
         DATA      M:SIKBUF
         DATA      0,0,0,0,0,0,0,0,0,0,0
M:SIFLP  GEN,8,24  1,8              FILENAME
         RES       8
         GEN,8,24  2,2              ACCOUNT
         RES       2
         GEN,8,8,16  7,1,3          INSN
         RES       3
M:SIKBUF RES       8
M:SITTL  EQU       %-M:SI
         TITLE     '     .....     M:EI     .....     '
*   HOME-MADE M:EI DCB TO BE SURE OF ENOUGH FILENAME ROOM.
M:EI     DSECT     1
         GEN,8,24  M:EITTL,1        TTL,ASN
         GEN,15,17  1,0             IN
         GEN,8,24  20,INPUT         TRIES,BUF
         GEN,15,17 120,EI:ERR       RSZ,ERR
         DATA      EI:ERR           ABN
         GEN,2,22,4,4  2,0,1,1      SAVE,CONSEC,SEQUEN
         DATA      M:EIFLP
         DATA      0,0,0
         DATA      M:EIKBUF
         DATA      0,0,0,0,0,0,0,0,0,0,0
M:EIFLP  GEN,8,24  1,8              FILENAME
         RES       8
M:EIACCN GEN,8,24  2,2              ACCOUNT
         RES       2
         GEN,8,8,16  7,1,3          INSN
         RES       3
M:EIKBUF RES       8
M:EITTL  EQU       %-M:EI
         TITLE     '     .....     F:SR     .....     '
*  HOME-MADE F:SR DCB TO MAKE IT EASIER TO LINK TO SORT.
F:SR     DSECT     1
         GEN,8,24  F:SRTTL,1        TTL,ASN
         GEN,15,17 2,0              OUT
         GEN,8,24  10,OUTPUT        TRIES,BUF
         GEN,15,17  LEN*4+32,0      RSZ
         DATA      0
         GEN,2,22,4,4  2,0,1,1      SAVE,CONSEC,SEQUEN
         DATA      F:SRFLP
         DATA      0,0,0
         DATA      F:SRKBUF
         DATA      0,0,0,0,0,0,0,0,0,0,0
F:SRFLP  GEN,8,16,8  1,3,3          FILENAME
TCXRSRT  TEXTC     'XREFSORT'
         GEN,8,24  2,2              ACCOUNT
         RES       2
         GEN,8,24   7,3             INSN
         RES       3
         GEN,8,8,16  8,1,3          OUTSN
         RES       3
         BOUND     8
F:SRKBUF RES       8
F:SRTTL  EQU       %-F:SR
         TITLE     '     .....     M:SO     .....     '
*  HOME-MADE M:SO DCB, BUILT JUST FOR GRINS.
M:SO     DSECT     1
         GEN,8,24  M:SOTTL,3        TTL,NOVFC,DEVICE
         GEN,15,17 2,3              OUT,LO
         GEN,8,24  10,OUTPUT        TRIES,BUF
         GEN,15,17  LEN*4+32,0      RSZ
         DATA      0
         GEN,2,22,4,4  2,0,1,1      SAVE,CONSEC,SEQUEN
         DATA      M:SOFLP
         DATA      0,0,0
         DATA      M:SOKBUF
         DATA      0,0,0,0,0,0,0,0,0,0,0
M:SOFLP  GEN,8,24  1,8              FILENAME
         RES       8
         GEN,8,24  2,2              ACCOUNT
         RES       2
         GEN,8,8,16  8,1,3          OUTSN
         RES       3
M:SOKBUF RES       8
M:SOTTL  EQU       %-M:SO
         TITLE     '     .....     M:LL     .....     '
*  HOME-MADE M:LL DCB, BUILT JUST TO ROUND THINGS OFF.
M:LL     DSECT     1
         GEN,8,24  M:LLTTL,3        TTL,NOVFC,DEVICE
         GEN,15,17 2,4              OUT,LL
         GEN,8,24  10,0             TRIES
         DATA      0,0
         GEN,2,22,4,4  2,0,1,1      SAVE,CONSEC,SEQUEN
         DATA      M:LLFLP
         DATA      0,0,0
         DATA      M:LLKBUF
         DATA      0,0,0,0,0,0,0,0,0,0,0
M:LLFLP  GEN,8,24  1,8              FILENAME
         RES       8
         GEN,8,24  2,2              ACCOUNT
         RES       2
         GEN,8,8,16  8,1,3          OUTSN
         RES       3
M:LLKBUF RES       8
M:LLTTL  EQU       %-M:LL
         TITLE    '     .....     M:LO     .....     '
*  HOME-MADE M:LO DCB, BUILT FOR VFC AND FOR (DEVICE,LO)
M:LO     DSECT    1
         GEN,8,16,8  M:LOTTL,1,3    TTL,VFC,DEVICE
         GEN,15,17 2,3              OUT,LO
         GEN,8,24 10,0              TRIES
         GEN,15,17  LEN*4+36,0      RSZ
         DATA     0
         GEN,2,22,4,4  2,0,1,1      SAVE,CONSEC,SEQUEN
         DATA     M:LOFLP
         DATA     0,0,0
         DATA     M:LOKBUF
         DATA     0,0,0,0,0,0,0,0,0,0,0
M:LOFLP  GEN,8,24 1,8               FILENAME
         RES      8
         GEN,8,24 2,2               ACCOUNT
         RES      2
         GEN,8,8,16  8,1,3          OUTSN
         RES      3
M:LOKBUF RES      8
M:LOTTL  EQU      %-M:LO
         PAGE
F:TFILE  DSECT    1
F:TFILE  M:DCB    (FILE)
         TITLE    'B L A N K   C O M M O N'
F4:COM   DSECT    0
         RES,4     LEN              (-1)TH NAME TO DUMP UNWANTED TEXT.
NAMES    RES,4     LEN*MAX          (LEN)-WORD AREAS FOR DECL NAMES.
USEDS    RES,4     MAX              AREA FOR 'U' MARK: 0 = UNUSED.
TYPES    RES,4     MAX              AREA FOR DECL TYPES; SEE BELOW:
SZF4:COM EQU      %-F4:COM          WORD SIZE OF BLANK COMMON
         TITLE    'B U F F E R S   A N D   D A T A'
D        CSECT    0                 BUFFER AND DATA SECTION
INPUT0   GEN,8,24  83,'   '         FOR DOING M:PRINT OF INPUT.
INPUT    RES       0                ALL INPUT COMES HERE.
         TXT      30
*
         BOUND     8                    (NOTE: OUTTYPE MUST BE ON DWB)
         TXT      1-(LEN&1)
         TEXT     '    '            FOR BENEFIT OF SORTED-OUTPUT LISTER.
OUTPUT   EQU       %                OUTPUT AREA STARTS HERE.
OUTNAME  RES       LEN              AREA FOR NAMES.
OUTTYPE  RES       2                  AREA FOR DECL TYPE, 'U' FLAG.
ID       TXT      6                 IDENT FIELD (6 WORDS).
         BOUND    8
         RES      1-(LEN&1)
OUTBUF   TEXT     '    '
         TXT      LEN
IDLIST   EQU      %
         TXT      26-LEN
*
IDINDEX  DATA     0
REFLIST  DATA     0
SEVLEVAD DATA     2                 ADR OF SEV LEV ON FILENAME LISTING
SILISTED DATA     1                 +/M:SI CARD HAS BEEN LISTED ON M:LL
*
*
ASTER    TEXT   'A***************************************************',;
                '****************************************************'
ASTERSIZE EQU     BA(%)-BA(ASTER)
HEADER   TEXTC    '** SYMBOL'
         TXT      LEN-%+HEADER+1
         TEXT     'DEFINED IN'
         TXT      27-%+HEADER
TCHDR2   TEXTC    '*** FILENAME'
         TXT      27-%+TCHDR2
BFEI     RES      30                BUFFER THAT M:EI READS INTO
#REFS    DATA     0                 # OF REFERENCES TO CURRENT SYMBOL WHEN LISTI
#UNUSEDS DATA     0                 # OF UNUSED REFERENCES TO CUR SYMBOL
#SREFS   DATA     0                 # OF SREFS TO CURRENT SYMBOL
#UNDEFS  DATA     0                 # OF UNDEFINED SYMBOLS IN TOTAL LISTING
#REFFLAG DATA     0                 # OF REFERENCES TO CAUSE FLAGGING
TXUNDEFS TEXT     'ANUMBER OF UNDEFINED SYMBOLS:     '
TXUNSIZE EQU      4*(%-TXUNDEFS)
         PAGE
FLAGSO   DATA     0                 1 FOR LO OUT, 0 FOR NOT.
FLAGCS   DATA      2                OUTPUT DECLTYPES 0,1,2.
*                                   CHANGED TO 4 TO OUTPUT CSECTS.
FLAGUN   DATA     0                 -1 FOR UNUSED OUT, 0 FOR NOT.
FLAGLO   DATA      0                1 FOR M:LO OUT, 0 FOR NOT.
SAVESR   DATA     0                 SAVE F:SR, 0=NO, 1=YES
INID     RES       1                WA(ID ON FILENAME CARD).
INIDLEN  RES       1                ID LENGTH, LEFT-JUST FOR LC.
INFILEN  RES       1                LENGTH(BYTES) OF FILE NAME.
*                                   M:OPEN M:EI,(FILE,...)
OPENEI   GEN,8,24  20,M:EI          M:OPEN M:EI,(LABEL,...)
         DATA      1                  (CHANGED TO 2 FOR LABEL)
         GEN,8,8,8,8  1,0,8,8       RESERVE 8 WORDS FOR FILENAME.
EIFILE   DATA      0                ASSURE LOUSY INITIAL FILENAME.
         RES       7
EIACCN   RES       3                ACCN FROM DCB GOES HERE.
DEFACCN  RES      2                 DEFAULT (INITIAL) ACCN
ERR:MESS TEXTC    '****   I/O ERR XXXX ON M:SI'
SORT:E   BAL,8     COMN:E
SORT:EMES TEXTC    '****    SORT ERROR 0'
         PAGE
*
*                      SPECIFICATION RECORD FOR -SORT-.
*
S:       FNAME
         PROC
S:1      SET       AF/10
S:2      SET       AF-10*S:1
         PEND      '00'+S:1**8+S:2
*
SORTSPEC DATA,3    'M00'
         DATA,2    S:(LEN*4+32)
         DATA,3    '   '
         DATA,8    '        '
         DATA,8    '        '
         DATA,8    '        '
         DATA,8    '        '
         DATA,8    '        '
         DATA,8    '03A00010'
         DATA,2    S:(LEN*4)
         DATA,5    '  A00'
         DATA,2    S:(LEN*4+3)
         DATA,8    '001  A00'
         DATA,2    S:(LEN*4+8)
         DATA,5    '024  '
*
         TEXT     '    '
LISTNAME DATA     0                 AREA FOR REMEMBERING SORTED NAMES.
         RES      LEN-1
         TEXT     ' *******'
2SPACE   TEXT     'A   '
         TITLE    'S T A T I C   D A T A'
C        CSECT    1                 STATIC DATA AND PROCEDURE
BLANKS   TEXT      '       '        A WORD OF BLANKS IS ALWAYS HANDY.
*
*  XLTYPE TABLE IS USED TO TRANSLATE 'TYPE' IN THE REF/DEF
*  STACK ENTRY TO THE TEXT EQUIVALENT (E.G., 'SREF').  IT IS
*  INDEXED BY THE 'TYPE' AND INDEXES INTO THE TYC TABLE THAT FOLLOWS.
XLTYPE   DATA,1   1,3,2,4,,,,,1,,,4,,,,
*
         BOUND     8                NAMES OF DECLARATION TYPES.
TYC      TEXT      '  DEF   '       TYPE = 0.
         TEXT      '  REF   '       TYPE = 1.
         TEXT      '  SREF  '       TYPE = 2.
         TEXT      '  DSECT '       TYPE = 3.
         TEXT      '  CSECT '       TYPE = 4.
DDEF     TEXT     '**DDEF**'
HEADER1  TEXTC    'REFERENCED IN   (S = SREF, U = UNUSED)'
PAGER    TEXT     '1   '
TCHEAD   TEXTC    'HEAD'            KEY FOR READING HEAD
TCTREE   TEXTC    'TREE'            KEY FOR READING TREE
TXHEX    TEXT     '0123456789ABCDEF'    TABLE FOR HEX CONVERSION
TCALLR   TEXTC    '---- ALL ARE'
TCSREF   TEXTC    ' SREFS'
TCAND    TEXTC    ' AND'
TCUNUSED TEXTC    ' UNUSED'
TCID     TEXTC    'ID'
TCSEVLEV TEXTC    ' SEV LEV'
         BOUND     8
IDLIMS   DATA      1,6              MIN, MAX SIZE OF ID FIELD.
NAMELIMS DATA      2,8              MIN, MAX SIZE OF FILENAME FIELD.
LM09     DATA     '0','9'
         TITLE    'F P T S'
READC    GEN,8,24  16,M:C           M:READ M:C,(ERR,C:ERR),(ABN,C:ERR)
         GEN,4,28  12,X'10'
         DATA      C:ERR,C:ERR
READSI   GEN,8,24  16,M:SI        M:READ M:SI,(ERR,SI:ERR),(ABN,SI:ERR)
         GEN,4,28  12,X'10'
         DATA      SI:ERR,SI:ERR
READEI   GEN,8,24  16,M:EI        M:READ M:EI,(ERR,EI:ERR),(ABN,EI:ERR),;
         GEN,4,28  14,X'10'         (BUF,BFEI)
         DATA      EI:ERR,EI:ERR,BFEI
WRITSR   GEN,8,24  17,F:SR          M:WRITE F:SR,(WAIT)
         DATA      16
WRITSO   GEN,8,24  17,M:SO          M:WRITE M:SO,(WAIT)
         DATA      16
PRINT    GEN,8,24  1,0              M:PRINT (MESS,INPUT0)
         PZE       *0
         DATA      INPUT0
CLOSEI   GEN,8,24  21,M:EI          M:CLOSE M:EI
         DATA      0
CLOSESR  GEN,8,24  21,F:SR          M:CLOSE F:SR,(SAVE)
         PZE       *0
         DATA      2
DELSR    GEN,8,24 21,F:SR           M:CLOSE  F:SR,(REL)
         PZE      *0
         DATA     1
CLOSSO   GEN,8,24  21,M:SO          M:CLOSE M:SO,(SAVE)
         PZE       *0
         DATA      2
OPENSR2  GEN,8,24 20,F:SR           M:OPEN F:SR,(IN)
         DATA     X'01000000'
         DATA     1
READSR   GEN,8,24 16,F:SR           M:READ F:SR,(ERR,SR2:ERR),
         GEN,4,28 12,0                          (ABN,SR2:ERR)
         DATA     SR2:ERR,SR2:ERR
WRITEAST GEN,8,24 17,M:LO
         DATA     X'30000010'
         DATA     ASTER,ASTERSIZE
OPENLO   GEN,8,24 X'14',M:LO        M:OPEN M:LO
         DATA     0
WRITLO   GEN,8,24 17,M:LO           M:WRITE M:LO,(BUF,OUTPUT-1),
         GEN,4,28   3,16
         DATA     OUTBUF
         PZE      *5
LO:UND   GEN,8,24 17,M:LO           M:WRITE M:LO,(BUF,LISTNAME-1),
         GEN,4,28 3,16                           (WAIT)
         DATA     LISTNAME-1,LEN*4+12
CLOSLO   GEN,8,24 21,M:LO           M:CLOSE M:LO,(SAVE)
         PZE      *0
         DATA     2
*
SETPGCNT GEN,8,24 X'24',M:LO
         PZE      *0
         DATA     105
*
SETHEADER GEN,8,24 X'26',M:LO
         GEN,2,30 3,0
         DATA     HEADER
         DATA     1
         TITLE     '****    I/O ERROR HANDLING ROUTINES    ****'
SI:ERR   LB,7      10               ERROR ON M:SI.
         CI,7      5                CHECK FOR
         BE        EXIT               EOD
         CI,7      6                OR
         BE        EXIT               EOF.
         LW,9      ='M:SI'
         LI,11     EXIT
         B         COMN:ERR
EI:ERR   BAL,15   LISTCARD          LIST FILENAME CARD
         LW,9      ='M:EI'
         BAL,11    COMN:ERR
         LI,7      X'20'
         CH,7      M:EI
         BAZ       %+2
         CAL1,1    CLOSEI
         B         NEXTF
C:ERR    LI,9      ='M:C '
         BAL,11    COMN:ERR
         CAL1,9    2
*
COMN:ERR STW,9     ERR:MESS+6       DCB NAME TO MESSAGE.
         LW,7      10               NOW CONVERT ERROR TO EBCDIC.
         SLD,6     8                SEPARATE TOP BYTE.
         SLS,7     -1               MAKE LOWER 7BITS INTO BYTE.
         SLD,6     -8               GET INTO R7(0-15).
         LI,6      -1
CVTERR2  SCS,6     4                GET 'F' ZONE.
         SLD,6     4                GET NUMERIC.
         CB,6      ='9999'          IS IT 0-9...
         BLE       %+2                YES.
         AI,6      'A'-'9'-1          NO, ADJUST IT.
         CW,6      ='9999'          ARE WE DONE...
         BG        CVTERR2            NO.
         STW,6     ERR:MESS+4       EBCDIC OF ERROR TO MESSAGE.
         CAL1,2    ERR:PRNT         PRINT ERROR MESSAGE.
         B         *11              RETURN TO SPECIFIC RECOVERY.
ERR:PRNT GEN,8,24  1,0              M:PRINT (MESS,ERR:MESS)
         PZE       *0
         PZE       ERR:MESS
         TITLE     '****    NON-I/O ERROR HANDLERS    ****'
NUL:E    LI,9      EXIT2            F:SR IS NULL; PRINT MESSAGE
         BAL,8     COMN:E             AND STOP.
         TEXTC     '****    NO DECLARATIONS; NO OUTPUT.'
SKP:E    LI,9      NEXTF            READ NEXT FILENAME CARD
         BAL,8     COMN:E           AFTER SAYING WE'VE SKIPPED THIS ONE.
         TEXTC     '****    SKIPPED; ERROR EARLIER IN FILE'
ILL:E    BAL,8     COMN:E0
         TEXTC     '****   ILLEGAL ROM LANGUAGE'
OFL:E    BAL,8     COMN:E0
         TEXTC     '****    TABLE OVERFLOW'
COMN:E0  BAL,9     COMN:E           PRINT ERROR MESSAGE.
         LI,7      X'20'            CLOSE M:EI
         CH,7      M:EI               IF IT'S OPEN,
         BAZ       %+2                  SO THAT ANY OTHER ROMS IN IT
         CAL1,1    CLOSEI                 WILL BE SKIPPED.
         B         ROMEND           THEN RECOVER WHAT WE CAN OF ROM.
*
COMN:E   BAL,15   LISTCARD          LIST FILENAME CARD
         CAL1,2    E:PRINT          PRINT MESSAGE
         B         *9               THEN GO TO RECOVERY ROUTINE.
E:PRINT  GEN,8,24  1,0              M:PRINT (MESS,*8)
         PZE       *0
         PZE       *8
         TITLE     'MAIN PROGRAM                                      '
*
*                            PROGRAM DESCRIPTION
*
*  THERE ARE THREE LEVELS IN THE CROSS-REFERENCE PROGRAM.
*
*  THE OUTERMOST LEVEL INCLUDES 'BEGIN' AND 'EXIT'.
*    'BEGIN' READS THE CONTROL CARD AND PERFORMS INITIAL SETUP.
*    'EXIT' IS CALLED AFTER EOF ON M:SI, AND PERFORMS THE SORT.
*
*  THE MIDDLE LEVEL INCLUDES 'NEXTF' AND 'ROMEND'.
*    'NEXTF' READS FILENAME CARDS FROM M:SI AND OPENS M:EI FILES.
*    'ROMEND' IS ENTERED AT THE END OF A ROM.  IT CREATES F:SR AND M:SO.
*    'LMN' PROCESSES M:EI FILES IF THEY ARE KEYED (POSSIBLE LOAD
*      MODULES).
*
*  THE LOWEST LEVEL CONTAINS THE COROUTINES 'INN' AND 'OUT'.
*    'INN' SCANS INDIVIDUAL ITEMS OF A ROM WITHIN EXPRESSIONS.
*    'OUT' SCANS INDIVIDUAL ITEMS OF A ROM OUTSIDE EXPRESSIONS.
*
*  IN ADDITION, SEVERAL UTILITY ROUTINES ARE USED BY 'INN' AND 'OUT':
*    'GET' FETCHES INDIVIDUAL BYTES FROM THE ROM.  M:EI IS READ HERE.
*    'IGNORE' CALLS 'GET' TO MOVE PAST UNNEEDED BYTES IN THE ROM.
*    'USED' EXAMINES DECLARATION NUMBERS AND MARKS THEM USED.
*    'TEXT' COLLECTS TEXTC STRINGS FROM THE ROM.
*
         TITLE     '****        OUTER LEVEL        ****'
*
BEGIN    EQU       %
         M:OPEN   M:LL,(SAVE)       OPEN M:LL
         LI,7      7
         AND,7     M:EI
         CI,7      2                IS M:EI ASSIGNED TO LABEL...
         BNE       %+2                NO.
         MTW,1     OPENEI+1           YES.  FIX UP FPT.
         LCI       3
         LM,6      M:EIACCN         GET ACCT # FROM M:EIDCB
         AI,6      X'10000'           SET LEI
         LCI       3
         STM,6     EIACCN               STORE IT INTO OPEN FPT.
         LCI      2                 L/CC'S OF 2 FOR STM
         STM,7    DEFACCN           S/ACCN; SAVE FOR DEFAULT
         CAL1,1    READC            READ CONTROL CARD FROM M:C.
         CAL1,2   PRINT             ECHO CONTROL CARD
         LW,8      INPUT+2          OUTPUT FLAGS.
         CI,8      X'10000'         OUTPUT UNUSED DECLARATIONS...
         BAZ       %+2                NO.
         MTW,-1    FLAGUN             YES.  SET FLAGUN =-1.
         CI,8      X'100'           OUTPUT CONTROL SECTIONS...
         BAZ       %+2                NO.
         MTW,2     FLAGCS             YES.  SET FLAGCS =4.
         CI,8      X'1'             OUTPUT TO M:SO...
         BAZ       %+2                NO.
         MTW,1     FLAGSO             YES.  SET FLAGSO =1.
         LB,9     INPUT+4
         CI,9     1
         BAZ      %+3
         MTW,1    SAVESR
         B        BEGIN50
         M:TFILE  F:TFILE,(TFILE,TCXRSRT)
BEGIN50  LW,9     INPUT+4
         CI,9     X'10000'
         BANZ     %+3
         MTB,-1   2SPACE
         MTB,-1   ASTER
         LW,9      INPUT+3
         CI,9     1                 OUTPUT TO M:LO...
         BAZ      %+2                 NO.
         MTW,1    FLAGLO              YES.  SET FLAGLO =1.
         SLD,8     8
         AND,8     =X'F'            NO. OF WORDS IN FILENAMES.
         CLM,8     NAMELIMS         BETWEEN 2 AND 8...
         BCR,9     %+2                YES.
         LI,8      4                  NO.  SET TO DEFAULT OF 4.
         SLS,8     2                CONVERT TO # OF BYTES.
         AI,8      -1
         STW,8     INFILEN          SAVE IT.
         LI,8      0
         SLD,8     8                DISPLACEMENT OF ID.
         AI,8      -'0'             WAS IT SPECIFIED...
         BGEZ      %+2                YES.
         LI,8      4                  NO.  USE DEFAULT.
         AI,8      INPUT            CONVERT TO ACTUAL ADDRESS.
         STW,8     INID             SAVE IT.
         AWM,8    SEVLEVAD          ADD TO SEV LEV ADR
         SLD,8     8
         AND,8     =X'F'            LENGTH OF ID.
         CLM,8     IDLIMS           BETWEEN 1 AND 6 WORDS...
         BCR,9     %+2                YES.
         LI,8      6                  NO. USE DEFAULT OF 6.
         AWM,8    SEVLEVAD          ADD TO SEV LEV ADR; CORRECT NOW
         SCS,8     -4               FIX IT UP FOR LC COMMAND.
         STW,8     INIDLEN          SAVE IT.
         LI,5     2                 L/BTD TO COL. 19 IN INPUT + 4
         LB,5     INPUT+4,5         L/COL. 19
         CLM,5    LM09              C/# W/0,9
         BCS,9    %+3               B/NOT BETWEEN 0 AND 9; NOT EBCDIC #
         AI,5     -'0'              -'0'; GET BINARY FROM EBCDIC
         STW,5    #REFFLAG          S/#REFS  ALL SREF/UNUSED FLAGGING
         LW,5     INID              L/ADR OF ID IN INPUT REC
         LI,4     TCID              L/ADR OF 'ID'
         BAL,8    HDRMV             MOVE 'ID' INTO HEADER
         LW,5     SEVLEVAD          L/ADR OF SEVLEVAD IN INPUT REC
         LI,4     TCSEVLEV          L/ADR OF ' SEV LEV'
         BAL,8    HDRMV             MOVE ' SEV LEV' TO HEADER
         AI,5     -BA(TCHDR2)-1     G/BC OF HEADER
         STB,5    TCHDR2            S/BC IN HEADER
         M:DEVICE M:LL,(COUNT,105)  SET PAGE COUNT COLUMN NUMBER
         M:DEVICE M:LL,(HEADER,1,TCHDR2)    SET HEADER ADR
         M:DEVICE M:LL,(PAGE)       TOP PAGE
         B         NEXTF            END OF INITIALIZATION; PROCEED.
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
EXIT     EQU       %                COME HERE AFTER EOF ON M:SI.
         LI,7      X'20'
         CH,7      F:SR             WAS F:SR OPENED...
         BAZ       NUL:E              NO.  QUIT WITHOUT SORTING.
         CAL1,1    CLOSESR          CLOSE AND SAVE F:SR.
         MTW,0     FLAGSO
         BEZ       %+2
         CAL1,1    CLOSSO           ALSO M:SO IF WE'VE BEEN USING IT.
*
         CAL1,8    M:GCP            GET A COMMON PAGE FOR SORT.
         LW,6      9                SET R6 FOR SORT.
         LI,5      -20              TRANSFER
         LW,8      SORTSPEC+20,5      SORT
         STW,8     *9                   SPECIFICATION.
         AI,9      1
         BIR,5     %-3
         LW,7      9                SET R7 FOR SORT.
         LI,4      2
         LI,5     -F:SRTTL          TRANSFER
         LW,8     F:SR+F:SRTTL,5     INPUT
         STW,8     *9                 AND
         AI,9      1                   OUTPUT
         BIR,5     %-3                  DCB'S.
         BDR,4     %-5
         STW,4     *9               SAY NO USER LABEL.
         CAL1,8    M:LINK           LINK TO SORT.
         AI,6      0                DID IT GO OKAY...
         BEZ      LIST0               YES.
         AI,6      '0'                NO.
         STB,6     SORT:EMES+5
         BAL,9     SORT:E           PRINT ERROR MESSAGE.
EXIT2,FPCLSLL     ;
         M:CLOSE  M:LL,(SAVE)       CLOSE M:LL
         CAL1,9    1
M:GCP    GEN,8,24  X'C',1           GET ONE COMMON PAGE.
*
M:LINK   GEN,8,24  2,2
         TEXTC     'SORT'
         TEXT      ':SYS    '
         TITLE    '*****     LIST SORTED OUTPUT     *****'
LIST0    EQU      %
         MTW,0    FLAGLO            OUTPUT TO M:LO...
         BEZ      EXIT2               NO.  QUIT.
         CAL1,1   OPENSR2           RE-OPEN F:SR INPUT.
         LW,5     INIDLEN
         SLS,5    -28
         AI,5     IDLIST
         STW,5    REFLIST
         AI,5     -OUTBUF+HEADER
         SLS,5    2                 SHIFT; G/BA
         LI,4     HEADER1           L/ADR OF LAST PORTION OF HEADER
         BAL,8    CONCAT            MOVE
         AI,5     -BA(HEADER)-1     G/BC OF HEADER
         STB,5    HEADER            S/BC OF HEADER
         CAL1,1   OPENLO            M:OPEN M:LO
         CAL1,1   SETPGCNT
         CAL1,1   SETHEADER
         LW,5     PAGER             MAKE FIRST LINE BE NEW-PAGE.
LIST1    CAL1,1   READSR            GET A RECORD.
         LD,6     OUTTYPE           GET DECLTYPE.
         STH,5    6                 ERASE 'UNUSED' INDICATOR.
         CW,7     TYC+9             IS IT CSECT/DSECT...
         BE       LIST2A              YES.  JUST LIST IT.
         LI,3     LEN               NOW SEE IF
         LW,4     OUTNAME-1,3         IT'S GOT THE SAME NAME
         CW,4     LISTNAME-1,3          AS THE PREVIOUS ONE.
         BNE      LIST3                     NO.  DO GOOD THINGS.
         BDR,3    %-3
LIST1A   EQU      %
         CD,6     TYC
         BNE      LIST1B
         CB,5     IDLIST            HAS IT BEEN DEFINED BEFORE
         BE       LIST1A20          NO
         LCI      2
         LM,8     DDEF              YES, INDICATE DOUBLE DEF
         STM,8    *REFLIST
         STW,5    OUTBUF
         LW,5     INIDLEN
         SLS,5    -26
         AI,5     (LEN+3)*4
         CAL1,1   WRITLO
         LW,1     =104**24+BA(OUTBUF+1)
         MBS,0    BLANKS            BLANK OUT OUTBUF
         LW,5     BLANKS
LIST1A20 LC       INIDLEN
         LM,8     ID
         STM,8    IDLIST
         B        LIST1
*
LIST1B   EQU      %
         LI,8     ' '
         LW,7     INIDLEN
         SLS,7    -26
         CB,8     ID,7
         BNE      %+2
         BDR,7    %-2
         AI,7     1
         LW,4     IDINDEX
         BEZ      LIST1C
         LI,8     ','
         STB,8    *REFLIST,4
         AI,4     1
         LI,8     ' '
         STB,8    *REFLIST,4
         AI,4     1
         LW,3     INIDLEN
         SLS,3    -26
         AW,3     7
         AW,3     4
         CI,3     104-(2+LEN*4)
         BL       LIST1C
         STW,5    OUTBUF
         LW,5     INIDLEN
         SLS,5    -26
         AW,5     4
         AI,5     (LEN+1)*4
         CAL1,1   WRITLO
         LW,4     IDLIST+1          L/2ND WD OF ID
         CW,4     ASTER+1           C/2ND WORD OF ID W/ASTERISKS
         BNE      %+2               BNE; NOT UNDEFINED SYMBOL
         MTW,1    #UNDEFS           INC # OF UNDEFINED SYMBOLS
         LI,4     0                 CLEAR R4
         LW,5     BLANKS
         LW,1     =104**24+BA(OUTBUF+1)
         MBS,0    BLANKS            BLANK OUT OUTBUF
LIST1C   MTW,1    #REFS             INC # OF REFERENCES
         LI,2     0
         LB,8     ID,2
         STB,8    *REFLIST,4
         AI,2     1
         AI,4     1
         BDR,7    %-4
         STW,4    IDINDEX
         LI,8     0
         LH,9     OUTTYPE
         CI,9     ' U'
         BNE      %+3
         MTW,1    #UNUSEDS          INC # OF UNUSED REFERENCES
         LI,8     'U'               SET UNUSED FLAG
         LD,6     OUTTYPE           L/DECLARATION TYPE
         STH,5    6                 CLEAR 'U' FLAG
         CD,6     TYC+4             IS IT SREF
         BNE      %+4
         MTW,1    #SREFS            INC # OF SREFS
         SLS,8    8
         AI,8     'S'               SET SECONDARY REF FLAG
         AI,8     0
         BEZ      LIST1
         LI,9     '('
         STB,9    *REFLIST,4
         AI,4     1
         STB,8    *REFLIST,4
         AI,4     1
         SLS,8    -8
         AI,8     0
         BNEZ     %-4
         LI,8     ')'
         STB,8    *REFLIST,4
         AI,4     1
         STW,4    IDINDEX
         B        LIST1
LIST2    EQU      %
         STW,5    OUTBUF
         LW,5     INIDLEN
         SLS,5    -26
         AW,5     IDINDEX
         AI,5     (LEN+1)*4
         CAL1,1   WRITLO            LIST THE SORTED RECORD.
         LW,5     BLANKS            GET NEW VFC THING.
         LI,3     LEN
         STW,5    OUTBUF,3
         BDR,3    %-1
         STW,3    IDINDEX
         B        LIST1             REPEAT.
LIST2A   EQU      %
         LCI      LEN
         LM,8     OUTNAME
         STM,8    OUTBUF+1
         LI,3     26-LEN
         LW,8     BLANKS
         STW,8    IDLIST-1,3
         BDR,3    %-1
         STD,6    IDLIST
         LCI      4
         LM,8     ID
         STM,8    *REFLIST
         LI,8     16
         STW,8    IDINDEX
         B        LIST2
*
LIST3    EQU      %                 NAMES DON'T COMPARE.
         LW,8     IDLIST+1
         CW,8     TYC+9
         BE       LIST3B
         CW,8     ASTER+1           C/2ND WORD OF ID W/ASTERISKS
         BNE      LST3A10           BNE; NOT UNDEFINED SYMBOL
         MTW,1    #UNDEFS           INC # OF UNDEFINED SYMBOLS
LST3A10  STW,5    OUTBUF
         LW,5     INIDLEN
         SLS,5    -26
         AW,5     IDINDEX
         AI,5     (LEN+1)*4
         CAL1,1   WRITLO
LIST3B   LI,5     0
         STW,5    IDINDEX
         LI,9     0                 CLEAR R9; USE AS FLAG
         LW,8     #REFFLAG          L/# OF REFS TO CAUSE FLAGGING
         BEZ      LIST3K            BEZ; DON'T FLAG ALL SREFS-UNUSEDS
         LW,8     #REFS             L/# OF REFERENCES TO THIS SYMBOL
         CW,8     #REFFLAG          C/# W/MIN TO CAUSE FLAGGING
         BL       LIST3K            BLE; DON'T SUMMARIZE
         CW,8     #SREFS            C/# REFERENCES W/# SREFS
         BNE      %+2               BNE; NOT ALL SREFS
         AI,9     1                 +1; SET ALL-SREF FLAG
         CW,8     #UNUSEDS          C/# REFERENCES W/# UNUSED REFERENCES
         BNE      %+2               BNE; NOT ALL UNUSEDS
         AI,9     2                 +2 SET ALL-UNUSED FLAG
         AI,9     0                 +0
         BE       LIST3K            BEZ; NOT ALL-SREF OR ALL-UNUSED
         LW,1     =104**24+BA(OUTBUF+1)
         MBS,0    BLANKS            BLANK OUT OUTBUF
         LW,5     REFLIST           L/ADR OF START COL FOR REFERENCES
         SLS,5    2                 SHIFT; GET BA
         LI,4     TCALLR            L/ADR OF '---- ALL ARE'
         BAL,8    CONCAT            BAL; MOVE TO OUTBUF
         CI,9     1                 C/FLAGS W/1; ALL-SREF FLAG
         BAZ      LIST3F            BAZ; IT'S NOT AN ALL-SREF
         LI,4     TCSREF            L/ADR OF ' SREFS'
         BAL,8    CONCAT            BAL; MOVE AND ADD TO BUFFER
         CI,9     2                 C/FLAGS W/2; ALL-UNUSED FLAG
         BAZ      LIST3H            BAZ; NOT ALL-UNUSED SYMBOL
         LI,4     TCAND             L/ADR OF ' AND'
         BAL,8    CONCAT            BAL; MOVE AND ADD TO OUTBUF
LIST3F   LI,4     TCUNUSED          L/ADR OF ' UNUSED'
         BAL,8    CONCAT            BAL; MOVE AND ADD TO OUTBUF
LIST3H   AI,5     -BA(OUTBUF-1)     -BA OF BUFFER; G/BC
         CAL1,1   WRITLO            WRITE OUT OUTBUF
LIST3K   LI,8     0                 CLEAR R8
         STW,8    #REFS             0/#REFS
         STW,8    #SREFS            0/#SREFS
         STW,8    #UNUSEDS          0/#UNUSEDS
         LW,5     2SPACE            GET SET FOR DOUBLE SPACE
         LB,4     OUTNAME           NOW, CHECK FIRST CHAR'S
         CB,4     LISTNAME          FOR EQUALITY.
         BE       %+2                 EQUAL, DO DOUBLE SPACE
         CAL1,1   WRITEAST          UNEQUAL, WRITE ASTERISKS
         LCI      LEN
         LM,8     OUTPUT            MOVE NEW NAME
         STM,8    LISTNAME            TO NAME-SAVE FIELD,.
         STM,8    OUTBUF+1
         CD,6     TYC               IS IT A DEF...
         BNE      %+5
         LC       INIDLEN
         LM,8     ID
         STM,8    IDLIST
         B        LIST1
         LCI      2
         LM,8     LISTNAME+LEN
         STM,8    IDLIST
         B        LIST1A
*
SR2:ERR  EQU      %                 TROUBLE ON F:SR.
         STW,5    OUTBUF
         LW,5     INIDLEN
         SLS,5    -26
         AW,5     IDINDEX
         AI,5     (LEN+1)*4
         CAL1,1   WRITLO
         LW,5     #UNDEFS           L/# OF UNDEFINED SYMBOLS
         LI,7     TXUNSIZE-1        L/BTD TO END OF NUMBER IN BUFFER
         LI,6     5                 L/MAX # OF DIGITS TO CONVERT
LIST4C   LI,4     0                 CLEAR R4 FOR DIVIDE
         DW,4     =10               /10
         AI,4     '0'               +'0'
         STB,4    TXUNDEFS,7        S/DIGIT
         AI,7     -1                -1 TO BTD
         AI,5     0                 +0 TO QUOTIENT
         BEZ      %+2               BEZ; DONE WITH CONVERSION
         BDR,6    LIST4C            BDR; GET NEXT DIGIT
         M:WRITE  M:LO,(BUF,TXUNDEFS),(SIZE,TXUNSIZE),(WAIT)
         CAL1,1   CLOSLO            SAVE M:LO.
         MTW,0    SAVESR
         BNEZ     %+2               DO WE SAVE EO
         CAL1,1   DELSR             NO, DELETE IT
         LB,8     10                WHAT KIND OF TROUBLE...
         CI,8     6                 EOF...
         BE       LIST4               YES, QUIT.
         CI,8     5                 EOD...
         BE       LIST4               YES.
         LW,9     ='F:SR'           REPORT ANY OTHER ERROR
         LI,11    EXIT2             AND QUIT.
         B        COMN:ERR
LIST4    EQU      %
         CAL1,1   FPCLSLL           M:CLOSE M:LL,(SAVE)
         CAL1,9   1                 QUIT.
*
*
HDRMV    AI,5     TCHDR2-INPUT+1    G/DISP IN BUF + BUF ADR
         SLS,5    2                 G/BA OF DEST FIELD
CONCAT   LB,10    *4                L/BC OF SOURCE FIELD
         STB,10   5                 S/BC IN MBS DBL WD
         SLS,4    2                 SHIFT SOURCE ADR; G/BA
         MBS,4    1                 MOVE FIELD
         B        *8                RETURN
*
*
LISTCARD LI,14    1                 L/1; ALREADY-LISTED-FLAG
         XW,14    SILISTED          SET ALREADY-LISTED-FLAG
         BNEZ     *15               BNEZ; HAS BEEN LISTED; RETURN
         CAL1,2   PRINT             LIST M:SI FILENAME CARD ON M:LL
         B        *15               RETURN
         TITLE     '****        INTERMEDIATE LEVEL        ****'
*
*  REGISTER USAGE:
*    0 AND 3 ARE SET =4 FOR SUBROUTINE 'GET'.
*    4 IS SET =1.  (NUMBER OF DECL'S SO FAR  + 1).
*    ALL OTHERS ARE USED FOR TEMP STORAGE ONLY.
*
NEXTF    EQU       %                PREPARE FOR NEXT ROM.
         BAL,15   LISTCARD          LIST M:SI FILENAME CARD ON M:LL
         LI,1     30                L/30; # OF WDS IN INPUT BUFFER
         LW,2     BLANKS            L/BLANKS
         STW,2    INPUT-1,1         S/BLANKS IN INPUT BUFFER
         BDR,1    %-1               BDR
         STW,1    SILISTED          CLEAR ALREADY-LISTED-FLAG
         CAL1,1    READSI           READ A FILENAME CARD FROM M:SI.
         LW,7      INFILEN
         LB,8      INPUT,7          SEE IF IT'S
         CB,8      EIFILE,7           THE SAME FILE.
         BNE       NEXTF2           NO.
         BDR,7     %-3                YES.
         LI,7      X'20'            THE FILE SHOULD BE OPEN.
         CH,7      M:EI             IF IT ISN'T, WE HAD TROUBLES,
         BAZ       SKP:E              AND SHOULD SKIP THIS ROM.
         B         NEXTROM          WE'RE OKAY IF IT'S OPEN.
NEXTF2   EQU       %                NEW FILE.
         LI,7      X'20'            CLOSE
         CH,7      M:EI               OLD FILE
         BAZ       %+2                  IF
         CAL1,1    CLOSEI                 NECESSARY.
         LCI      2                 L/CC'S OF 2 FOR LM/STM
         LM,7     DEFACCN           L/DEFAULT ACCN
         STM,7    EIACCN+1          S/ACCN INTO M:EI OPEN FPT
         LI,7     0                 L/0; INDEX INTO FILE NAMES
NEXTF5   AI,7     1                 +1 TO FILE NAME INDEX
         LB,8     INPUT,7           L/INPUT CHAR
         CI,8     ' '               C/CHAR W/BLANK
         BE       NEXTF10           BE; END OF FID, NO ACCN
         CI,8     '.'               C/CHAR W/'.'
         BE       NEXTF10           BE; END OF FID, ACCN FOLLOWS
         STB,8    EIFILE,7          S/CHAR IN M:EI OPEN FPT (FID)
         CW,7     INFILEN           C/INDEX W/MAX
         BL       NEXTF5            BL; GET NEXT CHAR
NEXTF10  AI,7     -1                -1 TO INDEX; GET FID BC
         STB,7    EIFILE            S/BC IN OPEN FPT
         CI,8     '.'               C/CHAR W/'.'
         BNE      NEXTF30           BNE; NO ACCN
         LCI      2                 L/CC'S OF 2 FOR LM/STM
         LM,4     BLANKS            L/BLANKS
         STM,4    EIACCN+1          S/BLANKS INTO M:EI ACCN FIELD
         AI,7     2                 +2 TO CHAR INDEX
         LI,6     -8                L/-8; -MAX LENGTH OF ACCN
NEXTF20  CW,7     INFILEN           C/INDEX W/MAX
         BG       NEXTF30           BG; END OF INPUT FIELD
         LB,8     INPUT,7           L/CHAR
         STB,8    EIACCN+3,6        S/CHAR IN M:EI OPEN FPT ACCN
         AI,7     1                 +1 TO CHAR INDEX
         BIR,6    NEXTF20           BIR; GET NEXT CHAR
NEXTF30  CAL1,1    OPENEI           NOW OPEN THE NEW FILE.
NEXTROM  EQU       %                NEW ROM, PERFORM SETUP.
         LC        INIDLEN          MOVE ID
         LM,0      *INID              FROM INPUT CARD
         STM,0     ID                   TO OUTPUT AREA.
         LI,2     X'20'             L/X'20'; CHECK ORG IN M:EI
         LI,3     X'F0'             L/X'F0'; MASK
         CS,2     M:EI+5            C/M:EI ORG W/2 (KEYED)
         BE       LMN               BE; PROBABLY PROCESSING LOAD MODULE
         LW,8     =X'3CFF0000'      SET UP DUMMY (-1)TH CARD
         STW,8     BFEI               CONTROL BYTES.
         LW,13     BLANKS           CLEAR
         LI,6      LEN*MAX-1          NAMES
         STW,13    NAMES,6              TO
         BDR,6     %-1                    BLANK.
         LI,8      0                MAKE ZEROTH DECL (STANDARD CSECT)
         STW,8     NAMES              BE NULL.
         LI,0      4
         LI,3      4                SET LAST-BYTE-GOTTEN-FROM-CARD.
         LI,4      1                SAY NO DECLARATIONS YET THIS ROM.
         B         OUT              NOW GO SCAN THE ROM.
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
ROMEND   EQU       %                COME HERE WHEN ROM IS FINISHED.
         LI,2      0                SET CURRENT DECL TO ZEROTH.
         LI,3      0                SAME THING, BUT COUNT BY LEN NOT 1.
         MTW,0     NAMES            SKIP ZEROTH DECL IF NULL.
         BEZ       ROMEND1            (STANDARD CONTROL SECTION).
ROMEND0  EQU       %
         LW,7      TYPES,2
         CW,7      FLAGCS           DO WE OUTPUT THIS DECL TYPE...
         BG        ROMEND1            NO.
         LD,0      TYC,7            GET TEXT OF TYPE.
         STD,0     OUTTYPE          PUT IT INTO OUTPUT RECORD.
         LW,8      USEDS,2          IS IT UNUSED...
         BNEZ      %+5                NO.
         MTW,0     FLAGUN             YES.  ARE WE OUTPUTTING UNUSEDS...
         BEZ       ROMEND1            NO.
         LI,1      ' U'             1= 'UNUSED' INDICATOR.
         STH,1     OUTTYPE            YES.  SET UNUSED MARKER.
         LCI       LEN
         LM,5      NAMES,3          GET NAME HOR CSECT LENGTH).
         STM,5     OUTNAME          PUT IT INTO OUTPUT RECORD.
         CAL1,1    WRITSR           WRITE RECORD TO F:SR.
         MTW,0     FLAGSO
         BEZ       ROMEND1          ALSO TO M:SO
         CAL1,1    WRITSO             IF FLAG IS SET.
ROMEND1  EQU       %
         AI,2      1                BUMP INDEX.
         AI,3      LEN              BUMP NAME INDEX.
         CW,2      4                ARE WE DONE...
         BL        ROMEND0            NOT YET.
         B         NEXTF              YES.  GO DO NEXT ROM.
         PAGE
LMN      M:READ   M:EI,(BUF,BFEI),(SIZE,48),(KEY,TCHEAD),(WAIT)
         LB,1     BFEI+1            L/SEVERITY LEVEL
         AND,1    =X'F'             MASK
         LI,0     '  '              L/TWO BLANKS
         AI,1     0                 +0 TO SEV LEV
         BE       %+2               BEZ; SKIP NEXT LINE
         LI,0     '* '              L/'* '; FLAG NON-ZERO SEV LEV
         LB,1     TXHEX,1           L/EBCDIC HEX FOR SEV LEV
         OR,1     0                 OR IN BLANKS OR * AND BLANK
         STH,1    *SEVLEVAD         S/SEV LEV INTO LISTING BUFFER
         M:READ   M:EI,(KEY,TCTREE),(WAIT)
         MTB,1    BFEI+1            INC BC ON SEG NAME
         LB,1     BFEI+1            L/BC OF ROOT SEGMENT
         LI,0     0                 L/0; REF/DEF STACK CODE
         STB,0    BFEI+1,1          S/0 IN LAST BYTE OF SEG NAME
         LH,15    BFEI+7            L/REF/DEF STK SIZE (WDS)
         CI,15    LEN*MAX           C/SIZE W/BUFFER SIZE
         BG       LMN900            B; BUF TOO SMALL; ERROR
         AI,15    NAMES             +BUFFER ADR; G/ADR OF 1ST WD AFTER END
         M:READ   M:EI,(BUF,NAMES),(SIZE,LEN*MAX*4),(KEY,BFEI+1),(WAIT)
         LI,1     NAMES             L/NAMES (BUF ADR); USE AS INDEX
LMN050   LW,2     0,1               L/WD 0 OF ENTRY
         LB,13    2                 L/SIZE (WDS) OF ENTRY
         LH,2     2                 RIGHT JUSTIFY ENTRY TYPE
         AND,2    =X'F'             & TYPE W/X'F'
         LB,2     XLTYPE,2          L/INDEX INTO TYC TABLE
         BEZ      LMN200            BEZ; NOT INTERESTED IN THIS TYPE
         LD,2     TYC-2,2           L/TEXT FOR TYPE (DEF, ETC.)
         STD,2    OUTTYPE           S/IN OUTPUT RECORD
         LI,2     LEN               L/NAME LENGTH
         LW,3     BLANKS            L/BLANKS
         STW,3    OUTNAME-1,2       S/BLANKS IN OUTNAME
         BDR,2    %-1               BDR
         LI,2     0                 L/0; INDEX INTO OUTNAME
         LI,3     12                L/12; INDEX INTO NAME IN ENTRY
         LB,4     *1,3              L/BC OF NAME
LMN100   AI,3     1                 +1 TO NAME INDEX
         LB,14    *1,3              L/BYTE OF NAME
         STB,14   OUTNAME,2         S/BYTE IN OUTNAME
         AI,2     1                 +1 TO OUTNAME INDEX
         BDR,4    LMN100            BDR; GET NEXT CHAR
         CAL1,1   WRITSR            WRITE RECORD TO F:SR
         LW,4     FLAGSO            L/SO LISTING FLAG
         BEZ      %+2               BEZ; DON'T LIST
         CAL1,1   WRITSO            WRITE RECORD TO M:SO
LMN200   AW,1     13                +ENTRY SIZE TO ENTRY ADR
         CW,1     15                C/ADR W/END ADR
         BL       LMN050            BL; GET NEXT ENTRY
         B        NEXTF             B; GET NEXT FILE
LMN900   CAL1,1   CLOSEI            CLOSE M:EI
         LI,9     NEXTF             L/RETURN ADR
         BAL,8    COMN:E            B; PRINT MESS, GO TO RETURN
         TEXTC    '****    REF/DEF STACK LARGER THAN BUFFER'
         TITLE     '****            LOWEST LEVEL            ****'
*
*  REGISTER USAGE:
*  0  IS NUMBER OF GOOD BYTES IN CURRENT CARD.
*  1  IS CURRENT BYTE.
*  2  IS # OF BYTES TO 'IGNORE'.
*        DECLARATION TYPE.
*        FLAG USED DURING CONVERSION OF CSECT/DSECT LENGTH.
*  3  IS POINTER TO CURRENT BYTE WITHIN CARD.
*  4  IS CURRENT # OF DECLARATIONS PLUS 1.
*  5  IS TEMP STORAGE FOR TEXTC COUNTS > 16.
*        EBCDIC FOR BYTE OF CSECT/DSECT LENGTH.
*  6  IS TEXTC COUNT.
*        INDEX FOR PICKING SUB-ROUTINE BASED ON BYTE TYPE.
*        ACCUMULATOR FOR CSECT/DSECT LENGTH.
*  7  IS USED AS TEMP STORAGE OF VARIOUS KINDS.
*  8  IS LINK TO 'USED' AND 'TEXT'.
*  9  IS LINK TO 'IGNORE'.
*  10 IS LINK TO 'GET'.
*  11 IS HIDING PLACE FOR CURRENT DECL # WHEN STANDARD CSECT IS FOUND.
*        COUNT REGISTER FOR CSECT/DSECT LENGTH CONVERSION.
*  12-15 ARE NEVER USED.
         PAGE
*
*    THESE TABLES ARE USED BY 'OUT' TO CHOOSE WHICH ROUTINE TO GO TO.
*    TOP BYTE OF OUTTAB2 IS USED AS # OF BYTES TO IGNORE OR DECL TYPE.
*
OUTTAB   EQU       %-1              TABLE OF CONTROL BYTES:
         GEN,8,24  X'14',ILL:E 14-3F  **
         GEN,8,24  X'40',#40   40-4F LOAD ABS :SKIP N.
         GEN,8,24  X'50',#50   50-5F LOAD LONG:DECL/FREF; SKIP4.
         GEN,8,24  X'60',ILL:E 60-7F  **
         GEN,8,24  X'80',#80   80-BF LOADSHORT:SKIP4 BUT MARK USE.
         GEN,8,24  X'C0',IGNORE C0-CFLOADSHORT:SKIP4.
OUTTAB2  EQU       %
         GEN,8,24  0,OUT          00  PADDING :.
         GEN,8,24  0,ILL:E        01  **
         GEN,8,24  0,ILL:E        02  **
         GEN,8,24  0,#DECL        03 DECL DEF :TEXTC.
         GEN,8,24  0,INN          04  ORIGIN  :EXPRESSION.
         GEN,8,24  1,#DECL        05 DECL REF :TEXTC.
         GEN,8,24  2,#DECL        06 DECL SREF:TEXTC.
         GEN,8,24  2,IGNIN        07  FIELD   :SKIP2; EXPRESSION.
         GEN,8,24  2,IGNIN        08 DEFN FREF:SKIP2; EXPRESSION.
         GEN,8,24  3,#DSEC        09 DECL DSEC:DECL#;SIZE.
         GEN,8,24  0,USDIN        0A DEFN DEF :DECL#; EXPRESSION.
         GEN,8,24  4,#CSEC0       0B DECL CSEC:SIZE.
         GEN,8,24  4,#CSEC        0C DECL CSEC:SIZE.
         GEN,8,24  0,INN          0D  START   :EXPRESSION.
         GEN,8,24  1,#EOM         0E  ROMEND  :SKIP1; ---> FINISHED.
         GEN,8,24  2,IGNORE       0F  REPEAT  :SKIP2.
         GEN,8,24  2,IGNIN        10 DF/H FREF:SKIP2; EXPRESSION.
         GEN,8,24  1,#11          11DBUG EXT :SKIP1; DECL#.
         GEN,8,24  1,#12          12 DBUG INT :SKIP1; TEXTC; EXPRESSION.
         GEN,8,24  2,#13          13 DBUG UND :TEXTC; SKIP2.
         PAGE
*
*    -OUT- SCANS CONTROL BYTES OUTSIDE EXPRESSIONS.
OUT      BAL,10    GET              GET A BYTE.
         LI,9      OUT              SET UP RETURN.
         LI,8      IGNORE           MAKE IT EASIER TO SKIP THINGS.
         LI,2      4                SET TO SKIP 4.
         LI,6      6
         LW,7      OUTTAB,6         LOOK UP THE BYTE.
         CB,1      7                IS THIS THE PROPER RANGE...
         BGE       0,7                YES.
         BDR,6     %-3                NO.
         LW,7      OUTTAB2,1        IF BYTE IS SMALL,
         LB,2      7                  GET VALUE FOR SKIP OR DECLTYPE
         B         0,7                  AND GO TO ROUTINE.
*
#80      AI,1      -X'80'           REMOVE TOP BIT;
         B         USED1            REST IS DECL#.  (SKIP NEXT 4)
*
#50      SLS,1     -2               MAKE INTO X'14'-X'17'
         LW,10     #50A-X'14',1     WHERE TO GO AFTER -GET-.
         LB,2      10               HOW MANY TO IGNORE.
         EXU       #50B-X'14',1     IGNORE FOR FREF;MARK USE FOR DECL.
#50B     B         GET
         B         IGNORE
         B         GET
         B         IGNORE
#50A     GEN,8,24  4,USED2     50-53 LOAD LONG; 2-BYTE DECL.
         GEN,8,24  6,0         54-57 LOAD LONG; 2-BYTE FREF.
         GEN,8,24  4,USED1     58-5B LOAD LONG; 1-BYTE DECL.
         GEN,8,24  5,0         5C-5F LOAD LONG; 1-BYTE FREF.
*
#40      LW,2      1
         AI,2      -X'40'
         BNEZ      IGNORE           1-15 BYTES; SKIP.
         LI,2      16               16 BYTES; SAY SO
         B         IGNORE             AND SKIP.
         PAGE
*
#13      LI,7      -LEN             SKIP TEXTC,
         B         TEXT               THEN IGNORE 2.
*
#12      BAL,9     IGNORE           SKIP 1.
         LI,7      -LEN
         BAL,8     TEXT             SKIP TEXTC
         B         INN              EXPRESSION FOLLOWS.
*
#11      BAL,9     IGNORE           SKIP 1.
         BAL,8     USED             MARK DECL# USED.
         B         OUT
*
#EOM     BAL,10   GET               G/LAST BYTE; SEV LEV
         CW,0      3                END OF CARD...
         BNE       ILL:E              NO, ERROR.
         LB,0      BFEI
         CI,0      X'1C'            LAST CARD...
         BNE       ILL:E              NO, ERROR.
         LI,0     '  '              L/TWO BLANKS
         AI,1     0                 +0 TO SEV LEV
         BE       %+2               BEZ; SKIP NEXT LINE
         LI,0     '* '              L/'* '; FLAG NON-ZERO SEV LEV
         LB,1     TXHEX,1           L/EBCDIC HEX FOR SEV LEV
         OR,1     0                 OR IN BLANKS OR * AND BLANK
         STH,1    *SEVLEVAD         S/SEV LEV INTO LISTING BUFFER
         B         ROMEND           FINISHED; GO PROCESS ROM.
*
#DECL    CI,4      MAX              TOO MANY DECLARATIONS...
         BGE       OFL:E              YES.  ERROR.
         STW,2     TYPES,4          INDICATE DECLTYPE.
         LI,7      0
         STW,7     USEDS,4          MARK IT UNUSED.
         LW,7      4
         MI,7      LEN              GET WA(TEXTC FIELD).
         BAL,8     TEXT             BUILD NAME.
         AI,4      1                BUMP DECL COUNTER.
         B         OUT
         PAGE
*
#CSEC0   LI,11     0                STANDARD CSECT
         XW,11     4                  IS DECL #0.
         B         #CSEC
#DSEC    BAL,8     USED             DSECT STARTS WITH DECL#.
#CSEC    CI,4      MAX              TOO MANY DECLARATIONS...
         BGE       OFL:E              YES, ERROR.
         STW,2     TYPES,4          INDICATE DECLTYPE.
         LI,7      0
         STW,7     USEDS,4          MARK IT UNUSED.
         LW,7      4
         MI,7      LEN              GET WA(NAME FIELD).
         AI,4      1                BUMP DECL COUNTER.
         CI,4      1                WAS THIS THE STANDARD CSECT...
         BNE       %+2                NO.
         LW,4      11                 YES, RESTORE REAL COUNTER.
         SLS,7     2                GET BA(NAME FIELD).
         BAL,10    GET              GET FIRST NAME BYTE.
         AND,1     =X'F'            CLEAR OFF PP BITS ON FIRST LENGTH.
         LW,6      1
         BAL,10    GET              GET SECOND BYTE.
         SLS,6     8
         OR,6      1
         BAL,10    GET              GET THIRD BYTE.
         SLS,6     8
         OR,6      1                6 CONTAINS SECTION SIZE (BYTES).
         SLS,6     2                6(4-23) CONTAINS SIZE IN WORDS.
         LI,11     5                CONVERT 5 BYTES.
         LI,2      0                SET NO-SIG-DIGITS-YET.
SETHEX   SLS,6     4                6(4-7) IS CURRENT DIGIT.
         AI,7      1                BUMP STORE-COUNTER.
         LB,5      6
         LB,5      HEXES,5          5 IS EBCDIC BYTE.
         CB,5      HEXES            IS IT ZERO...
         BNE       %+3                NO.  USE IT.
         CI,2      0                  YES.  ANY SIG DIGITS YET...
         BE        %+3                  NO.  DON'T USE IT.
         LI,2      X'100'           SET SIG DIGIT FLAG.
         STB,5     NAMES,7          STORE DIGIT.
         STB,2     6                CLEAR OUT DIGIT.
         BDR,11    SETHEX           REPEAT.
         B         OUT              FINISHED.
*    NOTE SUPERSECRET HORRIBLE KLUDGE USED IN THE FOLLOWING STATEMENT
*    TO GET NUMBERS TO SORT BEFORE LETTERS IN SECTION LENGTHS.
HEXES    TEXT      '          ABCDEF'
         PAGE
*
*    -INN- SCANS CONTROL BYTES INSIDE EXPRESSIONS.
USDIN    BAL,8     USED             MARK USAGE OF DECL #.
         B         %+2
IGNIN    BAL,9     IGNORE           SKIP SOME BYTES.
*
INN      BAL,10    GET              GET CONTROL BYTE.
         CI,1      X'40'
         BGE       ILL:E       40-FF  **
         LI,8      INN              MAKE IT EASIER
         LI,9      INN                TO GET BACK.
         LI,2      2                SET TO SKIP2.
         CI,1      X'20'
         BL        ##10
         SLS,1     -2               CONVERT 20-3F INTO 8-F; IGNORE RR.
         B         ##20-8,1         DO THE RIGHT THING.
##20     B         USED        20-23  +DECL:DECL#.
         B         IGNORE      24-27  +FREF:SKIP2.
         B         USED        28-2B  -DECL:DECL#.
         B         IGNORE      2C-2F  -FREF:SKIP2.
         B         INN         30-33 CHGRES:.
         B         INN         34-37 +ASECT:.
         B         INN         38-3C -ASECT:.
         B         ILL:E       3C-3F  **  (LOADER THINKS THIS IS -ASECT)
*
##10     LI,2      4                MAY WANT TO SKIP 4 LATER.
         CI,1      X'03'
         BGE       ILL:E       03-1F  **
         B         ##03,1
##03     B         INN           00  PADDING :.
         B         IGNORE        01 + ABSVAL :SKIP4.
         B         OUT           02  EXPR END:.   ---> OUT.
         PAGE
*
*  UTILITY SUBROUTINES.
GET      EQU       %                GETS THE NEXT BYTE FROM ROM.
         CW,3      0                END OF CARD...
         BL        GETS               NO.
         LB,1      BFEI               YES.
         CI,1      X'3C'            IS THIS A MIDDLE-CARD...
         BNE       ILL:E              NO.  BAD NEWS.
         LH,0      BFEI
         AI,0      1                GET NEXT SEQUENCE NUMBER.
         CAL1,1    READEI           READ THE NEXT CARD.
         LI,1      1
         CB,0      BFEI,1           IS SEQUENCE OKAY...
         BNE       ILL:E              NO.  BAD NEWS.
         LB,1      BFEI             CHECK CARD ID.
         CI,1      X'3C'            IS IT MIDDLE-CARD...
         BE        %+3                YES, OK.
         CI,1      X'1C'              NO, IS IT END-CARD...
         BNE       ILL:E                NO.  BAD NEWS.
         LI,1      3
         LB,0      BFEI,1           GET BYTE COUNT.
         LI,3      4                GET STARTING BYTE NUMBER.
         B         GET              RE-TRY.
GETS     LB,1      BFEI,3           GET A BYTE
         AI,3      1                  BUMP BYTE COUNTER
         B         *10                  AND RETURN.
*
         BAL,10    GET              IGNORE A BYTE.
IGNORE   AI,2      -1               COUNT DOWN # TO IGNORE.
         BGEZ      %-2
         B         *9               FINISHED.
*
USED     EQU       %                RECORD A DECLARATION AS USED.
         BAL,10    GET              GET FIRST BYTE.
         CI,4      256              IF NOT 256 YET,
         BLE       USED1              GET ONLY ONE.
USED2    LW,7      1                SAVE FIRST BYTE
         BAL,10    GET                AND GET ANOTHER.
         SLS,7     8
         AW,1      7                COLLECT ENTIRE NUMBER.
USED1    CW,1      4                IF GREATER THAN NUMBER SO FAR,
         BGE       ILL:E              BAD NEWS.
         MTW,1     USEDS,1          MARK IT USED,
         B         *8                 AND EXIT.
*                  ENTERED WITH REG 7 = WORD INDEX INTO 'NAMES'.
TEXT     EQU       %                GET A TEXT STRING.
         BAL,10    GET              GET BYTE COUNT.
         LW,6      1
         BEZ       ILL:E            ZERO BYTE COUNT IS EVIL.
         SLS,7     2                MAKE IT A BYTE INDEX.
         CI,6      LEN*4            TREAT STRINGS SPECIALLY
         BG        TEXT2              IF LONGER THAN FIELDSIZE.
         BAL,10    GET              GET A CHARACTER.
         STB,1     NAMES,7          PUT IT AWAY.
         AI,7      1                BUMP POINTER.
         BDR,6     %-3              CONTINUE.
         B         *8               FINISHED.
TEXT2    LW,5      6                SAVE COUNT.
         LI,6      LEN*4            DO AS MANY AS FIT FIRST.
         BAL,10    GET
         STB,1     NAMES,7
         AI,7      1
         BDR,6     %-3
         AI,5      -LEN*4           NOW DO THE REST.
         BAL,10    GET
         BDR,5     %-1              JUST IGNORE THEM THIS TIME.
         B         *8               FINISHED
         END       BEGIN
