*DECK     REC    REAR END CONTROLLER
          IDENT  REC
 REC      SECT   (REAR END CONTROLLER.) 
 REC      SPACE  4,10 
*         IN ALLOC
          EXT    ALC
  
*         IN FAS
          EXT    BT.IDNT,BT.IDN9,FAS,SNR,CLE.EQ,ESL.EQ,ESL,CLE
          EXT    RADOL1,RADOL2,RADRTN,FBP,FBP.EQ
          EXT    POL.EQ,POL,WLF.EQ,WLF,BST.EQ,BST 
  
*         IN RSNAP
          EXT    DMT= 
  
*         IN FTN
          EXT    CO.DBID,CO.DBPM,CO.DBST,CO.LOO,CO.OPT,CO.QC,CO.SNAP
          EXT    FV.LGO,F.PB,TL.CSOP,WNB= 
  
*         IN MAP
          EXT    MAP
  
*         IN PEM
          EXT    PDM
  
*         IN PUC
          EXT    BINIO,COMSIZ,ERRORS,F.LBT,NREXT,N.CON,PASS,SUM.LBT 
          EXT    S=CL,S=CON,S=LA,S=VALUE,T=API,T=APL,T=BLKS,T=LA
          EXT    T=CLW,T=CON,T=DIM,T=DATS,T=FMT,T=FPI,T=FPO,T=GL,T=IOA
          EXT    T=IOI,T=LCA,T=LNT,T=NLST,T=SUB,T=SUB0,T=SYM,T.API
          EXT    T.BLKS,T.DIM,T.FPI,T.FPO,T.GL,T.IOI,T.SUB,T.SUB0,T.SYM 
          EXT    USAVE,WO.LOA,WO.LOM,WO.LOO,WO.LOR,Z.LBT
  
*         IN QCGC 
          EXT    BCT,PCA,SMB
  
*         IN QCGLINK
          EXT    REL.RTN
  
*         IN RERRS
          EXT    E.MO1,E.MO8
  
*         IN UTILITY
          EXT    CIO=,SBM=
  
  
 WO.56    BSSENT 1           WRITE 5600 TABLE FOR CID/PMD 
 WO.57    BSSENT 1           WRITE 5700 TABLE FOR CID 
 COMSLBT  SPACE  4,10 
*CALL,COMSLBT 
          TITLE 
 REC      SPACE  4,10 
**        REC - REAR END CONTROLLER.
* 
*         ENTRY  FROM INIT23
* 
*         EXIT   TO REAR END LOADER 
  
  
 REC      BSSENT 0           ...ENTRY 
          CALL   CGE         CHECK ON ERRORS FROM (2,2) OVERLAY 
          RJ     REP         REAR END PRESETS 
          =X7    PASS=END 
          SA7    PASS 
          SA1    =XTV=END 
          SX7    B0 
          SA7    =XALC.PAR
          BX7    X1 
          SA7    =XTV=CUR    SET CURRENT PHASE TO END (FOR ALLOC) 
          RJ     END         PERFORM STORAGE ALLOCATION 
  
 .T       IFEQ   TEST,ON
          SA1    CO.SNAP
          LX1    1RE
          PL     X1,REC02S   IF (SNAP=E) NOT SELECTED 
 SNAP=E   DUMPT  (SYM)
 REC02S   BSS 
 .T       ENDIF 
  
*         OUTPUT REFERENCE MAP. 
  
          SA1    WO.LOA 
          SA2    WO.LOM 
          SA3    WO.LOR 
          BX1    X1+X2
          BX1    X1+X3
          ZR     X1,REC20    IF NO ATTRIBUTES, MAP OR REFERENCE 
          CALL   MAP
  
*         PERFORM ASSEMBLY. 
  
 REC20    CALL   BCT         CONVERT CONSTANT TABLE 
          CALL   PCA         CONVERT CONSTANTS IN T.CAC 
          SA2    FV.LGO 
          SA3    CO.LOO 
          BX6    X3 
          SA6    WO.LOO      INITIALIZE WORKING OLIST FLAG
          SA1    CO.QC
          BX6    X2+X3
          MI     X1,REC60    IF QC MODE, SKIP ASSEMBLY
          ZR     X6,REC60    IF NEITHER OL NOR BINARY REQUESTED 
          =X7    PASS=FAS 
          SA7    PASS        SET PASS TO ASSEMBLY 
          NZ     X2,REC30    IF BINARY REQUESTED
          PLUG   AT=WLF.EQ,TO=WLF,VOID=NO      TURN OFF WRITING OF LGO
          PLUG   AT=BST.EQ,TO=BST,VOID=NO      TURN OFF WRITING OF *SUB*
 REC30    NZ     X3,REC40    IF OBJECT LISTING REQUESTED
          PLUG   AT=POL.EQ,TO=POL,VOID=NO      TURN OFF OBJECT LISTING
          PLUG   AT=RADOL1,TO=RADRTN,VOID=NO
          PLUG   AT=RADOL2,TO=RADRTN,VOID=NO
          PLUG   AT=FBP.EQ,TO=FBP,VOID=NO 
  
 REC40    SA4    WO.57
          NZ     X4,REC50    IF 57 TABLE REQUESTED
          PLUG   AT=CLE.EQ,TO=CLE,VOID=NO 
          PLUG   AT=ESL.EQ,TO=ESL,VOID=NO 
  
 REC50    BSS    0
          RJ     MER         MARK EXTERNAL RELOCATION 
          SA7    NREXT
          SA1    ERRORS 
          NZ     X1,REC59    IF FATAL ERRORS
 .RM      IFNE   CP#RM,0
          RECALL F.PB 
          READ   F.PB 
  
 .RM      ELSE
          RECALL F.PB 
          SA1    BINIO
          MI     X1,REC55    IF CCG OR PHYSICAL I/O HAS OCCURED 
          SA1    F.PB+I.FET  X1 = CODE/STATUS WORD
          MX6    -18
          BX1    X6*X1       ERASE OLD CODE/STATUS
          SX6    23B
          BX6    X1+X6       SIMULATE REWIND,RECALL,READ
          SA6    A1          UPDATE THE FET 
          EQ     REC59
  
 REC55    BSS    0
          READ   F.PB 
 .RM      ENDIF 
  
 REC59    CALL   FAS         PERFORM ASSEMBLY 
  
*         TRASH TABLES NO LONGER REQUIRED.
  
 REC60    SHRINK T=CON
          SHRINK T=FMT,X6 
          SHRINK T=NLST,X6
          SHRINK T=GL,X6
          SHRINK T=APL,X6 
          SHRINK T=API,X6 
          SHRINK T=LCA,X6 
          SHRINK T=IOA,X6 
          SHRINK T=IOI,X6 
          SHRINK T=DATS,X6
          SHRINK T=FPI,X6 
          SHRINK T=FPO,X6 
          SHRINK T=SUB,X6 
          SHRINK T=SUB0 
          SHRINK T=LNT,X6 
          EQ     REL.RTN     TRANSFER TO REAR END LOADER... 
 REP      SPACE  4,10 
**        REP - REAR END PRESETS. 
* 
*         SET UP CELLS FOR REAR END.
  
  
 REP      SUBR   0           ENTRY/EXIT...
          SA1    TL.CSOP
          SA2    A1+B1
          BX6    X1          SET C.C. OPTIONS INTO 77-TABLE 
          SA3    CO.DBST
          SA4    CO.DBID
          BX3    X3+X4
          LX7    X2 
          SX5    BT.IDN9
          SA6    X5+BT.IDNT 
          =A1    A2+1        (TL.CSOP+3)
          =A7    A6+1 
          SA2    =7R
          MX0    18 
          BX6    X0*X1
          BX6    X6+X2
          =A6    A7+1 
          SA5    CO.DBPM
          BX6    X3+X5
          BX7    X3 
          SA6    WO.56       (WO.56) = (CO.DBST).O.(CO.DBID).O.(CO.DBPM)
          SA7    WO.57       (WO.57) = (CO.DBID) OR (CO.DBST) 
          SA1    BINIO
          PL     X1,EXIT.    IF NOT CCG AND NO PHYSICAL I/O HAS OCCURED 
          SA1    FV.LGO 
          SA2    CO.LOO 
          BX1    X1+X2
          ZR     X1,EXIT.    IF B=0 AND LO=-O 
          REWIND F.PB 
          EQ     EXIT.       EXIT...
 END      TITLE  RELOCATE SYMBOL TABLES.
 END      SPACE  4,10 
***       END - RELOCATE SYMBOL TABLES. 
* 
*         ASSIGNS ALL ADDRESSES THAT ARE NOT YET KNOWN, RESERVING 
*                STORAGE WHERE NECESSARY. 
*         ANY "VAR"S IN THE SYMTAB WHICH DO NOT YET HAVE AN 
*         ADDRESS WILL BE ASSIGNED SPACE IN (BN=VAR). 
  
  
 END      SUBR   0           ENTRY/EXIT...
  
  
**        THE FOLLOWING CODE SOLVES THE VALUE. STORAGE ALLOCATION 
*         PROBLEM BY SEARCHING THE LIST OF VALUE. SYMBOLS IN REVERSE
*         ORDER AND ASSIGNING THE BASE MEMBER THE TYPE OF THE FIRST 
*         ONE WHICH HAS WB.DEF SET. IF NONE OF THEM ARE DEFINED, A
*         ZERO WILL BE STORED AT S=VALUE
  
  
          SA1    S=VALUE
          SB2    X1 
          LX1    1
          SB2    X1+B2       CONVERT TO INDEX 
          SA2    T.SYM
          SB2    B2+WB.W
          SB7    X2+B2       SAVE ADDRESS OF BASE MEMBER
          SB2    B2+Z=SYM*N.TYPE
          SA2    X2+B2       INITIALIZE FETCH REG 
          SX7    M.CHAR 
  
 END1A    SA2    A2-Z=SYM 
          SBIT   X2,WB.DEFP 
          MI     X2,END1B    IF A VALUE. IS DEFINED 
          =X7    X7-1 
          PL     X7,END1A    IF NOT DONE
  
**        HERE IF NO VALUE. HAS BEEN DEFINED
  
          MX6    0
          SA6    A1 
          EQ     END1C
  
 END1B    LX7    WB.MODEP    POSITION NEW MODE
          MX0    -WB.MODEL
          LX0    WB.MODEP 
          SA2    B7          *WB* OF BASE MEMBER
          BX2    X0*X2       ERASE PREVIOUS MODE
          BX6    X2+X7       FILL IN NEW MODE 
          SA6    A2          UPDATE *WB*
  
 END1C    BSS    0
  
  
**        PART 1 - COMPLETE LOCAL BLOCK LENGTHS.
*                TBLN [LBT(BN=FMT)] = (T=FMT) 
*                TBLN [LBT(BN=CON)] = (T=CON) 
*                TBLN [LBT(BN=APL)] = (T=APL) + (T=LCA)-1 
*                TBLN [LBT(BN=IOAP)] = (T=IOA)/2 + (T=CLW)/2
*                WC.RA [S=CHAR] = (T=CON) 
*                WC.RA [S=CL]   = (T=IOAP)/2
  
  
          SA1    T=FMT
          SA4    F.LBT+BN=FMT 
          MX2    0
          RJ     GBS         RESERVE FORMAT BLOCK 
          SA3    CO.OPT 
          SA1    T=LA 
          NZ     X3,END1     IF NOT QUICK CODE GENERATOR
          SA2    S=LA 
          RJ     GBS         GENERATE SPACE FOR (LA.) 
  
 END1     SA4    A4-BN=FMT+BN=CON  GENERATE (BN=CON)
          SA1    =XN.CON
          SA2    S=CON
          RJ     GBS         GENERATE SPACE FOR (CON.)
  
          SA4    A4-BN=CON+BN=APL        GENERATE (BN=APL)
          SA2    T=LCA
          SA1    T=APL
          SX7    X2-1 
          MX2    0
          IX1    X1+X7       LENGTH = T=APL + T=LCA - 1 
          RJ     GBS
          SA1    T=IOA
          SA4    A4-BN=APL+BN=IOAP       GENERATE (BN=IOAP) 
          AX1    1           IOLEN = T=IOA / Z=IOA
          ERRNZ  2-Z=IOA
          MX2    0
          RJ     GBS         COUNT SPACE FOR IO APLS
          SA1    T=CLW
          SA2    S=CL 
          AX1    1           CLLEN = T=CLW / Z=CLW
          ERRNZ  2-Z=CLW
          RJ     GBS         DEFINE SPACE FOR (CL.) 
  
  
**        PART 2 - PROCESS NAMELISTS. 
*         FOR ALL REFERENCED NAMELIST GROUP NAMES, SET
*         RL[WCI] = ML.PROG,
*         RB[WCI] = BN=NLST,
*         RA[WCI] = SUMMED LENGTH OF (I-1) GROUP DEFINITION APLISTS.
  
  
 .T       IFEQ   TEST,ON
          SA1    F.LBT+BN=NLST
          NZ     X1,"BLOWUP" IF SPURIOUS USE OF  *NAMLST.*  BLOCK 
 .T       ENDIF 
  
          BX7    0           (X7) = RA = ACCUM LENGTH  *NAMLST.*  BLOCK 
          MX4    0
          RJ     ADA         ASSIGN BLOCK-REL RUN-TIME DIMTAB ADDRESSES 
          =B2    0           (B2) = ***** 
          =B3    0           (B3) = ***** 
  
*         PROCESS A NAMELIST GROUP. 
  
 END2     SB3    B3+B2       ADVANCE TO NEXT GROUP
          =B2    0
          CALL   SNR         SET NAMELIST REGISTERS 
          MI     B3,END4     IF NO MORE GROUPS
  
*         SET RA,RL,RB IN T.SYM WORD C FOR GROUP-NAME.
  
          =A1    A1+WC.W-WB.W 
  
 .T       IFEQ   TEST,ON
          CLAS=  X3,WC,(RLRB,RA)
          BX6    X3*X1
          NZ     X6,"BLOWUP" IF TRASH IN WORD C 
 .T       ENDIF 
  
          ERRNZ  WC.RAP 
          BX3    X1+X7
          SA2    ENDA        SKELETON  *RL=PROG, RB=(BN=NLST)*
          IX6    X3+X2
          SA6    A1          RA,RL,RB TO WORD C 
          SX1    B4+B4
          =X2    X1+1 
          IX7    X7+X2       RA = RA + 2*NMEM + 1 (FOR GROUP HDR) 
          ZR     B2,END2     IF NO MEMBERS
          =X1    B4+1        GROUP LEN (IN T.NLST) = (NR MEM - 1)/4 + 1 
          AX1    2
          =B2    X1+1 
          EQ     END2        LOOP FOR NEXT GROUP
  
*         HERE WHEN ALL GROUPS PROCESSED. 
  
 END4     SA7    F.LBT+BN=NLST     DEFINE LENGTH OF  *NAMLST.*  BLOCK 
  
  
  
  
**        PART 3 - PROCESS FORMAT LABELS. 
*         FOR ALL FORMAT LABELS, SET
*         RL[WCI] = ML.PROG,
*         RB[WCI] = BN=FMT
*         RA[WCI] = RA[WCI] + 1 
  
  
          SA2    T=SYM
          SA1    T.SYM
          CLAS=  X4,WC,(RLRB) 
          CLAS=  X5,WB,(LAB,FDEF) 
          SB7    X2          LENSYM = LEN(T.SYM)
          =A3    X1+WB.W     WBA = FWA(T.SYM) 
          SA2    ENDB        SKELETON  *RL=PROG, RB=(BN=FMT)* 
          =B3    Z=SYM
          SX0    1
          LX0    WC.RAP 
  
 END10    SA3    A3+B3       WBA = WBA + Z=SYM, WBI = (WBA) 
          SB7    B7-B3       LENSYM = LENSYM - Z=SYM
          ZR     B7,END15    IF END OF T.SYM
          BX6    X5*X3
          IX7    X6-X5
          NZ     X7,END10    IF NOT FORMAT LABEL
          =A1    A3-WB.W+WC.W      WCI
          BX7    -X4*X1      CLEAR (RLRB) FIELD 
          IX7    X7+X2
          IX7    X7+X0       RA[WCI] = RA[WCI] + 1
          SA7    A1          (RL,RB,RA)[WCI] = (ML.PROG,BN=FMT,RA+1)[WC.
          EQ     END10
  
  
**        PART 5 - ASSIGN ADDRESSES TO LOCAL SYMBOLS. 
  
  
 END15    BSS 
          RJ     SMB         SET MAT BIT
          RJ     SSA         SET SYMBOL ADDRESSES 
  
  
**        PART 6 - COMPUTE LENGTH OF SUB AND SUB0 BLOCK.
*                FOR EACH FORMAL PARAMETER, RELOCATE ITS NUMBER OF SUB
*                REFERENCES (LEN[FP.], SUB0[FP.] OF T.FPI ENTRY ) 
*                RELATIVE TO THE SUB AND SUB0 BLOCK.
*         AN T.FPO ENTRY IS MADE ALSO FOR EACH F.P.S, FORMATTED AS FP. .
  
  
          SA4    T=FPI
          ZR     X4,END60    IF NO FORMAL PARAMETERS
          ALLOC  T.FPO,X4 
          SB2    X1 
          SB7    X4          FPLEN = (T=FPI)
          SA3    T.FPI
          MX4    0           LENSUB = 0 
          MX5    0           SUB0LEN = 0
          SB3    B0          IND = 0
          SB4    X3 
          =B5    2
          MX0    -FP.SUBL 
  
 END45    ZR     B7,END50    IF END OF T.FPI
          SA3    B4+B3       FPI = T.FPI(IND) 
          CLAS=  X1,FP,(CA,SUB,SUB0)
          BX6    X4 
          BX7    -X1*X3      CLEAR (SUB,SUB0) FIELDS
          LX5    FP.SUB0P 
          LX6    FP.SUBP
          BX6    X5+X6
          LX5    -FP.SUB0P   RESTORE (X5) 
          SB7    B7-B1       FPLEN = FPLEN - 1
          LX3    -FP.LENP 
          ERRNZ  FP.LENP-FP.SUBP
          BX1    -X0*X3      LENI = LEN[FPI]
          LX3    FP.LENP-FP.SUB0P 
          MX2    -FP.SUB0L
          BX3    -X0*X3      SUB0I = SUB0[FPI]
          BX7    X7+X6
          SA6    B2+B3       [T.FPO(IND)] = (LENSUB,LENSUB0)[FP.] 
          SA7    A3          [FPI]  = (LENSUB,LENSUB0) [FP.]
          SB3    B3+B1       IND = IND + 1
          ZR     X1,END48    IF LENI .EQ. 0 
          IX4    X4+X1       LENSUB = LENSUB + LENI 
          SX4    X4+B1       ALLOW FOR 0 TERMINATOR WORD
  
 END48    ZR     X3,END45    IF SUB0I .EQ. 0
          IX5    X5+X3       LENSUB0 = LENSUB0 + SUB0I
          SX5    X5+B5       ALLOW FOR TERMINATOR AND HEADER WORD 
          EQ     END45
  
 END50    BX6    X4 
          BX7    X5 
          SX0    X6 
          LX6    LB.TBLNP 
          LX7    LB.TBLNP 
          SA6    F.LBT+BN=SUB      TBLN[T.LBT(BN=SUB )] = LENSUB
          SA7    F.LBT+BN=SUB0     TBLN[T.LBT(BN=SUB0)] = LENSUB0 
          SA3    FV.LGO 
          ZR     X3,END60    IF NO BINARY 
          ZR     X4,END55    IF LENSUB .EQ. 0 
          ALLOC  T.SUB,X0  ALLOCATE SPACE FOR T.SUB 
          MX6    60 
          SETMEM X1,X2,X6    INITIALIZE TO -0 
  
 END55    BSS    0
          SHRINK T=SUB0,0 
 #MD      IFNE   .DAL,0,1 
          RJ     ISZ         INITIALIZE SUB0 TABLE
  
  
**        PART 7 - PROCESS LOCAL BLOCK TABLES.
*         CONVERT BASE LENGTH IN LOCAL BLOCK TABLE INTO PROGRAM 
*         RELOCATABLE ADDRESS  (ORG). 
*         ALSO,  SET BLEN[LBT] = TBLN[LBT]. 
  
  
 END60    BSS    0
          =A2    F.LBT-1     LBTA = F.LBT-1  (PRE-FETCH)
          SB2    Z.LBT       LENLBT = LENGTH OF LOCAL BLOCK TABLE 
          =X6    0           ORG = 0
          MX0    -LB.BLENL
          SA1    ERRORS 
          NZ     X1,END90    IF FATAL ERRORS
  
 END70    SA2    A2+B1       LBTA= LBTA+1,  LBTI = (LBTA) 
          SX5    3           INITIALIZE PARCEL COUNT = 3
          BX7    X2 
          LX2    -LB.TBLNP
          HX7    LB.PARC
          AX7    -LB.PARCL   PARCNT = PARC[LBTI]
          =B3    0           ROUNDUP = 0
          ZR     X7,END80    IF PARCNT  EQ  0 (NO NEED TO ROUND UP) 
          SB3    B1          ROUNDUP = 1
  
 END80    BX2    -X0*X2      TBLNI= TBLN[LBTI]
          BX7    X6 
          LX7    LB.ORGP
          SX2    X2+B3       BLENI = TBLNI + ROUNDUP
          SB2    B2-B1       LENLBT = LENLBT - 1
          LX5    LB.PARCP 
          IX6    X6+X2       ORG = ORG + BLENI
          LX2    LB.BLENP 
          BX7    X7+X5
          BX7    X7+X2
          SA7    A2          (BLEN,ORG) [LBTI] = (TBLNI,ORG) [LB.]
          NZ     B2,END70    IF LENLBT  NE  0 
  
 END90    SA6    SUM.LBT     PROGRAM UNIT LENGTH = ORG
  
  
**        PART 8 - RELOCATE SYMBOL TABLE FOR ALL LOCAL BLOCKS.
* 
*         IF  RL = ML.PROG, 
*         RELOCATE THIS ENTRY, SETTING..
*         RA[WC] = RA[WC] + ORG [LBT( RB[WB] )],
*         RB[WC] = 0
  
  
          SA1    T.SYM
          =B3    Z=SYM
          SA2    T=SYM
          SA3    X1+WC.W     WCA = (T.SYM)+WC.W 
          SB7    X2-Z=SYM    LENSYM = (T=SYM) - Z=SYM 
          SB4    F.LBT
          MX0    -WC.RLL
          MX7    -WC.RBL
  
*         B3  =  LENGTH OF SYMBOL TABLE ENTRY 
*         B4  =  BASE ADDRESS OF LBT
*         B7  =  SYMTAB LENGTH
*         X0  =  MASK FOR (WC.RL) 
*         A3  =  ADDRESS CURRENT SYMBOL TABLE  WC.W  ENTRY
  
 END100   SA3    A3+B3       WCA = WCA + Z=SYM, WCI = (WCA) 
          LX3    -WC.RLP
          ZR     B7,END110   IF TABLE EXHAUSTED 
          IFEQ   TEST,ON,1
          MI     B7,"BLOWUP" IF SYMBOL TABLE NOT MULT OF Z=SYM
          BX4    -X0*X3      RLI = RL[WCI]
          SB7    B7-B3       LENSYM = LENSYM - Z=SYM
          SB2    X4-ML.PROG        = WC.RL(I) - ML.PROG 
          NE     B2,B0,END100      IF RL(I) .NE. ML.PROG
          =A5    A3-WC.W+WB.W      *WB* 
          CLAS=  X1,WB,(FUN)
          BX5    X1*X5
          NZ     X5,END100   IF A FUNCTION
          LX3    WC.RLP-WC.RBP
          BX6    X7*X3
          BX3    -X7*X3      RBI = RB[WCI]
          SA5    X3+B4       LBI = LBT(RBI) 
          LX6    WC.RBP 
          HX5    LB.ORG      ORGI = ORG[LBI]
          AX5    -LB.ORGL+WC.RAP
          LX5    WC.RAP 
          IX6    X6+X5       RAI = RAI + ORGI 
          SA6    A3          (RB,RA)[WCI] = (0,RAI) [WC.] 
          EQ     END100 
  
  
**        PART 9 - PROCESS AUXILIARY TABLES.
  
  
 END110   BSS    0
          SA1    ERRORS 
          NZ     X1,END115   IF FATAL ERRORS, SKIP RELOCATING AUX TABLES
          SA1    T=GL 
          SA2    T.GL 
          RJ     RAT         RELOCATE T.GL
          SA1    T=API
          SA2    T.API
          RJ     RAT         RELOCATE T.API 
          SA1    T=IOI
          SA2    T.IOI
          RJ     RAT         RELOCATE T.IOI 
  
  
**        PART 10 - RELOCATE LOCAL EQUIVALENCED VARIABLES.
* 
*         WORD WC.W OF EACH LOCAL EQUIV VARIABLE IS 
*         MODIFIED IN THE FOLLOWING WAY.... 
* 
*         WB.COM(I) = WB.COM(M) 
*         WB.SAVE(I) = WB.SAVE(M), IF UNIVERSAL SAVE
*         WC.RL(I) = WC.RL(M) 
*         WC.RB(I) = WC.RB(M) 
*         WC.RA(I) = WC.RA(I) + WC.RA(M)
*                WHERE I = THE CURRENT LOCAL EQUIV VARIABLE 
*                          BEING PROCESSED, 
*                      M = WC.BASE(I), THE ORDINAL OF THE BASE
*                          MEMBER.
  
  
 END115   BSS    0
          SA1    T=SYM
          SA2    T.SYM
          =B3    Z=SYM
          =A4    X2+WB.W     WBA = FWA(T.SYM) + WB.W
          SB4    X1          LENSYM = (T=SYM) 
          =B5    X2+WC.W
          MX0    WC.RLRBL 
          LX0    WC.RLRBL+WC.RLRBP
  
 END120   SA4    A4+B3       WBA = WBA + Z=SYM,  WBI = (WBA)
          SB4    B4-B3       LENSYM = LENSYM - Z=SYM
          ZR     B4,END130   IF END OF T.SYM
          CLAS=  X1,WB,(LAB)
          MX7    -WB.BASEL
          LX6    X4 
          BX2    X1*X4
          SBIT   X4,WB.EQVP 
          PL     X4,END120   IF NOT EQUIVALENCED
          NZ     X2,END120   IF LABEL 
          LX4    1+WB.EQVP-WB.BASEP 
          BX7    -X7*X4      BASEI = BASE[WBI]
  
 .TEST    IFEQ   TEST,ON,1
          ZR     X7,"BLOWUP" BASE ORD SHOULD NOT BE 0 
  
          =A3    A4-WB.W+WC.W      WCI
          LX2    X7,B1
          IX2    X2+X7       STINDB = 3 * BASEI 
          ERRNZ  3-Z=SYM
          BX7    -X0*X3      ALL BUT (RLRB) 
          CLAS=  X1,WB,(COM)
          LX4    WB.BASEP    RESTORE (X4) 
          SA2    X2+B5       WCB = T.SYM(STINDB) + WC.W 
          =A5    A2-WC.W+WB.W      WBB = WB ENTRY OF BASE 
          BX1    X1*X5       COMB = COM[WBB]
          BX6    X1+X4
          BX3    X0*X2       RLRBB = RLRB[WCB]
          HX2    WC.RA
          AX2    -WC.RAL     RAB = RA[WCB]
          SA1    =XUSAVE
          BX1    X1*X5       SAVEB = SAVE[WBB] IF UNIVERSAL SAVE
          BX6    X6+X1
          BX7    X7+X3
          IX7    X7+X2
          SA7    A3          (RLRB,RA) [WCI] = (RARBB,RAI+RAB) [WC.]
          SA6    A4          (COM,SAVE) [WBI] = (COMB,SAVEB) [WBB]
          EQ     END120 
  
  
**        PART 11 - DIAGNOSE OBJECT PROGRAM LENGTH TOO LONG FOR ANY 
*         POSSIBLE SCM. 
  
  
 END130   MX3    1
          RJ     GCL         GET LCM COMMON LENGTH
          SA6    COMSIZ+1 
          MX3    0
          RJ     GCL         GET CM COMMON LENGTH 
          SX7    MAX.SPCM 
          =X1    1
          IX7    X7+X1
          IX7    X6-X7
          SA1    SUM.LBT
          SA6    COMSIZ 
          IX2    X1+X6       OBJ PROG LEN = PROG LEN + COMMON LEN 
          SX0    MAX.SPCM 
          =X1    1
          IX0    X0+X1
          IX0    X2-X0
          MI     X7,END140   IF COMMON LEN O.K. 
          FATAL  E.MO8       COMMON LENGTH TOO LONG 
 END140   MI     X0,EXIT.    IF OBJ PROG LEN  O.K.
          FATAL  E.MO1       PROGRAM UNIT LENGTH TOO LONG 
          EQ     EXIT.       EXIT...
  
  
  
 ENDA     BSS    0           DEFINE SKELETON  *RL=PROG, RB=(BN=NLST)* 
          POS    WC.RLP+WC.RLL
          VFD    WC.RLL/ML.PROG 
          ERRMI  *P-WC.RBP-WC.RBL 
          POS    WC.RBP+WC.RBL
          VFD    WC.RBL/BN=NLST 
          VFD    *P/0 
  
 ENDB     BSS    0           DEFINE SKELETON  *RL=PROG, RB=(BN=FMT)*
          POS    WC.RLP+WC.RLL
          VFD    WC.RLL/ML.PROG 
          ERRMI  *P-WC.RBP-WC.RBL 
          POS    WC.RBP+WC.RBL
          VFD    WC.RBL/BN=FMT
          VFD    *P/0 
 ADA      SPACE  4,10 
**        ADA - ASSIGN (RUN-TIME) DIMENSION TABLE ADDRESSES.
* 
*         SEARCHES THRU T.DIM FOR ENTRIES WITH RUN-TIME MATERIALIZATION 
*         BIT (DH.MAT) SET.  FOR EACH SUCH ENTRY, ASSIGNS A BLOCK- OR 
*         PROGRAM-RELATIVE ADDRESS, REFERENCED TO A BASE ADDRESS
*         PROVIDED BY THE CALLER IN (X7). 
* 
* 
*         ENTRY  (X7) = BASE ADDRESS, AS ABOVE. 
*                (X4) = 0, IF (DH.MAT) TO BE HONORED. 
*                (X4) = 1S59, IF TO COUNT ALL ENTRIES.
* 
*         EXIT   (X7) = INCREMENTED BY TOTAL LENGTH OF DIMENSION TABLES 
*                       TO BE MATERIALIZED AT RUN-TIME. 
*                (T.DIM) = (DH.RA) SET IN HEADERS THAT HAD (DH.MAT) ON. 
* 
*         USES   A - 1,2.   X - ALL.   B - 2,3. 
* 
*         CALLS  NONE.
  
  
 ADA      SUBR   =           ENTRY/EXIT...
          SA1    T=DIM
          SA2    T.DIM
          MX0    -DH.DIML 
          =B2    0           (B2) = T.DIM INDEX OF ARRAY ENTRY HEADER 
          SB3    X1          (B3) = LENGTH OF T.DIM 
          MX5    -DH.RAL
 ADA2     GE     B2,B3,EXIT. IF END OF T.DIM
          SA1    X2+B2       NEXT ENTRY HEADER
          LX1    -DH.DIMP 
          BX3    -X0*X1      EXTRACT NUMBER OF DIMENSIONS 
          SB2    B2+X3
          =X3    X3+1 
          SB2    B2+X3       ADVANCE INDEX TO NEXT HEADER (2*NRDIM + 1) 
          LX1    DH.DIMP-1-DH.MATP
          BX6    X4+X1       MATI = (X4) .OR. (DH.MAT)
          PL     X6,ADA2     IF THIS ENTRY NOT MATERIAL 
          LX1    DH.MATP+1-DH.RAP 
          BX1    X5*X1       CLEAR DH.RA
          BX6    X1+X7       ADDRESS TO HEADER
          IX7    X7+X3       ADVANCE ADDRESS (1*NRDIM + 1)
          LX6    DH.RAP 
          SA6    A1 
          EQ     ADA2        LOOP FOR NEXT ENTRY
 GBS      SPACE  4,10 
**        GBS - GENERATE BLOCK OF STORAGE.
* 
*         ENTRY  (X1) = LENGTH. 
*                (X2) = SYMORD TO BE DEFINED. 
*                (A4,X4) = LOCAL BLOCK TABLE ENTRY. 
* 
*         EXIT   (A4,X4) = NEW BLOCK TABLE ENTRY. 
*                (WC.RA(SYMORD)) = OLD LENGTH OF BLOCK. 
*                BLOCK TABLE ENTRY UPDATED. 
*         USES   A1,A2,A3,A6,A7  X1,X2,X3,X6,X7  B7 
  
  
 GBS      SUBR   0           ENTRY/EXIT...
          LX1    LB.TBLNP 
          IX6    X4+X1       TBLN(I) = TBLN(I) + LENGTH 
          SA6    A4 
          ZR     X2,GBS8     IF NO SYMBOL 
  
          SA1    T.SYM
          LX7    X2,B1
          LX4    -LB.TBLNP
          IX2    X2+X7       STI = 3 * SYMORD 
          ERRNZ  3-Z=SYM
          =B7    X1+WC.W
          MX0    -LB.TBLNL
          SA2    X2+B7       WCI = T.SYM(STI) + WC.W
          BX4    -X0*X4      ADDR = ORIGINAL LENGTH OF BLOCK
          LX4    WC.RAP 
          BX7    X2+X4       RA[WCI] = ADDR 
          SA7    A2 
  
 GBS8     BX4    X6          RETURN (X4) = NEW ENTRY
          EQ     EXIT.
 GCL      SPACE  4,30 
**        GCL -  GET COMMON LENGTHS.
*         THIS ROUTINE SUMS SIZE OF CM OR LCM COMMON BLOCKS.
* 
*         ENTRY  X3 = MASK(LCM), WHERE LCM = 0 FOR CM,  1 FOR LCM 
*         EXIT   (X6) = TOTAL SIZE OF LOCAL COMMON
*         USES   A1,A2,X0,X1,X2,B2-B6 
  
  
 GCL      SUBR   0           ENTRY/EXIT...
          SA2    T.BLKS 
          =B2    X2+CB.W
          =X6    0           COMLEN = 0 
          SA1    T=BLKS 
          =B6    Z=BLKS      BLKIND = Z=BLKS
          SB4    X1 
          SB3    B6 
          MX0    -CB.BLENL
 GCL10    GE     B6,B4,EXIT. IF END OF T.BLKS 
          SA1    B2+B6       CBI = CB ENTRY OF T.BLKS 
          BX2    X1 
          SB6    B6+B3       BLKIND = BLKIND + Z=BLKS 
          AX1    CB.BLENP 
          BX1    -X0*X1      BLENI = BLEN[CBI]
          HX2    CB.LCM 
          BX2    X2-X3
          MI     X2,GCL10    IF NOT REQUESTED RESIDENCE 
          IX6    X6+X1       BLKLEN = BLKLEN + BLENI
          EQ     GCL10
 ISZ      SPACE  4,10 
**        ISZ -  INITIALIZE SUB0 TABLE. 
*                SET HEADER (0) AND TERMINATOR (-0) WORDS FOR EACH F.P. 
*                ENTRY IN THE SUB0 TABLE. 
* 
*         ENTRY  (X5) = SIZE OF SUB0 TABLE, INC. HEADERS AND TERMS. 
  
  
 #MD      IFNE   .DAL,0 
 ISZ      SUBR   0           ENTRY/EXIT...
          ZR     X5,EXIT.    IF NO SUB0 TABLE 
          ALLOC  T.SUB0,X5   ALLOCATE SPACE FOR TABLE 
          SA1    T.SUB0 
          SA2    T.FPO
          SA3    T=SUB0 
          SA4    T=FPO
          SB2    X1 
          SB3    X4 
          IX5    X1+X3
          MX6    0           0 HEADER WORD
          MX7    60          -0 TERMINATOR WORD 
          SA7    X5-1        LWA(T.SUB0) = -0 
          ERRMI  FUDGE-1
 ISZ10    ZR     B3,EXIT.    IF END OF TABLE
          SB3    B3-B1       I = I - 1
          SA5    X2+B3       FPOI = T.FPO(I)
          AX5    FP.SUB0P 
          SA6    X5+B2       T.SUB0(SUB0FWA) = 0
          =A7    A6-1        T.SUB0(SUB0FWA-1) = -0 
          EQ     ISZ10
 #MD      ENDIF 
 MER      SPACE  4,10 
**        MER - MARK EXTERNAL RELOCATION. 
**        PART 4 - PROCESS EXTERNAL SYMBOLS.
*         FOR ALL EXTERNALS, SET
*         WC.RL(I) = ML.EXT 
*         WC.RB(I) = 0
*         SET (NREXT) = NUMBER OF EXTERNALS.
*         FOR EXTERNALS WHICH ARE FORMAL PARAMETERS, REGARD AS NON- 
*         EXTERNALS FROM NOW ON, SO SET  EXT[WBI] = 0.
  
  
 MER      SUBR   0           ENTRY/EXIT...
          SA2    T=SYM
          SA1    T.SYM
          CLAS=  X4,WC,(RLRB) 
          CLAS=  X0,WB,(EXT)
          SX7    B1          INITIALIZE EXTERNAL COUNTER
          SB7    X2 
          =B3    Z=SYM
          =X2    ML.EXT      RLI = ML.EXT 
          =A3    X1+WB.W
          LX2    WC.RLP 
 MER20    SA3    A3+B3       WBA = WBA + L.SYM, WBI = (WBA) 
          SB7    B7-B3
          ZR     B7,EXIT.    IF SYMTAB EXHAUSTED
          BX5    X3 
          BX6    X0*X3
          HX5    WB.LAB 
          MI     X5,MER20    IF LABEL 
          ZR     X6,MER20    IF NOT EXTERNAL
          LX5    WB.LABP-WB.FPP 
          =A1    A3-WB.W+WC.W 
          PL     X5,MER30    IF NOT F.P.
          BX6    -X0*X3 
          SA6    A3          EXT[WBI] = 0 
          EQ     MER20
  
 MER30    SX7    X7+B1       COUNT EXTERNALS
          BX5    -X4*X1      CLEAR (RLRB) FIELD 
          IX6    X5+X2
          SA6    A1          (RL,RB) [WCI] = (RLI,0) [WC.]
          EQ     MER20
 RAT      SPACE  4,30 
**        RAT -  RELOCATE AUXILLIARY TABLES.
*         ENTRY -(A1) = LENGTH OF TABLE 
*                (A2) = FWA  OF TABLE 
* 
*         THE TABLE ELEMENTS ARE ONE WORD PER TABLE ENTRY 
*         EACH TABLE ENTRY HAS THE FORMAT AS DEFINED BY WC.W OF THE 
*         SYMBOL TABLE. 
  
  
 RAT      SUBR   0           ENTRY/EXIT...
          SB2    =XF.LBT
          ZR     X1,EXIT.    IF LENGTH OF TABLE = 0 
          SB3    X1          LENTAB = LENGTH OF TABLE 
          SA1    X2          TA = FWA OF TABLE
          MX7    -LB.ORGL 
 RAT10    SB3    B3-B1       LENTAB = LENTAB - 1
          SA1    A1+B1       TA = TA + 1,  TI = (TA)
          EQ     B3,B0,EXIT. IF TABLE EXHAUSTED 
          BX2    X1 
          HX2    WC.RB
          AX2    -WC.RBL     RBI = RB[TI] 
          SA4    X2+B2       LBI = LBT(RBI) 
          LX4    -LB.ORGP 
          BX4    -X7*X4      ORGI = ORG[LBI]
          LX4    WC.RAP 
          IX6    X1+X4
          SA6    A1          RA[TI] = (RA[TI] + ORGI) [WC.] 
          EQ     RAT10
 SSA      SPACE  4,10 
**        SSA - SET SYMBOL ADDRESSES. 
* 
*         PHASE 1 OF SYMBOL TABLE COMPLETION. 
* 
*         FIRST, INDEX THE SYMBOL TABLE RELATIVE TO THE LBT (F.LBT).
*         THIS INVOLVES SETTING THE  WC.RB  FIELD OF UNIQUE LOCAL 
*         SYMBOLS TO AN INDEX WHICH POINTS INTO THE FIXED TABLE,  F.LBT.
*         ALSO, THE TBLN FIELD OF  F.LBT  WILL BE ADJUSTED TO ACCOUNT 
*         FOR THE LENGTH OF EACH UNIQUE LOCAL SYMBOL PROCESSED. 
* 
*         FOR UNIQUE LOCAL VARIABLES, SET...
*         WC.RL(I) = ML.PROG  / (INDICATES PROGRAM RELOCATABLE).
*         WC.RB(I) = (BN=VAR),
*         WC.RA(I) = TBLN [LBT(BN=VAR)] 
*         TBLN [LBT(BN=VAR)] = TBLN [LBT(BN=VAR)] + DIM SIZE
*                FOR EACH LOCAL VARIABLE. 
*         FOR CHARACTER VARIABLES, DIM SIZE = DIM SIZE * CLEN[WCI] / 10 
  
  
 SSA      SUBR   0           ENTRY/EXIT...
          SA1    T.SYM
          =B3    Z=SYM
          SA2    T=SYM
          =A3    X1+WB.W     WBA = FWA(T.SYM) + WB.W
          CLAS=  X4,WB,(LAB,FP,EXT,NVAR,NLST,PARM,EQV,COM,ENT,SAVE) 
          =X6    ML.PROG
          =X5    BN=VAR 
          LX6    WC.RLP 
          LX5    WC.RBP 
          BX5    X5+X6       (X5) = (RL,RB) = (ML.PROG,BN=VAR) [WC.]
          SB7    X2          STLEN = (T=SYM)
          SA1    =XT.DIM
          BX0    0           VARLEN = 0 
          =B5    X1          FWA DIM TABLE  (T.DIM) 
  
*         B3  =  LENGTH OF SYMBOL TABLE ENTRY 
*         B5  =  FWA  DIMENSION TABLES
*         B7  =  SYMBOL TABLE LENGTH
*         (X0) =  VARLEN
*         X4 = CLASS BITS MASK
  
 SSA10    SA3    A3+B3       WBA = WBA + L.SYM, WBI = (WBA) 
          SB7    B7-B3       STLEN = STLEN + L.SYM
          ZR     B7,SSA30    IF SYMTAB EXHAUSTED
  
 .TEST    IFEQ   TEST,ON,1
          MI     B7,"BLOWUP" IF SYMBOL TABLE LENGTH NOT MULT OF L.SYM 
  
          BX2    X4*X3
          NZ     X2,SSA10    IF NOT UNIQUE LOCAL, AVOID.. 
          SBIT   X3,WB.MATP 
          PL     X3,SSA10    IF NOT MATERIALIZED
          =A1    A3-WB.W+WC.W      WCI = WC.W ENTRY 
          CLAS=  X2,WC,(RLRB,RA)
          BX2    X2*X1       RBRAI = (RLRB, RA) [WCI] 
          MX6    -WB.MODEL
          NZ     X2,SSA10    IF STORAGE ALREADY ALLOCATED 
          LX3    WB.MATP+1-WB.PNTP
          MX7    -WB.PNTL 
          BX2    -X7*X3      DTIND = PNT[WBI] 
          SA2    X2+B5       TDI = T.DIM(DTIND) 
          HX2    DH.PS
          AX2    -DH.PSL     SIZE = PS[TDI] 
          LX3    WB.PNTP-WB.MODEP 
          BX7    -X6*X3      MODEI = MODE[WBI]
          SX6    X7-M.CHAR
          MX3    -0 
          SB2    X7-M.DBL 
          EQ     B2,B0,SSA20 IF MODE = DOUBLE 
          EQ     B2,B1,SSA20 IF MODE = COMPLEX
          SX3    0           INDICATE SINGLE WORD ELEMENT 
          NZ     X6,SSA20    IF NOT MODE CHARACTER
          BX7    X1 
          HX7    WC.CLEN
          AX7    -WC.CLENL   CLENI = CLEN[WCI]
          IX7    X2*X7       SIZE = SIZE * CLENI
          CW     X2,X7       SIZE = SIZE / 10 
  
 SSA20    BX1    X1+X5
          MX6    -WC.RAL
          BX7    -X6*X0 
 .T       IFEQ   TEST,ON
          LX1    -WC.RAP
          BX6    -X6*X1      RAI = RA[WCI]
          NZ     X6,"BLOWUP" IF RAI .NE. 0
          LX1    WC.RAP 
 .T       ENDIF 
          BX3    X3*X2
          IX2    X2+X3       SIZE = 2 * SIZE (IF DOUBLE WORD) 
          LX7    WC.RAP 
          BX7    X7+X1
          IX0    X2+X0       VARLEN = VARLEN + SIZE 
          SA7    A1          (RL,RB,RA)[WCI] = (RLI,BN=VAR,VARLEN)[WC.] 
          EQ     SSA10
  
*         UPDATE BLOCK LENGTH FOR (BN=VAR) BLOCK. 
*         (X0) = VARLEN 
  
 SSA30    SB4    F.LBT+BN=VAR 
          SA3    B4          LBVAR = LBT ENTRY FOR VARIABLES
          MX6    -LB.TBLNL
          LX3    -LB.TBLNP
          BX7    X6*X3
          SX4    MAX.SPCM 
          =X1    1
          IX4    X4+X1
          IX4    X0-X4
          MI     X4,SSA40    IF VARIABLE LENGTH .LE. MAX.SPCM 
          SX0    MAX.SPCM 
  
 SSA40    BX7    X7+X0
          LX7    LB.TBLNP 
          SA7    A3          TBLN[LBVAR] = VARLEN 
          EQ     EXIT.
 END      SPACE  4,10 
          LIST   D
          END 
