         SYSTEM   BPM
         SYSTEM   SIG7FDP
         PCC      0
         REF      M:LO,F:LOCCT,M:SI
         DEF      LOCCT,LOAD,SCAN,ERROR
         DEF      PATCH
PATCH    RES      20
LOCCT    GEN,16,16 4,X'200'         DEFAULT SL, ASSIGNS READ
DROM     DATA     0
DTREE    DATA     0
SYSID    PZE
BIAS      DATA       X'A000'
         PZE
         DATA     X'E800'           FCOM (DA) ?????
ERSIZ    GEN,16,16 10,10
TSS      GEN,16,16 X'40',0
#ACCTS   GEN,16,16 1,1
LMN      GEN,8,16,8 3,0,'L'
         TEXT     '     '
MYACCT   RES      2
LMNPASS  DATA     0,0
EXP      TEXT     'NEVER'
LIBPASS  DATA     0,0
READX    TEXT     'ALL  '
         RES      14
WRITE    TEXT     'NONE '
         RES      14
         PAGE
*
TREEINIT RES      3
         DO1      8
         PZE
UNSATPTR PZE
         BOUND    8
STK      RES      2
*
CURTREE  PZE                          OFFSET OF CURRENT TREE BEING WORKED ON
NXTROML  PZE                          NEXT AVAIL SPOT IN ROM LISN
#ROMS    PZE                          # ROMS IN ROM LIST
ROMLST   PZE                          START OF ROM LIST
TREEST   PZE                          START OF TREE TABLE
ROMST    PZE                          START OF ROM TABLE
NXTROM   PZE                          NEXT AVAIL SPOT IN ROM TABLE
ROMTPG   EQU      X'1B400'
NXTROMPG DATA     ROMTPG+512
ROMTABSIZ PZE
TREETOP  PZE
Y8       GEN,1,31 1,0
STACKPNTR DATA    STACK
STACKTOP DATA     STACK+1
STACK    DATA     0,-1
         PAGE
         CSECT
OPTAB    EQU      %
         RES      2
         CSECT
OPTJMP1  EQU      %
         RES      1
         CSECT
ONEINDX  EQU      %
         RES,1    1
         CSECT
ONEMASK  EQU      %
         RES      2
         USECT    LOCCT
JT       CNAME
         PROC
         USECT    OPTAB
         TEXT     AF(1)
         USECT    OPTJMP1
         B        AF(2)
         USECT    ONEINDX
         DATA,1   AF(3)
         USECT    ONEMASK
         DATA     AF(4),AF(5)
         USECT    LOCCT
         PEND
         PAGE
START    M:PC     '%'
         LD,0     *0
         STD,0    STK
*        FIRST WE SCAN THE LOAD CARD
*
LOAD     BAL,10   SCANER
         BCS,15   ERROR             ANY SPECIAL IS ILLEGAL
         LW,1     X'4F'
         AI,1     1
         LCI      2
         LM,2     0,1
         STM,2    MYACCT
         INT,1    *X'4F'
         STW,1    SYSID             SET SYSID IN LOCCT
         SLS,1    8
         STS,1    LMN               SET ID AS LMN
         LW,1     FLD
         CW,1     ='LOAD'
         BE       LOAD10            MUST BE LOAD CARD
         CW,1     ='LOCC'           OR LOCCT CARD
         BNE      ERROR
LOAD10   BAL,10   SCANER            LOOK FOR (
         BCS,4    OPTION            GOT IT, GO PROCESS
         B        ERROR             DIDN'T, ERROR
LOAD20   BAL,10   SCAN              RETURN AFTER OPTION, LOOK FOR ,
         B        TREE              EOF, DONE WITH LOAD
         BCS,2    LOAD10            FOUND , GO LOOK FOR (
         B        ERROR             DIDN'T, ERROR
*
*        OPTION ROUTINE, PROCESS ALL OPTIONS
*
OPTION   BAL,10   SCANER            GET KEYWORD FIELD
         BCS,15   ERROR             ANY SPECIAL CHAR IS ERROR
         LI,7     #OPTS             LOOK UP IN TABLE
         LD,8     FLD
         CD,8     OPTAB,7
         BE       OPTJMP1,7         FOUND IT, GO TO ROUTINE
         BDR,7    %-2
         B        ERROR             ILLEGAL KEYWORD
*
*        DEFINE ALL KEYWORDS AND JUMP TABLE
*
         JT       'GO   ',ONE,0,X'400',X'400'
         JT       'EF   ',EFOPT,0,X'80000000',X'80000000'
         JT       'UNSAT',UNSOPT,0,0,0
         JT       'PERM ',PERMOPT,0,X'8',X'8'
         JT       'LMN  ',LMNOPT
         JT       'READ ',READOPT
         JT       'WRITE',WRTOPT
         JT       'SL   ',SLOPT
         JT       'TSS  ',TSSOPT
         JT       'BIAS ',BIASOPT
         JT       'FCOM ',ONE,0,X'80',X'80'
         JT       'CSECT1',ONE,0,X'1000',X'1000'
         JT       'NOSYSLIB',ONE,0,2,2
         JT       'MAP  ',ONE,0,1,1
         JT       'BI   ',ONE,0,X'800',X'800'
         JT       'M10  ',ONE,0,X'20',X'20'
         JT       'M100 ',ONE,0,X'40',X'40'
         JT       'ABS  ',ONE,0,X'100',X'100'
         JT       'ERTABLE',ERTABOPT
         JT       'ERSTACK',ERSTKOPT
         JT       'NOTCB',ONE,0,X'2000',X'2000'
         JT       'SEG  ',ONE
         JT       'REF  ',REFOPT,0,4,4
         JT       'BREF ',BREFOPT,0,X'40000000',X'40000000'
*
         USECT    OPTJMP1
#OPTS    EQU      %-OPTJMP1-1
*
         USECT    LOCCT
         PAGE
*        ONE - ONE FIELD OPTIONS, JUST SET FLAG IN LOCCT
*
ONE      LB,1     ONEINDX,7         GET OFFSET INTO LOCCT
         LD,2     ONEMASK,7         MASK AND VALUE
         STS,2    LOCCT,1           SET VALUE IN LOCCT
         BAL,10   SCANER            GET ) TO END OPTION
         BCS,1    LOAD20            GOT IT
         B        ERROR             DIDN'T, ERROR
*
PERMOPT  BAL,10   2NDFLD            SKIPS , &GETS NEXT FIELD
         BCS,15   PERMOPT50         NEXT FIELD IS )
         LW,1     FLD               GET FIELD
         CW,1     ='LIB '           MUST BE LIB
         BNE      ERROR
         LI,1     X'10'
         STS,1    LOCCT             SET FLAG FOR LIB
         BAL,10   2NDFLD            LOOK FOR ,PASS
         BCS,15   PERMOPT50         GOT ) THER IS NO PASSWORD
         LCI      2
         LM,1     FLD               GET PASSWORD
         STM,1    LIBPASS           PUT INTO LOCCT
         B        ONE               & GO GET )
PERMOPT50 LD,2    ONEMASK,7
         STS,2    LOCCT
         B        LOAD20
*
LMNOPT   BAL,10   2NDFLD            GET ,FIELD
         BCS,15   ERROR             MUST BE A FIELD
         LCI      3
         LM,1     FLDC              GET TEXTC FIELD
         STM,1    LMN               PUT INTO LOCCT
         BAL,10   2NDFLD            GET ,PASS OR )
         BCS,15   LOAD20            GOT )
         LCI      2
         LM,1     FLD
         STM,1    LMNPASS
         B        ONE
*
READOPT  LI,1     READX
         LI,2     HA(#ACCTS)
         B        WRTOPT10
*
WRTOPT   LI,1     WRITE
         LI,2     HA(#ACCTS)+1
WRTOPT10 LI,3     0                 # OF ACCOUNTS
         LI,6     8                 MAX NUMBER OF ACCOUNTS
WRTOPT20 BAL,10   2NDFLD            GET ,FIELD OR )
         BCS,15   WRTOPT80          GOT )
         LCI      2
         LM,4     FLD               GET ACCOUNT
         STM,4    0,1               PUT IN LOCCT
         AI,3     1                 INC # ACCOUNTS
         AI,1     2                 INC POINTER TO LOCCT
         BDR,6    WRTOPT20
         STH,3    0,2               SET # IN LOCCT
         B        ONE               AND GO GET )
WRTOPT80 STH,3    0,2               FOUND ) BEFORE 8 ACCOUNTS
         CI,3     0
         BE       ERROR
         B        LOAD20            GO GET NEXT OPTION
*
SLOPT    BAL,10   HEX2NDFLD         GET A HEX NUMBER
         LW,2     HEXFLD
         LI,3     X'F'              GET MASK
         SLD,2    16                SHIFT INTO PLACE
         STS,2    LOCCT             PUT INTO LOCCT
         B        ONE               GO GET )
*
TSSOPT   BAL,10   HEX2NDFLD
         LW,1     HEXFLD
         STH,1    TSS
         B        ONE
*
BIASOPT  BAL,10   HEX2NDFLD
         LW,2     HEXFLD
         AND,2    =X'1FE00'         ROUND UP TO PAGE BOUNDRY
         LI,3     X'1FFFF'
         STS,2    BIAS
         B        ONE
*
ERTABOPT LI,1     HA(ERSIZ)+1
         B        ERSTKOPT+1
*
ERSTKOPT LI,1     HA(ERSIZ)
         BAL,10   HEX2NDFLD
         LW,2     HEXFLD
         STH,2    0,1
         B        ONE
*
REFOPT   EQU      %
BREFOPT  BAL,10   2NDFLD
         BCR,15   REFOPT20          2ND FIELD IS THERE
         B        PERMOPT50
REFOPT20 BAL,10   DECVAL            CONVERT FLD TO BINARY
         LW,2     DECFLD            GET VALUE
         LI,3     -1
         SLD,2    17
         STS,2    BIAS              INTO LOCCT
         B        ONE               GO GET )
*
* UNSAT OPTION - FIELDS LOOK LIKE:
*                 (ACCOUNT,PASSWORD)    OR
*                 (ACCOUNT)
*
UNSMAX   DATA     512/4-1
EFMAX    DATA     512/8-1
*
UNSOPT   M:GP     1                 GET A PAGE TO PUT THEM
         BCS,8    ERROR1            NO PAGE, QUIT
         STW,9    UNSATPTR          REMEMBER START
         LI,2     0                 # UNSATS
         LI,1     0                 OFFSET IN BUFFER
UNSOPT20 BAL,10   PTOP2             GET FIELDS ,(...)
         BCS,15   UNSOPT50          GOT ) BEFORE ,
         MTW,0    F2                MUST HAVE 1ST FIELD
         BEZ      ERROR
         CW,2     UNSMAX            PAGE FILLED YET
         BL       %+5               NO
         M:GP     1                 YES, GET ANOTHER
         BCS,8    ERROR1            CAN'T GET, QUIT
         LI,10    512/4
         AWM,10   UNSMAX
         LD,4     F2
         LD,6     F3
         LCI      4
         STM,4    *UNSATPTR,1
         AI,2     1                 INCREMENT #
         AI,1     4
         B        UNSOPT20          GO GET ANOTHER
UNSOPT50 CI,2     0                 GOT ANY
         BE       ERROR             NO, ERROR
         LI,3     X'FFFF'
         STS,2    TSS               SET # IN LOCCT
         B        LOAD20            GO GET NEXT OPTION
*
EFOPT    M:GP     1                 GET PAGE TO BUILD ROM LIST
         BCS,8    ERROR1            NO PAGE, QUIT
         STW,9    ROMLST            REMEMBER START
         LI,2     0                 #
         LI,1     0                 OFFSET INTO TABLE
EFOPT20  BAL,10   PTOP              GET ,(...)
         BCS,15   EFOPT50           GOT ) BEFORE ,
         MTB,0    F1                FIRST FIELD MUST EXIST
         BEZ      ERROR
         CW,2     EFMAX
         BL       %+5               NO
         M:GP     1                 YES, GET ANOTHER
         BCS,8    ERROR1            CAN'T, QUIT
         LI,10    512/8
         AWM,10   EFMAX
         LCI      3
         LM,3     F1                GET NAME
         AND,5    =X'FFFFFF00'
         AI,5     X'40'             SET NOT LAST BIT
         LCI      2
         LM,6     MYACCT            SET RUNNING ACCT AS DEFAULD
         MTW,0    F2                NEW ACCOUNT
         BEZ      %+2               NO
         LD,6     F2                YES, USE IT
         LD,8     F3                GET PASSWORD
         LI,10    0                 FLAG FOR ME
         LCI      8
         STM,3    *ROMLST,1         STORE ROM TABLE
         AI,2     1                 INCREMENT COUNTER
         AI,1     8
         B        EFOPT20           GO GET ANOTHER
*
EFOPT50  CI,2     0                 ANY EF'S
         BE       ERROR             NO, ERROR
         STW,2    #ROMS             SET #
         LW,1     Y8
         STS,1    LOCCT
         B        LOAD20            GO GET ANOTHER OPTION
*
         PAGE
*
*        SUBROUTINES USED BY LOAD SCANNING ROUTINES
*
         SPACE    3
*
*        SCANER - CALLS SCAN, EOF GOES TO ERROR
*                 CC SET SAME AS FROM SCAN
*        BAL,10
*        NO VOLATILES
*
SCANER   PSW,10   STK
         BAL,10   SCAN
         B        ERROR
SCANER10 PLW,10   STK
         LC       CCSCAN            RESTORE CC FROM SCAN ROUTINE
         B        *10
         SPACE    3
*        2NDFLD - CALLS SCAN
*                 A)  IF ) SET ANY CC AND RETURN
*                 B)  IF ,FIELD RESET ALL CC AND RETURN
*                 C) ANYTHING ELSE GOES TO ERROR
*        BAL,10
*        NO VOLATILES
*
2NDFLD   PSW,10   STK
         BAL,10   SCANER
         BCS,1    SCANER10          GOT A ) RETURN
         BCR,2    ERROR             NO , GETS ERROR
         BAL,10   SCANER            GET THE FIELD
         BCS,15   ERROR             ANY SPECIAL IS ERROR
         B        SCANER10          NO SPECIAL, RETURN PROUD
*
*        HEX2NDFLD - CALLS 2NDFLD
*                 A) NO FIELD GETS ERROR
*                 B) CONVERTS FIELD FROM HEX TO BINARY
*        RESULT IN HEXFLD
*        BAL,10
*        NO VOLATILES
*
HEX2NDFLD LCI     4
         PSM,7    STK
         BAL,10   2NDFLD
         BCS,15   ERROR             NO FIELD, ERROR
         LI,7     0                 INDEX INTO FLD
         LW,8     FLDLEN            # CHARS IN FIELD
         LI,9     0                 ANSWER
HEXTO20  LB,10    FLD,7             GET A CHAR
         CI,10    X'C6'
         BG       HEXTO40
         CI,10    X'C1'
         BL       ERROR
         AI,10    -X'C1'+10
HEXTO30  SLS,9    4
         AW,9     10
         AI,7     1
         BDR,8    HEXTO20
         STW,9    HEXFLD
         LCI      4
         PLM,7    STK
         B        *10
*
HEXTO40  CI,10    X'F0'
         BL       ERROR
         CI,10    X'F9'
         BG       ERROR
         AI,10    -X'F0'
         B        HEXTO30
*
*        DECVAL - CONVERT FLD TO BIN, STORE IN DECVAL
*        BAL,10
*        NO VOLATILES
*
DECVAL   LCI      4
         PSM,7    STK
         LI,7     0                 INDEX INTO FLD
         LW,8     FLDLEN            #CHARS IN FLD
         LI,9     0                 ANSWER
DECVAL20 LB,10    FLD,7
         CI,10    X'F0'
         BL       ERROR
         CI,10    X'F9'
         BG       ERROR
         AI,10    -X'F0'
         MI,9     10
         AW,9     10
         AI,7     1
         BDR,8    DECVAL20
         STW,9    DECFLD
         LCI      4
         PLM,7    STK
         B        *10
*
HEXFLD   PZE
DECFLD   PZE
*
*        PTOP LOOKS FOR ,(--,--,--)
*                 A) GETS ) BEFORE , SET ANY CC & RETURN
*                 B) GETS ,(...) THEN:
*                    FIELD 1 TO F1 IN TEXTC
*                    FIELD 2 OR 0 TO F2
*                    FIELD 3 OR 0 TO F3
*                    RESET CC AND RETURN
*                 C) ANY OTHER GOES TO ERROR
*        PTOP2 - SAME BUT ONLY GETS FIELD 2 AND FIELD 3
*        BAL,10
*        NO VOLATILES
*
PTOP     LCI      3
         PSM,9    STK
         LI,10    0
PTOP10   STW,10   PTOPFLG           SET ENTRY POINT FLAG
         BAL,10   SCANER
         BCS,1    PTOP90            GOT ) FIRST
         BCR,2    ERROR             NOT , GETS ERROR
         BAL,10   SCANER            GET (
         BCR,4    ERROR             NOT ( GETS ERROR
         LW,9     BLKS
         STD,9    F1                INITIALIZE FIELDS
         STW,9    F1+2
         LI,9     0
         STD,9    F2
         STD,9    F3
         STB,9    F1
         MTW,0    PTOPFLG
         BNEZ     PTOP30            GET ONLY 2ND 2 FIELDS
         BAL,10   SCANER            GET FIELD 1
         BCS,15   ERROR             ANY SPECIAL IS ERROR
         LCI      3
         LM,9     FLDC
         STM,9    F1
         BAL,10   SCANER            GET , OR ) AFTER FIELD 1
         BCS,1    PTOP80            GOT ) WE ARE DONE
         BCR,2    ERROR             NOT , IS ERROR
PTOP30   BAL,10   SCANER            GET FIELD 2
         BCS,2    PTOP40            ANOTHER , NO FIELD 2
         BCS,15   ERROR             ANY OTHER SPECIAL IS ERROR
         LD,10    FLD
         STD,10   F2
         BAL,10   SCANER            GET , OR ) AFTER FIELD 2
         BCS,1    PTOP80            GOT ) WE ARE DONE
         BCR,2    ERROR             NOT A , IS ERROR
PTOP40   BAL,10   SCANER
         BCS,15   ERROR             ANY SPECIAL IS ERROR
         LD,10    FLD               GET FIELD 3
         STD,10   F3
         BAL,10   SCANER            GET ) AFTER FIELD 3
         BCR,1    ERROR             MUST BE A )
PTOP80   LCI      3
         PLM,9    STK
         LCI      0
         B        *10
PTOP90   LCI      3
         PLM,9    STK
         LCI      15
         B        *10
*
PTOP2    LCI      3
         PSM,9    STK
         B        PTOP10
*
         BOUND    8
F1       RES      3
PTOPFLG  PZE
         BOUND    8
F2       RES      2
F3       RES      2
*
ERROR1   M:WRITE  M:LO,(BUF,EM1),(SIZE,32)
         M:EXIT
EM1      TEXT     'CAN''T GET ENOUGH MEMORY, I QUIT.'
*
ERROR    M:WRITE  M:LO,(BUF,INBUF),(SIZE,*BUFLEN)
         M:WRITE  M:LO,(BUF,EM0),(SIZE,36)
         M:EXIT
EM0      TEXT     'ERROR IN ABOVE CONTROL CARD, I QUIT.'
         PAGE
CCTAB    DATA,1   0,0,X'10',X'20',X'40',X'80'
         BOUND    4
SPCHR    TEXT     '  ),(-;'         SPECIAL CHARACTER TABLE
#SPCHR   EQU      6                 # OF THEM
BLKS     EQU      %
BUFINIT  TEXT     '     '           BLANKS
INBUF    RES      144/4             INPUT BUFFER
         BOUND    8
FLD      RES      10                OUTPUT FIELD
FLDC     RES      10                OUTPUT FIELD IN TEXTC
FLDLEN   PZE                        # CHARS IN FIELD
BUFPTR   DATA     X'123'            INDEX IN BUF TO NEXT CHAR TO USE
CCSCAN   PZE                        HAS CC ON EXIT
BUFLEN   PZE                        LENGTH OF CURRENT RECORD
*
*        SCAN - CHARACTER SCANNER
*        BAL,10
*        NO VOLATILES
*        OUTPUT:
*                 FLD HAS FIELD GOTTEN
*                 FLDC HAS TEXTC FIELD GOTTEN
*                 FLDLEN HAS # BYTES IN FIELD
*                 CC SET AS FOLLOWS
*                 0 => A FIELD WAS DEFINED
*                 1 => ) WAS FOUND
*                 2 => , WAS FOUND
*                 4 => ( WAS FOUND
*                 8 => - WAS FOUND
*        EXITS *10 IF EOF IS HIT
*        EXITS *(10+1) IF NO EOF IS HIT
*
SCAN     LCI      11
         PSM,0    STK
         LI,1     20                CLEAR FIELDS
         LW,2     BLKS
         STW,2    FLD-1,1
         BDR,1    %-1
         STW,1    FLDLEN
         STB,1    FLDC
         LI,2     0                 FIELD LENGTH
SCAN05   LW,1     BUFPTR
         CW,1     BUFLEN            PAST END OF BUFFER
         BL       SCAN10            NO
SCAN07   BAL,10   READ              YES, READ NEXT RECORD
         B        SCAN50            EOF RETURN
         B        SCAN05            OK, CHECK AGAIN
SCAN10   LB,8     INBUF,1
         CI,8     ' '               SKIP TO FIRST NON-BLANK
         BNE      SCAN20
         BAL,0    INCRBUF           INCREMENT BUFFER POINTER
         B        SCAN10
SCAN20   CI,8     ';'               END OF USEFUL INFO
         BE       SCAN07            YEP, GO READ ANOTHER RECORD
         CI,8     '.'               DOT IS EOF
         BE       SCAN50
SCAN25   LI,7     #SPCHR
         CB,8     SPCHR,7
         BE       SCAN30            IS A SPECIAL
         BDR,7    %-2
*
*        NOT A SPECIAL CHARACTER, START A FIELD
*
         STB,8    FLD,2             CHARACTER TO OUTPUT BUFFER
         AI,2     1                 INCR FIELD LENGTH
         STB,8    FLDC,2            CHAR TO TEXTC OUTPUT
         BAL,0    INCRBUF           INCREMENT BUFFER POINTER
         LB,8     INBUF,1           GET NEXT CHARACTER
         B        SCAN25            GO LOOK FOR SPECIALS
*
SCAN30   CI,2     0                 WAS A FIELD DEFINED
         BE       SCAN35            NO
         STW,2    FLDLEN            YES, SET LENGTH
         STB,2    FLDC              AND COUNT IN TEXTC
         LI,7     0                 SET RETURN CC INDEX
         B        SCAN40
SCAN35   LI,2     1                 SET LENGTH
         STW,2    FLDLEN
         STH,8    FLDC
         STB,2    FLDC
         AI,1     1                 INCREMENT BUFFER POINTER
SCAN40   STW,1    BUFPTR            REMEMBER FOR NEXT TIME
         LC       CCTAB,7           SET CC FOR RETURN
         STCF     CCSCAN
         MTW,1    *STK              INCREMENT RETURN ADDRESS
SCAN50   LCI      11
         PLM,0    STK
         LC       CCSCAN
         B        *10
*
INCRBUF  AI,1     1                 INCREMENT BUFFER POINTER
         CW,1     BUFLEN            TOO BIG
         BL       *0                NO, RETURN
         CI,2     0                 YES, GOT ANY CHARS YET
         BG       SCAN30            YEP, TREAT AS BLANK
         STW,1    BUFPTR            NO SET AS POINTER FOR NEXT TIME
         B        SCAN50            AND GO TO EOF RETURN
*
READ     LCI      4
         PSM,7    STK
         M:READ   M:SI,(BUF,INBUF),(SIZE,140),(ABN,READ80),WAIT
         LW,7     M:SI+4            GET ARS
         SLS,7    -17
         AI,7     -1
         LB,8     INBUF,7
         CI,8     X'D'              KNOCK OFF CR
         BE       %+2
         AI,7     1
         LI,8     ' '
         STB,8    INBUF,7           EXTEND BUFFER BY ONE BLANK
         AI,7     1
         STW,7    BUFLEN
READ20   LI,7     1
         LB,8     INBUF
         CI,8     '!'               SKIP OVER A BANG
         BE       %+2
         LI,7     0
         STW,7    BUFPTR            SET POINTER TO 1ST CHAR
         MTW,1    *STK              INCREMENT RETURN ADDRESS
READ80   LCI      4
         PLM,7    STK
         B        *10
         PAGE
         SPACE    5
TREE     MTW,0    ROMLST            NO ROM LIST, NO TREE
         BEZ      FINISH
         BAL,10   READ              READ !TREE CARD
         B        FINISH            EOF - NO TREE
         M:GP     1                 GET A PAGE FOR TREES
         BCS,8    ERROR1            CAN'T GET, QUIT
         STW,9    TREEST            REMEMBER ADDRESS
         AI,9     511
         STW,9    TREETOP
         M:GVP    ROMTPG            GET PAGE FOR ROM TABLES
         BCS,8    ERROR1            CAN'T GET, QUIT
         BAL,10   SCANER            GET TREE FIELD
         BCS,15   ERROR             ANY SPECIAL IS ERROR
         LW,1     FLD
         CW,1     ='TREE'           MUST BE TREE
         BNE      ERROR
         BAL,10   SCANER            GET ROM NAME
TREE10   BCS,15   ERROR             ANY SPECIAL IS AN ERROR
         BAL,10   FINDROM           LOCATE ROM NAME IN ROM LIST
         LW,1     ROMLOC            ROM ADDRESS
         LW,2     ROMTABSIZ         INDEX TO PUT NEXT ENTRY
         OR,1     Y8                SET ROM AS LAST
         BAL,10   INCROMPG
         STW,1    ROMTPG,2          SET ROM ADDR IN ROM TABLE
         LW,7     CURTREE
         MI,7     11
         AI,7     11
         AW,7     TREEST
         CW,7     TREETOP
         BLE      TREE15
         M:GP     1
         BCS,8    ERROR1
         AI,9     511
         STW,9    TREETOP
TREE15   LW,7     TREEST
         LW,6     CURTREE
         AW,7     6
         LCI      8
         LM,8     TREEINIT+3
         STM,8    3,7
         LCI      3
         LM,8     FLDC
         STM,8    0,7
         LI,8     11
         AWM,8    CURTREE
         LW,3     *STACKPNTR        GET BACK LINK
         LW,5     2                 CALCULATE REAL ROM OFFSET
         MI,5     7
         STH,5    3                 SET ROM POINTER
         STW,3    3,7               AND PUT INTO TREE
         LW,2     *STACKTOP         INDEX OF PARALLEL TREE
         BLZ      TREE20            NULL, ISN'T ONE
*
*        SET OVERLAY LINK
*
         AI,2     4                 OFFSET TO OVERLAY LINK ENTRY
         LI,5     X'FFFF'           MASK
         LW,4     6                 OFFSET TO NEW TREE
         AND,2    =X'FFFF'          KNOCK OFF BAD BITS
         STS,4    *TREEST,2         SET LINK IN PREV OVERLAY
         STW,6    *STACKTOP         THIS IS NEW STACK TOP
         B        TREE30            BUT THIS IS NO BODY'S FORWARD
*
*        SET THIS GUY AS PREV GUY'S FORWARD
*
TREE20   STW,6    *STACKTOP         THIS IS NOW TOP OF STACK
         LW,2     *STACKPNTR
         AI,2     4                 OFFSET TO FORLINK
         LW,4     6                 OUR OFFSET
         LI,5     X'FFFF'
         SLD,4    16
         AND,2    =X'FFFF'
         STS,4    *TREEST,2         SET OUR OFFSET AS PREV'S FORWARD
TREE30   BAL,10   SCAN
         B        FINISH            EOF, WE ARE DONE
         BCS,4    ERROR             ( IS ERROR
         BCR,15   ERROR             NOT SPECIAL IS ERROR
         BCS,8    TREE60            - ANOTHER ROM IN THIS OVERLAY
         BCS,2    TREE50            , PARALLEL SEGMENT BEING DEFINED
*
*        IS ) => END OF THIS OVERLAY SEGMENT
*
TREE40   MTW,-1   STACKTOP
         MTW,-1   STACKPNTR
         LW,1     STACKPNTR
         CI,1     STACK
         BL       ERROR
         BAL,10   SCAN
         B        FINISH            EOF, WE ARE DONE
         BCS,1    TREE40            ) END OF ANOTHER SEGMENT
         BCR,2    ERROR             NOT , IS ERROR
TREE50   BAL,10   SCANER            PARALLEL SEGMENT
         B        TREE10
*
*        ANOTHER ROM IN THIS SEGMENT OR NEW OVERLAY SEGMENT
*
TREE60   BAL,10   SCANER
         BCS,4    TREE70            ( A NEW OVERLAY SEGMENT
         BCS,15   ERROR             ANY OTHER SPECIAL IS ERROR
         BAL,10   FINDROM           LOCATE OUR ROM IN ROM LIST
         LW,2     ROMTABSIZ         INDEX TO NEXT SPOT
         AI,2     -1
         LW,1     ROMTPG,2          SET LAST ROM AS NOT LAST
         AND,1    =X'1FFFF'
         STW,1    ROMTPG,2
         AI,2     1
         LW,1     ROMLOC
         OR,1     Y8                SET THIS AS LAST
         BAL,10   INCROMPG          INCREMENT ROM TABLE INDEX
         STW,1    ROMTPG,2          STORE THIS ROM
         B        TREE30
*
*        A NEW OVERLAY IS ABOUT TO BE DEFINED
*
TREE70   MTW,1    STACKPNTR
         MTW,1    STACKTOP
         LI,1     -1
         STW,1    *STACKTOP         PUT NULL ENTRY IN TREE STACK
         BAL,10   SCANER
         B        TREE10
*
*
INCROMPG PSW,1    STK
         LW,1     ROMTABSIZ         INDEX TO NEXT
         AI,1     ROMTPG            + START
         CW,1     NXTROMPG          = NEXT TO GET
         BL       %+5               NO, OK
         M:GVP    *NXTROMPG         YES, MUST GET NEXT PAGE
         BCS,8    ERROR1            CAN'T GET, QUIT
         LI,1     512               GOT IT, INCREMENT POINTER
         AWM,1    NXTROMPG
         MTW,1    ROMTABSIZ         AND INDEX
         PLW,1    STK
         B        *10               RETURN
*
*
FINDROM  LCI      6
         PSM,0    STK
         LW,5     #ROMS             # ENTRIES IN ROM LIST
         LW,4     ROMLST            ADDRESS OF START
         LD,2     FLDC              ROM WE ARE LOOKING FOR
         LW,0     FLDC+2
         LW,1     =X'FFFFFF00'      MASK
FINDR10  CD,2     *4
         BNE      FINDR20
         CS,0     2,4
         BE       FINDR30           GOT IT
FINDR20  AI,4     8                 INCREMENT POINTER
         BDR,5    FINDR10           AND LOOK AGAIN
         B        ERROR2            CAN'T FIND, QUIT
FINDR30  STW,4    ROMLOC
         MTW,1    7,4               SET ROM AS USED
         LCI      6
         PLM,0    STK
         B        *10
*
ROMLOC   PZE
*
ERROR2   LB,1     FLDC
         M:WRITE  M:LO,(BUF,EM2),(SIZE,29),WAIT
         M:WRITE  M:LO,(BUF,FLD),(SIZE,*1),WAIT
         M:EXIT
EM2      TEXT     'ROM IN TREE, NOT IN EF LIST: '
         PAGE
FINISH   LW,1     STACKPNTR
         CI,1     STACK
         BNE      ERROR             NOT BACK TO FIRST LEVEL
         LW,1     #ROMS
         LW,2     ROMLST
         BEZ      FIN10             NO ROMS TO CHECK
         MTW,0    TREEST
         BEZ      FIN10             NO TREE, NONE USED
         AI,2     7
         MTW,0    *2
         BEZ      ERROR3
         AI,2     8
         BDR,1    %-3
FIN10    M:GCP    1                 GET PAGE FOR LOCCT
         BCS,8    ERROR1
         AI,9     1                 RESERVE FOR SIZE
         LW,7     9                 PUT ADDR IN INDEX REG
         LI,1     21
         LW,10    LOCCT,1
         STW,10   *7,1
         AI,1     -1
         BGEZ     %-3
         LI,6     21                INDEX TO NEXT SPOT IN LOCCT
         LH,0     #ACCTS            #READ ACCOUNTS
         BEZ      FIN20             NONE (CAN'T HAPPEN)
         LI,1     0
         LCI      2
         LM,2     READX,1
         STM,2    *7,6
         AI,6     2
         AI,1     2
         BDR,0    %-5
FIN20    LW,0     #ACCTS
         AND,0    =X'FFFF'
         BEZ      FIN30             CAN'T HAPPEN
         LI,1     0
         LCI      2
         LM,2     WRITE,1
         STM,2    *7,6
         AI,6     2
         AI,1     1
         BDR,0    %-5
FIN30    LW,0     TSS
         AND,0    =X'FFFF'
         BEZ      FIN40
         LI,1     0
FIN35    LCI      4
         LM,8     *UNSATPTR,1
         STM,8    *7,6
         AI,6     4
         AI,1     4
         BAL,10   CHKSIZ
         BDR,0    FIN35
FIN40    LI,0     2
         CW,0     LOCCT             NOSYSLIB SET
         BANZ     FIN50             YEP, DON'T INCLUDE :SYS
         MTW,1    8,7               NO, INCLUDE :SYS
         LCI      4
         LM,8     SYSACCT
         STM,8    *7,6
         AI,6     4
         BAL,10   CHKSIZ
FIN50    LW,5     CURTREE
         BEZ      FIN60             NO TREE, GOTTA MAKE IT
         STW,5    *7,6
         AI,6     1
         BAL,10   CHKSIZ
         STW,6    2,7
         LI,1     0
FIN55    LW,10    *TREEST,1
         STW,10   *7,6
         AI,6     1
         AI,1     1
         BAL,10   CHKSIZ
         BDR,5    FIN55
         STW,6    1,7               SET DISP TO ROM TABLES
         LI,1     0
         LW,2     ROMTABSIZ         # ENTRIES IN TABLE
         BEZ      FIN65
FIN57    LW,3     ROMTPG,1
         LCI      7
         LM,8     *3
         AI,3     0
         BGEZ     %+2
         AND,10   =X'FFFFFF00'
         LCI      7
         STM,8    *7,6
         AI,6     7
         AI,1     1
         BAL,10   CHKSIZ
         BDR,2    FIN57
         B        FIN70
FIN60    LI,1     11
         STW,1    *7,6
         AI,6     1
         STW,6    2,7               SET TREE DISP IN LOCCT
         LCI      3
         LM,8     LMN
         STM,8    *7,6
         AI,6     3
         BAL,10   CHKSIZ
         LI,1     8
         LI,0     0
         STW,0    *7,6
         AI,6     1
         BDR,1    %-2
FIN65    LW,5     #ROMS
         BEZ      FIN70             NO ROMS, DONE
         STW,6    1,7               SET ROM TAB DISP IN LOCCT
         LW,4     ROMLST
FIN67    BAL,10   CHKSIZ
         LCI      7
         LM,8     *4
         STM,8    *7,6
         AI,6     7
         AI,4     8
         BDR,5    FIN67
         AND,10   =X'FFFFFF00'      SET LAST
         AI,6     -5
         STW,10   *7,6              PUT INTO ROM TABLE
         AI,6     5
FIN70    LW,13    7                 SET LOCCT POINTER
         LW,7     6                 SET LOCCT SIZE
         B        LOCCTER
*
ERROR3   M:WRITE  M:LO,(BUF,EM3),(SIZE,28),WAIT
         AI,2     -7
         LB,1     *2
         M:WRITE  M:LO,(BUF,*2),(BTD,1),(SIZE,*1),WAIT
         M:EXIT
EM3      TEXT     'ROM IN EF LIST NOT IN TREE: '
*
SYSACCT  TEXT     ':SYS '
         DATA     0,0
*
CHKSIZ   CW,6     LOCCTLIM
         BL       *10
         PSW,9    STK
         M:GP     1
         BCS,8    ERROR1
         LI,9     512
         AWM,9    LOCCTLIM
         PLW,9    STK
         B        *10
*
LOCCTLIM DATA     500
*
         PAGE
CARDSIZ  EQU      30
*
LOCCTER  EQU      %
         AI,13    -1
         STW,7    *13               SIZE TO FIRST WORD
         M:LDTRC  'LOADER',':SYS'
         M:EXIT
ERROR4   M:WRITE  M:LO,(BUF,EM4),(SIZE,34),(BTD,0),WAIT
         M:ERR
EM4      TEXT     'I/O ERROR, CAN''T WRITE LOCCT FILE.'
         END      START
