         PCC      1
         SYSTEM   SIG7
         TITLE    'LEMUR2 -- ADD, REPLACE CODE -- TERRY MOORE'
         SPACE
*M* LEMUR2  DOES WORK FOR ADD/REPLACE; CONTAINS ROM SCANNER.
         SPACE    2
*P*************************************************************
*P*
*P* NAME:  LEMUR2
*P*      CONTAINS CODE TO DO ADD, REPLACE COMMANDS.
*P*
*P*************************************************************
         TITLE    'LEMUR2 -- REFS AND DEFS'
         SPACE
*****************************************************************
*
* REFS & DEFS:
*
*  1.    ROUTINES DEFINED IN THIS MODULE.
*
         SPACE
         DEF      ADD#              RTN:   DOES WORK FOR ADD/REPLACE
         DEF      DELETE#           RTN:  DOES WORK FOR DELETE
         DEF      CARRY#            RTN:   DOES WORK FOR CARRY
         DEF      COPY#
         DEF      SCANROM           RTN:   SCANS A ROM FILE
         DEF      READSYM           RTN:   READS A SYMBOL FROM ROM LNG.
         DEF      HASH              RTN:   CALCULATES HASH FUNCTN. FOR S
*,*                                        SYM->SYMBOL.
         DEF      FINDMOD           RTN:   DETERMINES IF MODULE EXISTS
         DEF      APPEND            RTN:   APPENDS ONE STRING TO ANOTHER
         DEF      ENTER             RTN:    ENTERS A SYM IN HASH TABL
         DEF      ISNEXT            RTN:   DETERMINE THAT NEXT ITEM
*,*                                        IN SCAN TABLES IS THE
*,*                                        DESIRED TOKEN.
         DEF      BLDDIC            RTN:   CONSTRUCTS DICTIONARY
*,*                                        FROM REF/DEF STACK
         DEF      LIB#              RTN:   HANDLES LIBRARY COMMAND
         PAGE
         SPACE
*
*  2.    ROUTINES DEFINED IN OTHER MODULES:
*
         SPACE
         REF      CPYROM            RTN:   COPIES ROM INTO LIBRARY
         REF      CRELIB            RTN:   CREATES LIBRARY.
         REF      DICENT            RTN:   MAKES ENTRY IN THE DICTIONARY
         REF      DONE              RTN:   CALLED WHEN DONE W/ COMMAND
         REF      ERRENT            RTN:   CALLED TO SIGNAL ERRORS.
         REF      EXTOPT            RTN:   GETS VALUE OF SPECIFIED OPTION
         REF      GETBLK            RTN:   GETS A REF/DEF BLOCK
         REF      GETC              RTN:   GETS NEXT CHARACTER FROM ROM
         REF      MAKEKEY           RTN:   MAKES TEXTC FROM DESC.
         REF      OPENROM           RTN:   SELECTS INPUT ROM
         REF      OPENLIB           RTN:   SELECTS LIBRARY
         REF      CLSDCB
         REF      RDKEY             RTN:   READS KEYED RECORD
         REF      RETCC0            RTN:   DOES POP-JUMP, CC:=0
         REF      RETCC3            RTN:   DOES POP-JUMP, CC:=3
         REF      RETURN            RTN:   DOES POP-JUMP.
         REF      RSTCPY            RTN:   SELECTS OUTPUT MODULE FORM
*,*                                        COPYING ROM INTO LIBRARY.
         REF      SETNAME           SETS NAME IN DCB
         REF      CLOSEREL
         REF      COMPARE
         REF      DICENT1
         REF      CARLMN
         REF      KEYDESC
         REF      COPY
         REF      WINDOWN
         REF      DPOINTERS         RTN*  DELETES DIC POINTERS TO D:DESTMOD
         REF      DROMS             RTN:  DELETES ALL RECORDS IN D:DESTMOD
         REF      DLMN              RTN:  DELETES ALL LMN RECORDS.
         REF      DICDEL            DELETES DICTIONARY ENTRIES
*,*                                 FOR SYMBOLS IN THE DESTINATION MOD.
         REF      DICCHECK          CHECKS FOR DUPLICATE SYSM IN DIC.
         REF      DELKEY            DELETES A KEYED RECORD.
         REF      READSEQ           READS SEQUENTIALLY.
         REF      DEMPTY
         PAGE
         SPACE
*
*  3.    DYNAMIC DATA
*
         SPACE
         REF      ADDREP            FLAG:  BITS 2-3 ON MEAN THAT
*,*                                        WE SHOULDN'T ATTEMPT TO
*,*                                        DELETE MODULE BEFORE ADDING
*,*                                        A NEW ONE.
         REF      BLDDICI           CELL:  PRIVATE TEMP FOR BLDDIC
         REF      C%OPTS            DWD:   USED DIRECTLY TO TEST BIT-
*,*                                        WIDTH OPTIONS.
         REF      DESCNDX           CELL:  INDEX OF NEXT FREE WORD IN
*,*                                        DSCPOOL.
         REF      DSCPOOL           DESCRIPTOR VECTOR:  CONTAINS
*,*                                        DESCRIPTORS OF ALL TOKENS
*,*                                        SCANNED IN PARSE PHASE.
         REF      FREECHN           PTR:   HEAD OF FREE SPACE LIST.
         REF      HSHTBL            PTR VECTOR:  HEADS OF HASH CHAINS
         REF      KEYBUF            BUFF:  USED TO MAKE KEY FOR FINDMOD
         REF      MODNAME           BUFFER:
*,*                                        TEXTC OF MODULE FOR WHICH WE
*,*                                        ARE BUILDING DICTIONARY.
*,*                                        MUST BE ON A DW-BOUND.
         REF      MODTYP            FLAG:  ON MEANS MODULE IS ROM
         REF      SCTBL             WORD VECTOR:  TABLE OF SCANNED
*,*                                        TOKENS.
         REF      SCTBNDX           CELL:  INDEX TO LAST SIGNIFICANT
*,*                                        ENTRY IN SCTBL.
         REF      SYM               PTR:   @ OF REF/DEF BLOCK ON
*,*                                        WHICH WE ARE TO OPERATE.
         REF      #DECL             BYTE:  NUMBER OF DECLARATIONS SEEN
*,*                                        THUS FAR, MODULO 256.
         PAGE
         REF      L:BASE            TEMP TO REMEMBER COMMON
         REF      D:DESTMOD         DESCRIPTOR OF MODULE NAME
         REF      D:DESTLIB         DESCRIPTOR OF DESTINATION LIBRARY.
         REF      I:ISNEXT          TEMP TO REMEMBER SCAN INDEX FOR
*,*                                 ISNEXT.
         REF      L:ROMBASE         CELL TO REMEMBER WHERE ROM TABLES
*,*                                 BEGIN.  UPDATED FOR EACH ENTRY.
         REF      ARGBD             ARGUMENT TO BLDDIC.
         REF      L:DCB             DCB POINTER
         REF      D:SORSLIB         DESCRIPTOR OF SOURCE LIB (3-WORDS)
         REF      OKEYBUF
         REF      D:SORSMOD         DESCRIPTOR OF SOURCE MOD. NAME
         REF      FDSYMS            SYMBOL DELETE FLAG
         REF      ROMSRC
         REF      IKEYBUF
         REF      D:KEY
         REF      L:SIZE
         REF      ROMBUF
         REF      L:BUF
         REF      L:NOROM           NO. OF ROMS
         REF      L:MAPROM          FLAG FOR SNEAKING INTO LOADER FOR
*,*                                 MAP OPTION ON ROM LIBRARY.
         REF      L:PAGES
         SPACE
*
*  4.    STATIC OPTION DATA CELLS:
*
         SPACE
         REF      O%DUPM            WHAT TO DO W/ DUPLICATE MODULES
         REF      O%SL              MAXIMUM SEVERITY LEVEL.
         REF      O%ROM             MODULE IS TO BE ADDED AS ROM/LMN
         REF      O%X               WHAT TO DO IF LOADER ABORTS IN
*,*                                 BATCH.
         REF      O%DUPS            WHAT TO DO W/ DUPLICATE SYMBOLS
         REF      O%MAP
         SPACE
         REF      SCRATCH
         PAGE
         SPACE
*
*  5.    DATA FROM 'LITERALS':
*
         SPACE
         REF      BLANK             C'    '  I.E. X'40404040'
         REF      BT31TO0           ORDERED TABLE OF BITS.
         REF      DOUBLEONE         DWD OF 1,1; USED TO INC. 2 PTRS.
         REF      MASKS             WORD VECTOR:  ORDERED BIT MASKS.
         REF      XF                X'F'
         REF      X0                ZERO
         REF      Y04               X'04000000'
         PAGE
         SPACE
*
*  6.    MONITOR-DEFINED CELLS:
*
         SPACE
         REF      J:TCB             POINTER TO LEMUR'S TCB TEMP STACK.
         REF      J:ACCN            USER ACCOUNT NUMBER
         REF      J:JIT             SYSID
         REF      F:LIB
         REF      F:SORS            DCB TO READ SOURCE LIBRARY
         REF      F:ROMIN
         SPACE
*
*  7.    ERROR CODES:
*
         SPACE
         REF      E#ILRL            ILLEGAL ROM LANGUAGE
         REF      E#MAE             MODULE ALREADY EXISTS.
         REF      E#MSLX            MAX SEVERITY LEVEL EXCEEDED.
         REF      E#UEOR            UNEXPECTED END-OF-ROM
         REF      E#FNTL            ROM NAME TOO LONG FOR LOADER ROM TABLES.
         REF      E#LNTL            LIB. LOAD MOD. NAME TOO LONG
*,*                                 FOR LOADER TREE TABLE.
         REF      E#NOCORE
         REF      E#COL
         REF      E#COF
         REF      E#NLIB
         REF      E#IDS
         PAGE
         SPACE
*
*  8.    SYMBOLIC CONSTANTS DEFINED IN OTHER MODULES OF LEMUR:
*
         SPACE
         REF      HSH:N             BASE-2 LOG OF # OF WORDS IN HSHTBL
         REF      SYM:MAX           MAXIMUM # OF CH IN A SYMBOL
         REF      BLK:L             MAXIMUM # OF WORDS IN EACH BLOCK.
         REF      L:#OPS
         REF      O#DMOD            VALUE OF O%DUPM MEANING THAT
*,*                                 MODULE IS TO BE DELETED
         REF      O#DSYM            VALUE OF O%DUPS MEANING THAT
*,*                                 SYMBOLS IN MODULEE APPEARING
*,*                                 IN DICTIONARY ARE TO BE DELETED.
         REF      ROMSIZE
         TITLE    'LEMUR2 -- MISCELLANEOUS DEFINITIONS'
*
*  9.    CONSTANTS DEFINED IN OTHER MODULES OF LEMUR
*
         REF      GCP               FPT FOR GETTING COMMON PAGE
         REF      LINKFPT           FPT FOR M:LINK TO LOADER.
         REF      FCPFPT            FPT FOR FCP 255
         REF      L:REFDFLTS
         REF      BLANKS
         REF      ZEROES
         REF      L:RDDFLTS
         REF      L:LOCWDDEF
         PAGE
*
*  10. CONSTANT TABLES DEFINED ELSEWHERE IN LEMUR.
         REF      L:OPS
         REF      L:SHIFTS
         REF      L:MASKS
         PAGE
         SPACE
***************************************************************
*
* REGISTER DEFINITIONS
*
I1       EQU      1
I2       EQU      2
I3       EQU      3
T0       EQU      4
T1       EQU      5
T2       EQU      6
T3       EQU      7
R0       EQU      8
R1       EQU      9
R2       EQU      10
R3       EQU      11
A0       EQU      12
A1       EQU      13
A2       EQU      14
A3       EQU      15
RTN      EQU      A3
*
* I AGREE, THEY ARE RATHER NON-STANDARD.
*
***************************************************************
         PAGE
         SPACE
*************************************************************
*
* CONTROL SECTIONS --
*
         SPACE
CODE     CSECT    1
STRINGS  CSECT    1
         PAGE
         SPACE
***************************************************************
*
*  TYPES OF OBJECTS IN SCTBL--
*
* NAME            VALUE             MEANING                DESCRIPTORS
* ----            -----             -------                -----------
         SPACE
T%MNAME  EQU      1                 MODULE NAME            1
T%GRP    EQU      2                 GROUP NAME             1
T%DNAME  EQU      3                 SYMBOL (DEF)           1
T%LID    EQU      4                 LIBRARY NAME (N).A.P   3
T%FID    EQU      5                 FILE NAME N(.(A)(.P))  3
T%DEF    EQU      6                 DEF W/ MNAME DEF>>M    2
T%EOL    EQU      7                 END OF LINE
T%GRNCH  EQU      8                 N(.(A)(.P))<GNAM>/MNAM 5
T%UN     EQU      9                 + (UNION OP)           0
T%INT    EQU      10                - (INTERSECTION)       0
T%EQ     EQU      11                = (REPLACEMENT)        0
T%ON     EQU      12                'ON'/'TO'              0
T%OVER   EQU      13                'OVER'                 0
T%USING  EQU      14                'USING'                0
         TITLE    'LEMUR2 -- MACROS'
         SPACE
***************************************************************
*
*  MISCELLANEOUS MACROS--
*
*        CALL     ROUTINE
*                 EMITS A STANDARD (BAL,RTN) CALL TO AF(1)
*
CALL     S:SIN,1  X'6AF'
         SPACE
*
*
* SUBROUTINE:
*        GENERATES A 'PSW,15 *J:TCB'
*
SUBROUTINE ;
         CNAME
         PROC
LF       EQU,0    %
         PSW,RTN  *J:TCB
         PEND
         PAGE
         SPACE
*
*        PUSH     R                 PUSHES REGISTER 'R' ONTO TEMP STACK IN TCB
*        POP      R                 POPS TCB STACK INTO REGISTER R
*        PUSH     R1,R2             PUSHES REGISTERS R1 THROUGH R2 ON
*                                   TCB TEMP STACK
*        POP      R1,R2             POPS REGISTERS R1 THROUGH R2 FROM
*                                   TCB TEMP STACK
*
         SPACE
PUSH     CNAME    1
POP      CNAME    0
         PROC
LF       EQU,0    %
         LOCAL    I
         DO       NUM(AF)>1
I        SET      ((AF(2)-AF(1))+17)&X'F'
         DO1      I=1
I        SET      0
         LCI      I
         ELSE                       JUST A SIMPLE PSW,OR PLW, PLEASE.
I        SET      1                 PUSHING 1 WORD.
         FIN
         GEN,1,5,1,1,4,3,17 1,2,I~=1,NAME,AF(1),0,J:TCB
         PEND
         PAGE
         SPACE
*
*  D(STRING)
*        RETURNS AS ITS VALUE THE DESCRIPTOR OF ITS ARGUMENT
D        FNAME
         PROC
         LOCAL    HERE,I
HERE     EQU      %
         USECT    STRINGS
I        TEXT     AF
         USECT    HERE
         PEND     (S:NUMC(AF)**24)+BA(I)
         SPACE
*
*  E(ERROR NUMBER)
*        RETURNS AS ITS VALUE THE ADDRESS TO BRANCH TO FOR
*        THAT ERROR CODE.
*
E        FNAME
         PROC
         PEND     AF
         TITLE 'LEMUR2 -- ADD# -- DOES WORK FOR ADD/REPLACE'
         SPACE
         USECT    CODE
ADD#     EQU      %
         LI,A1    0
         STW,A1   L:MAPROM
         LI,A1    F:LIB             ARE WE TO DELETE?
         STW,A1   L:DCB
         LW,A2    D:DESTMOD         GET MODULE NAME
         CALL     FINDMOD           DOES IT EXIST?
         STCF     ADDREP            FLAG: CC=0 --> IT EXISTS.
         BNE      ADD#1             B/ NOT THERE: DONT DELETE.
*                                   OLD MODULE, ETC.
         LI,R1    +O%DUPM           EXTRACT OPTION FIELD WHICH TOLD US
*                                   WHAT TO DO FOR A DUPLICATED MODULE.
         BAL,T3   EXTOPT            EXTRACT OPTION:  VALUE COMES BACK IN
*                                   R0; R1 IS CREAMED.
         CI,R0    O#DMOD            ARE WE TO DELETE IT?
         BNE      E(E#MAE)          B/ NO: ERROR, MODULE ALREADY EXISTS
ADD#1    EQU      %                 ARE BUILDING A ROM OR A LMN?
         LW,R0    O%ROM             GET THE OPTION,
         CW,R0    C%OPTS            IS IT ROM OR LM?
         BAZ      ADDLMN            B/ ADD A LEMON
*
*  READ REF/DEF STACK FOR ROM AND DETERMINE THAT IT IS WELL-FORMED;
*  BUILD SYMBOL TABLE FOR ROM, & DETERMINE THAT NO SYMBOLS ARE DUPLICATED
*  IN THE DICTIONARY (ADD ONLY).
ADDROM1  LI,T3    +0                START AFTER FIRST ITEM IN THE
*                                   SCAN TABLE,
         STW,T3   I:ISNEXT
ADDROML  LI,R0    +T%FID            SCAN FOR A FILE NAME.
         CALL     ISNEXT            SETTING T3 TO AN INDEX TO IT IN THE SCAN TAB
         BNE      ADDROM2           B/ OUT OF ROMS TO SCAN.
         AI,A1    +DSCPOOL          MAKE POINTER OUT OF INDEX.
         CALL     OPENROM           AND TELL EVERYONE WE'RE TALKING TO
*                                   A ROM.
         LI,A2    +ENTER            GET @ OF ROUTINE TO HANDLE DEF'S
         CALL     SCANROM           AND GO EAT THIS ROM.
* ROM HAS BEEN SCANNED, TRY ANOTHER.
         B        ADDROML           AND GO EAT ANOTHER (IF ANY)
         PAGE
         SPACE
*
*  ROM IS GOOD: IF WE ARE DOING A REPLACEMENT, DELETE THE OLD MODULE,
*  THEN FOR ALL CASES, COPY THE NEW MODULE INTO THE LIBRARY.
*
ADDROM2  EQU      %
         CALL     OPENLIB           DOES THE LIB EXIST?
         BNEZ     ADDRML0           BRANCH IF NO. (DONT DELETE ANYTHING)
         LI,R1    O%DUPS            ARE WE TO DELETE DUPLICATE SYMS?
         BAL,T3   EXTOPT
         CI,R0    O#DSYM
         BE       YESDEL            YES, BRANCH.
*                                  NO, THEN CHACK THAT THERE ARE
         CALL     BLDDIC            NONE BEFORE WE START TO CHANGE
         DATA     DICCHECK          THE LIBRARY.
         B        ADDROM21
YESDEL   EQU      %                 RUN THE ROM'S SYMBOLS, DELETING
         CALL     BLDDIC            DUPLICATES IN THE DIC. AS WE GO.
         DATA     DICDEL
ADDROM21 EQU      %                 SHALL WE DELETE THE MODULE?
         LC       ADDREP
         BNE      ADDRML0           B/NO. IT DOESN'T EXIST.
         CALL     DELMOD            YES. DELETE IT
** LOOP THROUGH THE SCAN TABLE AND CATENATE ALL THE ROMS TOGETHER
** INTO ONE BIG HAPPY MODULE.
ADDRML0  EQU,0    %
         CALL     OPENLIB           MAKE SURE THE LIBRARY IS OPEN,
         BE       %+2               B/ IT IS;
         CALL     CRELIB            NOT OPEN ==> DOESN'T EXIST:  CREATE
         LI,T3    +0                START AT THE BEGINNING (WHERE ELSE?)
         STW,T3   I:ISNEXT
         LW,A2    D:DESTMOD
         LI,I3    BA(OKEYBUF)
         CALL     RSTCPY            SET UP TO COPY IN ROMS...
ADDRML1  LI,R0    +T%FID            FIND A FILE NAME...
         CALL     ISNEXT
         BNE      ADDROM3           B/ ALL DONE.
         AI,A1    +DSCPOOL          GET POINTER TO MODULE NAME,
         CALL     OPENROM           AND OPEN UP THE ROM.
         CALL     CPYROM            COPY IT IN,
         B        ADDRML1           AND LOOP.
         SPACE
* ROM IS COPIED IN...
ADDROM3  EQU      %
         CALL     BLDDIC            BUILD THE DICTIONARY
         DATA     DICENT            ENTER INTO THE DICTIONARY.
         PAGE
         LI,T2    F:ROMIN           CLOSE THE LAST ROM
         BAL,T3   CLSDCB
*        CHECK FOR MAP OPTION ON ROM LIBRARY.
         LI,R1    O%MAP
         BAL,T3   EXTOPT
         CI,R0    1
         BNE      DONE              B/ NO MAP DESIRED.  ALL DONE.
*        GO TO THE LOCCT BUILDING LOGIC.  SET UP A LOCCT FOR
*        THE LOADER TO CREATE A TEMPORARY LOAD MODULE WITH A BIAS OF
*        0, NOTCB,NOSYSLIB AND......MAP!
         MTW,1    L:MAPROM
         B        TREE
         TITLE    'LEMUR2 -- SCANROM -- CHECKS A ROM FOR VALIDITY/DEFS'
         SPACE
*****
*  SCAN A ROM...
*        ASSUMES THAT OPENROM HAS BEEN CALLED TO SET WHICH ROM
*        WE ARE TALKING TO;
*
*        ALSO ASSUMES A2 CONTAINS THE ADDRESS OF A ROUTINE TO
*        BE CALLED TO HANDLE ENTERING SYMBOLS.  NOTE THAT NOBODY
*        CHANGES EITHER A2 OR I1 IN THIS CODE; THE ROUTINE TO
*        ENTER SYMBOLS HAD BETTER NOT CHANGE THEM EITHER.
*
*
N        EQU      I1                INDEX: 0 --> # OF DCL'S <256
*                                          -1 --> # OF DCL'S >=256
         SPACE
SCANROM  SUBROUTINE                 A2= @ OF DEF HANDLER.
         LI,N     +0                NO DEF'S SEEN YET,
         STB,N    #DECL             SO SAVE & REMEMBER.
LOOP     CALL     GETC              GET A CHARACTER IN T2
LOOP1    BNE      E(E#UEOR)         B/ EOF HIT: ERROR, UNEXPECTED END OF ROM.
         CI,T2    +X'E0'            WHAT KIND OF A BEASTIE BE THEE?
         BAZ      RLTBL,T2          B/ I BE A SIMPLE BEASTIE. TABLE TIME.
         CI,T2    +X'C0'            THOU BE A SPECIAL CASE?
         BANZ     SPECIAL           B/ YUP.  GO GRUNGE FOR THOSE.
*  THESE ARE THE CODES THAT NEED TO BE SHIFTED RIGHT.
         SLS,T2   -2                SHIFT OFF UNIMPORTANT RESOLUTION STUFF
         B        %-7,T2            AND COMPENSATE FOR WEIRD BIAS...
*
         B        2A,N              ADD VALUE OF DECLARATION: 2 OR 3 BYTES.
         B        3A                ADD VAL OF FWD. REF.  3 ALWAYS.
         B        2A,N              SUB VAL OF DCL; 2 OR 3 BYTES.
         B        3A                SUB VAL OF FWRD. REF.:  3 BYTES ALWAYS
         B        1A                CHANGE EXPRESSION RESOLUTION: 1 BYTE
         B        1A                ADD ABS SECTION: 1 BYTE
         B        1A                SUB ABS SECT: 1 BYTE
         B        E(E#ILRL)         ILLEGAL ROM LANGUAGE.
         PAGE
         SPACE
*
*  THESE ARE THE CODES THAT TRY MEN'S SOULS...
*  SPECIAL CASE 'EM TO DEATH.
SPECIAL  CI,T2    +X'80'            IS IT A LOAD RELOC. SHORT?
         BANZ     5A                B/ YES:  ALWAYS 5 BYTES LONG.
         CI,T2    +X'B0'            IS IT A LOAD ABSOLUTE?
         BAZ      LABS              B/ YES:  VARIABLE LENGTH.
* THIS SHOULD BE A LOAD RELOCATABLE (LONG FORM)
         CI,T2    +X'A0'            CHECK FOR WEIRDNESSES,
         BANZ     E(E#ILRL)         B/ AHA! TRIED TO FOOL ME, EH?
         CI,T2    +X'4'             (I KNOW, IT LOOKS SILLY)
         BAZ      6A                IF IT SAYS SIX BYTES, THEN EAT 6.
         CALL     GETC              ELSE GO EAT ONE EXTRA,
*** AND FALL INTO 6A . . .
         SPACE
*
*  EAT 5,4,3,2,1 OR NO EXTRA BYTES.  THE NUMBERS IN THE LABELS CORRESPOND
*  TO THE # OF BYTES IN THE COMMAND, INCLUDING THE FIRST CODE BYTE.
         SPACE
6A       CALL     GETC
5A       CALL     GETC
4A       CALL     GETC
3A       CALL     GETC
2A       CALL     GETC
1A       LI,RTN   +LOOP1            RETURN TO THE LOOP
         B        GETC              AFTER GETING THE NEXT COMMAND.
         PAGE
*
*  EAT A VARIABLE # OF BYTES
LABS     AND,T2   XF                GET # OF BYTES FOR LOAD ABS.
GETMC    LW,T0    T2                COPY THE COUNT INTO A SAFE PLACE
         AI,T0    +1                GET THE REAL COUNT,
         LI,RTN   +GETMC1           GET RETURN @
GETMC1   BDR,T0   GETC              AND EAT GORPS OF CH.
         B        LOOP              NOW, GO GET A COMMAND.
         PAGE
*
* BRANCH TABLE FOR ORDINARY LOAD CODES.
RLTBL    EQU,0    %
         B        1A         :00    PADDING BYTE,
         B        5A         :01    ADD CONST:  5 BYTES
         B        1A         :02    EXPRESSION END: 1 BYTE
         B        DECDEF     :03    FOUND A DEF!
         B        1A         :04    ORG
         B        1PLUSK     :05    PREF
         B        1PLUSK     :06    SREF
         B        3A         :07    FIELD:  3 BYTES
         B        3A         :08    FORWARD REF: 3 BYTES
         B        4A,N       :09    DCL DSECT:  4 OR 5 BYTES.
         B        2A,N       :0A    SET VAL OF EXT DEF
         B        4A         :0B    STD. CSECT
         B        4DEF       :0C    NSTD CSECT DCL: 4BYTES, + DCL
         B        1A         :0D    START @: 1 BYTE
         B        MEND       :0E    MODULE END: 2 BYTES
         B        3A         :0F    RPT LOAD:  3 BYTES
         B        3A         :10    FWD REF DEFINE AND HOLD.  3 BYTES.
         B        3A,N       :11    TYPE INFO FOR EXT DEF: 3 OR 4 BYTES.
         B        3PLUSLS    :12    DCL INTERNAL SYM: 3 + LENGTH OF SYMBOL
         B        4PLUSLS    :13    DCL UNDEF INT. SYM: 4 + LENGTH OF SYM
         DO1      X'1D'-X'13'       THESE CODES ARE TRASH..
         B        E(E#ILRL)
         B        4DEF       :1E    PSECT: 4 BYTES, ALSO IS A DCL.
         B        E(E#ILRL)  :1F    TRASH.
         PAGE
         SPACE
*** PREF/SREF DEFINITION
1PLUSK   CALL     GETC              GET K,
SAWDECL  MTB,+1   #DECL             BUMP # OF DECLARATIONS.
         BNC      GETMC             B/ N IS OK; GO EAT SOME BYTES.
         LI,N     -1                ELSE SET N TO INDICATE WE'VE SEEN..
         B        GETMC             .. MORE THAN 255 DECLARATIONS (YES,...
*                                   ...THIS WORKS FOR ANY # OF DECLARATIONS,...
*                                   ... INCLUDING MORE THAN 512, ETC.
         SPACE    2
*** DECLARE NON-STD CSECT OR PSECT.
4DEF     LI,T2    +3                EAT 3 MORE BYTES,
         B        SAWDECL           AND BUMP # OF DECLARATIONS SEEN.
         SPACE
*** SAW INTERNAL SYM DEF...
3PLUSLS  CALL     GETC              GET A GARBAGE CH,
         LI,RTN   +GETMC            GET LENGTH BYTE, THEN EAT REST OF SYM
         B        GETC
         SPACE
*** SAW INTERNAL UNDEFINED SYMBOL
4PLUSLS  CALL     GETC              SCAN TRASHY PROLOGUE,
         CALL     GETC              GET # OF BYTES IN SYMBOL NAME,
         AI,T2    +2                SCAN 2 EXTRA BYTES AFTER NAME,
         B        GETMC             AND EAT THEM.
         PAGE
         SPACE
*** SAW MODULE END
MEND     CALL     GETC              GET SEVERITY LEVEL,
         LI,R1    O%SL              GET MAX SEVERITY LEVEL,
         BAL,T3   EXTOPT            AND THE OPTION SL
         CW,T2    R0                WAS THE SEVERITY TOO SEVERE?
         BG       E(E#MSLX)         B/ YES, MAXIMUM ERROR SEVERITY EXCEEDED
         CALL     GETC              EAT CH TILL YOU SEE A NON-ZERO OR
         BNE      RETURN            AN END OF FILE. B/ END OF FILE SEEN.
         AI,T2    +0                WAS THE CHARACTER A PADDING BYTE?
         BEZ      GETC              B/ YES, GO GET A CH & COME BACK ABOVE.
         LI,N     +0                AHA! STARTING A NEW ROM.  WE'VE SEEN < 256,
         STB,N    #DECL             IN FACT, WE'VE SEEN NO DECLARATIONS AT ALL
         B        LOOP1             NOW, GO HANDLE THIS COMMAND.
         PAGE
         SPACE
*** WE SAW AN EXTERNAL DEFINITION.
DECDEF   CALL     GETBLK            GET SOMEPLACE TO PUT A REF/DEF STACK ENTRY
         CALL     READSYM           READ TH E SYMBOL INTO THE BLOCK
         CALL     *A2               REMEMBER ME? I'M THE ROUTINE TO HANDLE DEF'S
*                                   I PROMISE I DON'T CLOBBER I1.
         LI,T2    +0                DON'T NEED TO SCAN ANY BYTES,
         B        SAWDECL           JUST FLAG:  ANOTHER DECLARATION SEEN.
         TITLE 'LEMUR2 -- READSYM -- READS A SYMBOL FROM ROM'
         SPACE
         SPACE
*** READ A SYMBOL INTO BLOCK POINTED TO BY SYM
READSYM  SUBROUTINE
         CALL     GETC              GET THE LENGTH,
         LW,T0    T2                SAVE IN A SAFE PLACE,
         BEZ      E(E#ILRL)         B/ YOU CAN'T HAVE A NULL SYMBOL!!
         LI,T2    +BLK:L            STORE # OF WORDS IN THIS BLOCK,
RDSYM0   STB,T2   *SYM              ***DON'T CHANGE THE LABEL ON THIS***
         ANLZ,I2  RDSYM0            GET BYTE @ OF START OF BLOCK
         CI,T0    +SYM:MAX          IS SYMBOL TOO LONG?
         BLE      RDSYM1            B/ NO, IT'S OK.
         LI,R0    +SYM:MAX          IT'S TOO LONG:
         STB,R0   +3,I2             POKE AWAY COUNT...
         B        RDSYM2            AND GO EAT UP THE SYMBOL.
RDSYM1   STB,T0   +3,I2             POKE AWAY THE COUNT,
RDSYM2   LI,I3    +0                CLEAR OUT COUNTER,
         AI,I2    +1                MAKE I2 POINT TO PROPER PLACE
         CALL     GETC              GET A CHARACTER FOR THE SYMBOL
         STB,T2   +3,I2             POKE IT AWAY,
         AD,I2    DOUBLEONE         INCREMENT POINTER, # OF CH STORED,
         CI,I3    +SYM:MAX          HAVE WE EATEN ALL WE CAN STAND?
         BL       %+2               B/ NO:  CONTINUE SAVING CHARACTERS
         LI,RTN   %+1               ELSE IGNORE ALL CH AFTER 11TH
         BDR,T0   GETC              GET ANOTHER CHARACTER.
* SYMBOL HAS BEEN TRUNCATED IF NECESSARY, NOW PAD W/ BLANKS.
         LI,R0    +C' '             GET A BLANK...
RDSYM3   CI,I3    +SYM:MAX          # OF CH STORED ALREADY: ALL DONE?
         BG       RETURN            B/YES: ALL DONE.
         STB,R0   +3,I2             STUFF IT,
         AD,I2    DOUBLEONE         BUMP POINTER & COUNTER
         B        RDSYM3            AND TRY AGAIN.
         TITLE 'LEMUR2 -- HASH -- CALCULATES HASH CODE FOR SYM'
         SPACE
*** HASH CALCULATOR:  WORKS ON REF/DEF BLOCK @ SYM
HASH     EQU,0    %
         LI,R1    +0                INITIALIZE,
         LB,T3    *SYM              GET # OF WORDS IN ENTRY,
         AI,T3    -1                MAKE IT AN INDEX TO LAST WORD.
         SPACE
* LOOP THROUGH THE SYMBOL BLOCK AND MAKE A 32-BIT SUM OF ALL WORDS.
* N.B.:  THE FX TRAP SHOULD HAVE BEEN SET TO 'IGNORE'.
         AW,R1    *SYM,T3           ACCUMULATE THIS SYMBOL WORD.
         CI,T3    +3                ARE WE DONE?
         BG       %-3               B/ NO. ACCUMULATE ANOTHER WORD.
         SPACE
* NOW TAKE THE THIRTY-TWO BIT SUM AND SQUARSH IT DOWN INTO
* HSH:N BITS; T3 PROVIDES A NICE BIAS OF THREE.
         SLD,R0   +HSH:N            GET WIDTH OF ACCUMULATION,
         AW,T3    R0                ACCUMULATE SUM,
         AI,R1    +0                ARE WE DONE?
         BNEZ     %-3               B/ NO: GO ACCUMULATE SOME MORE.
         AND,T3   MASKS+HSH:N       GET THE SIGNIFICANT BITS,
         B        *RTN              AND EXIT.
         TITLE 'LEMUR2 -- FINDMOD -- FIND MODULE IN LIBRARY'
         SPACE
*** DETERMINE IF MODULE EXISTS, SET UP POINTER TO FIRST RECORD.
FINDMOD  SUBROUTINE
         CALL     OPENLIB
         BNE      RETCC3            IF LIBRARY DOESN'T EXIST, MODULE DOESN'T
         LI,I3    0
         STW,I3   L:SIZE
         LI,I3    +BA(KEYBUF)+1     MAKE STRING 'XXXX'||'HEAD'
         LW,I2    A2                ...IN KEY BUFFER.  FIRST,...
         CALL     APPEND            ...MOVE MODULE NAME INTO BUFFER;...
         LW,I2    =D('HEAD')        ...THEN GET DESCRIPTOR OF 'HEAD'
         CALL     APPEND            ...AND MAKE THE STRING.
         CALL     RDKEY             SEE IF THE HEAD RECORD EXISTS.
         BNE      FNDMOD1           B/ NO HEAD RECORD, SEE IF IT'S A ROM.
         LI,R0    +0                RECORD THAT IT'S A LMN,
FNDMOD0  STW,R0   MODTYP
         B        RETCC0            AND RETURN TRUE.
         SPACE    2
*** CHECK FOR A ROM LIBRARY MODULE...
FNDMOD1  SW,I3    Y04               REMOVE 'HEAD' FROM THE NAME...
         LW,I2    =X'02000000'+BA(X0)  APPEND 2 BYTES OF ZEROS...
         CALL     APPEND
         CALL     RDKEY             ...AND SEE IF THE RECORD EXISTS.
         BNE      RETCC3            B/ NO SUCH KEY; NO SUCH ROM.
         LI,R0    +1                REMEMBER THAT WE ARE A ROM,
         B        FNDMOD0           ...SAVE THAT # AND EXIT TRUE.
         TITLE 'LEMUR2 -- ISNEXT -- CHECKS NEXT ITEM IN SCTBL'
         SPACE
*F***********************************************************
*F*
*F* NAME:  ISNEXT
*F*      CHECKS NEXT ITEM IN SCTBL, AND SETS CC3-4 :=I0 IFFI
*F*      THE NEXT ITEM IS OF THE TYPE DESIRED.
*F*
*F* DESCRIPTION:
*F*      (R0) IS THE TOKEN # THAT WE WANT TO SEE;
*F*     I:ISNEXT IS THE INDEX INTO SCTBL FOR THE *L A S T* ITEM
*F*           EXAMINED.
*F*      IF THE TEST SUCCEEDS, THEN (A0) IS SET TO (R0), AND (A1)
*F*      IS SET TO THE INDEX IN DSCPOOL FOR THIS TOKEN'S SEMANTIC
*F*      INFORMATION.
*F*
*F**************************************************************
         PAGE
         SPACE
ISNEXT   EQU,0    %
         MTW,1    I:ISNEXT          INCREMENT SCAN INDEX.
         LW,T3    I:ISNEXT
         CW,T3    SCTBNDX           ARE WE AT THE END OF THE SCAN TBL?
         BGE      ISNEXT1           B/ YES:  EXIT, CC34 ARE 2.
         INT,A0   SCTBL,T3          ELSE SPLIT THE TOKEN INTO ITS PARTS
         CW,R0    A0                AND SEE IF THIS IS WHAT WE WANT.
         BE       *RTN              B/ IT IS:  EXIT, CC34 ARE ZERO.
         LCI      +1                ELSE SIGNAL THAT ITEM EXISTS, BUT...
         B        *RTN              ...ISN'T WHAT IS WANTED, AND EXIT.
*
ISNEXT1  LCI      +2                ==> NO ITEMS LEFT IN LIST;
         B        *RTN              CC := 2, AND EXIT.
         TITLE 'LEMUR2 -- APPEND -- APPEND ONE STRING TO ANOTHER.'
         SPACE
*D*
*D* NAME:  APPEND
*D*
*D* CALL:
*D*      LW,I2    (DESCRIPTOR OF STRING WHICH IS TO BE APPENDED)
*D*      LW,I3    (DESCRIPTOR OF STRING TO WHICH WE ARE TO APPEND)
*D*      CALL     APPEND
*D*
*D* INPUT:
*D*      NONE
*D*
*D* OUTPUT:
*D*      I3 IS NEW DESCRIPTOR OF STRING TO WHICH WE DID THE APPEND.
*D*
*D* REGISTERS:
*D*      REGISTERS 0, I1 AND I2 ARE TRASHED; I3 GETS THE RESULT
*D*      (SEE 'OUTPUT'); ALL OTHERS ARE PRESERVED.
*D*
*D* SCRATCH:
*D*      0, I1 AND I2
*D*
*D* INTERFACE:
*D*      NONE.
*D*
*D* DESCRIPTION:
*D*      THE STRING POINTED TO BY THE DESCRIPTOR IN I2 IS APPENDED
*D*      TO THE STRING POINTED TO BY THE DESCRIPTOR IN I3.  NOTE
*D*      THAT THE FIRST PART OF THE STRING *I3 IS NOT MOVED; WE
*D*      ASSUME THAT THE SPACE AFTER THE DESTINATION STRING IS FREE
*D*      AND WE MOVE THE APPENDED STRING INTO THAT SPACE.
*D*
         PAGE
APPEND   EQU,0    %
         LB,0     I3                GET ORIGINAL COUNT OF DESTINATIO
         AW,I3    0                 ...POINT TO END OF DESTINATION STRING.
         LB,I1    I2                GET COUNT OF STRING BEING APPENDED,
         STB,I1   I3                AND MAKE THAT THE # OF BYTES TO MEOVE.
         MBS,I2   +0                NOW MOVE THE BYTE STRING.
         AW,I1    0                 LENGTH(ST1) + LENGTH(ST2) => LENGTH(ST1||ST2
         SW,I3    I1                MAKE DESCRIPTOR OF DESTINATION POINT...
         STB,I1   I3                ...TO THE BEGINNING; ADD IN NEW COUNT.
         B        *RTN              AND EXIT.
         TITLE 'LEMUR2 -- ENTER -- ENTERS A SYMBOL IN THE HASH TABLE.'
         SPACE
ENTER    SUBROUTINE                 ENTERS SYM->(REF/DEF BLOCK)
         CALL     HASH              GET HASH CODE FOR SYMBOL,
         AI,T3    +HSHTBL-1         GET POINTER TO 1ST WORD OF HSH CHN.
         LI,T1    +3*4              GET INDEX TO SYMBOL TEXT,
         SPACE
*D* PRE-LOAD LENGTH AND DESCRIPTOR OF SYMBOL WE ARE TRYING TO FIND,
         SPACE
ENTER0   LB,R0    *SYM,T1           GET LENGTH OF SYMBOL,
*                                   ** DON'T CHANGE THE LABEL ON THE ABOVE**
         ANLZ,R1  ENTER0            GET BYTE ADDRESS OF SYMBOL,
         STB,R0   R1                MAKE DESCRIPTOR,
         AI,R1    +1                AND POINT PAST THE COUNT BYTE.
*** LOOP POINT FOR FOLLOWING CHAIN:
*** T3 POINTS TO NEXT NODE IN CHAIN TO EXAMINE,
*** T2 POINTS TO PREVIOUS NODE.
ENTERNX  EQU,0    %
         LW,T2    T3                SAVE POINTER TO LAST NODE,
         LW,T3    +1,T3             GET POINTER TO NEXT NODE IN CHAIN,
         BEZ      ENTERI            B/ NO NEXT NODE: ENTER IT HERE.
         SPACE
*D* IF THE LENGTH OF THE NEXT ENTRY IN THE CHAIN IS NOT EQAUL TO
*D* THE LENGTH OF THE SYMBOL WE ARE ENTERING, THEN DON'T TRY A
*D* CBS; THE SYMBOLS CAN'T MATCH.  IF THE LENGTHS ARE EQUAL, THEN
*D* DO THE COMPARISON.
         SPACE
ENTER01  CB,R0    *T3,T1            ARE THE LENGTHS EQUAL?
         BNE      ENTERNX           B/ NO, TRY NEXT ENTRY IN CHAIN.
         ANLZ,R2  ENTER01           ELSE GET BYTE @ OF THIS ENTRY,
         LW,R3    R1                GET DESCRIPTOR OF SYM->SYMBOL;
         CBS,R2   +1                AND SEE IF THEY ARE EQUAL.
         BNE      ENTERNX           B/ NOT EQUAL.  TRY NEXT.
         SPACE
*** THIS IS THE SECOND DEFINITION FOR THIS SYMBOL;
*** RETURN SYM->(REF/DEF BLOCK) TO THE FREE LIST,
*** THEN MAKE SYM POINT TO THE BLOCK WHICH IS ALREADY IN THE TABLE.
         XW,T3    SYM               SYM NOW POINTS TO OLD BLOCK.
         LW,T2    FREECHN           NOW, INSERT T3->BLOCK AT HEAD...
         STW,T2   +1,T3             ...OF FREE CHAIN.
         STW,T3   FREECHN
         B        RETURN            SAY GOODBYE.
         SPACE
*** NO ENTRY WAS FOUND FOR SYM->BLOCK; ADD IT TO END OF CHAIN
*** AFTER T2->BLOCK.
ENTERI   LW,T1    SYM               PICK UP POINTER; T2->BLOCK.LINK :=
*                                                      SYM
         STW,T1   +1,T2
         STW,T3   +1,T1             AND ZERO SYM->BLOCK.LINK
         B        RETURN            FLICK IT IN.
         TITLE 'LEMUR2 -- BLDDIC -- BUILDS DICTIONARY FROM HASH TBL'
         SPACE
BLDDIC   LW,I1    *RTN              GET ARGUMENT FOR LATER BRANCH.
         STW,I1   ARGBD
         AI,RTN   1                 SAVE RETURN
         PUSH     RTN
         LW,I1    BLANK             Z
         STD,I1   MODNAME           A
         STW,I1   MODNAME+2         P
         LI,A1    +MODNAME          NOW, MAKE DESCRIPTOR INTO TEXTC.
         LW,A2    D:DESTMOD         GET MODULE NAME.
         BAL,T3   MAKEKEY
         LW,I1    BT31TO0+HSH:N+1   GET # OF WORDS IN HASH TABLE.
         SPACE
*** LOOP THROUGH EACH ENTRY IN THE HASH TABLE, ENTERING ALL SYMBOLS
*** WHICH ARE IN THAT ENTRY'S CHAIN.
BLDDIC0  LW,I2    HSHTBL-1,I1       GET NEXT HASH BUCKET,
         BNEZ     BLDDIC1           B/ SOMETHING WAS IN THIS CHAIN.
         BDR,I1   BLDDIC0           B/ THERE IS ANOTHER BUCKET TO TRY.
         B        RETURN            NOTHING LEFT TO DO. EXIT
         SPACE
*** LOOP THROUGH A HASH CHAIN, ENTERING SYMBOLS IN THE DICTIONARY
*** UNTIL ONE IS ENCOUNTERED WHOSE FORWARD LINK IS ZERO.
BLDDIC1  STW,I1   BLDDICI           SAVE BUCKET INDEX FOR A SEC,
         STW,I2   SYM               SAVE POINTER FOR FOLLOWING CHAIN.
         CALL     *ARGBD            AND PERFORM THE FUNCTION IN DIC.
         LW,I2    SYM               GET POINTER TO THIS,
         LW,I2    +1,I2             GET POINTER TO NEXT:
         STW,I2   SYM               SAVE FOR NEXT TIME THRU,
         BNEZ     *ARGBD            AND GO PERFORM SPECIFIED FUNCTION.
         SPACE
*** HIT END OF HASH CHAIN, TRY NEXT BUCKET:
         LW,I1    BLDDICI           GET THE INDEX,
         BDR,I1   BLDDIC0           AND TRY ANOTHER BUCKET.
         B        RETURN            EXIT.
         TITLE    'LEMUR2 -- LIB# -- HANDLES ''LIBRARY'''
         SPACE
*
* LIB#--
*        DOES WORK FOR LIBRARY COMMAND.
*        EXPECTS ONLY ONE ITEM IN SCAN TABLE; IT SHOULD BE
*          THE NAME OF THE LIBRARY.
*        SETS NAME OF LIBRARY, TRIES TO OPEN LIBRARY FOR UPDATE;
*        IF IT CANT, FLAMES OUT; IF THE LIBRARY MERELY DOESN'T
*        EXIST, THEN WE'RE OK.
*
         SPACE
LIB#     EQU,0    %
         LI,T2    F:LIB             SET THE DCB
         STW,T2   L:DCB
         LI,A1    D:DESTLIB         PUT LIB NAME IN DCB
         BAL,T3   SETNAME
         CALL     OPENLIB           SEE WHETHER WE CAN OPEN IT;
         B        DONE              ALL DONE.
*
*F***************************************
*F*
*F*  NAME:DELROM
*F*      DELETES THE DESTINATION MODULE FROM THE DESTINATION
*F*        LIBRARY.
DELMOD   SUBROUTINE
         CALL     DPOINTERS
         CALL     DPOINTERS         DELETE DIC ENTRIES WHICH POINT
         LI,RTN   DELMOD1           TO DEST. MOD.
         MTW,0    MODTYP            IS U A LMN OR A ROM?
         BEZ      DLMN              DELETE THE LEMON.
         B        DROMS             DELETE THE ROM MODULE.
DELMOD1  CALL     DEMPTY            DELETE FILE IF NO REC. LEFT.
         B        RETURN
         TITLE    'LEMUR2 -- ADDLMN --BUILDS A LMN'
         PAGE
         SPACE
*F***************************************************************
*F*
*F* NAME:  FINDTOKEN
*F*       LOOKS FOR A DESCRIPTOR IN DSCPOOL OF THE TYPE
*F*       PRESENTED IN R0. EXIT TO RTN IF NOT FOUND.
*F*                        EXIT TO RTN+1 IF FOUND. T1 HAS
*F*                        INDEX TO THE FOUND DESCRIPTOR.
FINDTOKEN  EQU    %
         LI,T3    0
GETNEXT  EQU      %
         INT,T0   SCTBL,T3          SPLIT TOKEN AND INDEX INTO T0,T1.
         CW,R0    T0                IS THIS THE TYPE WE WANT?
         BNE      %+3
         MTW,1    RTN
         B        *RTN              YES, RETURN
         MTW,1    T3                NO, ARE THERE MORE TO LOOK AT?
         BLZ      GETNEXT           YES, GO LOOK.
         B        *RTN              NO, ITEM NOT FOUND.
         PAGE
*F*********************************************************************
*F*
*F* NAME:  ADDLMN
*F*      BUILDS LOCCT, ROM AND TREE TABLES IN COMMON
*F*      AND M:LINKS TO THE LOADER TO FORM LIBRARY
*F*      LOAD MODULE.
*F*********************************************************************
ADDLMN   EQU      %
*                                   DELETE MODULE IF IT EXISTS.
         LC       ADDREP
         BNE      ADDLMN1           B IF IT DOESN'T EXIST.
         CALL     DELMOD            DELETE MODULE
ADDLMN1  EQU      %
*                                   CLOSE THE LIBRARY
         LI,T2    F:LIB
         BAL,T3   CLSDCB
         LI,T2    F:SORS
         BAL,T3   CLSDCB
*                                   DEFINE DISPLACEMENTS IN THE LOCCT.
L:LOCWD  EQU      1
L:SYSID  EQU      2
L:TREEDISP EQU    3
L:ROMDISP EQU     4
L:REF    EQU      5
L:LMN    EQU      11
L:TREE   EQU      32
L:USERACN EQU     14
L:LMNPSW EQU      16
L:LIBNAME EQU     20
L:LIBPSW  EQU     23
L:RACN   EQU      25
TREEDISP EQU      L:TREE-L:LOCWD
*                 BUILD LOCCT AND TREE
ROMDISP  EQU      TREEDISP+11
*                                   BUILD LOCCT WORD.
         LW,R0    L:LOCWDDEF
         STW,R0   SCRATCH           SET DEFAULTS
         LI,I1    L:#OPS
SETLOCWD EQU      %
         LW,R1    L:OPS-1,I1
         LW,T3    *R1               WAS OPTION SPECIFIED?
         CW,T3    C%OPTS
         BAZ      INCOP             NO, BRANCH.
*                                   YES, EXTRACT OPTION AND SET IT
*                                   IN LOCWD.
         BAL,T3   EXTOPT
         LW,I2    L:SHIFTS-1,I1
         S,R0     0,I2
         LW,R1    L:MASKS-1,I1
         STS,R0   SCRATCH
INCOP    BDR,I1   SETLOCWD
*                                   GET COMMON PAGE AND BUILD LOCCT.
TREE     EQU      %
*        COMPUTE NUMBER OF FIDS IN THE MODULE.
         LI,R0    T%FID
         LI,T3    0
         STW,T3   L:NOROM
         STW,T3   I:ISNEXT          INITIALIZE THE SCAN INDEX.
TREE2    CALL     ISNEXT
         BCS,2    TREE4             END OF THE ROMS
         BCS,1    %-2               NOT A FID.
         MTW,1    L:NOROM           FOUND ONE. BUMP COUNT
         B        TREE2
*        COMPUTE NUMBER OF PAGES TO GET.
TREE4    EQU      %
         LW,R1    L:NOROM
         MI,R1    7                 NO. OF WORDS IN A ROM ENTRY.
         AI,R1    11                + NO OF WORDS IN THE TREE
         AI,R1    X'20'             + NO OF WORDS IN THE LOCCT
         AI,R1    X'1FF'            ROUNDOFF TO
         SLS,R1   -9                PAGES.
         STW,R1   L:PAGES
         CAL1,8   GCP
         STW,9    L:BASE            SAVE LOWEST ADDRESS.
         BCS,8    E(E#NOCORE)
         LW,I1    L:BASE            I1 IS BASE REGISTER FOR ALL THAT
*                                   FOLLOWIS IN LOCCT SET UP.
         LW,A1    SCRATCH
         STW,A1   L:LOCWD,I1
         INT,A1   J:JIT             GET SYSID
         STW,A1   L:SYSID,I1
         LI,A1    TREEDISP
         STW,A1   L:TREEDISP,I1
         LI,A1    ROMDISP
         STW,A1   L:ROMDISP,I1
         LCI      6                PRESET REFCOUNT,BIAS,#EX. ACCTS.
*                                   FCOM,ERSTACK,TSS,#READ ACCTS.
         LM,I2    L:REFDFLTS
         STM,I2   L:REF,I1
         LB,R0    D:DESTMOD
         CI,R0    11                IS MODULE NAME TOO BIG?
         BG       E(E#LNTL)         YES,ERROR.
         LCI      3
         LM,R0    BLANKS
         LI,A1    R0
         LW,A2    D:DESTMOD
         BAL,T3   MAKEKEY           GET IT IN TEXTC
         LCI      3
         STM,R0   L:LMN,I1          PUT IN LMN NAME
         STM,R0   L:TREE,I1         ...AND IN TREE
         LCI      2                 GET USER ACCOUNT.
         LM,R0    J:ACCN
         STM,R0   L:USERACN,I1
         LCI      4
         LM,I2    ZEROES
         STM,I2   L:LMNPSW,I1
*                                   MAKE TEXTC FORM OF DEST. LIB.
         LCI      3                 BLANK FILL LIBRARY NAME
         LM,R0    BLANKS
         LW,A2    D:DESTLIB         GET DESCRIPTOR OF LIB NAME.
         LI,A1    R0                RO IS DESTINATION
         BAL,T3   MAKEKEY
         LCI      3
         STM,R0   L:LIBNAME,I1
         LM,R0    ZEROES            SET PSW TO 0 DEFAULT
         STM,R0   L:LIBPSW,I1
         LI,T1    2
         LW,T2    D:DESTLIB,T1      GET DESCRIPTOR OF LIB PASSOWRD.
         BEZ      NOPSW             B IF NONE
         LB,T1    T2                CHECK THAT PSW IS NOT > 8 CHARS.
         CI,T1    8
         BL       %+2
         LI,T1    8                 FORCE 8 CHARS.
         LW,T3    L:BASE            SET PSW IN LOCCT IN TEXXT FORM.
         SLS,T3   2
         AI,T3    L:LIBPSW**2
         STB,T1   T3
         MBS,T2   0                 MOVE PSW INTO LOCCT
NOPSW    EQU      %
         LCI      7
         LM,I2    L:RDDFLTS         PRESET MORE STUFF IN LOCCT.
         STM,I2   L:RACN,I1
         LCI      4
         LM,A1    ZEROES            ZERO TREE
         STM,A1   L:TREE+3,I1
         STM,A1   L:TREE+7,I1
         PAGE
*******************************************************************
*
*        BUILD ROM TABLES BY LOOKING THROUGH SCAN TABLES FOR
*        ITEM OF TYPE T%FID.WHEN FOUND SEND ITS DESCRIPTOR TO
*        MAKEKEY TO GET ROM NAME IN TEXTC FORM.
*
         LI,R0    T%FID             ITEM WE ARE LOOKING FOR IN SCTBL.
         LI,T3    0                 INITIALIZE SCAN INDEX FOR ISNEXT.
         STW,T3   I:ISNEXT
         AI,I1    ROMDISP+1         PINT I1 TO BEGINNING OF ROM TABLES.
         STW,I1   L:ROMBASE
MOREROMS EQU      %
         LW,I1    L:ROMBASE
         LCI      4
         LM,R1    ZEROES            INITIALIZE THIS ENTRY.
         STM,R1   0,I1
         STM,R1   4,I1
         LI,R1    X'40'             SET 'NOT LAST' FLAG.
         STW,R1   2,I1
         CALL     ISNEXT            IS NEXT ITEM A FID?
         BCS,2    NOMORE            B IF NO MORE ITEMS IN SCTBL.
         BCS,1    %-2               NO, LOOK AT NEXT ONE.
         AI,A1    DSCPOOL           MAKE DESCRIPTOR @
         LB,A2    *A1               GET FID NAME LENGTH
         CI,A2    10
         BG       E(E#FNTL)
         LW,A2    *A1               GET ROM DESCRIPTOR.
         STW,A1   SCRATCH           SAVE @ OF DESCRIPTOR
         LW,A1    L:ROMBASE         A1 IS DESTINATION FOR MAKEKEY.
         BAL,T3   MAKEKEY
         MTW,3    L:ROMBASE         POINT TO ACCOUNT.
         LW,I2    SCRATCH           GET DESCRIPTOR ADDRESS.
         LW,I2    1,I2              WAS ACCOUNT SPECIFIED?
         BEZ      NOACCN            NO ACCOUNT SPECIFIED?
         LCI      2                 YES, GET AND STORE IN ROM TABLES.
         LM,T0    BLANKS
         STM,T0   *L:ROMBASE
         LW,I3    L:ROMBASE
         SLS,I3   2
         CALL     APPEND
         B        PSW
NOACCN   EQU      %                 SUPPLY USERS ACCOUNT IN THIS
         LCI      2                 CASE.
         LM,T0    J:ACCN
         STM,T0   *L:ROMBASE
PSW      EQU      %
         MTW,2    L:ROMBASE         POINT TO PASSOWRD.
         LW,I2    SCRATCH           GET DESCRIPTOR ADDRESS
         LW,I2    2,I2
         BEZ      ROMFIN            ALL DONE FOR THIS ROM IF NO PSW.
         LCI      2
         LM,T0    BLANKS
         STM,T0   *L:ROMBASE
         LW,I3    L:ROMBASE
         SLS,I3   2                 PUT USER SPECIFIED PASSOWRD
         CALL     APPEND            IN THE RIGHT WORDS OF THIS ENTRY.
ROMFIN   EQU      %
         MTW,2    L:ROMBASE         POINT TO NEXT ENTRY IN ROM TABLE.
         B        MOREROMS
*                                   NO MORE ROMS.
NOMORE   EQU      %
         LW,A1    -5,I1
         AND,A1   L(X'FFFFFF00')    MARK LAST ROM AS 'LAST ROM'
         STW,A1   -5,I1
         SW,I1    L:BASE            COMPUTE TOTAL LOCCT TREE +ROM.
         OR,I1    L(X'80000000')    TELL LOADER TO COME BACK HERE
         STW,I1   *L:BASE           ...AND SAVE.
*        CHECK IF WE ARE HERE BECAUSE ITS REALLY A ROM MODULE
*        WITH 'MAP' OPTION.
         MTW,0    L:MAPROM
         BEZ      LOADER            B/ NO THIS IS A REAL LMN
*        SET LOCWD FOR NOTCB,NOSYSLIB,BIAS=0,SL,F,TEMP
         LW,A1    L(X'A1F2302')
         LW,I1    L:BASE
         STW,A1   L:LOCWD,I1        SET LOCWD
         LCI      3
         LM,A0    BLANKS
         STM,A0   L:LMN,I1
         STM,A0   L:TREE,I1
         LW,A1    L:SYSID,I1        LMN= SYSIDL
         SLS,A1   8
         OR,A1    L(X'030000D3')
         STW,A1   L:LMN,I1
         STW,A1   L:TREE,I1
         LCI      4
         LM,A0    ZEROES            0 THE LIBRARY NAME
         STM,A0   L:LMN+5,I1
         STM,A0   L:LMN+9,I1
         STW,A0   L:LMN+10,I1
LOADER   EQU      %
*******************************************************************
*        M:LINK   'LOADER',':SYS'
         CAL1,8   LINKFPT
*        M:FCP    255
         CAL1,8   FCPFPT
         LW,R1    J:JIT             IF WE ARE ON-LINE GET NEXT
         BLZ      DONE              COMMAND EVEN IF ERROR DURING LOAD..
         MTW,0    A3                ERROR DURING LOAD?
         BEZ      DONE              NO, BRANCH TO NEXT COMMAND
         LW,R1    O%X               WAS X SPECIFIED?
         CW,R1    C%OPTS
         BAZ      DONE              NO, BRANCH TO NEXT COMMAND.
         B        WINDOWN           YES, EXIT.
         TITLE    'LEMUR2 -- DELETE --DELETES ROM OR LMN.'
         PAGE
DELETE#  EQU      %
         LI,T1    F:LIB             POINT TO F:LIB
         STW,T1   L:DCB
         CALL OPENLIB
         BNE      E(E#COL)
         LI,R0    T%MNAME           WAS THIS A COMMAND TO DELETE THE
         CALL     FINDTOKEN         WHOLE LIBRARY?
         B        DELLIB            YES IF NO MOD NAMES WERE PRESENT.
         LI,T3    -1                START AT FIRST ITEM IN
         STW,T3   I:ISNEXT          SCAN TABLE.
DEL#LOOP EQU      %
         LI,R0    T%MNAME           SET TO SCAN FOR MOD NAME.
         CALL     ISNEXT
         BCS,2    DONE              ALL SPECIFIED MODS DELETED. GO HOME.
         BCS,1    DEL#LOOP          B IF ITEM NOT A MOD NAME.
*                                   FOUND A MOD NAME. GO DELETE.
         AI,A1    DSCPOOL           MAKE @ OUT OF INDEX.
         LW,A2    *A1               GET DESCRIPTOR.
         STW,A2   D:DESTMOD         SAVE DESTINATION MODULE.
         CALL     FINDMOD           DOES IT EXIST?
         BNE      E(E#COF)
         CALL     DELMOD            DEST. MOD. EXISTS.  GO DELETE IT.
         B        DEL#LOOP          GO DO THE NEXT ONE IN THE LIST.
DELLIB   EQU      %                 CO CLOSE WITH REL.
         LI,T2    F:LIB
         CALL     CLOSEREL
         B        DONE
         PAGE
*D*****************************************************************
*D*  DOES WORK FOR THE CARRY COMMAND. THE DESTINATION MODULE
*D*  IS DELETED FROM THE DIESTINATION LIBRARY.  SYMBOLS FROM
*D*  THE SOURCE MODULE ARE DELETED FROM THE DESTINATION LIBRARY.
*D*  IF SOURCE MODULE NAME IS DIFFERENT FROM DESTINATION MODULE
*D*  NAME, THE KEYS ARE ALTERED TO BEGIN WITH DEST. MODULE NAME.
*D*  DICTIONARY ENTRIES ARE ALTERED TO POINT TO DESTINATION MODULE
*D*  NAME.
********************************************************************
         SPACE
CARRY#   EQU      %
         LI,T2    F:SORS
         STW,T2   L:DCB
         LI,A1    D:SORSLIB
         BAL,T3   SETNAME           PUT SOURCE LIB NAME IN DCB
         LW,A2    D:SORSMOD
         CALL     FINDMOD           DOES SOURCE MOD EXIST?
         BCS,3    E(E#COF)          NO. ERROR.
         LI,T2    F:SORS            CLOSE SOURCE LIB. SO THAT IT
         BAL,T3   CLSDCB            CAN BE READ SEQUENTIALLY FROM THE
*                                   BEGINNING.
         LI,T2    F:LIB
         STW,T2   L:DCB
         LI,A1    D:DESTLIB
         BAL,T3   SETNAME
         CALL     OPENLIB           IF DEST. LIB DOESN'T EXIST
*                                   DONT BOTHER DELETING.
         BE       %+3
         CALL     CRELIB
         B        DOCARRY           DONT BOTHER TO DELETE
*                                   SINCE THIS LIBRARY IS EMPTY.
         LI,I1    0
         LI,R1    O%DUPS
         BAL,T3   EXTOPT            ARE WE TO DELETE DUPLICATE SYMS?
         CI,R0    O#DSYM
         BE       %+2
         LI,I1    1                 SET FLAG =0 IF NO.
         STW,I1   FDSYMS
CARRY#1  EQU      %
         LI,T2    F:SORS
         STW,T2   L:DCB
         LI,T2    ROMBUF
         STW,T2   L:BUF
         LI,T2    ROMSIZE
         STW,T2   L:SIZE
         CALL READSEQ               READ SOURCE DICTIONARY
         BCS,3    E(E#NLIB)         UNEXPECTED EOF. NOT A LIB.
*                                   CHAECK FOR BLANK.
         LW,I2    A2
         LB,I2    0,I2
         CI,I2    X'40'
         BNE      CARRY#3           END OF DICTIONARY.
         STW,A2   D:KEY
         LW,T0    D:SORSMOD         SEE IF THIS SYMBOL BELONGS TO
         LI,A2    ROMBUF            THE SOURCE MODULE.
         BAL,RTN  KEYDESC
         LW,T1    A2
         BAL,T3   COMPARE
         BNE      CARRY#1           B/ NO GET NEXT.
         LW,A2    D:KEY             YES. RESTORE SYMBOL DESCRIPTOR.
*                                   DO WE DO A DELETE OR JUST A CHECK?
         MTW,0    FDSYMS
         BEZ      CARRY#2
         LI,I3    0
         STW,I3   L:SIZE
         LI,I3    F:LIB             JUST CHECK.  FIRST READ DEST.
         STW,I3   L:DCB             DICTIONARY.
         LW,I3    A2
         CALL     RDKEY
         BCS,3    CARRY#1
         B        E(E#IDS)
CARRY#2  EQU      %                 DELETE THE SYMBOL
         LI,A1    OKEYBUF
         BAL,T3   MAKEKEY
         CALL     DELKEY
         B        CARRY#1           GO GET NEXT SYMBOL.
*                                   IF DESTINATION MODULE DOESNT
*                                   EXIST, DONT BOTHER DELETING IT.
CARRY#3  EQU      %                 DICTIONARY IS FINISHED. NOW
*                                   DELETE OR CHECK MODULE RECORDS.
         LI,A2    F:LIB
         STW,A2   L:DCB
         LW,A2    D:DESTMOD
         CALL     FINDMOD
         BCS,3    DOCARRY
*                                   ARE WE TO DELETE DUPLICATE
*                                   MODULES
         LI,R1    O%DUPM
         BAL,T3   EXTOPT
         CI,R0    O#DMOD
         BNE      E(E#MAE)          NO. MODULE ALREADY EXISTS. ERROR.
*                                   DELETE THE MODULE RECORDS.
         CALL     DELMOD
         PAGE
*
*        CARRY THE DICTIONARY.  AN ENTRY IS CARRIED FROM THE
*        SOURCE DICTIONARY IFF IT POINTS TO SOURCE MODULE.
**       IF SOURCE MODULE NAME IS DIFFERENT FROM DESTINATION
*        NAME, THE NEW ENTRY CONTAINS DESTINATION MODULE NAME.
*
DOCARRY  EQU      %
         LI,T2    F:SORS
         STW,T2   L:DCB
         BAL,T3   CLSDCB            CLOSE SO WE CAN READ SEQUENTIALLY
         LI,T2    ROMBUF
         STW,T2   L:BUF
         LI,T2    ROMSIZE
         STW,T2   L:SIZE
CARDIC1  EQU      %
         CALL     READSEQ
         BCS,3    E(E#NLIB)
         LW,I2    A2                A2 HAS KEY DESCRIPTOR.
         LB,I2    0,I2
         CI,I2    X'40'             SEE IF FIRST BYTE IS A BLANK.
         BNE      DICEND            IF NOT, WE'VE REACHED END.
         STW,A2   D:KEY
         LW,T0    D:SORSMOD
         LI,A2    ROMBUF
         BAL,RTN  KEYDESC
         LW,T1    A2
         BAL,T3   COMPARE           IS IT OUR MODULE?
         BNE      CARDIC1           B/ NO GET NEXT.
         LW,A2    D:KEY
         LI,A1    OKEYBUF
         BAL,T3   MAKEKEY
         LCI      3
         LM,I2    BLANKS
         STM,I2   MODNAME
         LW,I2    D:DESTMOD
         LI,I3    BA(MODNAME)+1
         CALL     APPEND
         LB,I3    I3
         STB,I3   MODNAME           PUT MODULE NAME INTO BUFFER.
         BAL,RTN  DICENT1           WRITE ENTRY. (DONT BUILD A NEW KEY).
         B        CARDIC1           GET NEXT.
DICEND   EQU      %
*
*        NOW CARRY THE MODULE RECORDS.
*
         MTW,0    MODTYP
         BEZ      ITSALMN
*        ITS A ROM.  CARRY IT TO DEST LIB..
*
         LI,I3    BA(IKEYBUF)       INITIALIZE KEYS FOR READING
         LW,A2    D:SORSMOD         AND WRITING SOURCE ROM.
         CALL     RSTCPY
         LI,I3    BA(OKEYBUF)
         LW,A2    D:DESTMOD
         CALL     RSTCPY
         LI,I3    0
         STW,I3   ROMSRC            TELL READROM ITS COMING FROM A LIB.
         CALL     CPYROM
         B        DONE
ITSALMN  CALL     CARLMN
         B        DONE
         PAGE
COPY#    EQU      %
         LI,T2    F:SORS
         STW,T2   L:DCB
         LI,A1    D:SORSLIB         PUT SOURCE LIB NAME IN DCB.
         BAL,T3   SETNAME
         CALL     OPENLIB
         BNE      E(E#COL)          SOURCE LIB DOESN'T EXIST.
         LI,T2    F:LIB
         STW,T2   L:DCB             SEE IF DESTINATION LIB EXISTS.
         CALL     OPENLIB
         BCS,3    COPY#2            B/ IT DOESN'T EXIST.
         LI,R1    O%DUPM
         BAL,T3   EXTOPT            ARE WE TO DELETE?
         CI,R0    O#DMOD
         BNE      E(E#MAE)          NO. ERROR. THE LIB ALREADY EXISTS.
         LI,T2    F:LIB
         CALL     CLOSEREL
COPY#2   EQU      %
         CALL     COPY
         B        DONE
         TITLE    'LEMUR2 -- SUMMARIES'
         END

