*COMDECK BLOADG 
          QUAL   LOADG
          ORG    LOCG+1 
  
          COMMENT LOADER - GENERATE OVERLAYS. 
 POD      SPACE  4
**        POD - PROCESS *OVERLAY* DIRECTIVE.
* 
*              CONTROL TRANSFERS HERE ANY TIME AN *OVERLAY* DIRECTIVE 
*         IS READ DURING THE LOADING PROCESS.  IF THIS IS THE FIRST 
*         SUCH OCCURRENCE THEN WE INITIALIZE AND GO INTO OVERLAY
*         GENERATION MODE, ELSE WE MUST COMPLETE THE GENERATION OF
*         THE LAST OVERLAY OR OVERLAY-CAPSULE AND THEN INITIALIZE 
*         FOR THE NEW OVERLAY.
  
 POD      RJ     COD         CRACK *OVERLAY* DIRECTIVE
          SX7    B1 
          MX6    42 
          SA7    OCOG        FLAG OVERLAY GENERATION FORTHCOMING
          SA7    MM          FLAG *LOADC* AS NEEDED 
          SA2    L
          BX6    X6*X2
          SA6    OGLDFIL     SAVE LOAD FILE NAME
          SA1    OG 
          NZ     X1,POD1     IF NOT FIRST TIME
          SA7    A1          FLAG OVERLAY GENERATION IN PROGRESS
          EQ     POD4 
  
 POD1     R=     X1,X1-2
          NZ     X1,POD2     IF OVERLAY GENERATION WAS IN PROGRESS
          RJ     CLOC        COMPLETE LAST OVCAP
          SA2    NEWL1
          ZR     X2,POD3     IF UPCOMING OVERLAY IS (0,0) LEVEL 
          R=     X7,7        ---- ILLEGAL OVCAP/OVERLAY SEQUENCE
          SA7    NEWERR      SET NEW ERROR INDICATOR
          EQ     POD3        CONTINUE 
  
 POD2     RJ     CLO         COMPLETE LAST OVERLAY
 POD3     SA1    FE 
          SA2    NE 
          SA3    MAPTYPE
          BX2    X1+X2
          BX3    X2+X3
          NZ     X3,POD5     IF ERRORS OR IF MAP REQUESTED
 POD4     SA1    NEWERR 
          ZR     X1,POD6     IF NO ERRORS ON OVERLAY CARD 
 POD5     EQ     LMO         GO TO GENERATE A MAP 
                                   (WILL RETURN, IF AT ALL, TO *INO*) 
 POD6     EQ     INO         GO INITIALIZE FOR NEXT OVERLAY 
  
 INO      SPACE  4
**        INO - INITIALIZE FOR NEW OVERLAY
* 
* 
*              THIS ROUTINE IS GIVEN CONTROL AFTER READING AN *OVERLAY* 
*         CARD ON THE LOAD FILE.  THIS CAN HAPPEN IMMEDIATELY IN SOME 
*         CASES (FIRST OVERLAY CARD, OTHERS IF NO MAP) BUT SOMETIMES
*         ONLY AFTER *LOADM* HAS DONE ITS WORK. 
* 
*              WHEN IT IS DETERMINED THAT *INO* IS TO BE GIVEN CONTROL, 
*         THE LOADER IS ALREADY A COUPLE OF LEVELS DEEP IN SUBROUTINES; 
*         BUT THE LOADING OF *LOADM* AND THEN THE RELOADING OF THE
*         ORIGINAL CODE IN THE FORM OF *LOADZ* DESTROYS THE RETURN
*         ADDRESSES.
* 
*              FORTUNATELY, THERE IS ONLY ONE VALID PATH THROUGH THE
*         SUBROUTINES TO *INO*.  THE PROBLEM IS SOLVED, THEN, BY
*         ASSEMBLING THE PROPER RETURN ADDRESS INTO THE ENTRY POINT 
*         OF *LOAD*.  THIS ENTRY POINT MUST NOT BE
*         CHANGED WITHOUT PROVIDING SOME ALTERNATE SOLUTION TO THE
*         PROBLEM JUST MENTIONED. 
* 
*              WE CAN END UP IN *INO* IF CALLED FROM *LMO* AND MAY
*         BE IN ENCAPSULATION.  CHECK FOR ENCAPSULATION AND IF SO 
*         THEN JUMP TO *INCAP*. 
* 
*              WE CAN END UP IN *INO* IF CALLED FROM *LMO* AND MAY BE 
*         IN OVCAP GENERATION.  THE FLAG *OG* INDICATES WHICH MODE WE 
*         WERE IN AND THE FLAG *OCOG* INDICATES WHICH MODE WE ARE TO
*         GO INTO.  CHECK FOR UPCOMING OVCAP GENERATION AND IF SO JUMP
*         TO *INOC*.
  
  
  
 INO      SA1    OG 
          MI     X1,INCAP    IF ENCAPSULATION 
          SA2    OCOG        UPCOMING MODE (1=OVERLAY,2=OVCAP)
          R=     X2,X2-2
          NZ     X2,INO0     IF NOT TO GO INTO OVCAP MODE 
          EQ     INOC        GO INIT FOR NEXT OVCAP 
  
 INO0     SX6    B1 
          SA6    A1          SET (OG)=1 
          MOVE   9,NEWCARD,OGCARD 
          SX6    /TMGR/TOV   SET ADDRESS OF TABLE OVERFLOW ROUTINE
          SA6    TO 
          SA1    TERR+B1     INITIALIZE TERR SIZE TO 2
          SX2    B1+B1
          IX1    X1-X2
          PL     X1,INO1     IF AT LEAST 2 WORDS ALREADY AVAILABLE
          ADDWRD TERR,X1-X1 
          ADDWRD A2,X1
 INO1     SA1    OGBC 
          MX6    1
          BX6    X6+X1
          SA1    TBLK 
          SA6    X1+B1       SET BLANK COMMON BLOCK 
 ECS      IFTEST NE,IP.MECS,0 
          SA2    OGECSBC
          MX6    1
          BX7    X7-X7       RESET ECS LABELLED COMMON WORD COUNT 
          SA7    ECSWCL 
          BX6    X6+X2
          SA6    X1+3        SET UP 2ND WORD OF *TBLK* ENTRY FOR ECS // 
 ECS      ENDIF 
          SX6    B0          X6=0 
          SA6    TLBC2+1
          SA6    PC          ZERO PROGRAM COUNT 
          SA6    XF          ZERO XFER ENTRIES
          SA6    A6+B1
          SA6    A6+B1
          SA6    NE          ZERO ERROR COUNTS
          SA6    FE 
          SA1    NEWL1
          BX7    X1 
          SA6    A1 
          SA7    OGL1        SAVE PRIMARY LEVEL 
          SA2    NEWL2
          BX7    X2 
          SA6    A2 
          SA7    OGL2        SAVE SECONDARY LEVEL 
          SA2    NEWLFN 
          BX7    X2 
          SA6    A2 
          SA7    OGLFN       SAVE LFN 
          NZ     X1,INO2     IF NOT (0,0) 
          SA7    OGLST00     YES, SAVE LFN OF (0,0) 
          SA6    OGSKIP      ZERO VARIOUS FLAGS 
          SA6    HHACM
          SA6    HHAECS 
          R=     X6,377777B 
          SA6    MINPFWA     RESET MINIMUM PRIMARY FWA
          SA2    OG1ST00
          NZ     X2,INO2     IF NOT 1ST (0,0) 
          SA7    A2          YES, SAVE LFN IN CASE OF *EXECUTE* 
          RJ     SOO         SET OVERLAY ORIGIN FOR FIRST (0,0) 
          EQ     INO3        (DON-T RML FOR FIRST (0,0))
  
 INO2     RJ     SOO         SET OVERLAY ORIGIN 
          RJ     RML         REMOVE LINKAGES
 INO3     SA2    OGL2 
          NZ     X2,INO4     IF UPCOMING OVERLAY IS SECONDARY OVERLAY 
          R=     X7,377777B 
          SA7    MINSFWA     RESET MINIMUM SECONDARY FWA
 INO4     BSS    0
          SETFET L,OGLDFIL,BINARY      RESTORE FILE NAME FOR LOAD 
          R=     X7,READ
          SA7    READFUNC    RESTORE READ FUNCTION CODE 
          SA7    L-1
          SA2    TLFN 
          RJ     CTAB=       CLEAR *TLFN* 
          SA1    OGLDFIL
          ADDWRD TLFN,X1     ENTER NAME OF LOAD FILE
          SX6    B0 
          SA6    FI          RESET FILE INDEX 
          SX7    B1 
          SA7    RECORDS
          SA7    REQTYPE
  
 DB       IFTEST NE,IP.LDBG,0 
          SA1    OGL1        PLUG LEVEL  NUMBERS INTO MESSAGE 
          SA2    OGL2 
          R=     B3,3 
          LX0    X1,B3
          LX3    X2,B3
          BX1    X1-X0
          BX2    X2-X3
          R=     X0,707B
          BX1    X0*X1
          BX2    X0*X2
          LX1    18 
          BX2    X1+X2
          LX2    6
          SA1    =10HNG (00,00) 
          IX6    X1+X2
          SA6    MSGL2+1
          SA1    =10H 
          BX6    X1 
          SA6    MSGL2-1
          SA6    A6-B1
          SA6    A6-B1
          SA6    A6-B1
          SMSG   A6          * GENERATING (00,00) OVERLAY ZZZZZZZ * 
 DB       ENDIF 
  
          EQ     LOAD7       CONTINUE LOAD
 CPL      SPACE  4
**        CPL - COMPLETE OVERLAY LOAD 
* 
*         CALLED TO PROCESS *EXECUTE* OR *NOGO* AFTER OVERLAY LOAD. 
* 
*         MAY ALSO BE CALLED TO COMPLETE THE LAST CAPSULE IF
*         ENCAPSULATION.  IN THIS CASE GO TO *CLCAP*. 
* 
*         MAY ALSO BE CALLED TO COMPLETE THE LAST OVCAP.
  
  
 CPL      SA1    OG 
          MI     X1,CLCAP    IF ENCAPSULATION 
          R=     X1,X1-2
          NZ     X1,CPL1     IF NOT OVCAP GENERATION
          RJ     CLOC        COMPLETE LAST OVCAP
          EQ     CPL2 
  
 CPL1     RJ     CLO         COMPLETE LAST OVERLAY
 CPL2     SA1    EX          DAYFILE A *NOGO* COMMAND NOW 
          NZ     X1,CPL3     *EXECUTE* GETS ISSUED ON LOADER RE-LOAD
          SA2    DFMFLAG
          NZ     X2,CPL3     IF ALREADY ISSUED
          SX6    COMLDCC
          SA6    A2 
          MESSAGE  X6,R 
 CPL3     RJ     SPYOFF      TURN OFF *SPY* 
          RJ     RSF         RETURN SYSTEM FILES
          IFNOS  1
          RJ     SSM         CLEAR SSM STATUS IF NECESSARY
          SA1    FE 
          SA2    NE 
          SA3    MAPTYPE
          SA4    CPYF 
          BX1    X1+X2
          BX1    X1+X3
          BX1    X1+X4
          NZ     X1,LMO      IF *LOADM* NEEDED
          RJ     ISD         ISSUE STATISTICS TO DAYFILE
          SA1    EX 
          NZ     X1,XEQ      IF *EXECUTE* 
          R=     X6,4RENDP/16 
          LX6    40 
          RJ     SYS=        ENDRUN 
 RML      SPACE  4
**        RML - REMOVE LINKAGES 
* 
* 
*              THIS ROUTINE REMOVES ALL ENTRY POINTS AND BLOCKS 
*         ABOVE THE MINIMUM LOAD ADDRESS IN PREPARATION FOR THE 
*         NEXT OVERLAY TO BE GENERATED.  THE MINIMUM LOAD ADDRESS 
*         IS THE LWA+1 OF THE CORRESPONDING LOWER LEVEL OVERLAY 
*         (EXCLUDING BLANK COMMON) BUT MAY BE LOWER THAN THIS IF
*         A PREVIOUS OVERLAYS ORIGIN HAS BEEN LOWERED VIA AN *O=* 
*         PARAMETER ON AN *OVERLAY* DIRECTIVE.  THE RULE IS THAT
*         ONCE SOMETHING IS REMOVED IT IS REMOVED FOREVER.
* 
*              NOTE THAT PROGRAM BLOCKS ARE REMOVED ACCORDING 
*         TO THE FWA OF THE BLOCK AND THAT ENTRY POINTS ARE REMOVED 
*         ACCORDING TO THE FWA OF THE BLOCK IN WHICH THE ENTRY
*         POINT WAS DEFINED.
* 
*              TABLE *TUSEP* IS CLEARED FOR THE NEXT LEVEL (*USEP*
*         REQUESTS ARE VALID FOR ONE OVERLAY ONLY) AND IF THE NEXT
*         OVERLAY IS A MAIN ((0,0)) OVERLAY THEN *TLNK* IS REINIT-
*         IALIZED WITH OMITS (AN *OMIT* REQUEST LASTS FOREVER UNLESS
*         OVERRIDEN BY A *USE* REQUEST).
* 
  
  
 RML      PS                 ENTRY/EXIT 
          SX6    B0 
          SA6    TUSEP+1     CLEAR *TUSEP*
          SA1    OGL1 
          NZ     X1,RML1     IF NOT (0,0) 
          SX6    B0 
          SA6    TLNK+1 
          SA1    TOMIT+1     PICK UP *TOMIT* LENGTH 
          ZR     X1,RMLA
          BX2    X1 
          LX2    36 
          R=     X3,0020B 
          LX3    48 
          BX3    X2+X3       X3 = INTERNAL FORM *OMIT* HEADER 
          ADDWRD TREQ2,X3    ADD TO *TREQ2* 
          SA1    TOMIT+1     *TOMIT* LENGTH 
          ALLOC  TREQ2,X1    ALLOCATE SPACE IN *TREQ2*
          SA2    TOMIT       SOURCE ADDRESS 
          MOVE   X1,X2,X3    MOVE *TOMIT* TO *TREQ2*
          RJ     REQD        PROCESS INTERNAL FORM OBJECT DIRECTIVES
 RMLA     BSS    0
          R=     X6,6 
          SA6    TBLK+1 
          SA6    IBI         SET INITIAL *TBLK* INDEX 
          SA1    TFID+1 
          SX7    B1 
          ZR     X1,RML      IF *TFID* EMPTY
          SA7    A1          SET *TFID* LENGTH = 1
          SA2    A1-B1       SET 1ST WORD = 3, TO INDICATE
          AX6    1            NO ENTRIES FOR 1ST 3 *TBLK* ENTRIES 
          SA6    X2 
          EQ     RML         EXIT 
  
 RML1     SA5    MLWCMEB     CALCULATE MINIMUM LOAD ADDRESS IN X5 
          SA1    MINPFWA
          IX2    X5-X1
          MI     X2,RML1A 
          BX5    X1          (X5) = MIN(MLWCMEB,MINPFWA)
 RML1A    SA1    MINSFWA
          IX2    X5-X1
          MI     X2,RML1B 
          BX5    X1 
 RML1B    BSS    0           (X5) = MIN(MLWCMEB,MINPFWA,MINSFWA)
          SA1    OGL2 
          ZR     X1,RML2     IF PRIMARY OVERLAY 
          SA5    PLWCMEB
          SA1    MINSFWA
          IX2    X5-X1
          MI     X2,RML2
          BX5    X1          (X5) = MIN(PLWCMEB,MINSFWA)
 RML2     BSS    0
  
 ECS      IFTEST NE,IP.MECS,0 
          SA1    MLWECS      GET MINIMUM ECS LOAD ADDRESS 
          SA2    OGL2 
          ZR     X2,RML2A    IF PRIMARY OVERLAY 
          SA1    PLWECS 
 RML2A    BX0    X1          (X0) = MINIMUM ECS LOAD ADDRESS
 ECS      ENDIF 
  
          SA1    TLNK 
          SA2    A1+B1
          SB2    X2          B2=TABLE LENGTH
          R=     A2,X1-1
          BX7    X2 
          SA7    A2 
 RML3     ZR     B2,RML4     IF END OF OF TABLE 
          R=     B2,B2-2
          SA1    A2+B1       PICK UP 1ST WORD OF TABLE ENTRY
          SA2    A1+B1       PICK UP 2ND WORD OF TABLE ENTRY
          BX3    X2 
          LX3    1
          MI     X3,RML3     IF *UNSAT* THEN REMOVE 
          LX3    1
          MI     X3,RML3A    IF *OMIT* CHECK FURTHER
          BX3    X2 
          AX3    36 
          MX4    -18
          BX3    -X4*X3      (X3)=*TBLK* INDEX
          SA4    OCBPI
          ZR     X4,RML3A3   IF NOT REMOVING AFTER OVCAP GEN
          NZ     X3,RML3A2   IF NOT REFERENCE IN CM //
          SA4    OCOGBC 
          ZR     X4,RML3     IF CM // DEFINED IN OVCAP (REMOVE) 
          EQ     RML3A3      CONTINUE 
  
 RML3A2   IX4    X3-X4       THIS *PI* - INIT OVCAP *PI*
          PL     X4,RML3     IF BLOCK IS IN OVCAP (REMOVE)
 RML3A3   BSS    0
          SA4    TBLK        (X4)=FWA *TBLK*
          IX3    X3+X4       (X3)=ADDR *TBLK* ENTRY 
          SA3    X3          *TBLK* ENTRY 
          SA4    A3+B1       *TBLK* DEFINITION
          MX6    -24
          BX6    -X6*X4      (X6) = BLOCK ADDRESS 
  
 ECS      IFTEST NE,IP.MECS,0 
          LX3    59-1 
          MI     X3,RML3E    IF ECS ENTRY POINT 
 ECS      ENDIF 
  
          IX3    X5-X6       (MIN CM ADR) - (BLOCK ADR) 
          MI     X3,RML3     IF ENTRY POINT IS TO BE OVERLAID 
 RML3A    BSS    0
          LX6    X1 
          BX7    X2 
          LX2    2
          PL     X2,RML3B    IF NOT *OMIT* THEN SAVE
          SA3    TOMIT       X3 = FWA *TOMIT* 
          SA4    A3+B1       X4 = LENGTH *TOMIT*
          ZR     X4,RML3     IF NO *TOMIT* MATCH THEN REMOVE
*                            I.E. UNSAT EXTER DISGUISED AS OMITS
          SB6    X3          B6 = *TOMIT* FWA (POINTER) 
          SB7    X4+B6       B7 = *TOMIT* LWA+1 (LIMIT) 
 RML3A1   GE     B6,B7,RML3  IF NO *TOMIT* MATCH THEN REMOVE
          SA3    B6          GET NEXT *TOMIT* NAME
          LX3    -18         ADJUST TO *TLNK* FORMAT
          BX3    X3-X6       COMPARE NAMES
          ZR     X3,RML3B    IF SAME THEN SAVE
          SB6    B6+B1       BUMP *TOMIT* POINTER 
          EQ     RML3A1      CONTINUE 
 RML3B    BSS    0
          SA6    A7+B1       SAVE 1ST WORD
          SA7    A6+B1       SAVE 2ND WORD
          EQ     RML3 
  
 ECS      IFTEST NE,IP.MECS,0 
 RML3E    IX3    X6-X0       (BLOCK ADR) - (MIN ECS ADR)
          PL     X3,RML3     IF ENTRY POINT IS TO BE OVERLAID 
          EQ     RML3A       KEEP ENTRY POINT 
  
 ECS      ENDIF 
  
 RML4     SA1    TLNK 
          SX2    A7+B1
          IX6    X2-X1
          SA6    A1+B1       SET NEW TABLE LENGTH 
          SA1    TBLK 
          SA2    A1+B1
          R=     B2,X2-6
          R=     A2,X1+5
          BX7    X2 
          SA7    A2 
          MX4    -24
 RML5     ZR     B2,RML6     IF END OF TABLE
          R=     B2,B2-2
          SA1    A2+B1       PICK UP 1ST WORD OF TABLE ENTRY
          SA2    A1+B1       PICK UP 2ND WORD OF TABLE ENTRY
          BX6    -X4*X2      (X6) = BLOCK ADDRESS 
  
 ECS      IFTEST NE,IP.MECS,0 
          BX3    X1 
          LX3    59-1 
          MI     X3,RML5B    IF ECS BLOCK 
 ECS      ENDIF 
  
          IX3    X5-X6       (MIN CM ADR) - (BLOCK ADR) 
          MI     X3,RML5     IF BLOCK WILL BE OVERLAID
 RML5A    BSS    0
          BX6    X1 
          BX7    X2 
          SA6    A7+B1       SAVE 1ST WORD
          SA7    A6+B1       SAVE 2ND WORD
          EQ     RML5 
  
 ECS      IFTEST NE,IP.MECS,0 
 RML5B    IX3    X6-X0       (BLOCK ADR) - (MIN ECS ADR)
          PL     X3,RML5     IF BLOCK WILL BE OVERLAID
          EQ     RML5A       KEEP BLOCK 
  
 ECS      ENDIF 
  
 RML6     SA1    TBLK 
          SX2    A7+B1
          IX6    X2-X1
          SA6    A1+B1       SET NEW TABLE LENGTH 
          AX2    X6,B1       (X2) = NO. OF *TBLK* ENTRIES REMAINING 
          SA6    IBI
          SA1    ID 
          LX1    59-0 
          PL     X1,RML7     IF NO *TFID* TABLE 
          SA1    TFID 
          SA4    X1 
          SA3    A1+B1
          ZR     X3,RML7     IF *TFID* EMPTY
          IX7    X4-X2
          MI     X7,RML6B    IF SOME *TFID* ENTRIES TO REMAIN 
          BX6    X2          SET *TFID* HEADER WORD = CURRENT 
          SA6    X1           NUMBER OF *TBLK* ENTRIES, AND 
          SX7    B1            SET LENGTH = 1 
          SA7    A3 
          EQ     RML7 
  
 RML6B    BX4    -X7         SET *TFID* LENGTH TO REFLECT THOSE 
          LX4    1            ENTRIES LEFT IN *TBLK*
          IX4    X4-X7
          SX7    X4+B1
          SA7    A3 
 RML7     BSS    0
          SA1    OCBPI
          ZR     X1,RML6A    IF NOT REMOVING AFTER OVCAP GEN
          BX6    X1 
          SA6    TBLK+1      SET *TBLK* LENGTH TO EXCLUDE LAST OVCAP
 RML6A    MX6    0
          SA6    OCBPI       ZERO OVCAP BASE *PI* 
          EQ     RML         EXIT 
 SOO      SPACE  4
**        SOO - SET OVERLAY ORIGIN. 
* 
*              THIS ROUTINE IS CALLED TO SET THE ORIGIN ADDRESS FOR 
*         THE NEXT OVERLAY TO BE GENERATED.  IT USES VALUES SET BY
*         ROUTINE */LOADG/COS* WHICH ALTER THE ORIGIN AT WHICH THE
*         OVERLAY WILL RESIDE.  CELLS *NEWORG* AND *NEWMAXOV* CONTAIN 
*         VALUES WHICH MAY ALTER THE ORIGIN.
* 
*         ENTRY  *NEWORG* AND *NEWMAXOV* AS SET BY *COS*. 
*         EXIT   *PO*, *PA*, *BI*, *ECSPO*, *ECSPA*, AND *MAXOV* SET. 
*                NECESSARY SPACE ALLOCATED IN *TPGM*. 
* 
*         CALLS  APS=.
  
  
 SOO      PS                 ENTRY/EXIT 
          SA3    NEWORG 
          SX6    X3          X6 = ADDRESS OR OFFSET 
          AX3    18          X3 = ENTRY POINT NAME
          MI     X3,SOO4     IF BLANK COMMON LENGTH SPECIFIED 
          ZR     X3,SOO4B    IF NO ENTRY POINT NAME SPECIFIED 
          SA1    OGL1 
          ZR     X1,SOO8     ILLEGAL IF (0,0) OVERLAY 
          SA1    TLNK 
          SA2    A1+B1
          SA1    X1 
 SOO1     BX1    X1-X3
          ZR     X1,SOO3     IF ENTRY POINT FOUND 
          R=     A1,A1+2
          R=     X2,X2-2
          NZ     X2,SOO1
 SOO2     BX7    X3 
          LX7    18 
          ERROR  4206,X7     NE4206  EPT IN ORIGIN SPEC NOT FOUND 
          SX6    B0 
          EQ     SOO5 
  
 SOO3     SA1    A1+B1
          BX2    X1 
          LX2    1
          MI     X2,SOO2     IF UNSATISFIED EXTERNAL
          SX3    X1 
          EQ     SOO6 
  
 SOO4     SA1    OGL1 
          ZR     X1,SOO8     BLANK COM SPEC ILLEGAL ON (0,0)
          SA1    OGBCLVL
          SA2    OGL2 
          NZ     X2,SOO4A    IF SECONDARY OVERLAY 
          R=     X1,X1+1
 SOO4A    R=     X1,X1-2
          NZ     X1,SOO9     IF NO COMMON AT LOWER OVERLAY
          SA3    OGBC        PICK UP ORIGIN 
          EQ     SOO6 
  
 SOO4B    ZR     X6,SOO5     IF NO OFFSET SPECIFIED 
          R=     X1,X6-110B 
          MI     X1,SOO8     IF ORIGIN LESS THAN 110B 
          SA1    OGL1 
          ZR     X1,SOO8     ORIGIN ILLEGAL ON (0,0) OVERLAY
          EQ     SOO6 
  
 SOO5     R=     X3,BASE     (X3) = ORIGIN
          SA1    OGL1 
          ZR     X1,SOO6     IF (0,0) OVERLAY 
          SA3    MLWCM
          SA1    OGL2 
          ZR     X1,SOO6     IF PRIMARY OVERLAY 
          SA3    PLWCM
 SOO6     SA1    OGL1 
          SX2    4           (X2) = LENGTH OF 54-HEADER FOR NON-(0,0) 
          SA4    TPGM 
          SB5    X4+4        (B5) = ABS STORE ADDRESS FOR E.P. NAME 
          NZ     X1,SOO6A3   IF NOT (0,0) OVERLAY 
          MX7    0
          LX2    1           (X2) = 10B = LENGTH OF 54-HEADER FOR (0,0) 
          SB5    B5+4 
          SA5    TCPENT+1    LENGTH OF *TCPENT* 
          SB6    B0          (B6) = NO. ENTRY NAMES FROM *TCPENT* 
          ZR     X5,SOO6A3   IF *TCPENT* EMPTY
          SA4    A5-B1
          SA7    A5          CLEAR *TCPENT* 
          SB7    X5          (B7) = REMAINING TABLE ENTRIES 
          SA1    X4-1        INITIALIZE FETCH 
 SOO6A1   SA1    A1+B1       NEXT TABLE ENTRY 
          SB7    B7-B1
          SX4    X1 
          NZ     X4,SOO6A2   SKIP *NOEPT* ENTRIES 
          SB6    B6+B1       BUMP PROGRAM ENTRY COUNT 
          BX7    X1          STORE ENTRY NAME IN HEADER IN *TPGM* 
          SA7    B5 
          SB5    B5+B1
 SOO6A2   NZ     B7,SOO6A1   LOOP THROUGH *TCPENT*
          NZ     B6,SOO6A4   IF ONE OR MORE *EPT* NAMES FOUND 
 SOO6A3   SB6    B1          SET FOR ONE ENTRY POINT
          MX7    0           CLEAR IT IN HEADER IN *TPGM* 
          SA7    B5 
 SOO6A4   SX7    B6          RESET NUMBER OF ENTRY POINTS 
          SA7    EPTC 
          IX3    X6+X3       OFFSET + ORIGIN
          IX6    X2+X7       TOTAL HEADER LENGTH
          SA6    BI          (BI) = HEADER LENGTH 
          SA6    TPGM+1      SET LENGTH OF *TPGM* TO THE SAME 
          IX6    X6+X3
          SA6    PO          SET PROGRAM ORIGIN 
          SA6    PA          SET PROGRAM ADDRESS
          SA1    OGL1 
          SA2    NEWMAXOV 
          ZR     X2,SOO6B1   IF NO *OV* SPECIFIED 
          MI     X2,SOO6B    IF INVALID *OV* SPECIFICATION
          R=     X6,40000D   VALIDATE 0.LE.*OV*.LE.20000D 
          IX6    X6-X2
          MI     X6,SOO6B    IF INVALID *OV* SPECIFICATION
          ZR     X1,SOO6C    IF (0,0) OVERLAY UPCOMING
 SOO6B    ERROR  4211        ---- ILLEGAL OV SPECIFICATION
 SOO6B1   SA1    OGL1 
          NZ     X1,SOO6D    IF NOT (0,0) LEAVE *MAXOV* ALONE 
          MX6    0
          SA6    MAXOV       SET *MAXOV* = 0 (NO *FOL* DIRECTORY) 
          EQ     SOO6D       PRETEND NOTHING SPECIFIED
  
 SOO6C    BX6    X2 
          SA6    MAXOV       SET *MAXOV* FOR LATER USE
          SA1    BI 
          SA3    PO 
          IX6    X1+X2
          IX7    X3+X2
          SA6    A1          BUMP (BI) BY 2*OV
          SA7    A3          BUMP (PO) BY 2*OV
          BX1    X2          (X1) = SPACE TO ALLOCATE IN *TPGM* 
          MX2    0           (X2) = 0 (INDICATES CM SPACE)
          RJ     APS=        ALLOCATE SPACE IN *TPGM* 
*                            APS= ALSO PRESETS THE SPACE AND BUMPS *PA* 
 SOO6D    BSS    0
          SA1    OGL1 
          ZR     X1,SOO6F    IF MAIN OVERLAY
          SA1    OGL2 
          SA2    MINPFWA
          ZR     X1,SOO6E    IF PRIMARY OVERLAY 
          SA2    MINSFWA
 SOO6E    SA1    PO 
          SA3    BI 
          IX6    X1-X3       (X6) = (PO)-(BI) 
          IX1    X6-X2
          PL     X1,SOO6F    IF (PO-BI).GE.MINPFWA (OR MINSFWA) 
          SA6    A2          SET MINPFWA=PO-BI (OR MINSFWA=PO-BI) 
 SOO6F    BSS    0
  
 ECS      IFTEST NE,IP.MECS,0 
          SX1    B0 
          SA2    OGL1 
          ZR     X2,SOO7     IF (0,0) OVERLAY 
          SA1    MLWECS 
          SA2    OGL2 
          ZR     X2,SOO7     IF PRIMARY OVERLAY 
          SA1    PLWECS 
 SOO7     BX6    X1 
          SA6    ECSPO
          SA6    ECSPA
 ECS      ENDIF 
  
          EQ     SOO         EXIT 
  
  
 SOO8     ERROR  4204        NE4204  ILLEGAL ORIGIN SPECIFICATION 
          SX6    B0 
          EQ     SOO5        PRETEND NOTHING SPECIFIED
  
 SOO9     ERROR  4205        NE4205  CNNNNNN IGNORED NO // BELOW
          SX6    B0 
          EQ     SOO5 
 CLO      SPACE  4
**        CLO - COMPLETE LAST OVERLAY 
* 
* 
*                THIS SUBROUTINE FINISHES THE GENERATION OF AN OVERLAY, 
*         SATISFYING EXTERNALS AND SO FORTH.  THEN THE OVERLAY IS 
*         WRITTEN OUT WITH A 77-TABLE AND A 54-TABLE. 
  
  
 CLO      PS                 ENTRY/EXIT 
          RJ     CPR         COMPLETE READ
          SB7    B0 
          RJ     SAT         SATISFY EXTERNALS
          SA1    OGL1 
          NZ     X1,CLO00B   IF NOT MAIN OVERLAY
          SA1    TPGM        (X1) = FWA *TPGM*
          R=     A1,X1+10B   (X1)=FIRST EPT NAME FROM *TPGM* HEADER 
          ZR     X1,CLO00B   IF NO EPT NAME EXISTS THERE
          MX7    42          ELSE WE HAVE NAMES FROM *EPT=* 
          BX7    X7*X1       42/NAME,18/0 
          SA7    XF+1        USE FIRST *EPT=* NAME AS XFER ADDRESS
 CLO00B   BSS    0
          RJ     PNF         PROCESS PROGRAMS NOT FOUND 
          RJ     USX         PROCESS UNSATISFIED EXTERNALS
          IFSCOPE 3 
          R=     X7,2030B 
          SA7    T1 
          LDL    A7          CLEAR *EDITLIB* INTERLOCK
          SA1    TBLK 
          SA2    X1+B1
          MX6    36 
          SA3    OGBC        GET CURRENT CM // ORIGIN 
          BX3    -X6*X3      SAVE ONLY ORININ OF CM //
          BX6    X2*X6       SAVE ONLY LENGTH CM // AND REF FLAG
          BX6    X6+X3       MERGE THE ABOVE
          SA6    A2          MODIFY *TBLK* CM // ENTRY
          BX2    X6          (X2)=*TBLK* CM // ENTRY
          SX6    X2 
          SA3    PA          GET *PA* BEFORE UPDATE FOR //
          BX7    X3          SAVE IN X7 
          SA3    OGL2 
          NZ     X3,CLO00A   IF SECONDARY OVERLAY 
          SA7    PLWCMEB     SET PRIMARY LWA+1 EXCLUDING // 
          SA3    OGL1 
          NZ     X3,CLO00A   IF PRIMARY OVERLAY 
          SA7    MLWCMEB     SET MAIN LWA+1 EXCLUDING //
 CLO00A   BSS    0
          NZ     X6,CLO00    IF BLANK COMMON ORIGIN ALREADY SET 
          SA1    PA 
          BX6    X2+X1
          SA6    A2          SET IT 
          AX2    24 
          SX2    X2 
          IX6    X1+X2       SET FINAL *PA* VALUE 
          SA6    A1 
 ECS      IFTEST NE,IP.MECS,0 
          SA2    A2+2        GET DISCRIPTION WORD OF ECS // FROM *TBLK* 
          MX6    36 
          SA3    OGECSBC     GET CURRENT ECS // ORGIN 
          BX3    -X6*X3      SAVE ONLY ORIGIN OF ECS // 
          BX6    X2*X6       SAVE ONLY LENGTH ECS // AND REF FLAG 
          BX6    X6+X3       MERGE THE ABOVE
          SA6    A2          MODIFY *TBLK* ECS // ENTRY 
          BX2    X6          (X2)=*TBLK* ECS // ENTRY 
          SX6    X2 
          SA1    ECSPA
          NZ     X6,CLO00    IF ECS // ORIGIN ALREADY SET 
          SA3    OGEBCLV
          NZ     X3,CLO00    IF ECS // ALREADY ESTABLISHED
          BX6    X2+X1
          SA6    A2          SET IT 
          AX2    24 
          SX2    X2 
          IX6    X1+X2       SET FINAL *ECSPA* VALUE
          SA6    A1 
 ECS      ENDIF 
 CLO00    RJ     RBE         RELOCATE // ENTRY POINTS 
          RJ     FBC         PROCESS FILL BYTE CHAINS 
          RJ     LBC         PROCESS LINK BYTE CHAINS 
          RJ     PBC         PROCESS BLANK COMMON 
          SA1    XF+1        GET XFER NAME
          SX2    B0 
          RJ     ELT
          SA1    A1 
          MX7    42 
          BX7    X7*X1       ISOLATE NAME 
          SX2    X2          ISOLATE ADDRESS
          BX7    X7+X2
          SA7    XF          SAVE BOTH
          NZ     X2,CLO01    IF NONZERO TRANSFER ADDRESS
          ERROR  106,X7      *TRANSFER POINT NOT FOUND* 
 CLO01    SA1    PA 
          SA2    HHACM
          IX2    X1-X2
          BX6    X2 
          AX6    59 
          BX2    X6*X2
          IX6    X1-X2
          SA6    A2          SET NEW HHA = MAX(OLDHHA,PA) 
          SA2    OGL2 
          NZ     X2,CLO0A    IF SECONDARY OVERLAY 
          BX6    X1 
          SA6    PLWCM       SAVE LWA+1 
          SA1    OGL1 
          NZ     X1,CLO0A    IF PRIMARY OVERLAY 
          SA6    MLWCM
 CLO0A    BSS    0
 ECS      IFTEST NE,IP.MECS,0 
          SA1    ECSPA
          SA2    HHAECS 
          IX2    X1-X2
          BX6    X2 
          AX6    59 
          BX2    X6*X2
          IX6    X1-X2
          SA6    A2          SAME FOR ECS 
          SA2    OGL2 
          NZ     X2,CLO0B    IF SECONDARY OVERLAY 
          BX6    X1 
          SA6    PLWECS      SAVE LWA+1 
          SA1    OGL1 
          NZ     X1,CLO0B    IF PRIMARY OVERLAY 
          SA6    MLWECS 
 CLO0B    BSS    0
 ECS      ENDIF 
          SA1    OGLFN
          SA2    OGLST00
          BX5    X2-X1
          ZR     X5,CLO0C    IF WRITING TO SAME FILE AS (0,0) 
          SA5    MAXOV
          ZR     X5,CLO1     IF NO *FOL* DIRECTORY GENERATION 
          BX6    X2 
          SA6    A1          SET *OGLFN* TO *OGLST00* (FORCE SAME FILE) 
          ERROR  4210        ---- FORCING ALL BINARIES TO SAME FILE 
 CLO0C    BSS    0
          SA2    OGSKIP 
          SX7    X2+B1       SAME FILE, BUMP SKIP COUNT 
          SA7    A2 
  
**             THE 54-TABLE HEADER IS BUILT AND THE FILE TO RECEIVE 
*         THE OVERLAY IS DETERMINED.  THE OVERLAY IS THEN WRITTEN TO
*         THE FILE.  IF *FOL* GENERATION AND A HIGHER LEVEL OVERLAY 
*         IS BEING GENERATED, THEN THE PRU OFFSET OF THE OVERLAY IS 
*         ADDED TO THE *TCII* TABLE.  IF NO MORE OVERLAYS OR OVCAPS 
*         FOLLOW, THEN THE 54-TABLE OF THE (0,0) OVERLAY IS REWRITTEN 
*         TO INCLUDE *HHA*, *LHHA*, AND THE *FOL* DIRECTORY.
  
 CLO1     RJ     B54         BUILD 54-TABLE HEADER
          RJ     SOF         SET FILE 
  
**             THE INPUT FILE (*OGLDFIL*) IS CHECKED AGAINST THE
*         OUTPUT FILE (*OGLFN*) AND IF THEY ARE THE SAME A FATAL
*         ERROR OCCURS AND THE LOAD IS ABORTED. 
  
          SA1    OGLFN       OUTPUT FILE
          SA2    OGLDFIL     INPUT FILE 
          BX6    X1-X2
          NZ     X6,CLO1B    IF FILES ARE NOT THE SAME
          SA2    OGLST00     FILE TO RECEIVE *ERRORS IN ...*
          BX6    X1-X2
          NZ     X6,CLO1A    IF NOT SAME AS INPUT FILE
          SA6    A2          INDICATE NOT TO WRITE *ERRORS IN ...*
 CLO1A    BX7    X1          FILE BEING INCONSISTENTLY USED 
          ERROR  246,X7      ---- INCONSISTENT FILE USAGE 
          EQ     ABEND       ABORT
  
 CLO1B    BSS    0
          RJ     WOV         WRITE OVERLAY
          SA1    OGL1 
          SA2    MAXOV
          ZR     X1,CLO      IF (0,0) OVERLAY 
          ZR     X2,CLO2     IF NOT *FOL*-GENERATION
          SA1    TCII        (X1) = FWA *TCII*
          SA2    A1+B1       (X2) = LENGTH *TCII* 
          IX1    X1+X2
          R=     A1,X1-2     (X1) = *TCII* TABLE ENTRY, (A1) = ADDR 
          SA2    HHAPRU      PRU OF (0,0) OVERLAY 
          SA3    FOLCRI      PRU OF THIS OVERLAY
          IX6    X3-X2
          LX6    18          12/0,30/REL PRU,18/0 
          BX6    X1+X6       6/L1,6/L2,30/RELPRU,18/LWA+1 
          SA6    A1          REWRITE *TCII* TABLE ENTRY (PLUG REL PRU)
          RJ     CFO         CHECK FOR *FOL* OVERFLOW 
 CLO2     SA1    NEWL1
          NZ     X1,CLO      IF MORE OVERLAYS/OVCAPS FOLLOW 
          SA2    MAXOV
          NZ     X2,CLO2A    *FOL* DIRECTORY
          SA1    TCII+B1
          ZR     X1,CLO2A 
          SA2    A1-B1
          RJ     CTAB=       CLEAR *CID*/*PMD* INFORMATION
 CLO2A    RJ     P54         PLUG 54-TABLE
          EQ     CLO         EXIT 
 PBC      SPACE  4
**        PBC - PROCESS BLANK COMMON
* 
* 
*              THIS ROUTINE IS CALLED BY *CLO* TO SET *OGBC*, *OGBCL*,
*         AND *OGBCLVL* FOR THE NEXT OVERLAY. 
* 
* 
*         IF BLANK COMMON SPECIFIED BY CURRENT OVERLAY
*             IF FIRST DECLARED BY LOWER OVERLAY
*                 IF ATTEMPTED TO USE MORE THAN ORIGINALLY DEFINED
*                     TRUNCATE AND ISSUE ERROR MESSAGE
*             ELSE
*                 IF NOT SECONDARY OVERLAY
*                     SET OGBC = BLANK COMMON ORIGIN
*                     SET OGBCL = BLANK COMMON LENGTH 
*                     SET OGBCLVL =1 IF (0,0) OR =2 IF PRIMARY
* 
*         IF BLANK COMMON SPECIFIED BY CURRENT OR LOWER LEVEL OVERLAY 
*             IF ORIGINALLY DECLARED BY PRIMARY AND NEXT OVLY IS PRIMARY
*             OR IF NEXT OVERLAY IS (0,0) 
*                 SET OGBC=OGBCL=OGBCLVL=0. 
  
  
 PBC      PS                 ENTRY/EXIT 
          SA3    TBLK 
          SA3    X3+B1       X3= 2ND WORD OF *TBLK* ENTRY FOR //
          MI     X3,PBC2     IF // NOT REFERENCED 
          SA1    OGBCLVL
          ZR     X1,PBC1     IF NOT DEFINED AT LOWER LEVEL
          BX2    X3 
          AX2    24 
          SX2    X2          X2=LENGTH USED BY CURRENT OVERLAY
          SA1    OGBCL       X1=LENGTH ORIGINALLY DEFINED 
          IX1    X1-X2
          PL     X1,PBC2     IF LENGTH NOT EXCEEDED 
          LX3    -24
          IX6    X3+X1
          LX6    24 
          SA6    A3 
          ERROR  4106        NE4106  SPEC LGR // THAN DCL BELOW 
          EQ     PBC2 
  
 PBC1     SA1    OGL2 
          NZ     X1,PBC2     IF SECONDARY OVERLAY 
          SX6    X3 
          SA6    OGBC        SET OGBC 
          LX3    -24
          SX6    X3 
          SA6    OGBCL       SET OGBCL
          SX6    B1 
          SA6    OGBCLVL     SET OGBCLVL
          SA1    OGL1 
          ZR     X1,PBC2
          SX6    X6+B1
          SA6    A6 
 PBC2     SA2    OGBCLVL
          ZR     X2,PBC4     IF NO SIGN OF CM //
          SA1    NEWL1
          ZR     X1,PBC3     IF NEXT OVERLAY (0,0)
          SA1    NEWL2
          NZ     X1,PBC4     IF NEXT OVERLAY IS SECONDARY 
          R=     X2,X2-2
          NZ     X2,PBC4     IF CM // NOT DEFINED BY LAST PRIMARY 
 PBC3     SX6    B0 
          SA6    A2          CLEAR BLANK COMMON FLAGS 
          SA6    OGBC 
          SA6    OGBCL
 PBC4     SA4    OG 
          SX4    X4-2 
          ZR     X4,PBC      NO ECS // WITH OVCAPS
 ECS      IFTEST NE,IP.MECS,0 
          SA4    A3+2        (X4)=SECOND WORD OF *TBLK* ENTRY FOR ECS// 
          MI     X4,PBC6     IF ECS // NOT REFERENCED 
          SA1    OGEBCLV
          ZR     X1,PBC5     IF NOT DEFINED AT LOWER LEVEL
          BX2    X4 
          AX2    24 
          SX2    X2          (X2)=LENGTH USED BY CURRENT OVERLAY
          SA1    OGEBCL      (X1)=LENGTH ORIGINALLY DEFINED 
          IX1    X1-X2
          PL     X1,PBC6     IF LENGTH NOT EXCEEDED 
          LX4    -24
          IX6    X4+X1
          LX6    24 
          SA6    A4 
          ERROR  4106 
          EQ     PBC6        NE4106 SPEC LGR // THAN DCL BELOW
  
 PBC5     SA1    OGL2 
          NZ     X1,PBC6     IF SECONDARY OVERLAY 
          SX6    X4 
          SA6    OGECSBC     SET OGESCSBC 
          LX4    -24
          SX6    X4 
          SA6    OGEBCL      SET OGEBCL 
          SX6    B1 
          SA6    OGEBCLV     SET OGEBCLV
          SA1    OGL1 
          ZR     X1,PBC6
          SX6    X6+B1
          SA6    A6 
 PBC6     SA2    OGEBCLV
          ZR     X2,PBC      IF NO SIGN OF ECS //, EXIT 
          SA1    NEWL1
          ZR     X1,PBC7     IF NEXT OVERLAY (0,0)
          SA1    NEWL2
          NZ     X1,PBC      IF NEXT OVERLAY IS SECONDARY, EXIT 
          R=     X2,X2-2
          NZ     X2,PBC      IF // NOT DEFINED BY LAST PRIMARY
 PBC7     SX6    B0 
          SA6    A2          CLEAR ECS // FLAGS 
          SA6    OGECSBC     SET OGESCSBC 
          SA6    OGEBCL 
 ECS      ENDIF 
          EQ     PBC         EXIT 
 SOF      SPACE  4,8
**        SOF - SET OVERLAY OR OVCAP FILE.
* 
*              THIS ROUTINE IS CALLED FROM *CLO* OR *CGWC* AND IS 
*         RESPONSIBLE FOR SETTING UP THE FET.  THE SPECIFIED FILE 
*         NAME IS IN *OGLFN*.  IF *FOL* GENERATION AND HIGHER LEVEL 
*         OVERLAYS OR OVCAPS ARE UPCOMING, THEN WE HAVE ALREADY 
*         FORCED ALL BINARIES TO BE WRITTEN TO THE SAME FILE BY 
*         SETTING *OGLFN* ACCORDINGLY.  IF THE OVERLAY IS A (0,0) 
*         OVERLAY WHICH WILL HAVE HIGHER LEVEL OVERLAYS OR OVCAPS 
*         AND THE OVERLAY IS TO BE WRITTEN TO A TAPE FILE, THEN WE
*         MUST SPOOL TO A DISK FILE (ZZZZZ32) SO THAT WE WILL BE
*         ABLE TO REWRITE THE 54-HEADER OF THE (0,0) OVERLAY TO 
*         INCLUDE *HHA*, *LHHA*, AND THE *FOL* DIRECTORY.  IF WE
*         ARE ALREADY SPOOLING THEN CONTINUE SPOOLING.  IF WE ARE 
*         WRITING A (0,0) OVERLAY THEN EITHER SET THE PRU NUMBER
*         IN *HHAPRU* (IF AVAILABLE) OR SET THE RANDOM BIT AND HAVE 
*         *CIO* RETURN THE PRU NUMBER IN *HHAPRU*.  IF WE ARE 
*         WRITING A HIGHER LEVEL OVERLAY OR OVCAP AND ARE GENERATING
*         AN *FOL* DIRECTORY, THEN SET THE RANDOM BIT AND HAVE
*         *CIO* RETURN THE PRU NUMBER IN *FOLCRI*.
* 
*         NOTE - IF NOT GENERATING AN *FOL* DIRECTORY THEN THE FET
*                SHOULD BE SET FOR A SEQUENTIAL WRITE TO ENSURE 
*                THAT BINARIES ARE WRITTEN TO EXISTANT FILES AT 
*                CURRENT POSITION AND NOT AT *EOI*. 
  
 SOF      PS                 ENTRY/EXIT 
          SA1    OGL1 
          SA2    CPYF 
          ZR     X1,SOF3     IF (0,0) OVERLAY 
          SA1    OGLFN       SET UP TO USE *OGLFN*
          ZR     X2,SOF1     IF NOT SPOOLING
          SA1    Z32         SET UP TO USE *ZZZZZ32*
 SOF1     SETFET L,A1,BINARY
          SA2    MAXOV
          ZR     X2,SOF      IF NOT *FOL* GENERATION, SEQUENTIAL WRITE
          SX6    FOLCRI      ADDR OF WORD TO RECEIVE PRU NUMBER 
 SOF2     SA1    L+1         READ FET+1 
          SX7    B1 
          SA6    L+6         SET ADDR OF WORD TO RECEIVE CRI INTO FET+6 
          LX7    47-0 
          BX7    X1+X7
          SA7    A1          SET RANDOM BIT IN FET+1
          EQ     SOF         EXIT 
  
 SOF3     ZR     X2,SOF4     IF NOT ALREADY SPOOLING
          SETFET L,Z32,BINARY  SET UP TO USE *ZZZZZ32*
          SX6    HHAPRU      ADDR OF WORD TO RECEIVE PRU NUMBER (CRI) 
          EQ     SOF2        GO PUT INTO FET, SET RANDOM BIT, THEN EXIT 
  
 S        IFSCOPE 
 SOF4     R=     X2,50000B   SET UP FOR *FILINFO* CALL
          SA1    OGLFN
          BX6    X1+X2       42/OGLFN,6/5,12/0
          SA6    T1          SET (T1) = 42/OGLFN,6/5,12/0 
          FILINFO  T1        CALL *FILINFO* FOR *OGLFN* (RECALL)
          SA1    T1+1        (X1) BIT 18 OR 19 SET THEN MAG TAPE
          SX6    B1          SET TO USE PRU 1 FOR NONEXISTANT FILE
          SA2    T1+3        (X2) BITS 29 THRU 6 = PRU NUMBER 
          NZ     X1,SOF6     IF FILE EXISTS ALREADY (0=NO)
 S        ENDIF 
 K        IFNOS 
 SOF4     SETFET L,OGLFN,BINARY    IFNOS USE *OPENNR* VS *FILINFO*
  
*                            IF *NOS* THEN USE *OPENNR* VS *FILINFO*. 
*                            SET RANDOM BIT SO THAT *OPENNR* WILL 
*                            RETURN CRI (IN FET+6).  IF=0 (IN FET+7)
*                            SO NO INDEX BUFFER NEEDED AND *CIO*
*                            CLEARS THE RANDOM BIT IN FET+1.
  
          MX0    1
          SA1    L+1
          LX0    -12
          BX6    X1+X0
          SA6    A1          SET RANDOM BIT IN FET+1
          OPENNR L,RCL
          SA1    L+1         CHECK DEVICE TYPE
          AX1    1           BITS 59/58 SET IF MAG TAPE 
          BX7    X1 
          LX1    19-59       (X1) BITS 19/18 SET IFF MAG TAPE 
          SA2    L+6         CURRENT RANDOM INDEX (CRI) FROM FET+6
          AX2    30 
          LX2    6           (X2) = 30/0, 24/PRU NUMBER, 6/0
          SX6    B1          SET TO USE PRU 1 FOR NONEXISTANT FILE
          MI     X7,SOF6     IF TAPE FILE 
          NZ     X2,SOF6     IF FILE EXISTS ALREADY (0=NO)
 K        ENDIF 
 SOF5     SA6    HHAPRU      SET PRU NUMBER INTO *HHAPRU* 
          SETFET L,OGLFN,BINARY    SET TO USE *OGLFN* 
          EQ     SOF         EXIT 
  
 SOF6     BSS    0           (X2) BITS 29 THRU 6 = PRU NUMBER (CRI) 
*                            (X1) BITS 18 OR 19 SET IFF MAG TAPE
          MX3    -24
          LX2    -6 
          BX6    -X3*X2      (X6) = PRU NUMBER (36/0,24/PRU)
          NZ     X6,SOF7     IF PRU NUMBER NONZERO
          SX6    B1          USE PRU 1 FOR EXISTANT BUT EMPTY FILE
 SOF7     BSS    0
          SA3    NEWL1
          LX1    59-19
          ZR     X3,SOF5     IF NO HIGHER LEVEL OVLS OR OVCAPS THEN USE 
*                            PRU NUMBER FROM *FILINFO* AND SET UP FOR 
*                            SEQUENTIAL WRITE TO *OGLFN*
          MX2    2
          BX2    X2*X1       (X2) NONZERO IF AND ONLY IF MAG TAPE 
          ZR     X2,SOF5     IF NOT MAG TAPE THEN USE PRU NUMBER FROM 
*                            *FILINFO* AND SET UP FOR SEQUENTIAL
*                            WRITE TO *OGLFN* 
          SX6    B1 
          SA6    CPYF        SET SPOOLING FLAG
          SA6    HHAPRU      SET PRU 1 INTO *HHAPRU*
          SETFET L,Z32,BINARY 
          CLOSE  L,R         CLOSE RETURN *ZZZZZ32* 
          SETFET L,Z32,BINARY  SET FOR SEQUENTIAL WRITE TO *ZZZZZ32*
          EQ     SOF         EXIT 
 CFO      SPACE  4,8
**        CFO - CHECK FOR *FOL* OVERFLOW. 
* 
*              THIS ROUTINE IS CALLED FROM *CLO* AND *CGWC* IF IN 
*         *FOL* GENERATION MODE AND CHECKS THAT SUFFICIENT *FOL*
*         DIRECTORY SPACE HAS BEEN ALLOCATED FOR THE *FOL* STRUCTURE. 
*         *MAXOV* CONTAINS THE ALLOCATED LENGTH(=2 * NUMBER OF HIGHER 
*         LEVEL OVERLAYS AND OVCAPS) AND THE *TCII* TABLE LENGTH
*         CONTAINS 3*NUMBER OF BINARIES (INCLUDING (0,0)).  HENCE 
*         WE MUST HAVE(((MAXOV/2)+1)*3).LE.LENGTH *TCII* OR A FATAL 
*         ERROR IS ISSUED.
  
 CFO      PS                 ENTRY/EXIT 
          SA1    MAXOV       ALLOCATED SPACE
          AX1    1           NUMBER OF HIGHER LEVEL OVLS/OVCAPS 
          SX1    X1+B1       TOTAL NUMBER OF BINARIES IN STRUCTURE
          IX2    X1+X1
          IX2    X2+X1       MULTIPLY BY 3
          SA1    TCII+1      *TCII* TABLE LENGTH
          IX2    X2-X1       ALLOCATED - USED 
          PL     X2,CFO      IF NO OVERFLOW, EXIT 
          ERROR  250         ---- INSUFFICIENT *FOL* DIRECTORY SPACE
          EQ     ABEND       ABNORMAL TERMINATION 
 P54      SPACE  4
**        P54 - PLUG 54-TABLE 
* 
* 
*              AFTER ALL THE HIGHER LEVEL OVERLAYS AND OVCAPS HAVE
*         BEEN WRITTEN, THIS SUBROUTINE IS CALLED TO PLUG *HHA*,
*         *LHHA*, AND THE *FOL* DIRECTORY INTO THE 54-TABLE OF THE
*         (0,0) OVERLAY.  THIS IS DONE VIA A REWRITE FUNCTION, SO 
*         THE (0,0) OVERLAY MUST BE ON A MASS-STORAGE DEVICE. 
*         *HHAPRU* CONTAINS THE PRU NUMBER OF THE (0,0) OVERLAY.
*         THE *TCII* TABLE CONTAINS ALL INFO NEEDED FOR THE *FOL* 
*         DIRECTORY, WHICH IS TO BE PLACED IMMEDIATELY AFTER THE
*         ENTRY POINT LIST IN THE 54-TABLE.  WE ARE SURE AT THIS
*         POINT THAT SUFFICIENT SPACE HAS BEEN ALLOCATED FOR THE
*         *FOL* DIRECTORY.  THE *TCII* TABLE IS MASSAGED SOMEWHAT 
*         TO REMOVE REDUNDANT WORDS OF INFORMATION AND IS EMPTIED 
*         PRIOR TO EXIT IN PREPARATION FOR THE NEXT OVERLAY STRUCTURE 
*         IF ONE EXISTS.
  
  
 P54      EQ     *+400000B   ENTRY/EXIT 
          SMSG   (=C/  PLUGGING HHA INTO (0,0)/)
          SA1    TCII        (X1) = FWA *TCII*
          SA2    A1+B1       (X2) = LENGTH *TCII* 
          SB3    B0          (B3) = STORE INDEX INTO *TCII* 
          SB4    X2          (B4) = LENGTH *TCII* 
          R=     B2,3        (B2) = FETCH INDEX FROM *TCII* 
*                            START AT 3, THROW AWAY (0,0) INFO
 P54B     GE     B2,B4,P54C  IF DONE WITH *TCII*
          SA3    X1+B2       SAVE FIRST 2 WORDS OF 3-WORD ENTRY 
          SA4    A3+B1
          BX6    X3 
          LX7    X4 
          SA6    X1+B3
          SA7    A6+B1
          R=     B2,B2+3     BUMP FETCH INDEX TO NEXT 3-WORD ENTRY
          R=     B3,B3+2     BUMP STORE INDEX 
          EQ     P54B        CONTINUE THRU *TCII* 
  
 P54C     SX6    B3 
          SA6    A2          RESET LENGTH OF *TCII* 
          SB2    B0          (B2) = FETCH INDEX FROM *TCII* 
*                            (B3) = LENGTH *TCII* 
          SA1    OGLST00
          SA2    CPYF 
          ZR     X2,P54A     IF NOT SPOOLING
          SA1    =0L"SFN"    SPOOLING FILE NAME 
 P54A     SETFET L,A1,BINARY SET LFN
          SA1    L+1
          MX2    1
          R=     X6,X1+101B  ROOM FOR PRU + 1 WORD
          LX2    -12
          SA6    L+4         SET *LIMIT* = *FIRST* + 65 
          BX6    X1+X2       SET RANDOM BIT 
          SA6    A1 
          SA5    HHAPRU      (X5) = PRU NUMBER OF (0,0) OVERLAY 
          SB5    X5          (B5) = NEXT PRU TO READ
          BX6    X5 
          SA6    L+6         SET RANDOM ADDRESS 
          READ   L,RCL       READ PRU 
          SA1    L+1
          R=     A1,X1+1+LTH77+4   PICK HHA WORD OUT OF BUFFER
          MX0    42 
          BX6    X0*X1
          SA2    HHACM
          BX6    X6+X2       ADD HHA
          SA6    A1 
          SA1    A1+B1       PICK UP LHHA WORD
          MX0    36 
          BX6    X6*X1       ADD LHHA 
          SA2    HHAECS 
          BX6    X6+X2
          SA6    A1 
          SA1    L+1         (X1) = ADDRESS OF FWA OF BUFFER
          R=     A1,X1+1+LTH77     (X1) = 54-TABLE HEADER FROM BUFFER 
*                                  (X1) BITS 17-0 = ENTRY POINT COUNT 
          R=     X1,X1+1+LTH77+10B  CALCULATE WHERE *FOL* DIR GOES
*                            *FOL* DIRECTORY GOES IMMEDIATELY AFTER THE 
*                            ENTRY POINT LIST IN THE 54-TABLE.  SO WE 
*                            NEED TO CALCULATE LENGTH OF 77-TABLE + 1 
*                            (FOR *7700* HEADER WORD) + 10B (LENGTH OF
*                            54-TABLE HEADER) + ENTRY POINT COUNT 
          MX2    -6 
          BX3    -X2*X1 
          AX1    6
*                            SIMULATE DIVIDE BY 100B WITH 
*                            (X3) = REMAINDER, (X1) = QUOTIENT
          SB4    X3          (B4) = INDEX INTO BUFFER (=REMAINDER)
          BX0    X1          (X0) = QUOTIENT (BIAS TO NEXT PRU) 
          NZ     X0,P54D     IF *FOL* DIRECTORY DOESN-T START THIS PRU
          SX0    B1          SET BIAS TO NEXT PRU = 1 
          RJ     P54FOL      PLUG *FOL* INFO INTO PRU IN BUFFER 
 P54D     RJ     P54CIO      REWRITE PRU
          SB5    X0+B5       (B5) = NEXT PRU TO READ
          GE     B2,B3,P54F  IF DONE WITH *FOL* DIRECTORY 
 P54E     SX6    B5          NEXT PRU TO READ 
          SA1    L+1
          SX7    X1          *FIRST*
          SA6    L+6         SET RANDOM ADDRES
          SA7    A1+B1       SET *IN* = *FIRST* 
          SA7    A7+B1       SET *OUT* = *FIRST*
          READ   L,RCL       READ PRU 
          RJ     P54FOL      PLUG *FOL* INFO INTO PRU IN BUFFER 
          RJ     P54CIO      REWRITE PRU
          SB5    B5+B1       (B5) = NEXT PRU TO READ
          LT     B2,B3,P54E  IF NOT DONE WITH *FOL* DIRECTORY 
 P54F     SKIPEI L,RCL       REPOSITION FILE TO WHERE WE STARTED
          SA1    L+1
          R=     X6,X1+IP.LBUF
          SA6    L+4         RESET *LIMIT*
          SA2    TCII 
          RJ     CTAB=       CLEAR *TCII* 
          EQ     P54         EXIT 
 P54CIO   SPACE  4,8
**        P54CIO - DO RANDOM REWRITE ON 54-TABLE. 
* 
*              THIS IS AN INTERNAL SUBROUTINE USED BY *P54* WHEN
*         DOING A RANDOM REWRITE ON THE 54-TABLE.  ON ENTRY B5
*         CONTAINS THE PRU NUMBER.  THE *CIO* CODE IS COMPUTED
*         FOR EITHER A *REWRITE* OR *REWRITER* AND *CIO=* IS CALLED 
*         TO REWRITE THE PRU. 
  
 P54CIO   PS                 ENTRY/EXIT 
          SA1    L           OLD *CIO* CODE FROM FET
          R=     X1,X1-READ+REWRITE-3  COMPUTE *CIO* CODE FOR REWRITE 
          SX6    B5          PRU NUMBER 
          SA6    L+6         SET RANDOM ADDRESS INTO FET
          SX2    A1          SETUP FOR CALL TO CIO= (X2=FET ADDRESS)
          BX7    -X1         (X7) = COMPLEMENTED ORDER CODE (RECALL)
          RJ     CIO=        REWRITE L,RCL --OR-- REWRITER L,RCL
          EQ     P54CIO      EXIT 
 P54FOL   SPACE  4,8
**        P54FOL - PLUG *FOL* INFORMATION INTO BUFFER.
* 
*              THIS IS AN INTERNAL SUBROUTINE USED BY *P54* TO MOVE 
*         THE *FOL* DIRECTORY INFORMATION FROM THE *TCII* TABLE INTO
*         THE PRU CURRENTLY IN THE BUFFER.  THE *TCII* TABLE HAS
*         ALREADY BEEN REFORMATTED TO CONTAIN EXACTLY AND ONLY THE
*         *FOL* DIRECTORY.
* 
*         ENTRY  (B2) = FETCH INDEX FROM *TCII*.
*                (B3) = LENGTH *TCII*.
*                (B4) = STORE INDEX INTO BUFFER.
* 
*         EXIT   (B2) = UPDATED FETCH INDEX FROM *TCII*.
*                (B3) = LENGTH *TCII*.
*                (B4) = NEXT STORE INDEX INTO BUFFER (=0).
* 
*         USES   X - 1, 2, 3, 6.
*                B - 6. 
*                A - 1, 2, 3, 6.
* 
*         CALLS  NONE.
  
 P54FOL   PS                 ENTRY/EXIT 
          SA1    TCII        (X1) = FWA *TCII*
          SA2    L+1
          SX2    X2          (X2) = FWA BUFFER
          R=     B6,100B     (B6) = STORING LIMIT FOR BUFFER
 P54FOL1  GE     B2,B3,P54FOL2  IF DONE WITH *TCII* 
          SA3    X1+B2       NEXT WORD FROM *TCII*
          BX6    X3 
          SB2    B2+B1       BUMP *TCII* FETCH INDEX
          SA6    X2+B4       PUT *FOL* INFO INTO BUFFER 
          SB4    B4+B1       BUMP BUFFER STORE INDEX
          LT     B4,B6,P54FOL1  IF MORE ROOM IN BUFFER
 P54FOL2  SB4    B0          SET BUFFER STORE INDEX FOR NEXT TIME 
          EQ     P54FOL      EXIT 
 COD      SPACE  4
**        COD - CRACK *OVERLAY* DIRECTIVE 
* 
* 
*         ENTRY  *OVERLAY* DIRECTIVE IN *CDIMAGE* 
* 
*         EXIT   *NEWCARD* CONTAINS CARD IMAGE TERMINATED BY 0000 
*                *NEWLFN* CONTAINS LFN FOR NEXT OVERLAY 
*                *NEWL1* CONTAINS PRIMARY LEVEL 
*                *NEWL2* CONTAINS SECONDARY LEVEL 
*                *NEWORG* CONTAINS ORIGIN SPECIFICATION 
*                *NEWMAXOV* CONTAINS *OV=* SPECIFICATION (*2).
*                *NEWERR* CONTAINS INTERNAL ERROR NUMBER OR ZERO
*                    1  SYNTAX ERROR ON OVERLAY CARD
*                    2  NO FILE SPECIFIED FOR OVERLAY 
*                    3  ILLEGAL LEVEL NUMBER
*                    4  PRIMARY OVERLAY NOT PRECEDED BY (0,0) OVERLAY 
*                    5  SECONDARY OVERLAY NOT PRECEDED BY ITS PRIMARY 
*                    6  OVERLAY CARD NOT SEPARATE SECTION 
* 
*         USES   X - 1, 2, 3, 5, 6, 7.
*                B - 7. 
*                A - 1, 2, 3, 6, 7. 
* 
*         CALLS  COS, /LOADCC/GNE, ION, /MISC/LFNCK.
  
  
 COD      PS                 ENTRY/EXIT 
          R=     B7,-10 
 COD1     SB7    B7+B1
          SA1    B7+/READ/CDIMAGE+9 
          BX6    X1 
          SA6    B7+NEWCARD+9      SAVE CARD IMAGE
          NZ     B7,COD1
          MX1    48 
          BX6    X1*X6       INSURE TERMINATOR
          SA6    A6 
          SX6    B0 
          SA6    NEWLFN      INITIALIZE EXIT VARIABLES
          SA6    NEWL1
          SA6    NEWL2
          SA6    NEWERR 
          SA6    NEWMAXOV 
          SA6    NEWORG 
          READO  L
          R=     X7,6 
          ZR     X1,COD9     IF OVERLAY CARD NOT SEPARATE SECTION 
          SX6    NEWCARD
          SA6    /LOADCC/CCWA      INITIALIZE FOR CARD SCANNING ROUTINE 
          SA6    A6+B1
          MX6    0
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
          RJ     /LOADCC/GNE GET KEYWORD *OVERLAY*
          SX7    B1 
          SX6    X5 
          ZR     X6,COD9     IF NOT FOLLOWED BY SEPARATOR 
          SB7    B7-B1
          EQ     B7,B1,COD9  IF FOLLOWED BY TERMINATOR
  
*   PICK UP LFN OR PRIMARY LEVEL
  
          RJ     /LOADCC/GNE GET NEXT ELEMENT 
          MX6    42 
          BX6    X6*X5
          ZR     X6,COD1A 
          SX7    B1 
          SX6    X5 
          ZR     X6,COD9     IF NOT FOLLOWED BY SEPARATOR 
          SB7    B7-B1
          EQ     B7,B1,COD9  IF FOLLOWED BY TERMINATOR
          BX1    X5 
          RJ     /MISC/LFNCK CHECK FOR LEGAL LFN
          SX7    B1 
          MI     X6,COD2     IF NOT LFN (CAN BE A LEVEL)
          SA6    NEWLFN 
  
*   LFN WAS GIVEN;  GET PRIMARY LEVEL 
  
 COD1A    RJ     /LOADCC/GNE GET NEXT ELEMENT 
          SX7    B1 
          SX6    X5 
          ZR     X6,COD9     IF NOT FOLLOWED BY SEPARATOR 
          SB7    B7-B1
          EQ     B7,B1,COD9  IF FOLLOWED BY TERMINATOR
 COD2     RJ     ION         CONVERT PRIMARY LEVEL
          MI     X6,COD9     IF NOT OCTAL NUMBER
          SA6    NEWL1
  
*   GET SECONDARY LEVEL 
  
          RJ     /LOADCC/GNE GET NEXT ELEMENT 
          SX7    B1 
          SX6    X5 
          ZR     X6,COD9     IF NOT FOLLOWED BY SEPARATOR 
          RJ     ION         CONVERT SECONDARY LEVEL
          MI     X6,COD9     IF NOT OCTAL NUMBER
          SA6    NEWL2
          SB7    B7-B1
          EQ     B7,B1,COD3  IF NO MORE PARAMETERS
  
*   CRACK OPTIONAL SPECIFICATIONS.
  
          RJ     COS
          SA1    NEWERR 
          NZ     X1,COD      IF ERROR FOUND 
  
*   SET UP LFN FOR WRITING OVERLAY
  
 COD3     SA1    OF 
          ZR     X1,COD3A    IF NO LFN FROM OVERLAY CARD
          BX6    X1 
          SA6    NEWLFN 
          EQ     COD4 
 COD3A    SX7    B1+B1       (X7=2) 
          SA1    NEWLFN 
          NZ     X1,COD4     IF LFN GIVEN 
          SA2    OGLFN
          NZ     X2,COD3B    IF LFN FROM LAST TIME
          SA2    DFLTLFN     USE DEFAULT LFN
 COD3B    BSS    0
          BX6    X2 
          SA6    A1          USE LFN FROM LAST TIME 
  
*   CHECK OVERLAY LEVEL FOR LEGALITY AND APPROPRIATENESS
  
 COD4     SA1    NEWL1
          SA2    NEWL2
          SX7    X7+B1       (X7=3) 
          AX1    6
          AX2    6
          NZ     X1,COD9     IF PRIMARY LEVEL > 77
          NZ     X2,COD9     IF SECONDARY LEVEL > 77
          SA1    A1 
          SA2    A2 
          ZR     X1,COD6     IF PRIMARY LEVEL ZERO
          ZR     X2,COD5     IF SECONDARY LEVEL ZERO
          R=     X7,5        (X7=5) 
          SA3    OGL1        **(M,N)**
          BX3    X3-X1
          ZR     X3,COD7     OK IF OLD L1 = M 
          EQ     COD9        ELSE ERROR 
  
 COD5     SA3    OGLFN       **(M,0)**
          NZ     X3,COD7     OK IF (0,0) FOUND EARLIER
          R=     X7,4        (X7=4) 
          EQ     COD9        ELSE ERROR 
  
 COD6     NZ     X2,COD9     IF (0,N)  [ALWAYS ILLEGAL] 
  
 COD7     EQ     COD         EXIT 
  
  
*   HERE IF ERROR FOUND.  SET FLAG FROM X7 AND EXIT.
  
 COD9     SA7    NEWERR      SET ERROR FLAG 
          EQ     COD         EXIT 
 COS      SPACE  4
**        COS - CRACK OPTIONAL SPECIFICATIONS.
* 
* 
*              THIS ROUTINE CRACKS THE OPTIONAL SPECIFICATIONS ON AN
*         *OVERLAY* CARD.  THESE CAN BE EITHER AN ORIGIN SPECIFICATION
*         OR AN *FOL* DIRECTORY SIZE SPECIFICATION. 
* 
*              ORIGIN SPECIFICATIONS ARE AS FOLLOWS - 
* 
*                CNNNNNN
*                O=NNNNNN 
*                O=EPTNAME
*                O=EPTNAME+NNNNNN 
*                O=EPTNAME-NNNNNN 
* 
*              THE FIRST FORM SPECIFIES A BLANK COMMON LENGTH TO BE USED
*         IN CALCULATING THE ORIGIN.  THE SECOND SPECIFIES AN ABSOLUTE
*         ORIGIN.  THE REST SPECIFY THAT THE ORIGIN IS TO BE AT THE 
*         SPECIFIED ENTRY POINT NAME, POSSIBLY OFFSET BY A CONSTANT.
* 
*              ACTUAL DETERMINATION OF THE ORIGIN IS DONE LATER.
*         HERE, *NEWORG* IS SET UP:                                            .
*                42/EPTNAME,18/OFFSET 
*         WHERE EPTNAME=-0 FOR BLANK COMMON (CASE 1) AND =+0 FOR AN 
*         ABSOLUTE ADDRESS (CASE 2).
* 
*              *FOL* DIRECTORY SIZE SPECIFICATION IS AS FOLLOWS - 
* 
*                OV=NNNNNN
* 
*              ACTUAL ALLOCATION OF THE DIRECTORY SPACE IS DONE LATER.
*              HERE *NEWMAXOV* IS SETUP.
* 
* 
*         USES   X - 1, 4, 5, 6, 7. 
*                B - 7. 
*                A - 1, 6, 7. 
* 
*         CALLS  /LOADCC/GNE, /LOADCC/CDB, ION, /MISC/EPNCK.
  
  
 COS      PS                 ENTRY/EXIT 
 COS0     GT     B7,B1,COS   IF TERMINATOR THEN DONE
          RJ     /LOADCC/GNE GET NEXT ELEMENT 
          SA1    COSA 
          BX1    X5-X1
          ZR     X1,COS1     IF O=
          SA1    COSB 
          BX1    X5-X1
          ZR     X1,COS4     IF OV= 
          MX1    42 
          BX5    X1*X5
          LX5    6
          R=     X6,X5-1RC
          NZ     X6,COS9     IF NOT CNNNNNN 
          RJ     ION
          MI     X6,COS9     IF NOT CNNNNNN 
          MX1    42 
          BX6    X6+X1       YES, SAVE
          SA6    NEWORG 
          EQ     COS0        GO GET NEXT PARAMETER
  
 COS1     RJ     /LOADCC/GNE GET NEXT ELEMENT 
          R=     X7,X5-5
          ZR     X7,COS3     IF FOLLOWED BY + 
          R=     X7,X5-6
          ZR     X7,COS3     IF FOLLOWED BY - 
          BX1    X5 
          RJ     ION         CHECK FOR ABS ADDRESS
          MI     X6,COS2     IF NOT 
          SA6    NEWORG 
          AX6    18 
          NZ     X6,COS9     IF ADDRESS TOO BIG 
          EQ     COS0        GO GET NEXT PARAMETER
  
 COS2     RJ     /MISC/EPNCK CHECK FOR VALID ENTRY POINT NAME 
          MI     X6,COS9     IF NOT, ERROR
          SA6    NEWORG 
          EQ     COS0        GO GET NEXT PARAMETER
  
 COS3     BX1    X5 
          RJ     /MISC/EPNCK CHECK FOR VALID ENTRY POINT NAME 
          MI     X6,COS9     IF NOT, ERROR
          R=     X7,X5-5
          R=     X7,X7-2
          LX7    58 
          AX7    59          IF +, X7=+0;  IF -, X7=-0. 
          MX1    42 
          BX7    -X1*X7 
          BX6    X6+X7
          SA6    NEWORG 
          RJ     /LOADCC/GNE GET OFFSET 
          RJ     ION
          MI     X6,COS9     IF OFFSET NOT OCTAL NUMBER 
          SA1    NEWORG 
          BX7    X1-X6
          SA7    A1 
          AX6    18 
          NZ     X6,COS9     IF OFFSET TOO BIG
          EQ     COS0        GO GET NEXT PARAMETER
  
 COS4     RJ     /LOADCC/GNE  GET DECIMAL NUMBER
          RJ     /LOADCC/CDB  CONVERT DECIMAL TO BINARY 
          LX6    X2,B1       MULTIPLY BY 2
          SA6    NEWMAXOV    SET  VALUE*2 INTO *NEWMAXOV* 
          EQ     COS0 
  
 COS9     SX6    B0 
          SX7    B1 
          SA6    NEWORG 
          SA7    NEWERR      FLAG ERROR 
          EQ     COS         EXIT 
  
  
 COSA     CON    1LO+2
 COSB     CON    2LOV+2 
 ION      SPACE  4
**        ION - INTERPRET OCTAL NUMBER
* 
* 
*         ENTRY  OCTAL DISPLAY CODE OF NUMBER IN X5 
*                LEFT JUSTIFIED, ZERO FILLED, LOW 18 BITS IGNORED 
* 
*         EXIT   BINARY INTEGER IN X6 
*                X6<0 IF ERROR
* 
*         USES   X - 2, 3, 5, 6.
*                B - NONE.
*                A - NONE.
* 
*         CALLS  NONE.
  
  
 ION0     MX6    1           ERROR EXIT 
 ION      PS                 ENTRY/EXIT 
          MX2    42 
          BX5    X2*X5
          MX2    54          X2=1-CHARACTER MASK
          SX6    B0          X6=ACCUMULATOR 
 ION1     LX6    3
          LX5    6
          BX3    -X2*X5 
          BX5    X2*X5
          R=     X3,X3-1R8
          PL     X3,ION0
          R=     X3,X3+1R8-1R0
          MI     X3,ION0
          IX6    X6+X3
          NZ     X5,ION1
          EQ     ION
 LOADG    TITLE  CAPSULE GENERATION CODE
 INCAP    SPACE  4,8
**        INCAP - INITIALIZE FOR NEXT CAPSULE.
* 
*              THIS ROUTINE IS CALLED TO INITIALIZE FOR THE NEXT
*         CAPSULE.  IT MAY BE CALLED FROM *PREFIX* TABLE PROCESSING 
*         IN WHICH CASE WE MAY BE CALLED FOR THE FIRST OR SUBSEQUENT
*         CAPSULES.  IF CALLED FOR THE FIRST CAPSULE SOME ADDITIONAL
*         INITIALIZATION IS REQUIRED.  IT MAY BE CALLED FROM *CLCAP*
*         (EITHER DIRECTLY OR THRU *LMO*/*INO*) AND ALSO MAY HAVE TO
*         HANDLE THE FINAL EXIT FROM ENCAPSULATION.  IF ANOTHER 
*         CAPSULE IS COMING, MAINTAIN GROUP/CAPSULE NAMES AND 
*         POINTERS, REMOVE LINKAGES (CALL *CGRML*), RESTORE LOAD
*         FILE NAME AND JUMP TO *LOAD11* TO CONTINUE *LOAD*/*SLOAD*.
  
 INCAP    SX6    /TMGR/TOV   SET ADDRESS OF TABLE OVERFLOW ROUTINE
          SA6    TO 
          SA1    TERR+B1     ENSURE *TERR* SIZE AT LEAST 2
          SX2    B1+B1
          IX1    X1-X2
          PL     X1,INCAP1   IF AT LEAST 2 WORDS ALREADY AVAILABLE
          ADDWRD TERR,X1-X1 
          ADDWRD A2,X1
 INCAP1   SA1    TCPFMT 
          SA3    TCPFMTP
          SA2    A1+B1
          SB2    X1          (B2) = FWA *TCPFMT*
          SB3    X2          (B3) = LENGTH *TCPFMT* 
          SB4    X3          (B4) = CURRENT *TCPFMT* POINTER
          NZ     B4,INCAP5   IF NOT FIRST TIME THRU 
          SA1    EX          CHECK IF TERMINATED BY *NOGO*
          ZR     X1,INCAP2   IF *NOGO*
          ERROR  505         ---- ENCAPSULATION NOT TERMINATED BY NOGO
          EQ     ABEND
  
 INCAP2   SA1    DFMFLAG     DAYFILE THE *NOGO* COMMAND 
          NZ     X1,INCAP2A  IF ALREADY DAYFILED
          SX6    COMLDCC
          SA6    A1          INDICATE IT HAS BEEN DAYFILED
          MESSAGE  X6,R 
 INCAP2A  MX1    42 
          SA2    B2          FIRST NAME FROM *TCPFMT* 
          BX6    X1*X2
          SA6    CURGPNAM    FIRST TIME INITIALIZATION FOR CURGPNAM 
          SB5    B0          CHECK IF ANY CAPSULE NAMES SPECIFIED 
 INCAP3   SA2    B2+B5       NEXT NAME
          SB5    B5+B1
          BX2    -X1*X2      =0 IFF CAP NAME, =1 IFF GP NAME
          ZR     X2,INCAP5   IF AT LEAST ONE CAPSULE NAME 
          LT     B5,B3,INCAP3  KEEP LOOKING 
          ERROR  506         ---- NO CAPSULES SPECIFIED 
          EQ     ABEND
  
 INCAP4   R=     X6,4RENDP/16  TERMINATE, ALL CAPSULES DONE 
          LX6    40 
          RJ     SYS=        ENDRUN 
  
 INCAP5   SA1    CURCPNAM    SET LASCPNAM=CURCPNAM
          BX6    X1 
          SA6    LASCPNAM 
          MX1    42          MASK 
 INCAP6   GE     B4,B3,INCAP4  IF NO MORE CAPSULES
          SA2    B2+B4       NEXT NAME
          SB4    B4+B1       BUMP POINTER 
          SB5    X2          =0 IFF CAPSULE NAME
          BX6    X1*X2       42/0LNAME,18/0 
          ZR     B5,INCAP7   IF CAPSULE NAME
          SA6    CURGPNAM    SET GROUP NAME 
          EQ     INCAP6      KEEP LOOKING FOR CAPSULE NAME
  
 INCAP7   SA6    CURCPNAM    SET CAPSULE NAME 
          SX7    B4 
          SA7    TCPFMTP     SET TCPFMTP FOR NEXT TIME THRU 
          MX6    0           INIT = 0 
 INCAP8   GE     B4,B3,INCAP9  IF NO NEXT CAPSULE 
          SA2    B2+B4       NEXT NAME
          SB4    B4+B1
          SB5    X2          =0 IFF CAPSULE NAME
          NZ     B5,INCAP8   IF NOT CAPSULE NAME
          BX6    X1*X2       NEXT CAPSULE NAME INTO X6
 INCAP9   SA6    NEXCPNAM    SET NEXCPNAM (NAME OR 0) 
          RJ     CGRML       REMOVE LINKAGES, ETC.
          SETFET L,CGLFNSV,BINARY  RESTORE  FET FOR LOAD
          R=     X7,READ
          SA7    READFUNC    RESTORE READ FUNCTION CODE 
          SA7    L-1
          SA2    TLFN 
          RJ     CTAB=       CLEAR *TLFN* 
          SA1    CGLFNSV
          ADDWRD TLFN,X1     ENTER NAME OF LOAD FILE
          SX6    B0 
          SX7    B1 
          SA6    FI          RESET FILE INDEX 
          SA6    PC          RESET PROGRAM COUNT
          SA6    CGFPAF      INDICATE CAPSULE NOT INITIATED 
          SA6    NE          RESET NON-FATAL ERROR COUNT
          SA6    FE          RESET FATAL ERROR COUNT
          SA7    REQTYPE     SET REQUEST ALLOW TYPE 
 DB       IFTEST NE,IP.LDBG,0 
          SA1    CURCPNAM 
          LD     X6,1R
          BX6    X1+X6
          LX6    -6 
          SA6    CGMSGCN     CAPSULE NAME INTO MESSAGE
          SMSG   CGMSG1      GENERATING CAPSULE XXXXXXX 
 DB       ENDIF 
          SX1    B0          SET *EOR* STATUS 
          EQ     LOAD11      CONTINUE *LOAD* OR *SLOAD* 
  
 CLCAP    SPACE  4,8
**        CLCAP - COMPLETE CAPSULE. 
* 
*              THIS ROUTINE IS CALLED FROM EITHER *PREFIX* TABLE
*         PROCESSOR OR *CPL*.  ITS FUNCTION IS TO COMPLETE THE
*         CAPSULE CURRENTLY BEING GENERATED AS FOLLOWS -- 
*         1)  CALLS *CPR* TO COMPLETE THE READ, 
*         2)  CALLS *SAT* TO SATISFY EXTERNALS, 
*         3)  CALLS *USX* TO PROCESS UNSATISFIED EXTERNALS, 
*         4)  CLEARS THE *EDITLIB* INTERLOCK (SCOPE ONLY),
*         5)  PROCESSES CM BLANK COMMON,
*         6)  CALLS *FBC* FOR FILL BYTE CHAINS, 
*         7)  CALLS *LBC* FOR LINK BYTE CHAINS, 
*         8)  CALLS *CGEPL* TO SETUP THE ENTRY POINT LIST,
*         9)  CALLS *CGXRL* TO SETUP THE XREF LIST AND CHAINS,
*         10) CALLS *CGREL* TO SETUP THE RELOCATION TABLE,
*         11) WRITES THE CAPSULE BINARY TO THE SPECIFIED FILE,
*         12) RETURNS SYSTEM FILES IF NECESSARY,
*         13  JUMPS TO OUTPUT MAP IF REQUIRED,
*         14) RETURN (IF AT ALL) IS TO *INCAP*. 
  
 CLCAP    RJ     CPR         COMPLETE READ
          SB7    B0 
          RJ     SAT         SATISFY EXTERNALS
          RJ     USX         PROCESS UNSATISFIED (UNRESOLVED) EXTERNALS 
 S        IFSCOPE 
          R=     X7,2030B 
          SA7    T1 
          LDL    A7          CLEAR *EDITLIB* INTERLOCK
 S        ENDIF 
          SA1    TBLK 
          R=     A1,X1+3     (X1) = *TBLK* ECS // DEF WORD
          MI     X1,CLCAP0   IF ECS // NOT REFERENCED 
          ERROR  503         ---- ECS TEXT DISALLOWED IN CAPSULES 
 CLCAP0   BSS    0
          SA1    TBLK 
          SA1    X1+B1       (X1) = *TBLK* CM // DEF WORD 
          MX2    -24
          BX3    X1 
          LX3    -24
          BX3    -X2*X3      (X3) = CM // LENGTH
          SA4    PA 
          BX1    X1*X2       SAVE ALL BUT ADDR FIELD
          BX6    X1+X4       PUT *PA* INTO ADDR FIELD 
          SA6    A1          WRITE BACK *TBLK* CM // DEF WORD 
          IX6    X4+X3
          SA6    A4          SET FINAL *PA* (TO INCLUDE // LENGTH)
          ZR     X3,CLCAP1   IF NO MORE *TPGM* SPACE NEEDED 
          ALLOC  TPGM,X3     DON-T USE APS=, *PA* ALREADY BUMPED AND
*                            *TCPREL* SPACE NOT NEEDED. 
 CLCAP1   SA3    TEPT1       MOVE AND RELOCATE *TEPT1* TO *TEPT*
          SA2    A3+B1
          SB2    B0          (B2) = *TEPT1* FETCH POINTER 
          SB3    X2          (B3) = *TEPT1* LENGTH
          SB4    B1+B1
          SB5    X3          (B5) = *TEPT1* FWA 
          SA1    TBLK        GET // ADDR FROM *TBLK*
          MX0    -24
          SA2    X1+B1
          BX0    -X0*X2      (X0) = // FWA
          ZR     B3,CLCAP4   IF NO ENTRY POINTS IN // 
 CLCAP2   SA1    B5+B2       FIRST WORD 
          SA5    A1+B1       SECOND WORD
          IX5    X0+X5       RELOCATE ENTRY POINT ADDR
          ADDWRD TEPT,X1     MOVE TO *TEPT* 
          ADDWRD A2,X5       MOVE TO *TEPT* 
          SB2    B2+B4       BUMP FETCH POINTER 
          GE     B2,B3,CLCAP3  IF DONE
          SA1    TEPT1       (X1) = *TEPT1* FWA (MAY CHANGE)
          SB5    X1          RESET (B5) = *TEPT1* FWA 
          EQ     CLCAP2      CONTINUE 
  
 CLCAP3   MX7    0
          SA7    TEPT1+1     EMPTY *TEPT1*
          RJ     CPR         COMPLETE READ
 CLCAP4   RJ     FBC         PROCESS FILL BYTE CHAINS 
          RJ     LBC         PROCESS LINK BYTE CHAINS 
          SA1    TPGM        PROCEED TO INITIALIZE CAPSULE HEADER 
          MX6    2           SET *6000* HEADER INTO WORD 0 OF *TPGM*
          SA6    X1 
          SA1    CURGPNAM 
          BX6    X1 
          SA6    A6+B1       SET GROUP NAME INTO HEADER 
          SA1    CURCPNAM 
          BX6    X1 
          SA6    A6+B1       SET CAPSULE NAME INTO HEADER 
          SA1    PC          CHECK FOR EMPTY LOAD 
          NZ     X1,CLCAP4A  IF AT LEAST ONE PROGRAM LOADED 
          ERROR  101         ---- EMPTY LOAD
 CLCAP4A  BSS    0
          RJ     CGEPL       HANDLE CAPSULE ENTRY POINT LIST
          RJ     CGXRL       HANDLE CAPSULE XREF LIST AND CHAINS
          RJ     CGREL       HANDLE CAPSULE RELOCATION TABLE
          RJ     CGWC        WRITE CAPSULE
          SA1    CURREQBP    CHECK IF WORKING ON *NOGO* 
          R=     X1,X1-CNOGO
          NZ     X1,CLCAP5   IF NOT *NOGO*
          RJ     RSF         RETURN SYSTEM FILES
          SA1    NEXCPNAM    SEE IF MORE CAPSULES EXPECTED
          ZR     X1,CLCAP5   IF NO MORE CAPSULES EXPECTED 
          ERROR  4502        ---- NOT ALL CAPSULE DIRECTIVES PROCESSED
 CLCAP5   SA1    FE          GENERATE MAP IF REQUESTED OR ERRORS
          SA2    NE 
          SA3    MAPTYPE
          BX1    X1+X2
          BX1    X1+X3
          NZ     X1,LMO      IF MAP REQUESTED OR ERRORS 
*                            RETURNS IF AT ALL TO *INCAP* (THRU *INO*)
          EQ     INCAP       GO TO INITIALIZE FOR THE NEXT CAPSULE
  
 ACRTS    SPACE  4,8
**        ACRTS - ALLOCATE CAPSULE RELOCATION TABLE SPACE.
* 
*              THIS ROUTINE IS CALLED FROM *APS=* TO ALLOCATE SPACE 
*         IN THE CAPSULE RELOCATION TABLE *TCPREL*.  THE AMOUNT OF
*         ADDITIONAL SPACE NEEDED IN *TCPREL* IS CALCULATED, THEN 
*         THE NEW SPACE IS ALLOCATED AND ZEROED OUT.
* 
*         ENTRY  (X1) = CHANGE FOR PROGRAM TABLE. 
*                (X2) = 0 IFF TO ALLOCATE CM SPACE. 
*                       NZ IFF TO ALLOCATE ECS SPACE. 
*         EXIT   NEW *TCPREL* SPACE ALLOCATED AND ZEROED. 
*                (X1) AND (X2) ARE AS AT ENTRY, SAVED AND RESTORED. 
*         USES   X - 3, 4, 6. 
*                B - 2. 
*                A - 1, 2, 3, 4, 6. 
*         CALLS  ATS=, ERROR. 
  
 CGTEMP1  BSS    1           SAVE AREA
 CGTEMP2  BSS    1           SAVE AREA
  
 ACRTSX   SA1    CGTEMP1     RESTORE X1 
          SA2    CGTEMP2     RESTORE X2 
  
 ACRTS    PS                 ENTRY/EXIT 
          BX6    X1 
          SA6    CGTEMP1     SAVE (X1)
          BX6    X2 
          SA6    CGTEMP2     SAVE (X2)
          ZR     X2,ACRTS1   IF REQUEST FOR CM SPACE
          ERROR  503         ---- ECS TEXT NOT ALLOWED IN CAPSULES
          EQ     ACRTSX      EXIT 
  
 ACRTS1   MI     X1,ACRTSX   IF NO MORE SPACE NEEDED IN *TCPREL*
          R=     X2,16B      CALCULATE ((PA)-(PO)+16B+(X1))/17B 
          SA3    PA 
          SA4    PO 
          IX1    X1+X2
          IX1    X1+X3
          IX1    X1-X4
          R=     X4,17B 
          IX2    X1/X4,B2    (X2) = ((PA)-(PO)+16B+(X1))/17B
          SA3    TCPREL+1    (X3) = CURRENT LENGTH OF *TCPREL*
          IX1    X2-X3       (X1) = ADDITIONAL AMOUNT NEEDED
          MI     X1,ACRTSX   IF NO MORE NEEDED
          ALLOC  TCPREL,X1   ALLOCATE NEEDED SPACE
          SB2    -B1         (B2) = -1
          MX6    0           (X6) = 0 
 ACRTS2   ZR     X1,ACRTSX   IF NEW SPACE ALL ZEROED OUT, THEN EXIT 
          SA6    X3          ZERO NEXT NEW WORD 
          SX1    X1+B2       DECREMENT COUNTER
          SX3    X3+B1       INCREMENT POINTER
          EQ     ACRTS2      CONTINUE 
  
 FBCREL   SPACE  4,8
**        FBCREL - FILL BYTE CHAIN RELOCATION TABLE PROCESSING. 
* 
*              THIS ROUTINE IS CALLED FROM *FBC* TO MAINTAIN THE
*         CAPSULE RELOCATION TABLE *TCPREL* FOR FILL/XFILL BYTE 
*         CHAINS.  SCANS TABLES *TFBC*/*TXFBC* AND MAINTAINS THE
*         RELOCATION INDICATORS IN TABLE *TCPREL* FOR CAPSULE 
*         OR OVCAP GENERATION.
* 
*         ENTRY  TABLES *TFBC*/*TXFBC* CONTAIN FILL/XFILL INFO. 
*                TABLE *TCPREL* HAS NECESSARY SPACE ALLOCATED,
*                INITIALIZED, AND POSSIBLY SOME RELOCATION INFO.
*         EXIT   TABLE *TCPREL* MODIFIED TO CONTAIN ALL NECESSARY 
*                RELOCATION INDICATORS FOR FILL/XFILL BYTE CHAINS.
*         USES   ALL REGISTERS. 
*         CALLS  ERROR. 
  
 FBCREL   PS                 ENTRY/EXIT 
          SA4    TCPREL 
          SB5    X4          (B5) = FWA OF *TCPREL* 
          SA4    TFBC 
          SA5    A4+B1
          SB7    X5          (B7) = WORD COUNT (LENGTH *TFBC*)
          MX5    30          (X5) = BYTE MASK 
          SA4    X4          (X4)=NEXT WORD FROM *TFBC*, (A4)=ADDR
          ZR     B7,XFBCR    IF *TFBC* EMPTY
          MX0    0           SET TO STORE INTO *TCPREL* 
 FBCR1    PL     X4,FBCR4    IF HEADER BYTE 
          LX4    3
          LX1    X4,B1       BELOW LOADABLE AREA BIT TO SIGN BIT
          PL     X1,FBCR1A   IF NOT BELOW LOADABLE AREA 
          LX4    27          IGNORE THIS TRAILER BYTE 
          BX5    -X5         SWITCH BYTE MASK 
          EQ     FBCR3       CONTINUE PROCESSING *TFBC* 
  
 FBCR1A   BSS    0
          MX1    -2 
          MI     X4,FBCRECS  IF ECS WORD
          BX1    -X1*X4      (X1) = *P* (0=LO,1=MIDDLE,2=UPPER) 
          LX1    2           CHANGE TO 2=LO,4=MIDDLE,10B=UPPER
          NZ     X1,FBCR2 
          R=     X1,2 
 FBCR2    SB4    X1          (B4) = RELOCATION INDICATOR
          LX4    27          POSITION ADDRESS 
          SX2    X4          (X2) = ADDR REL TO *TPGM*
          SX1    X4          FOR USE LATER
          R=     X3,17B 
          IX6    X2/X3,B6    CALCULATE CORRESPONDING WORD IN *TCPREL* 
          SA2    X6+B5       (X2) = *TCPREL* WORD, (A2) = ADDR
          R=     X3,17B 
          IX3    X6*X3
          IX3    X1-X3       (X3) = REMAINDER OF ABOVE DIVIDE 
          LX3    2           CALCULATE 59-3-(4*REMAINDER) 
          R=     X6,59-3
          IX6    X6-X3
          SB6    X6          (B6) = SHIFT COUNT 
          SX3    B4          LOAD RELOCATION INDICATOR
          LX6    X3,B6       SHIFT TO PROPER 4-BIT PARCEL 
          BX6    X6+X2       OR IN RELOCATION INDICATOR 
          BX5    -X5         SWITCH BYTE MASK 
          MI     X0,FBCR3    IF NOT TO STORE INTO *TCPREL*
          SA6    A2          WRITE WORD BACK INTO *TCPREL*
 FBCR3    PL     X5,FBCR1    IF NEXT BYTE LOWER 
          SB7    B7-B1       DECREMENT WORD COUNT 
          SA4    A4+B1       GET NEXT WORD FROM *TFBC*
          NZ     B7,FBCR1    IF NOT END OF *TFBC* 
          EQ     XFBCR
  
 FBCR4    SA1    OG 
          PL     X1,FBCR5    IF OVCAP GENERATION
          LX4    30          IGNORE HEADER BYTE 
          BX5    -X5         SWITCH BYTE MASK 
          EQ     FBCR3
  
 FBCR5    BSS    0           OVCAP GEN, CHECK *TBLK* INDEX OF RELOC QTY 
          SA1    OCBPI
          SB6    X1          (B6) = INITIAL *PI* FOR OVCAP GENER
          LX4    30 
          SB4    X4          (B4) = *TBLK* INDEX OF RELOC QUANTITY
 FBCR5B   BX5    -X5         SWITCH BYTE MASK 
          MX0    0           SET TO STORE INTO *TCPREL* 
          NZ     B4,FBCR5D   IF *TBLK* INDEX NOT TO CM // 
          SA1    OGBC 
          ZR     X1,FBCR3    IF CM // NOT DEFINED IN (0,0)
 FBCR5C   MX0    1           SET TO NOT STORE INTO *TCPREL* 
          EQ     FBCR3       GO TO PROCESS TRAILER BYTES
  
 FBCR5D   LT     B4,B6,FBCR5C  IF BLOCK DEFINED IN (0,0)
          EQ     FBCR3       GO TO PROCESS TRAILER BYTES
  
 FBCRECS  ERROR  503         ---- ECS TEXT DISALLOWED IN CAPSULES 
          EQ     FBCREL      EXIT 
  
*                            (B5) STILL = FWA OF *TCPREL* 
  
 XFBCR    SA4    TXFBC
          SA5    A4+B1
          SB7    X5          (B7) = WORD COUNT (LENGTH *TXFBC*) 
          SA4    X4          (X4)=NEXT WORD FROM *TXFBC*, (A4)=ADDR 
          ZR     B7,FBCREL   IF *TXFBC* EMPTY 
 XFBCR1   MI     X4,FBCRECS  IF ECS WORD
          SA1    OG          IF OVCAP GEN, CHECK BLOCK IN (0,0) 
          MI     X1,XFBCR1C  IF NOT OVCAP GENERATION
          SA1    OCBPI
          SB6    X1          (B6) = INITIAL *PI* FOR OVCAP GENER
          SB4    X4          (B4) = *TBLK* INDEX OF RELOC QUANTITY
          NZ     B4,XFBCR1B  IF *TBLK* INDEX NOT TO CM // 
          SA1    OGBC 
          NZ     X1,XFBCR6   IF CM // DEFINED IN (0,0)
          EQ     XFBCR1C
  
 XFBCR1B  LT     B4,B6,XFBCR6  IF BLOCK DEFINED IN (0,0)
 XFBCR1C  BSS    0
          LX4    1
          LX5    X4,B1       BELOW LOADABLE AREA BIT TO SIGN BIT
          PL     X5,XFBCR1A  IF NOT BELOW LOADABLE AREA 
          EQ     XFBCR6      IGNORE THIS WORD 
  
 XFBCR1A  BSS    0
          SB6    B0 
          PL     X4,XFBCR2   IF POSITIVE RELOCATION 
          SB6    B1          (B6)=0 IFF POS REL, (B6)=1 IFF NEG REL 
 XFBCR2   LX4    29 
          SB3    X4          (B3) = ADDRESS REL TO *TPGM* 
          LX4    12 
          MX5    -12
          BX5    -X5*X4      (X5) = 48/0,6/POS,6/SIZE 
          R=     X5,X5-0022B  CHECK EXACT LO FIELD
          NZ     X5,XFBCR3   IF NOT EXACT LO
          R=     X5,B6+2     SET LO POS OR LO NEG RELOCATION INDICATOR
          EQ     XFBCR5 
  
 XFBCR3   R=     X5,X5-1700B  CHECK EXACT MIDDLE FIELD
          NZ     X5,XFBCR4   IF NOT EXACT MIDDLE
          R=     X5,B6+2
          LX5    1           SET MIDDLE POS OR MIDDLE NEG RELOC INDIC 
          EQ     XFBCR5 
  
 XFBCR4   R=     X5,X5-1700B  CHECK EXACT UPPER FIELD 
          NZ     X5,XFBCINV  IF NOT EXACT UPPER (THEN NON-STANDARD) 
          R=     X5,B6+2
          LX5    2           SET UPPER POS OR UPPER NEG RELOC INDIC 
 XFBCR5   SB4    X5          (B4) = RELOCATION INDICATOR
          SX1    B3          ADDR REL TO *TPGM* 
          SX2    B3 
          R=     X3,17B 
          IX6    X2/X3,B2    CALCULATE CORRESPONDING WORD IN *TCPREL* 
          SA2    X6+B5       (X2) = *TCPREL* WORD, (A2) = ADDR
          R=     X3,17B 
          IX3    X6*X3
          IX3    X1-X3       (X3) = REMAINDER OF ABOVE DIVIDE 
          LX3    2           CALCULATE 59-3-(4*REMAINDER) 
          R=     X6,59-3
          IX6    X6-X3
          SB6    X6          (B6) = SHIFT COUNT 
          SX3    B4          LOAD RELOCATION INDICATOR
          LX6    X3,B6       SHIFT TO PROPER 4-BIT PARCEL 
          BX6    X6+X2       OR IN RELOCATION INDICATOR 
          SA6    A2          WRITE WORD BACK INTO *TCPREL*
 XFBCR6   BSS    0
          SA4    A4+B1       GET NEXT WORD FROM *TXFBC* 
          SB7    B7-B1       DECREMENT WORD COUNT 
          ZR     B7,FBCREL   IF DONE WITH *TXFBC* THEN EXIT 
          EQ     XFBCR1      CONTINUE 
  
 XFBCINV  SA1    TXFBC       (X1) = FWA *TXFBC* 
          SX0    A4          (X0) = CURRENT ADDRESS WITHIN *TXFBC*(ABS) 
          IX0    X0-X1       SAVE RELATIVE ADDRESS WITHIN *TXFBC* 
          SA4    A4          (X4) = *TXFBC* WORD THAT VIOLATES
          MX1    -18
          LX4    30 
          BX1    -X1*X4      (X1) = ADDRESS OF VIOLATION
          RJ     /MISC/COD   CONVERT TO DISPLAY CODE
          BX7    X6 
          ERROR  504,X7      ---- RELOCATION RESTRICTIONS VIOLATED
          SA4    TXFBC       (X4) = FWA *TXFBC* 
          IX4    X4+X0
          SA4    X4          RESTORE (A4) = ABS ADDRESS IN *TXFBC*
          EQ     XFBCR6      CONTINUE 
  
 LBCREL   SPACE  4,8
**        LBCREL - LINK BYTE CHAIN RELOCATION TABLE PROCESSING. 
* 
*              THIS ROUTINE IS CALLED FROM *LBC* TO MAINTAIN THE
*         CAPSULE RELOCATION TABLE *TCPREL* FOR LINK/XLINK BYTE 
*         CHAINS.  SCANS TABLES *TLBC*/*TXLBC* AND MAINTAINS THE
*         RELOCATION INDICATORS IN TABLE *TCPREL* FOR CAPSULE 
*         OR OVCAP GENERATION.
* 
*         ENTRY  TABLES *TLBC*/*TXLBC* CONTAIN LINK/XLINK INFO. 
*                TABLE *TCPREL* HAS NECESSARY SPACE ALLOCATED,
*                INITIALIZED, AND POSSIBLY SOME RELOCATION INFO.
*         EXIT   TABLE *TCPREL* MODIFIED TO CONTAIN ALL NECESSARY 
*                RELOCATION INDICATORS FOR LINK/XLINK BYTE CHAINS.
*         USES   ALL REGISTERS. 
*         CALLS  ELT, ERROR.
  
 LBCREL   PS                 ENTRY/EXIT 
          SA4    TCPREL 
          SB5    X4          (B5) = FWA *TCPREL*
          SA4    TLBC 
          SA5    X4          (X5)=NEXT WORD FROM *TLBC*, (A5)=ADDR
          SA3    A4+B1
          SB7    X3          (B7) = WORD COUNT (LENGTH *TLBC*)
          MX0    30          (X0) = BYTE MASK 
          ZR     B7,XLBCR    IF *TLBC* EMPTY
 LBCR1    PL     X5,LBCR4    IF NOT TRAILER BYTE
          LX5    3
          LX1    X5,B1       BELOW LOADABLE AREA BIT TO SIGN BIT
          PL     X1,LBCR1A   IF NOT BELOW LOADABLE AREA 
          LX5    27          IGNORE THIS TRAILER BYTE 
          BX0    -X0         SWITCH BYTE MASK 
          PL     X0,LBCR1    IF NEXT BYTE LOWER 
          EQ     LBCR3       GO TO GET NEXT *TLBC* WORD 
  
 LBCR1A   BSS    0
          MX1    -2 
          MI     X5,LBCRECS  IF ECS WORD
          BX1    -X1*X5      (X1)=*P* (0=LO,1=MIDDLE,2=UPPER) 
          LX1    2           CHANGE TO 2=LO,4=MIDDLE,10B=UPPER
          NZ     X1,LBCR2 
          R=     X1,2 
 LBCR2    SB4    X1          (B4) = RELOCATION INDICATOR
          LX5    27 
          SB3    X5          (B3) = ADDR REL TO *TPGM*
          SX2    X5 
          R=     X3,17B 
          IX6    X2/X3,B2    CALCULATE CORRESPONDING WORD IN *TCPREL* 
          SA2    X6+B5       (X2) = *TCPREL* WORD, (A2) = ADDR
          R=     X3,17B 
          IX3    X6*X3
          SX1    B3 
          IX3    X1-X3       (X3) = REMAINDER OF ABOVE DIVIDE 
          LX3    2           CALCULATE 59-3-(4*REMAINDER) 
          R=     X6,59-3
          IX6    X6-X3
          SB2    X6          (B2) = SHIFT COUNT 
          PL     B6,LBCR2A   IF TO ADD RELOCATION BIT 
          MX6    -2          FORM 2-BIT MASK
          SX3    B4          (X3) = 0-LOWER, 1-MIDDLE, 2-UPPER
          AX3    2
          SB2    B2+X3       ADJUST SHIFT COUNT FOR DESIRED PARCEL
          LX6    X6,B2       SHIFT TO DESIRED PARCEL INDICATOR
          BX6    X6*X2       SET PARCEL TO NO RELOCATION
          EQ     LBCR2B 
  
 LBCR2A   SX3    B4          LOAD RELOCATION INDICATOR
          LX6    X3,B2       SHIFT TO PROPER 4-BIT PARCEL 
          BX6    X6+X2       OR IN RELOCATION INDICATOR 
 LBCR2B   BX0    -X0         SWITCH BIT MASK
          SA6    A2          WRITE WORD BACK INTO *TCPREL*
          PL     X0,LBCR1    IF NEXT BYTE LOWER 
 LBCR3    MX0    30          SET BYTE MASK FOR UPPER
          SA5    A5+B1       (X5)=NEXT WORD FROM *TLBC*, (A5)=ADDR
          SB7    B7-B1       DECREMENT WORD COUNT 
          NZ     B7,LBCR1    IF NOT END OF *TLBC* 
          EQ     XLBCR
  
 LBCRECS  ERROR  503         ---- ECS TEXT DISALLOWED IN CAPSULES 
          EQ     LBCREL      EXIT 
  
 LBCR4    PL     X0,LBCR3    IGNORE ZERO TRAILER BYTE 
 LBCR5    BX1    X5          EXTERNAL NAME
          MX2    0           INDICATE SEARCH ONLY 
          RJ     ELT         FIND DEFINITION
          SB6    B0          FLAG TO ADD RELOCATION BIT 
          SA1    OG          IF OVCAP GEN CHECK FOR ENTRY IN (0,0)
          MI     X1,LBCR5B   IF NOT OVCAP GENERATION
          SA1    OCBPI
          SB2    X1          (B2) = INITIAL *PI* FOR OVCAP GENER
          LX2    -36
          SB3    X2          (B3) = *TBLK* INDEX FOR EPT-S BLOCK
          LX2    36 
          NZ     B3,LBCR5A   IF *TBLK* INDEX NOT TO CM // 
          LX1    X2,B1       CHECK FOR UNRESOLVED EXTERNAL
          LX1    B1          *OMIT* BIT TO SIGN POSITION
          MI     X1,LBCR5B   IF UNRESOLVED EXTERNAL 
          SA1    OGBC 
          NZ     X1,LBCR6    IF DEFINED IN CM // OF (0,0) (IGNORE)
          EQ     LBCR5B 
  
 LBCR5A   GE     B3,B2,LBCR5B  IF NOT DEFINED IN (0,0)
          SB6    -B1         FLAG TO REMOVE RELOCATION BIT
 LBCR5B   BSS    0
          LX2    1           LOOK AT *U* (UNSATISFIED) BIT
          PL     X2,LBCR3    IF SATISFIED THEN PROCESS
 LBCR6    SA5    A5+B1       (X5)=NEXT *TLBC* WORD, (A5)=ADDR 
          SB7    B7-B1       DECREMENT WORD COUNT 
          ZR     B7,XLBCR    IF END OF *TLBC* 
          MI     X5,LBCR6    IF NOT NAME CONTINUE TO DISCARD
          EQ     LBCR5       GO PROCESS EXTERNAL NAME 
  
*                            (B5) STILL = FWA *TCPREL*
  
 XLBCR    SA4    TXLBC
          SA3    A4+B1
          SA5    X4          (X5)=NEXT WORD FROM *TXLBC*, (A5)=ADDR 
          SB7    X3          (B7) = WORD COUNT (LENGTH *TXLBC*) 
          ZR     B7,LBCREL   IF *TXLBC* EMPTY THEN RETURN 
 XLBCR1   BX1    X5          EXTERNAL NAME
          MX2    0           INDICATE SEARCH ONLY 
          RJ     ELT         FIND DEFINITION
          SA1    OG          IF OVCAP GEN CHECK FOR ENTRY IN (0,0)
          MI     X1,XLBCR1B  IF NOT OVCAP GENERATION
          SA1    OCBPI
          SB2    X1          (B2) = INITIAL *PI* FOR OVCAP GENER
          LX2    -36
          SB3    X2          (B3) = *TBLK* INDEX FOR EPT-S BLOCK
          LX2    36 
          NZ     B3,XLBCR1A  IF *TBLK* INDEX NOT TO CM // 
          LX1    X2,B1       CHECK FOR UNRESOLVED EXTERNAL
          LX1    B1          *OMIT* BIT TO SIGN POSITION
          MI     X1,XLBCR1B  IF UNRESOLVED EXTERNAL 
          SA1    OGBC 
          NZ     X1,XLBCR6   IF DEFINED IN CM // OF (0,0) (IGNORE)
          EQ     XLBCR1B
  
 XLBCR1A  LT     B3,B2,XLBCR6  IF DEFINED IN (0,0) (IGNORE) 
 XLBCR1B  BSS    0
          LX2    1           LOOK AT *U* (UNSATISFIED) BIT
          MI     X2,XLBCR6   IF NOT TO PROCESS (UNSATISFIED)
 XLBCR2   SA5    A5+B1       (X5)=NEXT WORD FROM *TXLBC*, (A5)=ADDR 
          SB7    B7-B1       DECREMENT WORD COUNT 
          ZR     B7,LBCREL   IF END OF *TXLBC* THEN EXIT
          ZR     X5,XLBCR7   IF ZERO TRAILER WORD 
          MI     X5,LBCRECS  IF ECS WORD
          BX4    X5 
          LX4    2           BELOW LOADABLE AREA BIT TO SIGN BIT
          PL     X4,XLBCR2A  IF NOT BELOW LOADABLE AREA 
          EQ     XLBCR2      IGNORE THIS WORD 
  
 XLBCR2A  BSS    0
          LX5    30 
          SB3    X5          (B3) = ADDR REL TO *TPGM*
          LX5    12 
          MX4    -12
          BX4    -X4*X5      (X4) = 48/0,6/POS,6/SIZE 
          R=     X4,X4-0022B  CHECK EXACT LO FIELD
          NZ     X4,XLBCR3   IF NOT EXACT LO
          R=     X4,2        SET LO POS RELOCATION INDICATOR
          EQ     XLBCR5 
  
 XLBCR3   R=     X4,X4-1700B  CHECK EXACT MIDDLE FIELD
          NZ     X4,XLBCR4   IF NOT EXACT MIDDLE
          R=     X4,4        SET MIDDLE POS RELOCATION INDICATOR
          EQ     XLBCR5 
  
 XLBCR4   R=     X4,X4-1700B  CHECK EXACT UPPER FIELD 
          NZ     X4,XLBCINV  IF NOT EXACT UPPER (THEN NON-STANDARD) 
          R=     X4,10B      SET UPPER POS RELOCATION INDICATOR 
 XLBCR5   SB4    X4          (B4) = RELOCATION INDICATOR
          SX2    B3          ADDR REL TO *TPGM* 
          R=     X3,17B 
          IX6    X2/X3,B2    CALCULATE CORRESPONDING WORD IN *TCPREL* 
          SA2    X6+B5       (X2) = *TCPREL* WORD, (A2) = ADDR
          R=     X3,17B 
          IX3    X6*X3
          SX1    B3 
          IX3    X1-X3       (X3) = REMAINDER OF ABOVE DIVIDE 
          LX3    2           CALCULATE 59-3-(4*REMAINDER) 
          R=     X6,59-3
          IX6    X6-X3
          SB6    X6          (B6) = SHIFT COUNT 
          SX3    B4          LOAD RELOCATION INDICATOR
          LX6    X3,B6       SHIFT TO PROPER 4-BIT PARCEL 
          BX6    X6+X2       OR IN RELOCATION INDICATOR 
          SA6    A2          WRITE WORD BACK INTO *TCPREL*
          EQ     XLBCR2      CONTINUE 
  
 XLBCR6   SA5    A5+B1       (X5)=NEXT *TXLBC* WORD, (A5)=ADDR
          SB7    B7-B1       DECREMENT WORD COUNT 
          ZR     B7,LBCREL   IF END OF *TXLBC* THEN EXIT
          NZ     X5,XLBCR6   READ UNTIL ZERO TRAILER BYTE 
 XLBCR7   SA5    A5+B1       (X5)=NEXT *TXLBC* WORD, (A5)=ADDR
          SB7    B7-B1       DECREMENT WORD COUNT 
          ZR     B7,LBCREL   IF END OF *TXLBC* THEN EXIT
          EQ     XLBCR1      GO PROCESS EXTERNAL NAME 
  
 XLBCINV  SA1    TXLBC       (X1) = FWA *TXLBC* 
          SX0    A5          (X0) = CURRENT ADDRESS WITHIN *TXLBC*(ABS) 
          IX0    X0-X1       SAVE RELATIVE ADDRESS WITHIN *TXLBC* 
          SA5    A5          (X5) = *TXLBC* WORD THAT VIOLATES
          MX1    -18
          LX5    30 
          BX1    -X1*X5      (X1) = ADDRESS OF VIOLATION
          RJ     /MISC/COD   CONVERT TO DISPLAY CODE
          BX7    X6 
          ERROR  504,X7      ---- RELOCATION RESTRICTIONS VIOLATED
          SA5    TXLBC       (X5) = FWA *TXLBC* 
          IX5    X5+X0
          SA5    X5          RESTORE (A5) = ABS ADDRESS IN *TXLBC*
          EQ     XLBCR2      CONTINUE 
  
 TXTREL   SPACE  4,8
**        TXTREL - TEXT/XTEXT RELOCATION TABLE PROCESSING.
* 
*              THIS ROUTINE IS CALLED FROM TEXT/XTEXT TABLE 
*         PROCESSOR TO MAINTAIN CAPSULE RELOCATION TABLE *TCPREL*.
*         PUTS RELOCATION INDICATORS FROM TEXT/XTEXT TABLE INTO 
*         PROPER PLACE IN *TCPREL*. 
* 
*         ENTRY  (X0) = WORD COUNT (OF TEXT BLOCK, 1 THRU 17B,
*                       EXCLUDES RELOCATION INDICATOR HEADER WORD). 
*                (A5) = ADDRESS OF TEXT BLOCK (ABSOLUTE). 
*                (X5) = RELOCATION INDICATORS.
*         EXIT   RELOCATION INDICATORS PUT INTO *TCPREL*. 
*         USES   X - 0, 1, 3, 4, 6. 
*                B - 2, 3, 5. 
*                A - 1, 3, 6. 
*         CALLS  NONE.
  
 TXTREL   PS                 ENTRY/EXIT 
          SA1    TPGM        (X1) = FWA *TPGM*
          SX3    A5          (X3) = FWA OF TEXT (ABSOLUTE)
          IX3    X3-X1
          SB3    X3          (B3) = ADDR REL TO *TPGM*
          R=     X1,17B 
          IX6    X3/X1,B5    CALCULATE CORRESPONDING WORD IN *TCPREL* 
          SA1    TCPREL      (X1) = FWA *TCPREL*
          IX1    X1+X6
          SB2    X1          (B2) = ADDR OF WORD IN *TCPREL* (ABSOLUTE) 
          R=     X1,17B 
          IX1    X1*X6       CALCULATE REMAINDER OF ABOVE DIVIDE
          SX6    B3 
          IX1    X6-X1       (X1) = REMAINDER OF ABOVE DIVIDE 
          LX1    2           CALCULATE 59-3-(4*REMAINDER) 
          R=     X6,59-3
          IX6    X6-X1
          SB5    X6          (B5) = SHIFT COUNT 
          BX1    X5          (X1) = RELOCATION INDICATORS 
          SA3    B2          (X3) = *TCPREL* WORD, (A3) = ADDR
 TXTR1    LX1    4
          MX4    -4 
          BX4    -X4*X1      (X4) = NEXT RELOCATION INDICATOR 
          LX4    B5          SHIFT TO PROPER 4-BIT PARCEL 
          BX3    X3+X4       OR IN RELOCATION INDICATOR 
          R=     B5,B5-4     DECREMENT SHIFT COUNT
          R=     X0,X0-1     DECREMENT WORD COUNT 
          MI     B5,TXTR3    IF *TCPREL* WORD BOUNDARY
 TXTR2    NZ     X0,TXTR1    IF MORE RELOCATION INDICATORS
          BX6    X3 
          SA6    A3          WRITE WORD BACK INTO *TCPREL*
          EQ     TXTREL      RETURN 
  
 TXTR3    BX6    X3 
          SA6    A3          WRITE WORD BACK INTO *TCPREL*
          SA3    A3+B1       (X3) = NEXT *TCPREL* WORD, (A3) = ADDR 
          R=     B5,59-3     SET SHIFT COUNT FOR NEW WORD 
          EQ     TXTR2       CONTINUE 
  
 CGRML    SPACE  4,8
**        CGRML - REMOVE LINKAGES FOR CAPSULE GENERATION. 
* 
*              THIS ROUTINE IS CALLED FROM *INCAP* TO INITIALIZE
*         ALL MANAGED TABLES FOR THE NEXT ENCAPSULATION.  SOME
*         TABLES ARE CLEARED, *TBLK* IS INITIALIZED, *TLNK* IS
*         INITIALIZED WITH OMITS, *TPGM* IS CLEARED AND THE ABS 
*         BLOCK IS ALLOCATED. 
  
 CGRML    PS                 ENTRY/EXIT 
          SA2    TPGM 
          RJ     CTAB=       CLEAR *TPGM* 
          SA2    LASCPNAM 
          ZR     X2,CGRML0   IF FIRST CAPSULE LEAVE *TLNK*/*TUSEP*
          SA2    TLNK 
          RJ     CTAB=       CLEAR *TLNK* 
          SA2    TUSEP
          RJ     CTAB=       CLEAR *TUSEP*
 CGRML0   BSS    0
          SA2    TEPT 
          RJ     CTAB=       CLEAR *TEPT* 
          SA2    TEPT1
          RJ     CTAB=       CLEAR *TEPT1*
          SA2    TLBC2
          RJ     CTAB=       CLEAR *TLBC2*
          SA2    TCPREL 
          RJ     CTAB=       CLEAR *TCPREL* 
          SA2    TBLK        (X2) = FWA *TBLK*
          R=     X6,6 
          SA6    A2+B1       SET *TBLK* LENGTH = 6
          SB2    B1+B1
          MX6    1
          SA6    X2+B1       SET CM // NOT REF, ZERO LENGTH AND ADDR
          SA6    A6+B2       SET ECS // NOT REF, ZERO LENGTH AND ADDR 
          R=     X2,3 
          LX2    24 
          BX6    X6+X2
          SA6    A6+B2       SET ABS BLOCK NOT REF, LENGTH=3, ADDR=0
          SA1    TOMIT+1     PICK UP *TOMIT* LENGTH 
          ZR     X1,CGRML1   IF *TOMIT* EMPTY 
          BX2    X1          ELSE INITIALIZE *TLNK* WITH OMITS
          LX2    36 
          R=     X3,COMIT 
          LX3    48 
          BX1    X2+X3       *OMIT* HEADER AND LENGTH (INTERNAL FORM) 
          ADDWRD TREQ2,X1    ADD TO *TREQ2* 
          SA1    TOMIT+1     *TOMIT* LENGTH 
          ALLOC  TREQ2,X1    ALLOCATE SPACE IN *TREQ2*
          SA2    TOMIT       SOURCE ADDR
          MOVE   X1,X2,X3    MOVE *TOMIT* TO *TREQ2*
          RJ     REQD        INITIALIZE *TLNK* WITH OMITS 
 CGRML1   BSS    0
          MX6    0
          SA6    PO          PO=0 
          SA6    BI          BI=0 
          SA6    PA          PA=0 
          R=     X1,3        ALLOCATE ABS BLOCK (LENGTH=3, 6000 HEADER) 
          MX2    0           INDICATOR FOR CM SPACE 
          RJ     APS=        APS= BUMPS PA AND ALLOCATES *TCPREL* ALSO
          EQ     CGRML       RETURN 
  
 CGEPL    SPACE  4,8
**        CGEPL - CAPSULE/OVCAP ENTRY POINT LIST PROCESSING.
* 
*              THIS ROUTINE IS CALLED FROM *CLCAP* (CAPSULE GENERATION) 
*         OR *CLOC* (OVCAP GENERATION) AND IS RESPONSIBLE 
*         FOR GENERATING THE CAPSULE ENTRY POINT LIST.  THE LIST IS 
*         TO BE IN ALPHANUMERIC ORDER AND IS GENERATED FROM TABLES
*         *TLNK* (ALREADY ORDERED) AND *TCPENT*.  IF THE DEFAULT ENTRY
*         POINT DETERMINATION HAS BEEN TURNED OFF BY AN EMPTY *NOEPT* 
*         REQUEST, THEN THE CAPSULE ENTRY POINTS ARE THOSE EXPLICITLY 
*         MENTIONED (ON *EPT* REQUESTS) AND AN ENTRY POINT WHOSE NAME 
*         IS THE SAME AS THE CAPSULE NAME (IF ONE EXISTS, IS SATISFIED, 
*         AND HAS NOT BEEN EXPLICITLY LEFT OUT BY A *NOEPT*).  ELSE THE 
*         DEFAULT DETERMINATION IS USED, NAMELY - IN *TLNK* A SATISFIED 
*         UNREFERENCED ENTRY POINT BECOMES A CAPSULE ENTRY POINT UNLESS 
*         OVERRIDEN BY A *NOENTRY* REQUEST.  A SATISFIED REFERENCED 
*         ENTRY POINT DOES NOT BECOME A CAPSULE ENTRY POINT UNLESS
*         OVERRIDEN BY AN *ENTRY* REQUEST.  THIS ROUTINE FILTERS THRU 
*         *TLNK* AND SETS UP THE ENTRY LIST IN *TCPENTR* AS INDICATED 
*         ABOVE.  THEN THE RELEVANT FIELDS IN THE *6000* HEADER ARE 
*         PLUGGED IN AND *TCPENTR* IS MOVED TO THE END OF *TPGM*. 
*         *TCPENTR* IS NOT CLEARED AS IT MAY BE NEEDED FOR THE MAP. 
  
 CGEPL    PS                 ENTRY/EXIT 
          MX6    0
          SA6    TCPENTR+1   EMPTY *TCPENTR*
          SB2    B0          (B2) = *TLNK* FETCH POINTER
          SA1    TLNK+1 
          SB3    X1          (B3) = *TLNK* LENGTH 
 CGEPL1   GE     B2,B3,CGEPL6  IF DONE WITH *TLNK*
          SA1    TLNK 
          SA1    X1+B2       (X1) = NEXT *TLNK* NAME (18/0,42/0LNAME) 
          SA2    A1+B1       (X2) = NEXT *TLNK* DEF WORD
          R=     B2,B2+2     BUMP FETCH POINTER 
          BX3    X2          CHECK IF SATISFIED 
          LX3    2           *OMIT* BIT (*USX* SETS *UNSAT* TO *OMIT*)
          MI     X3,CGEPL1   IF UNSATISFIED (CAN NOT BE ENTRY)
          LX3    22          RIGHT ADJUST PROGRAM INDEX IN X3 
          SA4    OCBPI       INITIAL *PI* AFTER */LOADG/RML*
          SB4    X3          (B4) = PROGRAM INDEX 
          SB5    X4          (B5) = FIRST PROGRAM INDEX THIS OVCAP
          LT     B4,B5,CGEPL1  IF ENTRY POINT IS IN (0,0) OVERLAY 
          NZ     B4,CGEPL1A  IF ENTRY POINT NOT IN CM //
          SA4    OCOGBC      CM // ORIGIN IN (0,0) (NONE=0) 
          NZ     X4,CGEPL1   IF ENTRY POINT IN (0,0) CM // BLOCK
 CGEPL1A  BSS    0
          MX0    42 
          LX1    18 
          BX1    X1*X0       (X1) = 42/0LNAME,18/0
          SA4    TCPENT      SEARCH FOR NAME IN *TCPENT*
          MX3    0           INIT (X3) = 0 (NOT FOUND)
          SB4    X4          (B4) = *TCPENT* FWA
          SA4    A4+B1
          SB6    -B1         (B6) = FETCH POINTER 
          SB5    X4          (B5) = *TCPENT* LENGTH 
 CGEPL2   SB6    B6+B1       BUMP FETCH POINTER 
          GE     B6,B5,CGEPL3  IF NAME NOT IN *TCPENT*
          SA4    B4+B6       NEXT *TCPENT* ENTRY
          BX5    X0*X4       MASK NAME
          BX5    X1-X5       COMPARE NAMES
          NZ     X5,CGEPL2   IF NO MATCH
          BX3    X4          (X3) = MATCHING ENTRY
 CGEPL3   BSS    0           (X3) = *TCPENT* MATCH OR ZERO
          SA4    CGNDE
          NZ     X4,CGEPL8   IF DEFAULT DETERMINATION TURNED OFF
          MI     X2,CGEPL4   IF ENTRY REFERENCED
          ZR     X3,CGEPL5   IF NOT *NOENTRY* (AND NOT REFERENCED)
          SX3    X3          CLEAR NAME, SAVE FLAG (0 IFF *ENTRY*)
          ZR     X3,CGEPL5   IF *ENTRY* (AND NOT REFERENCED)
          EQ     CGEPL1      ELSE NOT A CAPSULE ENTRY POINT 
  
 CGEPL4   BSS    0           WE HAVE A REFERENCED ENTRY POINT 
          ZR     X3,CGEPL1   IF NOT *ENTRY* (AND REFERENCED)
          SX3    X3          CLEAR NAME, SAVE FLAG (0 IFF *ENTRY*)
          NZ     X3,CGEPL1   IF *NOENTRY* (AND REFERENCED)
 CGEPL5   BSS    0           WE HAVE A CAPSULE ENTRY POINT
          BX4    -X0*X2 
          BX1    X1+X4       (X1) = 42/0LNAME,18/ADDRESS
          ADDWRD TCPENTR,X1  ADD TO *TCPENTR* 
          EQ     CGEPL1      CONTINUE THRU *TLNK* 
  
 CGEPL6   BSS    0           *TCPENTR* COMPLETELY SET UP (ORDERED)
          SA1    TCPENTR+1
          NZ     X1,CGEPL7   IF AT LEAST ONE ENTRY POINT
          SA1    PC          CHECK FOR EMPTY LOAD 
          ZR     X1,CGEPL    IF EMPTY LOAD (SUPPRESS ERROR) 
          ERROR  507         ---- CAPSULE WITH NO ENTRY POINTS
          EQ     CGEPL       RETURN 
  
 CGEPL7   SA2    TPGM        PLUG *6000* HEADER FIELDS
          SA3    A2+B1       *TPGM* LENGTH (= ENTRY LIST POINTER) 
          SA2    X2          (X2) = FIRST WORD OF (*TPGM*) *6000* HEADER
          LX1    36          POSITION ENTRY POINT COUNT 
          BX6    X1+X2       OR IN ENTRY POINT COUNT
          SA6    A2          REWRITE *6000* HEADER (FIRST WORD) 
          SA4    A2+B1       SECOND WORD OF HEADER
          BX6    X4+X3       OR IN ENTRY LIST POINTER 
          SA6    A4          REWRITE *6000* HEADER (SECOND WORD)
          LX1    -36         RIGHT ADJUST ENTRY POINT COUNT 
          ALLOC  TPGM,X1     ALLOCATE *TPGM* SPACE FOR ENTRY LIST 
          SA2    TCPENTR     SOURCE ADDRESS 
          MOVE   X1,X2,X3    MOVE *TCPENTR* TO END OF *TPGM*
*                            DON-T CLEAR *TCPENTR*, NEEDED FOR MAP
          EQ     CGEPL       RETURN 
  
 CGEPL8   SA4    CURCPNAM 
          BX4    X4-X1
          NZ     X4,CGEPL9   IF EPT NAME .NE. CAPSULE NAME
          SX3    X3 
          ZR     X3,CGEPL5   IF NOT EXPLICIT *NOEPT*
          EQ     CGEPL1      CONTINUE THRU *TLNK* 
  
 CGEPL9   BX3    X3-X1
          ZR     X3,CGEPL5   IF IN *TCPENT* AS EXPLICIT *EPT* 
          EQ     CGEPL1      CONTINUE THRU *TLNK* 
  
 CGXRL    SPACE  4,8
**        CGXRL - CAPSULE/OVCAP XREF LIST AND CHAIN PROCESSING. 
* 
*              THIS ROUTINE IS CALLED FROM *CLCAP* (CAPSULE GENERATION) 
*         OR *CLOC* (OVCAP GENERATION) AND IS RESPONSIBLE 
*         FOR GENERATING THE CAPSULE EXTERNAL REFERENCE LIST AND
*         REFERENCE CHAINS.  THE LIST IS TO BE IN ALPHANUMERIC ORDER
*         AND IS GENERATED FROM TABLES *TLNK* (ALREADY ORDERED) AND 
*         *TLBC2*.  IN *TLNK* AN UNSATISFIED (UNRESOLVED) EXTERNAL
*         APPEARS AS AN *OMIT* (AS CHANGED BY *USX*), AND ANY SUCH
*         ENTITY WITH A CORRESPONDING *TLBC2* ENTRY IS AN EXTERNAL
*         REFERENCE.  THE XREF LIST IS GENERATED IN TABLE *TCPEXTR* 
*         AND THE REFERENCE CHAINS ARE GENERATED IN TABLE *TSCR1*.
*         THESE TABLES ARE THEN MOVED TO THE END OF *TPGM* AND ANY
*         RELEVANT FIELDS ARE PLUGGED IN THE *6000* HEADER.  TABLE
*         *TCPEXTR* IS NOT CLEARED AS IT MAY BE NEEDED FOR THE MAP. 
  
 CGXRL    PS                 ENTRY/EXIT 
          MX6    0
          SA6    TCPEXTR+1   CLEAR *TCPEXTR*
          SA6    TSCR1+1     CLEAR *TSCR1*
          SA1    TLNK+1 
          SB2    B0          (B2) = *TLNK* FETCH POINTER
          SB3    X1          (B3) = *TLNK* LENGTH 
 CGXRL1   GE     B2,B3,CGXRL7  IF THRU WITH *TLNK*
          SA3    TLNK 
          SA1    X3+B2       NEXT *TLNK* NAME 
          SA2    A1+B1       NEXT *TLNK* DEF WORD 
          MX0    42 
          LX1    18 
          BX1    X0*X1       (X1) = 42/0LNAME,18/0
          LX2    2           *OMIT* BIT 
          R=     B2,B2+2     BUMP FETCH POINTER 
          PL     X2,CGXRL1   IF NOT UNRESOLVED EXTERNAL 
          MX0    1
          LX2    2           *WEAK* BIT 
          BX3    X0*X2
          LX3    18 
          SA4    TSCR1+1     CHAIN ADDRESS (REL TO *TSCR1*) 
          BX3    X3+X1
          BX3    X3+X4       (X3) = 42/0LNAME,1/W,17/ADDR 
          SA4    TLBC2
          SA5    A4+B1
          SB4    B0          (B4) = *TLBC2* FETCH POINTER 
          SB5    X5          (B5) = *TLBC2* LENGTH
          SB6    X4          (B6) = *TLBC2* FWA 
 CGXRL2   GE     B4,B5,CGXRL1  IF NAME NOT IN *TLBC2* 
          SA4    B6+B4       NEXT *TLBC2* ENTRY 
          BX4    X4-X1       COMPARE NAMES
          SB4    B4+B1       BUMP FETCH POINTER 
          NZ     X4,CGXRL2   IF NO MATCH
          R=     B6,24B      (B6) = CHAIN PARCEL SHIFT COUNT (FIRST=0)
          BX0    X1          SAVE NAME
          ADDWRD TCPEXTR,X3  ADD NAME/W/ADDR TO XREF LIST 
          BX1    X0          RESTORE NAME 
          MX3    0           (X3) = PARCEL WORKING REGISTER 
          EQ     CGXRL5      NAMES MATCH
  
 CGXRL3   GE     B4,B5,CGXRL6  IF DONE WITH *TLBC2* 
          SA4    TLBC2
          SA5    X4+B4       NEXT *TLBC2* ENTRY 
          SB4    B4+B1       BUMP FETCH POINTER 
 CGXRL4   BX4    X5-X1       COMPARE NAMES
          NZ     X4,CGXRL3   IF NO MATCH
 CGXRL5   GE     B4,B5,CGXRL6  IF DONE WITH *TLBC2* 
          SA4    TLBC2
          SA5    X4+B4       NEXT *TLBC2* ENTRY 
          SB4    B4+B1       BUMP FETCH POINTER 
          PL     X5,CGXRL4   IF NAME WORD 
          MX0    30 
          BX0    X0*X5
          LX0    30          UPPER PARCEL INTO X0 
          RJ     CGXRCH      PROCESS PARCEL 
          MX0    30 
          BX0    -X0*X5      LOWER PARCEL INTO X0 
          ZR     X0,CGXRL3   IF LOWER PARCEL DOES NOT EXIST 
          RJ     CGXRCH      PROCESS PARCEL 
          EQ     CGXRL5      CONTINUE THRU *TLBC2*
  
 CGXRL6   R=     B6,B6-50B   SEE IF LAST CHAIN WORD NEEDS TO BE WRITTEN 
          ZR     B6,CGXRL1   IF ALREADY WRITTEN 
          ADDWRD TSCR1,X3    ELSE ADD TO *TSCR1*
          EQ     CGXRL1      CONTINUE THRU *TLNK* 
  
 CGXRL7   SA1    TPGM 
          SA3    TCPEXTR+1   (X3) = *TCPEXTR* LENGTH
          SA2    A1+B1       (X2) = *TPGM* LENGTH 
          SA1    X1          (X1) = FIRST *6000* HEADER WORD
          BX4    X3 
          LX4    24 
          BX6    X1+X4       OR IN EXTERNAL COUNT 
          SA6    A1          REWRITE HEADER WORD
          IX1    X2+X3       LENGTH *TPGM* + LENGTH *TCPEXTR* 
          SB2    B0          (B2) = *TCPEXTR* FETCH POINTER 
          SB3    X3          (B3) = *TCPEXTR* LENGTH
          SA4    TCPEXTR
          SB4    X4          (B4) = FWA *TCPEXTR* 
 CGXRL8   GE     B2,B3,CGXRL9  IF DONE WITH *TCPEXTR* 
          SA4    B4+B2       NEXT *TCPEXTR* ENTRY 
          IX6    X4+X1       SET REF CHAIN ADDR REL TO *TPGM* 
          SA6    A4 
          SB2    B2+B1
          EQ     CGXRL8      CONTINUE THRU *TCPEXTR*
  
 CGXRL9   BX1    X3          *TCPEXTR* LENGTH 
          ZR     X3,CGXRL    IF NO REFERENCES (OR CHAINS) 
          ALLOC  TPGM,X1     ALLOCATE *TPGM* SPACE FOR *TCPEXTR*
          SA2    TCPEXTR     SOURCE ADDRESS 
          MOVE   X1,X2,X3    MOVE *TCPEXTR* TO END OF *TPGM*
          SA1    TSCR1+1     *TSCR1* LENGTH 
          ALLOC  TPGM,X1     ALLOCATE *TPGM* SPACE FOR *TSCR1*
          SA2    TSCR1       SOURCE ADDRESS 
          MOVE   X1,X2,X3    MOVE *TSCR1* TO END OF *TPGM*
          MX6    0
          SA6    TSCR1+1     CLEAR *TSCR1*
*                            DON-T CLEAR *TCPEXTR*, NEEDED FOR MAP
          EQ     CGXRL       RETURN 
  
**        CGXRCH - PROCESS EXTERNAL REFERENCE CHAIN.
* 
*              INTERNAL SUBROUTINE OF *CGXRL* TO PROCESS *TLBC2*
*         PARCEL AND MAINTAIN THE REFERENCE CHAIN IN *TSCR1*. 
  
 CGXRCH   PS                 ENTRY/EXIT 
          MX2    -18
          BX2    -X2*X0      (X2) = 42/0,18/ADDR(REL TO *TPGM*) 
          MX4    2
          LX0    59-28
          BX4    X4*X0
          LX4    2           (X4) = 0(LOWER),1(MIDDLE),2(UPPER) 
          R=     X0,3 
          IX0    X0-X4       (X0) = 3(LOWER),2(MIDDLE),1(UPPER) 
          LX0    18 
          BX4    X0+X2       (X4) = 2/P,18/ADDR 
          LX2    X4,B6       SHIFT TO PROPER 20-BIT CHAIN PARCEL
          BX3    X2+X3       OR INTO PARCEL WORKING REGISTER
          R=     B6,B6-24B   DOWN SHIFT COUNT 
          GE     B6,B0,CGXRCH  IF MORE PARCEL SPACE EXISTS IN X3
          BX0    X1          SAVE NAME
          ADDWRD TSCR1,X3    ADD TO REF CHAIN 
          BX1    X0          RESTORE NAME 
          MX3    0           REINIT PARCEL WORKING REGISTER 
          R=     B6,50B      REINIT SHIFT COUNT 
          EQ     CGXRCH      RETURN 
  
 CGREL    SPACE  4,8
**        CGREL - CAPSULE/OVCAP RELOCATION TABLE PROCESSING.
* 
*              THIS ROUTINE IS CALLED FROM *CLCAP* (CAPSULE GENERATION) 
*         OR *CLOC* (OVCAP GENERATION) AND IT IS RESPONSIBLE
*         FOR TAKING THE CAPSULE RELOCATION TABLE (*TCPREL*), WHICH IS
*         COMPLETELY SET UP, AND MOVING IT TO THE END OF *TPGM*.  IT
*         ALSO PLUGS RELEVANT FIELDS INTO THE *6000* HEADER.
  
 CGREL    PS                 ENTRY/EXIT 
          SA1    TPGM        (X1) = FWA *TPGM*
          SA2    A1+B1       (X2) = *TPGM* LENGTH (PTER TO REL TABLE) 
          R=     A3,X1+2     THIRD WORD OF HEADER 
          BX6    X3+X2       OR IN POINTER TO RELOC TABLE 
          SA6    A3          REWRITE THIRD WORD OF HEADER 
          SA1    TCPREL+1    (X1) = *TCPREL* LENGTH 
          ALLOC  TPGM,X1     ALLOCATE *TPGM* SPACE FOR RELOC TABLE
          SA2    TCPREL      SOURCE ADDRESS 
          MOVE   X1,X2,X3    MOVE *TCPREL* TO END OF *TPGM* 
          SA1    TPGM        (X1) = FWA *TPGM*
          SA2    A1+B1       (X2) = *TPGM* LENGTH 
          SA3    X1          (X3) = FIRST WORD OF HEADER
          BX6    X3+X2       OR IN TOTAL LENGTH OF CAPSULE
          SX2    B1 
          SA1    OG 
          LX2    18 
          MI     X1,CGREL1   IF CAPSULE GENERATION
          BX6    X6+X2       SET OVCAP BIT (BIT 18) IN *6000* HEADER
 CGREL1   BSS    0
          SA6    A3          REWRITE FIRST WORD OF HEADER 
          EQ     CGREL       RETURN 
  
 CGWC     SPACE  4,8
**        CGWC - WRITE CAPSULE/OVCAP BINARY.
* 
*              THIS ROUTINE IS CALLED FROM *CLCAP* (CAPSULE GENERATION) 
*         OR *CLOC* (OVCAP GENERATION) AND IS RESPONSIBLE 
*         FOR WRITING THE CAPSULE BINARY TO THE SPECIFIED (OR 
*         DEFAULT) FILE.  (IF *FOL* GENERATION MODE THEN WE HAVE
*         ALREADY FORCED THE OVCAP TO BE WRITTEN TO THE SAME FILE 
*         AS THE (0,0) OVERLAY.)  IF OVCAP GENERATION THEN CALL 
*         ROUTINE *SOF* TO DETERMINE WHICH FILE TO WRITE TO AND 
*         WHETHER A SEQUENTIAL OR RANDOM WRITE SHOULD BE DONE.
*         ELSE CAPSULE GENERATION, SO THE FET IS INITIALIZED HERE.
*         THEN ROUTINE *WOV* IS CALLED TO WRITE THE *PREFIX* TABLE, 
*         THEN THE *6000* TABLE IS WRITTEN.  *TPGM* CONTAINS THE
*         ENTIRE CAPSULE/OVCAP BINARY, HEADER AND ALL, COMPLETELY 
*         SET UP.  IF *FOL* GENERATION (OVCAP MODE) THEN THE *TCII* 
*         TABLE ENTRY FOR THE OVCAP IS CREATED AND ADDED TO *TCII*. 
  
 CGWC     PS                 ENTRY/EXIT 
          SA1    FE          CHECK FATAL ERROR COUNTER
          NZ     X1,CGWC     IF FATAL ERROR (DON-T WRITE BINARY)
          SA1    CURCPNAM    CURRENT CAPSULE NAME 
          BX6    X1 
          SA6    ON          (NEEDED BY *WOV*)
          SA1    OG 
          MI     X1,CGWC1    IF CAPSULE (VS. OVCAP) GENERATION
          RJ     SOF         SET FILE (OVCAP MODE ONLY) 
          EQ     CGWC3
  
 CGWC1    SA1    OF 
          NZ     X1,CGWC2    IF LFN SPECIFIED ON *NOGO* CARD
          SA1    DFLTLFN     CAP GEN THEN LFN IN *DFLTLFN*
 CGWC2    SETFET L,A1,BINARY
 CGWC3    RJ     WOV         WRITE *PREFIX* TABLE 
          SA1    TPGM 
          SB6    X1          (B6) = FWA *TPGM*
          SA2    A1+B1
          SB7    X2          (B7) = LENGTH *TPGM* 
          WRITEW L,B6,B7     WRITE CM IMAGE (*6000* TABLE)
          WRITER L,RCL       FLUSH BUFFER 
          SA1    MAXOV
          ZR     X1,CGWC     IF NOT *FOL* GENERATION, THEN EXIT 
          SA1    CURCPNAM    (X1) = 42/OVCAP NAME,18/0
          ADDWRD TCII,X1     ADD OVCAP NAME ENTRY TO *TCII* 
          SA3    HHAPRU      PRU OF (0,0) 
          SA4    FOLCRI      PRU OF THIS OVCAP
          IX4    X4-X3       RELATIVE PRU NUMBER OF THIS OVCAP
          SA3    TPGM+1      (X3) = LENGTH *TPGM* = LENGTH OF OVCAP 
          LX4    18 
          BX1    X4+X3       (X1) = 12/0,30/REL PRU,18/LENGTH OF OVCAP
          ADDWRD A2,X1       ADD REL PRU AND LENGTH TO *TCII* 
          ADDWRD A2,X1-X1    ADD ZERO WORD TO *TCII*
          RJ     CFO         CHECK FOR *FOL* OVERFLOW 
          EQ     CGWC        EXIT 
  
 CAPREL   SPACE  4,8
**        CAPREL - CAPSULE RELOCATION TABLE PROCESSING. 
* 
*              THIS ROUTINE IS CALLED FROM *RCI* TO MAINTAIN THE
*         CAPSULE RELOCATION TABLE *TCPREL*.  PUTS THE RELOCATION 
*         INDICATORS OF THE CAPSULE BINARY BEING LOADED INTO THE
*         CAPSULE RELOCATION TABLE *TCPREL*.  THIS ALLOWS CAPSULES
*         AS INPUT DURING CAPSULE GENERATION.  THE ENTIRE CAPSULE 
*         BINARY TABLE HAS BEEN READ INTO *TPGM*. 
* 
*         ENTRY  (A0) = RELOCATION ADDRESS = CAPPA - 3. 
*                (X0) = ADDRESS OF CAPSULE IN *TPGM* (ABSOLUTE).
*                     = FWA *TPGM* + CAPPA - PO + BI. 
*                (B6) = WORD COUNT OF RELOCATION TABLE IN *TPGM*. 
*                (B7) = ADDR OF RELOC TABLE (REL TO CAPSULE IN *TPGM*)
*         EXIT   RELOCATION INDICATORS PUT INTO *TCPREL*. 
*         USES   ALL REGISTERS EXCEPT A0, X0, B6, B7, B1. 
*         CALLS  NONE.
  
 CAPREL   PS                 ENTRY/EXIT 
          SA1    TPGM        (X1) = FWA *TPGM*
          IX2    X0-X1       (X2) = ADDR OF CAPSULE RELATIVE TO *TPGM*
          R=     X2,X2-3     ACCOUNT FOR CAPSULE HEADER NOT LOADED
          BX7    X2 
          R=     X3,17B 
          IX6    X2/X3,B3    CALCULATE CORRESPONDING WORD IN *TCPREL* 
          SA1    TCPREL      (X1) = FWA *TCPREL*
          IX1    X1+X6
          SB3    X1          (B3) = ADDR OF WORD IN *TCPREL* (ABSOLUTE) 
          R=     X1,17B 
          IX1    X1*X6       CALCULATE REMAINDER OF ABOVE DIVIDE
          IX1    X7-X1       (X1) = REMAINDER 
          R=     X6,17B 
          IX6    X6-X1       15-R 
          LX6    2           4*(15-R) 
          SB2    X6          (B2) = SHIFT COUNT = 4*(15-R)
          BX6    X1          (X6) = REMAINDER 
          MX1    0
          ZR     X6,CAPREL0  IF R=0 
          MX1    1
          LX6    2           4*R
          SB4    X6 
          SB4    B4-B1
          AX1    B4          (X1) = CORRESPONDING MASK OF 4*R 
 CAPREL0  SB5    B6          (B5) = WORD COUNT OF RELOC TABLE IN *TPGM* 
          SB4    X0+B7       (B4) = ADDR OF RELOC TABLE IN *TPGM* (ABS) 
 CAPREL1  SA2    B4          GET RELOCATION INDICATORS FROM *TPGM*
          SA3    B3          GET RELOCATION WORD FROM *TCPREL*
          SA4    B3+B1       GET NEXT ONE ALSO
          LX2    B2          POSITION *TPGM* RELOC INDICATORS 
          BX6    -X1*X2      MASK FIRST PART
          BX7    X1*X2       MASK SECOND PART 
          BX6    X6+X3       OR FIRST PART INTO FIRST WORD
          BX7    X7+X4       OR SECOND PART INTO SECOND WORD
          SA6    A3          STORE FIRST WORD BACK INTO *TCPREL*
          SA7    A4          STORE SECOND WORD BACK INTO *TCPREL* 
          SB5    B5-B1       DECREMENT WORD COUNT OF REL TABLE IN *TPGM*
          SB4    B4+B1       INCREMENT ADDR OF REL TABLE IN *TPGM*
          SB3    B3+B1       INCREMENT ADDR OF NEXT *TCPREL* WORD 
          NZ     B5,CAPREL1  IF RELOC TABLE IN *TPGM* NOT EXHAUSTED 
          EQ     CAPREL      EXIT 
  
 OCRML    SPACE  4,8
**        OCRML - INITIALIZE TABLES FOR OVCAP GENERATION. 
* 
*              THIS ROUTINE IS CALLED FROM *INOC* AND IS USED IN
*         CONJUNCTION WITH *RML* TO REMOVE LINKAGES AND INITIALIZE
*         MANAGED TABLES FOR THE NEXT OVCAP GENERATION.  *RML* IS 
*         USED TO INITIALIZE TABLES *TBLK*, *TLNK*, AND *TUSEP*.
*         THIS ROUTINE CLEARS VARIOUS OTHER TABLES, *TPGM* IS 
*         CLEARED AND THE ABS BLOCK IS ALLOCATED. 
  
 OCRML    PS                 ENTRY/EXIT 
          SA2    TPGM 
          RJ     CTAB=       CLEAR *TPGM* 
          SA2    TEPT 
          RJ     CTAB=       CLEAR *TEPT* 
          SA2    TEPT1
          RJ     CTAB=       CLEAR *TEPT1*
          SA2    TLBC2
          RJ     CTAB=       CLEAR *TLBC2*
          SA2    TCPREL 
          RJ     CTAB=       CLEAR *TCPREL* 
          SA2    TBLK        (X2) = FWA *TBLK*
          SB2    B1+B1       (B2) = 2 
          MX6    1           PATTERN FOR BLOCK NOT REF
          SA3    OGBC        // ORIGIN
          BX6    X6+X3       CM // NOT REF, L=0, ADDR IF DEF IN (0,0) 
          SA6    X2+B1       SET CM // DEF WORD IN *TBLK* 
          MX6    1
          SA6    A6+B2       SET ECS // NOT REF, L=0=PA 
          SX2    B1+B2
          LX2    24 
          BX6    X6+X2
          SA6    A6+B2       SET ABS BLOCK NOT REF, LENGTH=3, ADDR=0
          SA1    TOMIT+1     PICK UP *TOMIT* LENGTH 
          ZR     X1,OCRML1   IF *TOMIT* EMPTY 
          BX2    X1          ELSE INITIALIZE *TLNK* WITH OMITS
          LX2    36 
          R=     X3,COMIT 
          LX3    48 
          BX1    X2+X3       *OMIT* HEADER AND LENGTH (INTERNAL FORM) 
          ADDWRD TREQ2,X1    ADD TO *TREQ2* 
          SA1    TOMIT+1     *TOMIT* LENGTH 
          ALLOC  TREQ2,X1    ALLOCATE SPACE IN *TREQ2*
          SA2    TOMIT       SOURCE ADDRESS 
          MOVE   X1,X2,X3    MOVE *TOMIT* TO *TREQ2*
          RJ     REQD        INIT *TLNK* WITH OMITS 
 OCRML1   MX6    0
          SA6    PO          PO=0 
          SA6    BI          BI=0 
          SA6    PA          PA=0 
          R=     X1,3        ALLOCATE ABS BLOCK (LENGTH=3, 6000 HEADER) 
          MX2    0           INDICATOR FOR CM SPACE 
          RJ     APS=        *APS=* BUMPS *PA* AND ALLOCATES *TCPREL* 
          EQ     OCRML       EXIT 
  
 CLOC     SPACE  4,8
**        CLOC - COMPLETE OVCAP.
* 
*              THIS ROUTINE IS CALLED FROM EITHER *POD*, *POCD*, OR 
*         *CPL*.  ITS FUNCTION IS TO COMPLETE THE OVCAP CURRENTLY 
*         BEING GENERATED.  THE PROCEDURE IS AS FOLLOWS --
*         1)  CALLS *CPR* TO COMPLETE THE READ, 
*         2)  CALLS *SAT* TO SATISFY EXTERNALS, 
*         3)  CALLS *USX* TO PROCESS UNSATISFIED EXTERNALS, 
*         4)  CLEARS THE *EDITLIB* INTERLOCK (SCOPE ONLY),
*         5)  PROCESSES BLANK COMMON, 
*         6)  CALLS *FBC* TO PROCESS FILL BYTE CHAINS,
*         7)  CALLS *LBC* TO PROCESS LINK BYTE CHAINS,
*         8)  CALLS *PBC* TO DIAGNOSE BLANK COMMON ERRORS,
*         9)  CALLS *CGEPL* TO SET UP THE ENTRY POINT LIST, 
*         10) CALLS *CGXRL* TO SETUP THE XREF LIST AND CHAINS,
*         11) CALLS *CGREL* TO SETUP THE RELOCATION TABLE,
*         12) CALLS *CGWC* TO WRITE THE BINARY AND MAINTAIN *TCII*, 
*         13) CALLS *P54* (IF NECESSARY) TO PLUG *HHA*, *LHHA*, AND 
*             THE *FOL* DIRECTORY INTO THE (0,0) OVERLAY. 
*         14) RETURNS.
  
 CLOC     PS                 ENTRY/EXIT 
          RJ     CPR         COMPLETE READ
          SB7    B0 
          RJ     SAT         SATISFY EXTERNALS
          RJ     USX         PROCESS UNSATISFIED (UNRESOLVED) EXTERNALS 
 S        IFSCOPE 
          R=     X7,2030B 
          SA7    T1 
          LDL    A7          CLEAR *EDITLIB* INTERLOCK
 S        ENDIF 
          SA1    TBLK 
          R=     A1,X1+3     (X1) = *TBLK* ECS // DEF WORD
          MI     X1,CLOC1    IF ECS // NOT REFERENCED 
          ERROR  503         ---- ECS TEXT DISALLOWED 
 CLOC1    SA1    TBLK 
          SA5    OGBC        (X5)=CM // ORIGIN IN (0,0) (NONE=0)
          MX2    -24
          SA1    X1+B1       (X1)=*TBLK* CM // DEF WORD, (A1)=ADDR
          BX1    X2*X1       (X1)=*TBLK* CM // DEF WORD (ORIGIN=0)
          BX6    X1+X5       MERGE REF BIT, LENGTH, ORIGIN (OR 0) 
          SA6    A1          WRITE BACK INTO *TBLK* 
          MI     X1,CLOC2    IF CM // NOT REFERENCED
          NZ     X5,CLOC2    IF CM // ORIGIN ALREADY SET (DEF IN (0,0)) 
          SA4    PA          USE *PA* AS CM // ORIGIN 
          BX6    X6+X4       MERGE REF, LENGTH, ORIGIN
          SA6    A1          WRITE CM // DEF WORD BACK INTO *TBLK*
          LX6    -24
          BX3    -X2*X6      (X3) = CM // LENGTH
          IX6    X3+X4       (X6) = *PA* + CM // LENGTH 
          SA6    A4          SET FINAL *PA* (TO INCLUDE CM // LENGTH) 
          ZR     X3,CLOC2    IF NO MORE *TPGM* SPACE NEEDED 
          ALLOC  TPGM,X3     DON-T USE APS=, *PA* ALREADY BUMPED AND
*                            *TCPREL* SPACE NOT NEEDED
 CLOC2    SA3    TEPT1       MOVE AND RELOCATE *TEPT1* TO *TEPT*
          SA2    A3+B1
          SB2    B0          (B2) = *TEPT1* FETCH POINTER 
          SB3    X2          (B2) = *TEPT1* LENGTH
          SB4    B1+B1       (B4) = 2 
          SB5    X3          (B5) = *TEPT1* FWA 
          SA1    TBLK        GET // ORIGIN FROM *TBLK*
          MX0    -24
          SA2    X1+B1
          BX0    -X0*X2      (X0) = // ORIGIN 
          ZR     B3,CLOC5    IF NO ENTRY POINTS IN // 
 CLOC3    SA1    B5+B2       FIRST WORD 
          SA5    A1+B1       SECOND WORD
          IX5    X0+X5       RELOCATE ENTRY POINT ADDR
          ADDWRD TEPT,X1     MOVE TO *TEPT* 
          ADDWRD A2,X5
          SB2    B2+B4       BUMP FETCH POINTER 
          GE     B2,B3,CLOC4  IF DONE RELOCATING AND MOVING TO *TEPT* 
          SA1    TEPT1       (X1) = *TEPT1* FWA (MAY CHANGE)
          SB5    X1          RESET (B5) = *TEPT1* FWA 
          EQ     CLOC3       CONTINUE 
  
 CLOC4    MX7    0
          SA7    TEPT1+1     CLEAR *TEPT1*
          RJ     CPR         COMPLETE READ
 CLOC5    RJ     FBC         PROCESS FILL BYTE CHAINS 
          RJ     LBC         PROCESS LINK BYTE CHAINS 
          SA1    OGBC 
          BX6    X1 
          SA6    OCOGBC      SET *OCOGBC* AS NEEDED FOR OVCAP MAP 
          RJ     PBC         PROCESS BLANK COMMON 
          SA1    OGLFN
          SA2    OGLST00
          BX5    X2-X1
          ZR     X5,CLOC5A   IF WRITING TO SAME FILE AS (0,0) 
          SA5    MAXOV
          ZR     X5,CLOC6    IF NO *FOL* DIRECTORY GENERATION 
          BX6    X2 
          SA6    A1          SET *OGLFN* TO *OGLST00* (FORCE SAME FILE) 
          ERROR  4210        ---- FORCING ALL BINARIES TO SAME FILE 
 CLOC5A   BSS    0
          SA2    OGSKIP 
          SX7    X2+B1       SAME FILE, BUMP SKIP COUNTER 
          SA7    A2 
 CLOC6    SA1    TPGM        PROCEED TO INITIALIZE *6000* HDR IN *TPGM* 
          MX6    2           SET *6000* HEADER INTO WORD 0 OF *TPGM*
          SA6    X1 
          SA1    CURGPNAM 
          SA2    CURCPNAM 
          BX6    X1 
          SA6    A6+B1       SET GROUP NAME INTO HEADER 
          BX6    X2 
          SA6    A6+B1       SET CAPSULE NAME INTO HEADER 
          SA1    PC          CHECK FOR EMPTY LOAD 
          NZ     X1,CLOC7    IF AT LEAST ONE PROGRAM LOADED 
          ERROR  101         ---- EMPTY LOAD
 CLOC7    RJ     CGEPL       PROCESS ENTRY POINT LIST 
          RJ     CGXRL       PROCESS XREF LIST AND CHAINS 
          RJ     CGREL       PROCESS RELOCATION TABLE 
          RJ     CGWC        WRITE BINARY 
          SA1    NEWL1
          NZ     X1,CLOC8    IF MORE HIGHER LEVEL OVL OR OVCAPS FOLLOW
          RJ     P54         PLUG 54-TABLE (OF (0,0) OVERLAY) 
 CLOC8    EQ     CLOC        RETURN 
  
 INOC     SPACE  4,8
**        INOC - INITIALIZE FOR NEW OVCAP.
* 
*              THIS ROUTINE IS CALLED TO INITIALIZE FOR THE NEXT
*         OVCAP GENERATION.  WE MUST HAVE PREVIOUSLY GENERATED SOME 
*         OVERLAYS.  THIS ROUTINE IS EITHER CALLED FROM *POCD* OR 
*         THRU *LMO*/*INO* IF A LOAD MAP WAS GENERATED. 
*         IT INITIALIZES VARIOUS FLAGS AND MANAGED TABLES, REMOVES
*         LINKAGES FOR THE UPCOMING OVCAP, SETS THE REQUIRED
*         PROGRAM ORIGIN AND PROGRAM ADDRESSES, ISSUES A DEBUGGING
*         MESSAGE IF APPROPRIATE, AND THEN JUMPS TO *LOAD7* TO
*         REENTER THE *LOAD* REQUEST PROCESSOR. 
  
 INOC     MOVE   9,NEWCARD,OGCARD 
          SX6    /TMGR/TOV   SET ADDRESS OF TABLE OVERFLOW ROUTINE
          SA6    TO 
          SA1    TERR+B1     INIT *TERR* SIZE TO AT LEAST 2 
          SX2    B1+B1
          IX1    X1-X2
          PL     X1,INOC1    IF AT LEAST 2 WORDS ALREADY AVAILABLE
          ADDWRD TERR,X1-X1 
          ADDWRD A2,X1
 INOC1    R=     X6,2 
          SA6    OG          SET *OG* TO INDICATE OVCAP GENERATION (=2) 
          MX6    0
          SA6    OCOGBC      CLEAR CM // FLAG 
          SA6    PC          ZERO PROGRAM COUNT 
          SA6    NE          ZERO ERROR COUNTS
          SA6    FE 
          SA1    NEWL1
          BX7    X1 
          SA6    A1          ZERO NEWL1 
          SA7    OGL1        SAVE PRIMARY LEVEL 
          SA6    OGL2        ZERO SECONDARY LEVEL 
          SA2    NEWLFN 
          BX7    X2 
          SA6    A2          ZERO NEWLFN
          SA7    OGLFN       SAVE LFN 
          RJ     RML         REMOVE LINKAGES (AS FOR PRIMARY OVERLAY) 
          SA1    TBLK+1 
          BX6    X1 
          SA6    OCBPI       SET BASE *PI* FOR OVCAP GEN
          RJ     OCRML       ADDITIONAL OVCAP LINKAGE REMOVAL 
          SETFET L,OGLDFIL,BINARY  RESTORE FILE NAME FOR *LOAD* 
          R=     X7,READ
          SA7    READFUNC    RESTORE READ FUNCTION CODE 
          SA7    L-1
          SA2    TLFN 
          RJ     CTAB=       CLEAR *TLFN* 
          SA1    OGLDFIL
          ADDWRD TLFN,X1     ENTER NAME OF LOAD FILE
          MX6    0
          SX7    B1 
          SA6    FI          RESET FILE INDEX 
          SA7    RECORDS     SET COUNT OF RECORDS READ
          SA7    REQTYPE     SET REQUEST ALLOW TYPE 
 DB       IFTEST NE,IP.LDBG,0 
          SX6    B0 
          SA6    MSGL1+3
          SMSG   (=C/ GENERATING OVCAP/)
 DB       ENDIF 
          EQ     LOAD7       CONTINUE *LOAD*
  
 COCD     SPACE  4,8
**        COCD - CRACK *OVCAP* DIRECTIVE. 
* 
*              THIS ROUTINE IS GIVEN CONTROL TO CRACK THE *OVCAP* 
*         DIRECTIVE.  AT THIS POINT WE KNOW AN OVCAP GENERATION IS
*         FORTHCOMING.  AS WE KNOW THAT THE OVCAP BINARY WILL BUILD 
*         ONTO THE PREVIOUS (0,0) OVERLAY, THIS ROUTINE BEHAVES 
*         MUCH LIKE */LOADG/COD* WHEN CRACKING AN *OVERLAY* DIRECTIVE 
*         FOR A PRIMARY (N,0) LEVEL OVERLAY.
* 
*         ENTRY  *OVCAP* DIRECTIVE IN *CDIMAGE*.
* 
*         EXIT   *NEWCARD* CONTAINS CARD IMAGE (TERMINATED BY 0000).
*                *NEWLFN* CONTAINS LFN FOR NEXT OVCAP.
*                *NEWL1* CONTAINS 100B. 
*                *NEWL2* CONTAINS 0.
*                *NEWORG* CONTAINS 0. 
*                *NEWERR* CONTAINS INTERNAL ERROR NUMBER OR 0.
*                    6  OVCAP DIRECTIVE NOT SEPARATE SECTION. 
*                    1  SYNTAX ERROR ON OVCAP CARD. 
  
 COCD     PS                 ENTRY/EXIT 
          R=     B7,-10 
 COCD1    SB7    B7+B1
          SA1    B7+/READ/CDIMAGE+9 
          BX6    X1 
          SA6    B7+NEWCARD+9  SAVE CARD IMAGE
          NZ     B7,COCD1 
          MX1    48 
          BX6    X1*X6       ENSURE TERMINATOR
          SA6    A6 
          MX6    0
          SA6    NEWLFN      INITIALIZE EXIT VARIABLES
          SA6    NEWL2
          SA6    NEWERR 
          SA6    NEWORG 
          R=     X6,100B
          SA6    NEWL1
          READO  L
          R=     X7,6 
          ZR     X1,COCD3    IF *OVCAP* CARD NOT SEPERATE SECTION 
          SX6    NEWCARD
          SA6    /LOADCC/CCWA  INITIALIZE FOR CARD SCANNING ROUTINE 
          SA6    A6+B1
          MX6    0
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
          RJ     /LOADCC/GNE  GET KEYWORD *OVCAP* 
          SB7    B7-B1
          EQ     B7,B1,COCD5  IF FOLLOWED BY TERMINATOR 
          SX6    X5 
          NZ     X6,COCD4    IF FOLLOWED BY SEPARATOR 
 COCD2    SX7    B1          SYNTAX ERROR ON *OVCAP* CARD 
 COCD3    SA7    NEWERR      SET ERROR INDICATOR (NEWERR) 
          EQ     COCD        EXIT 
  
 COCD4    RJ     /LOADCC/GNE GET NEXT ELEMENT (LFN) 
          SB7    B7-B1
          NE     B7,B1,COCD2 IF NOT FOLLOWED BY TERMINATOR
          BX1    X5 
          RJ     /MISC/LFNCK CHECK FOR LEGAL LFN
          MI     X6,COCD2    IF INVALID LFN 
          SA6    NEWLFN      SET LFN FROM DIRECTIVE INTO *NEWLFN* 
 COCD5    SA1    OF          SET UP LFN FOR WRITING MAP 
          ZR     X1,COCD5A   IF NO LFN FROM *NOGO* CARD 
          BX6    X1 
          SA6    NEWLFN      USE LFN FROM *NOGO* CARD AS *NEWLFN* 
          EQ     COCD        EXIT 
  
 COCD5A   SA1    NEWLFN 
          NZ     X1,COCD     IF LFN SPECIFIED ON DIRECTIVE
          SA2    OGLFN
          NZ     X2,COCD5B   IF LFN SPECIFIED LAST TIME 
          SA2    DFLTLFN     ELSE USE DEFAULT LFN 
 COCD5B   BX6    X2 
          SA6    A1          SET *NEWLFN* TO LAST ONE OR DEFAULT
          EQ     COCD        EXIT 
  
 POCD     SPACE  4,8
**        POCD - PROCESS *OVCAP* DIRECTIVE. 
* 
*              CONTROL TRANSFERS HERE ANY TIME AN *OVCAP* DIRECTIVE 
*         IS READ DURING THE LOADING PROCESS.  WE CRACK THE *OVCAP* 
*         DIRECTIVE, COMPLETE THE LAST OVERLAY OR OVCAP THAT
*         WAS CURRENTLY BEING GENERATED, AND THEN GO TO INITIALIZE
*         FOR THE UPCOMING OVCAP GENERATION.
  
 POCD     RJ     COCD        CRACK *OVCAP* DIRECTIVE
          SX7    B1 
          MX6    42 
          SA7    MM          FLAG *LOADC* AS NEEDED 
          SA2    L
          SA1    OG 
          BX6    X6*X2
          SA6    OGLDFIL     SAVE LOAD FILE NAME
          SX7    X7+B1
          SA7    OCOG        FLAG OVCAP GENERATION FORTHCOMING
          R=     X1,X1-1
          ZR     X1,POCD1    IF OVERLAY GENERATION (TO COMPLETE)
          RJ     CLOC        COMPLETE LAST OVCAP
          EQ     POCD2
  
 POCD1    RJ     CLO         COMPLETE LAST OVERLAY
 POCD2    SA1    FE 
          SA2    NE 
          SA3    MAPTYPE
          SA4    NEWERR 
          BX1    X1+X2
          BX3    X3+X4
          BX1    X1+X3
          NZ     X1,LMO      IF ERRORS OR IF MAP REQUESTED
          EQ     INOC        GO INITIALIZE FOR OVCAP GENERATION 
  
          SPACE  4
