*****************
*M*      GENMD    PROCESS GENMD COMMANDS
*****************
*P*      NAME:    GENMD
*P*      PURPOSE: APPLY PATCHES TO LOAD MODULES.
*P*      DESCRIPTION: TWO VERSIONS OF GENMD ARE GENERATED. THE GHOST1
*P*       VERSION IS LOADED WITH GHOST1 AND APPLIES THE PATCH DECK GENMD
*P*       COMMANDS. IT IS ALL PROCEDURE AND STORES IN ITSELF, ASSUMING THAT
*P*       GHOST1 WILL NOT BE THROWN AWAY DURING THE PATCHING PROCESS.
*P*       IT DOES NOT CONTAIN CODE FOR FUNCTIONS SPECIFIC TO ONLINE USE,
*P*       E.G. DELTA COMMANDS, QUESTION MARK(HELP), AND KEYIN INPUT.
*P*       IT HAS SLIGHTLY DIFFERENT DCB ARRANGEMENTS AND IS ENTERED FROM
*P*       BITOTM AND RETURNS TO GHOST1D. THE ONLINE VERSION IS ALL DATA
*P*       HAS A START ADDRESS, AND EXITS VIA M:EXIT.
*P*       THE ONLINE VERSION READS COMMANDS THROUGH M:C, UPDATES THE
*P*       LOAD MODULE THROUGH M:SI (MAKING GENMD LMN WORK AUTOMATICALLY),
*P*       OUTPUTS THROUGH M:LL, AND CREATES DELTA SYMBOL TEMP FILES THROUGH
*P*       M:GO. THE GHOST1 VERSION USES, RESPECTIVELY, M:PATCH, M:TM, M:LL,
*P*       AND DOESN'T CREATE DELTA SYMBOL TEMP FILES.
         SYSTEM   SIG7FDP
GHO      SET      1
ONL      SET      1-GHO
         DO       GHO
GENMD    DSECT    1
         REF      PAS0RTN           EXIT FOR GHOST1 VERSION
         REF      GHOST1            START ADDRESS FOR GHOST1 VERSION
         REF      BOOTFLG           DONT CHECK REPLACEMENT IF OLD FILES
BEGIN    EQU      GHOST1
         B        GBEGIN
         REF      M:TM              LOAD MODULE FOR GHOST1 VERSION
         REF      M:PATCH           COMMANDS FOR GHOST1 VERSION
M:SI     EQU      M:TM
M:C      EQU      M:PATCH
         ELSE
         REF      M:SI              LOAD MODULE FOR ONLINE VERSION
         REF      M:C               COMMANDS FOR ONLINE VERSION
         DEF      GENMD             FOR PATCHING
GENMD    RES
         FIN
         REF      M:LL              LISTING OUPUT
*        FILE IO FPTS
*
*
READHEAD GEN,8,24 X'10',M:SI
         DATA     X'F8000000'
         PZE      OABN
         PZE      OABN
         PZE      HBUF
         DATA     48
         DATA     HEADT
HEADT    RES
         TEXTC    'HEAD'
READTREE GEN,8,24 X'10',M:SI
         DATA     X'F8000000'
         DATA     OABN,OABN
TBUF     DATA     TBUFA
         DATA     X'1000'
         PZE      %+1
TKEY     TEXTC    'TREE'
OPENSI   GEN,8,24 X'14',M:SI
         DATA     X'C1000000'
         DATA     OABN,OABN
         DATA     4                 INOUT
         DATA,1   1,0,3,3
SIFILE   RES      3
         DATA,1   2,0,2,2
SIACCN   RES      2
         DATA,1   3,1,2*ONL,2
SIPSWD   RES      2
         DO       ONL
SIIN     GEN,8,24 20,M:SI
         DATA     X'1000000',1
INONLY   DATA     0
LLSAV    GEN,8,24 21,M:LL
         DATA     X'80000000',2
         FIN
44ERR    GEN,8,24 X'44',M:SI
CLOSE    GEN,8,24 X'15',M:SI
         PZE      *0
         DATA     2
READREC  GEN,8,24 X'10',M:SI
         DATA     X'F8000010'
         DATA     RABN,RABN
RECBUF   DATA     0
RECSIZE  DATA     X'FFFFF'
         DATA     KEY
KEY      RES      4
WRITE    GEN,8,24 X'11',M:SI
         DATA     X'F8000010'
         DATA     RABN,RABN
         PZE      *RECBUF
         PZE      *RECSIZE
         PZE      KEY
SPF      GEN,8,24 X'1C',M:SI
         DATA     X'10'
RLST     GEN,8,24 X'10',M:SI
         DATA     X'F8000010'
         DATA     RABN,RABN
         PZE      BUF
         DATA     81
         PZE      LKEY
WLST     GEN,8,24 X'11',M:SI
         DATA     X'38000050'
         PZE      *14
         PZE      *2
         PZE      LKEY
LKEY     RES      1
LKEY0    DATA     X'3FF0000'
SETDCB0  GEN,8,24 6,M:SI
         DATA     X'C0000000',LSTE,OABN
SETDCB   GEN,8,24 6,M:SI
         DATA     X'C0000000'
         DATA     RABN,RABN
         DO       ONL
         PAGE
*        DELTA ASSOCIATION FPTS
*
         REF      M:GO              DELTA SYMBOL TABLE FILES (ONLINE)
*
ASSDEL   GEN,8,7,17 4,1,%+3
DELTXT   TEXTC    'DELTA'
         DATA     GET,PUT,READCOM,DELLMN
DETXT    TEXTC    'DE'
DELOPN   GEN,8,24 X'14',M:GO
         DATA     X'7400001'
         DATA     2,2,2,2
         DATA,1   1,1,1,1
DELFIL   DATA     0,0,0
DELLMN   RES      7
DELRD    GEN,8,24 X'10',M:SI
         DATA     X'F0000010'
         DATA     DRDAB,DRDAB
         PZE      *RECBUF
DELSZ    DATA     0
DELFLG   EQU      DELFIL
DISDEL   GEN,8,24 5,0
         TEXTC    'DELTA'
DELWRT   GEN,8,24 X'11',M:GO
         DATA     X'38000030'
         PZE      *RECBUF
         PZE      *M:SI+13
         PZE      KEY
DELWRTHT GEN,8,24 X'11',M:GO
         DATA     X'38000030'
         RES      3
DELTEMP  GEN,8,24 X'F',M:GO
         DATA     X'18000050'
         DATA     0,DELFIL
DELCLS   GEN,8,24 X'15',M:GO
         PZE      *0
         DATA     2
         FIN
         PAGE
*        CONTROL COMMAND FPTS
*
*
READCB   GEN,8,24 X'10',M:C
         DATA     X'74000000'
         PZE      CABN
         PZE      BUF
         DATA     80
         DATA     1
PRINT    GEN,8,24 1,0
         PZE      *0
         PZE      *14
BUF      DO1      21
         DATA     0
         PAGE
*        POINTERS AND SUCHLIKE
*
*
RFDFPTR  DATA     0
RFDFEND  DATA     0
SEGPTR   DATA     0
VALUE    DATA     0
VLOC     DATA     0
         BOUND    8
RECLIMS0 DATA     1
RECLIMS  DATA     0
GP       DATA     X'8000000'
FP       DATA     X'9000000'
TVEC     DATA,1   0,3,5,7
LOCTBUF  DATA     0
HEXES    TEXT     '0123456789ABCDEF'
CURDLM   RES      1
GENMDF   DATA     0
BUFEND   DATA     0
OPNFLG   DATA     0
REPFLG   DATA     0
DIC      DATA     0
ERRCOUNT DATA     0
TEN      DATA     10
         PAGE
*        COMMAND SCAN TRANSLATE TABLE
*
*
*        MASK BITS:
*/NOT A-N/NOT BLNK/ ; / . /  / , / - /EOR OR ./
*/       /        /   /   /  /   /    +       /
TTBL     DO1      16
         DATA     'AAAA'
         DATA     X'88C0C0C0'
NAB      EQU      X'C0C0C0C0'
         DATA     NAB
         DATA     NAB+17            .
         DATA     NAB+X'60300'      ( +
         DATA     NAB
         DATA     NAB
         DATA     NAB-X'80'         %
         DATA     NAB+X'52000'      ) ;
         DATA     X'C2C0C0C0',NAB,NAB+4,NAB-X'800080'
         DATA     NAB,NAB,NAB-X'8080',X'40C0C0C0'
         DO1      16
         DATA     NAB
         DO1      3
         DATA     X'C0404040','    ',X'4040C0C0',NAB
BLANKS   DATA     '    ','    ',X'4040C0C0',NAB
         PAGE
*        COMMAND SCAN POINTERS
*
*
BUFPTR   GEN,8,24 81,BA(BUF)+1
INCR     GEN,8,24 -1,1
NALF     GEN,8,24 X'80',0
NBLNK    GEN,8,24 X'77',0
DLMSK    GEN,8,24 7,0
SIACCNP  GEN,8,24 8,BA(SIACCN)
SIPSWDP  GEN,8,24 8,BA(SIPSWD)
SEMI     GEN,8,24 X'60',0
DLMBLK   GEN,8,24 X'2F',0
SIFILEP  GEN,8,24 12,BA(SIFILE)
         PAGE
*        TEXT STRINGS
*
*
GENMDT   TEXTC    'GENMD'
:GENMDT  TEXTC    ':GENMD'
ATTEXT   TEXTC    '@'
ENDTXT   TEXTC    'END'
LSTTXT   TEXTC    'LIST'
DELETET  TEXTC    'DELETE'
         GEN,8,24 2,'DA('
         GEN,8,24 2,'WA('
         GEN,8,24 2,'HA('
         GEN,8,24 2,'BA('
ADDRFS   DATA     X'7F000102'
         DO       ONL
PROMPT   TEXTC    ':'
TEXTCR   CNAME
         PROC
LF       RES      0
         TEXTC    AF
         PEND
QTXT     TEXTC    '?'
INFO     TEXTCR   'ACCEPTABLE INPUT:'
         TEXTCR   ' ( :GENMD [,SEGN] )'
         TEXTCR   ' <                > LOC,VAL1 [(REPL1)],...,VALN',;
                  ' [(REPLN)]'
         TEXTCR   ' (    [SEGN] ,    )'
         TEXTCR   '   WHERE:'
         TEXTCR   '    SEGN=SEGMENT TO BE PATCHED'
         TEXTCR   '     IF SEGN IS OMITTED, PREV SEGN OR ROOT ASSUMED'
         TEXTCR   '     SEGN MAY BE SPECIFIED WITH NO LOC OR VAL'
         TEXTCR   '     IF SEGN=''DELTA'', DELTA IS ENTERED'
         TEXTCR   '     IF SEGN=''DE'', DELTA IS ENTERED'
         TEXTCR   '        BUT NO SYMBOL TABLES ARE AVAILABLE'
         TEXTCR   '     -IN DELTA, 0-5 CONTAIN SEGMENT LIMITS'
         TEXTCR   '        AND 6 HAS START ADDRESS WORD OF HEAD'
         TEXTCR   '     -TO RETURN FROM DELTA, TYPE ;G(RET)'
         TEXTCR   '     IF SEGN=''LIST'', PATCHES ARE LISTED'
         TEXTCR   '     IF SEGN=''DELETE'', THE LIST IS REMOVED'
         TEXTCR   '        FROM THE LOAD MODULE'
         TEXTCR   '     IF SEGN=''END'', GENMD EXITS'
         TEXTCR   '     IF SEGN=''GENMD'', FORMAT IS:'
         TEXTCR   '           GENMD LMN[.[ACCT][.PASSWORD]]'
         TEXTCR   '        AND LMN BECOMES PATCHABLE'
         TEXTCR   '        UNLESS WRITE ACCESS IS DENIED, IN WHICH CASE'
         TEXTCR   '        OPERATION IS UNCHANGED EXCEPT NO RECORDS ARE'
         TEXTCR   '        WRITTEN TO THE LOAD MODULE.'
         TEXTCR   '    LOC=DEF+/-HEX, DEF, OR +/-HEX'
         TEXTCR   '      LOC=@ => START ADDRESS WORD IN HEAD'
         TEXTCR   '    VALI=HEX+/-DEF...+/-DEF OR HEX'
         TEXTCR   '    REPLI=DESIRED REPLACED VALUE, FORMAT AS VALI.'
         TEXTCR   '      FOR VALI AND REPLI, ANY DEF MAY BE PRECEDED'
         TEXTCR   '      BY BA(, HA(, WA(, OR DA( AND FOLLOWED BY ) '
         TEXTCR   '      FOR ADDRESS RESOLUTION (IGNORED FOR ADEFS).'
         TEXTCR   'CONTINUATION IS INDICATED BY ; ANYWHERE A BLANK IS'
         TEXTCR   'PERMITTED. IF :GENMD IS USED, CONTINUATIONS MUST'
         TEXTCR   'HAVE A : IN THE FIRST BYTE, WHICH IS THEN IGNORED.'
         TEXTCR   'ANY ERROR CAUSES THE REST OF THE COMMAND (INCLUDING'
         TEXTCR   'CONTINUATION) TO BE IGNORED.'
         TEXTCR   'LINES ARE TERMINATED BY ''.'' OR ANY CHAR < BLANK'
         DATA     0                 TERMINATES SALUTATION
GENHERE  TEXTC    'GENMD HERE'
         FIN
HBUF     RES      12
         DO       GHO
GBEGIN   LI,9     1                 GET A PAGE TO DETERMNE BUFEND
         OR,9     GP
         CAL1,8   9
         BCS,8    %+2
         AI,9     X'200'
         STW,9    BUFEND
         B        READCOM
         ELSE
         PAGE
*        CODE
BEGIN    LC       *X'4F'
         BCR,12   START0
         BCS,8    %+2
         MTB,1    PRINT
         LI,14    GENHERE
         CAL1,2   PRINT
START0   LI,3     7
         AND,3    M:SI
         BDR,3    READCOM
         FIN
START    CAL1,1   OPENSI
         LI,10    X'F0'
         AND,10   M:SI+5
         CI,10    X'20'             MUST BE KEYED
         BNE      OABN
         CAL1,1   READHEAD
         DO       ONL
         LW,8     HBUF+7            GET MAX SYMTAB SIZE
         LW,9     HBUF+8
         SLS,8    -17
         SLS,9    -17
         CW,8     9
         BL       %+2
         LW,9     8
         SLS,9    2
         STW,9    DELSZ
         FIN
         INT,9    HBUF+5            TREE SIZE
         LW,10    9
         SLS,10   2
         STW,10   TBUF+1
         AW,9     TBUF
         BAL,11   GPGS
         XW,9     TBUF
         BNEZ     %+2
         LW,9     TBUF
         STW,9    TBUF
         CAL1,1   READTREE
         AW,9     *TBUF
         STW,9    RFDFPTR
         STW,9    RFDFEND
         LW,4     TBUF
         AI,4     1
         STW,4    SEGPTR
INITLOOP LW,11    6,4               SAVE RFDFSIZE
         SLS,11   -16
         STW,11   4,4
         LI,11    5
SETLIMS  LW,8     *11,4
         SLD,8    -16
         SLS,9    -16
         SLD,8    1
         AW,8     9
         AI,8     -1
         STW,9    *11,4
         AI,11    1
         STW,8    *11,4
         AI,11    1
         CI,11    11
         BL       SETLIMS
         AI,4     11
         CW,4     RFDFPTR
         BL       INITLOOP
         LW,9     RFDFEND
         STW,9    RECBUF
         LW,3     LKEY0             FIND END OF LIST
         STW,3    LKEY
         CAL1,1   SETDCB0
         CAL1,1   RLST              READ UNTIL NO DATA OR RECORD
         MTW,1    LKEY
         MTW,0    BUF
         BNEZ     %-3
         MTW,-1   LKEY              REWRITE ZERO RECORD
LSTE     CAL1,1   SETDCB            SET READ ERR/ABN ADDRESSES
         MTB,-1   OPNFLG            SET OPEN FLAG
*        READ COMMANDS
READCOM  RES      0
         MTH,-1   GENMDF            REST GENMD FLAG
         BAL,15   READC
         LW,3     BUFPTR
         LW,2     NBLNK
         TTBS,2   TTBL
         BAL,11   GETALF
         BEZ      NOSEG
         LW,5     6
         LI,4     BA(ENDTXT)
         CBS,4    0
         BE       END
         LW,5     6
         LI,4     BA(GENMDT)
         CBS,4    0
         BE       ENDGFN
         DO       ONL
         LW,5     6
         LI,4     BA(QTXT)
         CBS,4    0
         BNE      NOTQ
         MTW,-1   LKEY
         LI,14    INFO
NXTLIN   LB,3     *14
         BEZ      READCOM
         CAL1,2   PRINT
         AI,3     4
         SLS,3    -2
         AW,14    3
         B        NXTLIN
NOTQ     EQU      %
         FIN
         LC       OPNFLG            IF NO FILE OPEN,
         BEZ      NOFILEN           NOTHING ELSE LEGAL
         DO       ONL
         LC       *X'4F'
         BCR,12   NOTDELTA
         LW,5     6
         LI,4     BA(DETXT)
         CBS,4    0
         BNE      NOTDE
         MTW,-1   LKEY
         LI,4     0
         XW,4     DELFLG            IF ALREADY THERE, JUST GO THERE
         BNEZ     DELCAL
         STW,4    DELLMN+4          ZAP LMN NAME
         B        DELCAL
NOTDE    EQU      %
         LW,5     6
         LI,4     BA(DELTXT)
         CBS,4    0
         BNE      NOTDELTA
         MTW,-1   LKEY
         LI,3     0
         XW,3     DELFLG            IF ALREADY ASSOC, JUST GO THERE
         BNEZ     DELCAL
         LCI      9                 USE THE LMN IF INONLY
         LM,0     M:SI+23           0=FN,4=ACCT,7=PSWD
         LCI      3
         STM,4    DELLMN
         STM,7    DELLMN+2
         STM,0    DELLMN+4
         LW,3     INONLY
         BNEZ     DELCAL
         XW,3     RECLIMS
         BEZ      %+2
         CAL1,1   WRITE
         INT,3    *X'4F'
         SLS,3    8
         MTB,3    3
         AI,3     'S'
         STW,3    DELFIL
         STW,3    DELLMN+4
         CAL1,1   DELOPN
         LW,9     DELSZ             GET MAX RECORD SIZE
         SLS,9    -2                IN WORDS
         AW,9     RECBUF
         BAL,11   GPGS
         CAL1,1   SPF               READ FROM FIRST RECORD TO LKEY0
DELLOOP  CAL1,1   DELRD
DRDAB    EQU      %
         LCI      3
         LM,3     *M:SI+10
         STM,3    KEY
         CW,3     LKEY0
         BE       DELEX
         CW,3     PGKYMSK           IF PAGE RECORD, DONT COPY
         BAZ      DELLOOP
         LB,3     KEY
         LB,4     KEY,3
         CI,4     9
         BE       %+3
         CI,4     X'10'
         BNE      DELLOOP
         CI,4     9
         BNE      NOT9
         LW,3     DELFIL
         STW,3    KEY
         MTB,1    KEY
         STB,4    KEY+1
NOT9     EQU      %
         CAL1,1   DELWRT
         B        DELLOOP
PGKYMSK  DATA     X'FC00FF00'
DELEX    LCI      3
         LM,3     READHEAD+4
         STM,3    DELWRTHT+2
         CAL1,1   READHEAD          WRITE A GOOD HEAD
         CAL1,1   DELWRTHT
         LI,3     TKEY
         STW,3    DELWRTHT+4
         LI,3     DELFIL-1
         STW,3    DELWRTHT+2
         CAL1,1   DELWRTHT
         CAL1,1   DELCLS
         LCI      3
         LM,3     *X'4F'
         STM,4    DELLMN
         CAL1,1   DELTEMP
DELCAL   MTW,1    DELFLG            SET FLAG
         CAL1,4   ASSDEL
*        DOESN'T COME BACK
NOTDELTA EQU      %
         FIN
         LW,5     6
         LI,4     BA(DELETET)
         CBS,4    0
         BNE      %+4
         LW,5     LKEY0             DELETE , START OVER
         STW,5    LKEY
         B        READCOM
         LI,4     BA(LSTTXT)
         CBS,4    0
         BNE      NOTL
         MTW,-1   LKEY
         LI,14    BUF
         LI,2     13
         LW,5     LKEY0
         XW,5     LKEY
LIST1    CW,5     LKEY
         BLE      READCOM           DONE
         CAL1,1   RLST
         MTW,1    LKEY
         CAL1,2   PRINT
         B        LIST1
NOTL     EQU      %
         LW,5     6
         LI,4     BA(:GENMDT)
         CBS,4    0
         BNE      NOT:GENMD
         LI,4     X'44'             FLAG FOR COMMA
         STW,4    GENMDF
         CB,4     0,3               IS NEXT A BLANK
         BLE      %+5               NO
         LW,2     NBLNK             IF NEXT CHAR IS ALPHA,
         TTBS,2   TTBL              MUST BE MISSING SEGNAME
         CB,4     2                 IS THIS A COMMA
         BNE      LOCSCAN           NO, MUST BE MISSING SEGNAME
         BAL,11   GDLM
         BCS,15   DERR              MUST BE COMMA
         BAL,11   GETALF
         BEZ      SEGERR1
         LB,1     0,3
         CI,1     ' '
         BNE      DERR
         LI,1     ','
         STB,1    0,3
NOT:GENMD EQU     %
         LW,8     TBUF
         AI,8     1
FNDSEG   LW,4     8
         SLS,4    2
         LW,5     6
         CBS,4    0
         BE       %+5
         AI,8     11
         CW,8     RFDFPTR
         BL       FNDSEG
         B        SEGERR1
         CW,8     SEGPTR
         BE       NOSEG
         STW,8    SEGPTR
         LI,8     0
         XW,8     RECLIMS
         BEZ      NOSEG
         CAL1,1   WRITE
NOSEG    BAL,11   GDLM
         BCS,8    READCOM           DONE, MUST BE SET SEG FOR DELTA
         BCS,7    DERR              ELSE MUST BE COMMA
         LC       OPNFLG            IF NO FILE, SAY SO
         BEZ      NOFILEN
LOCSCAN  EQU      %
         LI,9     0
         STW,9    REPFLG
         LI,10    X'10001'
         BAL,11   GETALF
         BEZ      %+2
         BAL,11   NAMVAL
LOCNAM   RES
         BAL,11   GDLM
         BCS,9    DERR              MUST BE + - OR ,
         BCR,6    STLOC             IF , LOC IS FINISHED
         BCR,4    %+2               IF + ADD HEX
         LI,10    -1
         BAL,11   HEX
         BAL,11   GDLM
         BCS,15   DERR              MUST BE COMMA
STLOC    RES
         STW,9    VLOC
STOREVAL RES
         BAL,0    GETREC
         LI,10    X'10001'
         LI,9     0
         BAL,11   HEX
PLUSNAM  BAL,11   GDLM
         BCR,6    STVAL             VAL DONE IF , OR EOM
         BCS,1    REPCHK            IF ( OR ) MUST BE REPLACED INST
         BCR,4    %+2               IF + ADD
         LI,10    X'F0001'          SET NEG BUT WORD RESOLUTION
         BAL,11   GETALF
         BEZ      NAMERR
         LW,4     6
         LI,5     11*4
         MTB,4    5
         MBS,4    0
         LI,4     -4
CHKADDRF CW,11    ADDRFS,4
         BNE      NOTADDRF
         LB,4     ADDRFS+1,4
         AW,10    4
         AI,10    X'8000'           SET FLAG
         AW,3     INCR              SKIP (
         BAL,11   GETALF            GET REAL NAME
         BEZ      NAMERR
         B        %+2
NOTADDRF BIR,4    CHKADDRF
         BAL,11   NAMVAL
         CI,10    X'8000'           DO WE NEED RPAREN
         LI,10    X'10001'          RELOAD 10 (NOT CHANGING CC=4)
         BAZ      PLUSNAM
         BAL,11   GDLM
         BCR,1    DERR
         BCR,4    DERR
         B        PLUSNAM
REPCHK   XW,9     VALUE
         XW,11    REPFLG
         BCR,7    STOREVAL
         BEZ      DERR
         BCR,4    DERR
         MTB,-1   REPFLG            GOT BOTH OF THEM
         BAL,11   GDLM
         BCS,7    DERR
STVAL    LW,4     VLOC
         LI,11    0
         XW,11    REPFLG
         BGZ      DERR              DIDNT GET )
         BEZ      NOREP
         LW,10    *LOCTBUF,4        DOES IT MATCH
         CW,10    VALUE
         BE       NOREP
         LW,11    4                 NO
         BAL,15   REPERR            SET UP MESSAGE
         CW,9     *LOCTBUF,4        IS THE NEW VALUE
         BNE      CRREAD            NO, REAL ERROR
         BAL,15   LSTTXTC
         CAL1,2   PRINT
NOREP    STW,9    *LOCTBUF,4
         MTW,1    VLOC
         MTW,-1   CURDLM            CONTINUE IF NOT EOM
         BNEZ     STOREVAL
         B        READCOM
         PAGE
*        GETALF RETURNS CC=0 IF NEXT TNOT ALFANUMERIC
*        RETURNS POINTER FOR CBS IN 6 IF LEGAL A-N FIELD
*
*
GETALF   LW,6     3
         LW,2     NALF
         TTBS,2   TTBL
         CW,3     6
         BE       *11
         AI,6     -1
         LB,2     6
         LB,1     3
         SW,2     1
         STB,2    6
         STB,2    0,6
         MTB,1    6
         B        *11
         PAGE
*        GDLM RETURNS CONDITION CODES ACCORDING TO DELIMITER
*        CC=8     DOT, CR, LF, ENDOFLINE, ETC.
*        CC=4     DASH
*        CC=2     PLUS
*        CC=0     COMMA
*        CC=5     RPAREN
*        CC=6     LPAREN
*
*
GDLM     LW,2     NBLNK
         TTBS,2   TTBL
         CW,2     SEMI
         BNE      %+2
         BAL,4    CONTREC
         AND,2    DLMSK
         LB,4     2
         BEZ      DERR
         STW,4    CURDLM
         BDR,4    %+2               STOP AT THE END
         B        %+2
         AW,3     INCR
         LW,2     NBLNK
         TTBS,2   TTBL
         CW,2     SEMI
         BNE      %+2
         BAL,4    CONTREC
         LW,4     CURDLM
         EXU      %+1,4
         B        *11
         LCI      8
         LCI      4
         LCI      2
         LCI      0
         LCI      5
         LCI      3
*
CONTREC  RES      0
         BAL,15   READC
         LW,3     BUFPTR
         LB,14    0,3
         CI,14    ':'
         BNE      -5,4
         MTW,0    GENMDF
         BLEZ     -5,4
         AW,3     INCR
         B        -5,4
READC    LI,14    BUF
         STW,15   HBUF+1
READC0   RES
         LW,1     BUFPTR
         MBS,0    BA(BUF+20)+3
         DO       ONL
         LC       *X'4F'
         BCR,12   READC1
         LI,3     2                 IF C IS A FILE, READ IT
         CW,3     M:C
         BAZ      READC1
         CAL1,2   KEYIN
         LC       ECB
         BCS,8    %-1
         B        PRTREC0
KEYIN    DATA     X'4000000',X'F0000000',PROMPT,BUF,81
ECB      EQU      TEN
         FIN
READC1   CAL1,1   READCB
         LH,3     M:C+4
         SLS,3    -1
         STB,3    BUF
         CAL1,2   PRINT
PRTREC0  RES
         LI,3     1                 SKIP COMMENTS
         LB,1     BUF,3
         CI,1     '!'               IS IT BANG
         BE       CABN              YES, TREAT LIKE EOF/D
         BAL,15   PRTREC            PUT IN FILE
         CI,1     '*'               SKIP COMMENTS
         BE       READC0
         CI,1     '<'
         BE       READC0
         CI,1     '#'               ALSO SKIP CONTROL
         BE       READC0
         DO       GHO               IF GHOST SKIP SKIPPED PATCHES
         MTW,0    BUF+20
         BLZ      READC0
         LB,3     BUF+18            LAST REAL CHAR
         SLS,3    24
         STW,3    BUF+18            PUT 3 EOMS AFTER
         FIN
         B        *HBUF+1
PRTREC   LB,3     BUF
         LB,2     BUF,3
         AI,2     -' '
         BGZ      %+2
         BDR,3    %-3
         STB,3    BUF
LSTTXTC  LB,2     *14
         BEZ      *15
         LC       OPNFLG
         BEZ      *15
         AI,2     1
         LW,0     10                SAVE 10
         CAL1,1   WLST
         LW,10    0                 SET MOST PROBABLY 10 VALUE
         MTW,1    LKEY
         B        *15
         PAGE
*        HEX CONVERTS NEXT STRING FROM HEX
*        MULTIPLIES BY (10)
*        ADDS INTO (9)
*
*
HEX      LI,7     0
         LI,15    8
         LB,2     0,3
         LI,1     15
         CB,2     HEXES,1
         BE       %+3
         BDR,1    %-2
         CB,2     HEXES
         BNE      %+5
         SLS,7    4
         AW,7     1
         AW,3     INCR
         BDR,15   HEX+2
         CI,15    8
         BE       HEXERR            NO HEX
         LW,15    3
         LW,14    DLMBLK
         TTBS,14  TTBL
         CW,15    3
         BNE      HEXERR
         LH,15    10
         MW,7     15
         AW,9     7
         B        *11
         PAGE
*        GPGS ADJUSTS BUFFER SIZE TO END AFTER (9)
*
*
GPGS     SW,9     BUFEND
         BLEZ     RLSPG
         AI,9     X'1FF'
         SLS,9    -9
         OR,9     GP
         CAL1,8   9
         STCF     11                SAVE ERROR FLAG
         SLS,8    9
         AW,8     9
         STW,8    BUFEND
         LC       11                IF NOT ENOUGH
         BCR,8    SETRSZ            THROW OUT THE RFDF STACKS
         LW,8     RFDFPTR
         STW,8    RFDFEND
         SW,8     RECBUF            ADJUST BUFFER ADDR
         AWM,8    RECBUF            AND CONVERSION FACTOR
         AWM,8    LOCTBUF
SETRSZ   LW,8     BUFEND
         SW,8     RECBUF
         SLS,8    2
         STW,8    RECSIZE
         LC       11                SET FLAG IN CASE RFDF READ
         B        *11
RLSPG    LCW,9    9
         AI,9     -X'1FF'
         BLEZ     SETRSZ
         SLS,9    -9
         OR,9     FP
         CAL1,8   9
         SLS,8    9
         LCW,8    8
         AWM,8    BUFEND
         B        SETRSZ
         PAGE
*        NAMVAL CONVERTS A-N NAME (DEF) TO WORD ADDRESS
*        POINTER TO NAME IN (6) (FROM GETALF)
*
*
NAMVAL   LW,8     RFDFPTR
         CI,11    LOCNAM
         BNE      NAMVAL0
         LW,5     6
         LI,4     BA(ATTEXT)
         CBS,4    0
         BNE      NAMVAL0
         LI,9     -2                MAKE START ADDRESS
         BAL,11   GDLM              MUST NOT HAVE ADDEND
         BCS,15   DERR
         B        STLOC
NAMVAL0  RES
         CW,8     RFDFEND           IF NONE, READ IT (THEM)
         BNE      NAMVAL1
         LCI      0
         STM,0    HBUF+1            SAVE REGISTERS
         LW,4     TBUF
         AI,4     1
         LI,7     0
         XW,7     RECLIMS
         BEZ      %+3
         MTB,1    HBUF+11+1         SET FLAG IN RETURN REG
         CAL1,1   WRITE
RFDFLOOP LCI      3
         LM,0     0,4
         STM,0    KEY
         MTB,1    KEY
         LB,1     KEY
         LI,2     0
         STB,2    KEY,1
         LW,8     RFDFEND
         STW,8    RECBUF
         LW,9     4,4
         AW,9     RECBUF
         STW,9    RFDFEND
         BAL,11   GPGS
         BCS,8    NOPGS             CANT DO IT
         CAL1,1   READREC
         AI,4     11
         CW,4     RFDFPTR
         BL       RFDFLOOP
         LW,9     RFDFEND
         STW,9    RECBUF
         LCI      0
         LM,0     HBUF+1            RESTORE REGISTERS
         LW,8     RFDFPTR
NAMVAL1  EQU      %
         LI,4     X'70000'          DEF IS 0 OR 8
         AND,4    *8
         BEZ      %+3
         CI,4     X'30000'          DSECT IS 3
         BNE      NXTENT
         LW,4     8
         SLS,4    2
         AI,4     12
         LW,5     6
         CBS,4    0
         BE       FNDNAM
NXTENT   LB,4     *8
         BEZ      NAMERR            GET OUT IF LOOPING WOULD START
         AW,8     4
         CW,8     RFDFEND
         BL       NAMVAL0
         B        NAMERR
FNDNAM   LW,5     8
         LW,8     2,5               RELOC WORD
         LW,5     1,5               VALUE
         INT,7    10
         LI,4     -4
         MTB,0    9,4               CHECK TYPE
         BNEZ     %+3               GOT IT
         BIR,4    %-2
         B        %+3               ABS, DONT SHIFT OR HONOR ADDRESSING
         AI,4     1
         SLS,5    *7,4
         LH,8     10
         MW,5     8
         AW,9     5
         MTB,0    11                DO FLIPPY-FLOPPY IF NECESSARY
         BEZ      *11
         LCI      0                 TO GET RECORD BACK IN
         STM,0    HBUF+1
         BAL,0    GETREC
         LCI      0
         LM,0     HBUF+1
         B        *11
         PAGE
*        ERROR RETURNS
*
*
OABN     EQU      %
         DO       ONL
         XW,10    INONLY            TRY OPENING INOUT, ONCE
         BNEZ     OABN1
         CAL1,1   SIIN
         LI,14    INONLYM
         CAL1,2   PRINT
         B        *8
INONLYM  TEXTC    'OPENED FOR INPUT ONLY'
OABN1    RES
         FIN
         BAL,15   CLEANUP           CLOSE DCB IF OPEN
RABN     EQU      %
         DO       ONL
         CW,10    44ERR
         BE       *8
         FIN
         CW,10    43ERR             MEBBE MISSING PAGE OF PAGED ONE
         BNE      NOTPGER
         LW,8     KEY               CHECK KEY FOR PAGE TYPE
         MTB,-3   8
         BNEZ     NOTPGER
         CI,8     X'FF00'
         BANZ     NOTPGER
         LI,8     X'800'            SET RECORD SIZE
         STW,8    RECSIZE
         B        *0
43ERR    GEN,8,24 X'43',M:SI
NOTPGER  RES
         LI,8     0
         STW,8    RECLIMS
         BAL,14   PRQUIT0
         TEXTC    'BAD LMN 00-00'
PRQUIT0  SLD,10   -24
         SLS,10   1
         SLD,10   7
         LI,15    CRREAD
HXMSG    RES
         LB,6     *14
PRQUIT1  LI,7     15
         AND,7    10
         LB,7     HEXES,7
         STB,7    *14,6
         SCD,10   -4
         AI,6     -1
         LC       *14,6
         BCS,8    PRQUIT1
         BCS,3    %-3
         B        *15
CLEANUP  LI,8     0
         DO       ONL
         CAL1,4   DISDEL
         STW,8    DELFLG
         STW,8    INONLY            CLEAR IN ONLY
         FIN
         LC       OPNFLG            IF NOT VERIFIED
         STW,8    OPNFLG            DONT MESS WITH IT
         BEZ      CLEANUP1
         XW,8     RECLIMS
         BEZ      %+2
         CAL1,1   WRITE
         LI,14    OPNFLG            WRITE A WORD OF ZEROES
         LI,2     81                FULL SIZE
         MTW,-1   LKEY              AS THE LAST RECORD
         CAL1,1   WLST
CLEANUP1 LH,8     M:SI              CLOSE IF OPEN
         CI,8     X'20'
         BAZ      %+2
         CAL1,1   CLOSE
         B        *15
CABN     EQU      %
         MTW,1    LKEY              MAKE ROOM FOR LAST RECORD
END      RES      0
         BAL,15   CLEANUP
         DO       GHO
         LW,3     ERRCOUNT
         BEZ      PAS0RTN
         LI,6     BA(CNTMSG+2)      ERRORS, CONVERT TO DECIMAL
         LI,5     X'F0'             AND TELLEM
         LI,2     0
         DW,2     TEN
         STS,5    2
         STB,2    0,6
         BEZ      %+2
         BDR,6    %-5
         LI,14    CNTMSG            PRINT AND TYPE IT
         CAL1,2   PRINT
         MTB,1    PRINT
         CAL1,2   PRINT
         B        PAS0RTN
CNTMSG   TEXTC    '***      GENMD ERRORS DETECTED'
         ELSE
         CAL1,1   LLSAV
         CAL1,9   1
         FIN
SEGERR1  BAL,14   CRREAD
SEGMSG   TEXTC    'BAD SEG'
ENDGFN   LW,2     NBLNK
         TTBS,2   TTBL
         BAL,15   CLEANUP
GETFID   BAL,11   GETALF
         BEZ      NOFILEN
         LW,7     SIFILEP
         MBS,6    0
         LCI      3
         LM,5     *X'4F'
         LCI      2
         STM,6    SIACCN
         LB,5     0,3               IS THERE A ACCOUNT
         CI,5     '.'               MEBBE
         BNE      EGFID
         AW,3     INCR              SKIP .
         LW,2     NBLNK             AND BLANKS
         TTBS,2   TTBL
         BAL,11   GETALF
         BEZ      GPSWD
         LW,1     SIACCNP
         MBS,0    BLANKS
         AW,6     INCR
         LW,7     SIACCNP
         LB,1     6
         STB,1    7
         MBS,6    0
GPSWD    LB,5     0,3               IS THERE A PASSWORD
         CI,5     '.'               MEBBE
         BNE      EGFID
         AW,3     INCR              SKIP .
         LW,2     NBLNK             AND BLANKS
         TTBS,2   TTBL
         BAL,11   GETALF
         BEZ      EGFID
         AW,6     INCR
         LW,1     SIPSWDP
         MBS,0    BLANKS
         LW,7     SIPSWDP
         LB,1     6
         STB,1    7
         MBS,6    0
EGFID    LI,7     1
         STS,7    OPENSI+1
         BAL,11   GDLM
         BCS,8    START
NOFILEN  BAL,15   CLEANUP
         BAL,14   CRREAD
         TEXTC    'NO FILE NAMED'
NOPGS    BAL,14   CRREAD
         TEXTC    'TOO BIG'
DERR     BAL,14   SET#
         TEXTC    'DLM AT 00'
NAMERR   BAL,14   SET#
         TEXTC    'NAME AT 00'
HEXERR   BAL,14   SET#
         TEXTC    'HEX AT 00'
LOCERR   LC       DIC
         DO1      ONL
         BNE      DELLOC
         BAL,14   SET#
         TEXTC    'LOC AT 00'
REPERR   BAL,14   HXMSG
         TEXTC    'OLD +00000=00000000'
SET#     LI,2     0
         STB,2    3
         AI,3     -BA(BUF)+1
         DW,2     TEN
         LB,1     *14
         AI,2     '0'
         AI,3     '0'
         STB,2    *14,1
         AI,1     -1
         STB,3    *14,1
CRREAD   RES
         DO       ONL
         LC       DIC
         BNE      DELLOC
         FIN
         MTW,1    ERRCOUNT          COUNT ERRORS
         CI,14    SEGMSG
         BNE      %+3
         MTW,-1   LKEY
         B        %+2
         BAL,15   LSTTXTC
         LI,1     71
         STB,1    HBUF+1
         LI,15    '*'
         CB,1     *14
         BG       %+2
         LB,15    *14,1
         STB,15   HBUF+1,1
         BDR,1    %-4
         LW,1     M:LL+1
         CI,1     X'6F00'
         BAZ      %+2
         LI,14    HBUF+1
         CAL1,2   PRINT
         LB,14    3
         BEZ      READCOM
         LW,2     DLMSK
         TTBS,2   TTBL
         BAL,11   GDLM
         BCR,8    %-1
         B        READCOM
GETREC   LW,9     VLOC
         CI,9     -2
         BNE      GETREC1
         LW,8     RECLIMS
         BEZ      %+2
         CAL1,1   WRITE
         STD,9    RECLIMS
         LCI      3
         LM,8     HEADT
         STM,8    KEY
         LI,9     12
         LI,8     -3
         B        RDREC
GETREC1  RES
         LW,6     SEGPTR
         LCI      6
         LM,10    5,6
         LI,2     3
         CLM,9    8,2
         BCR,9    %+3
         BDR,2    %-2
         B        LOCERR
*        READ A NEW RECORD
         LW,8     RECLIMS
         BEZ      %+4               NO RECORD IN, NO WRITE
         CLM,9    RECLIMS
         BCR,9    *0
         CAL1,1   WRITE
         LW,10    5,6               RESTORE 10 IF INONPLT
         LD,8     8,2
         STD,8    RECLIMS
         LB,12    HBUF
         CI,12    X'85'
         BNE      TREEKEY
         LI,8     X'1FE00'
         AND,8    VLOC
         SLS,8    -9
         STW,8    KEY
         MTB,3    KEY
         LW,6     SEGPTR
         SW,6     TBUF
         B        %+3
         MTH,1    KEY
         AI,6     -10
         BDR,6    %-2
         LI,9     X'1FE00'
         LI,8     X'1FE00'
         AND,8    VLOC
         CS,8     RECLIMS0
         BNE      %+2
         LW,8     RECLIMS0
         AND,9    8
         AI,9     X'1FF'
         STD,8    RECLIMS
         LI,9     X'200'
         B        RDREC
TREEKEY  EQU      %
         LCI      3
         LM,12    0,6
         STM,12   KEY
         MTB,1    KEY
         LB,1     KEY
         LB,2     TVEC,2
         STB,2    KEY,1
         SW,9     8
         AI,9     X'1FF'
RDREC    AW,9     RECBUF
         LW,10    RECBUF
         SW,10    8
         STW,10   LOCTBUF
         BAL,11   GPGS
         CAL1,1   READREC
         LW,10    M:SI+13
         STW,10   RECSIZE
         B        *0
         DO       ONL
*
GET      STW,3    VLOC
         LI,2     2                 NO RECORD FOR GETS
         CI,3     6                 IF 0-5, MUST BE LIMITS
         BG       GET1
         BE       GET1-1
         AI,3     5
         LW,3     *SEGPTR,3
         B        PUT-2
         MTW,-8   VLOC
GET1     RES
         BAL,3    DELGET
         LW,3     *LOCTBUF,3
DELGET   LCI      0
         STM,0    BUF
         MTW,-1   DIC
         BAL,0    GETREC
         LW,14    BUF+2             ADDR OF TEXT
         BAL,15   LSTTXTC           RECORD SUCESSFUL ONES
         LCI      0
         LM,0     BUF
         LW,3     VLOC
         EXU      *BUF+3
         MTW,1    DIC
         LCI      0
         B        0,4
PUT      MTW,0    INONLY
         BNEZ     0,4
         CI,3     6
         BNE      %+2
         LI,3     -2
         STW,3    VLOC
         BAL,3    DELGET
         STS,0    *LOCTBUF,3
DELLOC   LCI      0
         LM,0     BUF
         MTW,1    DIC
         LCI      15
         B        0,4
TBUFA    EQU      0
         ELSE
TBUFA    EQU      %
         FIN
         END      BEGIN

