         SYSTEM   SIG7FDP
GHO      SET      1
ONL      SET      1-GHO
         DO       GHO
GENMD    DSECT    1
         REF      PAS0RTN,GHOST1
BEGIN    EQU      GHOST1
         B        GBEGIN
         REF      M:TM,M:PATCH
M:SI     EQU      M:TM
M:C      EQU      M:PATCH
         ELSE
         REF      M:SI,M:C
         FIN
         REF      M:LL
*        FILE IO FPTS
*
*
READHEAD GEN,8,24 X'10',M:SI
         DATA     X'F8000000'
         PZE      OABN
         PZE      OABN
         PZE      HBUF
         DATA     48
         DATA     %+1
         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
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 M:SI
         DATA     X'C0000000',RABN,LSTE
SETDCB   GEN,8,24 6,M:SI
         DATA     X'C0000000'
         DATA     RABN,RABN
         DO       ONL
         PAGE
*        DELTA ASSOCIATION FPTS
*
         REF      M:GO
*
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'38000020'
         PZE      *RECBUF
         PZE      *M:SI+13
         PZE      KEY
DELWRTHT GEN,8,24 X'11',M:GO
         DATA     X'38000020'
         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
RECLIMS  DATA     0,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
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,NAB+17,NAB+X'300'
         DATA     NAB,NAB,NAB-X'80',NAB+X'2000'
         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'
ENDTXT   TEXTC    'END'
LSTTXT   TEXTC    'LIST'
DELETET  TEXTC    'DELETE'
NOFILE   TEXTC    'NO FILE NAMED'
         DO       ONL
CR       DATA,1   0,13,0,0
CRPRT    DATA,1   2,0,0,0
         PZE      *0
         PZE      CR
PROMPT   TEXTC    ':'
TEXTCR   CNAME
         PROC
LF       RES      0
         TEXTC    AF,' '
Q        SET      S:NUMC(AF)+1&3
         RES,1    Q-4
         DATA,1   13
         RES,1    3-Q
         PEND
QTXT     TEXTC    '?'
INFO     TEXTCR   'ACCEPTABLE INPUT:'
         TEXTCR   ' 1: PASS0 GENMDS - EXCEPT NO'
         TEXTCR   '    ADDRESSING FUNCTIONS(E.G. BA(X))'
         TEXTCR   ' 2: ONLINE FORMAT GENMDS:'
         TEXTCR   '    SEGN,LOC,VAL1,...,VALN'
         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   '     -TO RETURN FROM DELTA, TYPE ;G(RET)'
         TEXTCR   '     IF SEGN=''LIST'', PATCHES ARE LISTED'
         TEXTCR   '     IF SEGN=''LISTD'', PATCHES ARE LISTED'
         TEXTCR   '        AND THE LIST IS DELETED'
         TEXTCR   '     IF SEGN=''END'', GENMD EXITS'
         TEXTCR   '     IF SEGN=''GENMD'', FORMAT IS:'
         TEXTCR   '           GENMD LMN[.[ACCT][.PASSWORD]]'
         TEXTCR   '        AND LMN BECOMES PATCHABLE'
         TEXTCR   '    LOC=DEF+/-HEX, DEF, OR +/-HEX'
         TEXTCR   '    VALI=HEX+/-DEF...+/-DEF OR HEX'
         TEXTCR   'LINES ARE TERMINATED BY ''.'' OR ANY CHAR < BLANK'
         DATA     0                 TERMINATES SALUTATION
GENHERE  TEXTCR   'GENMD II 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
         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,1     X'F0'
         AND,1    M:SI+5
         CI,1     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
         LW,3     LKEY0             FIND LAST PREV RECORD
         STW,3    LKEY
         CAL1,1   SETDCB0
         CAL1,1   RLST              READ UNTIL ZERO RECORD
         MTW,1    LKEY              OR NO MORE RECORDS
         MTW,0    BUF
         BNEZ     %-3
LSTE     RES
         CAL1,1   SETDCB
         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
         STCF     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
         LC       *X'4F'            IF NOT ONLINE, REMOVE CR
         BCS,8    %+2
         MTB,-1   *14
         CAL1,2   PRINT
         STB,3    *14
         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
         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   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
         DO       ONL
         LC       *X'4F'            IF ONLINE PUT IN CR
         BCR,8    %+4
         MTB,1    BUF
         LB,3     BUF
         STB,2    BUF,3
         FIN
         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
         B        DERR
         B        DERR
         B        DERR
         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
         B        READCOM
         B        DERR
         B        DERR
LOCSCAN  EQU      %
         LI,9     0
         LI,10    1
         BAL,11   GETALF
         BEZ      %+2
         BAL,11   NAMVAL
         BAL,11   GDLM
         B        DERR
         LI,10    -1
         B        %+2
         B        %+2
         BAL,11   HEX
         STW,9    VLOC
         BAL,0    GETREC
         LW,4     CURDLM
         CI,4     4
         BE       STOREVAL+4
STOREVAL BAL,11   GDLM
         B        READCOM
         B        DERR
         B        DERR
         LI,10    1
         LI,9     0
         BAL,11   HEX
PLUSNAM  BAL,11   GDLM
         B        STVAL
         LI,10    -1
         B        %+2
         B        STVAL
         BAL,11   GETALF
         BEZ      NAMERR
         BAL,11   NAMVAL
         LI,10    1
         B        PLUSNAM
STVAL    EQU      %
         STW,9    VALUE
         BAL,0    GETREC
         LW,9     VALUE
         LW,10    VLOC
         AW,10    LOCTBUF
         STW,9    *10
         MTW,1    VLOC
         LW,4     CURDLM
         CI,4     2
         BANZ     STOREVAL
         B        STOREVAL,4
         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 TO BAL+N ACCORDING TO NEXT DELIMITER
*        N=1 IF END OF INPUT LINE
*        N=2 IF -
*        N=3 IF +
*        N=4 IF ,
*
*
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
         AW,3     INCR
         LW,2     NBLNK
         TTBS,2   TTBL
         CW,2     SEMI
         BNE      %+2
         BAL,4    CONTREC
         AI,11    -1
         LW,4     CURDLM
         B        *11,4
*
CONTREC  RES      0
         LW,1     BUFPTR
         MBS,0    BA(BUF+20)+3
         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
         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   CRPRT
         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
         DO       ONL
         LC       *X'4F'
         BCR,8    PRTREC
         LI,3     1
         STB,3    CR
         CAL1,2   CRPRT
PRTREC0  LI,3     0
         STB,3    CR
         FIN
         LI,3     1                 SKIP COMMENTS
         LB,3     BUF,3
         CI,3     '*'               AST TYPE
         BE       READC1
         CI,3     '<'               LSTHN TYPE
         BE       READC1
         CI,3     '!'               BANG = EOF
         BE       END
         CI,3     '#'               ALSO SKIP CONTROL
         BE       READC1
         DO       GHO               IF GHOST SKIP SKIPPED PATCHES
         MTW,0    BUF+20
         BLZ      READC1
         LB,3     BUF+18            LAST REAL CHAR
         SLS,3    24
         STW,3    BUF+18            PUT 3 EOMS AFTER
         FIN
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
         CAL1,1   WLST
         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
         MW,7     10
         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
         BCS,8    NOPGS
         SLS,8    9
         AW,8     9
         STW,8    BUFEND
SETRSZ   LW,8     BUFEND
         SW,8     RECBUF
         SLS,8    2
         STW,8    RECSIZE
         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
         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,3     0
         XW,3     RECLIMS
         BEZ      %+2
         CAL1,1   WRITE
RFDFLOOP LCI      3
         LM,1     0,4
         STM,1    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
         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
         AW,8     4
         CW,8     RFDFEND
         BL       NAMVAL+1
         B        NAMERR
FNDNAM   LW,5     8
         LW,8     2,5               RELOC WORD
         LW,5     1,5               VALUE
         LI,4     -4
         MTB,0    9,4               CHECK TYPE
         BNEZ     %+3               GOT IT
         BIR,4    %-2
         B        %+2               ABS, DONT SHITF
         SLS,5    2,4
         MW,5     10
         AW,9     5
         B        *11
         PAGE
*        ERROR RETURNS
*
*
OABN     EQU      %
RABN     EQU      %
         LI,8     0
         STW,8    RECLIMS
         BAL,14   PRQUIT0
         TEXTC    'BAD LMN - 0000'
PRQUIT0  SLD,10   -24
         SLS,10   1
         SLD,10   7
         LI,11    4
         LB,6     *14
PRQUIT1  LI,7     15
         AND,7    10
         LB,7     HEXES,7
         STB,7    *14,6
         SLS,10   -4
         AI,6     -1
         BDR,11   PRQUIT1
PRQUIT   B        CRREAD
CLEANUP  LI,8     0
         STW,8    OPNFLG
         DO       ONL
         CAL1,4   DISDEL
         STW,8    DELFLG
         FIN
         XW,8     RECLIMS
         BEZ      %+2
         CAL1,1   WRITE
         LH,8     M:SI
         CI,8     X'20'
         BAZ      *15
         LI,14    OPNFLG            WRITE A WORD OF ZEROES
         LI,2     81                FULL SIZE
         MTW,-1   LKEY              AS THE LAST RECORD
         CAL1,1   WLST
         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'
         FIN
         CAL1,9   1
SEGERR1  BAL,14   CRREAD
SEGMSG   TEXTC    'BAD SEG'
ENDGFN   LW,2     NBLNK
         TTBS,2   TTBL
         BAL,15   CLEANUP
         BAL,0   GETFID
         BEZ      NOFILEN
         B        START
NOFILEN  BAL,15   CLEANUP
         LI,14    NOFILE
         B        CRREAD
GETFID   BAL,11   GETALF
         BEZ      *0
         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
         BAL,11   GDLM
         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
         BAL,11   GDLM
         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
         B        *0
         LCI      0
         LCI      0
         LCI      0
         B        *0
NOPGS    BAL,14   PRQUIT
         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'
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   CAL1,2   PRINT
         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
         DO       ONL
         LI,14    1
         STB,14   CR
         FIN
         LB,14    3
         BEZ      READCOM
         LW,2     DLMSK
         TTBS,2   TTBL
         BAL,11   GDLM
         B        READCOM
         B        %-4
         B        %-5
         B        %-6
GETREC   LW,9     VLOC
         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
         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     RECLIMS
         BNE      %+2
         LW,8     RECLIMS
         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
         BGE      %+4
         AI,3     5
         LW,3     *SEGPTR,3
         B        PUT-2
         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      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

