         PCC      0
         SYSTEM   SIG7
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         REF      M:SI,M:EI,M:EO,M:LO,M:DO,M:BI
         REF      F:SORTIN,F:SORTOUT
         REF      J:JIT
         REF      M:BLK
*************************************************************************
*        FPTS
*************************************************************************
         CSECT    0
PROMPT   GEN,8,24 X'2C','>'
READSI   GEN,8,24 X'10',M:SI
         DATA     X'F0000000'
         DATA     SIERR,SIERR
         DATA     BUFF
         DATA     80
OPENEI   GEN,8,24 X'14',M:EI
EIASN    DATA     X'FF000001'
         DATA     EIERR
         DATA     EIERR
         DATA     COMBUF
         DATA     140
         DATA     10
         DATA     1                 CONSEC
         DATA     1                 SEQUEN
         DATA     1                 IN
         DATA     X'01000808'
EINAME   DATA     '    ','    ','    ','    '
         DATA     '    ','    ','    ','    '
         DATA     X'02000002'
EIACCT   DATA     '    ','    '
         DATA     X'07010001'
EISN     DATA     0
OPNEINXT GEN,8,24 X'14',M:EI
         DATA     X'FF000401'
         DATA     EIERR,EIERR
         DATA     COMBUF
         DATA     140
         DATA     10
         DATA     1
         DATA     1
         DATA     1
    DATA   X'07010001'
EINXTSN DATA 0
CLOSEEI  GEN,8,24 X'15',M:EI
         DATA     X'80000000'
         DATA     2
OPENDB   GEN,8,24 X'14',M:EO
         DATA     X'F74A0001'
         DATA     DBKERR,DBKERR
         DATA     BUFF
         DATA     140
DBORG    DATA     0
DBACC    DATA     0
DBMODE   DATA     0
DBSAVE   DATA     2                 SAVE
         DATA     X'00000017'       KEYM
         DATA     0                 BTD
         DATA     X'01000303'
DBNAME   DATA     '    ','    ','    '
         DATA     X'02000002'
DBACCT   DATA     '    ','    '
         DATA     X'03010002'
DBPASS   DATA     '    ','    '
CLOSEDB  GEN,8,24 X'15',M:EO
         DATA     X'80000000'
         DATA     2
WRITDO   GEN,8,24 X'11',M:DO
         DATA     X'30000000'
         PZE      *15
         PZE      *14
READEI   GEN,8,24 X'10',M:EI
         DATA     X'F0000010'
         DATA     RDEIERR
         DATA     RDEIERR
         DATA     COMBUF
         DATA     140
WRITEDB  GEN,8,24 X'11',M:EO
         DATA     X'FC000020'       NEWKEY
         DATA     WRDBER,WRDBER
         DATA     BUFF+9            SKIP LEADING BLANKS
         DATA     104
         DATA     KEYBUF            KEYBUFFER
         DATA     2
OPENBI   GEN,8,24 X'14',M:BI
         DATA     X'F0000001'
         DATA     BIERR
         DATA     BIERR
         DATA     EINAME
         DATA     8                 RECL
         DATA     X'01010303'
         TEXTC    'EXDATA'
         DATA     '    '
READBI   GEN,8,24 X'10',M:BI
         DATA     X'C4000010'
         DATA     RDBIERR,RDBIERR
BIBTD    DATA     1                 BTD
CLOSEBI  GEN,8,24 X'15',M:BI
         DATA     X'80000000'
         DATA     2                 SAVE
READDBK  GEN,8,24 X'10',M:EO
         DATA     X'F8000010'       WAIT
         DATA     DBKERR,DBKERR     ERR,ABN
         DATA     BUFF
         DATA     140               RECL
         DATA     KEYBUF
READDBS  GEN,8,24 X'10',M:EO
         DATA     X'F0000010'       WAIT
         DATA     DBSERR,DBSERR
         DATA     BUFF
         DATA     140
OPENTEMP GEN,8,24 X'14',F:SORTIN
         DATA     X'F9400001'
         DATA     ERROR,ERROR
         DATA     BUFF
         DATA     140               RECL
         DATA     10                TRIES
         DATA     2                 OUT
         DATA     2                 SAVE
         DATA     X'01010303'
         GEN,8,24 X'08','SOR'
         GEN,24,8 'TIN',0
         DATA     0
WRITEMP  GEN,8,24 X'11',F:SORTIN
         DATA     X'F0000000'
         DATA     ERROR,ERROR
         DATA     BUFF
         PZE      *R0               BUFFER SIZE
CLOSTEMP GEN,8,24 X'15',F:SORTIN
         DATA     X'80000000'
         DATA     2
GETCP    GEN,8,24 X'0C',1
SORTLINK GEN,8,24 X'02',X'02'
         TEXTC    'SORT'
         TEXT     ':SYS    '
OPENSORT GEN,8,24 X'14',F:SORTOUT
         DATA     X'F1400001'
         DATA     ERROR
         DATA     ERROR
         DATA     BUFF
         DATA     140
         DATA     1                 IN
         DATA     1                 REL
         DATA     X'01010303'
         GEN,8,24 X'08','SOR'
         DATA     'TOUT'
         DATA     0
PREOPSRT GEN,8,24 X'14',F:SORTOUT
         DATA     X'01400001'
         DATA     1                 IN
         DATA     2                 SAVE
         DATA     X'01010303'
         GEN,8,24 X'08','SOR'
         DATA     'TOUT'
         DATA     0
READSORT GEN,8,24 X'10',F:SORTOUT
         DATA     X'C0000010'
         DATA     SORTERR,SORTERR
WRITECOM GEN,8,24 X'11',M:LO
         DATA     X'F0000000'
         DATA     ERROR,ERROR
         DATA     BUFF+1
         DATA     104               BYTE COUNT
UPSPACE  GEN,8,24 X'11',M:LO
         DATA     X'F0000000'
         DATA     ERROR,ERROR
         DATA     BLANKS
         DATA     1
ASKLINE  GEN,8,24 X'11',M:LO
         DATA     X'F0000000'
         DATA     ERROR,ERROR
         DATA     ASKBUFF
         DATA     68
DOOUT    GEN,8,24 X'11',M:DO
         DATA     X'F0000000'
         DATA     ERROR,ERROR
         PZE      *R1               BUFFER
         PZE      *R0               SIZE
MOVE     GEN,8,24 X'0E',M:EO
         DATA     X'F8000000'
         DATA     MOVERR,MOVERR
         DATA     F:SORTIN
         DATA     BUFF
         DATA     140
CLOSESORT GEN,8,24 X'15',F:SORTOUT
         DATA     X'80000000'
         DATA     1                 REL
SETDCB   GEN,8,24 X'06',F:SORTOUT
         DATA     X'C0000000'
         DATA     0,0               RESET ERR AND ABN
PAGE     GEN,8,24 X'04',M:LO
XCON     GEN,8,24 X'19',XITCON
OTMPREL  GEN,8,24 X'14',F:SORTIN
         DATA     X'01400001'
         DATA     4                 INOUT
         DATA     1                 REL
         DATA     X'01010303'
         GEN,8,24 X'08','SOR'
         GEN,24,8 'TIN',0
         DATA     0
CTMPREL  GEN,8,24 X'15',F:SORTIN
         DATA     X'80000000'
         DATA     1                 REL
SETTEMP  GEN,8,24 X'06',F:SORTIN
         DATA     X'C0000000'
         DATA     0,0
CMDWRITE GEN,8,24 X'11',M:DO
         DATA     X'F0000000'
         DATA     ERROR,ERROR
         DATA     BUFF
         PZE      *R3
PAGCNT   GEN,8,24 X'24',M:LO
         DATA     X'80000000'
         DATA     100
HEADER   GEN,8,24 X'26',M:LO
         DATA     X'C0000000'
         DATA     HEADBUF
         DATA     1
TOP      GEN,8,24 X'25',M:LO
         DATA     X'C0000000'
         DATA     1,2
NLINES   GEN,8,24 X'2A',M:LO
DERDDBK  GEN,8,24 X'10',M:EO
         DATA     X'F8000010'
         DATA     DEDBKER,DEDBKER
         DATA     BUFF
         DATA     140
         DATA     KEYBUF
DERDDBS  GEN,8,24 X'10',M:EO
         DATA     X'F0000010'
         DATA     DEDBSER,DEDBSER
         DATA     BUFF
         DATA     140
DELREC   GEN,8,24 X'0D',M:EO
         DATA     0
MODWRITE GEN,8,24 X'11',M:DO
         DATA     X'F0000000'
         DATA     ERROR,ERROR
         DATA     MODNAME
         DATA     8
LINCAL   GEN,8,24 X'20',M:LO
         DATA     X'80000000'
LINES    DATA     0
WRENTDB  GEN,8,24 X'11',M:EO
         DATA     X'FC000020'       NEWKEY
         DATA     WRDBER,WRDBER
         DATA     COMBUF
         DATA     104
         DATA     KEYBUF
         DATA     0                 BTD
WRTBLK   GEN,8,24 X'11',M:BLK
         DATA     X'F0000010'
         DATA     ERROR,ERROR
         DATA     BLOCK
         DATA     1200
BLKOPN   GEN,8,24 X'14',M:BLK
         DATA     X'C1040043'
         DATA     ERROR,ERROR
         DATA     2                 OUT
         DATA     '9T'
         DATA     X'07010101'
BLKSN    DATA     0
BLKCLS   GEN,8,24 X'15',M:BLK
         DATA     X'80000000'
         DATA     2                 SAVE
CLOSELO  GEN,8,24  X'15',M:LO
         DATA      X'80000000'
         DATA      2
         PAGE
*****************************************************************************
*        DATA AND BUFFERS
*************************************************************************
         BOUND    8
FIRST    DATA     0,0,0,0,0,0,0,0,0,0
         DATA     0,0,0,0,0,0,0,0,0,0
LAST     DATA     0,0,0,0,0,0,0,0,0,0
         DATA     0,0,0,0,0,0,0,0,0,0
JLNEMBS  DATA     BA(LINESAVE)
         GEN,8,24 X'04',BA(BUFF)+118
LINEMBS  DATA     BA(BUFF)+6
         GEN,8,24 X'04',BA(BUFF)+118
MODMBS   DATA     BA(MODNAME)
         GEN,8,24 X'08',BA(BUFF)+122
ENTMDMBS DATA     BA(MODNAME)
         GEN,8,24 X'08',BA(COMBUF)+84
ENTLNMBS DATA     BA(BUFF)+6
         GEN,8,24 X'04',BA(COMBUF)+80
BLANKS   DATA     '    ','    '
GLOS     TEXT     'GLOSSARY'
EXDATA   TEXT     'EXDATA'
EH@      TEXT     'EH @    '        ALL DOUBLEWORDS ABOVE
         DATA     0
KEYBUF   DATA     0
MODNAME  DATA     0,0
SEQ#     DATA     0
         DATA     X'C1'             BUFFER FOR SORT PARAMETERS
SORTPARM DATA     0,0               THIS MUST BE ON DOUBLEWORD
         DATA     '    '
COMPAGE  DATA     0
SORTDATA TEXT     'M 104   '
SORTBL DATA       0,0
         TEXT     'CODE    '
         TEXT     'MODULE  '
         TEXT     'NAME    '
         TEXT     'LINE#   '
SORTBLSZ EQU      4
PARMTBL  DATA     0,0
         TEXT     '0001003A'
         TEXT     '0085008A'
         TEXT     '0093012A'
         TEXT     '0081004A'
JIT      TEXT     'JIT'
ALL      TEXT     'ALL'
END      TEXT     'END'
NAME     TEXT     'NAME'
DO       DATA     '*DO*'
FIN      DATA     '*FIN'
ENTR     DATA     'ENTR'
Y:       DATA     'Y:  '
NAME:    DATA     'NAME',':   '
HEDFLAGS DATA     0
TYPHDFLG DATA     X'00200000'
MODHDFLG DATA     X'00100000'
NAMHDFLG DATA     X'00080000'
LINHDFLG DATA     X'00040000'       THIS TABLE PARALLEL TO SORTBL
FORMBITS DATA     X'03800000'
CFORBIT  DATA     X'02000000'
MFORBIT  DATA     X'01000000'
NFORBIT  DATA     X'00800000'
ENTRFLG  DATA     X'00400000'
EXDATBIT EQU      %
Y8       DATA     X'80000000'
SOMEBIT  EQU      %
Y4       DATA     X'40000000'
GLOSFLG  EQU      %
Y2       DATA     X'20000000'
ORDERFLG EQU      %
Y1       DATA     X'10000000'
DOFINFLG EQU      %
Y08      DATA     X'08000000'
FROMTOFLG EQU     %
Y04      DATA     X'04000000'
Y02      DATA     X'02000000'
Y01      DATA     X'01000000'
Y008     DATA     X'00800000'
YC       DATA     X'C0000000'
ZERO     EQU      %
XF0      DATA     X'000000F0'
XFFFF    DATA     X'0000FFFF'
XF       DATA     X'0000000F'
Y0D      DATA     X'0D000000'
BLKFLG   DATA     X'00020000'
GOTEBIT  DATA     X'00010000'
FLAGS    DATA     ALLBITS           ALL CODES AND MODS DEFAULT
SAVETYPE DATA     0
SAVESEQ  DATA     0
LINESAVE DATA     '   0'
SEQCLR   GEN,8,24 (CODSIZ+1)**2,BA(SEQBUF)
NAMECLR  GEN,8,24 (3*(CODSIZ+1))**2,BA(NAMEBUF)
EINAMCLR GEN,8,24 X'09',BA(EINAME)
EIACTCLR GEN,8,24 X'08',BA(EIACCT)
DBNAMCLR GEN,8,24 X'09',BA(DBNAME)
DBACTCLR GEN,8,24 X'08',BA(DBACCT)
DBPASCLR GEN,8,24 X'08',BA(DBPASS)
FIRSTCLR GEN,8,24 160,BA(FIRST)
BLKFILL  GEN,8,24 36,BA(BUFF+20)
HEADCLR  GEN,8,24 92,BA(HEADBUF+1)
COMBLK   GEN,8,24 104,BA(COMBUF)
BLKCOMP  GEN,8,24 76,BA(BUFF+1)
BLKCLR   EQU      %-1
         GEN,8,24 240,BA(BLOCK)
         GEN,8,24 240,BA(BLOCK+60)
         GEN,8,24 240,BA(BLOCK+120)
         GEN,8,24 240,BA(BLOCK+180)
         GEN,8,24 240,BA(BLOCK+240)
BLANKBUFF GEN,8,24 140,BA(BUFF)
LASTTYPE DATA     0
MODINDX  DATA     -1                INCREMENTED BEFORE USED
CMDHOLD  DATA     0
#PARM    DATA     0
DCBLOC   DATA     0
BUFF     RES      35
COMBUF   RES      35
BLOCK    DATA     '    ','    '
* BLOCK IS 1200 BYTES OF BLANKS
         LIST     0
         DO1      149
         DATA     '    ','    '
         LIST     1
BLKINDX  DATA     0
CURLINE  DATA     0
CURPAGE  DATA     0
CMDLNGTH DATA     0
CODSIZ   EQU      11                NUMBER OF CODES - CHANGE WHEN ADDED
SEQBUF   RES      (CODSIZ+1)**1
NAMEBUF  RES      (CODSIZ+1)*3
MBIT     EQU      1
XBIT     EQU      2
PBIT     EQU      4
FBIT     EQU      8
DBIT     EQU      X'10'
EBIT     EQU      X'20'
SBIT     EQU      X'40'
KBIT     EQU      X'80'
CBIT     EQU      X'100'
OBIT     EQU      X'200'
ABIT     EQU      X'400'
MXKBITS  EQU      MBIT+XBIT+KBIT
XINDEX   EQU      2
LT#      GEN,8,24 0,'LT#'
DP#      GEN,8,24 0,'DP#'
CMDS     DATA,2   0,'AD','DE','RE','EX'
CMDSIZ   EQU      5
ENTRIES  DATA     0
ENTRY1   RES      75
         BOUND    8
OPTS     DATA     0,0
         TEXT     'SOURCE'
         TEXT     'DATA  '
         TEXT     'SORT  '
         TEXT     'MODULES'
         TEXT     'CODES '
         TEXT     'FORMAT'
         TEXT     'ORDER'
         TEXT     'HEADING'
         TEXT     'LINES'
         TEXT     'BLOCK'
ALLBITS  EQU      X'7FF'            ADD BITS FOR NEW COMMENT TYPES
OPTSIZ   EQU      10
CODES    DATA,1   X'00','M','X','P','F','D','E','S','K','C','O','A'
         BOUND    4
CODBIT   DATA     X'00000001'
         DATA     X'00020004'
         DATA     X'00080010'
         DATA     X'00200040'
         DATA     X'00800100'
         DATA     X'02000400'
         DATA     X'00020002'
         DATA     X'00020000'
         BOUND    4
COMTBL   DATA     0
         TEXT     '*M* '
SPECX    TEXT     '*X* '
         TEXT     '*P* '
         TEXT     '*F* '
         TEXT     '*D* '
         TEXT     '*E* '
SKIP     TEXT     '*S* '
         TEXT     '*K* '
         TEXT     '*C* '
         TEXT     '*O* '
         TEXT     '*A* '
         TEXT     'REF '
DEF      TEXT     'DEF '
         TEXT     'SREF'
COMSIZ   EQU      14
NAMETAB  DATA     0                 NULL ENTRY
         DATA     0                 M
         DATA     0                 X
         DATA     'NAME'            P
         DATA     'NAME'            F
         DATA     'NAME'            D
ENAM     DATA     'ERRO'
         DATA     'SCRE'            S
         DATA     0                 K
         DATA     'VERS'            C
         DATA     'MESS'            O
         DATA     0                 A
NAMETAB1 DATA     0
         DATA     0                 M
         DATA     0                 X
         DATA     ':   '            P
         DATA     ':   '            F
         DATA     ':   '            D
ENAM1    DATA     'R:  '
         DATA     'ECH:'            S
         DATA     0                 K
         DATA     'ION:'            C
         DATA     'AGE:'            O
         DATA     0                 A
TABTAB   DATA,1   0,X'4A',X'38',X'2F'
TERM     DATA,1   0,';','-','(',')',','
TERMSIZ  EQU      5
         BOUND    4
ORD#     EQU      %
ORDTBL   DATA     0,0,0,0,0
CMDVEC   DATA     0
         B        ADDCMD
         B        DECMD
         B        RECMD
         B        EXCMD
OPTVEC   DATA     0
         B        SOUOPT
         B        DATOPT
         B        SOROPT
         B        MODOPT
         B        CODOPT
         B        FOROPT
         B        ORDOPT
         B        HEDOPT
         B        LINOPT
         B        BLKOPT
         BOUND    8
MSGMOD   DATA     '    ','    '
MSGNAME  DATA     '    ','    ','    '
MSGTYPE  DATA     '    '
         DATA     '    '            X'40' VFC FOR BLOCKED WRITE
ASKBUFF  DATA     '****'
         DO1      16
         DATA     '****'
HEADBUF  GEN,8,24 95,0
         DO1      29
         DATA     '    '
TITLE    EQU      HEADBUF+4
PAGE#    EQU      HEADBUF+24
IOERRMSG DATA     '** I','O ER','ROR '
ERRCODE  DATA     '    ',' ON ','DCB ','AT  '
DCBADD   DATA     '    ','.CAL',' AT '
CALADD   DATA     '    ','. **'
IOERRSZ  EQU      48
MODERMSG TEXT     '** ONLY TEN MODULE NAMES OR RANGES ALLOWED **'
MODERSZ  EQU      45
NOCPMSG  TEXT     '** UNABLE TO GET COMMON PAGE FOR SORT PARAMETERS **'
LNKERMSG TEXT     '** ERROR LINKING TO SORT - NO PSD IN TCB **'
LNKERSZ  EQU      43
NOCPSZ   EQU      51
DOFINMSG DATA     '** I','LLEG','AL C','OMME','NT T','YPE ','- GR'
         DATA     'OUP ','IGNO','RED ','-MOD','ULE '
DOFINMOD DATA     '    ','    ',' AT ','LINE'
DOFINLIN DATA     '    '
DOFINSZ  EQU      68
NOINMSG  DATA     '** I','NPUT',' FIL','E   '
NOINMOD  DATA     '    ','    ',' NOT',' FOU','ND *','*   '
NOINSZ   EQU      37
NOSRTMSG TEXT     '** A SORTING ORDER MUST BE GIVEN **'
NOSRTSZ  EQU      35
DEDBMS   TEXT     '** IF YOU WANT TO DELETE WHOLE DATABASE USE PCL **'
DEDBSIZ  EQU      50
NODATMSG TEXT     '** A DATABASE FILE MUST BE GIVEN **'
NODATSZ  EQU      35
BADKEYMS DATA     '** C','ANT ','ADD '
BADKEYCD DATA     '    ','CODE','S FR','OM  '
BADKEYMD DATA     '    ','    ','ALRE','ADY ','IN D','ATAB','ASE '
         DATA     'GROU','P AT'
BADKEYLN DATA     '    ',' SKI','PPED',' ** '
BADKEYSZ EQU      80
BLKMSG   TEXT     '** BLOCK MUST COME BEFORE HEADING OR LINE **'
BLKSIZ   EQU      44
         PAGE
***************************************************************************
*        EXTRACT - EXTRACT THE COMMENT FROM UTILIST COMPRESSED
*        MODULE LISTINGS. SAVE THESE COMMENS IN A DATA BASE
*        FROM WHICH TECH MANUAL DOCUMENTATION MAY PRODUCED.
*************************************************************************
         CSECT    1
EXTRACT  CAL1,8   XCON
         BAL,R8   CMDREAD           READ COMMAND LINE
CMD0     LI,R2    0
         BAL,R11  GETFLD
         CW,R14   END
         BE       ENDCMD
CMD1     CI,R6    '('
         BNE      EH
         LH,R14   R14
         LI,R3    CMDSIZ
         CH,R14   CMDS,R3
         BE       %+3
         BDR,R3   %-2
         B        EH
         STW,R3   CMDHOLD
CMD2     BAL,R11  GETFLD
         LI,R3    OPTSIZ
         CD,R14   OPTS,R3
         BE       OPTVEC,R3
         BDR,R3   %-2
         B        EH
OPTRTN   BAL,R11  GETFLD
         CI,R7    0
         BNE      EH
         CI,R6    ' '
         BE       CMDDONE
         CI,R6    ','
         BNE      EH
         BAL,R11  GETFLD
         CI,R6    '('
         BNE      EH
         B        CMD2
CMDDONE  LW,R3    CMDHOLD
         B        CMDVEC,R3
         PAGE
*************************************************************************
*        CMDREAD - READ COMMAND LINE - SET UP COMMAND LENGTH
*
*        WORK - R3,R6 BAL IS ON R8
*************************************************************************
         SPACE    2
CMDREAD  CAL1,1   PROMPT
         CAL1,1   READSI
         LW,R3    M:SI+4
         SLS,R3   -17
         LC       J:JIT
         BCS,8    %+2               DONT WRITE COMMAND LINE IF ONLINE
         CAL1,1   CMDWRITE
         AI,R3    -1                OMIT CR OR LF IF PRESENT
         LB,R6    BUFF,R3
         CI,R6    X'0D'             CR
         BE       CMDRD1
         CI,R6    X'15'             LF
         BE       CMDRD1
         AI,R3    1
CMDRD1   STW,R3   CMDLNGTH          SAVE FOR GETFLD
         B        *R8
         SPACE    2
***************************************************************************
*        SIERR - HANDLE ERROR AND ABNORMALS FROM READING COMMANDS
**************************************************************************
         SPACE    2
SIERR    LH,R1    R10
         CI,R1    X'0600'
         BE       ENDCMD
         CI,R1    X'0500'
         BE       ENDCMD
         B        ERROR
         PAGE
***************************************************************************
*        GETFLD - PICK UP NEXT FIELD FROM COMMAND LINE
*
*        INPUT - R2 - POSITION INDEX
*
*        OUTPUT - R2 - NEW POSITION INDEX
*                 R6 - TERMINATION CHARACTER
*                 R7 - FIELD LENGTH
*                 R14-15 - TEXT FIELD
*
*        WORK - R3 - IS DESTROYED
*               R11 - BAL REGISTER
*************************************************************************
         SPACE    2
GETFLD   CW,R2    CMDLNGTH
         BGE      CMDDONE
         LI,R7    0
         LD,R14   BLANKS
GETFL0   LB,R6    BUFF,R2
         CI,R6    ' '
         BNE      GETFL1
         AI,R2    1
         CW,R2    CMDLNGTH
         BL       GETFL0
         B        *R11
GETFL1   LB,R6    BUFF,R2
         LI,R3    TERMSIZ
         CB,R6    TERM,R3
         BE       GETFL3
         BDR,R3   %-2
         CI,R6    ' '
         BE       GETFL2
         CI,R7    7
         BG       EH
         STB,R6   R14,R7
         AI,R7    1
GETFL2   AI,R2    1
         CW,R2    CMDLNGTH
         BGE      *R11
         B        GETFL1
GETFL3   CI,R6    ';'
         BNE      GETFL4
         BAL,R8   CMDREAD           READ CONTINUATION
         LI,R2    0                 RESET INDEX
         CI,R7    0                 HAVE WE GET ANY CHAR YET
         BNE      GETFL1            YES - PICK UP WHERE LEFT OFF
         B        GETFLD            NO START OVER
GETFL4   AI,R2    1
         B        *R11
         PAGE
***************************************************************************
*        MODOPT - PROCESS MODULE SELECTION OPTION
*****************************************************************************
         SPACE    2
MODOPT   BAL,R11  GETFLD
         CD,R14   EXDATA
         BE       EXMOD
         CW,R14   ALL
         BE       ALLMOD
         LW,R3    SOMEBIT
         STS,R3   FLAGS
         B        %+2
MODOP1   BAL,R11  GETFLD
         MTW,1    MODINDX
         LW,R3    MODINDX
         CI,R3    10
         BL       MODOP2            LEGAL
         LI,R1    MODERMSG
         LI,R0    MODERSZ
         CAL1,1   DOOUT
         B        NXTCMD
MODOP2   STD,R14  FIRST,R3
         CI,R6    ','
         BE       MODOP1
         CI,R6    '-'
         BE       GETLAST
ALLMOD   CI,R6    ')'
         BNE      EH
         B        OPTRTN
GETLAST  BAL,R11  GETFLD
         LW,R3    MODINDX
         STD,R14  LAST,R3
         CI,R6    ','
         BE       MODOP1
         B        ALLMOD
EXMOD    LW,R3    EXDATBIT
         STS,R3   FLAGS
         B        ALLMOD
         PAGE
***************************************************************************
*        CODOPT - PROCESS CODE SELECTION OPTION
***************************************************************************
         SPACE    2
CODOPT   BAL,R11  GETFLD
         CW,R14   ALL
         BE       ALLCOD
         CD,R14   GLOS
         BE       GLOSCOD
         LI,R3    -ALLBITS          RESET FLAGS
         AWM,R3   FLAGS
         B        %+2
CODOP1   BAL,R11  GETFLD
         CI,R7    1
         BNE      EH
         LB,R14   R14
         LI,R3    CODSIZ
         CB,R14   CODES,R3
         BE       %+3
         BDR,R3   %-2
         B        EH
         LH,R3    CODBIT,R3
         STS,R3   FLAGS
         CI,R6    ','
         BE       CODOP1
ALLCOD   CI,R6    ')'
         BNE      EH
         B        OPTRTN
GLOSCOD  LW,R3    CMDHOLD
         CI,R3    3                 INDEX TO RE COMMAND
         BNE      EH                GLOSSARY ONLY LEGAL FOR REPORTS
         LI,R3    -ALLBITS+MXKBITS
         AWM,R3   FLAGS
         LW,R3    GLOSFLG
         STS,R3   FLAGS
         B        ALLCOD
         PAGE
*************************************************************************
*        DATOPT - PROCESS DATA BASE NAME AND ACCOUNT
****************************************************************************
         SPACE    2
DATOPT   BAL,R11  GETFLD
         STW,R7   R13
         AI,R7    1
         LI,R4    X'37'             BA BYTE 3 R13
         LI,R5    BA(DBNAME)
         STB,R7   R5
         MBS,R4   0
         CI,R6    ')'
         BE       OPTRTN
         CI,R6    ','
         BNE      EH
         BAL,R11  GETFLD
         CI,R7    0
         BE       DATOP1
         LI,R4    X'38'
         LI,R5    BA(DBACCT)
         STB,R7   R5
         MBS,R4   0
         LI,R4    X'0200'
         AWM,R4   DBACCT-1
DATOP1   CI,R6    ')'
         BE       OPTRTN
         CI,R6    ','
         BNE      EH
         BAL,R11  GETFLD
         LI,R4    X'38'
         LI,R5    BA(DBPASS)
         STB,R7   R5
         MBS,R4   0
         LI,R4    X'0200'
         AWM,R4   DBPASS-1
         CI,R6    ')'
         BNE      EH
         B        OPTRTN
         PAGE
***************************************************************************
*        SOUOPT - PROCESS TAPE SN AND/OR ACCOUNT OF UTILIST COMPRESSSED
*************************************************************************
         SPACE    2
SOUOPT   BAL,R11  GETFLD
         LW,R3    R14
         SLS,R3   -8
         CW,R3    LT#
         BE       SOUTAPE
         CW,R3    DP#
         BE       SOUPACK
         B        SOUACCT1
SOUTAPE  MTW,1    EISN              INC EI SN TO 2 - TAPE
         MTW,1    OPNEINXT+1
SOUPACK  EQU      %
         SCD,R14  -8
         STW,R15  EISN
         LI,R3    X'0100'
         AWM,R3   EISN-1
    STW,15  EINXTSN
    AWM,3   EINXTSN-1
         CI,R6    ','
         BE       SOUACCT
SOURET   CI,R6    ')'
         BNE      EH
         B        OPTRTN
SOUACCT  BAL,R11  GETFLD
SOUACCT1 LI,R4    X'38'
         LI,R5    BA(EIACCT)
         STB,R7   R5
         MBS,R4   0
         LI,R3    X'0200'
         AWM,R3   EIACCT-1
         B        SOURET
         PAGE
*************************************************************************
*        SOROPT - PROCESS THE SORT PARAMETERS OPTION
*                 ONLY LEGAL FOR THE REPORT COMMAND
***************************************************************************
         SPACE    2
SOROPT   LW,R5    CMDHOLD
         CI,R5    3                 INDEX FOR RE COMMAND
         BNE      EH
         CAL1,8   GETCP             GET A COMMON PAGE FOR SORT
         CI,R8    0
         BNE      SOROP0            GOT PAGE
         LI,R1    NOCPMSG
         LI,R0    NOCPSZ
         CAL1,1   DOOUT
         B        NXTCMD
SOROP0   STW,R9   COMPAGE
         LD,R0    SORTDATA
         STD,R0   *R9               STORE FIRST TWO WORDS OF SOPT PARM
         LW,R1    R9                NEXT TEN WORD ARE ALL BLANK
         AI,R1    2
         SLS,R1   2                 USE MBS TO BLANK THEM
         LI,R0    40                COUNT
         STB,R0   R1
         MBS,R0   BA(BLANKS)
         AI,R1    2                 SKIP NEXT HALFWORD (# OF SORT KEYS)
         LW,R9    R1
SOROP1   BAL,R11  GETFLD
         LI,R3    SORTBLSZ
         CD,R14   SORTBL,R3         IS IT LEGAL SORT PARAMETER
         BE       %+3               YES
         BDR,R3   %-2
         B        EH
         LD,R14   PARMTBL,R3
         STD,R14  SORTPARM
         LI,R8    10                COUNT
         STB,R8   R9
         LI,R8    BA(SORTPARM)-1    SOURCE
         MBS,R8   0
         MTW,1    #PARM
         CI,R6    ','
         BE       SOROP1
         CI,R6    ')'
         BNE      EH
         LH,R6    PARMTBL+2         X'F0F0'
         AW,R6    #PARM
         LI,R1    24                INDEX TO HALFWORD OF # OF SORT KEYS
         STH,R6   *COMPAGE,R1
         SLS,R9   -2
         AI,R9    1
         STW,R9   DCBLOC
         B        OPTRTN
         PAGE
*************************************************************************
*        FOROPT - PROCESS THE FORMAT OPTION
*************************************************************************
         SPACE    2
FOROPT   BAL,R11  GETFLD
         LI,R3    SORTBLSZ-1        SKIP LINE#
         CD,R14   SORTBL,R3
         BE       %+3
         BDR,R3   %-2
         B        EH
         LW,R3    FORMBITS,R3
         STS,R3   FLAGS
         CI,R6    ','
         BE       FOROPT
         CI,R6    ')'
         BNE      EH
         B        OPTRTN
         PAGE
*************************************************************************
*        ODROPT - PROCESS THE CODE SORT ODRER SELECTION OPTION
*************************************************************************
         SPACE    2
ORDOPT   LW,R3    ORDERFLG
         STS,R3   FLAGS
         LI,R4    1
ORDOP0   BAL,R11  GETFLD
         CI,R7    1
         BNE      EH
         SLS,R14  -24
         STB,R14  ORDTBL,R4
         MTB,1    ORD#
         CI,R6    ','
         BNE      ORDOP1
         AI,R4    1
         CI,R4    16
         BG       EH
         B        ORDOP0
ORDOP1   CI,R6    ')'
         BNE      EH
         B        OPTRTN
         PAGE
*************************************************************************
*        HEDOPT - PROCESS HEADING OPTION
*************************************************************************
         SPACE    2
HEDOPT   BAL,R11  GETFLD
         STB,R15  HEADBUF+2         PUT REPORT TYPE IN HEADING
         SLD,R14  -8
         STW,R15  HEADBUF+1
         AWM,R14  HEADBUF
         CI,R6    ')'
         BE       HEDRTN
         CI,R6    ','
         BNE      EH
         BAL,R11  GETFLD            PICK UP SORT PARM TO PUT IN HEADING
         LI,R3    SORTBLSZ
         CD,R14   SORTBL,R3
         BE       %+3
         BDR,R3   %-2
         B        EH                NOT LEGAL SORT PARM
         LW,R3    HEDFLAGS,R3       SET CORRECT SORT PARM BIT
         STS,R3   FLAGS
         CI,R6    ')'
         BE       HEDRTN
         CI,R6    ','
         BNE      EH
         LI,R7    0                 MOVE TITLE TO HEADBUF
HEDOP1   CW,R2    CMDLNGTH
         BGE      EH
         LB,R6    BUFF,R2
         CI,R6    ')'
         BE       HEDRTN0
         CI,R6    ';'
         BNE      HEDOP2
         BAL,R8   CMDREAD
         LI,R2    0
         B        HEDOP1
HEDOP2   STB,R6   TITLE,R7
         AI,R7    1
         CI,R7    80
         BGE      EH
         AI,R2    1
         B        HEDOP1
HEDRTN0  AI,R2    1
HEDRTN   LW,R3    FLAGS
         CW,R3    BLKFLG
         BANZ     %+2
         CAL1,1   HEADER            DONT DO CAL IF BLOCK SPECIFIED
         B        OPTRTN
         PAGE
**************************************************************************
*        LINOPT - PROCESS LINES PER PAGE OPTION
*************************************************************************
         SPACE    2
LINOPT   BAL,R11  GETFLD
         CI,R7    3
         BG       EH
         LI,R3    1                 CONVERT DECIMAL TEXT TO HEX
LINOP1   AI,R7    -1
         LB,R15   R14,R7
         AND,R15  XF
         MW,R15   R3
         AWM,R15  LINES
         MI,R3    10
         CI,R7    0
         BG       LINOP1
         LW,R3    FLAGS
         CW,R3    BLKFLG
         BANZ     LINOP3
         CAL1,1   LINCAL            DONT DO CAL IF BLOCK REQUESTED
LINOP2   CI,R6    ')'
         BNE      EH
         B        OPTRTN
LINOP3   LI,R3    -70               REMOVE DEFAULT 70 LINES PER PAGE
         AWM,R3   LINES
         B        LINOP2
         PAGE
*************************************************************************
*        BLKOPT - PROCESS BLOCK OPTION - WRITE MICROFICHE TAPE
*************************************************************************
         SPACE    2
BLKOPT   LH,R3    HEADBUF
         CI,R3    X'5F00'           BLOCK MUST COME BEFORE HEADING
         BNE      BLKFIRST          OR LINES TO PREVENT MONITOR ACTION
         LW,R3    LINES
         BNEZ     BLKFIRST
         LW,R3    BLKFLG
         STS,R3   FLAGS
         LI,R3    X'F1'             TOF
         STB,R3   HEADBUF
         LI,R3    70                70 LINES/PAGE DEFAULT
         STW,R3   LINES
         CI,R6    ','
         BNE      EH
         BAL,R11  GETFLD
         CI,R7    4                 ONLY FOUR CHAR SN
         BG       EH
         STW,R14  BLKSN
         CAL1,1   BLKOPN
         CI,R6    ')'
         BNE      EH
         B        OPTRTN
BLKFIRST LI,R1    BLKMSG
         LI,R0    BLKSIZ
         CAL1,1   DOOUT
         B        NXTCMD
         PAGE
*************************************************************************
*        DECOMP - DECOMPRESS UTILIST INPUT
*
*        INPUT - UTILIST COMPRESSED IN COMBUF
*
*        OUTPUT - DECOMPRESSED SOURCE IN BUFF
*                 R2 - BYTE COUNT OF DECOMPRESSED SOURCE
*
*        WORK - R3 - INDEX INTO COMPRESSED
*               R6 - TAB CONTROL
*               R10 - CHARACTER
*               R11 - BAL REGISTER
*               R12 - COMPRESSED FLAG
*               R13 - LENGTH OF COMPRESSED RECORD
*******************************************************************************
         SPACE    2
DECOMP   LW,R13   M:EI+4            GET ARS
         SLS,R13  -17
         LI,R12   -1
         LI,R2    0
         LI,R3    0
DECOMP1  LB,R10   COMBUF,R3
         CI,R10   X'13'             COMPRESSED STRING
         BNE      DECOMP2
         AI,R3    1
         LB,R12   COMBUF,R3
         AI,R3    1
         LB,R10   COMBUF,R3
DECOMP2  CI,R10   X'05'             IS IT A TAB
         BNE      DECOMP3
         LI,R10   ' '
         LI,R6    3
         CB,R2    TABTAB,R6
         BL       %+3
         BDR,R6   %-2
         B        DECOMP3
         LB,R6    TABTAB,R6
         STB,R10  BUFF,R2
         AI,R2    1
         CW,R2    6
         BL       %-3
         B        DECOMP4
DECOMP3  STB,R10  BUFF,R2
         AI,R2    1
DECOMP4  BDR,R12  DECOMP2
         AI,R3    1
         CW,R3    R13
         BL       DECOMP1
         STW,R2   CMDLNGTH          SAVE COMMENT LENGTH
         B        *R11
         PAGE
****************************************************************************
*        EH - OUTPUT BAD SYMTAX ERROR MESSAGE 'EH @ XX'
**************************************************************************
EH       LI,R6    3
         LW,R7    BLANKS
         LI,R10   10
         LW,R1    R2
EH1      LI,R0    0
         DW,R0    R10
         OR,R0    XF0
         STB,R0   R7,R6
         CI,R1    0
         BE       EH2
         BDR,R6   EH1
EH2      STW,R7   EH@+1
         LI,R15   EH@
         LI,R14   8
WRITEDO  CAL1,1   WRITDO
         CAL1,9   1
         PAGE
***************************************************************************
*        EXCMD - PROCESS THE EXTRACT COMMAND
****************************************************************************
         SPACE    2
EXCMD    MTW,2    DBORG
         MTW,2    DBACC
         MTW,2    DBMODE
         CAL1,1   OPENDB
         CAL1,1   CLOSEDB
         LI,R0    X'304'
         STW,R0   DBMODE            INOUT - SHARED
EXCM     CAL1,1   OPENDB
         LC       FLAGS
         BCS,8    EXEXDATA          MODS SPECIFIED IN EXDATA FILE
         BCS,4    GETMODS           MODS SPECIFIED ON COMMAND LINE
EXCMDALL CAL1,1   OPNEINXT
         B        %+2
EXCMD0   CAL1,1   OPENEI            NXTF
EXCMD0A  LD,R0    BLANKS
         STD,R0   MODNAME           CLEAR MODULE NAME IN KEY
         LB,R0    M:EI+23           GET BYTE COUNT OF FILE NAME
         LI,R4    BA(M:EI+23)+1
         LI,R5    BA(MODNAME)
         STB,R0   R5
         MBS,R4   0                 MOVE NEW MODNAME TO KEY
         CAL1,1   MODWRITE          OUTPUT MODULE NAME ON M:DO
         LW,R1    SEQCLR
         MBS,R0   BA(ZERO)          ZERO ALL SEQ NUMBERS
         LW,R1    NAMECLR
         MBS,R0   BA(BLANKS)        BLANK OUT ALL SAVED NAMES
         LI,R0    0
         STH,R0   SEQ#              ZAP SEQ# IN KEY
         LW,R0    ='   0'
         LW,R11   MODNAME
         CW,R11   JIT
         BNE      %+2
         LW,R0    BLANKS
         STW,R0   LINESAVE          ALL UPDATES BEFORE FIRST LINE# GET 0
         LW,R1    GOTEBIT
         LI,R0    0
         STS,R0   FLAGS             RESET FIRST ERROR COMMENT FLAG
         LW,R1    ='ERRO'           RESET ERROR: KEYWORD
         STW,R1   ENAM
         LW,R1    ='R:  '
         STW,R1   ENAM1
EXCMD0B  CAL1,1   READEI            READ INPUT UNTIL LINE ONE OF
         BAL,R11  DECOMP            NON - UPDATES IS FOUND
         LW,R1    BUFF+2
         CW,R1    =' 1* '
         BE       EXCMD0C
         CW,R1    =' 1  '
         BNE      EXCMD0B
         LI,R1    38                INDEX TO FIRST SOURCE CHAR
         LB,R1    BUFF,R1
         CI,R1    '+'               IS THIS AN UPDATE
         BNE      EXCMD0C           NO
         B        EXCMD0B
EXCMD1   LW,R1    BLANKBUFF
         MBS,R0   BA(BLANKS)
         CAL1,1   READEI
         BAL,R11  DECOMP
EXCMD0C  BAL,R11  UPTEST
         CI,R2    40
         BL       EXCMD1            NO
         LCI      2
         LM,R0    BUFF+8            CHECK FOR SKIPPED COMMENTS
         SCD,R0   16
         CW,R0    SKIP              *S*
         BE       EXCMD1
         LI,R1    38
         BAL,R11  GETCOM            GET FIRST FIELD
         CW,R13   DO                IS IT *DO*
         BNE      EXCMD2
         LW,R3    DOFINFLG          SET DO FIN FLAG
         STS,R3   FLAGS
         CAL1,1   READEI            READ COMMENT TYPE
         BAL,R11  DECOMP
         BAL,R11  UPTEST
         LI,R1    38
         BAL,R11  GETCOM
         BAL,R11  WANTIT            DO WE WANT THIS COMMENT TYPE
         B        DOFINER           BAD COMMENT TYPE - ERROR
         B        EXCMD5B
EXCMD1A  LCI      2
         LM,R14   BUFF+9
         SCD,R14  16
         CW,R14   ='*   '           OK TO STEP ON FIRST WORD
         BE       EXCMD1B
         LI,R8    17                NO MOVE EVERY WORD UP ONE
         LI,R1    BUFF+25
         LW,R13   *R1
         STW,R13  1,R1
         AI,R1    -1
         BDR,R8   %-3
EXCMD1B  LW,R13   SAVETYPE
         LI,R8    4                 FOUR CHAR TO MOVE INTO RECORD
         LI,R9    38                STARTING AT BYTE POSITION 38
         BAL,R11  INSRTFLD
         LI,R1    41
         B        EXCMD5B
EXCMD2   CW,R13   FIN               IS IT *FIN*
         BNE      EXCMD3
EXCMD2A  LI,R2    0
         LW,R3    DOFINFLG
         STS,R2   FLAGS             RESET DO FIN FLAG
         B        EXCMD1
EXCMD3   LW,R0    DOFINFLG
         CW,R0    FLAGS             DOING DO FIN
         BAZ      EXCMD4            NO
         LW,R0    LASTTYPE
         BLZ      EXCMD1
         B        EXCMD1A           FIX COMMENT TYPE
EXCMD4   CW,R13   ='*   '           IS IT *,*
         BNE      EXCMD5
         CI,R3    ','
         BNE      EXCMD1
         BAL,R11  GETCOM
         CW,R13   ='*   '
         BNE      EXCMD1
         LW,R0    LASTTYPE
         BLZ      EXCMD1
         LW,R13   SAVETYPE
         LI,R8    4                 FOUR CHAR TO MOVE
         LI,R9    38                START AT 38
         BAL,R11  INSRTFLD
         LI,R1    41                SET INDEX TO COMMENT
         B        EXCMD5A
EXCMD5   BAL,R11  WANTIT
         B        EXCMD1            ITS NOT A SPECIAL COMMENT
EXCMD5B  CI,R5    MXKBITS
         BAZ      EXCMD5A
         CI,R5    XBIT
         BE       XCOM
         STW,R13  SAVETYPE
         B        NEWNAME
EXCMD5A  STW,R13  SAVETYPE
         BAL,R11  GETCOM
         CW,R13   NAMETAB,R6        CHECK FOR NAME INDIATOR
         BNE      EXCMD6
         CW,R14   NAMETAB1,R6
         BNE      EXCMD6
         CI,R5    EBIT
         BAZ      NEWNAME
NEWE     LW,R3    GOTEBIT           SET FLAG - GOT AN E COMMENT
         STS,R3   FLAGS
NEWNAME  LI,R2    0
         LW,R3    ENTRFLG
         STS,R2   FLAGS
         STW,R2   ENTRIES
         CI,R5    OBIT+EBIT
         BAZ      %+2
         LI,R2    X'111'            FLAG TO GET 12 CHAR - NOT WORD
         BAL,R11  GETCOM            PICK UP NAME
         CI,R5    XBIT
         BNE      %+3
         CI,R3    ','
         BE       NOTWANT           ONLY ONE PER LINE
         LW,R7    R6                R6 SET UP BY WANTIT
         MI,R7    3
         LCI      3
         STM,R13  NAMEBUF,R7
         CI,R5    XBIT
         BNE      EXCMD6A
         BAL,R11  GETCOM
         CW,R13   BLANKS
         BE       NOTWANT           DONT WANT ANY WITH NO COMMENTS
         B        EXCMD6A
EXCMD6   CI,R5    EBIT              IF MESSAGE: COMES BEFORE ERROR:
         BNE      EXCMD6D           IN A MODULE THEN USE MESSAGE:
         LW,R11   FLAGS             AS THE KEYWORD FOR THAT MODULE
         CW,R11   GOTEBIT
         BANZ     EXCMD6D
         CW,R13   ='MESS'
         BNE      EXCMD6D
         CW,R14   ='AGE:'
         BNE      EXCMD6D
         STW,R13  ENAM
         STW,R14  ENAM1
         B        NEWE
EXCMD6D  CI,R5    SBIT              TEST S FOE SCREECH CODE:
         BNE      EXCMD6C
         CW,R13   ='SCRE'
         BNE      EXCMD6C
         CW,R14   ='ECH '
         BNE      EXCMD6C
         BAL,R11  GETCOM
         CW,R13   ='CODE'
         BNE      EXCMD6C
         CW,R14   =':   '
         BE       NEWNAME
EXCMD6C  CW,R13   ENTR
         BNE      EXCMD6A
         CW,R14   Y:
         BNE      EXCMD6A
EXCMD6B  BAL,R11  GETCOM
         LW,R11   ENTRFLG
         STS,R11  FLAGS
         LW,R7    ENTRIES
         MI,R7    3
         LCI      3
         STM,R13  ENTRY1,R7
         MTW,1    ENTRIES
         LW,R0    R1                SAVE DISP INTO RECORD
         LW,R1    COMBLK
         MBS,R0   BA(BLANKS)
         LW,R1    R0
         LI,R8    12
         LI,R9    92
         BAL,R11  INSRTENT
         LI,R8    12
         LI,R9    18
         BAL,R11  INSRTENT
         LCI      2
         LM,R13   NAME:
         LI,R8    5
         LI,R9    11
         BAL,R11  INSRTENT
         LCI      2
         LM,R8    BUFF+9            PICK UP AND MOVE COMMENT TYPE
         SLD,R8   16
         STW,R8   COMBUF
         LD,R8    ENTMDMBS
         MBS,R8   0
         LD,R8    ENTLNMBS
         MBS,R8   0
         MTH,1    SEQ#
         CAL1,1   WRENTDB
         LW,R0    ENTRIES
         CI,R0    24                24 IS MAX
         BGE      EXCMD1
         CI,R3    ','
         BE       EXCMD6B
         B        EXCMD1
EXCMD6A  CW,R5    LASTTYPE
         BE       EXCMD7
         LW,R7    SAVESEQ
         LH,R0    SEQ#
         STH,R0   SEQBUF,R7
         LH,R0    SEQBUF,R6
         STH,R0   SEQ#
         STW,R6   SAVESEQ
         STW,R5   LASTTYPE
         OR,R5    Y0D               SET R5 TO FIRST WORD OF KEYBUF
         STW,R5   KEYBUF
EXCMD7   LW,R7    R6
         MI,R7    3
         LCI      3
         LM,R13   NAMEBUF,R7        MOVE NAME TO RECORD
         LI,R8    12                TWELVE CHAR TO MOVE
         LI,R9    130
         BAL,R11  INSRTFLD
         LD,R8    MODMBS            MOVE MODULE NAME TO RECORD
         MBS,R8   0
         LD,R8    LINEMBS           MOVE LINE# TO RECORD
         LW,R3    MODNAME
         CW,R3    JIT
         BNE      %+2
         LD,R8    JLNEMBS
         MBS,R8   0
         MTH,1    SEQ#              INC SEQ#
         CAL1,1   WRITEDB
         LW,R3    FLAGS
         CW,R3    ENTRFLG
         BAZ      EXCMD1
         LW,R3    ENTRIES
         BEZ      EXCMD1
         MI,R3    3
EXCMD7A  AI,R3    -3
         LCI      3
         LM,R13   ENTRY1,R3
         LI,R8    12
         LI,R9    130
         BAL,R11  INSRTFLD
         MTH,1    SEQ#
         CAL1,1   WRITEDB
         CI,R3    0
         BLE      EXCMD1
         B        EXCMD7A
XCOM     LI,R8    4
         CI,R3    ','               IS IT REF,1
         BNE      %+2
         LI,R8    6                 YES BLANK ,1 ALSO
         LW,R9    R1                INDEX TO END OF REF OR DEF
         AI,R9    -4+BA(BUFF)-1
         STB,R8   R9
         LI,R8    BA(BLANKS)
         MBS,R8   0                 BLANK OUT REF - DEF
         LW,R3    R13               SAVE TEXT
         LW,R13   SPECX
         CW,R3    DEF
         BNE      %+2
         AI,R13   -X'100'           DEC TYPE TO SORT DEF FIRST
         STW,R13  SAVETYPE
         LI,R8    4
         LI,R9    38
         BAL,R11  INSRTFLD
         B        NEWNAME
DOFINER  LD,R0    MODNAME
         LCI      2
         STM,R0   DOFINMOD
         LM,R0    BUFF+1
         SCD,R0   -16               GET LINE NUMBER IN R1
         STW,R1   DOFINLIN
         LI,R1    DOFINMSG
         LI,R0    DOFINSZ
         CAL1,1   DOOUT
         B        EXCMD2A           RESET DOFINFLG AND CONTINUE
         PAGE
*************************************************************************
*        EXEXDATA - PROCESS EXDATA FILE
*************************************************************************
         SPACE    2
EXEXDATA CAL1,1   OPENBI
         LI,R2    0
         LI,R3    X'400'            TURN OFF NXTF
         STS,R2   EIASN
NXEXDATA CAL1,1   READBI            BUFFER IS EINAME
         LW,R0    M:BI+4
         SLS,R0   -17               GET ARS
         STB,R0   EINAME            PUT BYTE COUNT IN FILE NAME
         B        EXCMD0
         SPACE    4
*************************************************************************
*        UPTEST - FIX LINE NUMBERS FOR UPDATES
****************************************************************************
         SPACE    2
UPTEST   LW,R3    MODNAME
         CW,R3    JIT
         BE       JITLINE
         LI,R3    2
         LB,R3    BUFF+2,R3
         CI,R3    '*'
         BNE      NOTUP
         LW,R14   LINESAVE
         LW,R15   BLANKS
         SCD,R14  -16
         LCI      2
         STM,R14  BUFF+1
         B        *R11
NOTUP    LCI      2
         LM,R14   BUFF+1
         SCD,R14  16
         CW,R14   BLANKS
         BE       %+2
NOTUP1   STW,R14  LINESAVE
         B        *R11
JITLINE  LCI      2
         LM,R14   BUFF+4
         SLD,R14  8
         CW,R14   BLANKS
         BE       *R11
         B        NOTUP1
         PAGE
*****************************************************************************
*        GETMODS - PROCESS SELECTED MODULE FROM COMMAND
*******************************************************************************
         SPACE    2
GETMODS  LI,R1    0
         STW,R1   MODINDX
GETMOD1  LD,R14   FIRST,R1
         BEZ      GETMOD2
         MTW,0    LAST,R1
         BEZ      %+3
         LW,R1    FROMTOFLG
         STS,R1   FLAGS
         LI,R2    0
MODMOVE  LB,R1    R14,R2
         CI,R1    ' '
         BE       MODMVED
         AI,R2    1
         STB,R1   EINAME,R2
         CI,R2    8
         BL       MODMOVE
MODMVED  STB,R2   EINAME            BYTE COUNT
         B        EXCMD0
GETMOD2  CAL1,1   CLOSEDB           CLOSE DATA BASE AND GET NEXT CMD
         B        NXTCMD
         PAGE
*******************************************************************************
*        RDEIERR - ERROR OR ABNORMAL READING M:EI
*************************************************************************
         SPACE    2
RDEIERR  CAL1,1   CLOSEEI
         SLS,R10  -17
         CI,R10   X'0300'           ERROR CODE 06-00
         BE       %+2
         B        ERROR
RDEIER2  LW,R0    FLAGS
         BLZ      NXEXDATA
         CW,R0    SOMEBIT
         BAZ      EXCMDALL          ALL MODULES REQUESTED
         CW,R0    FROMTOFLG
         BAZ      RDEIER1
         LW,R1    MODINDX
         LD,R4    LAST,R1
         CD,R4    MODNAME
         BLE      RDEIER0
         B        EXCMDALL          OPEN NEXT
RDEIER0  LI,R0    0
         LW,R1    FROMTOFLG
         STS,R0   FLAGS
RDEIER1  MTW,1    MODINDX
         LW,R1    MODINDX
         B        GETMOD1
         PAGE
**************************************************************************
*        RDBIERR - ERROR OR ABNORMAL READING EXDATA
*****************************************************************************
         SPACE    2
RDBIERR  CAL1,1   CLOSEBI
         LH,R1    R10
         CI,R1    X'0600'           EOF
         BE       %+2
BIERR    B        ERROR
         LW,R3    CMDHOLD
         CI,R3    3                 INDEX TO REPORT COMMAND
         BE       SORT
         B        GETMOD2
         PAGE
******************************************************************************
*        EIERR - ERROR OPENING INPUT FILE
**************************************************************************
         SPACE    2
EIERR    LH,R0    R10
         CI,R0    X'0200'           NXTF BUT NO MORE FILES
         BE       EIERR1
         CI,R0    X'0600'           EOF
         BNE      ERROR
         LB,R1    EINAME            TELL USER WE CANT FIND FILE
         LI,R2    BA(EINAME)+1
         LI,R3    BA(NOINMOD)
         STB,R1   R3
         MBS,R2   0
EIERR0   LI,R1    NOINMSG
         LI,R0    NOINSZ
         CAL1,1   DOOUT
         B        RDEIER2           CONTINUE
EIERR1   LW,R0    FLAGS
         CW,R0    SOMEBIT           CANT BE EXDATA - IS IT SOME OR ALL
         BAZ      GETMOD2           ITS ALL - CLOSE DB AND GET NXTCMD
         CW,R0    FROMTOFLG         IF DOING FROMTO THEN STOP
         BAZ      RDEIER1
         B        RDEIER0
         PAGE
****************************************************************************
*        WANTIT - TEST RECORD FOR REQUESTED COMMENT TYPE
*
*        INPUT - R13 - TEXT FIRST FIELD IN RECORD
*
*        OUTPUT - IF NOT SPECIAL COMMENT RETURN IS
*                 TO BAL+1
*                 IF SPECIAL COMMENT OF TYPE NOT REQUESTED RETURN IS
*                 MADE DIRECTLY TO EXCMD1
*                 IF SPECIAL COMMENT OF TYPE THAT IS REQUESTED RETURN
*                 IS MADE TO BAL+2 WITH:
*                    R5 - COMMENT TYPE BIT
*                    R6 - INDEX INTO TYPE TABLES
*
*        WORK - R7
*******************************************************************************
         SPACE    2
WANTIT   LI,R7    COMSIZ
         CW,R13   COMTBL,R7
         BE       COMFIND
         BDR,R7   %-2
         B        *R11
COMFIND  LH,R5    CODBIT,R7
         CW,R5    FLAGS
         BAZ      NOTWANT
         LW,R6    R7
         CI,R5    XBIT
         BNE      %+2
         LI,R6    XINDEX
         AI,R11   1
         B        *R11
NOTWANT  LI,R5    -1
         STW,R5   LASTTYPE
         B        EXCMD1
         PAGE
****************************************************************************
*        INSRTFLD - PUT A TEXT FIELD INTO THE COMMENT RECORD
*
*        INPUT - R8 - NUMBER OF CHARACTERS TO MOVE
*                R9 - INDEX TO START POINT IN COMMENT BUFFER
*
*        OUTPUT - MOVED FIELD
******************************************************************************
INSRTFLD AI,R9    BA(BUFF)
         STB,R8   R9
         LI,R8    X'34'             BA(R13)
         MBS,R8   0
         B        *R11
         SPACE    2
*************************************************************************
*        INSRTENT - PUT FIELDS INTO NAME: RECORD FOR EACH ENTRY
***************************************************************************
         SPACE    2
INSRTENT AI,R9    BA(COMBUF)
         B        INSRTFLD+1
         PAGE
*******************************************************************************
*        GETCOM - GET NEXT FIELD FROM COMMENT RECORD
*
*        INPUT - R1 - INDEX INTO COMMENT
*                R2 - IF X'111' IGNORE DELIMITERS
*
*        OUTPUT - R1 - NEW INDEX INTO COMMENT
*                 R7 - FIELD LENGTH
*                 R13-R15 - TEXT FIELD
*
*        WORK - R3 - DESTROYED
*******************************************************************************
         SPACE    2
GETCOM   LW,R13   BLANKS
         LD,R14   BLANKS
         LI,R7    0
GETCM0   CW,R1    CMDLNGTH
         BGE      *R11
         LB,R3    BUFF,R1
         CI,R3    ' '
         BNE      GETCM1
         AI,R1    1
         B        GETCM0
GETCM1   STB,R3   R13,R7
         AI,R7    1
         CI,R7    12
         BGE      *R11
         AI,R1    1
         CW,R1    CMDLNGTH          END OF COMMENT?
         BGE      *R11
         LB,R3    BUFF,R1
         CI,R2    X'111'
         BE       GETCM1            FLAG - GET 12 CHAR. - NO WORDS
         CI,R3    ' '
         BE       GETCM2
         CI,R3    ','
         BE       GETCM2
         B        GETCM1
GETCM2   AI,R1    1
         B        *R11
         PAGE
*************************************************************************
*        ADDCMD   ADD SPECIAL COMMENTS TO DATABASE
******************************************************************************
         SPACE    2
ADDCMD   MTW,2    DBORG
         MTW,2    DBACC
         LI,R0    X'304'
         STW,R0   DBMODE            INOUT - SHARED
         B        EXCM
         PAGE
******************************************************************************
*        DECMD    DELETE SPECIAL COMMENT FROM DATABASE
*************************************************************************
         SPACE    2
DECMD    MTW,1    DBACC
         MTW,2    DBORG
         LI,R0    X'304'
         STW,R0   DBMODE
         CAL1,1   OPENDB
         MTH,1    SEQ#
         LW,R0    FLAGS
         BLZ      DEEXDATA
         CW,R0    SOMEBIT
         BANZ     DESOME
         AND,R0   XFFFF             ALL MODULES AND ALL CODES
         CI,R0    ALLBITS
         BE       DEDB              YES
         LI,R3    0
DECMD1   BAL,R11  GETCODE
         B        DEDONE
         STW,R3   KEYBUF
         LI,R4    3                 BYTE COUNT OF KET
         STB,R4   KEYBUF
         CAL1,1   DERDDBK
DECMD2   CAL1,1   DERDDBS
         CW,R3    KEYCODE
         BNE      DENWCOD           NEW CODE
         CW,R5    KEYMOD2           SAME MODULE
         BNE      DENWMOD           NO
         CW,R4    KEYMOD1
         BNE      DENWMOD
DECMD3   CAL1,1   DELREC            IS SAME CODE AND MODULE - DELETE
         B        DECMD2
*
*****************************************************************************
*
DEEXDATA LI,R3    0
         STW,R3   BIBTD             ZERO BTD
         CAL1,1   OPENBI            OPEN EXDATA FILE
DEEX0    LCI      2
         LM,R4    BLANKS
         STM,R4   EINAME            BUFFER FOR BIREAD
         CAL1,1   READBI
         LCI      2
         LM,R4    EINAME
         LI,R3    0
DENXEX   BAL,R11  GETCODE
         B        DEEX0
         BAL,R11  MAKEKEY
         CAL1,1   DERDDBK
         B        DECMD3
DESOME   LI,R3    0
DESOME0  LI,R1    0
         STW,R1   MODINDX
DESOM0   BAL,R11  GETCODE
         B        DEDONE
DESOM1   LW,R1    MODINDX
         LD,R4    FIRST,R1
         BEZ      DESOME0
         BAL,R11  MAKEKEY
         MTW,0    LAST,R1
         BEZ      DESOM2
         LW,R1    FROMTOFLG
         STS,R1   FLAGS
DESOM2   CAL1,1   DERDDBK
         B        DECMD3
*
****************************************************************************
*
DENWMOD  LW,R0    FLAGS
         BLZ      DENXEX
         CW,R0    SOMEBIT
         BANZ     DEMOD1
         LCI      2
         LM,R4    KEYMOD1
         B        DECMD3
DEMOD1   CW,R0    FROMTOFLG         NOT ALL OR EXDATA
         BAZ      DEMOD2
         LCI      2
         LM,R4    KEYMOD1
         LW,R1    MODINDX
         CD,R4    LAST,R1
         BLE      DECMD3
DEMOD1A  LI,R0    0
         LW,R1    FROMTOFLG
         STS,R0   FLAGS             RESET DOING FROM - TO FLAG
DEMOD2   MTW,1    MODINDX
         B        DESOM1
*
DENWCOD  LW,R0    FLAGS
         BLZ      DENXEX
         CW,R0    SOMEBIT
         BAZ      DECMD1
         CW,R0    FROMTOFLG
         BAZ      DEMOD2
         B        DEMOD1A
*
*************************************************************************
*
DEDB     LI,R1    DEDBMS
         LI,R0    DEDBSIZ
         CAL1,1   DOOUT
DEDONE   CAL1,1   CLOSEDB
         B        NXTCMD
         PAGE
*****************************************************************************
*        DEDBKER  ERROR/ABNORMAL HANDLER FOR READS OF DATABASE
*                 WHILE SEARCHING FOR THE RECORDS TO DELETE
******************************************************************************
         SPACE    2
DEDBKER  LH,R1    R10
         CI,R1    X'4300'
         BNE      DBKER0
         LW,R0    FLAGS
         BLZ      DENXEX
         B        DECMD2
         SPACE    2
*****************************************************************************
*        DEDBSER  ERROR/ABNORMAL HANDLER FOR SEQUENTIAL READS OF
*                 DATABASE DURRING DELETE LOGIC
*************************************************************************
         SPACE    2
DEDBSER  LH,R1    R10
         CI,R1    X'0600'
         BNE      ERROR
         LW,R0    FLAGS
         BLZ      DENXEX
         CW,R0    SOMEBIT
         BAZ      DEDONE
         CW,R0    FROMTOFLG
         BAZ      DEMOD2
         B        DEMOD1A
         PAGE
**************************************************************************
*        WRDBER   ERROR/ABNORMAL WRITTING DATABASE
*****************************************************************************
         SPACE    2
WRDBER   LH,R9    R10
         CI,R9    X'1600'           KEY EXISTS ALREADY
         BNE      ERROR
         MTH,-1   SEQ#
         LCI      2
         LM,R0    KEYMOD1
         STM,R0   BADKEYMD
         LW,R1    KEYCODE
         LW,R1    COMTBL,R1
         STW,R1   BADKEYCD
         LW,R1    LINESAVE
         STW,R1   BADKEYLN
         LI,R1    -1
         STW,R1   LASTTYPE
         LI,R1    BADKEYMS
         LI,R0    BADKEYSZ
         CAL1,1   DOOUT
         LD,R0    BLANKS
         LCI      2
         STM,R0   BADKEYMD
         STW,R0   BADKEYCD
         STW,R0   BADKEYLN
         B        EXCMD1
         PAGE
*******************************************************************************
*        RECMD - PROCESS REPORT COMMAND
*************************************************************************
         SPACE    2
RECMD    MTW,0    COMPAGE
         BNEZ     RECMD0            OK - HE GAVE A SORT ORDER
         LI,R1    NOSRTMSG          MUST SPECIFY A SORTING ORDER
         LI,R0    NOSRTSZ
         CAL1,1   DOOUT
         B        NXTCMD
RECMD0   MTW,1    DBACC
         MTW,2    DBORG
         MTW,1    DBMODE
         CAL1,1   OPENDB
         MTH,1    SEQ#
         LW,R0    FLAGS
         BLZ      REEXDATA
         CW,R0    SOMEBIT
         BANZ     RESOME
         CW,R0    ORDERFLG
         BANZ     RECMD0A
         AND,R0   XFFFF
         CI,R0    ALLBITS
         BE       DBSORT
RECMD0A  LI,R3    0
         CAL1,1   OPENTEMP          NEED TEMP FILE
RECMD1   BAL,R11  GETCODE
         B        SORT
         STW,R3   KEYBUF
         LI,R4    3
         STB,R4   KEYBUF            SET KEYLENGTH TO 3
         CAL1,1   READDBK
RECMD2   CAL1,1   READDBS
KEYCODE  EQU      M:EO+43           FIRST WORD OF KEY BUFFER IN DCB
         CW,R3    KEYCODE           SAME AS LAST CODE
         BNE      NEWCODE
KEYMOD2  EQU      M:EO+45           THIRD WORD - SECOND WORD OF MODULE
         CW,R5    KEYMOD2           SAME MODULE AS LAST
         BNE      NEWMOD
KEYMOD1  EQU      M:EO+44           SECOND WORD - FIRST OF MODULE NAME
         CW,R4    KEYMOD1
         BNE      NEWMOD
RECMD3   LW,R0    M:EO+4            GET BYTE COUNT OF LAST READ
         SLS,R0   -17
         LW,R1    FLAGS
         CW,R1    GLOSFLG
         BAZ      RECMD3A
         LW,R7    BUFF
         CW,R7    SPECX             THROW OUT REFS FOR GLOSSARY
         BE       RECMD2
RECMD3A  CW,R1    ORDERFLG
         BAZ      %+2
         BAL,R11  ORDRE
         CAL1,1   WRITEMP
         B        RECMD2
REEXDATA LI,R3    0
         STW,R3   BIBTD
         CAL1,1   OPENTEMP
         CAL1,1   OPENBI
REEX0    LCI      2
         LM,R4    BLANKS
         STM,R4   EINAME            CLEAR BUFFER
         CAL1,1   READBI
         LCI      2
         LM,R4    EINAME            BUFFER FOR BIREAD
         LI,R3    0
RENXEX   BAL,R11  GETCODE
         B        REEX0             DONE ALL CODES GET NEXT MODULE
         BAL,R11  MAKEKEY
         CAL1,1   READDBK
         B        RECMD3
RESOME   LI,R3    0
         CAL1,1   OPENTEMP
RESOM0A  LI,R1    0
         STW,R1   MODINDX
RESOM0   BAL,R11  GETCODE
         B        SORT              DONE ALL CODES
RESOM1   LW,R1    MODINDX
         LD,R4    FIRST,R1
         BEZ      RESOM0A
         BAL,R11  MAKEKEY
         MTW,0    LAST,R1
         BEZ      RESOM2
         LW,R1    FROMTOFLG
         STS,R1   FLAGS
RESOM2   CAL1,1   READDBK
         B        RECMD3
NEWMOD   LW,R0    FLAGS
         BLZ      RENXEX
         CW,R0    SOMEBIT
         BANZ     NEWMD1
         LCI      2
         LM,R4    KEYMOD1
         B        RECMD3
NEWMD1   CW,R0    FROMTOFLG
         BAZ      NEWMD2
         LCI      2
         LM,R4    KEYMOD1
         LW,R1    MODINDX
         CD,R4    LAST,R1
         BLE      RECMD3
NEWMD1A  LI,R0    0
         LW,R1    FROMTOFLG
         STS,R0   FLAGS
NEWMD2   MTW,1    MODINDX
         B        RESOM1
NEWCODE  LW,R0    FLAGS
         BLZ      RENXEX
         CW,R0    SOMEBIT
         BAZ      RECMD1
         CW,R0    FROMTOFLG
         BAZ      NEWMD2
         B        NEWMD1A
         PAGE
*******************************************************************************
*        GETCODE - SET UP NEXT CODE REQUESTED
*
*        INPUT - R3 - LAST CODE OR ZERO IF FIRST TIME THROUGH
*                R11 - BAL REGISTER
******************************************************************************
         SPACE    2
GETCODE  AND,R3   XFFFF             SCRUB BYTE COUNT
         CI,R3    0
         BNE      GETCOD1
         LI,R3    1
         B        %+2
GETCOD1  SLS,R3   1
         CW,R3    FLAGS
         BAZ      GETCOD2
         OR,R3    Y0D               REPLACE BYTE COUNT
         AI,R11   1
         B        *R11
GETCOD2  CI,R3    X'8000'
         BGE      *R11
         B        GETCOD1
**************************************************************************
*        MAKEKEY - CONSTRUCT KEY FOR READ OF DATA BASE
*
*        INPUT - R3 - BYTE COUNT AND CODE
*                R4-R5 - TEXT MODULE NAME
*
*        OUTPUT - CONSTRUCTED KEY IN KEYBUF
****************************************************************************
         SPACE    2
MAKEKEY  STD,R4   MODNAME
         STW,R3   KEYBUF
         B        *R11
         PAGE
*******************************************************************************
*        DBKERR - ERRABN ROUTINE FOR KEYED READ OF DATA BASE
****************************************************************************
         SPACE    2
DBKERR   LH,R1    R10
         CI,R1    X'4300'           NO RECORD WITH THIS KEY
         BE       DBKERR1
DBKER0   CI,R1    X'1400'
         BNE      ERROR
         LI,R1    NODATMSG
         LI,R0    NODATSZ
         CAL1,1   DOOUT
         B        GETMOD2           CLOSEDB AND GET NXTCMD
DBKERR1  LW,R0    FLAGS
         BLZ      RENXEX
         B        RECMD2
         SPACE    4
*******************************************************************************
*        DBSERR - ERRABN ROUTINE FOR SEQUEN READ OF DATA BASE
*******************************************************************************
         SPACE    2
DBSERR   LH,R1    R10
         CI,R1    X'0600'           EOF
         BNE      ERROR
         LW,R0    FLAGS
         BLZ      RENXEX
         CW,R0    SOMEBIT
         BAZ      SORT
         CW,R0    FROMTOFLG
         BAZ      NEWMD2
         B        NEWMD1A
         PAGE
*******************************************************************
*        SORT - PREPARE TO PASS PARAMETERS TO SORT
******************************************************************
         SPACE    2
DBSORT   CAL1,1   OPENTEMP
         CAL1,1   MOVE
SORT     CAL1,1   CLOSEDB
         CAL1,1   CLOSTEMP
         CAL1,1   SETDCB            ZERO ERROR AND ABNORMAL
         CAL1,1   PREOPSRT
         LW,R7    DCBLOC
         SLS,R7   2
         LI,R6    51**2             51 WORDS IN DCB
         STB,R6   R7
         LI,R6    BA(F:SORTIN)
         MBS,R6   0
         LI,R6    51**2
         STB,R6   R7
         LI,R6    BA(F:SORTOUT)
         MBS,R6   0
         LI,R6    0
         STB,R6   0,R7
         LW,R6    COMPAGE
         LW,R7    DCBLOC
SORTLNK  CAL1,8   SORTLINK
         NOP
         CAL1,1   OTMPREL
         CAL1,1   CTMPREL
         LW,R1    FLAGS
         CW,R1    BLKFLG
         BANZ     %+3               SKIP PAGCNT,TOP IF WRITTING BLOCKED
         CAL1,1   PAGCNT
         NOP      0                 CAL1,1 TOP
         CAL1,1   OPENSORT
         LI,R1    0
         STW,R1   MSGTYPE
         STW,R1   MSGMOD
         STW,R1   MSGNAME
SORT1    LI,R1    0
         LW,R0    FLAGS
         CAL1,1   READSORT
         LW,R3    FLAGS
         CW,R3    ORDERFLG
         BAZ      SORT8
         LI,R3    1
         LB,R2    BUFF,R3
         CI,R2    17
         BGE      SORT8
         LB,R2    ORDTBL,R2
         STB,R2   BUFF,R3
SORT8    LCI      3
         LM,R2    BUFF+23
         CW,R2    MSGNAME
         BNE      SORT5
         CW,R3    MSGNAME+1
         BNE      SORT5
         CW,R4    MSGNAME+2
         BE       SORT2
SORT5    CW,R2    BLANKS            CHECK FOR BLANK NAME AND
         BNE      SORT5A            BLANK LINE
         LW,R1    BLKCOMP
         CBS,R0   BA(BLANKS)
         BE       SORT1
         LI,R1    0
SORT5A   LCI      3
         STM,R2   MSGNAME
         AI,R1    4
         CW,R0    NAMHDFLG
         BAZ      SORT2
         BAL,R11  PARMOVE
SORT2    LCI      2
         LM,R2    BUFF+21
         CW,R2    MSGMOD
         BNE      SORT3
         CW,R3    MSGMOD+1
         BE       SORT4
SORT3    LCI      2
         STM,R2   MSGMOD
         AI,R1    2
         CW,R0    MODHDFLG
         BAZ      SORT4
         BAL,R11  PARMOVE
SORT4    LW,R2    BUFF
         CW,R2    MSGTYPE
         BE       SORT6
         XW,R2    MSGTYPE
         BNEZ     SORT4A
         LW,R2    FLAGS
         CW,R2    FORMBITS
         BANZ     SORT4A
         CW,R2    BLKFLG
         BAZ      SORT4B
         LW,R7    LINES
         STW,R7   CURLINE
         LI,R7    0
         BAL,R15  BLKER
         B        SORT4A
SORT4B   CAL1,1   PAGE
SORT4A   AI,R1    1
         CW,R0    TYPHDFLG
         BAZ      SORT6
         LW,R2    MSGTYPE
         BAL,R11  PARMOVE
SORT6    CW,R0    LINHDFLG
         BAZ      %+3
         LW,R2    BUFF+20
         BAL,R11  PARMOVE
         CI,R1    0
         BE       %+2
         BAL,R11  SPACE
         LW,R2    BUFF+20
         LCI      2
         LM,R3    BUFF+21
         CW,R3    JIT
         BNE      SORT6A
         CW,R2    LINESAVE
         BE       SORT6A            FOR JIT DONT START NEM PICTURE
         STW,R2   LINESAVE          TOO CLOSE TO BOTTOM OF PAGE
         LW,R8    FLAGS
         CW,R8    BLKFLG
         BANZ     BLKJIT
         CI,R8    0
         BE       SORT6A
         CI,R8    5
         BG       SORT6A
         CAL1,1   PAGE
         B        SORT6A
BLKJIT   LW,R8    LINES
         SW,R8    CURLINE
         CI,R8    5
         BG       SORT6A
         LW,R8    LINES
         STW,R8   CURLINE           FORCE TOF
         LI,R7    0
         BAL,R11  BLKER
SORT6A   LW,R11   R1                SAVE WHAT CHANGED
         LW,R1    BLKFILL
         MBS,R0   BA(BLANKS)
         STW,R2   BUFF+26
         LCI      2
         STM,R3   BUFF+24
         LI,R3    1
         LB,R3    BUFF,R3
         CI,R3    'X'               IS IT X TYPE
         BE       SORT6F
         CI,R3    'M'
         BE       SORT6F
         CI,R3    'K'
         BNE      SORT7
SORT6F   LW,R1    COMBLK
         MBS,R0   BA(BLANKS)
         LI,R2    0
SORT6D   LB,R3    BUFF+1,R2         SEARCH FOR LEAD CHARACTER
         CI,R3    ' '
         BNE      SORT6B
         AI,R2    1
         CI,R2    20                LEAVE ALONE IF INDENTED
         BG       SORT7
         B        SORT6D
SORT6B   LI,R4    76                MAX CHARACTERS
         SW,R4    R2                SUBTRACT SKIPPED  BLANKS
         AI,R2    BA(BUFF+1)
         LI,R3    BA(COMBUF)
         STB,R4   R3
         MBS,R2   0                 MOVE IT
         LW,R1    BLKCOMP
         MBS,R0   BA(BLANKS)
         LW,R3    BUFF              FIRST DEF IN COLUMN 10 -
         CW,R3    SPECX
         BE       SORT6C
         LI,R3    10
         CI,R11   0
         BNE      %+2               R11 IS R1 SAVED ABOVE
         LI,R3    20                NAME DIDNT CHANGE - INDENT
         BAL,R11  XMOVE
         B        SORT7
SORT6C   LI,R3    15                FIRST REF LINE TABBED TO 15 -
         CI,R11   0
         BNE      SORT6E            IF NOTHING CHANGED - INDENT
         LI,R3    20
SORT6E   BAL,R11  XMOVE
SORT7    LW,R2    FLAGS
         CW,R2    BLKFLG            WRITTING BLOCKED
         BAZ      SORT9             NO
         LI,R6    BA(BUFF+1)-1      BYTE 3 OF BUFF IS ALWAYS X'40'
         LI,R7    105
         BAL,R15  BLKER
         B        SORT1
SORT9    CAL1,1   WRITECOM
         B        SORT1
         PAGE
*******************************************************************
*        SPACE - SEPERATE COMMENT GROUPS
******************************************************************
         SPACE    2
SPACE    LW,R2    FLAGS
         CW,R2    GLOSFLG
         BANZ     *R11
         CI,R1    1
         BAZ      SPA1
         CW,R2    CFORBIT
         BANZ     SPAC1
         CI,R1    1                 IF ONLY CODE CHANGED
         BNE      SPA1              ONLY SPACE BETWEEN GROUPS
         CW,R2    BLKFLG
         BAZ      SPA5A
         B        SPA4A
SPA1     CI,R1    2
         BAZ      SPA2
         CW,R2    MFORBIT
         BANZ     SPAC1
SPA2     CI,R1    4
         BAZ      SPA3
         CW,R2    NFORBIT
         BAZ      SPA3
SPAC1    CW,R2    BLKFLG
         BAZ      SPAC2
         LW,R2    LINES
         STW,R2   CURLINE           FORCE TOF
         LI,R6    BA(ASKBUFF)-1
         LI,R7    69
         BAL,R15  BLKER
         B        *R11
SPAC2    CAL1,1   PAGE
         CAL1,1   ASKLINE
         B        *R11
SPA3     AND,R2   XFFFF
         CI,R2    XBIT
         BE       *R11
         LW,R2    FLAGS
         CW,R2    BLKFLG
         BAZ      SPA3A
         LW,R2    LINES             DONT START NEW
         SW,R2    CURLINE           TOO NEAR BOTTOM OF
         CI,R2    8                 PAGE
         BG       SPA4
         LW,R2    LINES
         STW,R2   CURLINE
         LI,R7    68                DO TOF,SPACE,ASKLINE
         LI,R6    BA(ASKBUFF)-1
         BAL,R15  BLKER
         B        *R11
SPA3A    CAL1,1   NLINES
         CI,R8    0
         BE       SPA5
         CI,R8    8
         BG       SPA5
         CAL1,1   PAGE
         CAL1,1   ASKLINE
         B        *R11
SPA4     LW,R2    FLAGS
         CW,R2    BLKFLG
         BAZ      SPA5
         LI,R7    0                 SPACE
         BAL,R15  BLKER
         LI,R6    BA(ASKBUFF)-1     ASKLINE
         LI,R7    69
         BAL,R15  BLKER
SPA4A    LI,R7    0
         BAL,R15  BLKER             SPACE
         B        *R11
SPA5     CAL1,1   UPSPACE
         CAL1,1   ASKLINE
SPA5A    CAL1,1   UPSPACE
         B        *R11
         PAGE
*************************************************************************
*        XMOVE - ALLIGN X TYPE COMMENTS
*
*        INPUT R3 - STARTING COLUMN FOR TEXT
*        COMBUF - CONTAINS TEXT
**************************************************************************
         SPACE    2
XMOVE    LI,R4    92                UP TO BUFF+24
         SW,R4    R3
         AI,R3    BA(BUFF)
         STB,R4   R3
         LI,R2    BA(COMBUF)
         MBS,R2   0
         B        *R11
         SPACE    2
*************************************************************************
*        PARMOVE - MOVE SELECTED SORT PARAMETER CURRENT VALUE
*                  TO HEADER
*        INPUT - R2 HOLDS TEXT TO MOVE
*************************************************************************
         SPACE    2
PARMOVE  LW,R5    Y04
         AI,R5    BA(HEADBUF)+11
         LI,R4    8                 BA(R2)
         MBS,R4   0
         B        *R11
         PAGE
*************************************************************************
*        SORTERR - ERROR READING SORT OUTPUT
*****************************************************************************
         SPACE    2
SORTERR  LH,R0    R10
         CI,R0    X'0600'           EOF
         BNE      ERROR
         CAL1,1   CLOSESORT
         B        NXTCMD
         SPACE    2
**************************************************************************
*        ORDRE - REPLACE SELECTED CODES TO PRODUCE CORRECT SORT ORDER
*************************************************************************
         SPACE    2
ORDRE    LB,R1    ORD#
         LI,R7    1
         LB,R6    BUFF,R7
         CB,R6    ORDTBL,R1
         BE       ORDRE1
         BDR,R1   %-2
         B        *R11
ORDRE1   STB,R1   BUFF,R7
         B        *R11
         PAGE
*************************************************************************
*        PAGER - UPDATE PAGE NUMBER IN HEADING FOR BLOCKED WRITE ONLY
*        R10 - LINK
*************************************************************************
         SPACE    2
PAGER    LI,R5    0
         STW,R5   CURLINE
         MTW,1    CURPAGE
         LW,R9    CURPAGE
         LI,R4    10
         LI,R5    3
         LW,R12   BLANKS
PAG1     LI,R8    0
         DW,R8    R4
         OR,R8    XF0
         STB,R8   R12,R5
         CI,R9    0
         BE       %+2
         BDR,R5   PAG1
         STW,R12  PAGE#
         B        *R10
         PAGE
*************************************************************************
*        BLKER - PUT ALL LO OUTPUT INTO A 10REC*120BYTE/REC BLOCK
*
*        INPUT - R6 - SOURCE BUFFER
*                R7 - BYTE COUNT
*                R15 - LINK
*************************************************************************
         SPACE    2
BLKER    MTW,1    CURLINE
         LW,R5    CURLINE           IS PAGE FULL
         CW,R5    LINES
         BLE      BLK1              NO
         BAL,R10  PAGER
         MTW,3    CURLINE           HEADING,SPACE,RECORD
         LW,R8    BLKINDX
         LI,R5    BA(BLOCK)
         AW,R5    R8                WRITE HEADER AND SPACE
         LI,R4    120
         STB,R4   R5
         LI,R4    BA(HEADBUF)
         MBS,R4   0
         AI,R8    120
         CI,R8    1080
         BLE      BLK0
         CAL1,1   WRTBLK
         LW,R8    R1                SAVE R1
         LI,R4    5
         LW,R1    BLKCLR,R4
         MBS,R0   BA(BLANKS)
         BDR,R4   %-2
         LW,R1    R8
         LI,R8    0
BLK0     STW,R8   BLKINDX
         LW,R10   R7                SAVE BYTE COUNT
         LW,R9    R15               AND RETURN
         LI,R7    0                 AND WRITE SPACE
         LI,R15   %+2
         B        BLK1
         LW,R7    R10
         LW,R15   R9
BLK1     LW,R5    BLKINDX
         CI,R7    0                 IF ZERO WRITE BLANK RECORD
         BE       BLK2
         SLS,R7   24                SHIFT BYTE COUNT
         AI,R7    BA(BLOCK)
         AW,R7    R5
         MBS,R6   0
BLK2     AI,R5    120
         CI,R5    1080
         BLE      BLK3
         CAL1,1   WRTBLK
         LW,R8    R1                SAVE R1
CLRBLK   LI,R7    5
         LW,R1    BLKCLR,R7         BLANK FILL BLOCK
         MBS,R0   BA(BLANKS)
         BDR,R7   %-2
         LI,R5    0
         LW,R1    R8                RESTORE R1
BLK3     STW,R5   BLKINDX
         B        *R15
         PAGE
*************************************************************************
*        ERROR - PROCESS ALL IO ERROR NOT HANDLED SPECIFICALLY
*
*        INPUT - R8 AND R10 AS RETURNED TO ERR OR ABN ADDRESS
*
*        OUTPUT - OUTPUTS MESSAGE AND EXITS
***************************************************************************
         SPACE    2
ERROR    LH,R2    R10
         BAL,R11  BINTOHEX
         STW,R4   ERRCODE
         LW,R2    R10
         BAL,R11  BINTOHEX
         STW,R4   DCBADD
         LW,R2    R8
         AI,R2    -1                MAKE REAL CAL ADDRESS NOT CAL+1
         BAL,R11  BINTOHEX
         STW,R4   CALADD
         LI,R1    IOERRMSG
         LI,R0    IOERRSZ
         CAL1,1   DOOUT
         CAL1,9   1
         SPACE    4
***************************************************************************
*        MOVERR - ERR AND ABN FOR MOVE CAL
******************************************************************************
         SPACE    2
MOVERR   LH,R1    R10
         CI,R1    X'0600'           EOF
         BNE      ERROR
         B        SORT              OK - WHOLE FILE MOVED
         PAGE
****************************************************************************
*        BINTOHEX - CONVERT BINARY HALFWORD TO PRINTABLE HEX VALUE
*
*        INPUT - R2 - HALFWORD 1 WILL BE CONVERTED
*
*        OUTPUT - R4 - CONTAINS PRINTABLE HEX
*
*        WORK - R3,R5 DESTROYED - BAL IS ON R11
**************************************************************************
         SPACE    2
BINTOHEX LI,R5    3                 INDEX
         LW,R4    BLANKS
BINHEX0  SLD,R2   -4
         SLS,R3   -28
         CI,R3    X'09'
         BG       BINHEX1
         AI,R3    X'F0'
         B        BINHEX2
BINHEX1  AI,R3    -X'09'+X'C0'
BINHEX2  STB,R3   R4,R5
         AI,R5    -1
         BGEZ     BINHEX0
         B        *R11
         PAGE
****************************************************************************
*        XITCON - TAKE EXIT CONTROL - DELETE TEMP FILES IF THERE
***************************************************************************
         SPACE    2
XITCON   LC       R12
         BCR,4    XITCON1
         BCS,8    LINKERR
         EXU      SORTLNK
         MTW,1    0,R1
         CAL1,8   XCON
         CAL1,9   X'105'            TRTN WITH XCON
XITCON1  CAL1,1   SETDCB
         CAL1,1   PREOPSRT
         CAL1,1   CLOSESORT
         CAL1,1   SETTEMP
         CAL1,1   OTMPREL
         CAL1,1   CTMPREL
         CAL1,9   1
LINKERR  LI,R1    LNKERMSG
         LI,R0    LNKERSZ
         CAL1,1   DOOUT
         CAL1,9   1
         PAGE
*******************************************************************************
*        NXTCMD - CLEAR AND RESET BUFFERS AND DATA FOR NEXT COMMAND
*************************************************************************
         SPACE    2
NXTCMD   LW,R1    FIRSTCLR
         MBS,R0   BA(ZERO)
         LW,R1    FLAGS
         CW,R1    BLKFLG
         BANZ     NXT0              NO NEW PAGE IF BLOCKED WRITE
         LC       J:JIT
         BCS,15   NXT0              ONLY PAGE BETWEEN CMDS IF BATCH
         CAL1,1   PAGE
NXT0     LI,R1    ALLBITS
         STW,R1   FLAGS
         LI,R1    0
         STW,R1   SAVESEQ
         STW,R1   LASTTYPE
         STW,R1   CMDHOLD
         STW,R1   #PARM
         STW,R1   DBMODE
         STW,R1   DBACC
    STW,R1  EINXTSN
         STW,R1   DBORG
         STW,R1   EISN
         STW,R1   SEQ#
         STW,R1   CURPAGE
         STB,R1   ORD#
         STW,R1   LINES
         LI,R1    1
         STW,R1   BIBTD
         LI,R1    -1
         STW,R1   MODINDX
         LW,R1    HEADCLR
         MBS,R0   BA(BLANKS)
         LI,R1    95
         SLS,R1   24
         STW,R1   HEADBUF
         LW,R1    EINAMCLR
         MBS,R0   BA(BLANKS)
         LW,R1    EIACTCLR
         MBS,R0   BA(BLANKS)
         LW,R1    DBNAMCLR
         MBS,R0   BA(BLANKS)
         LW,R1    DBACTCLR
         MBS,R0   BA(BLANKS)
         LW,R1    DBPASCLR
         MBS,R0   BA(BLANKS)
         LW,R2    BLKINDX
         BEZ      NXT1
         CAL1,1   WRTBLK
         BAL,R15  CLRBLK            BLANK FILL BLOCK
NXT1     CAL1,1   BLKCLS
         B        EXTRACT
ENDCMD   CAL1,1   CLOSELO
         CAL1,9   1
PATCH    RES      50
         END      EXTRACT
