*        704730   SIGMA 5/7         BPM M:EVLOAD
         SYSTEM   SIG7FDP
MODE     EQU      1
         DO       MODE=1
SD       EQU      1
         ELSE
SD       EQU      0
         FIN
         CSECT    1
         DEF      MCEV
MCEV     EQU      %
         REF      M2,M3,M4,M5,M6,M7,M8,M15,M16,M17,M20,M32,MN1,MN2,;
                  MN3,MN4,MN8,MN9,MN16,M826,MSKFTYPE,Y1,Y2,Y4,Y8,Y01,;
                  Y02,Y08,Y0C,Y0F,Y001,Y002,Y004,Y008,Y00C,;
                  Y001F,Y00FFFF,Y0001,Y0002,Y0003,Y0004,Y0005,Y0006,;
                  Y0007,Y0008,Y000B,;
                  Y000C,;
                  Y0301,Y0303,Y0343,Y0304,Y0405,Y0502,;
                  Y00FF,YFF00FFFF,Y000F,YFFF0FFFF,TXF:,TXM:,;
                  TXLIB,TX6F4:,TXASTL,TXHEAD,;
                  HEADWD,TXTREE,STK2,RFDFSTK2,PASSCODE
         REF      TXBLNK
         REF      X8
         REF      Y00F1,Y03
         REF      Y68,M9
         REF      M11,RFLDMODS,BREFBIT,DOREFPTR,BREFERR,RFLDTBSZ
         REF      READBILI,2BNUM,3BNUM,12BNUM,4BNUM,GBYTE,GETSEG
         REF      DECLSTK,DECLSTK1,DECLBAS,RFDFBAS,RFDFSTK,;
                  RFDFSTK1,EXPRSTK,EXPRSTK1,EXPRBAS,BSEG1,BSEG2,;
                  CSEG1,CSEG2,CROM1,CROM2,CRFDF1,CRFDF2,CURBYTE,;
                  RCDSIZE,SEQNUM,SEVLEV,XSL,LASTCARD,BUF,BUF2,;
                  BFR,TEMPPTR,TREEPTR,FCOUNT,FTABLE,;
                  ERRTAB,ERRSTK,TCBSIZE,TCBPTR,FTAB,RSEG00,;
                  RSEG01,RSEG10,RREL00,RREL01,RREL10,CSEG00,;
                  CREL00,CREL01,CREL10,MAX00,;
                  MAX01,MAX10,DLOC,PLOC,SLOC,LOC,START,LOCCT,;
                  LOADBAS,MODBAS,RELDBAS,MBIAS,FBIAS,BIAS,;
                  RDIG,MODSIZ,NOTLLM,MAXRFDF,MAXEXPR,TOPOMEM,;
                  OPENEF
         REF      LOCWD,XMKEY
         REF      XMRKEY
         REF      RFLDSG
         REF      TEMPSIZE,DECLSIZE,EXPRDIS,;
                  RFLOADIS,RFDFDIS,NXROMDIS,SBLNKDIS,ROM1DIS,;
                  TMPSZDIS,NUNSTDIS,00DIS,01DIS,10DIS,NRWACCT,;
                  TREESIZE,TREEDIS,BIASDIS,LOWLIMDS,FCOMDIS,;
                  ERRDIS,LMNDIS,USACTDIS,LMPASS,LMEXPDIS,;
                  RDACT1,ROMSIZE,TCBBLNK
         REF      LIBER
         REF      ERB,ERC,ERD,ERE,ERF
         REF      BINTOHEX,BLANKER,PRINT
         REF      READLM,WRITELM,M:LM,M:LL,M:EF,M:DIC,CLOSE,READEF
         REF      RLOC
         DEF      EVEXPRS,LOADSEG
         REF      Y048,Y018
         REF      ER19,ER1A,ER1B
         REF      FIRSTF,LASTF
         REF      XCSEG1
         REF      DECLCHK
         REF      ER1X,ERAX
         REF      CODE
         DO       SD=1
         REF      SYMBOLTB,SYMTOP,M30
         FIN
         DO       MODE=1
         REF      PLIB
         REF      MREFLAG,TOVBALPSD,TOVBPSD,MREFTAB,YFF
         FIN
         REF      PBUF
         PAGE
BGEZ     EQU      X'681'
BE       EQU      X'683'
BNEZ     EQU      X'693'
BGE      EQU      X'681'
BL       EQU      X'691'
BLZ      EQU      X'691'
BAZ      EQU      X'684'
BCR8     EQU      X'688'
BCR10    EQU      X'68A'
BLE      EQU      X'682'
BEZ      EQU      X'683'
BNE      EQU      X'693'
         REF      MESSAGE
*        QUIT     ERROR,CONDITION
QUIT     CNAME
         PROC
LF       EQU      %
         DO       NUM(AF)=3
         DO       AF(2)~=0
         GEN,12,20  AF(2),%+4+MODE
         FIN
         STW,AF(3) CODE
         ELSE
         DO       AF(2)~=0
         GEN,12,20  AF(2),%+3+MODE
         FIN
         FIN
         LI,R3    AF(1)
         DO       MODE=1
         LI,R4    AF(3)=SR3
         FIN
         B        MESSAGE
         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'
K16      EQU      X'16'
K17      EQU      X'17'
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'
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'
K800     EQU      X'800'
KC00     EQU      X'C00'
K2000    EQU      X'2000'
K3FFF    EQU      X'3FFF'
K4000    EQU      X'4000'
K7FFF    EQU      X'7FFF'
KFF00   EQU      X'FF00'
K8000    EQU      X'8000'
K1FE00   EQU      X'1FE00'
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
KN100    EQU      -100
KN200    EQU      -X'200'
KN3FE    EQU      -X'3FE'
KN400    EQU      -X'400'
KTE      EQU      'E'
KTR      EQU      'R'
         PAGE
*                                   THIS ROUTINE DECODES AND EVALUATES
*                                   AN EXPRESSION IF IT IS NOT ALREADY
*                                   MARKED AS EVALUATED. R6 POINTS TO
*                                   THE EXPRESSION. SR2 IS SET TO Y008
*                                   IF THE EXPRESSION IS SUCCESSFULLY
*                                   EVALUATED.
EVEXP    LW,R7    *R6
         CW,R7    Y00C                                                  730
         BANZ     *SR4
EVEXP1   PSW,SR4  *R0                                                   730
         LI,SR1   K0
         LH,D1    *R6
         AND,D1   M6
         LW,R7    D1
         AW,R7    R6
         AI,R7    KN1
         LI,D2    K0
         STW,D2   *R7
         LI,R7    K1
*                                   THIS IS THE GENERAL EXPRESSION
*                                   CONTROL BYTE DECODER.
EVWHATEC AI,R7    K1
         LB,D2    *R6,R7
         CI,D2    K0
         BE       EVWHATEC
         CI,D2    K1
         BE       EVADCON
         CI,D2    K2
         BE       EVEXPEND
         LW,R4    D2
         SLS,R4   -2
         CI,R4    KC
         BE       EVCHGRES
         BG       AABS
         B        EVGETVAL
*                                   ADD CONSTANT.
EVADCON  AW,SR1   *D1,R6
EVINCWD  AI,D1    K1
         B        EVWHATEC
*                                   CHANGE RESOLUTION.
EVCHGRES LW,R5    R6
         AI,R5    KN3
         AW,R5    D1
         LCI      2                                                     4730
         PSM,R1   *R0                                                   4730
         BAL,SR4  WHATRES
         B        EVCHGRS2
NEXTEC   LCI      2                                                     4730
         PLM,R1   *R0                                                   4730
         B        EVWHATEC
EVCHGRS2 AND,D2   MN2
         SW,R5    D2
         SLS,SR1  0,R2
         B        NEXTEC                                                4730
AABS     LI,D3    1
         CI,D2    8
         BAZ      %+2
         LI,D3    -1
         LI,4     3
         AND,D2   M2
         SW,4     D2
         SLS,4    3
         SLS,D3   0,4
         LH,R5    *R6
         AND,R5   M6
         AI,R5    -1                                                 B01
         AWM,D3   *R5,R6                                             B01
         B        EVWHATEC
EVEXPEND LW,SR2   Y008
*                                   EXPRESSION END. THE EXPRESSION
*                                   IS MARKED EVALUATED.
         STS,SR2  *R6
         LH,R4    *R6
         CI,R4    X'40'                                                 730
         BANZ     EVEXPUN1                                              730
*                                   THE VALUE OF THE EXPRESSION AND
*                                   THE RESOLUTION ARE INSERTED INTO
*                                   THE ENTRY IN THE REF/DEF STACK
*                                   IF IT IS NOT A CORE EXPRESSION AND
*                                   THE REF/DEF ENTRY IS MARKED DEFINED.
         AND,R4   M6
         STW,R4   R7
         AI,R4    KN2
         INT,R4   *R6,R4
         AI,R4    RFDFDIS
         LW,R4    *R4,R1
         AND,R4   M16
         SLS,R4   1
         AW,R4    R5
         LW,R5    *R4
         CW,R5    Y001
         BANZ     EVEXPUN1
         LW,R5    Y001
         STS,R5   *R4
         AI,R4    K1
         STW,SR1  *R4
         AW,R6    R7
         AI,R6    KN1
         AI,R4    K1
         LW,R5    *R6
         SW,R6    R7
         AI,R6    K1
         STW,R5   *R4
         B        EVEXPUN1
EVEXPUND LCI      K2
         PLM,R1   *R0
*                                   EXIT.
EVEXPUN1 PLW,SR4  *R0
         B        *SR4
*                                   THIS ROUTINE PICKS UP THE VALUE OF
*                                   A REF/DEF ENTRY POINTED TO BY AN
*                                   EXPRESSION. IF THE DEF DOES NOT
*                                   HAVE A VALUE THE EXPRESSION IS STILL
*                                   UNDEFINED. THE VALUE IS SHIFTED
*                                   TO THE APPROPRIATE RESOLUTION
*                                   ACCORDING TO THE RESOLUTION OF
*                                   THE DEF. THE RESOLUTION OF THE
*                                   EXPRESSION IS ADJUSTED APPROPRIATELY
EVGETVAL INT,R4   *D1,R6
         AI,R4    RFDFDIS
         LW,R4    *R4,R1
         AND,R4   M16
         SLS,R4   1
         AW,R5    R4
         LCI      K2
         PSM,R1   *R0
         LW,R2    *R5
         CW,R2    Y001
         BAZ      EVEXPUND
         STW,D2   SR2
         STW,D2   D3
         LW,D2    R5
         AI,D2    K1
         BAL,SR4  WHATRES
         LI,R2    K5                                                    730
         AND,SR2  M2
         LW,R4    D2
         LW,R5    *D2
         XW,R5    SR1
         CI,R2    5                                                     730
         BE       %+3                                                   730
         SW,R2    SR2                                                   730
         SLS,SR1  0,R2
         XW,R5    SR1
         CI,D3    8
         BAZ      %+2
         LCW,R5   R5
         AW,SR1   R5
         LH,R5    *R6
         AND,R5   M5
         AW,R5    R6
         STW,R6   R1
         AI,R4    K1
         LW,R6    *R4
         CI,R2    5                                                     730
         BE       %+2                                                   730
         SLS,R2   3
         SLS,R6   0,R2
         STW,R6   R4
         LW,R6    R1
         LI,R2    KN4
EVFIXRES LB,R1    R5,R2
         LB,D2    *R5,R2
         CI,D3    8
         BAZ      %+2
         LCW,R1   R1
         AW,D2    R1
         STB,D2   *R5,R2
         BIR,R2   EVFIXRES
         LCI      K2
         PLM,R1   *R0
         B        EVINCWD
*                                   THIS ROUTINE GOES THRU THE EXPRESSIO
*                                   STACK ATTEMPTING TO EVALUATE EACH
*                                   EXPRESSION IN ORDER. THE PROCESS
*                                   IS REPEATED UNTIL A PASS THRU THE
*                                   STACK HAS BEEN MADE WITH NO
*                                   EXPRESSIONS EVALUATED.
EVEXPRS  PSW,SR4  *R0
EVEXPRS1 LI,SR2   K0
         LW,R5    CSEG1
         AI,R5    EXPRDIS
         INT,R6   *R5,R1
         SLS,R7   1
         LW,R6    *R5,R1
         LH,R6    R6
         BEZ      EVEXEN
         AW,R6    R7
         STW,R6   SR3
         LW,R6    EXPRBAS
EVEXPRS2 BAL,SR4  EVEXP
         LB,R7    *R6
         AW,R6    R7
         CW,R6    SR3
         BL       EVEXPRS2
         CW,SR2   Y008
         BANZ     EVEXPRS1
EVEXEN   PLW,SR4  *R0
         B        *SR4
         SPACE    10
         PAGE
*                                   LOAD SEG MAKES THE SECOND PASS AT
*                                   THE OBJECT LANGUAGE AND FROM THE
*                                   CORE IMAGE OF THE LOAD MODULE.
         REF      01SIZ
YEES     DATA     X'EEEEEEEE'
LOADSEG  PSW,SR4  *R0
         LW,R4    LOCWD
         CI,R4    X'4100'
         BANZ     ZREL
*                                   THE RELOCATION DICTIONARY IS
*                                   INITIALIZED TO E'S (ABS) IN THE ROOT
*                                   SEGMENT AND O'S IN HIGHER SEGMENTS.
         LW,R4    CREL00
         LW,R5    CSEG00
         LI,R6    0
         LW,R7    CSEG1
         BNEZ     ZREL1
         LW,R6    YEES
         LW,R4    RREL00
         LW,R5    RSEG00
ZREL1    SLD,R4   -2
         SW,R5    R4
         AI,R4    -1
         STW,R6   *R4,R5
         BDR,R5   %-1
ZREL     EQU      %
         LW,R7    CSEG1             INITIALIZE
         AI,R7    RFDFDIS           FORWARD
         LW,R7    *R7,R1            REFERENCE
         LH,R3    R7                BOUNDARIES.
         AND,R7   M16
         SLS,R7   1
         STW,R7   FIRSTF
         AND,R3   M16
         AW,R7    R3
         STW,R7   LASTF
*                                   THIS LOGIC CONTROLS THE READING AND
*                                   LOADING OF ALL THE FILES FOR THIS
*                                   SEGMENT. WE INITIALIZE TO THE 1ST
*                                   FILE IN THE SEGMENT, LOAD IT, CHECK
*                                   FOR ANOTHER ROM IN THE SAME FILE.
*                                   IF THERE IS ONE WE LOAD IT AND
*                                   PROCEED. IF NOT GO TO THE NEXT FILE.
*                                   IF THE FILES ARE FROM THE LIBRARY WE
*                                   AVOID UNNECESSARY OPENS AND CLOSES.
FIRSTROM LW,R4    CSEG1
         AI,R4    ROM1DIS
         LW,R4    *R1,R4
         LH,R4    R4
NEXTROM  STW,R4   CROM1
         BAL,SR4  LOCROM
CALLP1   LCI      K3
         PSM,R1   *R0
         BAL,SR4  LP1
         LCI      K3
         PLM,R1   *R0
NUTHER   BAL,SR4  READBILI
         B        NEWROM
         BAL,SR4  CHECKROM
         B        CALLP1
NEWROM   EQU      %
         LW,R5    CROM1
         AI,R5    2
         LW,R5    *R5,R2
         CI,R5    X'20'
         BANZ     GETROM
         LI,R5    M:EF
         CAL1,1   CLOSE
GETROM   LW,R4    CROM1
         AI,R4    NXROMDIS
         LW,R5    *R4,R2
         AI,R4    7-2               ROMSIZE-NXROMDIS
         CI,R5    X'40'
         BANZ     NEXTROM
         PLW,SR4  *R0
         B        *SR4
         PAGE
*                                   THIS ROUTINE OPENS M:EF TO THE FILE
*                                   SPECIFIED IN THE ROM TABLE UNLESS
*                                    WE HAVE ANOTHER LIBRARY ROUTINE
*                                   IN THE SAME ACCOUNT #.
LOCROM   PSW,SR4  *R0
         LW,D1    M:EF
         CW,D1    Y002
         BAZ      LOCROM1
         CAL1,1   SETERR
         LW,R7    CROM1
         AW,R7    R2
         LW,D1    2,R7
         CI,D1    X'20'
         BAZ      CLOCROM
         LW,D1    3,R7
         CW,D1    OPENEF+12
         BNE      CLOCROM
         LW,D1    4,R7
         CW,D1    OPENEF+13
         BE       LOCROM2
CLOCROM  LI,R5    M:EF
         CAL1,1   CLOSE
LOCROM1  LI,D1    OPENEF+8
         BAL,SR4  LOADOPL
         CAL1,1   OPENEF
LOCROM2  BAL,SR4  READBILI
         B        %+2
         B        CHCKROM1
         B        ER1X
         SPACE    10
SETERR   GEN,8,24 6,M:EF
         DATA     X'80000000',LIBER
*                                   THIS ROUTINE MOVES THE NAME,
*                                   ACCOUNT # AND PASSWORD FROM THE
*                                   ROM TABLE TO THE OPEN PLIST. IF
*                                   THE ROM IS IN A LIBRARY THE FILE
*                                   NAME :LIB IS USED INSTEAD.
LOADOPL  PSW,SR4  *R0
         LW,D2    CROM1
         AW,D2    R2
         LW,R7    D2
         LW,R7    2,R7
         CI,R7    2
         BAZ      %+3
         LI,R6    2
         B        %+2
         LI,R6    1
         LI,R7    3
         STS,R6   OPENEF+1
         LI,R7    K3
         BAL,SR4  MOVER
         LW,R7    D1
         LW,SR3   -1,R7
         CI,SR3   X'20'
         BAZ      %+4
         LCI      2
         LM,SR3   TXLIB
         STM,SR3  -3,R7
         MTW,1    D1
         LI,R7    K2
         BAL,SR4  MOVER
         MTW,1    D1
         LI,R7    K2
         BAL,SR4  MOVER
         PLW,SR4  *R0
         B        *SR4
         SPACE    10
MOVER    LW,R6    *D2
         STW,R6   *D1
         MTW,1    D1
         MTW,1    D2
         BDR,R7   MOVER
         B        *SR4
         PAGE
*                                   THIS ROUTINE VERIFIES THE 1ST WORD
*                                   OF THE FIRST CARD OR READER. IF THE
*                                   TYPE IS NOT -C WE HAVE A LIBRARY
*                                   LOAD MODULE.
CHECKROM PSW,SR4  *R0
CHCKROM1 LI,R4    KN1
         STW,R4   CURBYTE
         STW,R4   SEQNUM
         LI,R4    K0
         STW,R4   LASTCARD
         BAL,SR4  GBYTE
         MTW,-1   CURBYTE
         LW,R5    BUF
         AND,R5   Y0F
         CW,R5    Y0C
         BNE      ADLDMD
         PLW,SR4  *R0
         B        *SR4
         PAGE
*                                   THIS ROUTINE READS IN THE CORE IMAGE
*                                   OF THE LIBRARY LOAD MODULE RELOCATES
*                                   IT AND EVALUATES ANY CORE EXP-
*                                    RESSIONS PERTAINING TO IT.
ADLDMD   EQU      %
         LW,D3    R1
*                                   FIND THE DUMMY CONTROL SECTION
*                                   INSERTED IN FRONT OF THIS MODULES
*                                   REF/DEF ENTRIES.
         BAL,SR4  DCS2
         STW,R5   FIRSTF
         LW,R1    D3
         PSW,R5   *R0                                                   730
         LW,D3    CSEG1
         STW,D3   XCSEG1
         LW,D3    *R5
         AND,D3   Y00C
         SLS,D3   -22
         LW,SR1   *R5
         AND,SR1  M16
         BNEZ     %+3
         PLW,R5   *R0
*                                   IN CASE THE MODULE IS ONLY DEFS.
*
         B        COREXP2+1
         SLS,SR1  1
         LW,R3    *R5               IF CSEC1 SPECIFIED & P.T.
         AND,R3   Y002                OF THIS LIBLMN = 0,
         SLS,R3   -21                 BIT 10 OF R/D ENTRY =1.
         AI,R5    K1
*                                   CALCULATE THE RELOCATION BIAS.
         LW,D4    *R5
         INT,R7   BUF+2
         SLS,R7   1
         SW,R7    D4
         LCW,R7   R7
         STW,R7   MBIAS
*                                   CALCULATE THE ADDRESS IN THE APPROP-
*                                   RIATE BUFFER TO READ THE CORE IMAGE
*                                   INTO = CSEC VALUE-SEG BASE +
*                                   BUFFER.
         LW,R6    CSEG1
         CI,R3    K1                UNLESS THIS IS LIB LMN
         BNE      %+3                 OF P.T. 0 WITH CSEC1
         LI,D3    0                   SPECIFIED, USE ITS
         B        %+2                 ACTUAL PROTECTION TYPE
*                                     FOR READING RECORDS.
         LW,R3    D3
         CI,R6    0
         BE       %+4
         LW,R7    CSEG00,R3         PICK UP PROPER CSEG
         LW,D1    CREL00,R3         (R3 CONTAINS PROTECTION TYPE)
         B        %+3
         LW,R7    RSEG00,R3
         LW,D1    RREL00,R3
         SLS,R7   -2
         STW,R7   FBIAS
         SLS,D1   -2
         SLS,D3   1
         AW,R6    D3
         AI,R6    00DIS
         INT,D2   *R6,R1
         SLS,D2   1
         STW,D2   BIAS
         LW,R4    D4
         SW,R4    D2
         AW,R4    R7
         LW,SR3   R4
         LW,SR4   LOCWD
         CI,SR4   K4000
*                                   IN EXTENDED MEMORY WE HAVE TO READ
*                                   THE IMAGE IN ABOVE THE EXPR STACK
*                                   IF THERE IS ROOM AND PUT EACH WORD
*                                   THRU THE XMEM LOGIC TO INSURE
*                                   THE RIGHT PAGE(S) BEING IN THE
*                                   XMEM BUFFERS.
         BAZ      ADXM1
         LW,R4    EXPRSTK
         AI,R4    1
         LW,R5    TOPOMEM
         AI,R5    KN3FE
         CI,SR4   K100
         BAZ      %+2
         AI,R5    K200
         SW,R5    SR1
         LW,R6    SR1
         SLS,R6   -3
         SW,R5    R6
         CW,R5    R4
         BGE      ADXM1
         AW,SR1   R6
         QUIT     ER19,,SR1
ADXM1    STW,R4   MODBAS
         LW,R5    CROM1
         AW,R5    R2
         MTB,1    *R5
         LW,R6    2,R5              SAVE 3RD WD OF ROMT ENTRY
         PSW,R6   *R0
         LB,R6    *R5
         AI,D3    K3
         STB,D3   *R5,R6
         PSW,R6   *R0
         LW,R6    SR1
         SLS,R6   2
         DO       MODE=1
         XW,R4    R5
         BAL,11   CHKLM
         XW,R4    R5
         REF      CHKLM
         FIN
*                                   READ THE IMAGE IN.
         CAL1,1   READLIB           READ VIA M:EF
         PLW,R6   *R0
         AI,D3    KN1
         STB,D3   *R5,R6
         LI,R6    K0
         LW,R7    D4
         SW,R7    D2
         DW,R6    X8
         AW,R7    D1
         SLS,R6   -1
*                                   IF NOT XMEM AND NOT ABS READ THE
*                                   REL DICT INTO ITS BUFFER.
*                                   IF XMEM READ IT IN ABOVE THE CORE
*                                   IMAGE. IF ABS READ IT IN ABOVE THE
*                                   EXPR STACK.
         LW,D1    LOCWD
         CI,D1    K4000
         BAZ      ADXM2
         LW,R7    MODBAS
         AW,R7    SR1
         B        READRLD
ADXM2    CI,D1    K100
         BAZ      READRLD
         LW,R7    EXPRSTK
         AI,R7    K1
         SLS,SR1  -2
         AW,R7    SR1
         SLS,R7   2
         CW,R7    CSEG00
         QUIT     ER1A,BLE,SR1
         SLS,R7   -2
         SW,R7    SR1
READRLD  EQU      %
         PSW,R4   *R0
         PSW,D4   *R0
         LI,D4    -3
         MSP,D4   *R0
         PLW,R4   *R0
         LW,R4    *R4
         AND,R4   M16
         LI,D4    4
         MSP,D4   *R0
         DO       MODE=1
         PSW,R5   *R0
         PSW,R6   *R0
         LW,5     7
         LW,6     4
         BAL,11   CHKLM
         PLW,6    *R0
         PLW,5    *R0
         FIN
*                                   READ THE REL DICT.
         CAL1,1   READREL
         PLW,D4   *R0
         PLW,R4   *R0
         PLW,D1   *R0               RESTORE 3RD WD OF ROMT ENTRY
         STW,D1   2,R5
         MTB,-1   *R5
         STW,R7   RELDBAS
         LW,R7    M:EF+4
         SLS,R7   -17
         AW,R7    R6
         STW,R7   MODSIZ
         AI,R6    KN1
         STW,R6   RDIG
*                                   RELOCATE THE IMAGE.
         BAL,SR4  RELOCATE
         LW,R4    SR3
         LW,D1    LOCWD
         CI,D1    K4000
         BAZ      ADXM3X
*                                   IF XMEM MOVE EACH WORD OF THE
*                                   RELOCATED IMAGE INTO THE XMEM
*                                   BUFFER.
         LW,SR2   M:EF+4
         SLS,SR2  -17
         SLS,SR2  1
         LW,D1    MODBAS
         LI,R5    0
ADXM4    LW,R7    R4
         BAL,SR4  XMEM
         LW,D2    *D1,R5
         STW,D2   *R6
         AI,R5    1
         CW,R5    SR2
         DO       MODE=1
         BGE      ADXM3X
         ELSE
         BGE      ADXM3
         FIN
         AI,R4    1
         B        ADXM4
         DO       MODE=0
*                                   IF XMEM, MOVE THE REL DIGITS TO THE
*                                   XMEM REL DICT BUFFER.
ADXM3    LW,R7    LOCWD
         CI,R7    K100              IS LOAD MODULE BEING GENERATED 'ABS'
         BANZ     ADXM3X            YES
         LW,R7    SR3               NO
         SLS,R7   2
         PSW,R1   *R0
         BAL,SR4  FNDRELDG          FIND CORE LOCATION FOR NEXT REL-DIC
         PLW,R1   *R0
         SLS,R6   -1
         SLS,R7   2
         LW,SR3   R7                MAKE CORE LOCATION A BYTE ADDRESS
         OR,SR3   R6
         LW,R4    RELDBAS
         SLS,R4   2
         AW,R4    RDIG              GET BYTE ADDRESS OF INPUT BUFFER
         LW,D1    MODSIZ
         AW,D1    SR3               ESTABLISH LOOP LIMIT
ADXM3I   LW,R7    SR3
         SLS,R7   -2                WORD LOC OF NEXT REL-DICT ITEM
         BAL,SR4  XMEM
         DATA     0                 SPECIFY REL-DICT TO XMEM
         AI,R4    1
         LB,D2    0,R4              GET NEXT BYTE OF LIBR REL-DICT
         LI,R7    K3
         AND,R7   SR3               BYTE OFFSET OF DESTINATION ADDRESS
         STB,D2   *R6,R7            PUT AWAY TWO DIGITS OF REL-DIC INFO
         AI,SR3   1                 BUMP CORE BYTE ADDRESS
         CW,SR3   D1
         BLE      ADXM3I
         FIN
*                                   FROM THE DUMMY LOAD MODULE CONTROL
*                                   SECTION GET THE BOUNDS OF THE EXPR
*                                   STACK AND EVALUATE THE CORE
*                                   EXPRESSIONS. ADJUST THE RELOCATION
*                                   DIGIT ACCORDING TO THE CORE EXPR.
ADXM3X   PLW,R5   *R0
         PSW,R2   *R0                                                   730
         LW,R6    CSEG1
         AW,R6    R1                                                    730
         INT,R6   EXPRDIS,R6
         SLS,R7   1                                                     730
         LW,R6    2,R5                                                  730
         LH,SR3   R6                                                    730
         BEZ      COREXP2
         AND,R6   M16                                                   730
         AW,R6    R7                                                    730
         AW,SR3   R6                                                    730
COREXP   LW,D3    *R6                                                   730
         CW,D3    Y004                                                  730
         BAZ      COREXP1                                               730
         PSW,R5   *R0                                                   730
         BAL,SR4  EVEXP1                                                730
         PLW,R5   *R0                                                   730
         LH,R7    *R6                                                   730
         AND,R7   M6                                                    730
         AI,R7    -2                                                    730
         LW,R2    *R6,R7                                                730
         LW,D2    R6
         AW,D2    R7
         AI,D2    K2                SAVE ADDR OF WORD1 IN D2 FOR WHATRES
         AW,R2    1,R5
         PSW,SR3  *R0                                                   730
         PSW,R7   *R0                                                   730
         PSW,R6   *R0                                                   730
         PSW,R1   *R0                                                   730
         LW,R6    *R5
         SLS,R6   -22
         AND,R6   M2
         LW,SR3   R6
         SLS,R6   1
         AI,R6    5
         AW,R6    CSEG1
         INT,R7   *R6,R1
         SLS,R7   1
         SW,R2    R7
         AI,SR3   CSEG00
         LW,R1    *SR3
         SLS,R1   -2                                                    730
         AW,R2    R1                                                    730
         LW,R7    LOCWD
         CI,R7    K100              IS LOAD MODULE BEING GENERATED 'ABS'
         BANZ     COREXP0           YES  -  REL-DICT DOES'T EXIST
         LI,R7    K1FFFF
         AND,R7   R2
         SLS,R7   2                 PHYS LOC OF LOAD ITEM IN BYTES
         BAL,SR4  FNDRELDG          GET PHYSICAL ADDRESS OF RELOC DIGIT
         LI,R1    K7
         SW,R1    R6                ADJUST DIGIT OFFSET FOR SHIFT COUNT
         SLS,R1   2
         DO       MODE=0
         BAL,SR4  XMEM
         DATA     0                 SPECIFY REL-DICT TO XMEM
         ELSE
         LW,R6    R7
         FIN
         LI,SR4   KF                SET UP DIGIT SELECT MASK
         LI,SR3   KE                COMPARE CHAR IS THE DIGIT 'E' (ABS)
         SLD,SR3  0,R1              SHIFT MASK AND DIGIT FOR COMPARISON
         CS,SR3   *R6               WITH CORRESPONDING RELOCATION DIGIT
         BNE      COREXP0           B IF DIGIT IS NOT E (ABSOLUTE)
         LCI      4                 ABSOLUTE--CHANGE TO PROPER RES.
         PSM,R2   *R0
         PSW,R1   *R0
         LW,R5    D2
         BAL,SR4  WHATRES+1         GO PICK UP RESOLUTION IN R2
         B        COREXPA           B IF RES. IS MIXED OR NONE
         PLW,R1   *R0
         LI,SR4   KF
         LW,SR3   R2
         SLD,SR3  0,R1              SHIFT RELOCATION DIGIT
         STS,SR3  *R6               STORE IN RELOCATION DICTIONARY
         B        %+2
COREXPA  PLW,R1   *R0
         LCI      4
         PLM,R2   *R0
COREXP0  EQU      %
         BAL,SR3  STOREFLDN                                             730
         PLW,R1   *R0                                                   730
         PLW,R6   *R0                                                   730
         PLW,R7   *R0                                                   730
         PLW,SR3  *R0                                                   730
COREXP1  LB,R7    *R6                                                   730
         AW,R6    R7                                                    730
         CW,R6    SR3                                                   730
         BNE      COREXP                                                730
COREXP2  EQU      %
         PLW,R2   *R0                                                   730
         PLW,SR4  *R0
         B        NEWROM
READLIB  GEN,8,24 X'10',M:EF
         DATA     X'7C000010'
         DATA     LIBERR,X'80000004',X'80000006',X'80000005',0
LIBERR   QUIT X'2F',,SR3            ABNORMAL I/O READING LIB LMN
*                                   THIS ROUTINE RELOCATES MODSIZ*2
*                                   WORDS STARTING AT MODBAS ACCORDING
*                                   TO THE RELOCATION DIGITS AT BYTE
*                                   RDIG WORD RELODBAS.
RELOCATE LW,D2    MODBAS
         LW,D1    RELDBAS
         LW,R4    RDIG
         LI,R5    KN1
NEXTRCD  AI,R4    K1
         CW,R4    MODSIZ
         BGE      *SR4
         LI,D4    K0
         LB,R6    *D1,R4
         SLS,R6   -4
NXTLDITM AI,R5    K1
         CI,R6    KE
         BE       NEXTRCD1
         CI,R6    K3
         BG       %+3
         LW,D3    MBIAS
         B        RELADD
         AND,R6   M3
         LW,SR2   *D2,R5
         CI,R6    K2
         BG       %+3
         LW,D3    MBIAS
         SLS,D3   -1
         B        RELAHALF,R6
NEXTRCD1 MTB,0    D4
         BNEZ     NEXTRCD
         MTB,1    D4
         LB,R6    *D1,R4
         AND,R6   M4
         B        NXTLDITM
RELADD   SLS,D3   15
         LW,SR2   *D2,R5
         SLD,SR1  13,R6
         AW,SR2   D3
         LCW,R6   R6
         SLD,SR1  -13,R6
         STW,SR2  *D2,R5
         B        NEXTRCD1
RELAHALF B        LEFTH
         B        RIGHTH
         B        BOTHHS
LEFTH    SLS,D3   16
         AW,SR2   D3
         B        RIGHTH3
RIGHTH   SLS,D3   16
RIGHTH2  SLD,SR1  16
         AW,SR2   D3
         SLD,SR1  -16
RIGHTH3  STW,SR2  *D2,R5
         B        NEXTRCD1
BOTHHS   SLS,D3   16
         AW,SR2   D3
         B        RIGHTH2
READREL  GEN,8,24 X'10',M:EF
         DATA     X'3C000010'
         DATA     X'80000007',X'80000004',X'80000005',X'80000006'
         PAGE
LP1      EQU      %
*                                   THIS IS THE OBJECT LANGUAGE PROCESSO
*                                   IT READS ONE OBJECT MODULE, FORMS
*                                   IMAGE AND RELOCATION DICTIONARY
*                                   AND RETURNS.
         PSW,SR4  *R0
         LW,D1    RFDFBAS
         LW,D2    DECLBAS
         LW,D3    R1
         LW,R1    DECLBAS
         SW,R1    DECLSTK
         MSP,R1   DECLSTK
         BAL,SR4  DCS2
         STW,R5   FIRSTF
         LW,R2    DECLSTK
         STW,R7   *R2
         LW,R5    CSEG1
         STW,R5   XCSEG1
*                                   THE OBJECT CONTROL BYTES ARE FETCHED
*                                   AND THE APPROPRIATE ROUTINE IS
*                                   CALLED.
LDR1     BAL,SR4  GBYTE
         CI,R5    K80
         BGE      LSREL
         CI,R5    X'13'
         BLE      ITEMV,R5
         CI,R5    X'1E'
         BE       PSECT
         LW,R1    R5
         SLS,R1   -4
         CI,R1    K4
         BE       LABS
         CI,R1    K5
         BE       LLREL
         B        ERAX
ITEMV    B        LDR1
         B        ERAX
         B        ERAX
         B        DDNAM
         B        ORG
         B        DPNAM
         B        DSNAM
         B        FIELD
         B        DFREF
         B        DDSECT
         B        DDEF
         B        DCS0
         B        DCS
         B        DSTART
         B        MODEND
         B        RLOAD
         B        DFREFH
         B        SD11
         B        SD12
         B        SD13
ERFX     QUIT     ERF,,SR4
ERBX     QUIT     ERB,,SR1
         PAGE
SD11     BAL,11   12BNUM
         BAL,11   GBYTE
         B        LDR1
SD12     EQU      %
         DO       SD=1
         MTW,0    SYMBOLTB          FORM IST
         BGEZ     SDKRD0            YES
SDKRD14  EQU      %
         FIN
         BAL,11   GBYTE             NO-SKIP THE LOAD ITEMS
         BAL,11   SKNAME
         BAL,11   EXPRSKP
         B        LDR1
SD13     BAL,11   SKNAME
         BAL,11   2BNUM
         B        LDR1
SKNAME   PSW,11   *R0
         BAL,11   GBYTE
         LW,1     5
         BAL,11   GBYTE
         BDR,1    %-1
         PLW,11   *R0
         B        *11
         PAGE
         DO       SD=1
SDKRD0   EQU      %
         LW,R3    SYMBOLTB
         AI,R3    -3                BASE OF NEW ENTRY
         CW,R3    EXPRSTK           ROOM FOR NEW ENTRY
         BG       SDKRD15           YES
         LI,R1    -1
         STW,R1   SYMBOLTB          NO-SET NO IST GENERATION
         B        SDKRD14              SKIP THIS AND FURTHER IST ENTRYS
SDKRD15  LI,R5    0
         STW,R5   0,R3
         STW,R5   1,R3              CLEAN OUT NAME FIELD
         BAL,SR4  GBYTE             GO-GET TYPE AND RESOLUTION
         SLS,R5   24
         STW,R5   2,R3              TYPE AND RESOLUTION INTO ENTRY
         BAL,SR4  GBYTE             GO-GET NAME LENGTH
         CI,R5    0
         BNE      %+2
         B        ERAX              ERROR-NAME LENGTH ZERO
         CI,R5    63
         BLE      %+2
         B        ERAX              ERROR-NAME LENGTH GT 63 BYTES
         STB,R5   *R3               TEXTC OF NAME FIELD
         LW,R6    R5
         CI,R6    7
         BLE      %+2
         LI,R6    7                 ALLOW NO MORE THAN 7 CHARS IN NAME
         LI,R1    1
SDKRD1   BAL,SR4  GBYTE
         STB,R5   *R3,R1
         AI,R1    1
         BDR,R6   SDKRD1            PUT FIRST 7 CHARS IN NAME FIELD
         LB,R6    *R3
         AI,R6    -7                MORE THAN 7 CHARS IN NAME
         BLEZ     SDKRD2            NO
         BAL,SR4  GBYTE             YES-BURN REMAINING CHARS
         BDR,R6   %-1
SDKRD2   LW,R1    SYMBOLTB
         LW,R5    M30               DO NOT CHECK TYPE
SDKRD3   CW,R1    SYMTOP            CHECKED ALL ENTRIES
         BGE      SDKRD6            YES
         LW,R4    0,R3
         CS,R4    0,R1              COUNT AND 3 CHARS MATCH
         BE       SDKRD5            YES
SDKRD4   AI,R1    3                 ADVANCE TO NEXT ENTRY
         B        SDKRD3
SDKRD5   LW,R4    1,R3
         CW,R4    1,R1              LAST 4 CHARS SAME
         BNE      SDKRD4            NO
         BAL,SR4  EXPRSKP           YES-SKIP EXPRESSION
         B        LDR1              GET NEXT LOAD ITEM
SDKRD6   LW,R7    SYMBOLTB
         AI,R7    -1                DESTINATION
         PSW,R3   *R0       SAVE NEW ENTRY BASE
         BAL,SR4  EXPRIN            GO-EVALUATE EXPRESSION
         PLW,R3   *R0               RESTORE BASE OF NEW ENTRY
         CI,SR3   0                 VALUE DEFINED
         BE       SDKRD11           YES
         LW,R1    Y8                NO-SET UNDEFINED ENTRY CODE
         STW,R1   2,R3                 AT 3RD WORD OF ENTRY
         B        SDKRD13
SDKRD11  LI,R5    SR2+1-3           SET AT R7
         BAL,SR4  WHATRES           GO GET RESOUTION IN R2
         B        SDKRD12           CONSTANT
         LW,R1    2,R3
         SLS,R1   -24
         AND,R1   M3                GET RESOLUTION OF IST ENTRY
         SW,R2    R1                GET SHIFT COUNT
         SLS,SR1  0,R2              SHIFT TO RESOLUTION OF ENTRY
         OR,SR1   2,R3
         STW,SR1  2,R3              PACK TOGETHER TYPE,RES,VALUE
         LW,R1    Y4
         STS,R1   0,R3              SET LOCATION SYMBOL CODE
         B        SDKRD13
SDKRD12  STW,SR1  2,R3              PUT CONSTANT VALUE IN ENTRY
         LW,R1    Y8
         STS,R1   0,R3              SET CONSTANT CODE
SDKRD13  LW,R1    EXPRSTK
         CI,SR3   0                 EXP STK POINTER AT TRUE SIZE
         BNE      SDKRD7            YES
         LI,R2    4                 NO-ADD SIZE OF ENTRY NOT IN STACK
         LB,R2    *EXPRSTK,R2
         AW,R1    R2
SDKRD7   CW,R1    R3                ROOM FOR NEW ENTRY IN IST
         BL       SDKRD8            YES
         LI,R1    -1
         STW,R1   SYMBOLTB          NO-SET NO IST GENERATION
         B        LDR1              GET NEXT LOAD ITEM
SDKRD8   MTW,-3   SYMBOLTB          POINT TO BASE OF NEW ENTRY
         B        LDR1              GET NEXT LOAD ITEM
         FIN
         PAGE
*                                   DECLARE DEF NAME: LOCATE THE NAME,
*                                     DECLARE IT AND MAP IT.
DDNAM    BAL,SR4  LOCRFDF
         BAL,SR4  ENDECL
         B        LDR1
         SPACE    10
*                                   ORIGIN: EVALUATE THE DEFINING
*                                     EXPRESSION.
ORG      BAL,SR4  EXPRIN
         CI,SR3   K0
*                                   IT MUST BE EVALUATABLE.
         BNE      ERFX
         LI,R5    SR3-3
         BAL,SR4  WHATRES
*                                   IT MUST HAVE RESOLUTION.
         B        ERFX
         SLS,SR1  0,R2
         STW,SR1  RLOC
*                                   DETERMINE WHICH SEGMENT AND
*                                   PROTECTION TYPE THE ORG VALUE IS IN.
         LW,R5    CSEG1
         BAL,SR4  WHICHPP
         B        CALCLOCC
         LI,R5    K0
         BAL,SR4  WHICHPP
         B        CALCLOCR
         B        ERFX
CALCLOCR LI,R6    RSEG00
         B        CALCLOC
CALCLOCC LI,R6    CSEG00
*                                   THE LOCATION COUNTER EQUALS ORG
*                                   VALUE - SEG BASE + BUFFER ADDRESS
*                                   IN BYTES.
CALCLOC  EQU      %
         STW,R5   XCSEG1            SAVE SEGMENT NO. FOR LOAD ITEMS
*                                   IN XMEM (IN CASE OF NON-ROOT DSECT).
         LW,R4    LOCCT
         AI,R4    TREEDIS
         AW,R5    *R4
         LI,R4    K3
         SW,R4    R2
         AI,R5    TREESIZE
         SLS,R2   1
         SW,R5    R2
         LW,R5    *R5
         AND,R5   M16
         DO       MODE=0
         SLS,R5   3
         ELSE
         SLS,R5   1
         STW,R5   BIAS              SAVE SEG BASE FOR XMEM
         SLS,R5   2
         FIN
         LCW,R5   R5
         AW,R5    *R6,R4
         AW,R5    SR1
         STW,R5   LOC
         DO       MODE=1
         LW,R5    *R6,R4
         SLS,R5   -2
         STW,R5   FBIAS             SAVE BUFFER ADDR FOR XMEM
         FIN
         B        LDR1
*                                   THIS ROUTINE CHECKS THE VALUE IN SR1
*                                   TO FIND OUT WHICH PROTECTION TYPE
*                                   OF A SEGMENT THE VALUE IS IN,
*                                   IF ANY. RETURN IS +1 IF NONE, +2
*                                   IF FOUND.
WHICHPP  LW,R4    LOCCT
         LW,R4    TREEDIS,R4
         AW,R4    R5
         AI,R4    00DIS
         LI,R2    K3
WHICHPP1 INT,R6   *R4
         LW,R6    *R4
         SLS,R6   -16
         SLD,R6   3
         AW,R6    R7
         AI,R6    -1
         CLR,R6   SR1
         BCR,9    WHICHPP2
         AI,R4    K2
         BDR,R2   WHICHPP1
         AI,SR4   K1
WHICHPP2 B        *SR4
         SPACE    10
*                                   DECLARE PRIMARY/SECONDARY
*                                   REFERENCE: LOCATE THE ENTRY AND
*                                   DECLARE IT.
DPNAM    BAL,SR4  LOCRFDF
         BAL,SR4  ENDECL
         B        LDR1
DSNAM    EQU      DPNAM
         SPACE    10
*                                   DEFINE FIELD: FETCH THE LOCATION
*                                     AND WIDTH.
FIELD    BAL,SR4  GBYTE
         LW,R6    R5
         BAL,SR4  GBYTE
         LW,R7    LOCWD
         CI,R7    K100
         BANZ     RELFLD2N
*                                   IF THE LOCATION IS RIGHT ADJUSTED
*                                   THE REL DIGIT WILL BE 0, 1, 2 OR 3.
*                                   INITIALIZE IT TO ZERO NOW. IF IT
*                                   IS EVEN TO BIT 15 THE DIGIT WILL BE
*                                   8, 9 OR A. OTHERWISE E FOR ABSOLUTE.
         LW,R7    R6
         AND,R7   M4
         CI,R7    KF
         BNE      RE
         LW,R7    LOC
         CI,R7    K1
         BANZ     RE
         AND,R7   M2
         LW,R4    R6
         SLS,R4   -4
         SLS,R4   1
         AND,R4   M2
         EOR,R7   R4
         BEZ      RELFLD1
         CI,R5    K10
         BE       R9
         LI,R4    0
         B        RELFLD2
RELFLD1  CI,R5    K10
         BE       R8
RE       LI,R4    KE
         B        RELFLD2
R9       LI,R4    K9
         B        RELFLD2
R8       LI,R4    K8
RELFLD2  STW,R4   RDIG
RELFLD2N EQU      %
*                                   A DESTINATION WORD IS FOUND FOR
*                                   THE EXPRESSION ABOUT TO BE READ.
*                                   ITS FORM IS:
*                                       BITS 0-7 FIELD WIDTH
*                                       BITS 8-14 BIT WITHIN THE WORD.
*                                       BITS 15-31 LOCATION OF WORD.
         LW,R2    LOC
         LI,R3    K0
         SLD,R2   -2
         SLS,R3   -27
         AW,R3    R6
         AI,R3    KN256
KN256    EQU      -256
TESTFLD  BGEZ     FORMCW
         AI,R2    KN1
         AI,R3    K20
         B        TESTFLD
FORMCW   SLS,R3   17
         OR,R2    R3
         STB,R5   R2
         LW,R7    R2
         PSW,R2   *R0
*                                   THE EXPRESSION DEFINING THE FIELD
*                                   IS EVALUATED.
         BAL,SR4  EXPRIN
         PLW,R2   *R0
         CI,SR3   K0
         BNE      FIELDEX           EXPRESSION DID NOT YIELD A VALUE
         LW,R7    LOCWD
         CI,R7    K100
         BANZ     STOREFLDN
*                                   IF THE EXPRESSION DID NOT YIELD A
*                                   VALUE (IT WAS IN TERMS OF A PREF)
*                                   LEAVE THE CORE EXPRESSION IN THE
*                                   STACK AND EXIT.
*                                   THIS LOGIC CALCULATES THE CORRECT
*                                   RELOCATION DIGIT ACCORDING TO THE
*                                   RIGHTMOST BIT OF THE FIELD (PRE-
*                                   VIOUSLY CONSIDERED WITH THE RESULT
*                                   SAVED IN RDIG), THE RESOLUTION OF
*                                   THE EXPRESSION AND ANY DIGIT
*                                   ALREADY ASSOCIATED WITH THE WORD IN
*                                   QUESTION.
RELFLD3  EQU      %
         PSW,R2   *R0
         AND,R2   M17
         SLS,R2   2
         LW,R7    R2
         LW,R2    RDIG
         BEZ      %+2
         AI,R7    2
         BAL,SR4  FNDRELDG
         SLS,R6   2
         LI,R5    SR2-2
         LI,R2    K0
         BAL,SR4  WHATRES
         B        %+2
         B        ADJR
         CI,R2    K0
*                                   IF THE EXPRESSION HAS NO RESOLUTION
*                                   THE WORD IS ABS.
         BE       RELFLD4
*                                   IF THE RESOLUTION IS MIXED THE
*                                   MODULE IS NOT RELOCATABLE AND IS
*                                   FORCED TO BE ABSOLUTE.
SETABS   LI,R5    K100
         LCI      8
         PSM,SR1  *R0
         BAL,SR4  BLANKER
         LW,R4    LOCCT
         STS,R5   *R4
         STS,R5   LOCWD
         LCI      11
         LM,R5    ABSMESS
         STM,R5   PBUF
         LW,R5    1,R4              ADDR TO ROMT
         AW,R5    CROM1             R5 POINTS TO CURRENT ROM NAME
         LCI      2
         LM,R5    *R5
         STM,R5   PBUF+11
         LI,R5    K40
         STB,R5   PBUF+11
         LI,R5    PBUF
         CAL1,2   PRINT
         LCI      8
         PLM,SR1  *R0
         B        STOREFLD
ABSMESS  DATA     X'5340D3D6'
         TEXT     'AD MODULE FORCED ABS WHEN PROCESSING ROM'
RELFLD4  LI,R5    KE
         B        PUTDIGIT
*                                   THE EXPRESSION HAS RESOLUTION.
ADJR     LW,R5    RDIG
         CI,R5    KE
*                                   THE FIELD WAS NOT ON A WORD OR
*                                   HALF WORD BOUNDARY - THE WORD IS
*                                   ABS.
         BE       SETABS
         CI,R5    K0
         BNE      RELHALF
*                                   THE FIELD WAS ON A WORD BOUNDARY.
*                                   THE RELOCATION DIGIT IS THE
*                                   RESOLUTION.
         AW,R5    R2
         B        PUTDIGIT
RELHALF  EQU      %
*                                   THE FIELD WAS ON A HALF WORD
*                                   BOUNDARY WITH A WIDTH OF 16 BITS.
*                                   CHECK THE DIGIT ALREADY ASSOCIATED
*                                   WITH THE WORD IN CASE BOTH
*                                   HALVES NEED TO BE RELOCATED. ALSO
*                                   THE RESOLUTION MUST BE DOUBLE
*                                   WORD.
         DO       MODE=0
         LCI      2
         PSM,R6   *R0
         BAL,SR4  XMEM
         DATA     0                 SUPPLY ZERO AS RELDICT FLAG FOR XMEM
         LW,D1    *R6
         LCI      2
         PLM,R6   *R0
         ELSE
         LW,D1    *R7
         FIN
         SLS,D1   -28,R6
         AND,D1   M4
         CI,D1    K0
         BE       PUTDIGIT
         CI,D1    K8
         BL       SETABS
         BE       RD9
         CI,D1    K9
         BE       RD8
         B        PUTDIGIT
RD9      CI,R5    K9
         BE       RA
         B        PUTDIGIT
RD8      CI,R5    K8
         BNE      PUTDIGIT
RA       LI,R5    KA
*                                   THE RELOCATION DIGIT IS STORED AWAY-
*                                   THROUGH EXTENDED MEMORY LOGIC IF
*                                   NECESSARY.
PUTDIGIT LW,R4    R5
         LI,R5    KF
         LCW,R6   R6
         SLD,R4   28,R6
         DO       MODE=0
PUTDIGX  BAL,SR4  XMEM
         DATA     0                 SUPPLY ZERO AS RELDICT FLAG FOR XMEM
         STS,R4   *R6
         ELSE
PUTDIGX  STS,R4   *R7
         FIN
STOREFLD LI,SR3   0                                                     730
         PLW,R2   *R0                                                   730
STOREFLDN EQU     %
*                                   THE DESTINATION WORD IS DECODED
*                                   AND THE FIELD ADDED TO THE
*                                   APPROPRIATE BITS OF THE APPROPRIATE
*                                   WORD(S).
         LCI      3
         PSM,D1   *R0
         LB,R1    R2
         LH,R4    R2
         SLS,R4   -1
         AND,R4   M7
         AI,R4    K1
         LI,D2    K0
         LI,SR2   K0
         LI,D1    K1
FLDLOP1  SLD,SR1  -1
         SCS,D1   -1
         BDR,R4   FLDLOP1
FLDLOP2  OR,D2    D1
         SCS,D1   1
         BCR,8    FLDLOP3
         CI,R1    1
         BG       FLDRET1
         LI,SR4   FLDRET2
         B        STORFLD
FLDRET1  EQU      %
         LI,SR4   FLDLOP3
STORFLD  LW,D4    D2
         LI,D3    K0
         LW,R7    R2
         PSW,SR4  *R0
         BAL,SR4  XMEM
         PLW,SR4  *R0
         AND,D4   *R6
         AD,SR1   D3
         AND,SR2  D2
         EOR,D2   M32
         AND,D2   *R6
         OR,D2    SR2
         STW,D2   *R6
         AI,R2    KN1
         LW,SR2   SR1
         LI,SR1   K0
         LI,D2    K0
         B        *SR4
FLDLOP3  BDR,R1   FLDLOP2
         BAL,SR4  STORFLD
FLDRET2  EQU      %
         LCI      K3
         PLM,D1   *R0
         CI,SR3   0                                                     730
         BNE      *SR3                                                  730
         LW,R1    LOCWD
         CW,R1    RFLDMODS          CHECK FOR BREF OR REF LOADING MODE
         DO       MODE=1
         BANZ     FLDRET4
         MTW,0    MREFLAG
         BEZ      FIELDEX
         MTW,0    RFLDSG
         BLZ      FIELDEX
         B        %+3
FLDRET4  EQU      %
         FIN
*                                   IF REFERENCE LOADING WAS
*                                   SPECIFIED WE HAVE TO CALCULATE
*                                   THE PLIST AND PUT EACH WORD
*                                   THROUGH EXTENDED MEMORY LOGIC.
         MTW,0    RFLDSG            CAN REF'D WORD INDUCE AN OVERLAY
         BEZ      FIELDEX           BRANCH IF IT CAN'T
         LW,R5    D3
         LW,SR3   RFLOADIS,R5       GET NEXT AVAIL SLOT IN REF LOAD TBL
         LW,SR2   RFLDSG
         LW,R7    LOC
         SLS,R7   -2
         AI,R7    -1                R7=LDR LOC OF WD WITH INTER-SEG REF
         BAL,SR4  XMEM              GET MEMORY PAGE CONTAINING THIS LOC
         CW,R1    BREFBIT           IS BREF LOADING MODE IN EFFECT
         BANZ     BREFMODE           YES - BRANCH TO BREF LDTBL LOGIC
         DO       MODE=1
         MTW,0    MREFLAG
         BNEZ     MREFMODE
         FIN
         AW,SR2   TREEPTR
         AI,SR2   1                                                     729
         AW,SR3   Y048                                                  729
         XW,SR3   *R6
         LW,SR4   RLOC
         SLS,SR4  -2                                                    729
         AW,SR4   Y68
         LI,R1    4                 SET R1 FOR A 4 WD ENTRY IN RFLDTBL
         LW,SR1   Y018
         B        BLDLDTBL           GO PUT ENTRY INTO REF LD TABLE
BREFMODE LB,R1    *R6               BREF LOADING MODE
         AND,R1   M7                GET OP CODE OF INSTR HAVING REF
         CI,R1    X'64'
         BL       NOBRANCH          AND VERIFY THAT IT IS A BRANCH
         CI,R1    X'6A'
         BG       NOBRANCH
         SLS,R1   -1
         CI,R1    X'33'
         BE       NOBRANCH
         LW,SR4   Y7FF
         LS,SR3   *R6               BUILD INSTR FOR WD HAVING REFERENCE
         XW,SR3   *R6               REPLACE REFERENCING WORD
         DH,SR2   Y000B
         SCS,SR2  -12               COMPOSE PARAMETER WD FOR REF LD TBL
         LS,SR3   SR2
         LW,SR2   SR3
         LW,R1    DOREFPTR          POINT R1 AT M:DO IN REF/DEF STACK
         LW,SR1   -4,R1             GET S:OVRLY LOC FROM VALUE WORD
         SLS,SR1  -2                CONVERT TO WORD ADDRESS
         OR,SR1   Y6A               COMPOSE 'BAL,R0   S:OVRLY'
         LI,R1    2                 SET R1 FOR 2 WORD ENTRY IN TABLE
         DO       MODE=1
         B        BLDLDTBL
MREFMODE EQU      %                 MREF LOADING MODE
         DH,SR2   Y000B
         SCS,SR2  -8                COMPOSE SEG#,0,0,ADDR
         INT,SR4  *R6
         AW,SR2   SR4
         LW,SR1   Y0F               COMPOSE XPSD T:OVBALPSD
         LB,R1    *R6                 OR XPSD T:OVBPSD INSTR
         AND,R1   M7
         CI,R1    X'6A'
         BNE      NONBAL
         LI,R1    1
         LB,SR4   *R6,R1            REG FROM THE BAL INSTR
         SCS,SR4  -16
         AW,SR2   SR4               SEG#,REG,0,ADDR
         LW,R4    TOVBALPSD
         B        %+2
NONBAL   LW,R4    TOVBPSD
         AW,R4    RFDFBAS
         LW,R7    1,R4              RESOLUTION
         LW,R4    *R4               VALUE
         LI,R1    K5
         CW,R7    MREFRES-1,R1      SHIFT VALUE WD OF
         BE       %+2               T:OVBALPSD OR T:OVBPSD
         BDR,R1   %-2               ACCORDING TO RESOLUTION
         EXU      MREFSLS-1,R1
         AW,SR1   R4
         LI,R1    2                 FOR 2 WD ENTRY IN MREF TABLE
*                                   CHECK FOR IDENTICAL MREF
*                                   TABLE ENTRY & USE IF FOUND.
         LW,R4    RFLOADIS,R5
         CW,R4    RFLDTBSZ          CK FOR MREF TABLE OVERFLOW
         BGE      REFOVFLW
         LW,R7    LOADBAS           START OF DATA
         XW,R7    BIAS
         PSW,R7   *R0               SAVE BIAS, FBIAS & XCSEG1
         LW,R7    RSEG00            & GIVE NEW VALUES FOR READING
         SLS,R7   -2                A WD OF THE MREF TABLE.
         XW,R7    FBIAS
         PSW,R7   *R0
         LI,R7    0
         XW,R7    XCSEG1
         PSW,R7   *R0
         LW,R7    MREFTAB
         AW,R7    RFDFBAS
         LW,R7    *R7               START OF MREF TABLE
         SW,R7    BIAS
         AW,R7    FBIAS
DONTDUP  AI,R7    K1
         PSW,R7   *R0
         BAL,SR4  XMEM              SEARCH FOR AN ENTRY WHOSE 2ND
         PLW,R7   *R0               WD LOOKS LIKE SR2.
         LW,R4    R7
         AI,R4    KN1
         SW,R4    FBIAS
         AW,R4    BIAS
         CW,R4    SR3               SR3=CURRENT POSITION IN TABLE
         BE       MREFSTOR
         LW,SR4   *R6
         CW,SR4   SR2
         BE       USEOLD
         AI,R4    K2
         CW,R4    RFLOADIS,R5
         BL       DONTDUP
         LW,R7    R4
         AI,R7    K1
         SW,R7    BIAS
         AW,R7    FBIAS
         PSW,R7   *R0
         BAL,SR4  XMEM
         PLW,R7   *R0
MREFSTOR STW,SR2  *R6               ADD NEW ENTRY TO MREF TABLE.
         AI,R7    KN1               WD 2: SEG#,REG OR 0,0,ADDR
         BAL,SR4  XMEM
         STW,SR1  *R6               WD 1: XPSD T:OVB....
         MTW,2    RFLOADIS,R5       UPDATE POINTER TO NEXT ENTRY
USEOLD   LW,R7    LOC
         SLS,R7   -2
         AI,R7    KN1
         LCI      3
         PLM,SR1  *R0
         STW,SR1  BIAS
         STW,SR2  FBIAS
         STW,SR3  XCSEG1
         BAL,SR4  XMEM
         LI,SR3   K0
         LW,SR4   MN16
         LS,SR3   *R6               REPLACE ORIGINAL REFERENCING WD
         AW,SR3   R4                REQUIRING MREF TABLE ENTRY W/
         STW,SR3  *R6               NEW WD REFERENCING MREF TABLE.
         B        FIELDEX
         FIN
BLDLDTBL LW,R4    RFLOADIS,R5
         CW,R4    RFLDTBSZ          CHECK FOR RF LOAD TABLE OVERFLOW
         BGE      REFOVFLW
         INT,R7   01DIS,R5          TABL ADDR REL. TO LOADER IN R4
         SLS,R7   1
         SW,R4    R7
         DO       MODE=1
         XW,R7    BIAS              USE  ROOT 01 BASE FOR XMEM
         PSW,R7   *R0               AND SAVE CURRENT SEG BASE
         FIN
         LW,R7    RSEG01
         SLS,R7   -2
         AW,R4    R7
         DO       MODE=1
         XW,R7    FBIAS             USE  RSEG01 BASE FOR XMEM
         PSW,R7   *R0               AND SAVE CURRENT BUFFER BASE
         FIN
         AWM,R1   RFLOADIS,R5       UPDATE ENTRY POS OF REF LOAD TABLE
         AI,R4    -1                DECR R4 FOR VECTOR ADDRESSING
         LI,R5    0
         XW,R5    XCSEG1            SAVE CURRENT SEG NO.  AND
         PSW,R5   *R0               SET FOR UPDATING THE ROOT
RFLDTAB  EQU      %
         LW,R7    R4
         AW,R7    R1
         LW,R5    R7,R1             R5 = NEXT WORD OF ENTRY
         BAL,SR4  XMEM
         STW,R5   *R6
         BDR,R1   RFLDTAB
         DO       MODE=1
         LCI      3
         PLM,R5   *R0               RESTORE PREVIOUS XMEM VARIABLES
         STW,R5   BIAS
         STW,R6   FBIAS
         STW,R7   XCSEG1
         ELSE
         PLW,R5   *R0
         STW,R5   XCSEG1
         FIN
*                                   THE FIELD ROUTINE EXIT.
FIELDEX  LW,R1    BFR
         CI,R1    BUF
         BNE      FIELDFB1
         B        LDR1
Y6A      DATA     X'6A000000'
Y7FF     DATA     X'7FF00000'
         DO       MODE=1
MREFRES  DATA     X'01000000'
         DATA     X'00010000'
         DATA     X'00000100'
         DATA     X'00000001'
         DATA     X'00000000'
MREFSLS  SLS,R4   -2
         SLS,R4   -1
         SLS,R4   0
         SLS,R4   1
         SLS,R4   0
         FIN
NOBRANCH LI,R1    X'10000'         BUMP COUNT OF NON-BRANCHING REF'S
         B        %+2
REFOVFLW LI,R1    1                BUMP COUNT OF REF'S OVERFLOWING TABLE
         AWM,R1   BREFERR
         B        FIELDEX
         SPACE    10
*                                   DEFINE FORWARD REFERENCE AND HOLD:
*                                   THE 2 BYTE FREF # IS FETCHED
*                                   AND THE ENTRY IS LOCATED IN THE
*                                   REF/DEF STACK AND MARKED "HELD"
*                                   WITH A HIGH-ORDER F. THE DEFINING
*                                   EXPRESSION IS IGNORED.
DFREFH   BAL,SR4  2BNUM
         BAL,SR4  CHKFREF
         AI,R5    K3
         LI,R4    X'F0'
         STB,R4   *R5
         BAL,SR4  EXPRSKP
         B        LDR1
         SPACE    10
*                                   DEFINE FORWARD REFERENCE: SAME AS
*                                     ABOVE EXCEPT A HIGH ORDER FF
*                                     MARKS THE ENTRY "USED".
DFREF    BAL,SR4  2BNUM
         BAL,SR4  CHKFREF
         AI,R5    K3
         LI,R7    KFF
         STB,R7   *R5
         BAL,SR4  EXPRSKP
         B        LDR1
         SPACE    10
*                                   DEFINE DUMMY SECTION: THE DECLAR-
*                                     ATION # IS FETCHED AND THE
*                                     DSECT IS DECLARED. THE SIZE AND
*                                     PROTECTION ARE SKIPPED.
DDSECT   BAL,SR4  12BNUM
         LW,R7    *D2,R7
         BAL,SR4  ENDECL
         BAL,SR4  3BNUM
         B        LDR1
         SPACE    10
*                                   DEFINE DEF: THE DECLARATION # AND
*                                     EXPRESSION ARE IGNORED.
DDEF     BAL,SR4  12BNUM
         BAL,SR4  EXPRSKP
         B        LDR1
         SPACE    10
*                                   DECLARE CONTROL SECTION 0: THE SIZE
*                                     AND PROTECTION ARE IGNORED. THE
*                                     0TH ENTRY OF THE DECLARATION
*                                     STACK IS PICKED UP AND THE
*                                     CONTROL SECTION IS MAPPED.
DCS0     BAL,SR4  3BNUM
         LW,R7    DECLBAS
         LW,R7    *R7
         B        LDR1
         SPACE    10
PSECT    EQU      DCS
*                                   DECLARE CONTROL SECTION: THE NEXT
*                                     CONTROL SECTION IN THE REF/DEF
*                                     STACK IS LOCATED AND CHANGED
*                                     FROM TYPE 4 TO 6 SO IT WONT BE USE
*                                     AGAIN. THE CONTROL SECTION IS
*                                     DECLARED,MAPPED, AND THE SIZE AND
*                                     PROTECTION IGNORED.
DCS      LI,SR4   K0
DCS2     LW,R6    CSEG1
         AI,R6    RFDFDIS
         INT,R5   *D3,R6
         SLS,R5   1
         STW,R5   R1
DCS1     LW,R6    *R5
         LB,R7    R6
         AW,R5    R7
         AND,R6   Y000F
         CW,R6    Y0004
         BE       %+3
         CW,R6    Y000C
         BNE      DCS1
         DO       MODE=1
         MTW,0    MREFLAG
         BEZ      DCS18
         LW,R6    RFDFBAS           IF CURRENT CSECT ENTRY
         AW,R6    MREFTAB            IS FOR THE MREF TABLE,
         AI,R6    KN1                FLAG IT TYPE=6 AND
         SW,R5    R7                 PROCEED TO NEXT ENTRY.
         CW,R6    R5                OTHERWISE, FLAG AND USE
         BNE      DCS19              CURRENT ENTRY.
         LW,R6    R7
         LW,R7    Y0006
         STS,R7   *R5
         SW,R5    R6
         B        DCS1
DCS18    EQU      %
         FIN
         SW,R5    R7
DCS19    EQU      %
         LW,R7    Y0006
         STS,R7   *R5
         LW,R7    R5
         SW,R7    R1
         LW,R6    CSEG1
         STH,R6   R7
         CI,SR4   K0
         BNE      *SR4
         BAL,SR4  ENDECL
         BAL,SR4  3BNUM
         B        LDR1
         SPACE    10
*                                   DEFINE START: THE EXPR DEFINING
*                                     THE START ADDRESS IS EVALUATED AND
*                                     SAVED.
DSTART   BAL,SR4  EXPRIN
         LI,R5    SR2-2
         BAL,SR4  WHATRES
         B        ERBX
         SLS,SR1  -2,R2             SHIFT TO WORD RESOLUTION
         STW,SR1  START
         B        LDR1
         SPACE    10
*                                   MODULE END: THE SECURITY LEVEL IS
*                                     CHECKED. ALSO THIS MUST BE THE
*                                     LAST CARD OF THE MODULE.
MODEND   BAL,SR4  GBYTE
         CW,R5    SEVLEV
         BLE      %+2
         STW,R5   SEVLEV
         LW,R1    LASTCARD
         QUIT     ERC,BNEZ
*                                   LP1 EXITS.
         DO       SD=1
         MTW,0    SYMBOLTB          FORM IST
         BLZ      SDKRD10           NO
         LW,R6    SYMTOP
         SW,R6    SYMBOLTB          WRITE OUT IST
         BEZ      SDKRD10           NO
         SLS,R6   2                 BYTES IN IST
         LW,R7    LOCCT
         AI,R7    1
         LW,R7    *R7               ((LOCCT)+1)+(CROM1)=ADDRESS OF
         AW,R7    CROM1                 TEXTC ROM NAME
         MTB,1    *R7
         LB,R1    *R7
         LI,R2    X'10'             IST CODE
         STB,R2   *R7,R1            AT END OF IST KEY
         LW,R5    SYMBOLTB          IST BUFFER ADDRESS
         CAL1,1   WRITELM           GO-WRITE THE IST RECORD
         MTB,-1   *R7               RESTORE THE ROM FILE NAME
         LW,R1    SYMBOLTB
         CW,R1    BSEG2
         BGE      %+2
         STW,R1   BSEG2             KEEP LARGEST IST SIZE
         LW,R1    SYMTOP
         STW,R1   SYMBOLTB          RESET IST
SDKRD10  EQU      %
         FIN
         PLW,SR4  *R0
         B        *SR4
         SPACE    10
         PAGE
*                                   REPEAT LOAD: THE REPEAT COUNT IS
*                                     FETCHED. THE NEXT BYTE IS
*                                     INTERUPTED AND THE APPROXIMATE
*                                     LOAD ITEM ROUTINE IS ENTERED.
RLOAD    BAL,SR4  2BNUM
         LW,SR2   R7
         QUIT     ERD,BNEZ
         BAL,SR4  GBYTE
         LW,R1    R5
         SLS,R1   -4
         CI,R1    K8
         BGE      LSREL1
         CI,R1    K4
         BE       LABS1
         CI,R1    K5
         BE       LLREL1
         B        ERAX
         PAGE
*                                   LOAD ABSOLUTE ITEM:
LABS     LI,SR2   K1
LABS1    LCI      K3
         PSM,D1   *R0
         AND,R5   M4
         BNEZ     LABS2
*                                   0 BYTES IMPLIES 16
         LI,R5    K10
LABS2    LW,R7    R5
         PSW,R7   *R0
         LI,R6    K0
*                                   THE BYTES ARE FETCHED AND PUT INTO
*                                   D1-D4 IN CASES OF A REPEAT LOAD.
LABS3    BAL,SR4  GBYTE
         STB,R5   D1,R6
         AI,R6    K1
         BDR,R7   LABS3
LABS4    LW,R7    *R0
         LW,R7    *R7
         LI,R5    K0
LABS5    PSW,R7   *R0
*                                   EACH BYTE IS STORED INTO THE BUFFER
*                                   THROUGH THE EXTENDED MEMORY LOGIC.
         LW,R7    LOC
         LW,R4    M2
         AND,R4   R7
         SLS,R7   -2
         BAL,SR4  XMEM
         SLS,R6   2
         OR,R6    R4
         LB,R2    D1,R5
         STB,R2   0,R6
         LW,R4    LOCWD
         CI,R4    K100
         BANZ     LABS6
*                                   UNLESS ABS WAS SPECIFIED THE
*                                   RELOCATION DIGIT (E FOR ABS) IS
*                                   PLACED IN THE BUFFER.
         PSW,R5   *R0
         LW,R7    LOC
         BAL,SR4  FNDRELDG
         LI,R5    KF
         LCW,R6   R6
         SLS,R6   2
         SLS,R5   28,R6
         DO       MODE=0
         PSW,R6   *R0
         BAL,SR4  XMEM
         DATA     0                 SUPPLY ZERO AS RELDICT FLAG FOR XMEM
         PLW,R7   *R0
         ELSE
         XW,R7    R6
         FIN
         AND,R5   *R6
         BNEZ     LABS6-1
         LI,R4    KE
         LI,R5    KF
         SLD,R4   28,R7
         STS,R4   *R6
         PLW,R5   *R0
LABS6    LI,R6    K1
         BAL,SR4  INCLOC
         AI,R5    K1
         PLW,R7   *R0
*                                   REPEAT FOR THE SPECIFIED # OF BYTES.
         BDR,R7   LABS5
*                                   REPEAT FOR THE REPEAT LOAD COUNT.
         BDR,SR2  LABS4
         PLW,R7   *R0
         LCI      K3
         PLM,D1   *R0
         B        LDR1
         PAGE
*                                   LOAD LONG FORM RELOCATABLE: THE CODE
*                                     BITS ARE DECODED AND THE DECLAR-
*                                     ATION # PICKED UP. A FIELD TYPE
*                                     EXPRESSION IS CREATED IN BUF2. THE
*                                     4-BYTE LOAD ITEM IS STORED INTO
*                                     THE BUFFER AND THE FIELD LOGIC IS
*                                     CALLED TO ADD THE VALUE OF THE
*                                     DECLARATION.
LLREL    LI,SR2   K1
LLREL1   LI,D4    BUF2
         LI,R2    K3
         LW,R6    R5
         CI,R5    K4
         BANZ     LLREL2
         LI,R4    K20
         B        LLREL3
LLREL2   LI,R4    K24
LLREL3   STB,R4   *D4,R2
         CI,R5    K8
         BANZ     LLREL4
         BAL,SR4  2BNUM
LLREL6   SLS,R7   16
         LB,R4    *D4,R2
         CI,R4    K4
         BANZ     LLREL10
         LW,R4    DECLSTK1
         AND,R4   M15
         CI,R4    K100
         BG       LLREL10
         SLS,R7   8
LLREL10  LI,R5    K2
         LI,R1    K5
LLREL9   LB,R4    R6,R1
         STB,R4   *D4,R1
         BDR,R1   %+1
         BDR,R5   LLREL9
         B        LLREL5
LLREL4   BAL,SR4  GBYTE
LLREL8   LW,R7    R5
         B        LLREL6
LLREL5   AND,R6   M2
         LW,R5    R6
         STS,R5   *D4
         LI,R5    K13
         SW,R5    R6
         MTW,-1   R2
         STB,R5   *D4,R2
         MTW,-1   R2
         LI,R5    KFF
         STB,R5   *D4,R2
         LI,R5    K2
         MTW,5    R2
         STB,R5   *D4,R2
         BAL,SR4  4BNUM
         LW,R4    R7
LLREL7   LW,R7    LOC
         CI,R7    K3
         QUIT     ERE,BAZ,R7
         SLS,R7   -2
         BAL,SR4  XMEM
         STW,R4   *R6
         LI,R6    K4
         BAL,SR4  INCLOC
         PSW,SR2  *R0
         PSW,R4   *R0
         BAL,SR4  FIELDFB
         PLW,R4   *R0
         PLW,SR2  *R0
         BDR,SR2  LLREL7
         B        LDR1
         SPACE    10
*                                   LOAD SHORT FORM RELOCATABLE: THE
*                                     DIFFERENCE BETWEEN THE SHORT AND
*                                     LONG FORM ARE ALLOWED FOR AND
*                                     THE LONG FORM LOGIC IS USED.
LSREL    LI,SR2   K1
LSREL1   LI,D4    BUF2
         LI,R2    K3
         CI,R5    K40
         BANZ     LSREL2
         LI,R4    K22
         B        LSREL3
LSREL2   LI,R4    K26
LSREL3   STB,R4   *D4,R2
         AND,R5   M6
         LI,R6    K2
         B        LLREL8
         PAGE
*                                   THIS ROUTINE SWITCHES PARAMETERS SO
*                                   GBYTE WILL FETCH BYTES FROM BUF2
*                                   RATHER THAN FROM THE NEXT BYTES IN
*                                   THE CARD IMAGE BUFFER.
FIELDFB  PSW,SR4  *R0
         LI,R1    K120
         XW,R1    RCDSIZE
         LI,R2    K0
         XW,R2    CURBYTE
         LI,R4    BUF2
         XW,R4    BFR
         LCI      4
         PSM,R1   *R0
         B        FIELD
FIELDFB1 LCI      4
         PLM,R1   *R0
         XW,R1    RCDSIZE
         XW,R2    CURBYTE
         XW,R4    BFR
         PLW,SR4  *R0
         B        *SR4
         PAGE
*                                   THIS ROUTINE EVALUATES AN EXPRESSION
*                                   IN THE OBJECT LANGUAGE. IT INITIAL-
*                                   IZES A STACK ENTRY JUST ABOVE THE
*                                   EXPR. STACK WITH THE GIVEN
*                                   DESTINATION WORD (R7),A 0 RESOLUTION
*                                   AND A 03430000 1ST WORD (3 WORD
*                                   ENTRY, CORE EXPRESSION, 3 WORDS TO
*                                   THE 1ST VALUE ENTRY, NO CONTROL
*                                   BYTES).
EXPRIN   PSW,SR4  *R0
         LI,SR2   K0
         DO       MODE=1
         MTW,0    MREFLAG
         BEZ      EXPRIN06
         LW,SR3   Y8                SEE GETVAL
         STW,SR3  RFLDSG
         B        EXPRIN08
         FIN
EXPRIN06 EQU      %
         STW,SR2  RFLDSG
EXPRIN08 EQU      %
         LI,SR3   K0
         LW,D4    EXPRSTK
         AI,D4    K3
         STW,SR2  *D4
         AI,D4    KN1
         STW,R7   *D4
         LW,R6    Y0343
         AI,D4    KN1
         STW,R6   *D4
         LI,R6    K1
         LI,SR1   K0
*                                   FETCH AN EXPRESSION CONTROL BYTE.
EXPRIN1  BAL,SR4  GBYTE
         CI,R5    K0
         BE       EXPRIN1
PUTBYTE  AI,R6    K1
         LI,R1    K3
         AND,R1   R6
         BNEZ     PUTBYTE1
*                                   IF THERE IS NOT ENOUGH ROOM FOR
*                                   THE CONTROL BYTE MOVE THE WORDS
*                                   IN THE EXPRESSION UP.
         LW,D4    EXPRSTK
         AI,D4    K1
         LW,R7    D4
         LH,R2    *D4
         AND,R2   M5                PICK UP DISP
         AW,R7    R2
         AI,R7    KN3               BASE FOR MOVING WDS IN R7
         LB,R1    *D4
         SW,R1    R2                # OF WDS TO BE MOVED IS
         AI,R1    K2                # OF WDS IN EXPR - DISP + 2
         MTH,1    *D4               INC. DISP
         MTB,1    *D4               INC. # OF WDS IN EXPR
         LW,R2    R7
         AI,R2    K1
PUTBYTE2 LW,R4    *R7,R1
         STW,R4   *R2,R1
         BDR,R1   PUTBYTE2
*                                   SAVE THE CONTROL BYTE.
PUTBYTE1 STB,R5   *D4,R6
*                                   CALL THE APPROPRIATE ROUTINE.
WHATEC   CI,R5    K1
         BE       ADCON1
         CI,R5    K2
         BE       EXPREND1
         LW,R1    R5
         SLS,R1   -2
         CI,R1    KE
         BE       SUBABS
         CI,R1    K8
         BE       ADDECL1
         CI,R1    K9
         BE       ADFREF1
         CI,R1    KA
         BE       SBDECL1
         CI,R1    KB
         BE       SBFREF1
         CI,R1    KC
         BE       CHGRES1
         CI,R1    KD
         BE       ADDABS
         B        ERAX
*                                   ADD DECLARATION: FETCH THE
*                                     DECLARATION # AND GET ITS VALUE.
ADDECL1  BAL,SR4  12BNUM
         MTW,0    SR2
         BNEZ     EXPRSKP1
         BAL,SR4  DECLCHK
         LW,R7    *D2,R7
         B        GETVAL
SBDECL1  EQU      ADDECL1
*                                   ADD FORWARD REFERENCE: FETCH THE
*                                     FORWARD REFERENCE #, LOCATE IT AND
*                                     GET ITS VALUE.
ADFREF1  BAL,SR4  2BNUM
         MTW,0    SR2
         BNEZ     EXPRSKP1
         PSW,R6   *R0
         BAL,SR4  CHKFREF
         PLW,R6   *R0
         B        GETVAL
SBFREF1  EQU      ADFREF1
*                                   ADD CONSTANT: FETCH THE CONSTANT AND
*                                     ADD IT TO THE EXP ACCUMULATOR
ADCON1   BAL,SR4  4BNUM
         MTW,0    SR2
         BNEZ     EXPRSKP1
         AW,SR1   R7
*                                   THIS ROUTINE SAVES THE CONSTANT
*                                     OR DECLARATION IN THE EXPRESSION
*                                     ENTRY BEING BUILT.
PTWRD    LW,D4    EXPRSTK
         AI,D4    K1
         LB,R1    *D4
         MTB,1    *D4
         STW,R7   *D4,R1
         B        EXPRIN1
ADDABS   EQU      %
         MTW,0    SR2
         BNEZ     EXPRSKP1
         LW,R1    R5
*                                   ADD ABS: ADD OR SUBTRACT A 1 TO THE
*                                     APPROPRIATE RESOLUTION BYTE OF THE
*                                     EXPRESSION.
         AND,R1   M2
         AI,R1    K1
         MI,R1    KN8
         LI,R2    K1
         AND,R1   D27F
         S,R2     *R1
         CI,R5    K4
         BAZ      %+2
         LCW,R2   R2
         LW,R5    EXPRSTK
         AI,R5    K1
         LH,R4    *R5
         AND,R4   M5
         AW,R5    R4
         AWM,R2   -1,R5
         B        EXPRIN1
SUBABS   EQU      ADDABS
*                                   CHANGE RESOLUTION: DETERMINE THE
*                                     CURRENT RESOLUTION OF THE EXPR
*                                     AND SHIFT IT TO THE DESIRED
*                                     RESOLUTION.
CHGRES1  LW,R5    EXPRSTK
         AI,R5    K1
         LH,R6    *R5
         AND,R6   M5
         AW,R5    R6
         AI,R5    KN3
         BAL,SR4  WHATRES
         B        EXPRIN1
CHGRES2  LB,R5    *D4,R6
         LI,R1    K0
         STB,R1   *D4,R6
         AND,R5   M2
         SW,R2    R5
         SLS,SR1  0,R2
         B        EXPRIN1
*                                   EXPRESSION END:
EXPREND1 MTW,0    SR2
         BNEZ     EXPREND2
         LW,D4    EXPRSTK
         AI,D4    1
         CI,SR3   0
         BNE      EXPREND3
*                                   EXPRESSION HAS A VALUE, PICK UP
*                                   RESOLUTION TO RETURN TO CALLER.
         LH,SR2   *D4
         AND,SR2  M5
         AW,SR2   D4
         AI,SR2   KN1
         LW,SR2   *SR2
         B        EXPREND2
*                                   EXPRESSION DOES NOT HAVE A VALUE-
*                                   PUSH IT INTO THE STACK.
EXPREND3 LB,R7    *D4
         MSP,R7   EXPRSTK
         DO       MODE=0
         QUIT     ER1B,BCR10
         ELSE
         BCR,10   MSPGOOD           B IF NO STACK OVERFLOW
         MTW,0    PLIB              HAS MESSAGE BEEN PRINTED
         BNEZ     MSPGOOD
         LCI      8                 NO - DO SO NOW
         PSM,SR1  *R0
         BAL,SR4  BLANKER
         LCI      8
         LM,SR1   NOCORE
         STM,SR1  PBUF
         PLM,SR1  *R0
         LI,R5    PBUF
         CAL1,2   PRINT
         MTW,1    PLIB
MSPGOOD  EQU      %
         FIN
         LH,R6    *D4                                                   730
         CI,R6    X'40'                                                 730
         BAZ      EXPREND4
*                                   ADJUST THE LOC IN THE DESTINATION
*                                   WORD TO BE RELATIVE TO THE BASE OF
*                                   THE MODULE.
         AND,R6   M6                                                    730
         AI,R6    -2                                                    730
         LW,R5    *D4,R6                                                730
         LW,R4    CSEG00
         SLS,R4   -2                                                    730
         SW,R5    R4                                                    730
         LW,R4    D3
         LW,R4    00DIS,R4
         AND,R4   M16                                                   730
         SLS,R4   1                                                     730
         AW,R5    R4                                                    730
         STW,R5   *D4,R6                                                730
EXPREND4 SLS,R7   16                                                    730
         LW,R6    CSEG1
         AW,R6    D3
         AWM,R7   EXPRDIS,R6
EXPREND2 PLW,SR4  *R0
         B        *SR4
*                                   THIS ROUTINE SETS A FLAG AND USES
*                                   THE EXPRIN LOGIC TO SKIP AN EXPR.
EXPRSKP  PSW,SR4  *R0
         LI,SR2   K1
         BAL,SR4  GBYTE
         CI,R5    K0
         BE       %-2
         B        WHATEC
EXPRSKP1 BAL,SR4  GBYTE
         B        WHATEC
D27F     DATA     X'27F'
         DO       MODE=1
NOCORE   TEXTC    ' CORE EXPRESSIONS SUPPRESSED.'
         FIN
         PAGE
*                                   THIS ROUTINE RUNS THRU THE REF/DEF
*                                   STACK LOOKING FOR A FORWARD REF
*                                   WITH THE NUMBER AGREEING WITH
*                                   R7. A DECLARATION STACK TYPE
*                                   POINTER IS RETURNED IN R7.
CHKFREF  EQU      %
         LW,R5    FIRSTF
         LI,R3    0
CHKFLOOP LW,R6    *R5
         AND,R6   MSKFTYPE
         CW,R6    Y0005
         BNE      CHKFREF2
         LW,R6    R5
         AI,R6    K3
         LB,R4    *R6
         CI,R4    X'FF'
         BE       CHKFREF2
         MTW,0    R3
         BNEZ     CHKFREF1
         STW,R5   FIRSTF
         LI,R3    -1
CHKFREF1 EQU      %
         LW,R6    *R6
         AND,R6   M28
         CW,R7    R6
         BE       FREFIN
CHKFREF2 LB,R6    *R5
         AW,R5    R6
         CW,R5    LASTF
         BL       CHKFLOOP
FREFIN   LW,R6    CSEG1
         STW,R5   R7
         AI,R6    RFDFDIS
         LW,R6    *D3,R6
         AND,R6   M16
         SLS,R6   1
         SW,R7    R6
         LW,R6    CSEG1
         STH,R6   R7
         B        *SR4
         PAGE
*                                   THIS ROUTINE PUSHES R7 INTO THE
*                                   DECLARATION STACK.
ENDECL   EQU      %
         PSW,R7   DECLSTK
         B        *SR4
M28      DATA     X'FFFFFFF'
         PAGE
*                                   THIS ROUTINE PICKS UP THE VALUE OF
*                                   THE REF/DEF ENTRY POINTED TO BY
*                                   R7, SHIFTS IT TO THE CORRECT RESOL-
*                                   UTION AND ADDS IT TO THE EXPR
*                                   ACCUMULATOR.
GETVAL   LCI      2
         PSM,R6   *R0
         LH,R5    R7
         LW,R6    LOCWD
         CW,R6    RFLDMODS
         DO       MODE=1
         BANZ     GETVALA
         MTW,0    MREFLAG
         BEZ      NORFLD+1
         FIN
GETVALA  PSW,R5   *R0
*                                   IF REF-LOADING WAS SPECIFIED THE
*                                   SEGMENT IN WHICH THE DEF IS IN
*                                   IS SAVED IN RFLDSG IF IT IS THE
*                                   HIGHEST SO FAR.
         INT,R6   R7                                                    729
         AW,R6    D3                                                    729
         LW,R6    RFDFDIS,R6                                            729
         SLS,R6   1                                                     729
         AW,R6    R7                                                    729
         LB,R5    *R6                                                   729
         CI,R5    3
         BEZ      NORFLD                                                729
         LW,R5    *R6                                                   729
         CW,R5    Y0007
         BANZ     NORFLD
         AND,R5   M16                                                   729
         SLS,R5   -2
         DO       MODE=1
         MTW,0    MREFLAG
         BEZ      GETVALB
         CI,R5    K0
         BE       NORFLD
         CW,R5    CSEG1             FOR MREF LOADING, SET RFLDSG
         BE       NORFLD            AS FOLLOWS:
         LW,R4    LOCCT              =SEG# OF CALLED SEG IF DEF
         AI,R4    TREEDIS             IS NOT IN ROOT,
         LW,R7    R5                  NOT IN UMOV, AND
         AW,R7    *R4                 NOT IN SEG BEING FORMED
         LW,R4    *R7               (OTHERWISE, = -1)
         CW,R4    TXUMOV
         BNE      GETVAL6
         LW,R4    1,R7
         LW,R5    YFF
         CS,R4    TXUMOV+1
         BNE      GETVAL6
         B        NORFLD
         FIN
GETVALB  CW,R5    CSEG1
         BLE      NORFLD
         CW,R5    RFLDSG
         BLE      NORFLD
GETVAL6  STW,R5   RFLDSG
NORFLD   EQU      %
         PLW,R5   *R0                                                   729
         AI,R5    RFDFDIS                                               729
         LW,R4    LOCCT
         AI,R4    TREEDIS
         AW,R5    *R4
         INT,R5   *R5
         SLS,R5   1
         LW,R7    *R0                                                   729
         LW,R7    *R7                                                          7
         STH,R7   R4
         AH,R5    R4
         LW,R4    *R5
         CW,R4    Y001
         BANZ     GETVAL1
*                                   THE REF/DEF HAS NOT BEEN DEFINED.
         STW,R4   SR3
         LCI      2
         PLM,R6   *R0
         B        PTWRD
*                                   GO PICK UP THE VALUE.
GETVAL1  LW,R6    *R0
         LW,R6    -1,R6                                                        7
         LB,R2    *D4,R6                                                       7
GETVAL4  EQU      %
         LW,R7    1,R5
         STW,R2   R6
         PSW,R1   *R0
*                                   DETERMINE ITS RESOLUTION.
         BAL,SR4  WHATRES
         B        GETVAL2-1
         PLW,R1   *R0
         B        GETVAL3
*                                   HAS NO RESOLUTION, ACCUMULATE VALUE.
         PLW,R1   *R0
GETVAL2  CI,R1    K2
         BAZ      %+2
         LCW,R7   R7
         AW,SR1   R7
         LCI      2
         PLM,R6   *R0
         B        PTWRD
*                                   SHIFT VALUE TO DESIRED RESOLUTION
*                                   AND CHANGE EXPR RESOLUTION
*                                   ACCORDINGLY.
GETVAL3  STW,R6   R4
         AND,R6   M2
         SW,R2    R6
         SLS,R7   0,R2
         AI,R5    KN1
         LW,R6    *R5
         SLS,R2   3
         SLS,R6   0,R2
         LW,D4    EXPRSTK
         AI,D4    K1
         LH,R4    *D4
         AND,R4   M5
         AI,R4    KN1
         CI,R1    K2
         BAZ      %+2
         LCW,R6   R6
         AWM,R6   *D4,R4
         LW,R6    R4
         B        GETVAL2
TXUMOV   TEXTC    'UMOV'
         PAGE
WHATRES  AI,R5    K3
*                                   THIS ROUTINE DETERMINES THE
*                                   RESOLUTION OF A REF/DEF. RETURN
*                                   IS +1 IF NONE OR MIXED,+2 WITH
*                                   0,1,2 OR 3 IF IT HAS RESOLUTION.
         LI,R1    KN4
WHATRES1 LB,R4    *R5,R1
         BNEZ     WHATRES4
         BIR,R1   WHATRES1
         B        WHATRES5
WHATRES2 LB,R4    *R5,R1
         BNEZ     WHATRES5
WHATRES3 BIR,R1   WHATRES2
         AI,SR4   K1
         B        *SR4
WHATRES4 STW,R1   R2
         AI,R2    K4
         CI,R4    K1
         BE       WHATRES3
         CI,R4    KFF
         BE       WHATRES3
WHATRES5 B        *SR4
         PAGE
*                                   THIS ROUTINE READS A NAME FROM
*                                   THE OBJECT STREAM, LOCATES THE REF/
*                                   DEF ENTRY AND RETURNS A DECLARATION
*                                   STACK TYPE POINTER IN R7.
LOCRFDF  PSW,SR4  *R0
*                                   READ THE NAME IN ABOVE EXPR STACK.
         BAL,SR4  GBYTE
         LW,D4    EXPRSTK
         AI,D4    K1
         LW,R6    TXBLNK
         STW,R6   *D4
         STB,R5   *D4
         LW,R6    R5
         LI,R7    K1
LOCRFDF1 BAL,SR4  GBYTE
         STB,R5   *D4,R7
         AI,R7    K1
         BDR,R6   LOCRFDF1
*                                   INITIALIZE THE SEARCH BOUNDARIES.
         LW,R2    CSEG1
LOCRFDF4 STW,R2   CSEG2
         AI,R2    RFDFDIS
         LW,R4    *D3,R2
         LW,R5    R4
         SLS,R4   -16
         INT,R5   R5
         SLS,R5   1
         AW,R4    R5
         LW,R3    *D4
LOCLOOP  EQU      %
         CW,R3    3,R5
         BNE      LOCRFDF3
         LW,R7    R5
         AI,R7    K3
         LB,R6    *D4
LOCRFDF2 LB,R2    *D4,R6
         CB,R2    *R7,R6
         BNE      LOCRFDF3
         BDR,R6   LOCRFDF2
         LB,R2    *R5
         CI,R2    3
         BE       LOCRFDF3
*                                 FOUND IT, RETURN POINTER.
         LW,R7    R5
         LW,R6    CSEG2
         AI,R6    RFDFDIS
         LW,R6    *D3,R6
         SLS,R6   1
         SW,R7    R6
         LW,R2    CSEG2
         STH,R2   R7
         PLW,SR4  *R0
         B        *SR4
*                                   LOOP UNTIL FOUND.
LOCRFDF3 LB,R6    *R5
         AW,R5    R6
         CW,R5    R4
         BL       LOCLOOP
         LW,R2    CSEG2
         QUIT     X'2C',BNEZ,R3     CANNOT FIND REF/DEF NAME IN STACK
*                                 GET BACK LINK
         AI,R2    ROM1DIS
         LW,R2    *D3,R2
         AND,R2   M16
         B        LOCRFDF4
         PAGE
*                                   THIS ROUTINE ACCEPTS A POINTER TO
*                                   A BUFFER LOC IN R7 AND RETURNS
*                                   POINTERS TO THE CORRESPONDING
*                                   RELOCATION DIGIT, WORD IN R7, DIGIT
*                                   IN R6.
FNDRELDG LW,R4    LOCWD
         CI,R4    K100
         BANZ     *SR4
         PSW,SR4  *R0
         LI,R4    RSEG00-1
         BAL,SR4  WHATPP
         LI,R4    CSEG00-1
         BAL,SR4  WHATPP
         B        ERFX
WHATPP   EQU      %
         LI,R1    K3
WHATPP1  CW,R7    *R4,R1
         BGE      CALCREL
         BDR,R1   WHATPP1
         B        *SR4
CALCREL  LI,R6    K0
         SW,R7    *R4,R1
         SLS,R7   -2
         SCD,R6   -3
         SCS,R6   3
         AI,R4    76-73             CREL00-CSEG00
         LW,R4    *R4,R1
         SLS,R4   -2
         AW,R7    R4
         PLW,SR4  *R0
         B        *SR4
         PAGE
*                                   THIS ROUTINE INCREMENTS THE
*                                   LOCATION COUNTERS.
INCLOC   AWM,R6   LOC
         AWM,R6   RLOC
         B        *SR4
         PAGE
*                                   THIS ROUTINE HAS AN INPUT IN R6 A
*                                   VIRTUAL BUFFER ADDRESS. RETURNS IN
*                                   R7 A PHYSICAL ADDRESS AFTER INSURING
*                                   THAT THE CORRECT PAGE IS IN MEMORY.
*                                   IT IS USED BOTH FOR LOAD ITEMS AND
*                                   RELOCATION DIGITS. XMEM KEYS ARE OF
*                                   THE FORM 03,00, SEG#, VIRTUAL PAGE#.
         DEF      XMRDERR
XMEM     EQU      %
         LW,R6    R7
         LW,R3    LOCWD
         CI,R3    K4000
         BAZ      XMEM5             NO,OUT.
         LCI      2
         PSM,R4   *R0
         AND,R7   M17
         DO       MODE=1
         SW,R7    FBIAS
         AW,R7    BIAS
         STW,R7   R6
         FIN
         SLS,R7   -9
         LW,R5    XCSEG1            SEGMENT NO.(SAVED AT ORG).
         DO       MODE=1
         DH,R5    Y000B             (CONVERT FROM SEG'S DISP IN
*                                     TREE TO ACTUAL SEG NO.)
         AI,R5    X'300'
         STH,R5   R7
         ELSE
         SLS,R5   8
         AW,R5    Y03
         OR,R7    R5
         FIN
         LW,R4    TOPOMEM
         DO       MODE=0
         MTW,K0   *SR4              IS ENTRY FOR PAGE OF RELOC DICT
         BNEZ     XMEM1              NO
XMEM1R   AI,R4    KN400+K2          SET R4 TO BUFFER OF RELDICT
         CW,R7    XMRKEY            IS PAGE OF REQUESTED WORD IN CORE
         BE       XMEM3X             YES
         ANLZ,R5  %-2
         B        XMEMIO
         FIN
XMEM1    AI,R4    KN200+K2          WORD REQUESTED FOR LOAD MODULE
         CW,R7    XMKEY             IS PAGE CONTAINING THIS WORD IN CORE
         BE       XMEM3X
         ANLZ,R5  %-2
XMEMIO   LCI      3
         PSM,SR1  *R0
         CAL1,1   XMWRT             WRITE OUT CURRENT BUFFER
         STW,R7   *R5              UPDATE KEY
         CAL1,1   XMRD
XMEM3    LCI      3
         PLM,SR1  *R0
XMEM3X   LI,R5    K1FE00
         STS,R4   R6
XMEM4    LCI      2
         PLM,R4   *R0
XMEM5    EQU      %
         DO       MODE=0
         MTW,K0   *SR4              WAS XMEM ENTERED FOR RELOC DICT
         BNEZ     *SR4               NO
         AI,SR4   1                  YES, ADJUST LINKAGE
         FIN
         B        *SR4
XMRDERR  LI,R5    K1FF        RETURN IS MADE TO HERE IF A READ ERROR
         LI,SR2   0           OCCURS. THIS LOGIC ASSUMES THAT THE ERROR
         STW,SR2  *R4,R5      WAS CAUSED BY SPECIFYING A KEY THAT DOES
         BDR,R5   %-1         NOT EXIST.
         STW,SR2  *R4         INITIALIZE BUFFER TO ZERO
         B        XMEM3
         DO       MODE=1
XMWRT    GEN,8,24 X'11',M:LM
         ELSE
XMWRT    GEN,8,24 X'11',M:DIC
         FIN
         DATA     X'38000050'
         DATA     X'80000004',X'800',X'80000005'
         DO       MODE=1
XMRD     GEN,8,24 X'10',M:LM
         ELSE
XMRD     GEN,8,24 X'10',M:DIC
         FIN
         DATA     X'38000010'
         DATA     X'80000004',X'800',X'80000005'
         END

