*        704731   SIGMA 5/7         BPM M:WRITESEG
***********************************************************************
*M*      WRT      WRITES OUT THE LOAD MODULE.
***********************************************************************
*P*      NAME:    WRT
*P*      PURPOSE: ENTRY/EXIT FROM PS2.
*P*               CREATES TCB AND DCBS,AND THE DCB NAME TABLE.
*P*               CONCATENATES THE PAGES OF THE EXTENDED MEMORY MODE
*P*                    FILE FOR A STANDARD LOAD MODULE.
*P*               CLEANS UP THE PAGED CORE IMAGE RECORDS FOR A PAGED
*P*                    LOAD MODULE.
*P*               WRITES THE LOAD MODULE TO THE FILE.
*P*      DESCRIPTION: WRT IS ENTERED AT WRITESEG FROM PS2. IF THIS IS A
*P*               LIBRARY LOAD MODULE,IT UPDATES THE LIB. DICTIONARY,
*P*               MAKES A COPY OF THE REF/DEF STACK FOR MAPPING
*P*               PURPOSES,AND ELIMINATES FORWARD REFERENCES FROM THE
*P*               JUST COPIED STACK. THE SEGMENT'S STACKS ARE WRITTEN
*P*               AS ARE THE SEGMENT'S CORE IMAGES AND RELOCATION
*P*               DICTIONARIES. ONCE THE ROOT HAS BEEN PROCESSED,THE
*P*               DCB NAME TABLE IS BUILT,AS WELL AS THE DCBS AND TCB.
*P*               THE HEAD AND TREE RECORDS ARE CONSTRUCTED AND WRITTEN
*P*               TO TE LOAD MODULE FILE.
*P*      REFERENCE: THE OVERLAY LOADER TECHNICAL MANUAL.
***********************************************************************
         SYSTEM   SIG7FDP
MODE     EQU      1
CFU      EQU      1
BPMLIB   EQU      0                 1=BUILD BPM LIB UNDER CP-V
*BPMLIB=1 MUST BE USED ONLY WITH MODE=1 AND THEN JUST TO
*FORM A LOADER TO USE IN BUILDING BPM LIBRARIES UNDER CP-V.
         DO       MODE=1
SD       EQU      1
         ELSE
SD       EQU      0
         FIN
         DO       MODE=0
NAMELIST EQU      1
         ELSE
NAMELIST  EQU     0
         FIN
         CSECT    1
         DEF      MCWT
MCWT     EQU      %
         REF      M2
         REF      M4
         REF      M8
         REF      M15
         REF      M16
         REF      M17
         REF      MN1
         REF      MN8
         REF      MN9
         REF      MN16
         REF      MSKFTYPE
         REF      Y2
         REF      Y4
         REF      Y8
         REF      Y02
         REF      Y08
         REF      Y008
         REF      Y00FFFF
         REF      Y0003
         REF      Y0007
         REF      Y0008
         REF      Y000B
         REF      Y00FF
         REF      TXF:
         REF      TXM:
         REF      TXLIB
         REF      TXHEAD
         REF      HEADWD
         REF      TXTREE
         REF      Y003
         REF      LHEADWD
         DEF      WRITESEG
         REF      DECLBAS
         REF      EXPRSTK
         REF      EXPRBAS
         REF      BSEG1
         REF      BSEG2
         REF      CSEG1
         REF      CRFDF1
         REF      CRFDF2
         REF      SEVLEV
         REF      BUF
         REF      BUF2
         REF      TEMPPTR
         REF      TREEPTR
         REF      FCOUNT
         REF      ERRSTK
         REF      ERRTAB
         REF      TCBSIZE
         REF      TCBPTR
         REF      FTAB
         REF      RSEG00
         REF      RSEG01
         REF      RSEG10
         REF      RREL00
         REF      RREL01
         REF      RREL10
         REF      CREL00
         REF      START
         REF      LOCCT
         REF      MBIAS
         REF      FBIAS
         REF      NOTLLM
         REF      MAXRFDF
         REF      TOPOMEM
         REF      LOCWD
         REF      XMKEY
         DO       MODE=0
         REF      XMRKEY
         REF      KBDIC
         REF      SNM:LM
         FIN
         REF      EXPRDIS
         REF      RFDFDIS
         REF      TMPSZDIS
         REF      00DIS
         REF      01DIS
         REF      10DIS
         REF      BIASDIS
         REF      TCBBLNK
         REF      LOADBAS
         REF      ER10X             M:LM ERROR EXIT
         REF      NXTAVPG
         REF      ER12
         REF      READLM
         REF      WRITELM
         REF      M:LM
         REF      CLOSE
         REF      PBUF
         DO       MODE=1
         REF      CORELIB
         REF      Y03
         REF      SPDBASE
         DO       CFU=1
         REF      TXM:STAR
         FIN
         FIN
         DO       SD=1
         REF      GSYMSIZ           GLOBAL SYMBOL TABLE SIZE
         REF      SYMTOP            END OF LARGEST INT SYM TAB
         REF      TEMPR1            SCRATCH STORAGE
         FIN
        REF      CODE
         REF      TXBLNK
         PAGE
BGEZ     EQU      X'681'
BE       EQU      X'683'
BNEZ     EQU      X'693'
BGE      EQU      X'681'
BL       EQU      X'691'
BAZ      EQU      X'684'
BCR8     EQU      X'688'
BCR10    EQU      X'68A'
BLE      EQU      X'682'
BEZ      EQU      X'683'
BG       EQU      X'692'
BNE      EQU      X'693'
         REF      MESSAGE
         REF      IOMSG
*       QUIT     ERROR, CONDITION,OUTPUT
QUIT     CNAME
         PROC
LF       EQU      %
         DO       NUM(AF)=3
         DO       AF(2)~=0
         GEN,12,20 AF(2),%+4
         FIN
         STW,AF(3) CODE
         ELSE
         DO       AF(2)~=0
         GEN,12,20 AF(2),%+3
         FIN
         FIN
         LI,R3    AF(1)
         DO       MODE=1&AF(3)=SR3
         B        IOMSG
         ELSE
         B        MESSAGE
         FIN
         PEND
*        SNAP     FROM,TO,TEXT1,TEXT2
SNAP     CNAME
         PROC
LF       CAL1,3   %+1
         DATA     0,AF(1),AF(2),AF(3),AF(4),X'02000000'
         PEND
         PAGE
*                 SYMBOLIC REGISTER DEFINITIONS.
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         PAGE
*                 IMMEDIATE CONSTANTS FOR LOADER.
K0       EQU      0
K1       EQU      1
K2       EQU      2
K3       EQU      3
K4       EQU      4
K5       EQU      5
K6       EQU      6
K7       EQU      7
K8       EQU      8
K9       EQU      9
KA       EQU      X'A'
KB       EQU      X'B'
KC       EQU      X'C'
KD       EQU      X'D'
KE       EQU      X'E'
KF       EQU      X'F'
K10      EQU      X'10'
K11      EQU      X'11'
K12      EQU      X'12'
K13      EQU      X'13'
K14      EQU      X'14'
K16      EQU      X'16'
K17      EQU      X'17'
K18      EQU      X'18'
K19      EQU      X'19'
K1C      EQU      X'1C'
K1E      EQU      X'1E'
K1F      EQU      X'1F'
K20      EQU      X'20'
K22      EQU         X'22'
K24      EQU      X'24'
K26      EQU      X'26'
K28      EQU      X'28'
K29      EQU      X'29'
K2B      EQU      X'2B'
K39      EQU      X'39'
K3C      EQU      X'3C'
K3F      EQU      X'3F'
K40      EQU      X'40'
K43      EQU      X'43'
K6C      EQU      X'6C'
K78      EQU      X'78'
K80      EQU      X'80'
KF0      EQU      X'F0'
KF1      EQU      X'F1'
KF2      EQU      X'F2'
KFF      EQU      X'FF'
K100     EQU      X'100'
K120     EQU      X'120'
K1FF     EQU      X'1FF'
K200     EQU      X'200'
K202     EQU      X'202'
K256     EQU      X'256'
K300     EQU      X'300'
K800     EQU      X'800'
KC00     EQU      X'C00'
K2000    EQU      X'2000'
K3FFF    EQU      X'3FFF'
K4000    EQU      X'4000'
K7FFF    EQU      X'7FFF'
KFFF00   EQU      X'FFF00'
K8000    EQU      X'8000'
K1FF00   EQU      X'1FF00'                                              731
K1FFFF   EQU      X'1FFFF'
K20000   EQU      X'20000'
KN1      EQU      -1
KN2      EQU      -2
KN3      EQU      -3
KN4      EQU      -4
KN8      EQU      -8
KN16     EQU      -16
KN30     EQU      -30
KN40     EQU      -X'40'
KN100    EQU      -100
KN200    EQU      -X'200'
KTE      EQU      'E'
KTR      EQU      'R'
K15      EQU      X'15'
K44      EQU      X'44'
FLPDISP  EQU      6
KBUFDISP EQU      X'A'
ENDRFDF  EQU      TEMPR1
         PAGE
*                 SCRATCH AREA FOR SAVEROOT AND FIXROOT ROUTINES
:FCOUNTN   EQU    BUF
:RDFCOUNTN EQU    BUF+1
:ALLN      EQU    BUF+2
:TREEN     EQU    BUF+3
:SR3       EQU    BUF+4
:R2      EQU      BUF+5
:FCOUNTX   EQU    BUF+6
:SAVEKEY EQU      BUF+7
*                                   SCRATCH AREA FOR SUPMEM ROUTINE
         DO       MODE=1
LOKEY00  EQU      BUF+8
LOKEY01  EQU      BUF+9
LOKEY10  EQU      BUF+10
HIKEY00  EQU      BUF+11
HIKEY01  EQU      BUF+12
HIKEY10  EQU      BUF+13
         FIN
         DO       MODE=0
:SEGLDCB EQU      BUF+14
         FIN
         PAGE
*                                   THIS ROUTINE WRITES THE SEGMENT
*                                   OUT TO THE LOAD MODULE FILE. IF
*                                   THIS IS THE ROOT, THE REQUIRED
*                                   TABLES ARE BUILT AND INSERTED.
WRITESEG PSW,SR4  *R0
         LCI      2
         PSM,R2   *R0
*                                   SQUOZE AND CHAIN LIBRARY REF/DEFS.
*                                   RUN CHECKS TO SEE IF THIS IS
*                                   POTENTIALLY A LIBRARY LOAD MODULE.
         LW,R5    -1,R1
         SW,R5    R1
         CI,R5    KC
         BG       NOTLIB
         LW,R5    LOCWD
         CI,R5    K100
         BANZ     NOTLIB
         LI,R7    K0
         SLS,R1   1
         LH,R6    00DIS,R1
         BEZ      %+2
         AI,R7    K1
         LH,R6    01DIS,R1
         BEZ      %+2
         AI,R7    K1
         LH,R6    10DIS,R1
         BEZ      %+2
         AI,R7    K1
         SLS,R1   -1
         CI,R7    K1
         BG       NOTLIB
         B        %+2
NOTLIB   STW,R1   NOTLLM
         LW,D4    LOCWD
         CI,D4    K10
*                                   GO WRITE DICTIONARY ETC FOR LIBRARY.
         BANZ     WRITELIB
WSEGL    EQU      %
*                                   WRITE OUT THE REF/DEF AND EXPL.
*                                   STACKS
         DO       MODE=0
         LI,SR3   0                                                     731
         FIN
         LW,D4    LOCWD
         LW,D2    CSEG1
         AW,D2    R1
         AI,D2    RFDFDIS
         LI,R4    K0
         LW,R7    CSEG1
         AW,R7    R1
         MTB,1    *R7
WTREFEXP LH,R6    *D2
         SLS,R6   2
         INT,R5   *D2
         SLS,R5   1
         LB,R2    *R7
         STB,R4   *R7,R2
         CAL1,1   WRITELM
         CI,R4    1                 ARE WE DONE
         BE       XMW4              YES
         CW,D4    Y04
         BAZ      GSTX
         CI,D4    X'10'             NOT  IF LIBRARY
         BANZ     GSTX
         MTW,0    CSEG1             ONLY FOR THE ROOT
         BNEZ     GSTX
         PSW,R6   *R0               SAVE RFDF SIZE FOR REREAD
         LCI      5                 AND OTHER REGS
         PSM,R1   *R0
         SLS,R6   -2
         AW,R6    R5                CALCULATE END OF RFDF
         STW,R6   ENDRFDF
         LW,R3    YC                FLAG BITS FOR STS
         LW,R6    R5                R6=CURRENT GST POINTER
GST1     LB,D1    *R5               R5=CURRENT RFDF POINTER
         BEZ      GSTE              LOST A COUNT BYTE SOMEHOW
         LI,R4    X'7FFFC'
         AND,R4   0,R5              CHECK TYPE
         BEZ      %+4               UNDISPLACED DEF..USE IT
         SLS,R4   -16
         CI,R4    3
         BNE      GST2              NOT DSECT, LEAV IT OUT
         LW,SR1   1,R5
         LI,R2    -4                CHECK RESOLUTION
         LW,R1    2,R5
         BEZ      GST3              ABS
         LB,R4    R1                GET NON-ZERO BYTE
         SLS,R1   8
         BNEZ     %+2
         BIR,R2   %-3
         AI,R1    0
         BNEZ     GST3              MIXED, SET ABS
         CI,R4    1
         BE       %+3               1 OK
         CI,R4    X'FF'
         BNE      GST3              NOT GOOD CODE
         SLS,SR1  2,2               ADJUST VALUE
         OR,SR1   Y02               SET WORD RESOL. TYPE
         LW,R2    Y4                SET,ADDRESS
         B        GST3+1
Y04      DATA     X'4000000'
YC       DATA     X'C0000000'
GSTE     LI,R6    0                 ERROR IN STACK, GIVE UP
         B        GST5
GST3     LW,R2    Y8                SET ABS VALUE
         STW,SR1  2,R6              SAVE VALUE IN GST
         LW,SR1   3,R5              GET TEXT
         LW,SR2   4,R5              (FIRST TWO WORDS)
         LB,R1    SR1
         AI,R1    -7                ZERO PAD
         BGEZ     %+3
         STB,R3   SR1+2,R1          IF NECESSARY
         BIR,R1   %-1
         STS,R2   SR1               SET CODE
         STW,SR1  0,R6              PUT IN TABLE
         STW,SR2  1,R6
         AI,R6    3                 TO NEXT ENTRY
GST2     AW,R5    D1                DITTO
         CW,R5    ENDRFDF
         BL       GST1
GST5     LCI      5                 NOW WRITE WHAT WEVE GOT
         PLM,R1   *R0
         SW,R6    R5                GET SIZE
         BLEZ     GST4              NOTHING
         LI,D1    9                 SET KEY
         STB,D1   *R7,R2
         STW,R6   GSYMSIZ           SAVE SIZE FOR HEAD BUILDING
         SLS,R6   2
         CAL1,1   WRITELM
         STB,R4   *R7,R2
GST4     PLW,R6   *R0               RESTORE RFDF SIZE FOR READ
         CAL1,1   READLM
GSTX     AI,R4    1                 TO EXPR STK
         AI,D2    K2
         B        WTREFEXP
XMW4     RES
         MTB,-1   *R7
         CI,D4    K10
         BANZ     TREE3
         CAL1,1   DELXREC           NO EXPR STK REC FOR NONLIBS
         LI,R4    0                 CLEAR SIZE IN TREE
         STH,R4   *D2               FOR SYMCON'S BENEFIT
         DO       MODE=1
         CI,D4    X'4000'
         BANZ     SUPMEM            B IF EXTENDED MEMORY MODE IS SET
         FIN
         LW,D2    CSEG1
         BEZ      BALSVRT
         LI,D1    CREL00
         B        WSEG1+1
DELXREC  GEN,8,24 13,M:LM
         PZE      *0
         PZE      *M:LM+10
*                                   IF ROOT SEGMENT BUILT TABLES REQ.
*                                   THE REF/DEF STACK, THEN GO TO
*                                   EXTENDED MEMORY TO PUT THE SEGMENTS
*                                   TOGETHER IF NECESSARY.
BALSVRT  EQU      %
         BAL,SR4  SAVEROOT
         DO       MODE=0
         BAL,SR4  XMEM
         ELSE
         BAL,SR4  FIXROOT
         FIN
         B        WSEG1
*                                   WRITE OUT CORE IMAGES AND RELOCATION
*                                   DICTIONARIES.
WSEG1A   LW,D2    R7
         AW,R7    R1
WSEG1    LI,D1    RREL00
         LI,R4    2
         AI,D2    00DIS
WRTSECT  LW,R5    *D1
         SLS,R5   -2
         LW,R6    *D2,R1
         LH,R6    R6
         CI,R6    K0
         BE       NEXTSECT
         MTB,1    *R7
         LB,R2    *R7
         STB,R4   *R7,R2
         CI,D4    K100
         BANZ     %+2
         BAL,SR4  WRTLMN
         AI,R4    K1
         STB,R4   *R7,R2
         SLS,R6   3
         AI,D1    KN3
         LW,R5    *D1
         SLS,R5   -2
         BAL,SR4  WRTLMN
         MTB,-1   *R7
         B        %+3
NEXTSECT AI,R4    K1
         AI,D1    KN3
         CI,R4    K7
         BE       WSEG1EXT
         AI,R4    K1
         AI,D2    K2
         AI,D1    K4
         B        WRTSECT
WRTLMN   LW,SR2   LOCWD
         CI,SR2   K4000
         BAZ      %+3
         LW,SR2   CSEG1
         BNEZ     *SR4
         DO       MODE=1
         REF      CHKLM
         PSW,11   *R0
         BAL,11   CHKLM
         PLW,11   *R0
         FIN
         CAL1,1   WRITELM
         B        *SR4
WSEG1EXT EQU      %
         LW,D4    LOCWD
         CI,D4    K10
         BANZ     LIBCPY            IF LIB LMN MUST WRITE OUT STKS
TREE     LW,SR2   CSEG1
         BNEZ     ENDWRT1                                               731
         DO       MODE=0
         INT,SR2  XMKEY
         AND,SR2  MN8
         BNEZ     *SR3
         FIN
*                                   WRITE TREE OUT.
TREE3    EQU      %                                                     731
         LW,R5    R1
         AI,R5    KN1
         LW,R6    *R5
         SLS,R6   2
         LW,D4    LOCWD
         CI,D4    K10
         BAZ      TREE1
         LI,D1    TXTREE
         BAL,SR4  LIBKEYS
         B        TREE2
TREE1    LI,R7    TXTREE
TREE2    CAL1,1   WRITELM
*                                   BUILD AND WRITE THE HEADER.
         DO       MODE=1
HEAD     LW,R4    LOCWD             CHOOSE CORRECT TYPE
         CI,R4    X'4000'
         BAZ      %+3
         LW,R4    HEAD85            XMEM--TYPE = X'85'
         B        HEAD3
         LW,R4    HEADWD            STANDARD TYPE--X'80'
         ELSE
HEAD     LW,R4    HEADWD
         FIN
*                                   CHOOSE CORRECT TYPE BYTE.
         MTW,0    NOTLLM
         BNEZ     HEAD3
         LW,R4    LOCWD
         CI,R4    X'10'
         BAZ      %+3
         LW,R4    HEAD82
         B        %+2
         LW,R4    LHEADWD
HEAD3    EQU      %
         DO       MODE+BPMLIB=1
         AI,R4    X'18'             FOR CP-V, HEAD SIZE = 30 BYTES
         FIN
         STW,R4   BUF
*                                   SEVERITY LEVEL.
         LW,R6    SEVLEV
         SLS,R6   24
*                                   START ADDRESS.
         AW,R6    START
         LW,R5    LOCWD
         CI,R5    K100
*                                   ABS BIT.
         BAZ      %+3
         LW,R7    Y8
         STS,R7   R6
*                                   NO TCB BIT.
         CI,R5    K2000
         BAZ      %+3
         LW,R7    Y4
         STS,R7   R6
         LW,R4    LOCCT
         LW,R7    1,R4
         AND,R7   YF                GET PRIVILEGED PROCESSOR FLAGS
         SLS,R7   -8                ALIGN TO POSITION IN HEAD RECORD
         OR,R6    R7                AND 'OR'  'EM INTO WORD 1
         STW,R6   BUF+1
*                                   TCB ADDRESS.
         LW,R5    TCBPTR
         SLS,R5   15
         AND,R5   MN16
*                                   BIAS.
*E*      ERROR:   0200-1D
*E*      MESSAGE: NO ROOM TO BUILD DCB
*E*      DESCRIPTION: THE LOADER EXHAUSTED AVAILABLE MEMORY WHILE
*E*               TRYING TO BUILD THE DCBS.
*E*      REGISTERS: R7 HOLDS THE SIZE OF THE DCB NAME TABLE
         LW,R6    BIASDIS,R4
         SLS,R6   -1
         AW,R5    R6
         STW,R5   BUF+2
*                                   PROTECTION TYPE BASES.
         DO       MODE=0[BPMLIB=1
         LI,R5    1
         FIN
         DO       MODE=0[BPMLIB=1
         INT,R6   00DIS,R1
         STH,R7   R6
         INT,R7   01DIS,R1
         STH,R7   R6,R5
         ELSE
         LW,R6    00DIS,R1
         LW,R5    10DIS,R1
         SW,R5    R6
         STH,R5   R6
         FIN
         STW,R6   BUF+3
         DO       MODE=0[BPMLIB=1
         INT,R6   10DIS,R1
         STH,R7   R6
         LI,R4    1
         LW,R5    NXTAVPG
         SLS,R5   -1
         STH,R5   R6,R4
         STW,R6   BUF+4
         ELSE
         LW,R6    01DIS,R1
         LW,R5    NXTAVPG
         SLS,R5   -1
         SW,R5    R6
         STH,R5   R6
         STW,R6   BUF+4
         FIN
*                                   MAX REF/DEF AND TREE SIZE.
         LW,R6    -1,R1
         LW,R5    MAXRFDF
         SLS,R5   16
         AW,R6    R5
         STW,R6   BUF+5
         DO       MODE=0[BPMLIB=1
         LI,R6    K18
         LI,R5    BUF
         ELSE
         LW,R6    10DIS,R1
         STW,R6   BUF+6
         LI,6     8
         LI,7     0
         LI,R5    BUF+6
         STW,R7   *R5,R6
         BDR,R6   %-1
*                 IF A CORE LIBRARY IS TO BE FETCHED,
*                 SIGNAL ITS NAME IN THE HEAD.
         LW,R3    CORELIB
         BLEZ     NOCORELIB
         AND,R3   M8
         OR,R3    TX04:P
         STW,R3   BUF+9
         AND,R3   M8
         LW,R6    TXBLNK
         STW,R6   BUF+11
         STB,R3   R6
         STW,R6   BUF+10
         B        NOCORELIB2
NOCORELIB  EQU     %
         LW,R5    LOCWD             IF CORELIB OPTION SPECIFIED,
         CW,R5    Y2                  SET BIT 0 OF WD 9 IN HEAD
         BAZ      %+3                 FOR STEP
         LW,R5    Y8
         STW,R5   BUF+9
NOCORELIB2        EQU               %
         DO       SD+BPMLIB=1
* NOTE: CP-V ONLY NO ROOM IN BPM HEAD FOR THESE WORDS
         LW,R5    SYMTOP
         SW,R5    BSEG2             SIZE OF LARGEST IST
         LI,R6    SPDBASE           BASE OF LARGEST IST
         SW,R6    R5                BASE OF LARGEST IST
         STW,R6   BUF+8
         SLS,R5   17
         STS,R5   BUF+8             SIZE,LOC LAREST IST
         LW,R5    LOCWD
         CW,R5    Y04               BUILD GLOBAL SYMBOL TABLE
         BAZ      NOGST             NOPE, NONE WAS BUILT
         LW,R5    GSYMSIZ           GET GLOBAL SIZE
         BEZ      NOGST
         SW,R6    R5                COMPUTE START OF GST (BELOW IST)
         SLS,R5   17
         OR,R6    R5
         STW,R6   BUF+7             SIZE,LOC OF GST
NOGST    EQU      %
         FIN
         LI,R6     X'30'
         LI,R5    BUF
         FIN
         CI,D4    K10
         BAZ      HEAD1
         LI,D1    TXHEAD
         BAL,SR4  LIBKEYS
         B        HEAD2
HEAD1    LI,R7    TXHEAD
HEAD2    CAL1,1   WRITELM
         DO       MODE=0
ENDWRT   EQU      %                                                     731
         CI,SR3   0                                                     731
         BNEZ     *SR3                                                  731
         FIN
*                                   EXIT WRT.
ENDWRT1  LCI      2
         PLM,R2   *R0
         PLW,SR4  *R0
         B        *SR4
HEAD82   DATA     X'8200FF18'
         DO       MODE=1
HEAD85   DATA     X'8500FF18'
TX04:P   DATA     X'047AD700'
         FIN
         PAGE
SAVEROOT EQU      %
         LW,R5    LOCWD
         CI,R5    K10
         BANZ     *SR4
         PSW,SR4  *R0
         PSW,R2   *R0
         LCI      KC
         PSM,R4   *R0
*                                   SIZE TESTS.
         LW,R7    -1,R1
         SW,R7    R1
         AI,R7    1
         STW,R7   :TREEN            TREE SIZE
         LW,R7    LOADBAS           IF BIAS ZERO, NO THING
         BEZ      %+2
         LW,R7    FCOUNT
         STW,R7   :ALLN
         STW,R7   :FCOUNTN
         BEZ      XSAVROOT
         AI,R7    2
         STW,R7   :FCOUNTN          DCB TABLE SIZE
         SLS,R7   -3
         AI,R7    1
         CI,R5    K100
         BAZ      :NOTABS
         LI,R7    0
:NOTABS  STW,R7   :RDFCOUNTN        DCB TABLE'S REL DIC SIZE (WORDS)
         AW,R7    :FCOUNTN
         STW,R7   :ALLN             SIZE DCBTABLE AND ITS RELDIC (IF ANY)
TSTEXPSZ EQU      %
         LW,R6    EXPRSTK+1         2ND WORD OF EXPR POINTER
         LH,R5    R6
         AND,R5   M15
         AND,R6   M15
         AW,R6    R5                R6=EXPRSTK SIZ
         CW,R6    :ALLN
        QUIT     X'1D',BG,R7
         DO       MODE=0
         LW,R4    LOCWD
         CI,R4    K4000
         BAZ      SIZESOK           NOT EMEM - RFDF SPACE OK
         CI,R4    K100
         BAZ      %+3               NOT ABS
         LW,R6    RSEG00            FOR ABS
         B        %+2
         LW,R6    RREL00            FOR REL
         SLS,R6   -2
         AND,R6   MN9               MAKE PAGE ADR
         LW,R5    DECLBAS
*                                   THIS ROUTINE BUILDS THE DCB TABLE AN
*                                   SEGLOAD DCB IF NECESSARY AND THEIR
*                                   RELOCATION DICTIONARIES IF NECESSARY
*                                   ABOVE THE REF/DEF STACK AFTER
*                                   CHECKING TO INSURE SUFFICIENT ROOM.
*                                   IT THEN MOVES THESE TABLES DOWN TO
*                                   THE DECLARATION STACK.
         AW,R5    :ALLN
         CW,R5    R6
         BL       SIZESOK
         LW,R5    :ALLN
        QUIT     X'1D',,R5
         FIN
*                                   SIZE IS OK. BUILD DCB TABLE AND
*                                   REL. DICT.
SIZESOK  EQU      %
         LW,SR3   EXPRBAS
         AW,SR3   :FCOUNTN          SR3 NOW POINTS TO RD
         LW,R2    :RDFCOUNTN
         BEZ      GPNORD
*                                   CLEAR DCBTAB REL DIC AREA
         AI,SR3   KN1
         LI,R5    0
         STW,R5   *SR3,R2           CLEAR RD
         BDR,R2   %-1
         AI,SR3   K1
GPNORD   EQU      %
         LI,R2    0
BLDDCBTB EQU      %
         LW,R7    EXPRBAS
         AI,R7    K1                FIRST LOCATION TO BUILD
         LI,D1    K2
         BAL,SR4  PUTDIG
         LW,R4    CSEG1
         LW,D2    Y00FFFF
         BAL,SR4  ESTRFDF3
         LW,R4    CRFDF1
DCB1     AI,R4    K3
         LW,D1    *R4
         CS,D1    TXF:
         BE       DCB2
         CS,D1    TXM:
         BNE      NEXTDCB
         DO       MODE=0
         CW,D1    TXM:SGLD
         BNE      DCB2
         LW,D1    1,R4
         CW,D1    TXM:SGLD+1
         BNE      DCB2
         LW,D1    -2,R4             SAVE VALUE WORD FROM REF/DEF
         STW,D1   :SEGLDCB            ENTRY FOR M:SGLD DCB
         FIN
DCB2     LW,R5    -3,R4
         AND,R5   Y00F7
         DO       MODE=0[BPMLIB=1
         CW,R5    Y0053
         ELSE
         CW,R5    Y0093
         FIN
         BNE      NEXTDCB
         LB,R5    *R4
         STB,R5   *R7
         LB,D1    *R4,R5
         STB,D1   *R7,R5
         BDR,R5   %-2
         AI,R4    KN3
         LW,R6    1,R4
         INT,R5   *R4
         SLS,R5   1
         STB,R5   R6                DCB SIZE, LOC IN R6
         LB,D1    *R7
         AI,D1    K4
         SLS,D1   -2                D1=DCB NAM SIZ
         LW,SR4   D1
         AW,R7    D1                R7=LOC ENTRY
         LW,D1    *R4               D1=1ST WORD OF RFDF ENTRY
         CW,D1    Y0008
         BAZ      NOLDCB            B IF LOADER IS NOT TO BUILD
         LW,R5    Y008
         STS,R5   R6                SET BIT 8 IN LOC WORD FOR LDCB
NOLDCB   EQU      %
         STW,R6   *R7               DCB BLD BIT,SIZ & LOC
         LW,R5    SR4
         LI,D1    KE
         BAL,SR4  PUTDIG
         BDR,R5   %-2
         LI,D1    2
         BAL,SR4  PUTDIG
         AI,R7    K1
NEXTDCB  BAL,SR4  NEXT
         B        DCB1
         LI,R4    0
         STW,R4   *R7
         LI,D1    X'E'
         BAL,SR4  PUTDIG
DCBRELA  EQU      %
         LW,R6    :FCOUNTN
         AI,R6    -1              COMPUTE POINTER
         DO       MODE=0[BPMLIB=1
         AW,R6    TREEPTR           THE DCBTABLE.
         AW,R6    :TREEN
         ELSE
         INT,R5   10DIS,R1
         SLS,R5   1
         AW,R6    R5
         FIN
         STW,R6   *EXPRBAS
TAMOV    EQU      %
         LW,R4    :ALLN           MOVE THE DCBTABLE
         MTW,-1   EXPRBAS         AND ITS RELOCATION
         MTW,-1   DECLBAS         DICTIONARY FROM THE
         LW,R5    *EXPRBAS,R4     EXPRESSION STACK
         STW,R5   *DECLBAS,R4     TO THE DECLARATION
         BDR,R4   %-2             STACK AND UP.
         MTW,1    EXPRBAS
         MTW,1    DECLBAS
XSAVROOT EQU      %
         LW,R6    :ALLN
         AW,R6    DECLBAS
         DO       MODE=1
         REF      M:FVP
         AI,R6    X'1FF'
         AND,R6   MN9
         AW,R6    M:FVP
         CAL1,8   6
         BCS,8    %+3
         AI,R6    X'200'
         B        %-3
         FIN
         LCI      KC
         PLM,R4   *R0
         PLW,R2   *R0
         PLW,SR4  *R0
         B        *SR4
         PAGE
FIXROOT  EQU      %
*                                   THIS ROUTINE PUTS ALL LOADER BUILT
*                                   TABLES ETC. INTO THE APPROPRIATE
*                                   LOCATION IN THE ROOT CORE IMAGE.
         LW,D1    LOCWD
         CI,D1    K10
         BANZ     *SR4
         LCI      15
         PSM,R1   *R0
*                                   MOVE THE TREE TO THE 01 BUFFER.
*                                   R4 POINTS TO LOC OF TREE IN 01 BUF.
         LW,R6    :TREEN            STORE TREE SIZE IN ORIGINAL COPY OF
         STW,R6   -1,R1             TREE (IN LOCCT).
         MTW,0    LOADBAS           IF BIAS ZERO, NO FIXING REQD
         BEZ      OVGENDCB
         LW,R5    R1
         AI,R5    -1
         LW,R4    RSEG01
         SLS,R4   -2
         DO       NAMELIST=1
         AI,R4    2
         FIN
         AI,R4    KN1
         AI,R5    KN1
         LW,D1    *R5,R6
         STW,D1   *R4,R6
         BDR,R6   %-2
         LW,D1    LOCWD
         CI,D1    K100
         BANZ     DCBTABER
*                                   GENERATE THE TREES REL. DICT.
TREEREL  LW,SR3   RREL01
         SLS,SR3  -2
         LI,R2    0
         DO       NAMELIST=1
         LI,D1    2
         BAL,SR4  PUTDIG
         LI,D1    KE
         BAL,SR4  PUTDIG
         FIN
         LI,D1    KE
         BAL,SR4  PUTDIG
         LW,D3    R4
         LI,R6    1
         AI,R5    1
TREEREL1 LI,R4    0
TREEREL2 LB,D1    TREEREL3,R4
         BAL,SR4  PUTDIG
         AI,R4    1
         CI,R4    11
         BNE      TREEREL2
         AI,R6    11
         CW,R6    *R5
         BL       TREEREL1
         STW,SR3  :SR3              SAVE NEXT AVAILABLE DIGIT
         STW,R2   :R2               IN 01 REL DIC
*                                   MOVE DCB TABLE AND SEGLOAD DCB IF
*                                   ANY.
DCBTABER EQU      %
         LW,R4    :FCOUNTN
         BEZ      TCB               NO DCBTAB TO MOVE.
         DO       MODE=0
         LW,R7    RSEG01
         ELSE
         LW,R7    RSEG10
         FIN
         SLS,R7   -2
         DO       MODE=0[BPMLIB=1
         AW,R7    :TREEN
         DO       NAMELIST=1
         AI,R7    2
         FIN
         FIN
         LW,D2    DECLBAS
         AI,D2    KN1
         AI,R7    KN1
         LW,R6    *D2,R4
         STW,R6   *R7,R4            MOVE DCB & SLGD
         BDR,R4   %-2               TO BUF
         LW,R4    LOCWD
         CI,R4    K100
         BANZ     TCB
*                                   MOVE DCB TABLES AND SEGLOAD DCB'S
*                                   REL DICT..
         DO       MODE=0[BPMLIB=1
         LW,SR3   :SR3              FOR BATCH PUT DCB REL DIC
         LW,R2    :R2             AFTER TREE REL. DIC.
         ELSE
         LW,SR3   RREL10            FOR CP-V, DCB TAB STARTS IN BEGINNING
         SLS,SR3  -2                OF 10
         LI,R2    0
         FIN
         LW,SR1   DECLBAS           COMPUTE BEGINNING OF
         AW,SR1   :FCOUNTN          DCB TAB RELDIC.
         LW,R3    :FCOUNTN
         STW,R3   :FCOUNTX          HOW MANY DIGITS TO MOVE.
         LI,R3    0
MOREMOVE EQU      %
         LW,D1    *SR1              GET DIGIT FROM DECL AREA.
         SLS,D1   -28,R3
         AND,D1   M4
         BAL,SR4  PUTDIG
         AI,R3    4
         CI,R3    32
         BNE      SAMEWORD
         AI,SR1   1
         LI,R3    0
SAMEWORD EQU      %
         MTW,-1   :FCOUNTX
         BGZ      MOREMOVE
*                                   BUILD THE TCB.
TCB      LW,R4    LOCWD
        CI,R4    K2000
        BANZ     TCBNO
         LW,R4    RSEG00
         SLS,R4   -2
         LW,R5    TEMPPTR
         STW,R5   0,R4
         LW,R5    LOCCT
         AI,R5    TMPSZDIS
         LH,R5    *R5
         SLS,R5   16
         STW,R5   1,R4
         LW,R5    TCBPTR
         AI,R5    TCBBLNK+14
         STW,R5   6,R4
         AI,R5    K1
         STW,R5   9,R4
         LW,R5    ERRSTK
         SLS,R5   16
         STW,R5   7,R4
         LW,R5    6,R4
         AW,R5    ERRSTK
         STW,R5   8,R4
         LW,R5    ERRTAB
         SLS,R5   17
         AWM,R5   8,R4
         AI,R5    X'C0000'
         AWM,R5   9,R4
         LW,R5    FTAB
         STW,R5   10,R4
         LW,R5    TREEPTR
         STW,R5   11,R4
         DO       MODE=0
         LI,R5    0                 SET WORD 15 OF TCB=0
         STW,R5   15,R4
         FIN
         LW,R6    LOCWD
         CI,R6    K100
         BANZ     TCBNO
         LW,R6    RREL00
         SLS,R6   -2
         LCI      2
         LM,R4    TCBREL
         STM,R4   *R6
TCBNO   EQU       %
         LW,SR4   FCOUNT
         BEZ      OVGENDCB
         BAL,SR4  GPGENDCB
         B        OVGENDCB
*                                   BUILD DCB'S NOT EXPLICITLY LOADED
*                                   BY RUNNING THROUGH DCB TABLE.
GPGENDCB EQU      %
         PSW,SR4  *R0
         DO       MODE=0[BPMLIB=1
         LW,D2    RSEG01
         ELSE
         LW,D2    RSEG10
         FIN
         SLS,D2   -2                WA(01 TYPE BUF)
         DO       MODE=0
         LW,R6    -1,R1             TREE SIZE
         AW,R6    D2
         ELSE
         LW,R6    D2
         FIN
         DO NAMELIST=1
         AI,R6    2
         FIN
         AI,R6    1
         LW,D4    -1,R6                 "    END
         DO       MODE=0[BPMLIB=1
         LW,D3    01DIS,R1
         ELSE
         LW,D3    10DIS,R1
         FIN
         SLS,D3   K1
         AND,D3   M17               WA(01 TYPE ACT)
NXNTRE   LB,SR1   *R6               BYTE CNT DCB NAME
         BEZ      NOMONTRE
         AI,SR1   K4
         SLS,SR1  -2
         LW,R2    R6
         AW,R6    SR1               DCB LOC ENTRY
         LW,SR1   *R6
*                                   BIT 8 IN LOCATION FIELD
*                                   MEANS THE LOADER IS TO BUILD IT.
         CW,SR1   Y008
         BANZ     YESBLD
NOBLD    EQU      %
*                                   PLUS SIZE FROM DCB TABLE INTO 1ST
*                                   BYTE OF DCB'S WE DONT BUILD.
         LB,SR2   SR1
         AND,SR1  M17
         STW,SR1  *R6
         SW,SR1   D3
         AW,SR1   D2
         STB,SR2  *SR1
         B        NOMORELD
YESBLD   EQU      %
*                                   FOUND ONE TO BUILD. ESTABLISH SIZE.
         LB,SR2   SR1
         AND,SR1  M17
         STW,SR1  *R6
*                                   CLEAR DCB, INSERT PL AND KBUF.
ITSAFILE EQU      %
         LW,SR4   SR1
         SW,SR1   D3                DISP
         AW,SR1   D2                DCB LOC BUF
         DO       MODE+BPMLIB=1
         DO       CFU=1
         LW,R4    *R2
         CW,R4    TXM:STAR          CHECK FOR M:* DCB
         BNE      WHATSYS
         AI,SR1   KN1
         LI,SR2   K0
         LI,R5    K29               M:* DCB IS SPECIAL
         STW,SR2  *SR1,R5             CASE CONSISTING OF
         BDR,R5   %-1                 41 WDS OF ZEROES
         LW,R5    LOCWD
         CI,R5    K100
         BANZ     NOMORELD          BRANCH IF ABS
         LI,R5    X'2A'
         B        STORELD
WHATSYS  EQU      %
         FIN
         LW,SR2   Y33               33 WORDS FOR CP-V
         ELSE
         LW,SR2   Y30               30 WORDS FOR BPM
         FIN
         STW,SR2  *SR1              1ST WORD = CNT
         LI,SR2   K0
         DO       MODE+BPMLIB=1
         LI,R5    X'32'
         ELSE
         LI,R5    X'2F'
         FIN
         STW,SR2  *SR1,R5           ZERO REST OF DCB
         BDR,R5   %-1
         LW,R7    SR1
         LI,SR2   K16
         AW,SR2   SR4               DCB LOC + 16
         STW,SR2  FLPDISP,R7
         DO       MODE=0[BPMLIB=1
         LI,SR2   X'28'
         ELSE
         LI,SR2   X'2B'
         FIN
         AW,SR2   SR4               DCB LOC + 3C
         STW,SR2  KBUFDISP,R7
*                                   BUILD VARIABLE PORTION OF DCB.
         LI,R5    FNAMETRY
         LW,SR2   0,R5
         STW,SR2  22,R7
         LW,SR2   1,R5
         STW,SR2  26,R7
         LW,SR2   2,R5
         STW,SR2  29,R7
         LW,SR2   3,R5
         STW,SR2  32,R7
         LW,SR2   4,R5
         DO       MODE=0[BPMLIB=1
         STW,SR2  36,R7
         LI,R5    X'30'
         ELSE
         STW,SR2  35,R7             INSERT EXPIRE OPT. FOR CP-V
         LW,SR2   5,R5
         STW,SR2  39,R7
         LI,R5    X'34'
         FIN
BLDMCDCB EQU      %
*                                   INSERT DEFAULT INFO FOR THOSE DCBS
*                                   WHOSE NAMES WE RECOGNIZE.
         LW,SR3   0,R2
         LW,SR4   1,R2
         LB,R2    SR3
         SLD,SR3  24
         AI,R2    -3
         LW,SR4   DCBNMASK,R2
         AND,SR3  SR4
         DO       MODE=1
         LI,R2    28
         ELSE
         LI,R2    25
         FIN
         CW,SR3   TAB1-1,R2
         BE       STDDCB            B IF STANDARD DCB
         BDR,R2   %-2
         DO       MODE+BPMLIB=1
         LCI      3
         LM,SR2   DFAULTS
         STM,SR2  1,R7
         LW,SR2   WERDMSK1
         STW,SR2  5,R7
         ELSE
         LW,SR2   NRA
         STW,SR2  2,R7
         FIN
         B        MODRLDCT
STDDCB  EQU      %                 INSERT DEFAULT INFO FOR STD DCB
         LW,SR3   TAB2-1,R2
         LW,SR4   WERDMSK
         STS,SR3  1,R7
         LB,SR3   SR3
         SLS,SR3  17
         STW,SR3  3,R7
         LW,SR3   WERDMSK1
         STW,SR3  5,R7
         LI,SR3   KA
         LI,R2    8
         STB,SR3  *R7,R2
MODRLDCT EQU      %
         LW,D4    LOCWD
         CI,D4    K100
         BANZ     NOMORELD          NONT MOD REL DICT
*                                   BUILD REL. DICT. FOR DCB.
*                                   CALCULATE LOCATION
*                                   OF RELOCATION DIGIT
         DO       MODE=0[BPMLIB=1
         LW,R3    RSEG01
         ELSE
         LW,R3    RSEG10
         FIN
         SLS,R3   -2
         LW,R2    R7
         SW,R2    R3
         SLD,R2   -3                WORD DISPLACEMENT FROM RSEG01
         DO       MODE=0[BPMLIB=1
         LW,R7    RREL01            =DIGIT DISP FROM RREL01
         ELSE
         LW,R7    RREL10
         FIN
         SLS,R7   -2
         AW,R2    R7
         LW,SR3   R2
         LI,R2    0
         SLD,R2   3
         LW,R7    R5
         CI,R7    K16
         BE       %+2
         LI,R5    K6
         LI,D1    KE
         BAL,SR4  PUTDIG            DO ALL
         BDR,R5   %-2
         CI,R7    K16
         BE       NOMORELD          DEVICE
         LI,D1    K2
         BAL,SR4  PUTDIG            2 FOR FLP
         LI,R5    3
         LI,D1    KE
         BAL,SR4  PUTDIG            DUMMY PAST
         BDR,R5   %-2
         LI,D1    K2
         BAL,SR4  PUTDIG            2 FOR KBUF
         LW,R5    R7
         AI,R5    -11
         BLEZ     %+4
         DO       CFU=1
STORELD  EQU      %
         FIN
         LI,D1    KE
         BAL,SR4  PUTDIG
         BDR,R5   %-2
NOMORELD EQU      %
         AI,R6    K1
         B        NXNTRE
NOMONTRE EQU      %
         DO       MODE=0
         LW,R5    -1,R1
         CI,R5    KC
         BLE      FIXREXIT          EXIT IF NON-OVERLAID
         LW,R5    SNM:LM
         CI,R5    X'FF00'
         BAZ      FIXREXIT          EXIT UNLESS SN SPECIFIED
         LW,R5    01DIS,R1          START OF 01 AREA IN ROOT'S TREE
         AND,R5   M16
         SLS,R5   1                 CONVERT TO WA
         LW,R6    RSEG01            START OF 01 AREA IN LOADER'S BUFS
         SLS,R6   -2
         SW,R6    R5                CORRECTION FACTOR
         LW,R5    :SEGLDCB          CONVERT VALUE OF M:SGLD AT EXECUTION
         AW,R5    R6                  TIME TO VALUE IN LOADER'S BUFS NOW
         AI,R5    22
TESTVLP  EQU      %
         LB,R7    *R5               VLP CODE
         CI,R7    K7
         BNE      NXTVLP            BRANCH IF NOT 07 ENTRY
         LI,R7    2
         LB,R4    SNM:LM,R7         CHECK NO. OF SIG. WDS IN M:LM
         AI,R7    1
         LB,R6    *R5,R7            CHECK NO. OF WDS RESERVED IN M:SGLD
         BEZ      FIXREXIT
         CW,R4    R6                MAKE SURE THAT NO MORE WDS ARE
         BLE      STORSIG             MOVED INTO M:SGLD THAN ARE
         LW,R4    R6                  RESERVED
STORSIG  EQU      %
         AI,R7    -1
         STB,R4   *R5,R7
MUVPNAME EQU      %
         LW,R7    SNM:LM,R4         MOVE SN WORDS TO M:SGLD DCB
         STW,R7   *R5,R4
         BDR,R4   MUVPNAME
         B        FIXREXIT
NXTVLP   EQU      %
         LW,R6    *R5
         CW,R6    Y00FF
         BANZ     FIXREXIT          BRANCH IF LAST VLP ENTRY
         LI,R6    3
         LB,R7    *R5,R6            WDS RESERVED FOR THIS VLP
         AW,R5    R7
         AI,R5    1                 ALLOW FOR CONTROL WORD
         B        TESTVLP           EXAMINE NEXT VLP ENTRY
FIXREXIT EQU      %
         FIN
         PLW,SR4  *R0
         B        *SR4
OVGENDCB EQU      %
         LCI      15
         PLM,R1   *R0
         B        *SR4
*                                   THIS ROUTINE INSERTS THE REL. DIGIT
*                                   IN D1 INTO THE WORD POINTED TO BY
*                                   SR3 AT THE DIGIT POINTED TO BY
*                                   R2. SR3 AND R2 ARE INCREMENTED
*                                   APPROPRIATELY.
PUTDIG   PSW,D2   *R0
         LW,D2    LOCWD
         CI,D2    K100
         BANZ     PDEX
         LI,D2    KF
         LCW,R2   R2
         SLS,R2   2
         SLD,D1   28,R2
         LCW,R2   R2
         SLS,R2   -2
         STS,D1   *SR3
         AI,R2    1
         CI,R2    8
         BNE      PDEX
         AI,SR3   1
         LI,R2    0
PDEX     PLW,D2   *R0
         B        *SR4
TREEREL3 DATA     X'0E0E0E0E',X'0E090E09',X'0E090900'
TCBREL   DATA     X'2EEEEE2E',X'2222EE00'
         DO       MODE=0[BPMLIB=1
Y30      DATA     X'30000003'
         ELSE
Y33      DATA     X'33000003'
         FIN
Y0093    DATA     X'00930000'
YF       DATA     X'F0000000'
FNAMETRY EQU      %
         DATA     X'01000003'
         DATA     X'02000002'
         DATA     X'03000002'
         DO       MODE+BPMLIB=1
         DATA     X'04000002'
         FIN
         DATA     X'07000003'
         DATA     X'08010003'
DCBNMASK DATA     X'FF000000'
         DATA     X'FFFF0000'
         DATA     X'FFFFFF00'
WERDMSK  DATA     X'00FE00FF'
         DO       MODE+BPMLIB=1
DFAULTS  DATA     X'0007D4C5'
         DATA     X'0A000000'
         GEN,15,17 140,0
         ELSE
NRA      DATA     X'0A000000'
         FIN
WERDMSK1 DATA     X'80000011'
TAB1     EQU      %
         GEN,8,24 'C',0
         GEN,16,16       'OC',0
         GEN,16,16       'LO',0
         GEN,16,16       'LL',0
         GEN,16,16       'DO',0
         GEN,16,16       'PO',0
         GEN,16,16       'BO',0
         GEN,16,16       'LI',0
         GEN,16,16       'SI',0
         GEN,16,16       'BI',0
         GEN,16,16       'SL',0
         GEN,16,16       'SO',0
         GEN,16,16       'CI',0
         GEN,16,16       'CO',0
         GEN,16,16       'AL',0
         GEN,16,16       'EI',0
         GEN,16,16       'EO',0
         GEN,16,16       'GO',0
         GEN,24,8 '101',0
         GEN,24,8 '102',0
         GEN,24,8 '103',0
         GEN,24,8 '104',0
         GEN,24,8 '105',0
         GEN,24,8 '106',0
         GEN,24,8 '108',0
         DO       MODE=1
         GEN,8,24 '5',0
         GEN,8,24 '6',0
         GEN,8,24 '7',0
         FIN
TAB2     EQU      %
         GEN,8,7,17   120,1,1       C
         GEN,8,7,17    85,3,2       OC
         GEN,8,7,17   132,2,3       LO
         GEN,8,7,17   132,2,4       LL
         GEN,8,7,17   132,2,5       DO
         GEN,8,7,17    80,2,6       PO
         GEN,8,7,17  120,2,7        BO
         GEN,8,7,17  120,1,8        LI
         GEN,8,7,17   80,1,9        SI
         GEN,8,7,17  120,1,10       BI
         GEN,8,7,17  132,2,11       SL
         GEN,8,7,17   80,2,12       SO
         GEN,8,7,17  120,1,13       CI
         GEN,8,7,17  120,2,14       CO
         GEN,8,7,17  80,2,15        AL
         GEN,8,7,17  120,1,16       EI
         GEN,8,7,17  120,2,17       EO
         GEN,8,7,17  120,2,0        GO
         GEN,8,7,17  0,1,2          101
         GEN,8,7,17  0,2,2          102
         DO       MODE+BPMLIB=1
         GEN,8,8,16 0,3,X'D7D9'      103(PR)
         GEN,8,8,16 0,5,X'D7D7'      104(PP)
         ELSE
         DATA     X'00028202'        103
         DATA     X'00048303'        104
         FIN
         GEN,8,7,17 80,1,9          105
         GEN,8,7,17      120,2,7    106
         GEN,8,7,17      132,2,3    108
         DO       MODE=1
         GEN,8,7,17  80,1,9         5
         GEN,8,7,17  132,2,3        6
         GEN,8,7,17  120,2,7        7
         FIN
TXM:SGLD TEXTC    'M:SGLD'
         PAGE
ESTSEG3  STW,R4   CSEG1
         STW,R4   BSEG1
ESTRFDF3 AI,R4    RFDFDIS
         INT,R5   *R4,R1
         LW,R4    *R4,R1
         LH,R4    R4
         SLS,R5   1
         AW,R4    R5
         STW,R5   CRFDF1
         STW,R4   CRFDF2
         LW,R4    R5
         B        *SR4
NEXT     LW,R4    CRFDF1
         LW,R5    *R4
         LB,R4    R5
         AW,R4    CRFDF1
         STW,R4   CRFDF1
         CW,R4    CRFDF2
         BL       *SR4
         AI,SR4   K1
         B        *SR4
         PAGE
*                                   IF A LIB LMN, MAKE AN EXTRA COPY
*                                   OF RFDFSTK FOR MAPER
LIBCPY   LW,D2    CSEG1
         AW,D2    R1
         AI,D2    RFDFDIS
         LW,R5    *D2
         STW,R5   MBIAS             SAVE OLD RFDFSTK FOR MAPER
         AND,R5   M16               RFDFBAS IN R5
         SLS,R5   1
         LH,R4    *D2               SIZE IN R4
         AI,D2    2
         LH,R6    *D2
         INT,R7   *D2
         SLS,R7   1
         AI,R6    K1
         AND,R6   MN1               FORCE EVENWD BOUNDARY
         AW,R6    R7                EXPRSTK TOP + 1 = NEW RFDF BASE
         LW,R7    R6                SAVE NEW RFDF BASE
         AW,R7    R4                ENOUGH ROOM FOR RFDFSTK COPY
         CW,R7    TOPOMEM
         BG       NOMAP             IF NOT, DON'T COPY THE STACK
         SW,R7    R4
         AI,R5    KN1
         AI,R7    KN1
         LW,R3    *R5,R4
         STW,R3   *R7,R4
         BDR,R4   %-2               COPY RFDFSTK ABOVE EXPRSTK
         AI,D2    KN2
         LI,R7    X'FFFF'
         SLS,R6   -1
         STS,R6   *D2               POINT TO NEW RFDFSTK COPY IN TREE
ENDCPY   BAL,SR4  SQZ               CHAIN STKS AND ELIMINATE FREFS
         B        WSEGL
NOMAP    LI,R6    0
         LW,R7    Y003
         STS,R6   LOCWD             ERASE MAP OPTION
         B        ENDCPY
         PAGE
WRITELIB EQU      %
*                                   THIS ROUTINE TAKES CARE OF WRITING
*                                   THE DICTIONARY FOR A LIBRARY LOAD
*                                   MODULE.
         LI,R5    M:LM
         CAL1,1   CLOSE
         LW,R7    NOTLLM
*E*      ERROR:   0200-12
*E*      MESSAGE: ILL. LIB. LOAD MOD.
*E*      DESCRIPTION: THE LIBRARY LOAD MODULE HAS >1 PROTECTION TYPE.
         QUIT     ER12,BEZ
*                                   THE DICTIONARY IS OPENED.
         LW,R7    LOCCT
         LI,R3    40
         LB,R3    *R7,R3           BYTE COUNT OF LMN NAME.
         CI,R3    X'B'
*E*      ERROR:   0200-26
*E*      MESSAGE: ILLEGAL LIBRARY LOAD MODULE NAME
*E*      DESCRIPTION: LIB. LOAD MODULE NAME IS >11 CHARACTERS
*E*      REGISTERS: R3 HAS CHARACTER COUNT OF LOAD MODULE NAME
         QUIT     X'26',BLE,R3
*                                   THE LIBRARY LOAD MODULE IS OPENED.
OLIB     LW,R4    *R0
         LI,R5    OPENLLMX-OPENLLM
         LW,R6    OPENLLM-1,R5
         STW,R6   *R4,R5
         BDR,R5   %-2
         LCI      3                 MOVE LIBNAME
         LM,D1    19,R7             TO SYNON NAME
         STM,D1   14,R4
         BDR,D1   %+3               DDO WE REALLY HAVE A NAME
         LM,D1    TXLIB             NO,    USE DEFAULT
         STM,D1   14,R4
         BAL,SR4  OPENINOUT
*                                   DELETE THE PARENT TO AVOID CONFUSION
*                                   IF PARENT IS A ROM (SAME NAME AS LMN),
*                                   DELETE THE ROM FILE.
*                                   IF PARENT IS SYNONYMOUS NAME,
*                                   DELETE THE NAME.
         LI,R5    M:LM
         CAL1,1   CLOSEREL
         BAL,SR4  OPENINOUT
         CAL1,1   CLOSE             NOW OPEN TO THE LIB
         LCI      3                 DIRECTLY
         LM,D1    14,R4
         STM,D1   10,R4
         CAL1,1   1,R4
         LW,R7    LOCCT
         LW,R5    1,R7              GET NODICTIONARY FLAG
         CW,R5    Y08
         BANZ     CLDICT            NOTHING DO TO HERE, WRITE THE FLMN
RDRFDF   EQU      %
*                                   THE REF/DEF FOR THIS MODULE IS READ
*                                   IF THIS MODULE EXISTS IN THE LIBRARY
         LW,R7    R4
         AI,R7    10                POINT TO FILE NAME
         MTB,1    *R7
         LB,R5    *R7
         LI,R6    K0
         STB,R6   *R7,R5
         DO       MODE=1
         AI,R5    4
         SLS,R5   -2
         MTW,-1   R7
         LW,R6    *R7,R5
         STW,R6   :SAVEKEY-1,R5
         BDR,R5   %-2
         MTW,1    R7
         FIN
         LW,R5    EXPRSTK
         AI,R5    K1
         LW,R6    LOCWD
         CI,R6    X'4000'
         BANZ     ITSXMEM
         CI,R6    X'100'
         BANZ     %+3
         LW,R6    RREL00
         B        %+2
         LW,R6    RSEG00
         SLS,R6   -2
         B        %+3
ITSXMEM  EQU      %
         LW,R6    TOPOMEM
         AI,R6    -X'3FE'
         SW,R6    R5
         DO       MODE=1
         STW,R6   BUF2-1
         MTB,-1   :SAVEKEY
         LW,R3    R1
         LI,R1    :SAVEKEY
         LI,D1    TXHEAD
         BAL,SR4  LIBKEYS
         LW,R1    R3
         MTB,1    :SAVEKEY
         LI,R6    HEADSIZE
         SLS,R6   2
         BAL,SR4  CHKLM
         CAL1,1   READLM            READ HEAD
         LW,R6    HEADRFDF,R5       GET MAXRFDF
         SLS,R6   -16
         CW,R6    BUF2-1
*E*      ERROR:   0200-23
*E*      MESSAGE: NO ROOM TO UPDATE LIBRARY
*E*      DESCRIPTION: THERE IS NOT ENOUGH MEMORY TO READ A LIBRARY'S
*E*               REF/DEF STACK IN ORDER TO UPDATE THE LIBRARY.
*E*      REGISTERS: R6 CONTAINS NUMBER OF WORDS NEEDED.
         QUIT     ER23,BLE,R6
         SLS,R6   2                 YES.
         REF      HEADSIZE,HEADRFDF,ER23
         BAL,SR4  CHKLM
         LI,R7    :SAVEKEY
         FIN
         CAL1,1   READLM
         LW,R7    M:LM+13
         SLS,R7   -2
         AW,R7    R5
*                                   EACH DEF, DOUBLE DEF, AND DSECT IN
*                                   THE OLD REF/DEF STACK HAS
*                                   ITS CORRESPONDING RECORD IN THE
*                                   DICTIONARIES DELETED.
NEXTDEF  LB,D1    *R5
         CI,D1    K3
         BE       NODEF1
         LW,R6    *R5
         AND,R6   MSKFTYPE
         CW,R6    Y0003
         BE       DLETREC
         CW,R6    Y0007
         BANZ     NODEF1
DLETREC  EQU      %
         LW,R6    R5
         LI,SR4   CALDELREC
BDICKEY  PSW,SR4  *R0
         AI,R6    3                 GET TO TEXT
         LB,SR1   *R6               MAKE KEY WITH BLANK+DEF
         ANLZ,SR3 %-1               BA(KEY) FOR MOVE
         LI,SR4   BA(PBUF)+2        PUT IT IN PBUF
         STB,SR1  SR4
         MBS,SR3  1
         SLS,SR1  8
         AI,SR1   X'140'
         CI,SR1   X'F40'            IS KEY TOO BIG
         BLE      %+2               NO
         LI,SR1   X'F40'            YES, USE MAX
         STH,SR1  PBUF
         PLW,SR4  *R0
         B        *SR4
CALDELREC  EQU   %
         CAL1,1   DELREC
NODEF1   AW,R5    D1
         CW,R5    R7
         BL       NEXTDEF
WRITEDEF LI,R4    K0
*                                   EACH DEF IS WRITTEN INTO THE
*                                   DICTIONARY WITH THE ASSOCIATED
*                                   RECORD CONTAINING THE LIBRARY LOAD
*                                   MODULE NAME.
         BAL,SR4  ESTRFDF3
         LW,R5    LOCCT
         LW,SR4   12,R5
         AI,SR4   KN40
         STW,SR4  12,R5
WDEF2    LW,R5    *R4
         AND,R5   MSKFTYPE
         CW,R5    Y0003             ADD RECORD FOR DSECT
         BE       ISDEF
         CW,R5    Y0007
         BAZ      ISDEF             ADD RECORD IF A DEF OR DOUBLE DEF
WDEF1    BAL,SR4  NEXT
         B        WDEF2
         B        CLDICT
ISDEF    LW,R6    R4
         BAL,SR4  BDICKEY           MAKE A KEY
         LW,R5    LOCCT
         AI,R5    KA
CALWRTDIC  EQU  %
         CAL1,1   WRITEDIC
         B        WDEF1
CLDICT   RES
         LW,R5    R1
         AI,R5    KN1
         LW,R6    *R5
         SW,R6    R5
         STW,R6   *R5
         LW,R7    CSEG1
         LW,D4    LOCWD
         B        WSEG1A
BUFCHK   LB,R4    SR3
         CI,R4    X'43'
         BE       WRITEDEF
         B        ER10X
FIRSTLIB EQU      %
         LB,R6    SR3
         CI,R6    K13               NO KEY ON DELREC
         BE       NODEF1            IS O.K..
         CI,R6    3                 'FILE DOES NOT EXIST' CODE
*E*      ERROR:   0200-2B
*E*      MESSAGE: ABNORMAL I/O IN WRITELIB
*E*      DESCRIPTION: THE :LIB FILE COULD NOT BE OPENED
*E*      REGISTERS: SR3 HAS THE SYSTEM I/O ERROR INFORMATION.
        QUIT     X'2B',BE,SR3      QUIT IF NOT
         LCI      3
         LM,D1    14,R4             OPEN WITH PARENT=SYNON
         STM,D1   10,R4
         LI,R6    2                 SET FUNCTION OUT.
         STW,R6   7,R4
*                                   CREATE :LIB
         CAL1,1   1,R4
         LI,R5    M:LM
         CAL1,1   CLOSE             CLOSE AND SAVE
OPENINOUT  EQU   %
         LCI      3
         LM,D1    10,R7             OPEN WITH PARENT NAME=
         STM,D1   10,R4             LMN FROM LOCCT
         LI,R6    4                 SET FUNCTION INOUT
         STW,R6   7,R4
         CAL1,1   1,R4
         B        *SR4
CLOSEREL GEN,8,24  X'15',M:LM
         DATA     X'80000000'
         DATA     1
         PAGE
*                                   THIS ROUTINE PUTS THE LOAD MODULE
*                                   NAME IN BUF2 AND ADDS THE TEXT WORD
*                                   POINTED TO BY D1 AFTER IT.
LIBKEYS  LCI      2
         PSM,R5   *R0
         LW,R7    R1
         LI,D2    BUF2
         LB,R5    *R7
         STB,R5   *D2
         LB,R6    *R7,R5
         STB,R6   *D2,R5
         BDR,R5   %-2
         LI,R4    K4
         MTB,4    *D2
         LB,R5    *D2
         LB,R6    *D1,R4
         STB,R6   *D2,R5
         BDR,R5   %+1
         BDR,R4   %-3
         LW,R7    D2
         LCI      2
         PLM,R5   *R0
         B        *SR4
         PAGE
         DO       MODE=0
         DEF      XMEMEOF
*                                   THIS ROUTINE PUTS TOGETHER THE PAGES
*                                   OF EACH SEGMENT AND WRITES THE SEG-
*                                   MENTS OUT INTO THE LOAD MODULE FILE.
XMEM     LW,R5    LOCWD
         CI,R5    K4000
         BANZ     %+3
         LI,SR4   WSEG1
         B        FIXROOT
         LCI      0
         PSM,R0   *R0
         CAL1,1   XMEMERR
         LW,R4    TOPOMEM
         AI,R4    KN200+K2
         ANLZ,R5  XMEM2
*                                   WRITE OUT THE LAST PAGE IN BUFFER.
         CAL1,1   XMWRT
         LW,R6    LOCWD
         CI,R6    K100              IS LOAD MODULE 'ABSOLUTE'
         BANZ     XMBOF              YES
         AI,R4    KN200              NO  -  SET KEY AND BUFFER ADDRESSES
         AI,R5    XMRKEY-XMKEY              OF LAST RELO DICT PAGE AND
         CAL1,1   XMWRT                     FORCE IT OUT
XMBOF    EQU      %
*                                   POSITION TO BEGINNING OF FILE. READ
*                                   A RECORD WITH NO BYTES TO GET THE
*                                   KEY. FROM THE LOW ORDER BYTE OF THE
*                                   KEY CALCULATE THE PAGE ADDRESS FOR
*                                   THE READ. READ THE RECORD INTO THE
*                                   BUFFER IT WOULD HAVE GONE IN IF WE
*                                   WERENT IN EXTENDED MEMORY. READ THE
*                                   NEXT KEY. IF THE SEGMENTS AGREE
*                                   CONTINUE READING OTHERWISE BACK-
*                                   SPACE AND PREPARE TO WRITE.
         CAL1,1   BOF
XMEM1    CAL1,1   XMRDL
XMEM4    LW,R5    KBDIC
XMEM2    STW,R5   XMKEY
XMEMRS   LW,R6    KBDIC
         AND,R6   M8
         SLS,R6   9
         CW,R6    DECLBAS
         BGE      XMEMLE
        SW,R6    DECLBAS
        LCW,R6   R6
         QUIT     X'18',,R6
*ER18  NOT ENOUGH ROOM TO CONCATENATE XMEMFILE
XMEMLE   EQU      %
         CAL1,1   XMRD
         CAL1,1   XMRDL
XMEM3    LW,R6    KBDIC
         LI,R7    K1FF00                                                731
         CS,R6    XMKEY
         BE       XMEMRS
         CAL1,1   BOR
         LW,R6    XMKEY
         BAL,R3   XWRIT
         LCI      0
         PSM,R0   *R0
*                                   CONTINUE TO NEXT SEGMENT.
         B        XMEM1
XMEMEOF  LB,SR3   SR3
         CI,SR3   7
*                                   LOST DATA IS THE EXPECTED ABNORMAL
*                                   FOR READING 0 BYTES. CHECK WHICH 0
*                                   BYTE READ AND CONTINUE.
         BE       *SR1
*                                   OTHERWISE WE HAVE END-OF-FILE.
         LW,R6    KBDIC                                                 731
         LI,R7    K1FF00                                                731
         BAL,R3   XWRIT
         B        ENDWRT1
         PAGE
XWRIT    EQU      %
         STW,R3   FBIAS
         CS,R6    M2                                                    731
         BNE      %+2                                                   731
*                                   IF IT IS IN THE ROOT SEGMENT FIX THE
*                                   ROOT WITH LOADER BUILT STUFF.
         BAL,SR4  FIXROOT                                               731
*                                   IN EITHER EVENT WRITE SEGMENT OUT.
         LCI      0
         PLM,R0   *R0
         LW,R7    XMKEY
         AND,R7   Y00FFFF                                               731
         SLS,R7   -8                                                    731
         BAL,SR3  WSEG1A
         B        *FBIAS
XMWRT    GEN,8,24 X'11',M:DIC
         DATA     X'38000050'
         DATA     X'80000004',X'800',X'80000005'
XMRDL    GEN,8,24 X'10',M:DIC
         DATA     X'70000010'
         DATA     XMEMEOF,X'80000000',0
XMRD     GEN,8,24 X'10',M:DIC
         DATA     X'38000010'
         DATA     X'80000006',X'800',KBDIC
BOF      GEN,8,24 X'1C',M:DIC
         DATA     X'10'
BOR      GEN,8,24 X'1D',M:DIC                                           731
         DATA     X'80000010',1
XMEMERR  GEN,8,24 6,M:DIC
         DATA     X'80000000',XMEM3
         PAGE
         ELSE
*                                   THIS ROUTINE 'CLEANS UP' THE PAGED
*                                   CORE IMAGE RECORDS OF AN EXTENDED
*                                   MEMORY MODE LOAD MODULE AFTER ALL
*                                  OF THE RECORDS HAVE BEEN BUILT BY
*                                   EVL.
SUPMEM   LW,SR3   CSEG1
         BNEZ     ENDWRT1           RETURN IF NOT AT ROOT
         BAL,SR4  SAVEROOT          BUILD DCB NAME TABLE
         CAL1,1   SUPDCB
         LW,R4    TOPOMEM
         AI,R4    KN200+2
         LI,R6    X'800'
         CAL1,1   XMWRT             WRITE OUT LAST PAGE IN BUFFER
*                                   READ IN THE FIRST FEW PAGES OF ROOT
*                                   00,01,10 AREAS ABOVE DCB NAME TABLE
*                                   SO THE APPROPRIATE TABLES CAN BE
*                                   INSERTED BY FIXROOT.
         LI,SR4   TREE              NONE OF THIS FOR ZERO BIAS
         MTW,0    LOADBAS
         BEZ      FIXROOT
         LW,R5    DECLBAS
         AW,R5    :ALLN
         AI,R5    X'1FF'
         AND,R5   MN9
         LW,D1    R1                TREE POINTER IN R1
         AI,D1    00DIS
         LW,D2    LOCWD
         CI,D2    K2000             IS NOTCB SPECIFIED
         BAZ      %+4               B IF NOT
         LI,D2    0
         STW,D2   LOKEY00           0 IN LOKEYNN MEANS NO RECORDS READ
         B        RXMEM1
         LW,D2    TCBSIZE
         LI,R3    0
         BAL,SR2  GETRECS           READ IN RECORDS FOR TCB
         INT,R7   *D1               TCB MAY NOT START ON PAGE BNDRY
         AND,R7   M8                DUE TO PRESENCE OF CORE LIB CON-
         SLS,R7   3                 TEXT OR BLANK COMMON. ADJUST RSEG00
         AWM,R7   RSEG00            TO POINT TO START OF TCB.
RXMEM1   AI,D1    2
         LW,D2    :TREEN            SIZE OF TREE TABLES
         LI,R3    1
         BAL,SR2  GETRECS           GET RECORDS FOR 01 TABLES
         AI,D1    2                 FOR CP-V, THE DCBS & DCB NAME TABLES
         LH,D2    *D1               FOLLOW DATA
         BNEZ     %+4
         STW,D2   LOKEY10           ZERO LOKEY10 IF SIZE = 0
         LI,SR4   RXMEM2
         B        FIXROOT           INSERT 00 AND 01 TABLES
         SLS,D2   1
         LI,R3    2
         BAL,SR2  GETRECS           READ IN PAGES IF THEY ALREADY EXIST
         LI,SR4   RXMEM2            RETURN ADDR FOR FIXROOT
         B        FIXROOT
*                                   FIXROOT RETURNS HERE IF XMEM SET.
*                                   THIS SECTION WRITES OUT THE PAGES
*                                   WHICH WERE READ IN BY GETRECS
RXMEM2   EQU      %
         LI,R3    3
RXMEM3   LW,R7    LOKEY00-1,R3
         BEZ      RXMEM5            B IF NO RECORDS READ FOR THIS AREA
         LW,R4    RSEG00-1,R3
         SLS,R4   -2
         CI,R3    1
         BNE      RXMEM4
         AND,R4   MN9
RXMEM4   CW,R7    HIKEY00-1,R3      WRITE OUT ALL RECORDS FOR THIS AREA
         BG       RXMEM5
         STW,R7   XMKEY
         CAL1,1   XMWRT
         AI,R4    K200
         AI,R7    1
         B        RXMEM4
RXMEM5   EQU      %
         BDR,R3   RXMEM3
         PAGE
*                                   FOR THE OVERLAY SEGMEMTS, THE FIRST
*                                   RECORD OF EACH PROT TYPE AREA MUST
*                                   BE ADJUSTED TO BEGIN AT THE EXECU-
*                                   TION BIAS.
CXMEM    EQU      %
         LW,R5    TOPOMEM           USE TOP PAGE OF AVAIL CORE FOR
         AI,R5    KN200+2           INPUT BUFFER
         LW,D3    -1,R1
         AW,D3    R1                TOP OF TREE IN D3
        AI,D3    KN1
         LI,R3    0
         INT,D2   00DIS,R1          IF ROOT DOES NOT BEGIN ON
         CI,D2    X'FF'             A PAGE BOUNDARY
         BANZ     %+2               SHORTEN THE FIRST DATA RECORD
         LI,R3    X'B'              ELSE START WITH THE 1ST OVERLAY
CXMEM1   EQU      %
         LW,D1    R1
         AW,D1    R3
         CW,D1    D3
         BGE      TREE              B IF NO MORE SEGMENTS
         AI,D1    00DIS
         LI,D4    3
CXMEM2   LH,D2    *D1
         BEZ      CXMEM3            BRANCH IF SIZE IS ZERO
         INT,D2   *D1
         SLS,D2   1                 EXECUTION BIAS IN D2
         STW,D2   R6
         AND,D2   MN9
         SW,R6    D2                R6 = 512 - SIZE OF OUTPUT RECORD
         SLS,D2   -9
         LW,R7    R3
         DH,R7    Y000B             KEY IS 03,SEG#,00,VIRTUAL PAGE#
         AI,R7    X'300'
         STH,R7   D2
         STW,D2   XMKEY
         CAL1,1   XMRD              READ PAGE-LENGTH RECORD
         LW,R4    R5
         AW,R4    R6                MOVE BUFFER POINTER TO EXEC BIAS
         LCW,R6   R6
         AI,R6    X'200'            ADJUST SIZE OF RECORD
         SLS,R6   2
         CAL1,1   XMWRT             WRITE SHORTENED RECORD
CXMEM3   CI,R3    0
         BE       CXMEM4
         AI,D1    2
         BDR,D4   CXMEM2
CXMEM4   AI,R3    X'B'              MOVE R3 TO POINT TO THE NEXT TREE TBL
         B        CXMEM1
         PAGE
*                                   GETRECS READS IN THE RECORDS WHICH
*                                   ARE TO HAVE TABLES INSERTED.  IT
*                                   EXPECTS A TREE POINTER TO THE PROPER
*                                   PROT. TYPE IN D1, THE TABLE SIZE
*                                  (IN WDS) IN D2, AND 1 OR 0 IN R3
GETRECS  INT,R7   *D1               EXEC. BIAS IN R7
         SLS,R7   1
         AW,D2    R7                GET WA(END OF TABLE)
         SLS,R7   -9                PAGE # OF START OF TABLE FOR KEY
         OR,R7    Y03
         STW,R7   LOKEY00,R3        SAVE FOR WRITING RECORD OUT
         SLS,D2   -9
         OR,D2    Y03               KEY FOR PAGE # OF END OF TABLE
         STW,D2   HIKEY00,R3        SAVED IN HIKEYNN
         SLS,R5   2
         STW,R5   RSEG00,R3         ADJUST RSEG BUFFER FOR FIXROOT
         SLS,R5   -2
GETRECS1 EQU      %
         BAL,SR4  CHKLM
         STW,R7   XMKEY
         CAL1,1   XMRD
         AI,R7    1                 INCREMENT PAGE NO. IN KEY
         AI,R5    K200              SET BUFFER PNTR TO NEXT PAGE IN CORE
         CW,R7    HIKEY00,R3        COMPARE NEXT KEY TO THE COR. HIKEY
         BLE      GETRECS1
         B        *SR2
NOREC    LB,R4    SR3
         CI,R4    X'43'
         BE       *SR1
         B        ER10X
XMRD     GEN,8,24 X'10',M:LM
         DATA     X'38000010'
         DATA     X'80000005',X'800',XMKEY
XMWRT    GEN,8,24 X'11',M:LM
         DATA     X'38000050'
         DATA     X'80000004',X'80000006',XMKEY
SUPDCB   GEN,8,24 X'06',M:LM
         DATA     X'80000000',NOREC
         FIN
         PAGE
OPENLLM  GEN,8,24 X'14',M:LM
         DATA     X'C7080801'
         DATA     BUFCHK
         DATA     FIRSTLIB
         DATA     2                 KEYED
         DATA     2                 DIRECT
         DATA     4                 INOUT
         DATA     15                KEYMAX
         DATA     X'1000303',,,     FILENAME HOLE
         DATA     X'B010303',,,     SYNON HOLE
OPENLLMX EQU      %
DELREC   GEN,8,24 13,M:LM
         DATA     X'80000000'
         PZE      PBUF              KEY ADDR
WRITEDIC GEN,8,24 17,M:LM
         DATA     X'38000060'
         PZE      *R5               RECORD=LMNNAME
         DATA     12                SIZE
         PZE      PBUF              KEY ADDR
Y0053    DATA     X'530000'
Y00F7    DATA     X'F70000'
         PAGE
SQZ      EQU      %
*                                   THIS ROUTINE PROCESSES LIBRARY REF/
*                                   DEF AND EXPRESSION STACKS TO ALLOW
*                                   FASTER ADDING OF LOAD MODULES. FIRST
*                                   ALL FORWARD REFERENCES AND THEIR
*                                   DEFINING EXPRESSIONS ARE ELIMINATED
*                                   FROM THE STACKS AND ALL POINTERS TO
*                                   THE REF/DEF STACK ARE ADJUSTED. THEN
*                                   ALL POINTERS IN THE EXPRESSION STACK
*                                   TO A GIVEN ENTRY IN THE REF/DEF STAC
*                                   ARE CHAINED TOGETHER. THE VALUE WORD
*                                   OF THE REF/DEF BECOMES A RELATIVE
*                                   POINTER TO THE FIRST POINTER IN THE
*                                   EXPRESSION STACK WHICH POINTS TO THE
*                                   NEXT, ETC. 0 TERMINATES THE CHAIN.
         LW,15    LOCWD
         CI,15    X'10'
         BAZ      *11
         PSW,11   *0
         LI,11    0
         INT,15   RFDFDIS,1
         SLS,15   1
* 15 #RFDF BASE
         LW,6     RFDFDIS,1
         SLS,6    -16
* 6 # RFDF SIZE
         LW,14    EXPRDIS,1
         SLS,14   1
* 14 # EXPR BASE
         LW,5     EXPRDIS,1
         SLS,5    -16
* 5 # EXPR SIZE
         LCI      3
         PSM,1    *0
         LI,1     0
RFDFLOOP CW,1     6
         BGE      SQZDN
* IS ENTRY AN FREF WHICH CAN BE RELEASED
         LW,R3    Y0037
         AND,3    *15,1
         CW,R3    Y0015
         BE       REMFREF
* INC PAST ENTRY
NXTRFDF  LW,2     1
         AW,2     15
         LB,2     *2
         AW,1     2
         B        RFDFLOOP
* REMOVE ENTRY FROM RFDF STACK
REMFREF  LW,2     1
         LW,3     1
         AI,2     4
         LW,13    *15,2
         STW,13   *15,3
         AI,2     1
         AI,3     1
         CW,3     6
         BL       %-5
         AI,6     -4
*        REMOVE EXPR FOR FREF, DECREMENT ALL REFERENCES ABOVE BY 4
FIXEXPR  LI,2     0
EXLOOP   CW,2     5
         BL       EXLOOP1
         MTW,0    11
         BEZ      RFDFLOOP
         B        EXCHLOP1
EXLOOP1  LW,3     14
         AW,3     2
         LH,4     *3
         LI,13    X'3F'
         AND,13   4
         AW,13    3
         LI,4     -2
         AW,4     13
* IS IT EXPR FOR REMOVED FREF
         CW,1     *4
         BNE      FX2
         MTW,0    11
         BEZ      FX4
         LW,12    4
         SW,12    14
         OR,12    Y8
         STW,12   *7
         LW,7     4
         B        FX3
* YES, GET IT OUT
FX4      LB,4     *3
         SW,5     4
         LW,3     2
         AW,4     3
         LW,13    *14,4
         STW,13   *14,3
         AI,4     1
         AI,3     1
         CW,3     5
         BL       %-5
         B        EXLOOP
*        13 HAS ADDRESS OF FIRST VALUE
FX2      LI,12    X'1FFFF'
         CW,12    *4
         BL       FX3
         CW,1     *4
         BG       FX3
         MTW,0    11
         BNEZ     FX3
* DEST IS ABOVE REMOVED FREF, DECREMENT
         MTW,-4   *4
FX3      LI,4     2
* CHECK FOR VALUE POINTERS ABOVE REMOVED FREF
FX2LOP   LB,12    *3,4
         BEZ      NOVAL
         CI,12    1
         BE       ADCON
         CI,12    2
         BE       EXPREND
         CI,12    X'30'
         BGE      NOVAL
         CW,1     *13
         BG       ADCON
         MTW,0    11
         BEZ      FX2LOP1
         CW,1     *13
         BNE      ADCON
         LW,12    13
         SW,12    14
         OR,12    Y8
         STW,12   *7
         LW,7     13
         B        ADCON
FX2LOP1  MTW,-4   *13
ADCON    AI,13    1
NOVAL    AI,4     1
         B        FX2LOP
EXPREND  LB,12    *3
         AW,2     12
         B        EXLOOP
*                                   CHAINING STARTS HERE.
SQZDN    EQU      %
         LI,11    1
         LI,1     0
EXCNLOOP CW,1     6
         BGE      EXCHDN
         LW,7     15
         AW,7     1
         AI,7     1
         B        FIXEXPR
EXCHLOP1 LI,2     0
         STW,2    *7
         LW,2     1
         AW,2     15
         LB,2     *2
         AW,1     2
         B        EXCNLOOP
EXCHDN   EQU      %
         LCI      3
         PLM,1    *0
         PLW,11   *0
         SLS,5    16
         INT,15   EXPRDIS,1
         AW,15    5
         STW,15   EXPRDIS,1
         SLS,6    16
         INT,15   RFDFDIS,1
         AW,15    6
         STW,15   RFDFDIS,1
         B        *11
Y0037    DATA     X'00370000'
Y0015    DATA     X'00150000'
         END

