*COMDECK BLOAD2 
          ORG    LOCL+1 
  
**        + + + + + + + + + + + + + + + + + 
*         + LOAD COMPLETION SUBROUTINES.  + 
*         + + + + + + + + + + + + + + + + + 
* 
* 
*              THIS IS THE START OF THE AREA CONTAINING THE CODE
*         NEEDED THROUGHOUT THE LOADING PROCESS UP UNTIL THE TIME THE 
*         MAP IS WRITTEN.  IF A MAP IS SELECTED, OR IF ANY ERRORS 
*         OCCUR, THE MAP ROUTINE (*LOADM* FOR CONTROL CARD LOADS, 
*         *LOADUM* FOR USER CALL LOADS) IS LOADED STARTING AT LOCATION
*         *LOCL*.  THIS AREA EXTENDS TO LOCATION *LOCC*.
* 
* 
*         WOV - WRITE OVERLAY.
* 
*              THIS ROUTINE PERFORMS THE ACTUAL WRITING OF AN OVERLAY 
*         TO A BINARY OUTPUT FILE.  THE OVERLAY CONSISTS OF A 
*         77 (PREFIX) TABLE FOLLOWED BY A 54 TABLE. 
* 
*              IF CAPSULE/OVCAP GENERATION THIS ROUTINE WRITES ONLY 
*         THE *PREFIX* TABLE AND THEN RETURNS.
* 
*         ENTRY  FET *L* SET UP AND READY FOR WRITING 
*                54-TABLE HEADER SET UP IN *TPGM* 
  
  
 IC       IFCARD
  
 WOV      EQ     *+400000B   ENTRY/EXIT 
          IFCARD 2
          SA1    SEGFLAG
          NZ     X1,WOV      IF SEGMENT LOAD - OVERLAYS ALREADY WRITTEN 
          SMSG   (=30H  WRITING BINARY              ) 
          SA1    CPYF 
          ZR     X1,WOV0     IF NOT SPOOLING
          WRITEW L,OGLFN,1   SPOOLING, WRITE LFN INSTEAD OF HEADER
          EQ     WOV0A
  
 WOV0     WRITEW L,IH,1      NOT SPOOLIN, WRITE *PREFIX* HEADER 
 WOV0A    WRITEW L,ON,1      WRITE OVERLAY NAME 
          DATE   T1          GET CURRENT DATE 
          CLOCK  T2          GET CURRENT TIME 
 WOV1A    SA1    B1          WAIT RA+1
          NZ     X1,WOV1A 
          SA3    X6          SHIFT TIME AND DATE LEFT ONE CHAR, 
          BX7    X3          SINCE THAT IS THE WAY COMPILERS AND
          LX7    6           ASSEMBLERS PUT IT OUT
          SA7    A3 
          SA4    A3-B1
          BX6    X4 
          LX6    6
          SA6    A4 
          WRITEW X2,A4,2     WRITE DATE AND TIME
          SA1    =1HA        ABSOLUTE CPU PROGRAM OR OVERLAY PATTERN
          SA4    OG 
          SB2    X4 
          SB3    B2-B1
          ZR     B2,WOV1A1   IF ABSOLUTE PROGRAM
          ZR     B3,WOV1A1   IF OVERLAY 
          SA1    =1H         RELOCATABLE CPU PROGRAM PATTERN
 WOV1A1   BX7    X1 
          SA7    PFXW+3      INITIALIZE HARDWARE DEPENDENCY WORD
          SA4    HDEP        HARDWARE DEPENDENCY BITS 
          SA1    PFXW+3      WORD 7 FOR *PRFX* TABLE
          LX4    -1          BIT 1 CORRESPONDS TO *A* 
          R=     B2,1RA-1    INITIALIZE CHAR
          R=     B3,6*8      SHIFT COUNT
          MX7    -6 
 WOV1B    LX4    -1          NEXT BIT 
          SB2    B2+B1       NEXT CHAR VALUE
          R=     X6,B2-1R0
          ZR     X6,WOV1C    IF A-Z CHECKED 
          PL     X4,WOV1B    IF THIS CHAR NOT REPRESENTED 
          SX3    B2          REMOVE BLANK AND INSERT CHAR 
          LX6    X7,B3
          BX1    X6*X1
          LX3    X3,B3
          BX1    X1+X3
          R=     B3,B3-6
          PL     B3,WOV1B    IF ROOM FOR MORE CHARS 
 WOV1C    BX6    X1          STORE WORD 7 
          SA6    A1 
          WRITEW X2,PFXW,LTH77-3  WRITE REMAINDER OF *PRFX* TABLE 
          SB7    LTH77-7-1   CLEAR COMMENT AREA IN CASE NEXT
          MX7    0            OVERLAY HAS NO COMMENTS 
          SA7    PFXCOM 
 WOV2     SA7    A7+B1
          SB7    B7-B1
          NZ     B7,WOV2
          R=     B7,10B      (B7) = LENGTH OF 54-HEADER 
          SA3    EPTC        (X3) = ENTRY POINT COUNT 
          R=     X7,100B     (X7) = OFFSET INTO *TPGM* TO 54-HEADER 
          SA1    OG 
          ZR     X1,WOV3
          MI     X1,WOV      IF CAPSULE GEN, WRITE ONLY *PREFIX*
          R=     X1,X1-2
          ZR     X1,WOV      IF OVCAP GEN, WRITE ONLY *PREFIX*
          SX7    B0 
          SA1    OGL1 
          NZ     X1,WOV2A    IF NOT MAIN OVERLAY
          SA1    MAXOV       (X1) = *FOL* DIRECTORY LENGTH (NONE=0) 
          IX3    X3+X1       (X3) = EPT COUNT + *FOL* DIRECTORY LENGTH
          EQ     WOV3 
  
 WOV2A    BSS    0
          R=     B7,4        4-WORD HEADER
 WOV3     SA1    TPGM 
          IX6    X1+X7       (X6) = FWA OF OVERLAY IMAGE
          R=     A5,X6+2     FWAL, WCL
          WRITEW L,X6,B7+X3  WRITE HEADER, EPTS, *FOL* DIRECTORY
 IE       IFTEST NE,IP.MECS,0 
          MX0    -24
          BX0    -X0*X5      (X0) = WCL 
          AX5    24          (X5) = FWAL
 WOV4     ZR     X0,WOV5     IF NO MORE ECS 
          BX2    X5          CURRENT ECS ADDRESS FOR FETCH
          SX7    B1 
          IX0    X0-X7       DOWN WORD COUNT
          IX5    X5+X7       ADVANCE FETCH ADDRESS
          RJ     RE=         READ NEXT ECS WORD TO X1 
          WRITEW L,A1,1      WRITE WORD TO OVERLAY
          EQ     WOV4 
 IE       ENDIF 
 WOV5     R=     B7,10B      (B7) = LENGTH OF 54-HEADER 
          SA3    EPTC        (X3) = ENTRY POINT COUNT 
          R=     X7,100B     (X7) = OFFSET INTO *TPGM* TO 54-HEADER 
          SA1    OG 
          ZR     X1,WOV6
          SX7    B0 
          SA1    OGL1 
          NZ     X1,WOV5A    IF NOT MAIN OVERLAY
          SA1    MAXOV       (X1) = *FOL* DIRECTORY LENGTH (NONE=0) 
          IX3    X3+X1       (X3) = EPT COUNT + *FOL* DIRECTORY LENGTH
          EQ     WOV6 
  
 WOV5A    BSS    0
          R=     B7,4 
 WOV6     SA1    TPGM 
          IX6    X1+X7       (X6) = FWA OF HEADER 
          SA1    X6+B1
          AX1    42          POSITION WCS 
          SB6    B7+X3
          WRITEW L,X6+B6,X1  WRITE CM IMAGE 
          WRITER L,RCL       FLUSH BUFFER 
          EQ     WOV         EXIT 
  
 IC       ENDIF 
  
          RELOC  OFF
 LTH77    EQU    16B         LENGTH OF PREFIX TABLE 
  
 IC       IFCARD
  
*         THE FOLLOWING GOES IN WORDS 4-16B OF THE *PRFX* TABLE.
  
 PFXW     DATA   10H"OS.ID" 
          DATA   10HLOADER "VER"
          DATA   10H"LEVEL" 
          CON    0
 PFXCOM   BSSZ   LTH77-7     COMMENTS FIELD 
  
 IC       ENDIF 
  
 HDEP     CON    0           WORD FOR HOLDING ALL HARDWARE DEP. 
          RELOC  ON 
 SAT      TITLE  LOAD COMPLETION SUBROUTINE - SATISFY EXTERNALS.
**        SAT - SATISFY EXTERNALS.
* 
*              THIS ROUTINE IS CALLED EITHER DURING THE PROCESSING OF 
*         A *SATISFY* REQUEST OR AT LOAD COMPLETION TO SATISFY EXTERNALS
*         FROM LIBRARIES.  IT IS CONCERNED ONLY WITH DETERMINING
*         WHETHER ANYTHING ELSE NEEDS TO BE LOADED AND IF SO, THE ORDER 
*         IN WHICH VARIOUS LIBRARIES ARE TO BE SEARCHED.  THE ACTUAL
*         SEARCHING OF LIBRARY DIRECTORIES IS DONE BY *SLD*,
*         AND THE ACTUAL LOADING OF LIBRARY PROGRAMS IS DONE BY THE 
*         ROUTINE *LLP*.
* 
*              EITHER THE PRESENCE OF ONE OR MORE UNSATISFIED EXTERNALS 
*         IN TABLE *TLNK* OR THE PRESENCE OF ONE OR MORE NAMES IN TABLE 
*         *TUSEP* INDICATE THAT MORE LIBRARY LOADING IS NECESSARY.
* 
*              THE SELECTION OF LIBRARIES IS PERFORMED IN ONE OF TWO
*         METHODS - 
* 
*         1) IF *SAT* WAS CALLED AS A RESULT OF A *SATISFY* REQUEST 
*         ON WHICH ONE OR MORE LIBRARIES WERE SPECIFIED, THOSE LIBRARIES
*         ARE SEARCHED IN THE ORDER SPECIFIED, AND THE SEARCH TERMINATES
*         WITH EITHER NOTHING NECESSARY TO LOAD OR THE END OF THE 
*         LIBRARIES.
* 
*         2) IF *SAT* WAS CALLED AT LOAD COMPLETION TIME (OR DUE TO A 
*         *SATISFY* REQUEST WITH NO LIBRARIES SPECIFIED), THEN THE
*         LIBRARIES TO BE SEARCHED CONSIST OF THE CURRENTLY-DEFINED 
*         LIBRARY SET (GLOBAL FOLLOWED BY LOCAL), FOLLOWED BY THE 
*         DEFAULT LIBRARY *SYSLIB*.  (*SYSLIB* IS NOT USED BY DEFAULT 
*         IF IN CAPSULE/OVCAP GENERATION.)  THIS SET IS SEARCHED IN AN
*         END-AROUND FASHION UNTIL EITHER NO MORE LIBRARY ROUTINES ARE
*         NEEDED OR UNTIL ALL LIBRARIES IN THE SET HAVE BEEN SEARCHED 
*         WITHOUT FINDING ANY PROGRAMS. 
* 
*         ENTRY  (B7) = 0 IF LIBRARY SET METHOD IS TO BE USED.
*                     > 0 IF LIBRARY NAMES SPECIFIED IN A *SATISFY* 
*                         REQUEST ARE TO BE USED.  IN THIS CASE, THE
*                         *SATISFY* REQUEST APPEARS AT THE BEGINNING
*                         OF THE TABLE *TREQ*.
*         EXIT   EITHER THERE ARE NO UNSATISFIED EXTERNALS REMAINING
*                OR ALL SPECIFIED LIBRARIES HAVE BEEN SEARCHED. 
*         USES   ALL REGISTERS EXCEPT B1. 
*         CALLS  ATS=, MVE=, UXCK, SLD=, LLP. 
*         USES   ALL EXCEPT B1. 
  
 SATX     BSS    0           EXIT (RESTORE *CURREQBP* IF NECESSARY) 
 IC       IFCARD
          SA1    CGREQSV
          BX6    X1 
          SA6    CURREQBP    RESTORE CURRENT REQUEST NUMBER 
  
 IC       ENDIF 
  
 SAT      PS                 ENTRY/EXIT 
 IC       IFCARD
          SA1    ABS
          NZ     X1,SAT      EXIT IF ABSOLUTE LOAD
          SA1    CURREQBP 
          BX6    X1 
          SA6    CGREQSV     SAVE CURRENT REQUEST NUMBER
          R=     X6,CSATISFY  SETUP (CURREQBP) TO INDICATE *SATISFY*
          SA6    CURREQBP 
 IC       ENDIF 
          MX6    0
          SX7    B1 
          SA6    SATP1       CLEAR LIST POINTER 
          SA7    SATCHG      FORCE NEW LIB SET DEFINITION 
          SA7    SATCHG1     FORCE START AT BEGINNING OF SET
          SA6    CFWTS       CLEAR WEAK-TO-STRONG FLAG
          SA6    SATYP
          ZR     B7,SAT1     IF SATISFYING FROM LIB SET 
          SA7    A6          SET TYPE FLAG ACCORDINGLY
          SX6    B7          SET LIST LENGTH = REQUEST LENGTH 
          SA6    SATP2
 SAT1     SA1    SATCHG 
          ZR     X1,SAT2     IF NOT NEW LIB SET DEFINITION
          MX6    0           CLEAR NEW DEFINITION FLAG
          SA2    SATYP
          SA6    A1 
          NZ     X2,SAT2     IF NOT SATISFYING FROM LIB SET 
          SA4    SATCHG1     START SEARCH AT BEGINNING FLAG 
          ZR     X4,SAT1A    IF NOT TO START SEARCH OVER
          SA6    A4          RESET FLAG 
          SA6    SATP1
          MX7    1           FLAG 1ST TIME THRU LIB SET 
          SA7    SATHIT 
 SAT1A    BSS    0
          SA4    TLIB+1      (SATP2) = (LENGTH OF LIB SET) + 1
          SA6    TLIB2+1     CLEAR *TLIB2*
          SX7    X4+B1
          SA7    SATP2
          ALLOC  A6-B1,X7    ALLOCATE *TLIB2* 
          SX0    B1 
          SA5    =0LSYSLIB   SET DEFAULT *SYSLIB* AS LAST LIB IN SET     CP146A 
          IX1    X1-X0
          BX7    X5 
          IX4    X2+X1
          SA7    X4 
          BX3    X2          MOVE (*TLIB*) TO (*TLIB2*) 
          SA2    TLIB 
          MOVE   X1,X2,X3 
 IC       IFCARD
          SA1    OG 
          ZR     X1,SAT2     IF BASIC/SEGMENT LOAD
          IX1    X1-X0
          ZR     X1,SAT2     IF OVERLAY GENERATION LOAD 
          SA1    TLIB2+1     CAPSULE/OVCAP GEN, REMOVE DEFAULT *SYSLIB* 
          IX6    X1-X0
          SA6    A1          DECREMENT LENGTH OF *TLIB2*
          SA6    SATP2       DECREMENT LENGTH OF LIB SET TO SEARCH
          ZR     X6,SATX     IF NO LIBRARIES TO SEARCH, THEN EXIT 
 IC       ENDIF 
 SAT2     SA1    SATYP
          SA2    SATP1       CHECK IF CURRENT LIBRARY IS THE LAST 
          SA3    SATHIT      ON WHICH SOMETHING WAS FOUND 
          SB7    X2          SAVE POINTER 
          IX4    X2-X3
          NZ     X1,SAT3     IF NOT SATISFYING FROM LIB SET 
          ZR     X4,SATX     EXIT IF LIBRARIES SEARCHED AROUND
 SAT3     SA5    TUSEP
          RJ     UXCK        SET (X6) = 1 IF ANY UNSAT. EXTERNALS 
          SA1    A5+B1       CHECK IF ANY NAMES ARE IN *TUSEP*
          IFNOS  2
          BX7    X1          SET CURRENT *USEP* FLAG
          SA7    KSATUSEP 
          IX1    X1+X5
          SB2    X5 
          SB3    X1 
 SAT4     SA2    B2          NEXT POSSIBLE NAME 
          EQ     B2,B3,SAT5  IF END OF *TUSEP*
          BX6    X6+X2       ACCUMULATE BITS FROM NAMES 
          SB2    B2+B1
          EQ     SAT4        LOOP 
  
 SAT5     SA1    TLIB2
          ZR     X6,SATX     EXIT IF NOTHING TO SEARCH FOR
          SA2    SATYP
          ZR     X2,SAT6     IF SATISFYING FROM *TLIB*
          SA1    TREQ 
 SAT6     SB2    X2+B7       (X1) = LIBRARY NAME
          MX3    0           INDICATE SATISFYING EXTERNALS
          SA1    X1+B2
          IFNOS  1
 SAT6.1   BSS    0
          SX2    TLNK 
          RJ     SLD=        SEARCH LIBRARY DIRECTORY 
          SA1    TPADR       CHECK IF ANY PROGRAMS FOUND
          SA4    A1+B1
          ZR     X4,SAT7     IF NO NEW LIBRARY PROGRAMS FOUND 
 IC       IFCARD                                                         LDR0186
          SA1    SEGFLAG                                                 LDR0186
          SA2    TSEG+1                                                  LDR0186
          AX1    59                                                      LDR0186
          BX1    X1*X2       COUNT *TSEG* ENTRIES IF SEGMENT LOAD        LDR0186
 IC       ELSE                                                           LDR0186
          SX1    B0                                                      LDR0186
 IC       ENDIF                                                          LDR0186
          SA2    TBLK+1                                                  LDR0186
          IX6    X1+X2                                                   LDR0186
          SA6    SATBLK                                                  LDR0186
          SA1    /SLD/LIBNAME      (X1) = LIBRARY NAME
          IFNOS 
          SA2    TLNK+1      SAVE SIZE OF *TLNK*
          BX7    X2 
          SA7    KSATSV      SAVE *TLNK* LENGTH 
          ENDIF 
          RJ     LLP         GO LOAD LIBRARY PROGRAMS 
 IC       IFCARD                                                         LDR0186
          SA1    SEGFLAG                                                 LDR0186
          SA2    TSEG+1                                                  LDR0186
          AX1    59                                                      LDR0186
          BX2    X1*X2       COUNT *TSEG* ENTRIES IF SEGMENT LOAD        LDR0186
 IC       ELSE                                                           LDR0186
          SX2    B0                                                      LDR0186
 IC       ENDIF                                                          LDR0186
          SA1    TBLK+1                                                  LDR0186
          IX1    X1+X2                                                   LDR0186
          SA2    SATBLK                                                  LDR0186
          IX1    X1-X2                                                   LDR0186
          SA2    SATP1                                                   LDR0186
          BX6    X2                                                      LDR0186
          ZR     X1,SAT7     IF NO PROGRAMS LOADED                       LDR0186
          SA6    SATHIT      INDICATE SOMETHING LOADED FROM THIS LIBRARY LDR0186
          IFNOS 
          SA2    KSATSV      RELOAD *TLNK* PREVIOUS LENGTH
          SA1    TLNK+1 
          IX1    X1-X2
          SA3    CFWTS       WEAK-TO-STRONG FLAG
          BX1    X3+X1       INSURE LENGTH CHANGE IF FLAG IS SET
          MX7    0
          SA7    A3          CLEAR WEAK-TO-STRONG FLAG
          ZR     X1,SAT7     IF NO NEW EXTERNALS
          SA1    /SLD/NOSXREF  CHECK IF LIB HAS XREFS 
          NZ     X1,SAT6.2   IF LIB DOES NOT HAVE XREFS, SEARCH AGAIN 
          SA4    KSATUSEP 
          MX6    0           RESET *USEP* FLAG
          SA6    A4 
          ZR     X4,SAT7     IF NOTHING LOADED FROM *USEP* REQUESTS 
 SAT6.2   SA1    /SLD/LIBNAME  SEARCH SAME LIBRARY AGAIN
          MX3    0           INDICATE SATISFYING EXTERNALS
          EQ     SAT6.1      LOOP THRU LIBRARY
  
          ENDIF 
 SAT7     SA1    SATP1       ADVANCE LIBRARY LIST POINTER 
          SA2    SATP2
          SX6    X1+B1
          MX7    0
          SA6    A1 
          IX3    X6-X2
          NZ     X3,SAT1     IF NOT AT END OF LIST
          SA7    A1          RESET LIST POINTER 
          SA4    SATYP
          SA5    SATCHG 
          NZ     X4,SATX     EXIT IF NOT SEARCHING LIB SET
          SA3    SATHIT 
          ZR     X5,SAT7A    IF LIB SET NOT JUST REDEFINED
          MX6    1
          SA6    A3          PRETEND FIRST TIME THRU LIB SET
          EQ     SAT1 
 SAT7A    BSS    0
          NG     X3,SATX     EXIT IF NOTHING FOUND ON FIRST PASS
          EQ     SAT2        CONTINUE SEARCH
  
 SATYP    CON    0           0 - LIB SET, 1 - NAMES IN *TREQ* 
 SATCHG   CON    0           SET NZ WHEN *LIB* REQUEST PROCESSED
 SATCHG1  CON    0           SET NZ IF TO RESTART SEARCH FROM FRONT 
 SATHIT   CON    0           LAST LIB ON WHICH SOMETHING WAS FOUND
 SATP1    CON    0           POINTER TO CURRENT LIB LIST ENTRY
 SATP2    CON    0           LENGTH OF LIB LIST 
 SATBLK   CON    0           LENGTH OF *TBLK* BEFORE CALL TO *LLP*       LDR0186
          IFNOS  2
 KSATSV   CON    0           SAVE CELL NEEDED FOR KRONOS/NOS
 KSATUSEP CON    0           SET NZ IF LAST LIB SEARCH HAD *USEP* PROGS 
          QUAL   SLD
          SPACE  4
 IN       IFNOS 
 ALF      TITLE  LOAD COMPLETION SUBROUTINE - ACCESS LIBRARY FILE.
**        ALF - ACCESS LIBRARY FILE.
* 
*              THIS ROUTINE ASSIGNS A LIBRARY FILE TO THE CONTROL 
*         POINT AND CHECKS ITS FORMAT.  IF APPROPRIATE, ONE OF THE
*         FOLLOWING ERROR MESSAGES WILL APPEAR:                                .
*                4273  NONEXISTENT LIBRARY
*                4275  ILL-FORMATTED LIBRARY
* 
*              IF LOADING AN EXECUTE-ONLY FILE, THEN LOADING FROM 
*         USER LIBRARIES IS SUPPRESSED.  THIS ROUTINE ENSURES IN
*         THIS CASE THAT ALL LIBRARIES ARE SYSTEM ORIGIN.  NO ERROR 
*         IS DIAGNOSED, AS THE LOAD MAP IS SUPPRESSED ALSO. 
* 
*         ENTRY  /SLD/LIBNAME = LIBRARY NAME
*         EXIT   B2=0 IFF NO ERRORS 
  
  
 ALF      PS     0           ENTRY/EXIT 
          RECALL L
          SETFET L,LIBNAME,BINARY 
          SA2    L+1         SET RANDOM BIT 
          SX4    B1 
          LX4    47 
          BX6    X4+X2
          SA6    A2 
          SA1    LIBNAME
          SA2    CURLIB 
          BX7    X1-X2
          MX6    42 
          BX7    X6*X7
          ZR     X7,ALF6     IF SAME LIBRARY AS LAST TIME, DO NOT 
                              REPEAT ASSIGN AND OTHER SETUP 
          BX6    X1          UPDATE CURRENT LIBRARY NAME
          SA6    A2 
          ASSIGN L,LIBRARY   REQUEST LIBRARY FILE 
          SA2    L           CHECK STATUS 
          SX2    X2 
          AX2    10 
          R=     X6,X2-9
          ZR     X6,ALF1     IF FILE WAS LOCAL
          R=     X0,7        SET FILE RETURN
          R=     X6,X2-1
          ZR     X6,ALF5     IF FILE NOT FOUND
          SA2    L           FILE NAME
          MX7    42 
          BX7    X7*X2       42/0LNAME,18/0 
          SA7    /SLD/FILRTN SET FILE NAME INTO FILE RETURN WORD
 ALF1     SA2    L+7         CHECK PROCEDURE BIT
          MI     X2,ALF4     IF PROCEDURE FILE FOUND
  
 IC       IFCARD
          SA2    XEQOF
          NZ     X6,ALF1.4   IF SYSTEM FILE 
          MX7    -1          SET FOR NO *SDM=* PROCESSING 
          SA7    SDMFLAG
          ZR     X2,ALF1.4   IF NOT EXECUTE ONLY FILE 
          SA2    TLFN        (X2) = FWA OF FILE TABLE 
          SA1    A2+B1       (X1) = LENGTH OF TABLE 
          IX1    X1+X2       (X1) = LWA+1 OF TABLE
          MX0    42 
          SB2    X1 
          R=     A2,X2-1
          SA1    LIBNAME     LIBRARY NAME 
 ALF1.2   SA2    A2+B1       GET NEXT ENTRY FROM *TLFN* 
          SX4    A2-B2
          PL     X4,ALF1.3   IF END OF TABLE
          BX4    X0*X2       EXTRACT FILE NAME
          BX6    X4-X1       COMPARE NAMES
          NZ     X6,ALF1.2   IF NAMES DO NOT MATCH
          R=     X6,X2-2
          ZR     X6,ALF1.4   IF SYSTEM LIBRARY, INDICATE USER LIBRARY 
 ALF1.3   SB2    B1          INDICATE ERRORS
          EQ     ALF         RETURN 
 ALF1.4   BSS    0
 IC       ENDIF 
  
          SB3    X6          (B3) = SYSTEM VS LOCAL LIBRARY FLAG
          REWIND  L          DO A REWIND THE FIRST TIME 
          SA3    L+7         SAVE ADDRESS BIAS FROM FET 
          BX7    X3           FOR SUBSEQUENT ACCESSES OF THIS LIB 
          SA7    CURINFO
          SX4    B1 
          ZR     B3,ALF1.1   IF LOCAL USER LIBRARY
          SX4    B1+B1
 ALF1.1   MX0    42          PLACE FLAG FOR USER OR SYSTEM LIBRARY
          SA2    LIBNAME
          BX6    X0*X2
          IX6    X6+X4
          SA6    A2 
          SA6    CURLIB      ADD FLAG SO *LIBNAME* CAN BE 
                              UPDATED AT *ALF6* 
 ALF1.5   RECALL L           WAIT NOT BUSY
          READ   L           BEGIN READ 
          READO  L
          NZ     X1,ALF4     IF EOR 
  
*         CHECK FILE FORMAT.
  
          SX7    X6 
          LX6    18 
          R=     X1,X6-770000B
          NZ     X1,ALF3     IF NO PREFIX TABLE 
          LX6    6
          SX0    X6+B1
 ALF2     READO  L           READ OUT TABLE 
          R=     X0,X0-1
          NZ     X0,ALF2     IF NOT END OF TABLE
          SX7    X6 
          LX6    18 
 ALF3     LX6    -6          CHECK FOR *ULIB* TABLE 
          MX1    -12
          BX6    -X1*X6 
          R=     X6,X6-7600B
          R=     B2,B0+ 
          MX1    -1 
          BX7    -X1*X7 
          SA7    NOSXREF
          ZR     X6,ALF      RETURN IF LIBRARY FORMAT 
 ALF4     SA2    /SLD/LIBNAME 
          MX7    42 
          BX7    X7*X2
          ERROR  4275,X7     ---- ILL-FORMATTED LIBRARY 
          SB2    B1 
          EQ     ALF         RETURN 
  
 ALF5     SA2    /SLD/LIBNAME 
          MX7    42 
          BX7    X7*X2
          ERROR  4273,X7     ---- NONEXISTENT LIBRARY 
          SB2    B1 
          EQ     ALF         RETURN 
  
 ALF6     BSS    0
          BX6    X2          UPDATE *LIBNAME* TO INCLUDE
          SA6    LIBNAME      SYSTEM/USER FLAG
          SA1    CURINFO     RESET RANDOM ADDRESS OF *ULIB* DIRECTORY 
          SX6    B1 
          IX6    X1+X6
          SA6    L+6
          BX7    X1 
          SA7    A6+B1       RESTORE ADDRESS BIAS 
          EQ     ALF1.5      GO PERFORM STARTING READ 
  
 CURLIB   CON    0           NAME OF MOST-RECENT LIBRARY
 CURINFO  CON    0           SAVE AREA FOR CURRENT LIBRARY ADDRESS BIAS 
 SPT      TITLE  LOAD COMPLETION SUBROUTINE - SEARCH PROGRAM NAME TABLE.
**        SPT - SEARCH PROGRAM NAME TABLE.
*         THIS ROUTINE IS ENTERED FROM *SLD* IF AND ONLY IF WE ARE
*         TO PROCESS A *USEP* REQUEST FOR THE CURRENT LIBRARY BEING 
*         SEARCHED.  THE LIBRARY"S *OPLD* RECORD IS TO BE SEARCHED
*         FOR NECESSARY PROGRAM NAMES.  IF THE CURRENT LIBRARY IS 
*         A LOCAL USER LIBRARY THEN WE SKIP TO EOF, BACKSPACE TWO 
*         RECORDS, THEN READ SEQUENTIALLY UNTIL THE *OPLD* RECORD 
*         HAS BEEN READ IN.  IF THE CURRENT LIBRARY IS A SYSTEM 
*         LIBRARY, THEN THE *ULIB* RECORD IS READ AND THE LAST DECK 
*         ADDRESS (NOT EXTERNAL ADDRESS) IN THE RECORD IS FOUND AND 
*         THEN USING THIS ADDRESS WE READ SEQUENTIALLY UNTIL THE
*         *OPLD* RECORD HAS BEEN READ IN. 
*         THE ROUTINE THEN READS EACH ENTRY IN THE OPL DIRECTORY OF 
*         THE CURRENT LIBRARY FILE AND SEARCHES THE TABLE *TUSEP* 
*         FOR A CORRESPONDING PROGRAM NAME.  IF A MATCH IS FOUND, THE 
*         CORRESPONDING RANDOM ADDRESS IS ENTERED IN *TOUT* FOR LATER 
*         PROCESSING BY *LLP*.
* 
*         ENTRY - FET -L- POINTS TO BEGINNING OF ULIB DIRECTORY.
*               - PROGRAM LIBRARY ADDRESSES (IF FOUND IN CURRENT
*                 LIBRARY). 
* 
*         EXIT  - ALL ENTRIES IN DIRECTORY PROCESSED. 
* 
*         CALLS  ATS, RDW, STE. 
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 5, 6, 7. 
  
  
 SPT      PS     0           ENTRY/EXIT 
          RECALL L
          SA1    /SLD/LIBNAME      GET USER/SYSTEM LIB FLAG 
          R=     X1,X1-1
          ZR     X1,SPTU     IF USER LIBRARY
 SPTS     BSS    0           SYSTEM LIB, READ *ULIB* RECORD 
          SA1    L+7         RESET RANDOM ADDRESS OF *ULIB* DIRECTORY 
          SX6    B1 
          IX6    X1+X6
          SA6    A1-B1       I.E., SET FET+6 = ADDR BIAS + 1
          SX6    B0 
          SA6    SPTRA       INITIALIZE ADDRESS SAVE FIELD
 SPTS1    SA1    L+1         INDICATE EMPTY BUFFER
          SX6    X1 
          SA6    A1+B1       SET IN=FIRST 
          SA6    A6+B1       SET OUT=FIRST
          READ   L,R
          SA4    L
          LX4    59-5 
          MI     X4,SPTILL   IF EOF/EOI THEN ILL-FORMATTED LIBRARY
          SA4    A4+B1       FIND LAST DECK ADDRESS IN THE BUFFER 
          SB2    X4          B2=FIRST 
          SA4    A4+B1
          SB3    X4          B3=IN
 SPTS2    SB3    B3-B1       SEARCH BACKWARDS THRU BUFFER 
          LT     B3,B2,SPTS4  IF BUFFER EXHAUSTED 
          SA4    B3 
          PL     X4,SPTS2    IN CASE BUFFER ENDS WITH ENTRY NAMES 
 SPTS3    SB3    B3-B1
          LT     B3,B2,SPTS4  IF BUFFER EXHAUSTED 
          SA4    B3 
          MI     X4,SPTS3    SKIP ALL ADDRESSES UNTIL ENTRY NAME
          SA4    B3+B1       GET LAST DECK ADDRESS IN THE BUFFER
          BX6    X4 
          SA6    SPTRA       SAVE THE LAST DECK ADDRESS FOUND SO FAR
 SPTS4    SA4    L
          LX4    59-4 
          PL     X4,SPTS1    IF NOT *EOR* THEN KEEP LOOKING 
          SA4    SPTRA       GET LAST DECK ADDRESS
          ZR     X4,SPTILL   IF NEVER FOUND THEN ILL-FORMATTED LIBRARY
          SA2    L+7         X2 = RANDOM ADDRESS BIAS 
          IX6    X4+X2       BIAS + ADDR
          SA6    A2-B1       SET RANDOM ADDRESS 
          EQ     SPT2        GO SEARCH FOR *OPLD* 
 SPTU     BSS    0           USER LIB, SKIP TO EOF, SKIP BACK 2 RECORDS 
          SKIPF  L,1,17B,R
          SKIPB  L,2,0,R
 SPT1     RECALL L
          SA5    L+6         GET CURRENT RANDOM ADDRESS 
          BX6    X5 
          AX6    30 
          SA6    A5          SET RANDOM ADDRESS 
 SPT2     SA6    SPTRA       SAVE RANDOM ADDRESS
          SA1    L+1         INDICATE EMPTY BUFFER
          SX6    X1 
          SA6    A1+B1       SET IN=FIRST 
          SA6    A6+B1       SET OUT=FIRST
          READSKP L,R 
          READW  L,T1,1 
          MI     X1,SPTILL   IF *EOF* THEN ILL-FORMATTED LIBRARY
          NZ     X1,SPT1     IF *EOR* THEN KEEP LOOKING 
          SA1    T1 
          LX1    18 
          MX3    -6 
          R=     X2,X1-770000B
          NZ     X2,SPT1     IF NO *PREFIX* TABLE THEN KEEP LOOKING 
          LX1    6
          BX0    -X3*X1      (X0) = LENGTH OF PREFIX TABLE
          ZR     X0,SPT4A    IF ZERO LENGTH *PREFIX* TABLE
 SPT4     READW  L,T1,1      SKIP PREFIX TABLE
          NZ     X1,SPT1     IF *EOR* THEN KEEP LOOKING 
          R=     X0,X0-1
          NZ     X0,SPT4     IF NOT END OF TABLE
 SPT4A    BSS    0
          READW  L,T1,1 
          NZ     X1,SPT1     IF *EOR* THEN KEEP LOOKING 
          SA1    T1 
          SB2    X1 
          MX2    24 
          BX1    X1*X2       SAVE UPPER 24 BITS OF TABLE HEADER 
          MX2    3           UPPER 24 BITS OF *OPLD* = 70000000B
          BX2    X1-X2       COMPARE HEADER WITH *OPLD* HEADER
          NZ     X2,SPT1     IF NOT *OPLD* THEN KEEP LOOKING
          RECALL L
          SA1    SPTRA       GET *OPLD* RANDOM ADDRESS
          BX6    X1 
          SA6    L+6         RESET *OPLD* RANDOM ADDRESS INTO FET 
          SA1    L+1         INDICATE EMPTY BUFFER
          SX6    X1 
          SA6    A1+B1       SET IN=FIRST 
          SA6    A6+B1       SET OUT=FIRST
          READ   L,R         READ *OPLD*
          READW  L,T1,1 
          SA1    T1          GET *PREFIX* HEADER WORD 
          MX3    -6 
          LX1    24 
          BX0    -X3*X1      (X0)=LENGTH OF *PREFIX* TABLE
          ZR     X0,SPT3A    IF ZERO LENGTH *PREFIX* TABLE
 SPT3     READW  L,T1,1 
          R=     X0,X0-1
          NZ     X0,SPT3     SKIP *PREFIX* TABLE
 SPT3A    BSS    0
          READW  L,T1,1      READ *OPLD* HEADER 
 SPT5     READW  L,T1,2 
          NZ     X1,SPT6     IF EOR 
          MX7    42          SET UP ENTRY TO *STE*
          SA1    T1 
          R=     X2,X1-RELCD
          ZR     X2,SPT5A    IF TYPE RELOCATABLE
          R=     X2,X1-CAPCD
          NZ     X2,SPT5     IF NEITHER CAPSULE NOR RELOC, TRY AGAIN
 SPT5A    BSS    0
          SA0    TPRG 
          RJ     STE         SEARCH *TPRG* FOR ENTRY
          NZ     X6,SPT5     IF NOT FOUND, SKIP 
          SA1    TPRG        GET LAST ENTRY 
          SA2    A1+B1
          R=     B2,X2-1     DECREMENT TABLE LENGTH BY 1
          SX7    B2          DECREMENT TABLE LENGTH 
          SA5    X1+B2       LAST ENTRY = (X5)
          BX6    X5 
          SA7    A2 
          SA6    A4          PLACE LAST ENTRY IN MATCH HOLE 
          MX0    30 
          SA1    T2 
          IFCARD 1
          SA6    UP          SET *USEP* HONORED FLAG
          ADDWRD TOUT,-X0*X1
          SA1    TPRG+1 
          ZR     X1,SPT6     IF *TPRG* (*TUSEP*) NOW EMPTY THEN EXIT
          EQ     SPT5 
  
 SPTILL   SA2    /SLD/LIBNAME      GET LIBRARY NAME 
          MX7    42 
          BX7    X7*X2
          ERROR  4275,X7     ---- ILL-FORMATTED LIBRARY 
  
 SPT6     RECALL L
          SA1    L+1         INDICATE EMPTY BUFFER
          SX6    X1 
          SA6    A1+B1       SET IN=FIRST 
          SA6    A6+B1       SET OUT=FIRST
          SA2    L+7         RESET RANDOM ADDRESS OF DIRECTORY
          SX6    B1 
          IX6    X2+X6
          SA6    A2-B1
          READ   L,R
          EQ     SPT         RETURN 
  
 RELCD    EQU    3           CODE FOR TYPE RELOCATABLE
 CAPCD    EQU    16B         CODE FOR TYPE CAPSULE
 SPTRA    BSSZ   1           RANDOM ADDRESS SAVE AREA 
 STE      TITLE  LOAD COMPLETION SUBROUTINE - SEARCH TABLE. 
**        STE - SEARCH TABLE FOR ENTRY. 
* 
*         ENTRY  - (X1) = ENTRY TO SEARCH FOR.
*                  (A0) = POINTER TO FWA OF TABLE.
*                  (X7) = TABLE MASK TO BE USED IN SEARCH.
* 
*         EXIT  - (X1) = UNCHANGED
*                 (X6) = 0 IFF ENTRY FOUND IN TABLE 
* 
*         USES   X - 2, 3, 4, 6.
*                B - 2. 
*                A - 2, 3, 4. 
  
  
 STE      PS     0           ENTRY/EXIT 
          SA2    A0          GET FWA OF TABLE 
          SA3    A0+B1       GET LENGTH OF TABLE
          MX6    1
          SB2    X3 
          SA4    X2 
 STE1     ZR     B2,STE      IF NO MORE ENTRIES, RETURN 
          BX6    X4-X1
          BX6    X7*X6
          ZR     X6,STE      IF MATCH 
          SB2    B2-B1
          SA4    A4+B1       GET NEXT ENTRY 
          EQ     STE1 
 STB      TITLE  LOAD COMPLETION SUBROUTINE -SORT TABLE 
**        STB - SORT TABLE. 
* 
*         ENTRY  (B2) = TABLE POINTER ADDRESS.
* 
*         USES   X - 1, 2, 4, 6, 7. 
*                B - 2, 3, 4, 5, 6, 7.
*                A - 0, 1, 2, 6, 7. 
  
  
 STB      PS     0           ENTRY/EXIT 
          SA1    B2          (A0) = FWA - 1 
          SA2    B2+B1       (B7) = N = LENGTH
          R=     A0,X1-1
          SB7    X2 
          SB6    X2          M = N (LENGTH) 
 STB1     SX6    B6          M = M/2
          AX6    1
          SB6    X6 
          SB3    B1          J = 1
          ZR     B6,STB      RETURN IF M = 0
          SB4    B7-B6       K = N-M
          SB2    B3          I = J
 STB2     SB5    B2+B6       L = I+M
          SA1    A0+B2       A(I) 
          SA2    A0+B5       A(L) 
          IX4    X2-X1
          PL     X4,STB3     IF A(L) > A(I) 
          BX6    X1          INTERGHANGE A(L) AND A(I)
          LX7    X2 
          SA6    A2 
          SA7    A1 
          SB2    B2-B6       I = I-M
          GT     B2,STB2     IF I > 0 
 STB3     SB3    B3+B1       J = J+1
          SB2    B3          I = J
          LE     B3,B4,STB2  IF J @ K 
          EQ     STB1 
 IN       ENDIF 
 SLD      TITLE  LOAD COMPLETION SUBROUTINE - SEARCH LIBRARY DIRECTORY. 
**        SLD - SEARCH LIBRARY DIRECTORY. 
* 
*              THIS ROUTINE PROCESSES ONE LIBRARY ONLY.  IT RETURNS A 
*         LIST OF ADDRESSES (RMS, ECS, OR CM) OF ALL PROGRAMS NEEDED
*         TO CONTAIN ALL ENTRY POINTS SPECIFIED, PLUS ALL EXTERNAL
*         REFERENCES WHICH MAY RESULT, PLUS ALL PROGRAMS
*         EXPLICITLY MENTIONED. 
* 
*         ENTRY  (X1) = LIBRARY NAME. 
*                (X2) = POINTER TO TABLE OF KNOWN ENTRY POINTS AND
*                       UNSATISFIED EXTERNALS.  THIS TABLE IS OF THE
*                       FORMAT OF *TLNK*. 
*                (X3) = VFD  58/0,1/B,1/A 
*                       A = 0 IF SATISFYING EXTERNALS.
*                         = 1 IF PROCESSING A *LIBLOAD* REQUEST.
*                       B = 1 IF *LIBLOAD* REQUEST RESULTED FROM A
*                             PROGRAM CALL CARD.
*                TABLE *TUSEP* CONTAINS A LIST OF THOSE PROGRAMS THAT 
*                       ARE TO BE INCLUDED IN THE LIST OF PROGRAMS
*                       RETURNED.  IT IS NOT USED IF (X3) INDICATES A 
*                       *LIBLOAD* REQUEST, AS DESCRIBED ABOVE.
*         EXIT   TABLE *TPADR* CONTAINS A LIST OF ADDRESSES OF THOSE
*                       PROGRAMS (RMS, ECS, OR CM ADDRESS) TO BE
*                       LOADED RESULTING FROM THE DIRECTORY SEARCHING 
*                       JUST COMPLETED.  NO LOADING HAS BEEN DONE.
*         USES   ALL REGISTERS EXCEPT B1. 
*         CALLS  CIO=, LDL, ATS=, PTS=, RDW=, CTAB=, IDR, RLI, SAL, PBS.
* 
* 
*                +++  S L D   P R O C E D U R E  +++
* 
*         0.0 PRELIMINARY.
* 
*            0.1 ENTRY INFORMATION IS SAVED AND ALL SCRATCH TABLES
*                WHICH ARE USED ARE SET AS EMPTY. 
* 
  
 SLD      PS                 ENTRY/EXIT 
 K        IFNOS 
          MX6    0
          SA6    FILRTN      INIT FILE RETURN NAME =0 (NO RETURN) 
          SA6    NOSXREF     INIT NOS LIB XREF FLAG, 0=XREF 
 K        ENDIF 
          MX0    42 
          BX6    X1*X0       SAVE LIBRARY NAME
          SA6    LIBNAME
          LX7    X2          SAVE LINKAGE TABLE POINTER WORD ADR
          BX6    X3          SAVE OPTIONS 
          SA7    TIN
          LX6    -1          MI IF *LIBLOAD*
          SA6    FLAGS
  
 DB       IFTEST NE,IP.LDBG,0 
          BX1    X0*X1
          RJ     SFN= 
          BX6    X0*X6
          SA1    =3RNG       R= X1,3RNG  WILL NOT ASSEMBLE W/ UC LOADER 
          BX6    X6+X1
          LX6    -18
          SA6    MSGL1+2
          SA1    =10H   SEARCHI 
          BX6    X1 
          SA6    A6-B1
          SA1    =10H 
          BX6    X1 
          SA6    A6-B1
          SMSG   A6          * SEARCHING XXXXXXX *
 DB       ENDIF 
  
          SA2    L1          CLEAR TABLES *L1*, *L2*, *L3*
          RJ     CTAB=
          SA7    L2+1 
          SA7    L3+1 
          SA7    CMEC        FLAG NO CM OR ECS-RES PROGRAMS SO FAR
  
**           0.2 *IDR* IS CALLED TO PERFORM INITIALIZATION OF THE *FET* 
*                FOR AN *OPEN* REQUEST, AND THEN LDL(4142) IS ISSUED. 
*                THIS ALSO CAUSES THE *EDITLIB* INTERLOCK TO BE SET.
*                DURING SUBSEQUENT PROCESSING, THIS INTERLOCK WILL BE 
*                RELEASED AS SOON AS IT IS KNOWN THAT ALL REMAINING 
*                PROCESSING INVOLVES ONLY DISK-RESIDENT MATERIAL. 
* 
  
 .9       IFNOS 
          RJ     ALF         ACCESS LIBRARY FILE
          SA1    FILRTN 
          ZR     X1,SLD0     IF NOT SYSTEM FILE 
          SA2    TSFR        ADD FILE NAME TO *TSFR*
          RJ     AET= 
 SLD0     BSS    0
          MX0    42 
          SA4    L           FETCH LIBRARY NAME 
          SA3    A4+B1       FET(1) 
          BX7    X0*X4
          NZ     B2,SLDX     IF BAD LIBRARY, EXIT 
 .9       ELSE
 SLD1     R=     X6,3RLDL    SET TO USE *LDL* FOR I/O CALLS 
          SA6    /CCIO/CALL 
          RECALL L
          SA2    LIBNAME     SET LIB NAME IN FET(0) 
          SB7    -B1         INITIALIZE *FET* FOR *LDL* OPEN
          BX7    X2 
          SA7    L
          RJ     IDR
          SX6    B0 
          SA6    INDEX       ZERO FIRST WORD OF INDEX BUFFER
          SX6    B1          FLAG DIRECTORY INTERLOCK AS SET
          SA6    LOCK 
          CIOCALL L,RCL,4142B      SET INTERLOCK AND ISSUE OPEN 
          MX0    42          FETCH STATUS FROM LDL(142) REPLY 
          SA4    L           (X4) = LIBRARY NAME
          BX2    -X0*X4 
          AX2    1
          SB2    X2 
          EQ     B2,B1,SLD3  IF SYSTEM LIBRARY
          MX7    0
          SA7    ULORSL      SET FLAG TO INDICATE USER LIBRARY
  
**           0.3 IF THE *OPEN* REQUEST INDICATED THAT THE LIBRARY IS A
*                USER LIBRARY, THE INTERLOCK IS NOW RELEASED (VIA 
*                *RLI*), SINCE EVERYTHING IS ON DISK.  IT IS HOWEVER
*                VERIFIED THAT THE FILE CONTAINING THE LIBRARY IS MASS- 
*                STORAGE TO DETECT THE ERROR CONDITION OF A USER LIBRARY
*                THAT WAS NOT COPIED FROM TAPE PRIOR TO USE THERE OF. 
* 
  
          SA3    A1+B1       FET(1) 
          BX4    X0*X4
          RJ     RLI         RELEASE LIBRARY INTERLOCK
          BX7    X4          LIBRARY NAME 
          NZ     B2,SLD2     IF USER LIBRARY
          ERROR  4273,X7     ---- NON-EXISTENT LIBRARY GIVEN
          EQ     SLDX        GO TO EXIT 
 .9       ENDIF 
  
 K        IFNOS 
 SLD2     PL     X3,SLD9     IF LIBRARY ON MASS-STORAGE 
          ERROR  4274,X7     ---- LIBRARY NOT ON MASS-STORAGE 
          EQ     SLDX        GO TO EXIT 
 K        ENDIF 
 S        IFSCOPE 
 SLD2     PL     X3,SLD2A    IF LIBRARY ON MASS-STORAGE 
          ERROR  4274,X7     ---- LIBRARY NOT ON MASS-STORAGE 
          EQ     SLDX        EXIT 
 SLD2A    SA2    L           PICK ERROR CODE FIELD OUT OF FET 
          AX2    9D 
          MX5    -5 
          BX2    -X5*X2 
          ZR     X2,SLD2B    IF NO ERROR CONDITION
          ERROR  4275,X7     ---- LIBRARY FORMAT ERROR
          EQ     SLDX        EXIT 
 SLD2B    SA2    INDEX       GET FIRST INDEX WORD (FOR KEY PATTERN) 
          AX2    48D
          R=     X2,X2-2REP  CHECK RANDOM USER LIB KEY PATTERN
          ZR     X2,SLD9     IF GOOD FORMAT RANDOM USER LIB 
          ERROR  4275,X7     ---- LIBRARY FORMAT ERROR
          EQ     SLDX        EXIT 
 S        ENDIF 
  
 .6       IFSCOPE 
**           0.4 IF THE LIBRARY IS A SYSTEM LIBRARY, ALL READ REQUESTS
*                ARE MADE USING AN *FET* WHICH CONTAINS THE NAME OF ONE 
*                OF THE SYSTEM FILES, *ZZZZZ03*, *ZZZZZ04*, OR
*                *ZZZZZ06*.  A REQUEST IS NOW MADE TO *LDL* TO MAKE 
*                SURE A LOCAL COPY EXISTS FOR EACH ONE OF THE ABOVE 
*                WHICH CURRENTLY EXISTS AS A SYSTEM FILE. 
* 
*                FOR A SYSTEM LIBRARY, THE *OPEN* REQUEST CAUSES THE
*                ENTIRE 5-WORD *LNT* ENTRY TO BE RETURNED TO THE
*                INDEX.  FROM THIS, THE RESIDENCY OF THE LIBRARY AND
*                THE APPROPRIATE DESCRIPTOR FIELDS FOR EACH DIRECTORY 
*                RECORD ARE AVAILABLE.
* 
*         FOR A SYSTEM LIBRARY, THE FNT ADDRESS OF ZZZZZ03 (AT CONTROL
*         POINT ZERO) IS RETURNED IN BITS 59-48 OF *L* AND THE FNT
*         ADDRESS OF ZZZZZ04 (AT CONTROL POINT ZERO) IS RETURNED IN 
*         BITS 47-36 OF *L*.  THESE ARE MASSAGED INTO *FOL* FILE-SPEC 
*         ENTRIES AND SAVED FOR LATER (NOT DONE IF USER-CALL LOADER). 
* 
  
 SLD3     SB2    B1+B1       (B2) = 4 
          SX7    B1 
          SA7    ULORSL      SET FLAG TO INDICATE SYSTEM LIBRARY
 IC       IFCARD
          MX6    12 
          SA1    L
          BX2    X6*X1       (X2) = 12/ Z03 FNT ADDR, 48/0
          LX1    12 
          BX1    X6*X1       (X1) = 12/ Z04 FNT ADDR, 48/0
          LX1    -59+35 
          LX2    -59+35 
          BX7    X6+X1       (X7) = 12/7777B,12/0,12/Z04 FNT ADDR,24/0
          SA7    Z04FSE      STORE ZZZZZ04 FILE SPECIFICATION ENTRY 
          BX7    X6+X2       (X7) = 12/7777B,12/0,12/Z03 FNT ADDR,24/0
          SA7    Z03FSE      STORE ZZZZZ03 FILE SPECIFICATION ENTRY 
 IC       ENDIF 
          SA1    =0LZZZZZ0   SET 1ST 6 CHARS OF STANDARD
          BX6    X1          SYSTEM LIBRARY FILE NAME 
          SB2    B2+B2
          SA6    L
          R=     X7,1000B    CREATE LOCAL *FNT* ENTRIES IF
          SA7    T1          NOT PRESENT
          LDL    A7 
          MX3    -2 
          SA1    INDEX       REARRANGE INDEX WORDS SO THAT THE
          BX7    X1          1ST 4 WORDS WILL BE CONSISTENT 
 SLD4     SA1    A1+B1       WITH THE CASE OF A USER LIBRARY, 
          SB2    B2-B1       I.E., THEY CONSIST OF THE
          BX6    X1          ADDRESSES FOR THE 4 DIRECTORY
          SA6    A1-B1       RECORDS, AND, AS A RESULT, THE 
          NZ     B2,SLD4     WORD FROM LNT(0) WILL GO TO THE
          SA7    A1          5TH WORD.
          BX3    -X3*X7 
          NZ     X3,SLD5     IF LIBRARY NOT DISK-RESIDENT 
  
**           0.5 IF THE DIRECTORY IS DISK-RESIDENT, *RLI* IS NOW CALLED 
*                TO RELEASE THE *EDITLIB* INTERLOCK, SINCE, IF THE
*                DIRECTORY IS DISK-RESIDENT, SO ARE ALL PROGRAMS IN THE 
*                LIBRARY. 
* 
  
          RJ     RLI         RELEASE LIBRARY INTERLOCK
          EQ     SLD7 
  
**           0.6 IF THE DIRECTORY IS EITHER CM OR ECS-RESIDENT, IT IS 
*                NECESSARY TO MAKE SURE *EDITLIB* IS NOT WAITING TO GET 
*                CONTROL OF THE INTERLOCK SO HE CAN UPDATE CM/ECS 
*                ADDRESSES IN THE DIRECTORY.  IF THIS CONDITION EXISTS, 
*                THE ENTIRE DIRECTORY ACCESS PROCEDURE MUST BE
*                RE-STARTED AFTER ALLOWING *EDITLIB* TO COMPLETE.  THIS 
*                IS DONE BY RELEASING THE INTERLOCK, ISSUING ONE
*                RECALL, AND RE-ISSUING THE LDL(4142), WHICH WILL NOT 
*                BE ABLE TO PROCEED UNTIL *EDITLIB* RELEASES THE
*                INTERLOCK IN *P.LIB*.
* 
  
 SLD5     LX7    59-17
          PL     X7,SLD6     IF CM/ECS ADDRESSES SAFE 
          RJ     RLI         RELEASE LIBRARY INTERLOCK
          RECALL             ISSUE ONE RECALL 
          EQ     SLD1        TRY AGAIN
  
 SLD6     LX7    17-0 
          SA2    A1+B1       WORD CONTAINING TABLE LENGTHS
          PL     X7,SLD7     IF LIBRARY ECS-RESIDENT
          MX6    -12
          SA3    A1-B1       *PNT* DESCRIPTOR WORD
          LX2    12 
          BX6    -X6*X2      LENGTH OF *PNT*
          AX3    18 
          SX3    X3          FWA OF *PNT* 
          IX6    X6+X3       LWA+1 OF *PNT* IS BASE FOR PROGRAMS
          SA6    PNTEND 
  
**           0.7 THE LDL(1000) REQUEST ISSUED ABOVE TO CREATE LOCAL 
*                *FNT* ENTRIES ALSO RETURNS THE ADDRESSES OF ALL SUCH 
*                ENTRIES.  THESE VALUES ARE NOW SAVED IN THE TABLE
*                *FNTS*.  THIS TABLE IS USED DURING ALL *FET* 
*                INITIALIZATION BY THE ROUTINE *SETFET* SO THAT THE 
*                *FNT* ADDRESS CAN BE PROVIDED FOR *CIO* CALLS WHENEVER 
*                POSSIBLE.
* 
  
 SLD7     SA3    T1          STORE *FNT* ADDRESSES OF SYSTEM
          MX4    -12         LIBRARY FILES IN TABLE *FNTS*
          SB2    B0 
          R=     B3,LFNTS 
 SLD8     LX3    12          NEXT *FNT* ADDRESS OR ZERO 
          SA1    B2+FNTS     NEXT ENTRY 
          BX6    -X4*X3 
          BX1    X4*X1
          IX6    X1+X6
          SA6    A1 
          SB2    B2+B1
          NE     B2,B3,SLD8  LOOP 
 .6       ENDIF 
 SLD9     BSS    0
  
**        1.0 ENTRY POINT NAME TABLE PROCESSING.
* 
*                IN GENERAL, THE PROCESSING OF THE *EPNT* INVOLVES THE
*                BUILDING OF TWO (2) TABLES - THE FIRST (CALLED *L1*) 
*                IS A LIST OF THOSE ENTRY POINTS FOUND IN THIS LIBRARY
*                WHICH ARE AMONG THOSE NEEDED, BUT NOT YET DEFINED. 
*                THE SECOND (CALLED *L2*) IS A LIST OF THOSE ENTRY
*                POINTS FOUND IN THIS LIBRARY WHICH ARE ALREADY 
*                DEFINED.  UNLESS OTHERWISE SPECIFIED, THE ENTRIES IN 
*                ALL TABLES USED BY *SLD* CONSIST OF INTEGERS WHICH 
*                REPRESENT *EPNT* ORDINALS, THE LOWEST HAVING A VALUE 
*                OF ONE (1).  THE TABLES ARE KEPT IN ASCENDING ORDER. 
* 
*            1.1 THE FIRST STEP IS TO CALL *IDR* TO BEGIN THE READ OF 
*                THE *EPNT*.  THEN TABLE *L3* IS SET TO THE LENGTH OF 
*                THE TABLE (*TSUB*) WHICH SPECIFIES SUBSTITUTION OF 
*                ONE EXTERNAL NAME FOR ANOTHER.  *L3* IS SET TO ALL 
*                ZERO INITIALLY.
* 
  
 S        IFSCOPE 
          SB7    B0          START READ OF *EPNT* 
          RJ     IDR
          SA1    TSUB+1      SET *L3* TO SAME SIZE AS *TSUB*
          BX5    X5-X5       INITIALIZE *TIN* ORDINAL FOR SEARCH
          MX0    0           INITIALIZE MAXIMUM *EPNT* ORDINAL
          ZR     X1,EPNT2    IF NO SUBSTITUTIONS
          SB7    -B1         (B7) = -1
          ALLOC  L3,X1       ALLOCATE SPACE FOR *L3*
 EPNT1    MX7    0           ZERO OUT *L3*
          SA7    X2 
          SX6    X6+B7
          SX2    X2+B1
          NZ     X6,EPNT1 
 S        ENDIF 
  
**           1.2 THE NEXT ENTRY FROM THE *EPNT* IS FETCHED.  FOR EACH 
*                LOCATION THE NAME OF THIS ENTRY APPEARS IN *TSUB*
*                (THERE MAY BE MORE THAN ONE), THE CORRESPONDING
*                LOCATION IN *L3* IS SET TO THE CURRENT *EPNT* ORDINAL. 
* 
  
 .7       IFNOS 
  
 EPNT2    BSS    0
**        UNDER KRONOS/NOS THE TABLES *L1*, *L2*, AND *L3* ARE
*         USED AS FOLLOWS.
* 
*         *L1* WILL CONTAIN ENTRY NAMES THAT WE DO NOT WANT.
* 
*         *L2* WILL CONTAIN ENTRY NAMES THAT WE DO WANT.
* 
*         AN ENTRY WILL APPEAR IN *L1* IFF IT IS AN UNSATISFIED 
*         EXTERNAL (POSSIBLY UNDER *OMIT* CONTROL) THAT WE WANT 
*         TO SUBSTITUTE FOR. (FIRST NAME IN SUBSTITUTE PAIR)
*         A *WEAK* EXTERNAL WILL NOT APPEAR IN *L1* AND HENCE ITS 
*         SUBSTITUTE COUNTERPART WILL NOT APPEAR IN *L2*. 
* 
*         AN ENTRY WILL APPEAR IN *L2* IFF WE WANT TO SUBSTITUTE
*         IT (SECOND NAME IN SUBSTITUTE PAIR) AND IT IS NOT UNDER 
*         OMIT CONTROL AND ITS CORRESPONDING NAME (FIRST NAME IN
*         SUBSTITUTE PAIR) IS IN *L1*.
* 
*         NOTE THAT MOST RECENT SUBSTITUTES OVERRIDE PREVIOUS 
*         SUBSTITUTES.  SUBSTITUTES ARE PUT AT THE FRONT OF *TSUB*. 
*         HENCE *TSUB* MUST BE PROCESSED FROM THE FRONT TOWARD
*         THE BACK AND DUPLICATES (FIRST NAMES) MUST BE IGNORED.
* 
*         *L3* (EQU *TOUT*) WILL CONTAIN ADDRESSES OF PROGRAMS
*         THAT WE WANT TO READ IN *LLP*.
* 
*         ANY SUBST/OMIT REQUESTS CAUSE THE LIBRARY TO BE 
*         PROCESSED AS IF NOT CROSS REFERENCED. 
* 
  
          SA1    TSUB+1 
          SA2    TOMIT+1
          BX1    X1+X2
          SX6    B1 
          SA6    SLDACT      SET *SLD* ACTIVE FLAG
          ZR     X1,ULIBI0   IF NO OMITS OR SUBSTITUTES 
          SA6    NOSXREF     FLAG TO NOT USE XREFS (ALSO FLAG TO *SAT*) 
 ULIBI0   BSS    0
          SA1    TSUB+1      (X1) = *TSUB* LENGTH 
          ZR     X1,ULIB0    IF NO SUBSTITUTES, LEAVE *L1*,*L2* EMPTY 
          SB6    X1          (B6) = *TSUB* LIMIT
          SB7    B0          (B7) = *TSUB* INDEX
 ULIBI1   SA2    TSUB        (X2) = *TSUB* FWA
          SA1    X2+B7       (X1) = FIRST NAME IN NEXT SUBST PAIR 
          SA0    L1 
          MX7    42 
          RJ     STE         SEE IF ALREADY IN *L1* 
          ZR     X6,ULIBI3   IF ALREADY IN *L1* 
*                            (X1) STILL IS NAME/0 (FOR *ELT* SEARCH)
          MX2    0           *ELT* FLAG TO SEARCH ONLY
          SA3    FLAGS       SEE IF *LIBLOAD* (IE USING *TLNK2*)
          PL     X3,ULIBI2   IF NOT *LIBLOAD*  (IE USING *TLNK*)
          SB1    -B1         (B1)  = -1 IFF USING *TLNK2* 
 ULIBI2   RJ     ELT         SEARCH *TLNK*/*TLNK2*
          ZR     X2,ULIBI3   IF NOT IN *TLNK*/*TLNK2* 
          LX2    59-58       CHECK IF UNSATISFIED (UNSAT IFF BIT 58 =1) 
          PL     X2,ULIBI3   IF ALREADY SATISFIED 
          LX2    58-55       CHECK IF *WEAK* EXT (WEAK IFF BIT 55 = 1)
          MI     X2,ULIBI3   IF *WEAK* EXTERNAL 
          SA2    TSUB 
          SA1    X2+B7       GET NAME AGAIN INTO X1 
          ADDWRD L1,X1       ADD NAME TO *L1* 
          SA2    TSUB 
          SX2    X2+B7
          SA1    X2+B1       (X1) = SECOND NAME IN SUBST PAIR 
          SA0    TOMIT
          MX7    42 
          RJ     STE         SEE IF UNDER *OMIT* CONTROL
          ZR     X6,ULIBI3   IF UNDER *OMIT* CONTROL
*                            (X1) STILL IS NAME/0 
          ADDWRD L2,X1       ADD NAME TO *L2* 
 ULIBI3   R=     B7,B7+2     BUMP *TSUB* INDEX
          LT     B7,B6,ULIBI1  IF NOT THRU WITH *TSUB*
* 
*         *L1* AND *L2* ARE NOW SETUP AS DESCRIBED ABOVE
* 
 ULIB0    SA1    TIN         CHECK FOR *TIN* EMPTY
          SA1    X1+B1       (X1) = *TIN* LENGTH
          ZR     X1,OUT1     IF *TIN* EMPTY, *L3* (*TOUT*) STILL EMPTY
 ULIB1    RJ     RDULIB      SETUP POINTERS, ISSUE READ IF NECESSARY
          RJ     BINTIN      INITIALIZE FOR BINARY SEARCH OF *TIN*
          SA1    T1          (X1) = NEXT WORD FROM BUFFER 
          EQ     ULIB5
  
 ULIB4    GE     B6,B7,ULIB1  IF NO EASY READ POSSIBLE
          SA1    B6          (X1) = NEXT WORD FROM BUFFER 
          SX6    B6+B1
          R=     B6,B6+1     BUMP B6
          SA6    L+3         BUMP *OUT* 
 ULIB5    MI     X1,ULIB4    IF NOT ENTRY NAME
          SA2    L1+1        CHECK *L1*/*L2* EMPTY
          NZ     X2,ULIBL2L1  IF ONE OF THEM NON-EMPTY
*                            CURRENTLY, IF *L1* EMPTY THEN SO IS *L2* 
 ULIB6    BX4    X1          GET NAME INTO X4 
* 
*         SEARCH *TIN* FOR ENTRY POINT MATCHING (X4)
*         EXPECT (X4) = NAME TO SEARCH FOR
*                (B5) = FWA-2 OF *TIN*
*                (X0) = INITIAL UNDIRECTED DISTANCE 
*                (X5) = LENGTH+2 OF *TIN* 
* 
          SA3    B5+X0       (X3) = ENTRY FROM *TIN*
          AX4    18          POSITION NAME TO *TIN* FORMAT
          IX6    X3-X4
          AX7    X0,B1       (X7)  = INITIAL UNDIRECTED DISTANCE
          ZR     X6,ULIB8    IF MATCH 
          AX6    59 
          BX2    X6*X5
          SB2    X2          (B2) = INITIAL OFFSET = 0 OR LENGTH+4
 ULIB7    AX6    59          (X6) = + OR - 0 = DIRECTION TO LOOK NEXT 
          BX2    X6-X7       (X2) = DIRECTED DISTANCE 
          AX7    1           (X7) = UNDIRECTED DISTANCE NEXT TIME 
          SB2    B2+X2       (B2) = OFFSET INTO *TIN* FOR NEXT TEST 
          ZR     X7,ULIB4    IF ENTRY NOT IN TABLE
          SA3    B5+B2       (X3) = NEXT ENTRY FROM TABLE 
          IX6    X4-X3
          NZ     X6,ULIB7    IF NO MATCH, TRY ANOTHER 
 ULIB8    R=     B2,B5+2     FOUND, ENSURE FIRST, (B2) = FWA *TIN*
          SB3    A3          (B3) = CURRENT MATCH ADDRESS 
 ULIB9    EQ     B2,B3,ULIB10  IF NO PRECEEDING ENTRY 
          R=     A2,B3-2     CHECK PRECEEDING ENTRY 
          BX2    X4-X2
          NZ     X2,ULIB10   IF NOT THE SAME
          R=     B3,B3-2     DECREMENT MATCH ADDRESS
          EQ     ULIB9       KEEP LOOKING 
  
 ULIB10   SA3    B3+B1       GET *TIN* DEFINITION WORD
          LX3    1
          PL     X3,ULIB4    IF ALREADY DEFINED/SATISFIED 
          LX3    1
          MI     X3,ULIB4    IF UNDER *OMIT* CONTROL
          LX3    2
          MI     X3,ULIB4    IF *WEAK* EXTERNAL 
          EQ     ADI1        GO TO ADD ADDRESSES TO *TOUT*
  
*                            *L2* MUST BE PROCESSED BEFORE *L1* 
 ULIBL2L1 SA0    L2          SEE IF EXPLICITLY WANTED 
          MX7    42 
          RJ     STE
          ZR     X6,ADI1     IF EXPLICITLY WANTED 
          SA0    L1          SEE IF EXPLICITLY NOT WANTED 
          MX7    42 
          RJ     STE
          ZR     X6,ULIB4    IF EXPLICITLY NOT WANTED 
          EQ     ULIB6       ELSE CONTINUE CHECKING 
  
* 
*         ADD ADDRESSES TO *TOUT*.  IF *LIBLOAD*, THEN ADD PROGRAM
*         ADDRESS ONLY, ELSE ADD EXTERNAL ADDRESSES ALSO. 
* 
*         ENTRY IS TO *ADI1*. 
* 
 ADI0     RJ     RDULIB      SETUP POINTERS, ISSUE READ IF NECESSARY
          SA1    T1          (X1) = NEXT WORD FROM BUFFER 
          EQ     ADI2 
  
 ADI1     GE     B6,B7,ADI0  IF NO EASY READ POSSIBLE 
          SA1    B6          (X1) = NEXT WORD FROM BUFFER 
          SX6    B6+B1
          R=     B6,B6+1     BUMP B6
          SA6    L+3         BUMP *OUT* 
 ADI2     PL     X1,ADI1     IF NOT ADDRESS 
          MX0    6           (X0) = RECORD TYPE MASK
          LX0    6+30-0 
          BX3    X0*X1
          LX3    30 
          R=     X3,X3-20B
          ZR     X3,ADIX     IF TYPE *PROC*, DO NOT USE 
          SA4    FLAGS
          MI     X4,ADI2A    IF *LIBLOAD*, ACCEPT ANY OF THE OTHER TYPES
          BX5    X1          CHECK IF NEW *LIBGEN* FORMAT (BIT 58 SET)
          LX5    59-58
          PL     X5,ADI2B    IF OLD FORMAT
          R=     X3,X3+20B-03 
          ZR     X3,ADI2A    IF TYPE *REL*, USE 
          R=     X3,X3+03-16B 
          ZR     X3,ADI2A    IF TYPE *CAP*, USE 
          EQ     ADIX        DO NOT USE 
  
 ADI2B    R=     X3,X3+20B-11B
          ZR     X3,ADIX     IF TYPE *ABS*, DO NOT USE
 ADI2A    MX2    30 
          ADDWRD TOUT,-X2*X1  ADD PROGRAM ADDRESS TO *TOUT* 
          MX1    1           FLAG LAST ENTRY AS ADDRESS 
          SA2    NOSXREF
          NZ     X2,ADIX     EXIT IF NO XREFS OR NOT TO USE XREFS 
          SA2    FLAGS       SEE IF *LIBLOAD* 
          PL     X2,ADI4     IF NOT *LIBLOAD*, ADD EXTERNAL ADDRESSES 
 ADIX     RJ     BINTIN      REINITIALIZE FOR BINARY SEARCH OF *TIN*
          EQ     ULIB5       CONTINUE ENTRY POINT SEARCH
  
 ADI3     RJ     RDULIB      SETUP POINTERS, ISSUE READ IF NECESSARY
          SA1    T1          (X1) = NEXT WORD FROM BUFFER 
          EQ     ADI5 
  
 ADI4     GE     B6,B7,ADI3  IF NO EASY READ POSSIBLE 
          SA1    B6          (X1) = NEXT WORD FROM BUFFER 
          SX6    B6+B1
          R=     B6,B6+1     BUMP B6
          SA6    L+3         BUMP *OUT* 
 ADI5     PL     X1,ADIX     IF NOT ADDRESS THEN EXIT 
          BX3    X0*X1       (X3) = RECORD TYPE INDICATOR 
          LX3    30 
          PL     X5,ADI5A    IF OLD LIBGEN FORMAT 
          R=     X3,X3-03 
          ZR     X3,ADI5B    IF TYPE *REL*, INCLUDE 
          R=     X3,X3+03-16B 
          ZR     X3,ADI5B    IF TYPE *CAP*, INCLUDE 
          EQ     ADI4        DO NOT INCLUDE 
  
 ADI5A    R=     X3,X3-20B
          ZR     X3,ADI4     IF TYPE *PROC*, DO NOT INCLUDE 
          R=     X3,X3+20B-11B
          ZR     X3,ADI4     IF TYPE *ABS*, DO NOT INCLUDE
 ADI5B    MX2    30 
          ADDWRD TOUT,-X2*X1  ADD EXTERNAL ADDRESS TO *TOUT*
          EQ     ADI4        CONTINUE 
  
* 
*         ENTRY IS TO *OUT1* WHEN WE ARE THRU PROCESSING
*         THE *ULIB* RECORD.  ALL NECESSARY PROGRAM ADDRESSES 
*         HAVE BEEN SAVED IN *TOUT* (EQU *L3*). 
* 
*         IF A *LIBLOAD* PASS THRU *SLD*, THEN DO NOT PROCESS 
*         *USEP* REQUESTS AT THIS TIME. 
* 
 OUT1     RECALL L           AWAIT I/O COMPLETE (I/O SEQUENCE ERROR)
          SX6    B0 
          SA6    SLDACT      CLEAR *SLD* ACTIVE FLAG
          SA5    FLAGS       SEE IF *LIBLOAD* 
          MI     X5,SUB8.1   IF *LIBLOAD* REQUEST 
          SA5    TUSEP+1     *TUSEP* LENGTH 
          ZR     X5,SUB8.1   IF NO NAMES TO SEARCH FOR
          RJ     SPT         SEARCH *OPLD* RECORD (*USEP* REQUESTS) 
  
*         SORT PROGRAM ADDRESS TABLE *L3* (EQU *TOUT*). 
*         SUPPRESS DUPLICATE ENTRIES. 
*         ADD ADDRESS BIAS TO ALL ENTRIES.
  
 SUB8.1   SA1    TOUT+1 
          ZR     X1,SUB11    IF NO ENTRIES
          SB2    TOUT        SORT TABLE 
          RJ     STB
          SA5    L+7         FILE BIAS
          ADDWRD TOUT,X1-X1  ADD ZERO WORD
          SB2    X2 
          SB3    X2 
          SA1    X2          FIRST ENTRY
          MX3    1
 SUB9     IX6    X5+X1
          BX4    X3-X1
          SA6    B3 
          ZR     X4,SUB10    IF DUPLICATE ENTRY 
          SB3    B3+B1
          BX3    X1 
 SUB10    SA1    A1+B1       NEXT ENTRY 
          NZ     X3,SUB9     IF NOT END, LOOP 
          SX7    B3-B2       SET LENGTH 
          R=     X7,X7-1
          SA7    TOUT+1 
 SUB11    BSS    0
  
 .7       ELSE
 EPNT2    READO  L           NEXT *EPNT* ENTRY
          SA3    TSUB 
          NZ     X1,EPNT10   IF AT END OF *EPNT*
          SA4    A3+B1       SEARCH *TSUB* FOR CURRENT NAME 
          SX0    X0+B1       ADVANCE *EPNT* ORDINAL 
          IX4    X3+X4
          BX1    X6          (X1) = CURRENT *EPNT* ENTRY
          MX7    42 
          SB2    X3 
          SA2    L3          (B5) = FWA *L3*
          SB3    X4 
          BX6    X0          ORDINAL FOR STORE
          SB5    X2 
          BX2    X7*X1
 EPNT3    EQ     B2,B3,EPNT4 IF END OF *TSUB* 
          SA3    B2          NEXT ENTRY 
          BX3    X3-X2
          SB2    B2+B1
          SB5    B5+B1
          NZ     X3,EPNT3    IF NO MATCH
          SA6    B5-B1       STORE ORDINAL IN MATCHING *L3* ENTRY 
          EQ     EPNT3       LOOP 
  
**           1.3 IT IS NOW DETERMINED WHETHER OR NOT THE CURRENT ENTRY
*                EXISTS IN THE MAIN LINKAGE TABLE (*TIN*).  THIS IS DONE
*                BY A SHOTGUN-STYLE SEARCH, MAKING USE OF THE FACT
*                THAT BOTH THE *EPNT* AND *TIN* ARE IN ASCENDING ORDER. 
*                IF THE CURRENT ENTRY IS OF GREATER VALUE THAN THE
*                LAST ENTRY IN *TIN*, NO MORE SEARCHING IN *TIN* IS 
*                PERFORMED, BUT THE *EPNT* MUST BE READ TO THE END
*                IN ORDER TO SET THE VALUE OF THE HIGHEST ORDINAL.
* 
  
 EPNT4    MI     X5,EPNT2    IF NOTHING ELSE CAN BE FOUND 
          SA2    TIN         (B7) = *TIN* FWA 
          MX6    42          NAMES ARE IN LOWER 42 BITS 
          SA2    X2 
          SA3    A2+B1       (X3) = *TIN* LENGTH
          BX6    X6*X1
          SB7    X2 
          LX6    -18
          SB2    B1+B1       (B2) = 2 
 EPNT5    SA2    B7+X5       NEXT *TIN* ENTRY 
          IX7    X6-X2
          ZR     X7,EPNT6    IF ENTRY FOUND 
          MI     X7,EPNT2    IF THIS ENTRY NOT IN *TIN* 
          SX5    X5+B2       ADVANCE *TIN* ORDINAL
          IX4    X5-X3
          NG     X4,EPNT5    IF MORE ENTRIES IN *TIN* 
          MX5    1           FLAG FOR NO MORE SEARCHING OF *TIN*
          EQ     EPNT2
  
**           1.4 IF THE ENTRY IS FOUND IN *TIN*, IT IS ADDED TO *L1*
*                OR *L2*, AS DESCRIBED ABOVE, WITH THE FOLLOWING
*                NOTABLE EXCEPTIONS - 
* 
*                1) WHILE SATISFYING EXTERNALS, ENTRIES FOR OVERLAYS
*                   ARE TREATED AS NO-MATCHES.
*                2) IF THE ENTRY IS *OMITTED* OR A *WEAK* EXTERNAL, IT
*                   IS ADDED TO *L2*, JUST AS IF IT WERE DEFINED. 
*                3) IN CONTROL-CARD-INITIATED LOADS ONLY - IF PROCESSING
*                   A PROGRAM-CALL, AND IF THE ENTRY IS NOT SPECIFIED 
*                   AS CONTROL-CARD-CALLABLE, A FLAG IS SET FOR LATER 
*                   ERROR PROCESSING, AND THE ENTRY IS TREATED AS A 
*                   NO-MATCH. 
*                4) IN CONTROL-CARD-INITIATED LOADS ONLY UNDER
*                   NOS/BE, IF THE PROGRAM FOUND IS A PROCEDURE,
*                   GO TO THE PROCEDURE TABLE PROCESSOR IN *READ*.
*                5) UNDER NOS/BE IF AN ABS ENTRY IS FOUND (*LIBLOAD*) 
*                   THEN THE USER MUST HAVE THE PROPER PERMISSION.
*                   BITS 0 THRU IP.IACES-1 = ACCESS LEVEL AND BITS
*                   IP.IACES THRU 10 INCLUSIVE = PERMISSION BITS.  EACH 
*                   BIT WHICH IS SET IN THE LIBRARY DIRECTORY *EPNT*
*                   PERMISSION BITS FIELD MUST ALSO BE SET IN THE 
*                   CONTROL POINT AREA PERMISSION BITS FIELD.  THE
*                   ACCESS LEVEL FIELD IN THE CONTROL POINT AREA
*                   MUST BE GREATER THAN OR EQUAL TO THE ACCESS LEVEL 
*                   FIELD IN THE *EPNT* ENTRY.  BOTH OF THESE CHECKS
*                   MUST PASS OTHERWISE A FATAL ERROR WILL BE ISSUED. 
*                   THE *EPNT* ACCESS LEVEL IS THE UPPER 11 BITS OF THE 
*                   ACCESS LEVEL FIELD, THUS IGNORING THE CONTROL CARD
*                   CALLABLE BIT. 
* 
  
 EPNT6    MX3    -3 
          BX3    -X3*X1 
          SA4    FLAGS
          MI     X4,EPNT6A   IF *LIBLOAD* 
          NZ     X3,EPNT2    IF ENTRY FOR ABSOLUTE PROGRAM
 EPNT6A   BSS    0
 IC       IFCARD
          ZR     X3,EPNT7    IF ENTRY FOR RELOCATABLE PROGRAM 
          MX2    -11
          LX1    -4 
          BX6    -X2*X1      (X6) = ACCESS LEVEL FROM *EPNT*
          SA4    ULORSL 
          NZ     X4,EPNT6C   IF LOADING FROM SYSTEM LIBRARY 
          MX7    59          INVALIDATE POSSIBLE SDM= 
          LX1    4           RESTORE *EPNT* ENTRY 
          SA7    SDMFLAG
          EQ     EPNT6D 
  
 EPNT6C   MX4    -1 
          LX1    4-15 
          BX7    -X4*X1      SDM= FLAG
          LX1    15          RESTORE *EPNT* ENTRY 
          ZR     X2,EPNT6D   IF NOT PROCESSING PROGRAM CALL 
          SA2    SDMFLAG
          ZR     X7,EPNT6D   IF NOT SDM= ROUTINE
          MI     X2,EPNT6D   IF ALREADY LOADED NON-SYSTEM ROUTINE 
          SA7    SDMFLAG
 EPNT6D   BSS    0
          SA2    AL          (X2) = ACCESS LEVEL FROM CONTROL POINT AREA
          MX7    11 
          BX4    X2*X6
          LX7    IP.IACES    (X7) = ACCESS LEVEL/PERMISSION BIT MASK
          BX4    X4-X6
          BX4    -X7*X4 
          NZ     X4,EPNT6B   IF PERM. BIT SET IN *EPNT* AND NOT IN CPA
          BX2    X7*X2
          BX6    X7*X6
          IX7    X2-X6
          MX6    42 
          SA2    X5+B7       RESTORE A2 
          BX6    X6*X1
          LX6    -18         RESTORE X6 
          SA4    FLAGS       RESTORE X4 
          PL     X7,EPNT7    IF CPA ACCESS LEVEL .GE. *EPNT* ACCESS LEV.
 EPNT6B   MX7    42 
          BX7    X7*X1       ENTRY POINT NAME 
          ERROR  205,X7      ---- USER NOT AUTHORIZED FOR PROGRAM-(NAME)
          EQ     ABEND
 IC       ENDIF 
  
 EPNT7    BSS    0
 IC       IFCARD
          R=     X2,X3-PROCCD 
          ZR     X2,/READ/PROC1  IF A CCL PROCEDURE 
 IC       ENDIF 
          SA3    A2+B1       GET DEFINITION WORD OF *TIN* ENTRY 
          LX3    59-58       MI IF UNSATISFIED
          SX2    L2          SET TO ADD KNOWN ENTRY TO *L2* 
          LX7    X3,B1       POSITION *OMIT* BIT
          LX6    18          NAME TO UPPER 42 BITS
          MI     X3,EPNT9    IF UNSATISFIED 
 EPNT8    BX1    X0          INSERT *EPNT* ORDINAL IN *L1* OR *L2*
          RJ     SAL
          EQ     EPNT2       LOOP THROUGH *EPNT*
  
 EPNT9    MI     X7,EPNT8    IF *OMIT* CONTROL, ACT AS IF KNOWN 
          LX7    2           POSITION *WEAK* BIT
          MI     X7,EPNT2    IF *WEAK* EXTERNAL, COMPLETELY IGNORE
          SX2    L1          SET TO ADD NEEDED ENTRY TO *L1*
 IC       IFCARD
          PL     X4,EPNT8    IF NOT *LIBLOAD* 
          SB2    X4 
          LX1    59-3 
          ZR     B2,EPNT8    IF NOT PROCESSING PROGRAM CALL 
          MI     X1,EPNT8    IF CONTROL-CARD-CALLABLE 
          SA6    NOTCCC      SET ERROR FLAG = ENTRY NAME
 IC       ENDIF 
          IFUSER 1
          EQ     EPNT8
  
**           1.5 IF, UPON REACHING THE END OF THE *EPNT*, TABLE *L1* IS 
*                EMPTY, IT MEANS THAT NONE OF THE NEEDED ENTRY POINTS 
*                WERE FOUND IN THIS LIBRARY.  IN THIS CASE, TABLES
*                *L2* AND *L3* ARE CLEARED, AND CONTROL PASSES TO THE 
*                *PNT* PROCESSOR IN CASE ANY PROGRAMS SPECIFIED BY
*                *USEP* MIGHT BE FOUND. 
* 
  
 EPNT10   SA1    L1+1 
          NZ     X1,EPNT11   IF ANY ENTRY POINTS FOUND
          SA2    L2          CLEAR *L2* AND *L3*
          RJ     CTAB=
          SA7    L3+1 
          EQ     PNT0        GO PROCESS *PNT* 
  
 EPNT11   BSS    0
  
**        2.0 EXTERNAL REFERENCE TABLE PROCESSING.
* 
*                THE PROCESSING OF THE *ERT* INVOLVES THE ADDITION OF 
*                ENTRIES IN TABLE *L1* WHICH RESULT FROM *ERT* ENTRIES
*                WHICH CORRESPOND TO VALUES ALREADY IN *L1*.  THE *ERT* 
*                PROCESS IS PERFORMED ONLY WHILE SATISFYING EXTERNALS,
*                AND NOT DURING A *LIBLOAD*.
* 
*            2.1 *IDR* IS CALLED TO BEGIN THE READ OF THE *ERT*.
* 
  
          SA1    FLAGS
          MI     X1,PNUT0    IF *LIBLOAD*, SKIP *ERT* 
          MX4    1           FORCE *IDR* CALL THE 1ST TIME
          SA0    X0          (A0) = MAXIMUM *EPNT* ORDINAL
          MX5    0           SET *IN* = *FIRST* BELOW 
 ERT1     BX6    X6-X6       CLEAR RE-PASS FLAG 
          SA6    ERTREP 
          SB2    B1+B1       SET *OUT* = *FIRST* - IF ALL OF *ERT*
          SA1    L+1         WILL FIT IN THE BUFFER, AND HAS
          SX6    X1          ALREADY BEEN READ, THIS IS ALL THAT
          SA6    A1+B2       IS NEEDED FOR ANOTHER PASS 
          IX7    X6+X5       RESET *IN* TO END OF LAST READ 
          SA7    A6-B1       (*LCB* SET IT TO *FIRST*)
          MX5    0           INITIALIZE *ERT* ORDINAL 
          SB7    B1 
          PL     X4,ERT2     IF RE-READ NOT NECESSARY 
          RJ     IDR         START READ OF *ERT*
          RECALL X2          WAIT FOR CIO COMPLETION
          SA1    X2 
          LX1    59-4        CHECK FOR RECORD IN BUFFER 
          PL     X1,ERT2     IF ERT DOES NOT FIT IN BUFFER
          RJ     SET         SEARCH ERT TABLE 
          EQ     PNUT0       GO HANDLE PNUT NOW 
  
**           2.2 THE NEXT ENTRY FROM THE *ERT* IS FETCHED.  IF THE
*                CORRESPONDING ORDINAL DOES NOT APPEAR IN *L1*, THE 
*                ENTRY IS NOT PROCESSED FURTHER.
* 
  
 ERT2     READO  L           NEXT *ERT* ENTRY 
          BX0    X6          (X0) = ENTRY 
          NZ     X1,ERT8     IF AT END OF *ERT* 
          SX5    X5+B1       ADVANCE *ERT* ORDINAL
          BX1    X5          CHECK IF THIS ORDINAL ALREADY IN *L1*
          SX2    L1 
          RJ     PBS
          SB7    B0          INITIALIZE BYTE COUNT
          PL     X2,ERT2     IF THIS ORDINAL NOT OF INTEREST
  
**           2.3 EACH 12-BIT BYTE OF THE ENTRY IS EXAMINED IN TURN. 
*                IF ZERO, THE ENTRY IS EXHAUSTED, AND THE NEXT WORD IS
*                FETCHED.  OTHERWISE, IT REPRESENTS AN ORDINAL OF A 
*                NEEDED ENTRY, AND IS ADDED TO *L1*.  HOWEVER, IF THE 
*                VALUE IS GE 4000B, THEN IT POINTS TO A CONTINUATION
*                ENTRY AT ORDINAL (VALUE)-3777B+E, WHERE *E* IS THE 
*                ORDINAL OF THE LAST ENTRY IN THE *EPNT*.  BY ADDING
*                THE RESULTING VALUE TO *L1*, ALL CONTINUATION BYTES
*                WHICH ARE NEEDED WILL BE PICKED UP.
* 
  
 ERT3     LX0    12          (X1) = NEXT BYTE (K) FROM ENTRY
          MX1    -12
          R=     B3,3777B 
          BX1    -X1*X0 
          ZR     X1,ERT2     IF NO MORE VALUES THIS ENTRY 
          SX3    A0-B3       EPMAX-4000B+1
          SB2    X1 
          LE     B2,B3,ERT4  IF NOT A CONTINUATION BYTE 
          IX1    X1+X3       SET K = K-4000B+EPMAX+1
  
**           2.4 BEFORE EACH NEW ORDINAL IS ADDED TO *L1*, IT IS
*                SEARCHED FOR IN TABLE *L3*, THE SUBSTITUTION TABLE.
*                IF IT APPEARS IN THE 1ST HALF OF AN ENTRY, IT IS UNDER 
*                *SUBST* CONTROL.  IF THE 2ND HALF IS NON-ZERO, THEN
*                THAT VALUE POINTS TO THE ORDINAL OF AN ENTRY POINT IN
*                THIS LIBRARY, AND THAT ORDINAL IS ADDED TO *L1* INSTEAD
*                OF THE 1ST VALUE.  HOWEVER, IF A 1ST HALF MATCH
*                OCCURS, AND THE 2ND HALF = 0, THEN THE ENTRY TO BE 
*                SUBSTITUTED IS NOT IN THIS LIBRARY, SO NO ENTRY IS 
*                MADE TO *L1*.
* 
*                NOTE THAT SUBSTITUTIONS IN *L3* ARE NOT MADE DURING
*                THE *EPNT* PROCESSING, BECAUSE ANY VALUES ADDED TO THE 
*                MAIN LINKAGE TABLE HAVE ALREADY BEEN THE RESULT OF ANY 
*                NECESSARY SUBSTITUTIONS (I.E., IN *CPR*).
* 
  
 ERT4     SA2    L3          CHECK IF VALUE CAN BE SUBSTITUTED
          SA3    A2+B1       WITHIN THIS LIBRARY
          IX3    X2+X3
          SB2    X2 
          SB3    X3 
          SB4    B1+B1
          SB6    X1          (B6) = CURRENT BYTE
 ERT5     EQ     B2,B3,ERT6  IF END OF SUBSTITUTION ORDINALS
          SA2    B2          1ST HALF OF NEXT ENTRY 
          IX3    X2-X1
          SB2    B2+B4
          NZ     X3,ERT5     IF NO MATCH
          SA4    A2+B1       GET 2ND HALF OF ENTRY
          ZR     X4,ERT7     IF 2ND HALF ZERO, DISCARD
          BX1    X4          BOTH HALVES PRESENT, SUBSTITUTE
          SB6    X4 
  
**           2.5 IT IS ALSO NECESSARY, PRIOR TO MAKING AN ADDITION TO 
*                *L1*, TO MAKE SURE THE VALUE IS NOT IN *L2*, SINCE, IF 
*                IT IS, THE CORRESPONDING EXTERNAL IS ALREADY DEFINED.
* 
  
 ERT6     SX2    L2          CHECK IF VALUE IS OF A KNOWN 
          RJ     PBS         ENTRY POINT (IN *L2*)
          MI     X2,ERT7     IF KNOWN 
          SX2    L1          ADD ORDINAL TO TABLE OF NEEDED 
          RJ     SAL         ENTRY POINTS (*L1*)
          MI     X2,ERT7     IF ALREADY IN TABLE OF NEEDED ENTRIES
  
**           2.6 IF ANY ORDINAL, AT THE TIME IT WAS ADDED TO *L1*, IS 
*                LOWER THAN THAT OF THE *ERT* ENTRY CURRENTLY BEING 
*                PROCESSED, NEEDED VALUES ARE LIKELY TO HAVE BEEN 
*                MISSED.  THEREFORE, IF THIS SITUATION IS DETECTED, A 
*                FLAG IS SET SO THE *ERT* PROCESS WILL BE REPEATED. 
* 
  
          SB5    X5          CURRENT *ERT* ORDINAL
          SX7    B1 
          GE     B6,B5,ERT7  IF THIS VALUE NOT REACHED
          SA7    ERTREP      FLAG FOR ANOTHER PASS
 ERT7     SB7    B7+B1       ADVANCE BYTE COUNT 
          R=     X4,B7-5
          NZ     X4,ERT3     IF NOT END OF WORD 
          EQ     ERT2        GET NEXT WORD
  
 ERT8     R=     X4,IP.LBUF-1      (X4) = PL IF ENTIRE *ERT* IN BUFFER
          SA1    ERTREP 
          IX4    X4-X5
          NZ     X1,ERT1     IF *ERT* MUST BE RE-PROCESSED
  
**           2.7 WHEN THE *ERT* PROCESSING IS COMPLETE, INCLUDING ANY 
*                NECESSARY RE-PASSES, THERE WILL BE SOME ENTRIES IN 
*                *L1* WHICH ARE NO LONGER WANTED, NAMELY THOSE WHICH
*                CAME ABOUT FROM *ERT* OVERFLOW POINTERS, DESCRIBED IN
*                2.3 ABOVE.  THESE ARE EASILY RECOGNIZED AS THOSE VALUES
*                GREATER THAN THE HIGHEST *EPNT* ORDINAL AND THE LENGTH 
*                OF *L1* IS NOW ADJUSTED SO AS TO DELETE THESE. 
* 
  
          SA2    L1          (X4) = LENGTH OF *L1*
          SA4    A2+B1       (X3) = FETCH POINTER 
          SX7    B1          (FETCH TOP-DOWN) 
          IX3    X2+X4
          SX0    A0          (X0) = MAXIMUM *EPNT* ORDINAL
 ERT9     IX3    X3-X7       DOWN FETCH ADDRESS 
          IX4    X4-X7       DOWN LENGTH
          MI     X4,ERT10    IF NOTHING TO KEEP 
          SA5    X3          NEXT ENTRY 
          IX1    X0-X5
          MI     X1,ERT9     IF THIS ONE TO BE DISCARDED
 ERT10    SX6    X4+B1       SET ADJUSTED LENGTH
          SA6    A4 
  
**        3.0 PROGRAM NUMBER TABLE PROCESSING.
* 
*                PROCESSING OF THE *PNUT* IS THE SIMPLEST OF THE FOUR 
*                DIRECTORY RECORDS AND INVOLVES USING THE CONTENTS OF 
*                *L1* TO FORM A TABLE OF NEEDED *PNT* ORDINALS IN 
*                TABLE *L2*.
* 
*            3.1 TABLES *L2* AND *L3* ARE EMPTIED AT THIS POINT, SINCE
*                THEIR CONTENTS ARE NO LONGER NEEDED.  *IDR* IS CALLED
*                TO BEGIN THE READ OF THE *PNUT*. 
* 
  
 PNUT0    SA2    L2          CLEAR *L2* AND *L3*
          RJ     CTAB=
          SA7    L3+1 
          SA0    B0          INITIALIZE *EPNT* ORDINAL
          R=     B7,2        START READ OF *PNUT* 
          SB6    B7+B7       (B6) = BYTE COUNT = 4
          RJ     IDR
  
**           3.2 FOR EACH POSITION IN THE *PNUT* IN WHICH THERE IS A
*                CORRESPONDING ORDINAL IN *L1*, AN ENTRY IS ADDED TO
*                *L2*.  EACH *PNUT* ENTRY CONSISTS OF A 12-BIT BYTE 
*                WHICH CONTAINS A *PNT* ORDINAL.  IN THIS CASE, THE 
*                VALUE *N* FOR THE 1ST *PNT* ENTRY IS ZERO (0), THE 2ND 
*                IS ONE (1), ETC.  THE VALUES *V* ADDED TO *L2* ARE 
*                CONVERTED TO V=2N+1 TO ALLOW FOR THE *PNT* ENTRIES 
*                BEING TWO (2) WORDS IN LENGTH. 
* 
  
 PNUT1    SA1    L1          (X5) = NEXT ENTRY FROM *L1*
          SA2    A1+B1
          MX4    -1 
          SA5    X1 
          ZR     X2,PNT0     IF ALL OF *L1* PROCESSED 
          SX6    X1+B1       SHORTEN *L1* BY ONE WORD 
          IX7    X2+X4
          SA6    A1 
          SA7    A2 
 PNUT2    SB6    B6+B1       ADVANCE BYTE COUNT 
          R=     X4,B6-5
          NZ     X4,PNUT3    IF MORE IN CURRENT *PNUT* ENTRY
          READO  L
          BX0    X6          (X0) = NEXT *PNUT* ENTRY 
          SB6    B0          RESET BYTE COUNT 
 PNUT3    SA0    A0+B1       ADVANCE *EPNT* ORDINAL 
          LX0    12          POSITION NEXT BYTE 
          SX1    A0 
          IX2    X1-X5
          NZ     X2,PNUT2    IF NEXT DESIRED ORD NOT REACHED
          MX3    -12         FORM NEXT *PNT* ORDINAL
          BX1    -X3*X0      = 2*BYTE + 1 
          LX1    1
          SX2    L2          ADD TO *L2*
          SX1    X1+B1
          RJ     SAL
          EQ     PNUT1       LOOP TO END OF *L1*
  
**        4.0 PROGRAM NAME TABLE PROCESSING.
* 
*                THE *PNT* IS NOW READ TO GET THE ADDRESSES OF ALL
*                NEEDED PROGRAMS.  NEEDED PROGRAMS ARE SPECIFIED BY 
*                1) THE ORDINALS IN TABLE *L2* WHICH RESULT FROM ENTRY
*                POINTS FOUND IN THIS LIBRARY, AND 2) PROGRAM NAMES IN
*                TABLE *TPRG*, RESULTING FROM *USEP* REQUESTS.  THE 
*                LATTER IS USED ONLY IF SATISFYING EXTERNALS AND NOT
*                DURING A *LIBLOAD*.
* 
*            4.1 TABLE *TOUT* IS ALLOCATED TO THE SUM OF THE LENGTHS
*                OF *L2* AND *TPRG*.  AS A RESULT OF THIS, IT IS KNOWN
*                THAT NO TABLE MOVES WILL OCCUR DURING THE *PNT* READ.
*                THE ACTUAL FINAL LENGTH WILL BE A VALUE BETWEEN THE
*                ABOVE AND THE LENGTH OF *L2* ALONE, AND WILL BE SET
*                PROPERLY WHEN THE READ IS DONE.  HOWEVER, IF BOTH OF 
*                THE ABOVE TABLES ARE OF ZERO LENGTH, THERE IS NOTHING
*                TO FIND, AND THE *PNT* READ IS SKIPPED.
* 
  
 PNT0     SA2    TPRG+1      *TPRG* LENGTH
          SA3    FLAGS
          MX0    0           (X0) = NZ ONLY IF TO USE *TPRG*
          SA4    L2+1        *L2* LENGTH
          MI     X3,PNT1     IF PROCESSING *LIBLOAD*
          BX0    X2          SET *TPRG* LENGTH
 PNT1     IX1    X4+X0       COMBINED LENGTH
          ZR     X1,SLDX     IF NO REASON TO READ *PNT* 
          ALLOC  TOUT,X1     ALLOCATE *TOUT* TO MAX NECESSARY SIZE
  
**           4.2 *IDR* IS CALLED TO BEGIN THE READ OF THE *PNT*.
*                INITIALIZATION INVOLVES FETCHING THE FIRST ENTRY FROM
*                *L2*, WHICH IS THE FIRST DESIRED *PNT* ORDINAL.  IF
*                *L2* IS EMPTY, THIS VALUE IS SET TO ZERO SO AS TO
*                FORCE NO MATCHES OF THIS TYPE.  (THE LOWEST *PNT*
*                ORDINAL IS ONE).  THE THE FOLLOWING CODE IS SET UP TO
*                HANDLE THE CASES OF 1) *L2* EMPTY, WHICH IS RARE, AND
*                2) *TPRG* EMPTY WHICH IS MOST OF THE TIME, BUT NOT 
*                BOTH EMPTY, SINCE THIS WAS CHECKED AS DESCRIBED ABOVE. 
*                THE *PNT* IS CHECKED FOR GROUP NAMES AND IF ANY ARE
*                FOUND THEY ARE READ AND DISCARDED. 
* 
  
          R=     B7,3        BEGIN READ OF *PNT*
          SA0    X2          (A0) = *TOUT* STORE POINTER
          BX5    X0          NZ IF *TPRG* TO BE USED
          RJ     IDR
          MX0    1           (X0) = CURRENT *PNT* ORDINAL 
          ZR     X5,PNT2
          MX0    2           (X0) = NG IF *TPRG* TO BE SEARCHED 
 PNT2     SA1    L2          (X5) = CURRENT *L2* ENTRY
          LX0    1
          SA5    A1+B1       *L2* LENGTH
          MX6    0
          IX2    X1+X5       *L2* LWA+1 
          ZR     X5,PNT2A    IF *L2* EMPTY, LEAVE (X5) = 0
          SA6    X2          STORE ZERO WORD AT LWA+1 
          SA5    X1          (A5) = *L2* FETCH POINTER
 PNT2A    READW  L,T1,2      READ AND DISCARD GROUP NAMES 
          NZ     X1,PNT7     IF AT END OF PNT 
          SA1    T1          (X1) = FIRST WORD OF PNT 
          MX3    12 
          BX4    X1*X3
          LX4    12          (X4) = PNT HEADER CODE FIELD 
          R=     X4,X4-7604B  CHECK FOR NEW FORMAT PNT
          NZ     X4,PNT3A    IF NO GROUP NAMES TO DISCARD 
          LX1    12 
          BX4    X1*X3
          LX4    12 
          SB2    X4 
          SB2    B2-B1       (B2) = NO. OF GROUP NAMES - 1
          ZR     B2,PNT3     IF ALL GROUP NAMES DISCARDED 
 PNT2C    READO  L           READ AND DISCARD 
          SB2    B2-B1       DECREMENT
          NZ     B2,PNT2C    CONTINUE TO DISCARD GROUP NAMES
  
  
**           4.3 AS EACH *PNT* ENTRY IS FETCHED, ITS ORDINAL IS 
*                COMPARED WITH THE NEXT ORDINAL FROM *L2*.  WHENEVER
*                A MATCH OCCURS, THE SUBROUTINE *AJAX* IS CALLED TO 
*                FORM THE ENTRY FOR *TOUT*, THE TABLE CONTAINING THE
*                PROGRAM ADDRESSES.  IN ADDITION, AND IF APPROPRIATE, 
*                THE TABLE *TPRG* IS SEARCHED FOR EACH *PNT* ENTRY BY 
*                NAME.  THIS MUST BE DONE FOR EACH ENTRY REGARDLESS OF
*                WHETHER OR NOT JUST FOUND, BECAUSE ENTRIES ALSO HAVE TO
*                BE DELETED FROM *TPRG* AS THEY ARE FOUND.
* 
  
 PNT3     READW  L,T1,2      NEXT *PNT* ENTRY 
          NZ     X1,PNT7     IF AT END OF *PNT* 
 PNT3A    BSS    0
          SX4    X0          COMPARE ORDINAL OF THIS *PNT* ENTRY
          IX3    X4-X5       WITH NEXT ORDINAL FROM *L2*
          NZ     X3,PNT4     IF NOT NEEDED ACCORDING TO *L2*
          RJ     AJAX        FORM *TOUT* ENTRY
          SA6    A0          STORE *TOUT* ENTRY 
          SA5    A5+B1       NEXT *L2* ENTRY
          SA0    A0+B1       ADVANCE *TOUT* STORE POINTER 
          SB6    B0          FLAG THIS *PNT* ENTRY STORED 
          NZ     X5,PNT4     IF END OF *L2* NOT REACHED 
          MX5    1           FORCE NO MORE MATCHES
 PNT4     PL     X0,PNT6     IF NO SEARCHING BY NAME
          SA2    TPRG        SEARCH *TPRG* FOR *PNT* ENTRY
          SA3    A2+B1
          SX6    B1 
          SA4    X2          FIRST ENTRY
          MX7    42 
          SA1    T1          (X1) = NAME FROM *PNT* ENTRY 
          BX1    X7*X1
          MX7    0
 PNT5     IX3    X3-X6       DOWN LENGTH
          MI     X3,PNT6     IF NOT IN *TPRG* 
          IX2    X4-X1       COMPARE NAMES
          SA4    A4+B1       NEXT ENTRY 
          NZ     X2,PNT5     LOOP IF NO MATCH 
          SA7    A4-B1       MATCH - CLEAR ENTRY IN *TPRG*
          ZR     B6,PNT6     IF THIS ENTRY ALREADY PUT IN *TOUT*
*                            CHECK IF PROGRAM ALREADY LOADED
          SA2    TBLK        (X2) = *TBLK* FWA
          SA3    A2+B1
          IX3    X2+X3       (X3) = *TBLK* LWA+1
          MX7    44 
          LX7    2           (X7) = MASK FOR *TPGM* NAME,CM+PROG FLAGS
 PNT5A    IX4    X2-X3
          PL     X4,PNT5B    IF END OF *TBLK* (PROG NOT LOADED YET) 
          SA4    X2          GET NEXT *TBLK* NAME 
          BX4    X4*X7       (X4) = 42/NAME,15/0,1/0,1/E,1/T
          R=     X2,X2+2     BUMP *TBLK* FETCH INDEX
          BX4    X4-X1       COMPARE WITH THIS PROGRAM NAME 
          NZ     X4,PNT5A    IF NOT THE SAME
          EQ     PNT6        DO NOT ADD ENTRY TO *TOUT*(ALREADY LOADED) 
  
 PNT5B    BSS    0
          RJ     AJAX        FORM *TOUT* ENTRY
          IFCARD 1
          SA6    UP          SET *USEP* HONORED FLAG
          SA6    A0          STORE *TOUT* ENTRY 
          SA0    A0+B1       ADVANCE *TOUT* STORE POINTER 
 PNT6     SX1    B1+B1       ADVANCE *PNT* ORDINAL
          IX0    X0+X1
          EQ     PNT3        LOOP THROUGH *PNT* 
  
**           4.4 WHEN THE READ OF THE *PNT* IS COMPLETE, THE LENGTH OF
*                *TOUT* IS SET TO REFLECT THE ACTUAL ENTRIES STORED IN
*                THE TABLE. 
* 
  
 PNT7     SA5    TOUT        SET *TOUT* ACTUAL LENGTH 
          RJ     AMU=        ACCUMULATE MEMORY USED 
          SX2    A0 
          IX6    X2-X5
          SA6    A5+B1
 .7       ENDIF 
  
**        5.0 EXIT PROCEDURE. 
* 
*                ALL SCRATCH TABLES USED BY *SLD* ARE CLEARED PRIOR TO
*                EXIT.  THE MAIN I/O CONTROL IS SET BACK TO *CIO* 
*                (AS OPPOSED TO *LDL*).  IF ALL PROGRAMS PASSED BACK
*                THROUGH *TOUT* ARE DISK-RESIDENT, THE *EDITLIB*
*                INTERLOCK IS RELEASED. 
* 
*                IF UNDER KRONOS/NOS THEN THE CURRENT SYSTEM FILE NAME
*                IS ADDED TO TABLE *TSFR*, THE TABLE OF SYSTEM FILES
*                TO BE RETURNED.  LOGIC IS AS FOLLOWS -- IF ROUTINE 
*                *ALF* FINDS THAT THE FILE WAS NOT LOCAL AND WAS
*                FOUND AT *ASSIGN* TIME, THEN THE FILE NAME IS PLACED 
*                IN *FILRTN*, ELSE *FILRTN* LEFT =0 AS INITIALIZED
*                BY *SLD*.  IF ROUTINE *SLDX* FINDS *FILRTN*.NE.0 
*                THEN IT ADDS THE NAME TO TABLE *TSFR* WHICH IS 
*                PROCESSED BY ROUTINE *RSF* AS THE LOADER EXITS.
* 
  
 SLDX     BSS    0
          MX6    0           CLEAR *L2* 
          SA6    L2+1 
          SA6    L1+1        CLEAR *L1* 
          R=     X7,3RCIO    SET FOR USE OF *CIO* 
          SA7    /CCIO/CALL 
          SA1    CMEC 
          MX6    0           CLEAR CM/ECS FLAG
          SA6    A1 
          NZ     X1,SLD      IF SOME CM/ECS-RES PROGRAMS PRESENT
 .10      IFSCOPE 1 
          RJ     RLI         RELEASE LIBRARY INTERLOCK
          EQ     SLD         EXIT 
  
 K        IFNOS 
 FILRTN   CON    0           NAME OF SYSTEM FILE TO BE RETURNED 
 NOSXREF  CON    0           NOS LIB XREF FLAG, 0=XREF, 1=NO XREF 
 K        ENDIF 
 LIBNAME  CON    0           LIBRARY NAME 
*                            42/NAME,18/FLAG(1=USER LIB,2=SYSTEM LIB) 
 FLAGS    CON    0           PL - SATISFYING EXTERNALS
                                   MI - *LIBLOAD* REQUEST 
                                      BIT 0 = 1 IF A PROGRAM CALL 
          IFSCOPE  1
 ULORSL   CON    0           FLAG - USER LIB=0, SYSTEM LIB=1. 
 TIN      CON    0           ADR OF LINKAGE TABLE POINTER WORD
 TOUT     EQU    TPADR       OUTPUT TABLE 
 TSUB     EQU    TSUBST      *SUBST* TABLE
 TPRG     EQU    TUSEP       *USEP* TABLE (EXPLICIT PROGRAMS) 
 L1       EQU    TSCR1       SCRATCH TABLE 1
 L2       EQU    TSCR2       SCRATCH TABLE 2
 L3       EQU    TPADR       SCRATCH TABLE 3
 PNTEND   CON    0           BASE ADDRESS FOR CM-RESIDENT PROGRAMS
 IC       IFCARD
 PROCCD   EQU    6           *EPNT* CODE FOR A PROCEDURE
 NOTCCC   CON    0           SET TO ENTRY NAME IF ENTRY NOT FOUND 
                                    BECAUSE OF NOT CONTROL-CARD-CALLABLE
 IC       ENDIF 
 ERTREP   CON    0           NZ IF ANOTHER *ERT* PASS NECESSARY 
 K        IFNOS 
          SPACE  4
**        RDULIB - READ *ULIB* RECORD, USED FOR KRONOS/NOS ONLY.
* 
*                SUBROUTINE TO ISSUE *READW* FOR *SLD* WHEN 
*                READING KRONOS/NOS *ULIB* RECORD AND TO
*                SETUP POINTERS FOR FAST READ FROM THE CIO
*                BUFFER TO SAVE CP TIME FOR SUBSEQUENT FETCHES. 
* 
*         ENTRY- FET *L* POINTS TO *ULIB* RECORD. 
* 
*         EXIT - NEXT WORD IS READ INTO *T1* IF MORE WORDS AVAILABLE. 
*              - (B6) = FWA OF AVAILABLE WORDS (DOESNT INCLUDE T1). 
*              - (B7) = LWA+1 OF AVAILABLE WORDS. 
* 
*         NOTE - IF *EOR* (END OF *ULIB* RECORD) THEN CONTROL 
*                IS PASSED TO *OUT1*. 
* 
*         USES   X - 1, 2, 3, 7.
*                B - 6, 7.
*                A - 1, 2, 3. 
* 
*         CALLS  RDW=.
  
 RDULIB   PS                 ENTRY/EXIT (*EOR* THEN EXIT TO *OUT1*) 
          READW  L,T1,1 
          NZ     X1,OUT1     IF *EOR* THEN THRU WITH *ULIB* RECORD
          SA1    L+3         *OUT*
          SA2    A1-B1       *IN* 
          SA3    A1+B1       *LIMIT*
          SB6    X1          (B6) = FWA AVAILABLE WORDS 
          IX7    X2-X1       POSITIVE IFF IN.GE.OUT 
          R=     X3,X3-1     LIMIT-1
          AX7    59 
          BX2    -X7*X2 
          BX3    X7*X3
          BX3    X2+X3       IF IN.GE.OUT USE *IN* AS *LIMIT* 
          R=     X1,X1+400B 
          IX7    X3-X1       POSITIVE IFF .GE. 400B WORDS AVAILABLE 
          AX7    59 
          BX1    -X7*X1 
          BX7    X7*X3
          BX3    X1+X7       USE MAX OF 400B WORDS AT A SHOT
          SB7    X3          (B7) = LWA+1 OF AVAILABLE WORDS
          EQ     RDULIB      EXIT 
          SPACE  4
**        BINTIN - INITIALIZE FOR BINARY SEARCH OF *TIN*, USED
*                FOR KRONOS/NOS ONLY. 
* 
*         EXIT - (B5) = FWA-2 OF *TIN*. 
*                (X5) = LENGTH+2 OF *TIN*.
*                (X0) = INITIAL UNDIRECTED DISTANCE FOR SEARCH. 
* 
*         USES   X - 0, 2, 5, 6.
*                B - 2, 3, 5. 
*                A - 2, 5.
* 
*         CALLS  NONE.
  
 BINTIN   PS                 ENTRY/EXIT 
          SA2    TIN         INITIALIZE FOR BINARY SEARCH OF *TIN*
          SA2    X2 
          SA5    A2+B1
          R=     B5,X2-2     (B5) = FWA-2 OF *TIN*
          MX0    1
          PX6    X5 
          R=     B3,48
          NX6    B2 
          SB2    B3-B2
          R=     X5,X5+2     (X5) = LENGTH+2 OF *TIN* 
          LX0    B2          (X0) = INITIAL UNDIRECTED DIST FOR SEARCH
          EQ     BINTIN      EXIT 
 K        ENDIF 
 .11      IFSCOPE 
 SAL      SPACE  4,8
**        SAL - SELECTIVE ADD TO LIST.
* 
*              THIS ROUTINE ADDS AN ENTRY TO A TABLE OF INTEGER VALUES
*         IF THE VALUE OF THE ENTRY IS NOT ALREADY PRESENT.  THE TABLE
*         IS MAINTAINED IN ASCENDING ORDER SO AS TO BE SEARCHED BY A
*         BINARY SEARCH.
* 
*         ENTRY  (X1) = VALUE.
*                (X2) = TABLE POINTER.
*         EXIT   (X2) = MI IF ENTRY ALREADY IN TABLE. 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5.
*                A - 1, 2, 3, 4, 6, 7.
*         CALLS  PBS, ATS=, MVE=. 
  
  
 SAL      PS                 ENTRY/EXIT 
          BX6    X1          SAVE ENTRY VALUES
          LX7    X2 
          SA6    SALS 
          SA7    A6+B1
          RJ     PBS         FIND ENTRY VIA BINARY SEARCH 
          NG     X2,SAL      EXIT IF ENTRY ALREADY IN TABLE 
          SA3    SALS+1      TABLE POINTER
          SB4    X2          SAVE ORDINAL WHERE ENTRY BELONGS 
          SA1    X3+B1
          AX1    1           LENGTH / 2 
          IX1    X2-X1
          NG     X1,SAL1     IF NEW ENTRY FOR LOWER 1/2 OF TABLE
          ALLOC  X3,1        ADD TO END OF TABLE
          SX3    B4          AMOUNT TO MOVE = OLD LENGTH - ORD
          SB3    X2          SAVE TABLE ORIGIN
          IX1    X4-X3
          IX2    X2+X3       FWA MOVE = TABLE FWA + ORD 
          SX3    X2+B1       LWA = FWA + 1
          EQ     SAL2        GO MOVE
  
 SAL1     ALLOC  X3,1,FRONT  ADD TO FRONT OF TABLE
          SX1    B4          AMOUNT TO MOVE = ORD 
          BX3    X2          MOVE FROM FWA+1 TO FWA 
          SB3    X2          SAVE TABLE ORIGIN
          SX2    X2+B1
 SAL2     MOVE   X1,X2,X3 
          SA1    SALS        INSERT NEW ENTRY 
          MX2    0
          BX6    X1 
          SA6    B3+B4
          EQ     SAL         EXIT 
  
 SALS     BSSZ   2           SAVE AREA
 SET      SPACE  4,8
**        SET - SEARCH ERT TABLE. 
* 
*         FOR EACH ENTRY IN *L1* SET BIT 58 OF ITS ERT ENTRY.  WE 
*         ADD ENTRIES TO *L1* ONLY IF THE CORRESPONDING ERT ENTRY IS
*         POSITIVE.  WE KEEP FLAGGING ERT ENTRIES AND ADDING TO *L1*
*         UNTIL THERE ARE NO MORE ENTRIES IN L1.  WE THEN REMOVE
*         DUPLICATES AND SORT *L1* INTO ASCENDING ORDER.  WE HAVE 
*         CHECKED FOR ENTRY POINTS UNDER SUBST CONTROL AND FOR ENTRY
*         POINTS ALREADY KNOWN. 
* 
*         ENTRY  (X2) = FET ADDRESS.
*                (A0) = LENGTH OF EPNT. 
* 
*         CALLS  ADW=, AMU=, SST. 
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
  
  
 SET      PS                 ENTRY/EXIT 
          SA1    X2+B1
          MX5    0           INDEX IN L1 TABLE
          R=     B7,X1-1     FWA-1 OF CIO BUFFER
 SET1     SA2    L1+1 
          SA1    A2-B1
          IX4    X2-X5
          IX3    X1+X5       ADDRESS OF NEXT ENTRY IN L1
          ZR     X4,SET8     IF NO MORE ENTRIES IN L1 
          SA2    X3          L1 ENTRY 
          SX5    X5+B1       INCREMENT L1 INDEX 
          ZR     X2,SET1     IF NO L1 ENTRY 
          SA3    X2+B7       GET ERT ENTRY
          MI     X3,SET7     IF ENTRY ALREADY PROCESSED 
          MX6    1
          BX6    X6+X3
          SA6    A3          SET BIT 59 OF ERT ENTRY
          BX0    X3 
          SB6    B0          BYTE COUNT 
 SET2     LX0    12 
          MX1    -12
          R=     B3,3777B 
          BX1    -X1*X0      ERT ORDINAL
          ZR     X1,SET1     IF NO MORE ENTRIES 
          SX3    A0-B3       EPNT LENGTH - 3777B
          SB2    X1 
          LE     B2,B3,SET3  IF NOT A CONTINUATION BYTE 
          IX1    X1+X3       CONTINUATION BYTE + EPNT LENGTH - 3777B
          SA3    X1+B7       GET CONTINUATION WORD
          BX0    X3          ERT ENTRY
          SB6    B0          BYTE COUNT 
          EQ     SET2 
  
 SET3     SA3    X1+B7
          SB6    B6+B1       INCREMENT BYTE COUNT 
          MI     X3,SET6     IF ENTRY ALREADY PROCESSED 
          SA2    L3 
          SA3    A2+B1
          IX3    X2+X3       LWA+1 OF L3
          SB2    X2          FWA OF L3
          SB3    X3          LWA+1
          SB4    B1+B1
 SET4     EQ     B2,B3,SET5  IF NO MORE IN L3 TO SEARCH 
          SA2    B2 
          IX3    X2-X1
          SB2    B2+B4
          NZ     X3,SET4     IF NO MATCH
          SA4    A2+B1
          ZR     X4,SET6     IF SECOND ENTRY POINT NOT IN LIB 
          BX1    X4 
 SET5     SX2    L2 
          RJ     PBS         BINARY SEARCH L2 
          MI     X2,SET6     IF ENTRY ALREADY KNOWN 
          SA2    L1 
          RJ     ADW=        ADD ONE WORD TO L1 
          SA1    L+1
          R=     B7,X1-1     RESET FWA-1 OF BUFFER
 SET6     R=     X4,B6-5
          NZ     X4,SET2     CONTINUE ONTO NEXT BYTE
          EQ     SET1        GET NEXT L1 ENTRY
  
 SET7     MX7    0
          SA7    A2          CLEAR THIS L1 ENTRY
          EQ     SET1        GO TO NEXT L1 ENTRY
  
 SET8     SB2    X1          FWA OF L1
          SB3    X2          LENGTH OF L1 
          SB4    B0 
          SB5    B0          LAST GOOD ENTRY IN L1
 SET9     EQ     B4,B3,SET10 IF NO MORE ENTRIES IN L1 TO EXAMINE
          SA1    B2+B4       REMOVE ALL ZERO ENTRIES IN L1
          SB4    B4+B1
          ZR     X1,SET9     IF  THIS ENTRY ZERO
          BX6    X1 
          SA6    B2+B5       MOVE THIS ENTRY
          SB5    B5+B1
          EQ     SET9 
  
 SET10    RJ     AMU=        ACCUMULATE MEMORY USED 
          SA2    L1 
          SX6    B5 
          SB7    X2 
          SX1    B5          LENGTH OF TABLE
          SA6    A2+B1       RESET NEW L1 LENGTH
          RJ     SST         SHELL SORT TABLE 
          EQ     SET         RETURN 
 SST      SPACE  4
**        SST - SORTS A TABLE INTO ASCENDING ORDER. 
* 
*         ALL ELEMENTS SHOULD BE OF THE SAME SIGN.
*         ORIGIN OF TECHNIQUE IS CACM VOL 6 NUMBER 5  MAY 1963, P209. 
*         FIRST CODED BY R. HOTCHKISS IN *SORT1*. 
*         REVISED BY L. A. LIDDIARD.
*         E. J. MUNDSTOCK.  70/10/07. 
*         UNIVERSITY OF MINNESOTA.
* 
*         ENTRY  (B7) = ADDRESS OF TABLE TO BE SORTED.
*                (X1) = NUMBER OF ELEMENTS IN ARRAY.
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5.
*                A - 1, 2, 6, 7.
  
  
 SST1     SA7    B5-B4       T(J+K) = S 
          SB2    B2+B1       I = I+1
          EQ     B2,B3,SST4  IF END OF TABLE
 SST2     SA2    B2          S = T(I) 
          NO
          SB5    B2+B4       J = I-K
          BX7    X2 
 SST3     SA1    B5          T(J) 
          IX3    X2-X1       COMPARE S AND T(J) 
          PL     X3,SST1     IF ELEMENTS IN ORDER 
          BX6    X1          T(J+K) = T(J)
          SB5    B5+B4       J = J-K
          SA6    A1-B4
          GE     B5,B7,SST3  IF J " FIRST 
          EQ     SST1 
  
 SST4     AX4    1           K = K/2
          NO
          SB4    X4          (B4) = -K
          SB2    B7-B4       I = FIRST+K
          NZ     X4,SST2     IF K " 0 
  
 SST      PS                 ENTRY/EXIT 
          MX4    12          K = 2**(ENTIER(LOG2(COUNT)+1)
          SB3    B7+X1       (B3) = LAST+1
          NX6,B2 X1 
          AX4    X4,B2
          EQ     SST4        ENTER SORT LOOP
 PBS      SPACE  4,8
**        PBS - PERFORM BINARY SEARCH.
* 
*              THIS ROUTINE PERFORMS A BINARY SEARCH ON A MANAGED 
*         TABLE OF ONE WORD ENTRIES.
* 
*         ENTRY  (X1) = WORD TO SEARCH FOR. 
*                (X2) = TABLE POINTER.
*         EXIT   (X2) = IF ENTRY NOT FOUND - TABLE ORDINAL (LOWEST = 0) 
*                                            AT WHICH ENTRY BELONGS.
*                       IF ENTRY FOUND     - COMPLEMENT OF THE ORDINAL
*                                            OF THE ENTRY.
*         USES   X - 2, 3, 4, 6, 7. 
*                B - 2, 3.
*                A - 2, 3.
  
  
 PBS2     SX2    B2 
          PL     X6,PBS      IF ENTRY GOES HERE 
          SX2    B2-B1
  
 PBS      PS                 ENTRY/EXIT 
          SA3    X2 
          SA2    X2+B1
          MX7    13 
          NX6,B2 X2 
          ZR     X2,PBS      IF TABLE EMPTY 
          SX4    X2+B1       (X4) = LENGTH + 1
          AX2    X7,B2       -ENTIER(LOG2(LENGTH))+1
          SB3    X3 
          BX7    -X2
          SA3    X7+B3       FIRST TRY
          SX7    X7+B1
          IX6    X3-X1
          AX7    1
          ZR     X6,PBS      IF A MATCH 
          AX6    59 
          SB3    B3-B1       (B3) = FWA-1 OF TABLE
          BX2    X6*X4
          SB2    X2          (B2) = 0 OR LENGTH+1 
 PBS1     AX6    59 
          BX2    X6-X7
          ZR     X7,PBS2     IF ENTRY NOT IN TABLE
          SB2    X2+B2
          AX7    1
          SA3    B2+B3       NEXT MIDPOINT
          IX6    X1-X3       COMPARE
          NZ     X6,PBS1     IF NO MATCH
          SX2    B2-B1
          BX2    -X2
          EQ     PBS
 .11      ENDIF 
 IDR      SPACE  4,8
**        IDR - INITIALIZE DIRECTORY READ.
* 
*              THIS ROUTINE NEEDED UNDER SCOPE ONLY.
* 
*              THIS ROUTINE INITIALIZES THE *FET* NAMED *L* FOR EITHER
*         THE INITIAL ACCESS OF A LIBRARY VIA *LDL*, OR FOR THE READING 
*         OF ONE OF THE FOUR DIRECTORY RECORDS.  IN THE LATTER CASE, THE
*         READ IS INITIATED.
* 
*         ENTRY  (B7) = -1 IF TO SET UP FOR THE LDL(142) REQUEST. 
*                        0 IF TO SET UP FOR READ OF *EPNT*. 
*                        1 IF TO SET UP FOR READ OF *ERT*.
*                        2 IF TO SET UP FOR READ OF *PNUT*. 
*                        3 IF TO SET UP FOR READ OF *PNT*.
*         EXIT   AS DESCRIBED ABOVE.
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2. 
*                A - 1, 2, 3, 4, 6, 7.
*         CALLS  WNB=, SETFET=, CIO=. 
  
  
 IDR      PS                 ENTRY/EXIT 
 .8       IFSCOPE 
          SX2    L           (X2) = *FET* ADDRESS 
          MX7    42 
          SA4    X2          (X1) = FILE NAME 
          LT     B7,B1,IDR1  IF FILE CANNOT BE ACTIVE 
          RECALL X2          WAIT NOT BUSY
 IDR1     BX1    X7*X4
          MX3    1
          SETFET X2,A1,BINARY      INITIALIZE *FET* 
          SA1    X2+B1       SET RANDOM BIT 
          LX3    -59+47 
          BX6    X1+X3
          SA6    A1 
          SX7    INDEX       SET INDEX FWA AND LENGTH IN FET(7) 
          R=     X6,INDEXL
          LX6    18 
          BX6    X6+X7
          SA6    L+7
          MI     B7,IDR      IF 1ST CALL FOR THIS LIBRARY 
          SA3    B7+DIRNAME  INDICATE NAME OF DIRECTORY RECORD
          BX7    X3          CURRENTLY BEING READ 
          MX1    42 
          SA7    PN 
          SA4    B7+INDEX    SET UP RECORD REQUEST FOR THE CASE 
          BX7    -X1*X4      OF IT BEING DISK-RESIDENT
          SA7    A6-B1       FET(6) 
          SA1    =0LZZZZZ0   COMPARE 1ST 6 CHARS OF LFN IN
          SA3    X2          FET(0) WITH *ZZZZZ0* 
          BX7    X1-X3
          SA1    INDEX+4     CHECK RESIDENCY FROM LNT(0)
          AX7    24 
          LX1    59-0        BIT 0 SET IF CM-RESIDENT 
          NZ     X7,IDR6     IF NOT A SYSTEM LIBRARY
          PL     X1,IDR3     IF NOT CM-RESIDENT 
          MX3    -18         (X6) = FWA OF DIRECTORY RECORD 
          AX4    18 
          BX6    -X3*X4 
          SB2    -B7
          SA1    A1+B1       WORD WITH LENGTHS OF DIRECTORY RECS
          ZR     B2,IDR2     IF *EPNT*
          AX1    18 
          SB2    B2+B1
          ZR     B2,IDR2     IF *ERT* 
          MX3    -12
          AX1    18 
          SB2    B2+B1
          ZR     B2,IDR2     IF *PNUT*
          AX1    12 
 IDR2     BX4    -X3*X1      LENGTH OF DIRECTORY RECORD 
          IX4    X4+X6       LWA+1 OF DIRECTORY RECORD
          LX4    36          FORM 6/0,18/LWA,18/0,18/FWA
          BX6    X6+X4
          SA6    A7          SET CM LIMITS IN FET(6)
          R=     X7,3RLDL    SET TO USE *LDL* 
          SA7    /CCIO/CALL 
          READ   X2,RCL      ISSUE WITH RECALL IF BY *LDL*
          EQ     IDR         EXIT 
  
 IDR3     LX1    0-1         BIT 1 SET IF ECS-RESIDENT
          MI     X1,IDR4     IF ECS-RESIDENT
          LX1    1-3
          R=     X7,1R3      SET *ZZZZZ03*
          MI     X1,IDR5     IF ON *ZZZZZ03*
          SX7    X7+B1       SET *ZZZZZ04*
          EQ     IDR5 
  
 IDR4     AX4    18+18       SET ECS DESCRIPTOR IN FET(6) 
          R=     X7,1R6      SET *ZZZZZ06*
          MX6    -24
          BX6    -X6*X4 
          SA6    A7 
 IDR5     MX1    -6          INSERT 7TH CHAR OF FILE NAME 
          SA3    X2          OF SYSTEM LIBRARY
          LX1    6*3
          LX7    6*3
          BX6    X1*X3
          IX6    X6+X7
          SA6    A3 
 IDR6     R=     X7,3RCIO    SET TO USE *CIO* 
          SA7    /CCIO/CALL 
          READ   X2          INITIATE READ OF DIRECTORY RECORD
 .8       ENDIF 
          EQ     IDR         EXIT 
  
          RELOC  OFF
 INDEX    BSSZ   4           WORDS 1-4 OF *LNT* ENTRY 
          BSSZ   1           WORD 0 OF *LNT* ENTRY
          BSSZ   1           WORD WITH LENGTHS IF CM-RESIDENT 
 INDEXL   EQU    *-INDEX     1ST 4 WORDS ONLY ARE USED IF USER LIB
 DIRNAME  VFD    60/6L(EPNT) NAMES OF DIRECTORY RECORDS 
          VFD    60/5L(ERT) 
          VFD    60/6L(PNUT)
          VFD    60/5L(PNT) 
 CMEC     CON    0           NZ IF ANY CM OR ECS-RES PROGRAMS 
          RELOC  ON 
 AJAX     SPACE  4,8
**        AJAX - RETURN PNT INFORMATION.
* 
*              THIS ROUTINE NEEDED UNDER SCOPE ONLY.
* 
*              THIS ROUTINE FORMS *TOUT* ENTRIES OF THE FORMAT
*         DESCRIBED IN THE ENTRY INFORMATION OF THE ROUTINE *LLP*.
*         IF NOT SATISFYING EXTERNALS, IT ALSO UPDATES THE LOCATION 
*         *PFL* WITH THE MAXIMUM VALUE FOR THE EXECUTION FIELD LENGTH 
*         ENCOUNTERED IN THE PNT ENTRIES OF THE PROGRAMS TO BE LOADED.
*         IF IN A CONTROL CARD LOAD THIS ROUTINE SETS UP THE FOL
*         RANDOM ADDRESS AND FILE SPECIFICATION ENTRIES IF THEY 
*         HAVE NOT ALREADY BEEN INITIALIZED.  THIS IS DONE IN CASE
*         THE LOAD IS OF A (0,0) OVERLAY WITH A FOL DIRECTORY.  THE 
*         INFO WILL BE USED LATER BY *OVL54*. 
* 
*         ENTRY  (B6) = ADDRESS+1 OF 2ND WORD OF PNT ENTRY. 
*                FILE NAME OF THE LIBRARY BEING READ IS IN THE FET. 
*         EXIT   (X6) = COMPLETED ENTRY.
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 6. 
*                A - 1, 2, 3, 4, 6, 7.
*         CALLS  NONE.
  
  
 S        IFSCOPE 
 AJAX     PS                 ENTRY/EXIT 
          SB6    B6-B1
          MX4    36 
          IFCARD 1
          SA3    FLAGS       CHECK TYPE OF LIBRARY SEARCH 
          SA1    B6-B1       1ST WORD OF PNT ENTRY
 IC       IFCARD
          PL     X3,AJAX1    IF SATISFYING EXTERNALS
          SX7    X1          CHECK IF CAPSULE ENTRY 
          MI     X7,AJAX1     IF CAPSULE ENTRY
          SA3    PFL         UPDATE MAXIMUM EXECUTION FL
          MX7    -12
          BX6    -X7*X1 
          IX3    X3-X6
          PL     X3,AJAX1    IF NEW ONE NOT BIGGER
          SA6    A3 
 AJAX1    BSS    0
          SA3    FOLRA
          NZ     X3,AJAX1B   IF FOL RANDOM ADDRESS ALREADY SET
          SA2    B6          2ND WORD OF PNT ENTRY
          BX3    X1          1ST WORD OF PNT ENTRY
          SX2    X2          (X2) = 42/0, 18/PRU
          LX3    59-12       IF FROM ZZZZZ03 THEN NEGATIVE
          LX2    18          (X2) = 24/0, 18/PRU, 18/0
          BX7    X2 
          SA7    A3          SET FOLRA WITH FOL RANDOM ADDRESS WORD 
          SA2    Z04FSE      SET FOR ZZZZZ04
          PL     X3,AJAX1A   IF FROM ZZZZZ04
          SA2    Z03FSE      SET FOR ZZZZZ03
 AJAX1A   SA3    ULORSL      CHECK IF USER LIBRARY
          NZ     X3,AJAX1B   IF SYSTEM LIBRARY
          SA2    LIBNAME     USER LIBRARY NAME
 AJAX1B   BX7    X2 
          SA7    FOLFS       SET FOL FILE SPEC ENTRY
 IC       ENDIF 
          SA2    L           CHECK FILE NAME FOR THE UPPER 36 BITS
          SA3    =0LZZZZZ0   WHICH REPRESENT A SYSTEM LIBRARY 
          MX7    0           FLAG FOR USER LIBRARY
          BX2    X4*X2
          LX1    59-14       ECS RESIDENT BIT TO SIGN POSITION
          IX3    X2-X3
          SA4    B6          2ND WORD OF PNT ENTRY
          NZ     X3,AJAX2    IF USER LIBRARY
          LX2    X1,B1       CM RESIDENT BIT TO SIGN POSITION 
          R=     X7,6        FLAG FOR *ZZZZZ06*  (ECS)
          MX6    -24         ECS MASK 
          NG     X1,AJAX3    IF ECS RESIDENT
          MX6    -18         CM MASK
          LX1    2           EXTEND FILE FLAG BIT TO SIGN POSITION
          NG     X2,AJAX5    IF CM RESIDENT 
          AX7    1           FLAG FOR *ZZZZZ03* 
          NG     X1,AJAX2    IF PROGRAM ON *ZZZZZ03*
          SX7    X7+B1       FLAG FOR *ZZZZZ04* 
 AJAX2    MX2    -18         EXTRACT DISK ADDRESS 
          BX6    -X2*X4 
          EQ     AJAX4
  
 AJAX3    LX4    24          EXTRACT ECS ADDRESS
          SA7    CMEC        FLAG NON-DISK-RESIDENT PROGRAM 
          BX6    -X6*X4 
 AJAX4    AX3    X0,B1       MERGE PNT ORDINAL  (0, 1, 2..., ETC.)
          LX3    36 
          BX6    X3+X6
          LX7    54          MERGE LIBRARY NAME INDICATOR 
          BX6    X7+X6
          EQ     AJAX        EXIT 
  
 AJAX5    SA7    CMEC        FLAG NON-DISK-RESIDENT PROGRAM 
          SA1    PNTEND      PNT FWA
          LX4    24 
          BX3    -X6*X4      EXTRACT RELATIVE FWA 
          MX7    1           FLAG FOR CM RESIDENT 
          LX4    18          EXTRACT LENGTH 
          IX3    X1+X3       ABSOLUTE FWA 
          BX2    -X6*X4 
          IX2    X3+X2       ABSOLUTE LWA+1 
          LX2    36 
          BX2    X3+X2       FWA AND LWA+1
          IX6    X2+X7       COMPLETE 
          EQ     AJAX        EXIT 
 S        ENDIF 
  
          QUAL
 SLD=     EQU    /SLD/SLD 
 LLP      TITLE  LOAD COMPLETION SUBROUTINE - LOAD LIBRARY PROGRAMS.
**        LLP - LOAD LIBRARY PROGRAMS.
* 
*              THIS ROUTINE LOADS THE LIBRARY PROGRAMS WHICH WERE FOUND 
*         DURING THE LAST EXECUTION OF THE ROUTINE *SLD=*.  THE *CIO* 
*         FUNCTION *READLS* IS USED TO LOAD ALL EXCEPT THE CM-RESIDENT
*         ROUTINES. 
* 
*         ENTRY  (X1) = LIBRARY NAME. 
*                TABLE *TPADR* CONTAINS ONE-WORD ENTRIES WHICH DESIGNATE
*                   THE PROGRAMS TO BE LOADED.  THESE ENTRIES ARE OF TWO
*                   POSSIBLE FORMATS:                                          .
* 
*                   FORM 1:   VFD   1/0,5/N,6/0,12/K,12/0,24/ADR
* 
*                   N   = 0 IF THE LIBRARY IS A USER LIBRARY. 
*                           THE LFN TO USE IS THE LIBRARY NAME. 
*                       " 0 IF THE LIBRARY IS A SYSTEM LIBRARY. 
*                           THE LFN TO USE IS *ZZZZZ0N*.
*                           (CURRENTLY N MUST BE 3, 4, OR 6.) 
*                   K   = PNT ORDINAL OF PROGRAM.  (0 FOR 1ST ENTRY,
*                         1 FOR 2ND, ETC.). 
*                   ADR = 18-BIT MASS-STORAGE PRU ADDRESS OR 24-BIT ECS 
*                         DESCRIPTOR ADDRESS. 
* 
*                   FORM 2:   VFD   1/1,5/0,18/LWA,18/0,18/FWA
* 
*                   LWA = LWA+1 (RELATIVE TO START OF PNT) OF 
*                         CM-RESIDENT PROGRAM BODY. 
*                   FWA = FWA (RELATIVE TO START OF PNT) OF 
*                         CM-RESIDENT PROGRAM BODY. 
* 
*                   NOTES 
* 
*                   1) THE TWO FORMATS MAY BE INTERMIXED. 
*                   2) ALL ENTRIES OF FORM 1 ARE IN ASCENDING ORDER AS
*                      THEY RESIDE IN THE PNT.
*                   3) THE OPTIMIZING OF THE LIST ENTRIES FOR THE 
*                      *READLS* CALLS IS BASED ON THE ASSUMPTION THAT 
*                      THE DISK ADDRESSES WITHIN ALL THE ENTRIES FOR
*                      EACH OF THE THREE POSSIBLE SYSTEM LIBRARY FILES
*                      (OR A USER LIBRARY FILE) ARE IN ASCENDING ORDER. 
* 
*         EXIT   PHYSICAL LOADING OF THE SPECIFIED PROGRAMS IS COMPLETE.
*         USES   ALL REGISTERS EXCEPT B1. 
*         CALLS  SETFET=, CIO=, RDW=, /READ/RDR, CPR. 
* 
* 
*         +++ *LLP* PROCEDURE +++ 
* 
*         --   THE LIBRARY NAME IS ENTERED IN THE FILE TABLE *TLFN*.
* 
  
  
 LLP      PS                 ENTRY/EXIT 
          SA5    TPADR
          SA4    A5+B1
          MX6    0
          ZR     X4,LLP      EXIT IF NO PROGRAMS TO LOAD
          BX7    X1          SAVE LIBRARY NAME
          SX2    B1+B1       SET AS SYSTEM LIBRARY
          IFSCOPE 1 
          SA6    LLFG        SET FLAG TO ADVANCE *LLCTL*
          SA6    PN          CLEAR MISLEADING PROGRAM NAME
          SA3    LLCTL+1     RESET *LLCTL*
          BX6    X3          (LIBRARY FILE CONTROL WORD)
          SA6    A3-B1
          SA7    LLLIB
          IFSCOPE 
          ADDWRD TLFN,X7+X2  ENTER NAME AND FLAG IN *TLFN*
          ELSE   1
          ADDWRD TLFN,X7     ENTER NAME AND FLAG IN *TFLN*
          SA4    FI          ADVANCE FILE INDEX 
          SX7    X4+B1
          SA7    A4 
 .5       IFSCOPE 
  
**        --   A PRE-SCAN OF *TPADR* IS MADE TO DETERMINE IF ANY
*              CM-RESIDENT PROGRAMS ARE PRESENT.  SUCH ENTRIES ARE THE
*              ONLY ONES WITH BIT 59 = 1.  NOTE THAT THIS STEP EXISTS 
*              ONLY TO SAVE SOME CPU TIME FOR THE MOST COMMON CASE WHICH
*              IS NO CM-RESIDENT PROGRAMS.
* 
  
          SA1    A5          STORE NG WORD AT FWA-1 
          SB2    -B1
          MX6    1
          SA2    A1+B1       (B3) = LENGTH - 1
          SA6    X1+B2
          SB3    X2+B2
 LLP1     SA4    X1+B3       LOOP UNTIL NG WORD 
          SB3    B3-B1
          PL     X4,LLP1
          SB3    B3+B1
          MI     B3,LLP5     IF NO CM-RESIDENT PROGRAMS 
  
**        --   NOW THAT IT IS KNOWN THAT THERE ARE ONE OR MORE
*              CM-RESIDENT PROGRAMS, ONE PROGRAM AT A TIME IS REMOVED 
*              FROM *TPADR*.  IT IS THEN LOADED BY CALLING *LDL* TO 
*              PERFORM CIRCULAR I/O LIKE *CIO*, EXCEPT THAT THE INPUT IS
*              READ FROM CM.
* 
  
          R=     X6,3RLDL    SET TO USE *LDL* FOR I/O 
          SA6    /CCIO/CALL 
 LLP2     SA2    TPADR       (X2) = FWA *TPADR* 
          SA4    A2+B1       (X4) = LWA+1 *TPADR* 
          IX3    X2+X4       (X3) = LWA+1 *TPADR* 
          MX6    1           STORE NG WORD AT LWA+1 
          SA6    X3 
          R=     A5,X2-1     (FIRST ENTRY) - 1
 LLP3     SA5    A5+B1       NEXT ENTRY 
          MX7    0
          PL     X5,LLP3     LOOP TO NG ENTRY 
          ZR     X5,LLP3     SKIP -0 WORDS
          SB3    A5          CHECK IF NG WORD AT END REACHED
          SB2    X3 
          SA7    A5 
          MX4    6
          EQ     B2,B3,LLP4  IF NO MORE CM-RESIDENT PROGRAMS
          SA1    LLLIB       (X1) = LIBRARY NAME
          BX5    -X4*X5      (FET+6) FOR *LDL*
          SETFET L,A1,BINARY INITIALIZE FET 
          SX6    B1          ADD RANDOM BIT 
          BX7    X5 
          LX6    47-0 
          SA1    X2+B1
          SA7    L+6         STORE (FET+6) FOR *LDL*
          BX6    X1+X6
          SA6    A1 
          READ   L           INITIATE READ BY *LDL* 
          READO  L           GET 1ST WORD 
          BX5    X6 
          SA6    T1          GO PERFORM LOAD OF THIS PROGRAM
          RJ     /READ/RDR
          EQ     LLP2        LOOP FOR ALL CM-RESIDENT PROGRAMS
 .5       ENDIF 
  
 LLP4     R=     X6,3RCIO    RESTORE READ CONTROL TO USE *CIO*
          SA6    /CCIO/CALL 
  
**        --   THE *READLS* HANDLING OF ALL THE REMAINING PROGRAMS
*              BEGINS AT THIS POINT.  THE FOLLOWING STEPS MUST BE 
*              PERFORMED FOR EACH OF THE POSSIBLE FILES ON WHICH LIBRARY
*              PROGRAMS MAY RESIDE.  THEY ARE FIRST PERFORMED FOR FILE
*              *ZZZZZ04*, THE MAIN RMS-RESIDENT SYSTEM FILE; THEN FOR 
*              *ZZZZZ06*, THE FILE CONTAINING ANY ECS-RESIDENT PROGRAMS;
*              AND FINALLY FOR *ZZZZZ03*, THE FILE FOR ANY RMS-RESIDENT 
*              PROGRAMS ADDED BY SYSTEM *EDITLIB*.
* 
  
          SA1    TPADR       SHORTEN *TPADR* BY REMOVING ALL
          SX4    B1          ZERO-WORDS 
          SA2    A1+B1       (X2) = LENGTH
          SB2    X1          (B2) = FWA 
          SB3    X1          (B3) = STORE POINTER 
          SB4    X1          (B4) = FETCH POINTER 
 LLP4A    SA3    B4          NEXT ENTRY 
          IX2    X2-X4
          ZR     X3,LLP4B    IF TO BE DISCARDED 
          BX7    X3          STORE ENTRY
          SA7    B3 
          SB3    B3+B1       ADVANCE STORE POINTER
 LLP4B    SB4    B4+B1       ADVANCE FETCH POINTER
          NZ     X2,LLP4A    LOOP 
          SX6    B3-B2       SET NEW LENGTH 
          SA6    A2 
          ZR     X6,LLP15    IF ALL PROGRAMS LOADED 
  
**          1) THE SPACE TO BE USED FOR THE LIST PASSED TO THE *READLS* 
*              REQUEST IS TAKEN FROM THE UPPER END OF THE BUFFER.  THIS 
*              AREA IS CHOSEN BECAUSE IT MUST BE IN AN AREA THAT DOES 
*              NOT MOVE AROUND, AS IT WOULD IF A MANAGE TABLE WERE
*              USED.  THE AMOUNT OF SPACE ALLOCATED FOR THIS PURPOSE
*              IS THE LESSER OF (1) THE SIZE OF *TPADR*, AND (2) THE
*              VALUE *IP.RDLS*. 
* 
  
 LLP5     SA2    TPADR+1     SET LIST LENGTH
          R=     X7,IP.RDLS  = MIN[(*TPADR* LENGTH),*IP.RDLS*]
          IX6    X7-X2
          MI     X6,LLP6
          SX7    X2 
 LLP6     SA5    LLFG 
          NZ     X5,LLP7     IF LAST FILE NOT EXHAUSTED 
          SA4    LLCTL       PICK UP INDICATOR OF NEXT FILE TO USE
          MX3    6
          LX4    6
          BX0    X3*X4       (X0) = N FOR *ZZZZZ0N* 
          BX6    X4 
          SA6    A4 
 LLP7     SA7    T1          SET *LIMIT* IN *FET* DOWN BY 
          SA1    L+1         (LIST LENGTH) + 1
          R=     X1,X1+IP.LBUF
          SX7    X7+B1
          IX6    X1-X7
          SA6    L+4
          SB4    X6          (B4) = LIST STORE POINTER
  
**          2) ENTRIES WITHIN THE SAME LIBRARY FILE WHICH WERE FROM 
*              ADJACENT PNT ENTRIES ARE STAGGERED IN THE *READLS* LIST
*              DUE TO THE POSSIBILITY OF LOSING REVOLUTIONS WHILE THE 
*              STACK PROCESSOR IS READING THEM.  AS A RESULT, THE LIST
*              IS BUILT BY MOVING SELECTED ENTRIES FROM *TPADR* TO THE
*              AREA ALLOCATED FOR THE LIST, SO AS TO STAGGER.  AS 
*              ENTRIES ARE ADDED, THEY ARE SET TO -0 IN *TPADR*.
* 
  
 LLP8     SA5    TPADR       (B6) = *TPADR* FETCH POINTER 
          SA2    A5+B1       (B7) = *TPADR* LWA+1 
          SB3    -B1         (B3) = PREVIOUS ORDINAL FOR COMPARE
          SB6    X5 
          IX3    X5+X2
          SB5    B0          (B5) = 0 MEANS NO ENTRIES THIS FILE
          SB3    B3-B1
          MX5    30          (X5) = NG MEANS TO INSERT
          SB7    X3 
          MX7    6
          SA2    B6          LOOK AT FILE INDICATOR IN 1ST ENTRY
          BX6    X7*X2
          NZ     X6,LLP9     IF NOT USER LIBRARY
          MX0    0           FORCE MATCH ON FILE CHECK
          IFSCOPE 
          SA2    TLFN        MODIFY LAST *TLFN* ENTRY TO
          SA3    FI          INDICATE USER LIBRARY
          MX6    42 
          IX2    X2+X3
          SX4    B1 
          SA2    X2 
          BX6    X6*X2
          IX6    X6+X4
          SA6    A2 
          ENDIF 
 LLP9     NE     B6,B7,LLP10 IF NOT AT END OF *TPADR* 
          NZ     B5,LLP8     IF NOT DONE WITH THIS FILE 
          MX7    0           INDICATE READY FOR NEXT FILE 
          EQ     LLP10D      GO ISSUE *READLS*
  
 LLP10    SA2    B6          NEXT *TPADR* ENTRY 
          MX7    6
          BX3    X7*X2       ISOLATE FILE INDICATOR 
          SB6    B6+B1       ADVANCE FETCH POINTER
          ZR     X2,LLP9     IF -0 ENTRY
          IX3    X0-X3
          NZ     X3,LLP9     IF ENTRY NOT ON DESIRED FILE 
          MX1    -24         (X1) = ADDRESS 
          BX1    -X1*X2 
          SB5    B1          INDICATE SOMETHING FOUND THIS FILE 
          LX2    6+6+12      COMPARE PNT ORDINAL WITH LAST ONE
          SB2    X2 
          SX4    X2 
 .13      IFSCOPE 1 
          LX1    36          POSITION ADDRESS 
          SB2    B2-B3
          SB3    X4          UPDATE LAST PNT ORDINAL WITH CURRENT 
          NE     B2,B1,LLP10A      IF NOT CONSECUTIVE WITH LAST 
          LX5    30          SET TO STORE IN THE OTHER TABLE
 LLP10A   PL     X5,LLP9     IF NOT TO PUT IN LIST
          MX7    60          SET *TPADR* ENTRY TO -0
          SA7    A2 
          BX6    X1          STORE IN LIST
          SA6    B4 
          SB4    B4+B1
          SA2    T1          REDUCE LIST LENGTH 
          SX7    B1 
          IX6    X2-X7
          SA6    A2 
          NZ     X6,LLP9     IF LIST AREA NOT FULL
 LLP10D   SA7    LLFG        SET COMPLETE - NOT COMPLETE FLAG 
          MX6    0           SET ZERO WORD AT END OF LIST 
          SA6    B4 
          SA1    L+4         (B2) = LIST FWA
          SB2    X1 
          EQ     B2,B4,LLP5  IF NOTHING ADDED TO LIST 
  
**          3) ON NOS, IF THIS IS THE FIRST PROGRAM LOADED, AND THE 
*              LIBRARY IS AN EXECUTE-ONLY FILE, EXECUTE-ONLY
*              ACCESS IS BLOCKED BY LIMITING IT TO THIS FILE. 
*              FOR ALL TYPE FILES, *SSJ=* IS DISABLED.
* 
  
          SA4    LLLIB       FILE NAME = LIB NAME IF USER LIB 
          SA1    =0LZZZZZ00  FORM NAME FOR SYSTEM FILE
          LX0    6+18 
          IX1    X1+X0
          SX3    B1 
          NZ     X0,LLP11    IF NOT USER LIBRARY
          BX1    X4 
 IC       IFCARD
 K        IFNOS 
          SA4    PC 
          NZ     X4,LLP11    IF SOMETHING ALREADY LOADED
          BX5    X1          (X5) = FILE NAME 
          SETFET L,A1,BINARY
          STATUS L,POS       RETRIEVE *FNT* ENTRY 
          SA4    L+5         ISOLATE FILE TYPE
          LX4    59-14
          PL     X4,LLP10E   IF NOT EXECUTE-ONLY FILE 
          LX4    14-59-6     CHECK FOR DIRECT-ACCESS P.F. 
          MX1    -6 
          BX1    -X1*X4 
          LD     X2,X1-PMFT 
          ZR     X2,LLP10G   IF DIRECT-ACCESS P.F.
          LD     X2,X1-LOFT 
          NZ     X2,LLP10E   IF NOT LOCAL FILE
 LLP10G   BSS    0
          SX6    B1          INDICATE EXECUTE-ONLY FILE LOAD
          SA6    XEQOF
          SETLFE L           LIMIT EXECUTE ONLY ACCESS TO THIS FILE 
          MX7    -8 
          SA4    L           CHECK ERROR CONDITION
          LX4    8-18 
          BX7    -X7*X4 
          ZR     X7,LLP10E   IF NO ERROR CONDITION
          ERROR  CAT,(=C/LOCAL FILE LOAD OF EXECUTE-ONLY FILE NOT ALLOWE
,D/)
 LLP10E   SA1    NAMCALL
          SA2    NODISSJ     NZ IF NOT TO ISSUE *DISSJ* 
          BX1    X1+X2
          NZ     X1,LLP10F   IF THIS IS A SINGLE CARD NAME CALL LOAD
          DISSJ              DISABLE *SSJ=* PRIVILEGES
 LLP10F   BX1    X5          (X1) = FILE NAME 
 K        ENDIF 
 IC       ENDIF 
  
**          4) THE FET IS INITALIZED FOR THE *READLS* FUNCTION.  IN 
*              ADDITION TO THE FUNCTIONS PERFORMED BY THE ROUTINE 
*              *SETFET*, THE RANDOM BIT IS SET AND THE FWA OF THE 
*              LIST IS STORED.
  
 LLP11    LX3    47-0 
          SETFET L,A1,BINARY
          SA1    X2+B1       ADD RANDOM BIT 
          SX7    B2 
          BX6    X1+X3
          SA6    A1 
 .11      IFNOS 
          SA7    L+5         SET *READLS* LIST POINTER
 .11      ELSE
          SA7    L+6         SET *READLS* LIST POINTER
 .11      ENDIF 
  
**          4) THE *READLS* FUNCTION IS INITIATED, AND THE ROUTINE
*              *RDR* IS CALLED TO PERFORM THE LOADING.
* 
  
 LLP12    READLS L           START *READLS* 
          READO  L           GET FIRST WORD 
          SA6    T1 
          ZR     X1,LLP14    MUST NOT BE EOR/EOF
 LLP13    SA2    LLLIB
          SX3    =C* SYSTEM ERR, EOI ON LIBRARY - XXXXXXX*
          BX7    X2 
          R=     A7,X3+3     STORE LIBRARY NAME IN MESSAGE
          ERROR  CAT,X3 
  
 LLP14    SA5    T1          PERFORM LOAD 
          RJ     /READ/RDR
 .12      IFSCOPE 
          NG     X1,LLP13    MUST NOT BE EOI
          SA3    L+6         CHECK PROGRESS OF LIST POINTER 
          IFCARD  2 
          SA2    DEFER
          NZ     X2,LLP4     IF A DEFERRED LOAD 
          SA5    X3 
          NZ     X5,LLP12    IF *READLS* NOT COMPLETED
          EQ     LLP4        END OF MAIN *READLS* LOOP
 .12      ELSE
          SA3    L+5         CHECK *READLS* LIST POINTER
          SA5    X3 
          ZR     X5,LLP4     IF *READLS* COMPLETED
          MI     X1,LLP13    IF EOF/EOI ERROR 
          IFCARD  2 
          SA2    DEFER
          NZ     X2,LLP4     IF A DEFERRED LOAD 
          EQ     LLP12       LOOP 
 .12      ENDIF 
  
**        --   AT THIS POINT, ALL LIBRARY PROGRAMS HAVE BEEN LOADED.
*              UNLESS THIS IS A DEFERRED LOAD, THE BUFFER IS SET
*              BACK TO ITS NORMAL LENGTH.  THEN *CPR* IS CALLED FOR 
*              THOSE ACTIVITIES PERFORMED AFTER A PHYSICAL LOAD 
*              IS COMPLETED.
  
 LLP15    BSS    0
 IC       IFCARD
          SA2    DEFER
          ZR     X2,LLP16    IF NOT A DEFERRED LOAD 
          RJ     AMU=        ACCUMULATE MEMORY USED 
          EQ     LLP         EXIT 
  
 LLP16    BSS    0
 IC       ENDIF 
          SA1    L+1         RESET *LIMIT* BACK TO NORMAL VALUE 
          R=     X6,X1+IP.LBUF
          SA6    L+4
          RJ     RLI=        MAKE SURE LIBRARY INTERLOCK RELEASED 
          RJ     CPR         GO COMPLETE PHYSICAL LOAD
          IFCARD 3
          SA1    SEGFLAG
          ZR     X1,LLP      IF NOT SEGMENT LOAD
          RJ     /LOADS/AUX  ADD UNSATISFIED EXTERNALS TO *TLNK*
          EQ     LLP         EXIT 
  
 LLLIB    CON    0           CURRENT LIBRARY NAME 
 LLCTL    CON    0,00040603000000000000B  LIBRARY FILE SEARCH ORDER 
                                          *ZZZZZ04* 
                                          *ZZZZZ06* 
                                          *ZZZZZ03* 
 LLFG     CON    0           NEXT SYSTEM FILE FLAG
  
 LBC      TITLE  LOAD COMPLETION SUBROUTINE - PROCESS LINK BYTE CHAINS. 
**        LBC - LINK BYTE CHAINS. 
* 
*              ALL EXTERNAL REFERENCES ARE FILLED BY THIS ROUTINE.
*         FIRST THE TABLE *TLBC* AND THEN THE TABLE *TXLBC* IS
*         PROCESSED.  THE FORMATS OF THESE TABLES ARE DESCRIBED IN
*         THE MANAGE TABLE DESCRIPTIONS.
* 
*              EACH EXTERNAL IS CLASSIFIED IN ONE OF THE FOLLOWING
*         WAYS SHOWN BELOW.  ONLY THE REFERENCES TO THE FIRST TWO 
*         TYPES ARE FILLED.  THE BYTES WHICH CONSIST OF REFERENCES TO 
*         THE LAST TWO TYPES ARE PLACED BACK IN *TLBC* OR *TXLBC*.
*         HOWEVER, THE LAST TIME *LBC* IS CALLED, ALL EXTERNALS WILL
*         BE OF ONE OF THE FIRST TWO TYPES AS A RESULT OF THE PROCESSING
*         BY THE ROUTINE *USX*. 
* 
*         U=0, UF=0 - EXTERNAL IS SATISFIED, NOT UNDER OMIT CONTROL,
*                     TO BE PROCESSED AT THIS TIME. 
*         U=0, UF=1 - EXTERNAL IS SATISFIED, BUT IS UNDER OMIT CONTROL, 
*                     THEREFORE IT IS TO BE SET AS 400000B+ADR. 
*         U=1, UF=0 - EXTERNAL IS UNSATISFIED, NOT UNDER OMIT CONTROL,
*                     NOT TO BE PROCESSED AT THIS TIME. 
*         U=1, UF=1 - EXTERNAL IS UNSATISFIED AND UNDER OMIT CONTROL, 
*                     THUS IS NOT TO BE PROCESSED.  AT LOAD COMPLETION, 
*                     ALL SUCH ENTRIES ARE CHANGED TO U=0, UF=1.
* 
*              IF CAPSULE/OVCAP GENERATION THEN CALLS */LOADG/LBCREL* 
*         TO MAINTAIN THE CAPSULE RELOCATION TABLE *TCPREL*.
  
  
 LBC      PS                 ENTRY/EXIT 
          SA3    TLBC        (A0) = *TLBC* STORE POINTER
          MX4    30          (X4) = UPPER/LOWER FLAG FOR FETCH
          SA0    X3 
 IC       IFCARD
          SA1    OG 
          ZR     X1,LBC0     IF NOT CAPSULE/OVCAP GENERATION
          R=     X1,X1-1
          ZR     X1,LBC0     IF NOT CAPSULE/OVCAP GENERATION
          RJ     /LOADG/LBCREL  GO TO MAINTAIN *TCPREL* 
          SA3    TLBC 
          MX4    30 
          SA0    X3 
 LBC0     BSS    0
 IC       ENDIF 
          SA1    A3+B1       (B7) = LENGTH OF *TLBC*
          SB7    X1 
          SA5    A0          (A5) = *TLBC* FETCH POINTER
          ZR     B7,LBC11    IF *TLBC* EMPTY
          SMSG   (=30H  LINKING EXTERNAL REFERENCES ) 
  
*         BYTE CHAIN LOOP.
  
 LBC1     PL     X5,LBC4     IF INDEX BYTE
          LX5    3           ADDRESS SHIFT = CONTROL BITS * 15
          MX0    -2 
          BX1    -X0*X5 
          BX2    X1 
          LX2    4
          IX6    X2-X1
          BX3    X5 
          SB3    X6 
          LX5    27          EXTRACT WORD INDEX 
          BX0    X4          SAVE X4
          SA2    TPGM        (B5) = FWA *TPGM*
          BX1    X5          OR ZERO FOR USER-CALL LOADS
          LX1    59-25       IF CM ADDRESS IS BELOW 
          AX1    60          FWA OF LOADABLE AREA 
          BX2    -X1*X2 
          SB5    X2 
          R=     B4,B3-60 
 ECS      IFTEST NE,IP.MECS,0 
          PL     X3,LBC1A    IF CM ADDRESS
          MX1    -24         (X2) = ECS ADDRESS 
          BX2    -X1*X5 
          RJ     RE=         READ WORD FROM ECS TO X1 
          EQ     LBC1B
  
          ENDIF 
 LBC1A    SA3    A2+B1       GET *TPGM* LENGTH
          SX1    X5 
          IX4    X3-X1
          PL     X4,LBC1AA   IF INDEX TO TPGM IS OKAY 
          ZR     B5,LBC1AA   IF PRESET BELOW FWA IGNORE THIS TLBC ENTRY 
          MX7    0           LINK TABLE INDICATOR 
          ERROR  340,X7      *BAD LINK BINARY TABLE*
          EQ     ABEND       GO TO ERROR EXIT 
  
 LBC1AA   SA1    B5+X5
 LBC1B    BSS    0
          MX3    -18
          AX1    X1,B4       SHIFT TO LOWER 
          BX4    X3*X1       REMOVE ADDRESS 
          NG     X7,LBC1C    IF TO BE SET UNSATISFIED 
          SX1    X1          EXTEND SIGN OF ADDRESS FIELD 
          IX3    X7+X1       RELOCATE ADDRESS 
          EQ     LBC1F
  
 LBC1C    BSS    0
 IC       IFCARD
          SX7    X1          SIGN EXTEND ADDRESS FIELD CONTENTS INTO X7 
          SA3    OG 
          MI     X3,LBC1CA   IF CAPSULE GENERATION
          R=     X3,X3-2
          ZR     X3,LBC1CA   IF OVCAP GENERATION
          MX7    0           ELSE SET CONTENTS = 0
 LBC1CA   BSS    0
 IC       ENDIF 
 ECS      IFTEST NE,IP.MECS,0 
          BX3    X5          CM/ECS FLAG
          LX3    59-26
          NG     X3,LBC1D    IF ECS ADDRESS 
 ECS      ENDIF 
          BX3    X5          (X3) = ADDRESS 
          ZR     B5,LBC1C1   IF ADDRESS BELOW LOADABLE AREA 
          SA3    PO          ADDRESS + PO - BI
          IX6    X3+X5
          SA3    BI 
          IX3    X6-X3
 LBC1C1   BSS    0
 ECS      IFTEST NE,IP.MECS,0 
          EQ     LBC1E
  
 LBC1D    BX3    X2          ADR = ECS ADDRESS
 LBC1E    BSS    0
 ECS      ENDIF 
  
          R=     X3,X3+400000B     SET ADDRESS FIELD = 400000B+ADR
 IC       IFCARD
          IX3    X3+X7       IF ENCAP THEN USE 400000B+ADR+CONTENTS 
*                            (X7)=CONTENTS OR ZERO
          MX7    1           RESTORE UNSATISFIED FLAG IN X7 
 IC       ENDIF 
 LBC1F    MX6    -18         REMOVE ANY SIGN EXTENSION
          BX6    -X6*X3 
          IX6    X6+X4       MERGE WORD AND ADDRESS 
          LX6    X6,B3       RESTORE WORD 
 ECS      IFTEST NE,IP.MECS,0 
          BX3    X5          CM/ECS FLAG
          LX3    59-26
          PL     X3,LBC1G    IF CM ADDRESS
          RJ     WE=         WRITE (X6) TO ECS
          EQ     LBC1H
  
 ECS      ENDIF 
 LBC1G    NZ     B5,LBC1GA   IF NOT BELOW LOADABLE AREA (B5 AS ABOVE) 
 IC       IFCARD
          SA4    SEGFLAG
          NZ     X4,LBC1GB   IF SEGMENT LOAD DO NOT LINK
          SA4    OG          OVERLAY GENERATION FLAG
          NZ     X4,LBC1GB   IF OVERLAY/CAPSULE/OVCAP GENERATION
 IC       ENDIF 
 LBC1GA   SA6    A1          STORE WORD IN CM 
 LBC1GB   BSS    0
 LBC1H    BSS    0
          BX4    -X0         RESTORE X4 AND SWITCH BYTES
          PL     X4,LBC1     IF NEXT BYTE LOWER 
          SB7    B7-B1
          SA5    A5+B1       NEXT WORD
          NZ     B7,LBC1     LOOP TO END OF CHAIN 
          EQ     LBC10       IF END OF LINK BYTE CHAIN
  
*         SET RELOCATION ADDRESS FOR INDEX BYTE.
  
 LBC4     BX1    X5          EXTERNAL NAME
          MX2    0           INDICATE SEARCH ONLY 
          RJ     ELT         FIND DEFINITION
          MX7    -24         (X7) = ADDRESS 
          LX1    X2,B1       LOOK AT *U* AND *UF* BITS
          NG     X1,LBC5     IF NOT TO FILL REFERENCE YET 
          BX7    -X7*X2 
          LX1    1
          PL     X1,LBC4A    IF TO BE SET AS SATISFIED
          MX7    1           INDICATE TO USE 400000B+ADR
 LBC4A    MX4    30          SET FOR FETCH OF UPPER BYTE
          SB7    B7-B1
          SA5    A5+B1       NEXT WORD
          NZ     B7,LBC1     LOOP TO END OF CHAIN 
          EQ     LBC10       IF END OF LINK BYTE CHAIN
  
*         STORE BYTES FOR UNSATISFIED EXTERNAL BACK IN *TLBC*.
*         (STORE ADDRESS IS ALWAYS @ FETCH ADDRESS).
  
 LBC5     BX6    X5          STORE CURRENT WORD 
          SA6    A0 
          SA0    A0+B1       ADVANCE STORE POINTER
          SA5    A5+B1       NEXT WORD
          SB7    B7-B1       DOWN WORD COUNT
          ZR     B7,LBC10    IF AT END OF *TLBC*
          NG     X5,LBC5     LOOP ON DATA BYTE
          EQ     LBC4        GO PROCESS INDEX BYTE
  
 LBC10    SX6    A0          SET NEW *TLBC* LENGTH
          SA1    TLBC        SET LINK INDEX = NEW *TLBC* LENGTH 
          IX6    X6-X1
          SA6    A1+B1
          SA6    LI 
  
*         PROCESS EXTENDED LINK BYTE CHAIN (*TXLBC*). 
  
 LBC11    SA4    TXLBC       (A0) = STORE POINTER TO *TXLBC*
          SA0    X4 
          SA1    A4+B1       (B7) = LENGTH OF *TXLBC* 
          SB7    X1 
          SA5    X4          1ST WORD 
          ZR     X1,LBC      EXIT IF *TXLBC* EMPTY
  
*         BYTE CHAIN LOOP FOR *TXLBC*.
  
 LBC12    BX1    X5          EXTERNAL NAME
          MX2    0           INDICATE SEARCH ONLY 
          RJ     ELT         FIND DEFINITION
          MX7    -24         (X7) = ADDRESS 
          LX1    X2,B1       LOOK AT *U* AND *UF* BITS
          NG     X1,LBC30    IF NOT TO FILL REFERENCE YET 
          BX7    -X7*X2 
          LX1    1
          PL     X1,LBC13    IF TO BE SET AS SATISFIED
          MX7    1           FIELD VALUE = 400000B+ADR
 LBC13    SA5    A5+B1       NEXT WORD
          SB7    B7-B1
          ZR     B7,LBC31    IF END OF *TXLBC*
          NZ     X5,LBC14    IF A LINKAGE DESCRIPTOR
          SB7    B7-B1       NEXT WORD (LINK INDEX) 
          SA5    A5+B1
          NZ     B7,LBC12    IF NOT END OF *TXLBC*
          EQ     LBC31
  
 LBC14    BX0    X5          SAVE CM/ECS FLAG 
          AX5    18 
          MX2    -6 
          BX1    -X2*X5      (B3) = FIELD WIDTH 
          SB3    X1 
          AX5    6           (B2) = FIELD POSITION
          BX1    -X2*X5 
          SB2    X1 
          AX5    6
          SA2    TPGM        (B5) = FWA *TPGM*
          BX1    X0          OR ZERO FOR USER-CALL LOADS
          LX1    59-57       IF CM ADDRESS IS BELOW 
          AX1    60          FWA OF LOADABLE AREA 
          BX2    -X1*X2 
          SB5    X2 
 ECS      IFTEST NE,IP.MECS,0 
          PL     X0,LBC15    IF CM ADDRESS
          MX2    -24         (X2) = ECS ADDRESS 
          BX2    -X2*X5 
          RJ     RE=         READ WORD FROM ECS TO X1 
          EQ     LBC16
  
 LBC15    SA1    X5+B5       READ WORD FROM CM
 LBC16    BSS    0
 ECS      ENDIF 
  
          IFTEST EQ,IP.MECS,0,1 
          SA1    X5+B5       READ WORD
          R=     B6,60       (B6) = 60
          MX6    1           FORM MASK OF (60-WIDTH)
          SB4    B6-B3       60-WIDTH 
          SB4    B4-B1       59-WIDTH (+1 BEFORE SHIFT) 
          AX6    X6,B4
          NE     B3,B6,LBC17 IF WIDTH " 60
          MX6    0           SET MASK = 0 
 LBC17    SB4    B4+B1       (B4) = (60-WIDTH)
          SB6    B6-B2       (B6) = (60-POSITION) 
          LX1    X1,B6       SHIFT FIELD TO LOW-ORDER BITS
          LX3    X1,B4       EXTEND SIGN OF FIELD 
          AX3    X3,B4
          BX1    X6*X1       REMOVE OLD ADDRESS 
          NG     X7,LBC18    IF TO BE SET AS UNSATISFIED
          BX5    X7 
          LX5    -24
          AX5    -24
          IX3    X3+X5       RELOCATE ADDRESS 
          EQ     LBC21
  
 LBC18    BSS    0
 IC       IFCARD
          BX7    X3          SAVE CONTENTS OF ADR FIELD(SIGN EXT) IN X7 
          SA3    OG 
          MI     X3,LBC18A1  IF CAPSULE GENERATION
          R=     X3,X3-2
          ZR     X3,LBC18A1  IF OVCAP GENERATION
          MX7    0           ELSE SET CONTENTS = 0
 LBC18A1  BSS    0
 IC       ENDIF 
          IFTEST NE,IP.MECS,0,1 
          NG     X0,LBC19    IF WORD CAME FROM ECS
          BX3    X5          (X3) = ADDRESS 
          ZR     B5,LBC18A   IF ADDRESS BELOW LOADABLE AREA 
          SA3    PO          COMPUTE ADR = X5 + PO - BI 
          IX5    X3+X5
          SA3    BI 
          IX3    X5-X3
 LBC18A   BSS    0
 ECS      IFTEST NE,IP.MECS,0 
          EQ     LBC20
  
 LBC19    BX3    X2          ADR = ECS ADDRESS
 LBC20    BSS    0
 ECS      ENDIF 
  
          R=     X3,X3+400000B     SET ADDRESS FIELD = 400000B+ADR
 IC       IFCARD
          IX3    X3+X7       IF ENCAP THEN USE 400000B+ADR+CONTENTS 
*                            (X7) = CONTENTS OR ZERO
          MX7    1           RESTORE UNSATISFIED FLAG IN X7 
 IC       ENDIF 
 LBC21    BX6    -X6*X3      REMOVE SIGN EXTENSION
          IX6    X6+X1       MERGE WORD AND ADDRESS 
          LX6    X6,B2       RESTORE POSITION OF WORD 
 ECS      IFTEST NE,IP.MECS,0 
          PL     X0,LBC22    IF CM ADDRESS
          RJ     WE=         WRITE (X6) TO ECS
          EQ     LBC23
  
 ECS      ENDIF 
 LBC22    NZ     B5,LBC22A   IF NOT BELOW LOADABLE AREA (B5 AS ABOVE) 
 IC       IFCARD
          SA2    SEGFLAG
          NZ     X2,LBC23    IF SEGMENT LOAD DO NOT LINK
          SA2    OG          OVERLAY GENERATION FLAG
          NZ     X2,LBC23    IF OVERLAY/CAPSULE/OVCAP GENERATION
 IC       ENDIF 
 LBC22A   SA6    A1          STORE WORD IN CM 
 LBC23    BSS    0
          EQ     LBC13       LOOP 
  
*         STORE BYTES FOR UNSATISFIED EXTERNALS BACK IN *TXLBC*.
  
 LBC30    BX7    X5          REPLACE WORDS UNTIL EITHER END OF
          SA7    A0          TABLE OR ZERO WORD STORED
          SA0    A0+B1
          SB7    B7-B1
          SA5    A5+B1
          ZR     B7,LBC31    IF END OF *TXLBC*
          NZ     X7,LBC30    IF ZERO WORD NOT YET STORED
          EQ     LBC12       LOOP 
  
*         ADJUST TABLE SIZE.
  
 LBC31    SX6    A0          SET NEW *TXLBC* LENGTH 
          SA1    TXLBC       SET INDEX = NEW LENGTH 
          IX6    X6-X1
          SA6    A1+B1
          SA6    XLI
          EQ     LBC         EXIT 
 FBC      TITLE  LOAD COMPLETION SUBROUTINE - PROCESS FILL BYTE CHAINS. 
**        FBC - FILL BYTE CHAINS. 
* 
*              THIS ROUTINE IS CALLED TO FILL ALL REFERENCES DESCRIBED
*         BY *FILL* OR *XFILL* TABLES.  THESE TABLES HAVE BEEN STORED IN
*         THE MANAGE TABLES *TFBC* AND *TXFBC*, RESPECTIVELY. 
* 
*              THIS ROUTINE IS CURRENTLY BEING ENTERED ONLY ONE TIME AT 
*         LOAD COMPLETION.  THIS IS AFTER BLANK COMMON HAS BEEN 
*         ESTABLISHED IN ORDER THAT REFERENCES TO BLANK COMMON CAN BE 
*         FILLED.  IT SHOULD BE MODIFIED TO PLACE BLANK COMMON
*         REFERENCES BACK IN THE RESPECTIVE TABLE, AS DOES THE ROUTINE
*         *LBC* FOR UNSATISFIED EXTERNALS.  DOING THIS WOULD ALLOW *FBC*
*         TO BE CALLED MORE OFTEN, AND WOULD, HENCE, KEEP THESE TABLES
*         SMALLER AND MAKE A NOTICABLE REDUCTION IN CORE NEEDED IN LOADS
*         WITH MANY COMMON REFERENCES.
*              IF CAPSULE/OVCAP GENERATION THEN CALLS */LOADG/FBCREL* TO
*         MAINTAIN THE CAPSULE RELOCATION TABLE *TCPREL*. 
  
  
 FBC      PS                 ENTRY/EXIT 
 IC       IFCARD
          SA1    OG 
          ZR     X1,FBC0     IF NOT CAPSULE/OVCAP GENERATION
          R=     X1,X1-1
          ZR     X1,FBC0     IF NOT CAPSULE/OVCAP GENERATION
          RJ     /LOADG/FBCREL  GO TO MAINTAIN *TCPREL* 
 FBC0     BSS    0
 IC       ENDIF 
          SB2    B1+B1       (B2) = 4 
          MX5    30          (X5) = BYTE MASK 
          SA2    TFBC 
          SB2    B2+B2
          SA1    A2+B1
          SB7    X1          (B7) = WORD COUNT
          SA4    X2          FIRST WORD 
          SA3    TBLK        (A0) = FWA BLOCK TABLE 
          MX0    -2          (X0) = CONTROL BIT MASK
          SA0    X3 
          ZR     X1,FBC5     IF *TFBC* EMPTY
          MX6    0           SET *TFBC* EMPTY 
          SA6    A1 
          SMSG   (=30H  FILLING COMMON BLOCK REFS   ) 
  
*         BYTE CHAIN LOOP FOR *TFBC*. 
  
 FBC1     PL     X4,FBC4     IF INDEX BYTE
          LX4    3           ADDRESS SHIFT = CONTROL BITS * 15
          BX1    -X0*X4 
          LX6    X1,B2
          IX6    X6-X1
          SB3    X6 
          R=     B4,B3-60 
 ECS      IFTEST NE,IP.MECS,0 
          PL     X4,FBC2     IF CM TEXT 
          LX4    27          POSITION TEXT ADDRESS
          MX1    -24         (X2) = ECS ADDRESS 
          BX0    X4          SAVE X4
          BX2    -X1*X4 
          RJ     RE=         READ WORD FROM ECS TO X1 
          AX1    X1,B4       SHIFT ADDRESS TO LOWER 
          MX4    -18         ADDRESS MASK 
          BX3    X4*X1       REMOVE ADDRESS 
          SX6    X1+B6       RELOCATE ADDRESS 
          BX1    -X4*X6 
          IX6    X1+X3       MERGE WORD AND ADDRESS 
          LX6    X6,B3       RESTORE WORD 
          RJ     WE=         STORE IN ECS 
          BX4    X0          RESTORE X4 
          BX5    -X5         SWITCH BYTES 
          MX0    -2          RESTORE X0 
          EQ     FBC3 
  
 ECS      ENDIF 
  
 FBC2     LX4    27          POSITION TEXT ADDRESS
          SA3    TPGM        (B5) = FWA *TPGM*
          BX6    X4          OR ZERO FOR USER-CALL LOADS
          LX6    59-25       IF CM ADDRESS IS BELOW 
          AX6    60          FWA OF LOADABLE AREA 
          BX3    -X6*X3 
          SB5    X3 
          MX2    -18         ADDRESS MASK 
          SA1    B5+X4       READ WORD
          AX1    X1,B4       SHIFT ADDRESS TO LOWER 
          BX3    X2*X1       REMOVE ADDRESS 
          SX6    X1+B6       RELOCATE ADDRESS 
          BX1    -X2*X6 
          IX2    X1+X3       MERGE WORD AND ADDRESS 
          LX6    X2,B3       RESTORE WORD 
          BX5    -X5         SWITCH BYTES 
          NZ     B5,FBC2A    IF NOT BELOW LOADABLE AREA (B5 AS ABOVE) 
 IC       IFCARD
          SA2    SEGFLAG
          NZ     X2,FBC3     IF SEGMENT LOAD DO NOT FILL
          SA2    OG          OVERLAY GENERATION FLAG
          NZ     X2,FBC3     IF OVERLAY/CAPSULE/OVCAP GENERATION
 IC       ENDIF 
 FBC2A    BSS    0
          SA6    A1          STORE WORD 
 FBC3     PL     X5,FBC1     IF NEXT BYTE LOWER 
          SB7    B7-B1
          SA4    A4+B1       NEXT WORD
          NZ     B7,FBC1     LOOP TO END OF CHAIN 
          EQ     FBC5        GO TO *XFBC* CHAIN 
  
*         SET RELOCATION ADDRESS FOR INDEX BYTE.
  
 FBC4     LX4    30          SET INDEX
          BX5    -X5         SWITCH BYTES 
          SB3    X4 
          SA1    A0+B3       (B6) = RELOCATION ADDRESS
          SB6    X1 
          PL     X5,FBC1     IF NEXT BYTE LOWER 
          SB7    B7-B1
          SA4    A4+B1       NEXT WORD
          NZ     B7,FBC1     LOOP TO END OF CHAIN 
  
*         INITIALIZE FOR EXTENDED FILL BYTE CHAIN.
  
 FBC5     SA2    TXFBC
          SA1    A2+B1
          SA5    X2          FIRST WORD 
          ZR     X1,FBC      EXIT IF *TXFBC* EMPTY
          SB7    X1          (B7) = WORD COUNT
          MX6    0           SET *TXFBC* EMPTY
          SA6    A1 
  
*         BYTE CHAIN LOOP FOR EXTENDED FILL BYTE CHAIN (*TXFBC*). 
  
 FBC6     SB3    X5          SAVE *TBLK* INDEX
          IFTEST NE,IP.MECS,0,1 
          BX7    X5          SAVE CM/ECS FLAG 
          SA3    TPGM        (B5) = FWA *TPGM*
          BX1    X5          OR ZERO FOR USER-CALL LOADS
          LX1    59-57       IF CM ADDRESS IS BELOW 
          AX1    60          FWA OF LOADABLE AREA 
          BX3    -X1*X3 
          SB5    X3 
          LX5    30          POSITION ADDRESS 
 ECS      IFTEST NE,IP.MECS,0 
          MX2    -24
          PL     X7,FBC7     IF CM ADDRESS
          BX2    -X2*X5      (X2) = ECS ADDRESS 
          RJ     RE=         READ WORD FROM ECS TO X1 
          EQ     FBC8 
  
 FBC7     SA1    X5+B5       FETCH WORD FROM CM 
 FBC8     BSS    0
 ECS      ENDIF 
          IFTEST EQ,IP.MECS,0,1 
          SA1    X5+B5       READ WORD
          MX0    -6 
          LX5    6           (B2) = FIELD POSITION
          SA4    A0+B3       (X4) = RELOCATION QUANTITY 
          BX6    -X0*X5 
          MX3    -24
          LX5    6           (B3) = FIELD WIDTH 
          SB2    X6 
          BX4    -X3*X4 
          R=     B6,60       (B6) = 60
          BX3    -X0*X5 
          MX6    1           FORM MASK OF (60-WIDTH)
          SB3    X3 
          SB4    B6-B3       60-WIDTH 
          LX5    59-58-30-6-6      POSITION TO +/- BIT
          SB4    B4-B1       59-WIDTH  (+1 BEFORE SHIFT)
          AX6    X6,B4
          NE     B3,B6,FBC9  IF WIDTH " 60
          MX6    0           SET MASK = 0 
 FBC9     SB4    B4+B1       (B4) = (60-WIDTH)
          SB6    B6-B2       (B6) = (60-POSITION) 
          LX1    X1,B6       SHIFT FIELD TO LOW-ORDER BITS
          LX3    X1,B4       EXTEND SIGN OF FIELD 
          PL     X5,FBC9A    IF + RELOCATION
          BX4    -X4         SET FOR - RELOCATION 
 FBC9A    AX3    X3,B4
          IX3    X3+X4       RELOCATE FIELD 
          BX4    -X6*X3      REMOVE SIGN EXTENSION
          BX1    X6*X1       REMOVE OLD ADDRESS 
          BX1    X1+X4       INSERT RELOCATED ADDRESS 
          LX6    X1,B2       RESTORE POSITION OF WORD 
 ECS      IFTEST NE,IP.MECS,0 
          PL     X7,FBC10    IF WORD CAME FROM CM 
          RJ     WE=         WRITE (X6) TO ECS
                                   NOTE (X2) STILL = ECS ADDRESS
          EQ     FBC11
  
 ECS      ENDIF 
 FBC10    NZ     B5,FBC10A   IF NOT BELOW LOADABLE AREA (B5 AS ABOVE) 
 IC       IFCARD
          SA3    SEGFLAG
          NZ     X3,FBC11    IF SEGMENT LOAD DO NOT FILL
          SA3    OG          OVERLAY GENERATION FLAG
          NZ     X3,FBC11    IF OVERLAY/CAPSULE/OVCAP GENERATION
 IC       ENDIF 
 FBC10A   SA6    A1          STORE WORD IN CM 
 FBC11    BSS    0
          SB7    B7-B1
          SA5    A5+B1       NEXT WORD OF CHAIN 
          NZ     B7,FBC6     LOOP TO END OF CHAIN 
          EQ     FBC         EXIT 
 CPR      TITLE  LOAD COMPLETION SUBROUTINE - COMPLETE READ.
**        CPR - COMPLETE READ.
* 
*              THIS ROUTINE IS CALLED AFTER THE PHYSICAL LOADING HAS
*         BEEN PERFORMED FOR ONE LOAD FILE, OR AFTER LOADING ONE OR 
*         MORE LIBRARY PROGRAMS BY THE ROUTINE *LLP*.  IT DOES
*         THE FOLLOWING 
* 
*         1) A CALL IS MADE TO THE SUBROUTINE *AMU=* TO RECORD THE
*            CURRENT CORE REQUIREMENT OF THE LOAD.  IT IS NORMALLY
*            EXPECTED THAT THE MAXIMUM CORE REQUIREMENT WILL BE AT THIS 
*            POINT, SINCE TABLES CONTAINING THE LINK AND FILL BYTE
*            CHAINS WILL BE AT THEIR MAXIMUM SIZE, AND TABLE *TEPT* 
*            WILL NOT HAVE YET BEEN EMPTIED.
* 
*         2) ENTRY NAMES FROM *TEPT* ARE MOVED INTO *TLNK*.  EACH NAME
*            SO ENTERED MAY ALREADY BE THERE IF IT HAS ALREADY APPEARED 
*            IN AN EXTERNAL REFERENCE FROM A PREVIOUS PHYSICAL LOAD,
*            BUT IT WILL EXIST IN *TLNK* AS BEING UNSATISFIED, UNLESS 
*            THE ENTRY POINT IS DOUBLY-DEFINED, WHICH IS A NON-FATAL
*            ERROR. 
* 
*         3) EACH EXTERNAL REFERENCE NAME FROM LINK-TYPE TABLES IS
*            FETCHED, AND IF UNDER *SUBST* CONTROL, IS REPLACED WITH
*            THE SUBSTITUTED NAME.  THE NAME IS THEN PLACED IN *TLNK*.
*            IF THE NAME WAS ALREADY IN *TLNK*, EITHER AS BEING 
*            SATISFIED OR UNSATISFIED, NO NEW ENTRY GOES IN.  THE 
*            *TLNK* DEF WORD IS THEN SET SUCH THAT THE *REFERENCED* 
*            BIT IS SET AND THE *WEAK* BIT IS MAINTAINED SUCH THAT A
*            *STRONG* EXTERNAL WILL OVERRIDE A *WEAK* ONE.  IF IT 
*            WAS NOT THERE, IT GOES IN AS BEING UNSATISFIED,
*            REFERENCED, AND *STRONG* OR *WEAK* AS ABOVE. 
* 
*         4) IF A CROSS-REFERENCE LIST OF EXTERNAL REFERENCES IS
*            SELECTED FOR THE MAP, THE LINK BYTE CHAIN IS COPIED TO A 
*            SEPARATE TABLE (*TLBC2*) FOR USE BY THE MAP ROUTINE. 
*            THIS IS NECESSARY SINCE LINK BYTES ARE DISCARDED AS
*            EXTERNAL REFERENCES ARE LINKED.  THIS SECOND TABLE IS
*            SPACE-CONSUMING, SINCE IT MUST REMAIN UNTIL THE END OF THE 
*            LOAD, BUT IT IS GENERATED ONLY IF SUCH A MAP IS REQUESTED. 
* 
*         5) THE SUBROUTINE *AMU=* IS CALLED TO RECORD THE CURRENT CORE 
*            REQUIREMENT.  IT MAY BE HIGHER AT THIS TIME THAN AT (1)
*            ABOVE IF A SIZEABLE INCREASE WAS MADE TO THE TABLE *TLBC2*.
* 
*         6) THE SUBROUTINE *LBC* IS CALLED TO FILL AS MANY EXTERNAL
*            REFERENCES AS POSSIBLE.
* 
*         7) THE SUBROUTINE *RPL* IS CALLED TO PROCESS ALL DEFERRED 
*            REPLICATIONS WHICH WERE ENCOUNTERED DURING THE PHYSICAL
*            LOADING.  THE INSTANT REPLICATIONS WERE PROCESSED AS THEY
*            WERE ENCOUNTERED.
* 
*         CALLS  AMU=, SEN, ELT, MVE=, LBC, RPL.
  
  
 CPR10    RJ     AMU=        ACCUMULATE MEMORY USED 
          RJ     LBC         PROCESS LINK BYTE CHAINS 
          SA0    TREP        PROCESS REPLICATIONS 
          RJ     RPL
  
 CPR      PS                 ENTRY/EXIT 
          RJ     AMU=        ACCUMULATE MEMORY USED 
          IFCARD 2
          SA2    ABS         EXIT IF ABSOLUTE LOAD
          NZ     X2,CPR      (SAME TABLES ARE USED DIFFERENTLY) 
  
*         ENTER ENTRY POINT NAMES AND DEFINITIONS.
  
 CPR1     SA4    TEPT 
          SA3    A4+B1
          SX6    B1+B1
          ZR     X3,CPR2     IF NO ENTRY POINTS 
          SA1    X4          NEXT ENTRY 
          SA2    X4+B1
          SB6    A2 
          SX7    A2+B1       ADVANCE FWA
          IX6    X3-X6       REDUCE LENGTH
          BX5    X2          SAVE EQUIVALENT
          SA7    A4 
          SA6    A3 
          RJ     ELT         ENTER LINK TABLE 
          SA1    TLNK        ENTER EQUIVALENT 
          BX7    X5 
          SB2    X1 
          SA2    B2+X6       FETCH EQUIVALENT IN *TLNK* 
          BX3    X2-X5
          ZR     X3,CPR1     IF ENTRY JUST NOW DEFINED
          R=     X4,25B      PRESERVE PREVIOUS SETTING OF *REFERENCED*, 
          LX4    59-4        *OMIT*, AND *WEAK* BITS
          BX4    X4*X2
          LX2    1
          R=     B2,18
          PL     X2,CPR1A    IF ENTRY NOT UNSATISFIED 
          BX7    X7+X4
          SA7    A2          ENTER DEFINITION (EQUIVALENT)
          EQ     CPR1        LOOP FOR NEXT ENTRY
  
 CPR1A    LX2    1
          NG     X2,CPR1     IF UNDER *OMIT* CONTROL
          SA1    A2-B1       SAME NAME HAS APPEARED TWICE 
          LX7    X1,B2       (X7) = NAME
          AX5    36 
          SX5    X5 
          BX7    X7+X5       (X7) = NAME + PI 
  
 IC       IFCARD
          SA3    OG 
          SA4    SEGFLAG
          MI     X4,CPR1A1   IF SEGMENT GENERATION
          R=     X3,X3-1
          NZ     X3,CPR1B    IF NOT OVERLAY GENERATION
 CPR1A1   BSS    0
          LX2    -2 
          SA3    PO 
          SX2    X2 
          IX3    X2-X3
          PL     X3,CPR1B    IF EARLIER DEFINITION IN SAME OVERLAY
          SX6    B1 
          IX6    X6+X1       TEMPORARILY ALTER NAME IN 1ST DEF
          SA6    A1 
          LX1    18 
          SA2    B6 
          SB6    A1 
          SA7    T1 
          RJ     ELT         ENTER THIS DEFINITION IMMEDIATELY BEF
          SA1    A7+B1
          SX6    B1 
          IX6    X1-X6
          SA6    A1          RESTORE ORIGINAL ENTRY 
          SA1    T1 
          BX7    X1 
 IC       ENDIF 
  
 CPR1B    ERROR  4102,X7     ---- DUPLICATE ENTRY POINT NAME
          EQ     CPR1 
  
*         LINK-BYTE CHAIN PROCESSING. 
  
 CPR2     SA2    TLBC        CHECK FOR NEW LINK BYTES 
          SA1    A2+B1
          SA3    LI 
          IX6    X1-X3
          SB7    X1          (B7) = LENGTH OF *TLBC*
          ZR     X6,CPR7     IF NO NEW LINK BYTES 
          BX0    X3          SAVE LINK INDEX
          MX4    30 
          SB6    X3          (B6) = START INDEX 
          SA1    X2+B6
          BX6    X4*X1
  
*         LINK BYTE CHAIN SCAN LOOP.
  
 CPR3     LX4    30          SHIFT MASK 
          ZR     X6,CPR4     IF EMPTY BYTE
          PL     X1,CPR5     IF POSITIVE BYTE 
          LX1    30 
          BX6    -X4*X1 
 CPR4     PL     X4,CPR3     IF NEXT BYTE LOWER 
          SB6    B6+B1       ADVANCE INDEX
          SA1    A1+B1       NEXT WORD
          BX6    X4*X1
          NE     B6,B7,CPR3  LOOP IF NOT END OF TABLE 
          EQ     CPR6A
  
*         ENTER EXTERNAL NAME.
  
 CPR5     RJ     CPRELT      ENTER EXTERNAL NAME
          SA2    TLBC        STORE NAME (MAY BE CHANGED BY *SEN*) 
          BX6    X5 
          MX4    30          RESET BYTE MASK
          SA6    X2+B6
          SB6    B6+B1       ADVANCE INDEX
          SA1    A6+B1       NEXT WORD
          NE     B6,B7,CPR3  CONTINUE SCAN LOOP, IF NOT TABLE END 
  
*         TRANSFER ALL NEW LINK BYTES TO *TLBC2* IF A CROSS-REFERENCE 
*         LIST IS SELECTED FOR THE MAP. 
  
 CPR6A    SA1    MAPTYPE
          SX7    B7          ADVANCE LINK INDEX 
          LX1    59-3 
          SA7    LI 
 IC       IFCARD
          SA2    OG          CAPSULE/OVCAP GEN THEN WE NEED *TLBC2* 
          ZR     X2,CPR6AA   IF NOT CAPSULE/OVCAP GENERATION
          R=     X2,X2-1
          ZR     X2,CPR6AA   IF NOT CAPSULE/OVCAP GENERATION
          SB4    B0          INIT WC FOR *TLBC2* ADD
          EQ     CPR6B       GO TO FORM *TLBC2* 
  
 CPR6AA   BSS    0
 IC       ENDIF 
          PL     X1,CPR7     IF REFERENCE LIST NOT SELECTED 
          SB4    B0          INITIALIZE WORD COUNT FOR *TLBC2* ADD
 CPR6B    SA2    TLBC        (B2) = *TLBC* FETCH FWA
          SA3    A2+B1       (B3) = *TLBC* FETCH LWA+1
          IX3    X2+X3
          IX2    X2+X0
          SB2    X2 
          MX4    1           INITIALIZE PREVIOUS WORD 
          SB3    X3 
 CPR6C    EQ     B2,B3,CPR6D IF END OF *TLBC* 
          SA2    B2          (X7) = NEXT *TLBC* WORD
          BX7    X2 
          NG     X2,CPR6G    IF NOT A NAME WORD 
          IFCARD 2
          SA2    SI          ADD SEGMENT INDEX TO NAME
          BX7    X7+X2
 CPR6D    PL     X4,CPR6E    IF PREVIOUS WORD WAS A NAME
          MX3    30 
          BX3    -X3*X4 
          ZR     X3,CPR6F    IF PREVIOUS WORD HAD ZERO LOWER BYTE 
 CPR6E    SB4    B4+B1       ADVANCE COUNT / STORE POINTER
          PL     B7,CPR6F    IF 1ST TIME THROUGH LOOP 
          SA6    B4-B1       ADD ZERO WORD TO *TLBC2* 
 CPR6F    EQ     B2,B3,CPR6I IF END OF *TLBC* 
 CPR6G    SB4    B4+B1       ADVANCE COUNT / STORE POINTER
          PL     B7,CPR6H    IF 1ST TIME THROUGH LOOP 
          SA7    B4-B1       ADD CURRENT WORD TO *TLBC2*
 CPR6H    BX4    X7          SET PREVIOUS WORD = CURRENT WORD 
          SB2    B2+B1       ADVANCE FETCH POINTER
          EQ     CPR6C       LOOP 
  
 CPR6I    NG     B7,CPR7     IF *TLBC2* ADDING DONE 
          SB7    -B1         FLAG 2ND TIME THROUGH LOOP 
          ALLOC  TLBC2,B4    ADD REQUIRED LENGTH TO *TLBC2* 
          SB4    X3          (B4) = *TLBC2* STORE POINTER 
          MX6    0           ZERO WORD FOR STORE
          EQ     CPR6B       GO ADD WORDS TO *TLBC2*
  
*         EXTENDED LINK-BYTE CHAIN PROCESSING.
  
 CPR7     SA5    TXLBC       (A5) = *TXLBC* POINTER 
          SA1    A5+B1
          SA3    XLI         (B6) = START INDEX OF *TXLBC*
          IX6    X1-X3
          SB7    X1          (B7) = LENGTH OF *TXLBC* 
          ZR     X6,CPR10    IF NO NEW EXTENDED LINK BYTES
          SB6    X3 
          SA1    X5+B6       FIRST WORD 
          SX7    B7          ADVANCE LINK INDEX 
          SA7    A3 
          SA4    MAPTYPE     (B5) = 1 IF MAP REFERENCE LIST 
          AX4    3           SELECTED 
          SB5    X4 
 IC       IFCARD
          SA2    OG          CAPSULE/OVCAP GEN THEN WE NEED *TLBC2* 
          ZR     X2,CPR7AA   IF NOT CAPSULE/OVCAP GENERATION
          R=     X2,X2-1
          ZR     X2,CPR7AA   IF NOT CAPSULE/OVCAP GENERATION
          SB5    TLBC2       (B5) = *TLBC2* POINTER 
          EQ     CPR8 
  
 CPR7AA   BSS    0
 IC       ENDIF 
          ZR     B5,CPR8     (B5) = *TLBC2* POINTER OR ZERO 
          SB5    TLBC2
  
*         LOOP FOR *TXLBC*. 
  
 CPR8     RJ     CPRELT      ENTER EXTERNAL NAME
          SA2    A5          STORE NAME (MAY BE CHANGED BY *SEN*) 
          BX6    X5 
          IFCARD 2
          SA1    SI 
          BX5    X5+X1
          SA6    X2+B6
          ZR     B5,CPR9A    IF NOT FORMING *TLBC2* 
          ADDWRD B5,X5       ADD NAME TO *TLBC2*
 CPR9     MX0    0           INITIALIZE TRAILER BYTES 
 CPR9A    SB6    B6+B1       ADVANCE FETCH POINTER
          EQ     B6,B7,CPR9C IF AT END OF *TXLBC* 
          SA2    A5          NEXT WORD
          SA1    X2+B6       SET UP (X6) = 1/1,2/P,57/0 
          MX6    -12          WHERE P AS IN *TLBC* (P=3 IF NONE)
          LX1    -18
          BX1    -X6*X1      (X1) = 48/0,6/POS,6/SIZE 
          R=     X6,4        INIT X6 = LO FLAG
          R=     X1,X1-0022B  CHECK EXACT LO ADDR FIELD 
          ZR     X1,CPR9AA   IF LO
          SX6    X6+B1       SET X6 = MIDDLE FLAG 
          R=     X1,X1-1700B  CHECK EXACT MIDDLE ADDRESS FIELD
          ZR     X1,CPR9AA   IF MIDDLE
          SX6    X6+B1       SET X6 = HI FLAG 
          R=     X1,X1-1700B  CHECK EXACT HI ADDRESS FIELD
          ZR     X1,CPR9AA   IF HI
          SX6    X6+B1       SET X6 = NONE OF ABOVE FLAG
 CPR9AA   LX6    59-2        (X6) = 1/1,2/P,57/0(*TLBC* TYPE TRAILER) 
          SA1    X2+B6
          ZR     X1,CPR9C    IF AT END OF SET OF TRAILER BYTES
          ZR     B5,CPR9A    IF NOT FORMING *TLBC2* 
          MX7    1
          BX7    X7*X1       CM/ECS FLAG
          LX7    26-29
          MX4    1
          LX4    -2 
          BX4    X4*X1       BELOW LOADBALE AREA BIT FROM *TXLBC* 
          LX4    -2          CHANGE TO *TLBC2* BIT POSITION 
          BX7    X7+X4       CM/ECS BIT + BELOW LOADABLE AREA BIT 
          MX4    -24
          BX6    X6+X7       FLAG + CM/ECS BIT + BELOW LOADABLE AREA BIT
          LX4    30 
          BX4    -X4*X1      ADDRESS
          BX6    X6+X4       1/1,2/P,1/F,1/A,1/0,24/ADDR,30/0 
          ZR     X0,CPR9B    IF THIS ONE GOES TO UPPER HALF 
          LX6    30          INSERT WORD WITH BOTH UPPER AND LOWER
          ADDWRD B5,X0+X6 
          EQ     CPR9        LOOP 
  
 CPR9B    BX0    X6          INSERT UPPER TRAILER BYTE
          EQ     CPR9A       LOOP 
  
 CPR9C    ZR     B5,CPR9D    IF NOT FORMING *TLBC2* 
          ADDWRD B5,X0       ADD FINAL TRAILER BYTE AND/OR ZERO 
 CPR9D    SB6    B6+B1       ADVANCE FETCH POINTER
          EQ     B6,B7,CPR10 IF AT END OF *TXLBC* 
          SA2    A5          GET NEXT NAME WORD 
          SA1    X2+B6
          EQ     CPR8        LOOP 
          SPACE  4
**        CPRELT - ENTER EXTERNAL NAME INTO *TLNK* FROM *CPR*.
* 
*              THIS ROUTINE IS CALLED FROM *CPR* TO ENTER AN EXTERNAL 
*         NAME INTO *TLNK*.  CALLS *SEN* TO SUBSTITUTE FOR THE NAME 
*         IF UNDER SUBSTITUTE CONTROL.  NAMES ARE FROM *TLBC* AND 
*         *TXLBC*.  CALLS *ELT* TO ENTER THE NAME INTO *TLNK* AND 
*         THEN ENSURES THAT THE *R* AND *W* BITS IN THE *TLNK* DEF
*         WORD ARE SET UP PROPERLY. 
* 
*         ENTRY  (X1) = EXTERNAL NAME AS FROM *TLBC*/*TXLBC*. 
*                       I.E. 42/0LNAME,18/FLAGS.
*         EXIT   (X5) = 42/0LNAME,18/0 (NAME MAY BE CHANGED BY *SEN*) 
*         USES   X - 2, 4, 5, 6, 7. 
*                B - 2. 
*                A - 4, 6, 7. 
*         CALLS  SEN, ELT.
  
 CPRELT   PS                 ENTRY/EXIT 
          SX7    B1 
          BX5    X1*X7       (X5) = 1 IFF *WEAK* EXTERNAL 
          LX7    58          DEFINITION = UNSATISFIED 
          LX5    55          POSITION *WEAK* BIT
          BX7    X7+X5       DEF = UNSAT + *W* BIT
          RJ     SEN         CHECK SUBSTITUTION (POSSIBLY DO IT)
          BX2    X7          SET DEFINITION 
          LX5    X1          SET (X5) AS PER EXIT REQUIREMENTS
          RJ     ELT         ENTER LINK 
          SX2    B1          ENSURE *STRONG* EXT OVERRIDES *WEAK* 
          BX2    -X2+X5      BITS 59-1 SET, BIT 0 SET IFF *WEAK*
          LX2    55          MASK BIT TO BIT 55 
          SA4    TLNK        FWA *TLNK* 
          SB2    X6          INDEX TO *TLNK* DEF WORD 
          SA4    X4+B2       (X4) = *TLNK* DEF WORD 
          BX6    X2*X4       *STRONG* OVERRIDES *WEAK*
          BX7    X5          CHECK THE WEAK FLAG
          LX7    59 
          MI     X7,CPRELT.1 IF NEW REF *WEAK*
          LX4    59-55       CHECK *TLNK* REF TYPE
          PL     X4,CPRELT.1 IF ALREADY A *STRONG* REF
          SX7    B1          SET FLAG TO INDICATE CHANGE
          SA7    CFWTS       FROM *WEAK* TO *STRONG*
 CPRELT.1 BSS    0
          MX4    1
          BX6    X4+X6       SET *REFERENCED* BIT 
          SA6    A4          CHANGE *TLNK* DEF WORD 
          MX7    42          MASK 
          BX5    X5*X7       (X5) = 42/0LNAME,18/0
          EQ     CPRELT      RETURN 
  
 CFWTS    CON    0           NZ IF CHANGE FROM *WEAK* TO *STRONG* 
 SEN      SPACE  4,8
**        SEN - SUBSTITUTE EXTERNAL NAME. 
* 
*              THIS ROUTINE CHECKS IF A GIVEN EXTERNAL NAME IS TO BE
*         REPLACED WITH ANOTHER NAME AS A RESULT OF A *SUBST* REQUEST.
* 
*         ENTRY  (X1) = 42/0LNAME,18/FLAGS. 
*         EXIT   (X1) = UNCHANGED IF NO SUBSTITUTION. 
*                       NAME CHANGED IF SUBSTITUTION. 
*         USES   X - 2, 3, 4, 6.
*                B - 2, 3.
*                A - 2, 3.
*         CALLS  NONE.
  
  
 SEN      PS                 ENTRY/EXIT 
          SA2    TSUBST 
          SA3    A2+B1
          SB2    X2          (B2) = FETCH ADDRESS 
          IX4    X2+X3
          ZR     X3,SEN      IF *TSUBST* EMPTY
          SB3    X4          (B3) = LWA+1 OF FETCH
          MX2    42 
          BX6    -X2*X1      (X6) = SAVED FLAGS 
          BX1    X2*X1       CLEAR FLAGS IN X1
 SEN1     SA2    B2          NEXT ENTRY 
          SA3    B2+B1
          SB2    A3+B1
          BX4    X2-X1
          ZR     X4,SEN2     IF NAME MATCHED THIS ENTRY 
          LT     B2,B3,SEN1  LOOP THROUGH TABLE 
          BX1    X1+X6       RESTORE FLAGS WITH NAME
          EQ     SEN         NOT IN TABLE - EXIT
  
 SEN2     BX1    X3+X6       REPLACE NAME AND RESTORE FLAGS 
          EQ     SEN         EXIT 
 RPL      TITLE  LOAD COMPLETION SUBROUTINE - PROCESS REPLICATIONS. 
**        RPL - PROCESS REPLICATIONS. 
* 
*              THIS ROUTINE PERFORMS ALL REPLICATIONS.  THE A0 REGISTER 
*         INDICATES THE TABLE CONTAINING THE ACCUMULATED REPLICATION
*         TABLES.  THERE ARE TWO TYPES OF REPLICATION ALLOWED 
* 
*         1) BOTH SOURCE AND DESTINATION ADDRESSES ARE CM.
*         2) BOTH SOURCE AND DESTINATION ADDRESSES ARE ECS. 
* 
*              SEE THE MANAGE TABLE DESCRIPTION OF *TREP* FOR THE FORMAT
*         OF THE TABLE PROCESSED BY THIS ROUTINE. 
* 
*         ENTRY  (A0) = REPLICATION TABLE POINTER.
*         EXIT   THE TABLE IS EMPTIED.
*         USES   ALL REGISTERS EXCEPT B1. 
*         CALLS  RE=, WE=.
  
  
 RPL      PS                 ENTRY/EXIT 
          SA2    A0          FWA OF REPLICATION TABLE 
          SA1    A0+B1       (B7) = WORD COUNT
          MX7    0           CLEAR REPLICATION TABLE
          SA7    A1 
          SB4    B1+B1
          SA3    TPGM        (B6) = FWA PROGRAM 
          SB7    X1 
          SB6    X3 
          R=     A5,X2-2     INITIALIZE FETCH OF REPLICATIONS 
 RPL1     ZR     B7,RPL      IF NO MORE REPLICATIONS
          SA5    A5+B4       1ST WORD OF NEXT PAIR
          SA1    A5+B1       2ND WORD 
          ZR     X5,RPL7     IF NULL ENTRY
          SB2    X5          (B2) = S (SOURCE ADDRESS)
          LX5    59-23
          IFTEST NE,IP.MECS,0,1 
          NG     X5,RPL10    IF ECS REPLICATION 
          IFUSER 4
          LX2    X5,B1       EXTEND BIT 22 AND USE IT TO SET
          SX4    B6          (X0) TO ZERO OR FWA *TPGM* 
          AX2    60 
          BX0    -X2*X4 
          SX3    X1          (X3) = D (DESTINATION ADDRESS) 
          LX1    -24         (X2) = B (BLOCK SIZE)
          SX2    X1 
          LX1    -18         (B4) = C (REPEAT COUNT)
          SB4    X1 
          SB5    X5          (B5) = K (INCREMENT) 
  
 IU       IFUSER
          LX1    59-22+24+18-60    EXTEND BIT 22 AND USE IT TO SET
          SX4    B6          (X1) TO ZERO OR FWA *TPGM* 
          AX1    60 
          BX1    -X1*X4 
          SB2    X0+B2       SET S AND D ABSOLUTE 
          IX3    X1+X3
 IU       ENDIF 
  
          IFCARD 2
          SB2    B6+B2       SET S AND D ABSOLUTE 
          SX3    B6+X3
  
*         LOOP FOR CM TO CM REPLICATION.
  
 RPL4     SB3    X2          RESET B
          SA1    B2          MOVE FIRST WORD
          BX7    X1 
          SA7    X3 
 RPL5     SB3    B3-B1       B = B-1
          ZR     B3,RPL6     IF BLOCK MOVED 
          SA1    A1+B1       MOVE NEXT WORD 
          BX7    X1 
          SA7    A7+B1
          EQ     RPL5        LOOP 
  
 RPL6     SB4    B4-B1       C = C-1
          SX3    X3+B5       D = D+I
          NZ     B4,RPL4     LOOP C TIMES 
 RPL7     SB4    B1+B1
          SB7    B7-B4       DECREMENT WORD COUNT 
          EQ     RPL1        LOOP 
  
 ECS      IFTEST NE,IP.MECS,0 
  
*         ECS-TO-ECS REPLICATION. 
  
 RPL10    SB5    X5          (B5) = K (INCREMENT) 
          MX2    -23
          BX0    -X2*X1      (X0) = D (DESTINATION ADDRESS) 
          LX5    -59+23      (X5) = S (SOURCE ADDRESS)
          BX5    -X2*X5 
          LX1    -24
          SB2    X1          (B2) = B (BLOCK SIZE)
          LX1    -18
          SB4    X1          (B4) = C (REPEAT COUNT)
  
*         REPLICATION LOOP. 
  
          SB3    B0          FETCH/STORE INDEX
 RPL15    SX6    B3          (X2) = NEXT FETCH ADDRESS
          IX2    X6+X5
          RJ     RE=         READ 1 WORD FROM ECS TO X1 
          IX2    X0+X6       (X2) = NEXT STORE ADDRESS
          BX6    X1          WRITE (X6) TO ECS
          RJ     WE=
          SB3    B3+B1       ADVANCE INDEX
          LT     B3,B2,RPL15 LOOP FOR ONE BLOCK MOVE
          SB4    B4-B1       C = C - 1
          SX4    B5          D = D+K
          IX0    X0+X4
          SB3    B0          RESET INDEX
          NZ     B4,RPL15    LOOP C TIMES 
          EQ     RPL7        PROCESS NEXT WORD PAIR 
  
 ECS      ENDIF 
 USX      TITLE  LOAD COMPLETION SUBROUTINE - UNSATISFIED EXTERNALS.
**        UXCK - CHECK IF UNSATISFIED EXTERNALS PRESENT.
* 
*         ENTRY  NONE.
*         EXIT   (X6) = 0 IF NO UNSATISFIED EXTERNALS.
*                     = 1 IF UNSATISFIED EXTERNALS. 
*         NOTE - *OMITS* AND *WEAK* EXTERNALS ARE NOT CONSIDERED
*                HERE AS UNSATISFIED.  (SPEEDS UP *SAT* LOOP).
*         USES   X - 1, 2, 6. 
*                B - 2, 3.
*                A - 1, 2.
*         CALLS  NONE.
  
  
 UXCK     PS                 ENTRY/EXIT 
          SA1    TLNK        (X1) = FWA *TLNK*
          SA2    A1+B1       (X2) = LENGTH *TLNK* 
          SB2    X1 
          SB3    X2+B2       (B3) = LWA+1 *TLNK*
          SB2    B2-B1       (B2) = FWA-1 *TLNK*
          MX6    0           INITIALIZE NO UNSATISFIEDS FLAG
 UXCK1    R=     B2,B2+2     POINT TO NEXT DEF WORD IN *TLNK* 
          GE     B2,B3,UXCK  IF *TLNK* EXHAUSTED
          SA1    B2          GET NEXT DEF WORD FROM *TLNK*
          LX1    B1 
          PL     X1,UXCK1    IF SATISFIED 
          LX1    B1 
          MI     X1,UXCK1    IF OMITTED 
          LX1    2
          MI     X1,UXCK1    IF WEAK EXTERNAL 
          SX6    B1          SET FLAG INDICATING UNSATISFIEDS 
          EQ     UXCK        RETURN 
  
 USX      SPACE  4,8
**        USX - PROCESS UNSATISFIED EXTERNAL REFERENCES.
* 
*              THIS ROUTINE INSURES THAT ALL UNSATISFIED EXTERNALS WILL 
*         BE FILLED WITH THE VALUE 400000B+ADR DURING THE LAST TIME 
*         THROUGH THE SUBROUTINE *LBC*.  IT IS ALSO HERE THAT THE NON-
*         FATAL ERROR FOR EACH UNSATISFIED EXTERNAL IS ISSUED.
* 
*         CALLS  ERROR. 
  
  
 USX      PS                 ENTRY/EXIT 
          IFCARD 2
          SA1    ABS         IF ABSOLUTE PROGRAM DON-T CHECK
          NZ     X1,USX      UNSATISFIED EXTERNALS
          SA0    TLNK        SET FOR LATER
          SA1    A0 
          MX0    1           FLAG FOR ADR = 400000B+ADR 
          SA3    A1+B1
          SB5    -B1         (B5) = *TLNK* FETCH POINTER
          SB6    X3          (B6) = *TLNK* LENGTH 
          LX0    -2 
          SB7    B1+B1       (B7) = 2 
 IC       IFCARD
          SA3    SEGFLAG
          ZR     X3,USX1     IF NOT A SEGMENT LOAD
          SX3    B7+B1
          LX3    36+1 
          BX0    X0+X3       SET PROGRAM INDEX TO ROOT SEGMENT
 IC       ENDIF 
 USX1     SA3    A0 
          SB5    B5+B7       ADVANCE POINTER
          GT     B5,B6,USX   IF AT END OF *TLNK*
          SA5    X3+B5       NEXT ENTRY 
          R=     X4,21B      PRESERVE *R* *W* BITS FROM *TLNK* DEF WORD 
          LX4    59-4 
          BX4    X4*X5
          BX4    X4+X0       (X4) = (X0) + *R* + *W*
          LX5    1
          PL     X5,USX1     IF SATISFIED 
          LX2    X5,B7       GET *BC* FIELD 
          NG     X2,USX1     IF ENTRY POINT IS IN BLANK COMMON
          BX7    X4 
          LX3    X5,B1
          SA7    A5          FORCE AS UNSATISFIED 
          SA2    A5-B1       (X7) = EXTERNAL NAME 
          BX7    X2 
          NG     X3,USX1     IF UNDER *OMIT* CONTROL
          LX3    2
          MI     X3,USX1     IF WEAK EXTERNAL 
 IC       IFCARD
          SA3    OG 
          MI     X3,USX1     IF CAPSULE GENERATION THEN NOT AN ERROR
          R=     X3,X3-2
          ZR     X3,USX1     IF OVCAP GENERATION THEN NOT AN ERROR
 IC       ENDIF 
          LX7    18 
          ERROR  4100,X7     ---- UNSATISFIED EXTERNAL REF
          EQ     USX1        LOOP TO END OF TABLE 
 PNF      SPACE  4,8
**        PNF - PROCESS PROGRAMS NOT FOUND. 
* 
*              WE CHECK *TUSEP* TO CHECK THAT ALL PROGRAMS REQUESTED
*         BY *USEP* REQUESTS OR BY *TREE* OR *INCLUDE* SEGMENT
*         DIRECTIVES HAVE BEEN FOUND.  IF NOT A NON-FATAL ERROR IS
*         ISSUED. 
* 
*         USES   X - 1, 2, 7. 
*                B - 7. 
*                A - 1, 2.
*         CALLS  ERROR. 
  
 PNF      PS                 ENTRY/EXIT 
          SA1    TUSEP
          SB7    B0          (B7) = CURRENT INDEX 
          SA2    A1+B1
          SB6    X2          (B6) = LENGTH OF *TUSEP* 
 PNF1     GE     B7,B6,PNF   IF END OF TABLE
          SA2    X1+B7
          SB7    B7+B1
          ZR     X2,PNF1     IF ENTRY HAS BEEN ZEROED BY *SAT*
          MX7    42 
          BX7    X7*X2
          ERROR  4201,X7     ---- PROGRAM NOT FOUND 
          SA1    TUSEP
          EQ     PNF1 
 WLI      TITLE  LOAD COMPLETION SUBROUTINE - WRITE LOADER INFORMATION. 
**        WLI - WRITE LOADER INFORMATION. 
* 
*              THIS ROUTINE IS CALLED AT LOAD COMPLETION TO SAVE
*         INFORMATION NEEDED FOR 1) USER CALL PROCESSING, AND 
*         2) DEBUGGING AIDS.
* 
*              DURING CONTROL-CARD-INITIATED LOADS, THIS INFORMATION
*         IS WRITTEN ONLY IF USER CALLS ARE POSSIBLE OR IF A *TRAP* 
*         RUN IS TAKING PLACE (DEBUG AIDS).  DURING USER-CALL LOADS,
*         IT IS WRITTEN IN ANY CASE.
* 
*              THE INFORMATION CONSISTS OF THE FOLLOWING BEING WRITTEN
*         TO FILE *ZZZZZ17* - 
* 
*         RECORD 1 -
* 
*              WORD 1  -  VFD 42/(1ST XFER NAME),18/(1ST XFER ADDRESS)
*              WORD 2  -  VFD 60/(CONTENTS OF CONTROL POINT W.CPLDR1) 
* 
*         RECORD 2  -  CONTENTS OF *TBLK*.
*         RECORD 3  -  CONTENTS OF *TLNK*.
*         RECORD 4  -  CONTENTS OF *TLFN*.
*         RECORD 5  -  WORD CONTAINING LENGTH OF GLOBAL LIBRARY SET,
*                      FOLLOWED BY THE CONTENTS OF *TLIB*.
*         RECORD 6  -  CONTENTS OF *TPRX* (AN EMPTY RECORD IF *TPRX*
*                      WAS EMPTY).
* 
*         CALLS  ELT, SETFET=, WTW=, CIO=, WLT. 
  
  
 WLI      PS                 ENTRY/EXIT 
 L1       IFCARD
          SA1    =0LLOADER
          MX2    0           SEARCH LINK TABLE
          RJ     ELT
          NZ     X2,WLI1     IF *LOADER* PRESENT
          SA1    =0LLOADER. 
          RJ     ELT         LOOK FOR *LOADER.* - *PILOAD* PRESENT
          NZ     X2,WLI1     IF *LOADER.* PRESENT 
          SA1    =0LLOADER= 
          IFTEST NE,IP.TRAP,0,1 
          SA5    TRAPADR
          RJ     ELT
          IFTEST EQ,IP.TRAP,0,1 
          ZR     X2,WLI      IF *LOADER=* NOT PRESENT 
          IFTEST NE,IP.TRAP,0,2 
          NZ     X2,WLI1     IF *LOADER=* PRESENT 
          ZR     X5,WLI      IF NOT A *TRAP* RUN
 WLI1     BSS    0
 L1       ENDIF 
  
          SMSG   (=C/  WRITING ZZZZZ17/)
  
*         INITIALIZE FET FOR FILE *ZZZZZ17*.
  
          RECALL L           WAIT FOR ANY ACTIVITY ON OTHER FILE
          SETFET X2,(=0LZZZZZ17),BINARY 
          REWIND X2,RCL 
  
*         WRITE MISCELLANEOUS LOADER INFORMATION TO 1ST RECORD. 
  
          SX5    CTLPT
          WRITEW X2,XF,1     SAVE TRANSFER ADDRESS
          WRITEW X2,X5,1     SAVE CONTROL POINT FLAGS 
          WRITER X2,RCL      EOR FOR 1ST RECORD 
  
*         WRITE MANAGE TABLES.
  
          SA5    TBLK        SAVE *TBLK*
          RJ     WLT
          SA5    TLNK        SAVE *TLNK*
          SA4    A5+B1
          R=     B2,2 
          NZ     X4,WLI1A    IF *TLNK* NOT EMPTY
          RJ     WLT         WRITE EMPTY RECORD 
          EQ     WLI4 
  
 WLI1A    SB3    X5 
          SB4    X4 
          R=     B5,18
 WLI2     SB4    B4-B2       SHIFT NAMES IN *TLNK* TO UPPER 42
          SA3    B3+B4       BITS.  THIS IS THE EXPECTED FORMAT 
          LX6    X3,B5       OF *ZZZZZ17*.
          SA6    A3 
          GT     B4,B0,WLI2 
          RJ     WLT
          SA5    A5 
          SA4    A5+B1       RESTORE *TLNK* SO THAT NAMES ARE IN
          R=     B2,2        LOWER 42 BITS.  THIS IS NECESSARY
          SB3    X5          SINCE THE TABLE MAY STILL BE USED
          SB4    X4          PRIOR TO ENTERING THE MAP ROUTINE
          R=     B5,42       (WHERE IT GETS CHANGED FOR GOOD).
 WLI3     SB4    B4-B2
          SA3    B3+B4
          LX6    X3,B5
          SA6    A3 
          GT     B4,B0,WLI3 
 WLI4     SA5    TLFN        SAVE *TLFN*
          RJ     WLT
          WRITEW X2,LP,1     SAVE LENGTH OF GLOBAL LIBRARY SET
          SA5    TLIB        AND SAVE *TLIB*
          RJ     WLT
          SA5    TPRX        SAVE *TPRX*
          RJ     WLT
          EQ     WLI         EXIT 
 WLT      SPACE  4,8
**        WLT - WRITE LOADER TABLE. 
* 
*              THIS ROUTINE WRITES THE CONTENTS OF ONE MANAGE TABLE 
*         TO THE FILE *ZZZZZ17*.
* 
*         ENTRY  (X5) = FWA OF TABLE. 
*                (A5) = ADDRESS OF 1ST TABLE POINTER WORD.
*                THE FET IS SET UP FOR FILE *ZZZZZ17*, AND THE FILE IS
*                POSITIONED FOR THE WRITE.
*         EXIT   NONE.
*         USES   X - 0, 1, 2, 3, 5. 
*                B - NONE.
*                A - 1. 
*         CALLS  WTW=, CIO=.
  
  
 WLT      PS                 ENTRY/EXIT 
          SX2    L           (X2) = FET ADDRESS 
          SA1    A5+B1       (X0) = LWA+1 OF TABLE
          IX0    X5+X1
 WLT1     IX3    X5-X0
          ZR     X3,WLT2     IF AT END OF TABLE 
          WRITEW X2,X5,1     OUTPUT NEXT TABLE WORD 
          SX5    X5+B1       ADVANCE TABLE FETCH ADDRESS
          EQ     WLT1        LOOP 
  
 WLT2     WRITER X2,RCL      ISSUE END-RECORD WRITE 
          EQ     WLT         EXIT 
 CFP      SPACE  4,8
 IC       IFCARD
**        CFP - CHECK FOR FIRST PROGRAM UNDER INTERACTIVE DEBUG.
* 
*              IF BIT 59 OF WORD *ID* IS NOT SET AND *ID* IS NON-ZERO 
*         THEN SPECIAL PROCESSING MUST BE DONE FOR FORTRAN INTERACTIVE
*         DEBUG.
*                1) ALLOCATE A BUFFER FOR FET *O* AND REWIND ANY
*                EXISTING *ZZZZZDT* FILE. 
*                2) SET BIT 59 OF WORD *ID*.IF BIT 0 WAS SET ONLY THE 
*                *ZZZZZDT* FILE WAS REQUESTED AND NO FURTHER PROCESSING 
*                IS REQUIRED. 
*                3) CLEAR *TPRX* TABLE TO REMOVE *PRFX* TABLE INFO READ.
*                4) CLEAR *TREQ2* TABLE TO REMOVE *LDSET* TABLES JUST READ. 
*                5) ADD A LIBLOAD REQUEST TO THE FRONT OF TABLE *TREQ*
*                TO LOAD THE DEBUG PROGRAM FIRST. 
*                6) CHECK THE CURRENT READ AND BACKSPACE ANY LOCAL FILE 
*                LOAD.
*                7) ADD THE DEBUG TRANSFER NAME TO *TPGM*.
*                8) PREALLOCATE *TFID* TO COMPENSATE FOR THE FIRST
*                THREE ENTRIES IN *TBLK*. 
* 
*         EXIT   TO *REQ*.
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*         CALLS  ATS=, APS=, CIO=, MVE=, SETFET=, SKIP=.
  
  
 CFP      PS                 ENTRY/EXIT 
          SA1    ID 
          ZR     X1,CFP      IF NO INTERACTIVE DEBUG PROCESSING AT ALL
          MI     X1,CFP      IF WE HAVE ALREADY DONE OUR JOB
          ALLOC  FTAB,IP.DBUF          ALLOCATE SPACE FOR BUFFER
          IX7    X1+X2
          BX6    X4 
          SA7    O+4         SET NEW LIMIT FOR FET *O*
          SA7    A2          SET NEW FWA OF TABLE 
          SA7    LM          SET NEW MEMORY LIMIT 
          SA6    A2+B1       RESET LENGTH OF TABLE
          MOVE   X4,X2,X7    MOVE TABLE UP
          SETFET O,CFPA,BINARY
          REWIND O,RCL       REWIND ANY EXISTING *ZZZZZDT* FILE 
          MX6    1
          SA1    O+1
          LX6    48 
          BX6    X6+X1
          SA6    A1          SET RANDOM BIT IN FET *O*
          SA1    TBLK+1      (X1) = NO. OF *TBLK* ENTRIES BEFORE 1ST
          AX1    1                  PROGRAM REQUIRING A *TFID* ENTRY
          ADDWRD TFID,X1     PUT FLAG WORD IN *TFID*
          MX6    1
          SA1    ID 
          BX6    X1+X6
          AX1    1           REMOVE *PMD* BIT 
          SA6    A1          SET BIT 59 OF *ID* 
          ZR     X1,CFP      IF ONLY *ZZZZZDT* FILE TO GENERATE 
          SX7    B0 
          SA2    TPRX 
          SA7    TREQ2+1     CLEAR EXISTING *LDSET* REQUESTS
          SA7    TLNK2+1     CLEAR EXISTING *LIBLOAD* ENTRY NAMES IF ANY
          SA7    A2+B1       CLEAR EXISTING PREFIX TABLE
          SA7    X2          CLEAR FIRST WORD OF *TPRX* 
          ALLOC  TREQ,3,FRONT  ADD LIBLOAD REQUEST FOR DEBUG PROGRAM
          SX1    CLIBLOAD 
          SX2    B1+B1       WORD COUNT OF REQUEST
          LX1    48 
          LX2    36 
          BX6    X1+X2
          SA6    X3          ADD REQUEST HEADER 
          SA1    CFPB        LIBRARY NAME 
          SA2    TA          LIBLOAD ENTRY POINT NAME 
          BX6    X1 
          LX7    X2 
          SA6    A6+B1
          SA7    A6+B1
          SA3    EPTC 
          SX1    B1 
          SX6    X3+B1
          MX2    0           ALLOCATE FOR CM
          SA6    A3          ADD DEBUG ENTRY POINT TO HEADER
          RJ     APS=        ALLOCATE SPACE FOR ENTRY POINT 
          SA1    TA 
          BX6    X1 
          IX3    X2+X3
          SA4    MAXOV       (X4) = LENGTH OF *FOL* DIRECTORY 
          IX3    X3-X4       BACK OVER *FOL* DIRECTORY TO EPT LIST
          SA6    X3-1        ADD NAME TO *TPGM* 
          SA2    BI 
          SA4    PO 
          SX7    X2+B1
          SX6    X4+B1
          SA7    A2 
          SA6    A4 
          SA1    FI 
          SA2    TLFN 
          IX3    X1+X2
          SA4    X3 
          SX6    -B1
          SX4    X4 
          SA6    PC          SO THAT *ON* = SECOND PROGRAM NAME 
          NZ     X4,REQ1     IF LOAD FROM A LIBRARY-NO BACKSPACE NEEDED 
          SKIPB  L,1,0,RCL
          SA1    TREQ 
          SA2    X1+4        SET *LOAD* OR *SLOAD* LFN WORD 
          SX6    B1+B1
          MX3    -1 
          BX2    X3*X2       REMOVE REWIND INDICATOR
          BX6    X2+X6       ADD SPECIFICATION BIT
          SA6    A2          RESTORE LFN WORD 
          EQ     REQ1        START ALL OVER AGAIN 
  
 CFPA     CON    0LZZZZZDT   INTERACTIVE DEBUG FILE 
 CFPB     CON    0LDBUGLIB   INTERACTIVE DEBUG LIBRARY
 CII      SPACE  4,8
**        CII - ADD CORE IMAGE INDEX TO FILE *ZZZZZDT*. 
* 
*              IF WE ARE IN DEBUG MODE (*ID* IS NON-ZERO) WE COMPLETE 
*         FILE *ZZZZZDT* BY WRITING THE CORE IMAGE INDEX AS AN INDEX
*         RECORD.  FET *O* MUST BE DEALLOCATED AND THE PROCESSOR BITS 
*         WRITTEN INTO THE LOADER CONTROL WORD IN THE CONTROL POINT 
*         AREA.  THE FLAG *ID* IS CLEARED TO PREVENT *ZZZZZDT* FROM 
*         BEING USED IN *OVCAP* GENERATION. 
* 
*              THE *ZZZZZDT* FILE CONSISTS OF ONE RECORD FOR EACH CORE
*         IMAGE GENERATED (PROVIDED BIT 0 OF WORD *ID* WAS SET).  EACH
*         RECORD CONSISTS OF *PIDL*, *LINE* NUMBER AND *SYMBOL* TABLES
*         AS ENCOUNTERED DURING THE LOAD.  USUALLY THIS WILL CONSIST
*         OF SETS OF THREE TABLES, ONE FOR EACH PROGRAM.  THE RECORD
*         IS COMPLETED BY WRITING THE BLOCK AND ENTRY POINT TABLES.  IF 
*         ONLY BIT 1 IS SET IN WORD *ID* THEN THE *ZZZZZDT* FILE
*         CONSISTS OF ONLY THE CORE IMAGE INDEX.  THE CORE IMAGE INDEX
*         HAS THE SAME FORMAT AS THE MANAGED TABLE *TCII* WITH AN 
*         ADDITIONAL HEADER WORD WHICH IS OF THE FORMAT --
*         24/0,6/DEBUG VERSION NUMBER,12/DEBUG CONTROL BYTE,18/NUMBER 
*         OF ENTRIES. 
* 
*         ENTRY  FET *O* SET UP FOR FILE *ZZZZZDT*. 
*         EXIT   *ID* = 0.
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - NONE.
*                A - 1, 2, 3, 6.
*         CALLS  CIO=, CPM=, LDL. 
  
  
 CII      PS                 ENTRY/EXIT 
          SA1    ID 
          SA2    ABS
          ZR     X1,CII      IF NOT UNDER DEBUG MODE - NOTHING TO DO
          NZ     X2,CII      IF ABS LOAD
          SX6    B0 
          SA2    TCII 
          SA6    A1          CLEAR INTERACTIVE DEBUG MODE 
          SA3    A2+B1
          BX4    X3          *TCII* LENGTH
          SX7    3           3 WORDS PER *TCII* ENTRY 
          IX6    X4/X7,B1    (X6) = NO. OF TABLE ENTRIES
          SB1    1           RESTORE (B1) 
          MX4    12 
          SA1    CTLPT       LOADER CONTROL WORD
          LX1    24 
          BX1    X4*X1       SAVE ONLY DEBUG CONTROL BYTE 
          LX1    30 
          BX6    X1+X6
          SA1    IDVER       GET CURRENT VERSION NUMBER 
          LX1    30 
          BX6    X6+X1       (X6) = 24/0,6/VN,12/IDCB,18/NO. OF ENTRIES 
          SX2    X2-1        (X2) = FWA-1 OF *TCII* 
          SA6    X2 
          SX3    X3+B1       (X3) = *TCII* LENGTH + 1 
          LX3    18 
          BX6    X3+X2       FORM INDEX BUFFER FWA AND LENGTH 
          SA6    O+7
          CIOCALL O,RCL,CLOSE  WRITE INDEX TO FILE *ZZZZZDT*
 S        IFSCOPE 
          SX1    B1 
          SX2    B1+B1
          SX3    CTLPT
          SX4    W.CPLDR1 
          LX1    24 
          BX6    X1+X2       ADD LENGTH OF WRITE TO FUNCTION CODE 
          LX3    36 
          LX1    54-24
          LX4    12 
          BX7    X3+X4
          BX6    X6+X1
          BX6    X6+X7       6/1,18/CTLPT,12/1,12/W.CPLDR1,12/2 
          SA6    T1 
          LDL    A6          ADD PROCESSOR BITS TO LOADER CONTROL WORD
 S        ELSE
          SETLC  CTLPT       SET PROCESSOR BITS IN LOADER CONTROL WORD
 S        ENDIF 
          SA1    O+1
          SX6    X1 
          SA6    O+4         SET FET *O* TO EMPTY BUFFER
          SA6    LM          SET NEW LOW MEMORY ADDRESS 
          EQ     CII
 FID      SPACE  4,8
**        FID - WRITE BLOCK AND ENTRY POINT TABLES FOR FID. 
* 
*              THE BLOCK AND ENTRY POINT TABLES ARE WRITTEN TO FILE 
*         *ZZZZZDT* IN THE FOLLOWING FORMATS FOR FORTRAN INTERACTIVE
*         DEBUG.  THIS IS ONLY DONE WHEN BIT 0 OF WORD *ID* IS SET. 
*         WHENEVER WORD *ID* OR *MAXOV* IS NON-ZERO WE CREATE A 
*         CORE IMAGE ENTRY IN TABLE *TCII*. 
* 
*         BLOCK TABLE ENTRY FORMAT
* 
*                42/NAME,1/T,1/C,4/0,12/PWC 
*                12/SL,24/LEN,24/FWA
*                30/SYM,30/P       (ONLY IF C=0)
*                30/0,30/LIN       (ONLY IF C=0)
* 
*         NAME = BLOCK OR PROGRAM NAME. 
*         T    = ECS/CM FLAG.  0 FOR CM.
*         C    = PROGRAM/BLOCK FLAG.  1 FOR BLOCK.
*         PWC  = LENGTH OF PROGRAM *PIDL* TABLE.
*         SL   = SOURCE LANGUAGE ORDINAL. 
*         LEN  = LENGTH OF BLOCK OR PROGRAM.
*         FWA  = FWA OF BLOCK OR PROGRAM. 
*         SYM  = LOGICAL DISK ADDRESS OF FIRST *SYMBOL* TABLE.
*         P    = LOGICAL DISK ADDRESS OF *PIDL* TABLE.
*         LIN  = LOGICAL DISK ADDRESS OF *LINE NUMBER* TABLE. 
* 
* 
*         ENTRY POINT TABLE ENTRY FORMAT (IN ALPHABETICAL ORDER)
* 
*                42/NAME,18/0 
*                1/T,35/0,24/ADR
* 
*         NAME = ENTRY POINT NAME.
*         T    = CM/ECS FLAG.  0 FOR CM.
*         ADR  = ADDRESS OF ENTRY POINT.
* 
*         EXIT   *LA* UPDATED FOR NEXT PRU. 
*         USES   ALL REGISTERS EXCEPT B1, A0. 
*         CALLS  ATS=, CIO=, WTO=.
  
  
 FID      PS                 ENTRY/EXIT 
          SA2    ABS
          SA5    ID 
          NZ     X2,FID      IF ABS LOAD
          SA2    MAXOV       CHECK IF AN *FOL* DIRECTORY IS NEEDED
          BX5    X2+X5       IF AN *FOL* DIRECTORY IS NEEDED
          ZR     X5,FID      IF NOT *FID* AND NOT *FOL* 
          ALLOC  TCII,3      CREATE NEW CORE IMAGE ENTRY
          SA1    OGL1 
          SA2    OGL2 
          SA4    PA 
          LX1    54 
          LX2    48 
          BX6    X4+X1
          BX6    X6+X2       6/L1,6/L2,30/0,18/LWA
          SA6    X3+B1
          SB6    A6+B1       (B6) = ADDRESS OF WORD CONTAINING *EP* 
          SA2    PO 
          SA4    EPTC 
          R=     X6,4        LENGTH OF NON (0,0) OVERLAY HEADER 
          NZ     X1,FID1     IF NOT (0,0) OVERLAY 
          R=     X6,10B      LENGTH OF (0,0) HEADER 
          SA1    MAXOV
          IX6    X6+X1       ADD (MAXOV) TO HEADER LENGTH 
 FID1     IX6    X2-X6
          SA1    ON 
          IX6    X6-X4
          SA2    OG 
          ZR     X2,FID2     IF RELOCATABLE LOAD SET NAME = 0 
          BX6    X1+X6
 FID2     SA6    X3          42/NAME,18/FWA 
          SA2    TBLK 
          LX5    59-0 
          SB2    X2          (B2) = FWA OF *TBLK* 
          PL     X5,FID      IF WE ARE NOT WRITING A COMPLETE *ZZZZZDT* 
  
*         ADD ENTRY POINT TABLE TO FILE *ZZZZZDT*.
  
          SA1    IBI
          SA2    TLNK 
          SB5    B0          (B5) = CURRENT INDEX IN *TLNK* 
          SB3    X1          (B3) = - *TBLK* INDEX FOR START OF OVERLAY 
          SA3    A2+B1
          SB4    X3          (B4) = LENGTH OF *TLNK*
          SB7    X2          (B7) = FWA OF *TLNK* 
          SA5    LA          (X5) = LOGICAL DISK ADDRESS
          BX6    X5 
          SB3    -B3
          LX6    30 
          SA6    B6          ADD *EP* FIELD TO *TCII* ENTRY 
 FID3     GE     B5,B4,FID4  IF NO MORE *TLNK* ENTRIES
          SA1    B7+B5       *TLNK* ENTRY 
          SA2    A1+B1
          MX0    -24
          SB5    B5+2        UPDATE CURRENT INDEX INTO *TLNK* 
          BX0    -X0*X2      ADDRESS OF ENTRY 
          MX6    18 
          BX6    -X6*X1      NAME 
          LX6    18 
          AX2    36 
          SX4    X2+B3
          SA3    B2+X2       *TBLK* ENTRY DEFINING BASE ADDRESS 
          SX7    B1+B1
          BX7    X7*X3       *T* BIT
          LX7    59-1 
          BX0    X7+X0
          MI     X4,FID3     IF THIS ENTRY NOT IN THIS OVERLAY
          SX4    B1+B1
          IX5    X4+X5       UPDATE LOGICAL DISK ADDRESS
          WRITEO O
          BX6    X0 
          WRITEO O
          EQ     FID3 
  
*         ADD BLOCK TABLE TO FILE *ZZZZZDT*.
  
 FID4     SA4    TFID 
          SA3    TBLK+1 
          SA2    X4          K = NO. OF *TBLK* ENTRIES WHICH DO NOT 
          BX2    -X2             HAVE *TFID* ENTRIES
          LX1    X2,B1       (B4) = -3K + 1 
          IX2    X2+X1
          SB4    X2+B1
          SA1    B6 
          SB3    X3          (B3) = LENGTH OF *TBLK*
          BX6    X1+X5
          SB5    B0          (B5) = CURRENT INDEX IN *TBLK* 
          BX7    X5 
          SA6    B6          ADD *B* FIELD TO TABLE 
          SA7    A5          UPDATE LOGICAL DISK ADDRESS
 FID5     GE     B5,B3,FID7  IF END OF *TBLK* 
          SA1    B2+B5       *TBLK* ENTRY 
          MX3    0           SET FOR NOT YET FETCHING FROM *TFID* 
          SA2    A1+B1
          MX6    42 
          SA4    TFID        FWA *TFID* 
          MX5    0           SET FOR NOT YET FETCHING FROM *TFID* 
          MI     B4,FID5B    IF NO *TFID* ENTRY FOR THIS *TBLK* ENTRY 
          SA3    X4+B4       *TFID* ENTRY, WORD 0 
          SA5    A3+B1       *TFID* ENTRY, WORD 1 (*SYM* AND *P*) 
 FID5B    MX7    -1 
          SB5    B5+2        UPDATE CURRENT INDEX 
          SB6    A5+B1       ADDRESS OF *LIN* FIELD 
          SB4    B4+3        UPDATE *TFID* INDEX
          MI     X2,FID5     IF UNREFERENCED BLOCK IGNORE IT
          BX6    X6*X1       NAME 
          SX4    B5-5 
          PL     X4,FID5A    IF NOT CM OR ECS //
          SA4    =7L         CHANGE NAME TO ALL BLANKS FOR // 
          BX6    X4          (X6) = 42/NAME(=BLANKS),18/0 
 FID5A    BSS    0
          BX4    -X7*X1      PROGRAM/BLOCK BIT
          LX7    1
          MX0    -24
          BX7    -X7*X1      CM/ECS BIT 
          BX0    -X0*X2      FWA OF PROGRAM OR BLOCK
          SA1    PO 
 ECS      IFNE   IP.MECS,0
          ZR     X7,FID6     IF CM BLOCK
          SA1    ECSPO
 ECS      ENDIF 
 FID6     IX1    X0-X1
          MI     X1,FID5     IF BLOCK NOT DEFINED IN THIS OVERLAY 
          BX7    X7+X4
          SB7    B1+B1
          LX7    16 
          MX1    -12
          BX4    -X4
          NZ     X4,FID6A    IF BLOCK ENTRY 
          SX4    X4+B1
 FID6A    BX1    -X1*X3      *PWC*
          SB7    X4+B7       (B7) = 1 FOR BLOCK ENTRY, 3 FOR PROGRAM
          BX6    X6+X7
          MX0    12 
          BX6    X6+X1
          BX2    -X0*X2      *LEN* AND *FWA* FIELDS 
          BX0    X0*X3       *SL* FIELD 
          BX0    X0+X2
          SA4    LA          UPDATE LOGICAL DISK ADDRESS
          SX7    B7+B1
          IX7    X7+X4
          SA7    A4 
          WRITEO O
          BX6    X0 
          WRITEO O           WRITE SECOND WORD
          EQ     B7,B1,FID5  IF THIS WAS A BLOCK ENTRY
          BX6    X5 
          WRITEO O           WRITE THIRD WORD 
          MX5    0
          LE     B4,B1,FID6B  IF NO *TFID* ENTRY (INDEX .LT. 4) 
          SA5    B6          *TFID* ENTRY, WORD 2 
 FID6B    BX6    X5 
          WRITEO O           WRITE FOURTH WORD
          EQ     FID5 
  
 FID7     SA5    LA 
          SX6    100B 
          IX6    X6+X5       ROUND UP TO NEXT PRU 
          AX6    6
          LX6    6
          SA6    A5          SET NEW LOGICAL DISK ADDRESS 
          WRITER O,RCL
          EQ     FID
 IDE      SPACE  4,8
**        IDE - ADD INTERACTIVE DEBUG ENTRY TO TABLE *TFID*.
* 
*              IF BIT 0 OF WORD *ID* IS SET WE CREATE A *TFID* ENTRY
*         WITH THE GIVEN PARAMETERS.  THIS ENTRY WILL BE UPDATED
*         DURING THE LOAD AND EVENTUALLY USED TO CREATE THE BLOCK TABLE 
*         ON FILE *ZZZZZDT*.
* 
*         ENTRY  (X1) = LENGTH OF *PIDL* TABLE. 
*                (X2) = LOGICAL DISK ADDRESS OF *PIDL* TABLE OR ZERO. 
*         USES   X - 1, 6.
*                B - NONE.
*                A - 1, 6.
*         CALLS  ADW=.
  
  
 IDE      PS                 ENTRY/EXIT 
          SA3    ID 
          BX6    X5 
          LX3    59-0 
          PL     X3,IDE      IF WE ARE NOT TO CREATE *TFID* ENTRIES 
          SA3    SEGFLAG
          NZ     X3,IDE      IF SEGMENT LOAD
          SA6    IDEA        SAVE X5
          BX5    X2 
          ADDWRD TFID,X1     CREATE *TFID* ENTRY
          ADDWRD A2,X5
          SX5    B0          ADD BLANK THIRD WORD (FILLED LATER)
          ADDWRD A2,X5
          SA1    IDEA 
          BX5    X1          RESTORE X5 
          EQ     IDE
  
 IDEA     CON    0           SAVE AREA
 PID      SPACE  4,8
**        PID - PROCESS *PIDL* TABLE UNDER INTERACTIVE DEBUG MODE.
* 
*              IF BIT 0 OF WORD *ID* IS SET WE CREATE A *TFID* ENTRY
*         FOR THIS PROGRAM AND COPY THE *PIDL* TABLE TO FILE *ZZZZZDT*. 
* 
*         ENTRY  *T1* = *PIDL* TABLE HEADER.
*                (X0) = NUMBER OF BLOCK ENTRIES IN *PIDL* TABLE.
*                *TRLB+2* = FWA OF THE REST OF THE *PIDL* TABLE.
  
  
 PID      PS                 ENTRY/EXIT 
          SA3    ID 
          SX1    X0+2        LENGTH OF *PIDL* TABLE INCLUDING HEADER
          LX3    59-0 
          PL     X3,PID      IF WE ARE NOT IN INTERACTIVE DEBUG MODE
          SA2    LA 
          IX7    X1+X2
          SX1    X0+B1       *PWC* FIELD FOR *TFID* 
          SA7    A2          UPDATE LOGICAL DISK ADDRESS
          RJ     IDE         CREATE *TFID* ENTRY FOR THIS PROGRAM 
          SA1    T1 
          BX6    X1 
          WRITEO O
          SA1    TRLB 
          SX1    X1+2 
          WRITEW O,X1,X0+B1  WRITE REMAINDER OF *PIDL* TABLE
          EQ     PID
 SDE      SPACE  4,8
**        SDE - SET DEBUG ENTRY ADDRESS.
* 
*              FOR CONTROL CARD LOADS THE INTERACTIVE DEBUG TRANSFER
*         ADDRESS IS FOUND AND STORED IN *TA* IF WE ARE GOING TO USE
*         THAT ADDRESS AS THE TRANSFER ADDRESS.  WE WILL ALSO SAVE
*         THE ACTUAL TRANSFER ADDRESS AT THE DEBUG ENTRY POINT - 1. 
  
  
 SDE      PS                 ENTRY/EXIT 
          SA1    OGL1 
          NZ     X1,SDE      IF WE ARE NOT ON (0,0) OVERLAY 
          SA2    CTLPT       *ID* MAY BE ZEROED BY ROUTINE *CII*
          SA1    TA 
          LX2    59-35       BIT 11 OF BYTE 2 
          BX5    X1 
          SX6    B0 
          SA6    A1 
          PL     X2,SDE      IF WE ARE NOT CALLING INTERACTIVE DEBUG
          SA2    ABS
          NZ     X2,SDE1     IF ABS LOAD
          RJ     ELT         FIND DEBUG NAME
          ZR     X2,SDE      IF ADDRESS NOT FOUND 
          SX2    X2          ADDRESS IF FOUND 
          BX6    X5+X2
          SA6    TA          SAVE NAME AND ADDRESS
          EQ     SDE3 
  
 SDE1     SA3    TOVEPT 
          SA2    A3+B1
          SB2    B0          (B2) = CURRENT INDEX IN *TOVEPT* 
          SB3    X2          (B3) = LENGTH OF *TOVEPT*
          MX6    42 
 SDE2     GE     B2,B3,SDE   IF ENTRY POINT NOT FOUND 
          SA2    X3+B2
          IX4    X2-X1
          SB2    B2+B1
          BX4    X6*X4
          NZ     X4,SDE2     IF WRONG ENTRY POINT 
          BX6    X2 
          SA6    A1          SAVE NAME AND ADDRESS
 SDE3     SA1    TPGM 
          SA3    XF 
          IX2    X1+X6       ADDRESS OF TRANSFER
          BX6    X3 
          SA6    X2-1        SAVE ADDRESS AT DEBUG ENTRY - 1
          EQ     SDE
 IC       ENDIF 
          TITLE  LOAD COMPLETION SUBROUTINE - BUILD 54-TABLE HEADER.
**        B54 - BUILD 54-TABLE HEADER.
* 
*              THIS ROUTINE PLACES A 54-TABLE HEADER IN *TPGM*.  THIS 
*         IS DONE ONLY FOR CONTROL-CARD-INITIATED LOADS.  WHEN AN 
*         OVERLAY OTHER THAN (0,0) IS BEING GENERATED, A 4-WORD HEADER
*         IS PLACED AT THE FRONT OF *TPGM*.  IN ALL OTHER CASES THE 
*         FULL 8-WORD HEADER IS PUT IN THE PORTION OF *TPGM*
*         CORRESPONDING TO RA+100 THROUGH RA+107.  ADDRESSES ARE FILLED 
*         IN THE ENTRY POINT LIST IMMEDIATELY FOLLOWING.
  
  
 IC       IFCARD
  
 B54      EQ     *+400000B   ENTRY/EXIT 
          SA1    SEGFLAG
          NZ     X1,B54      IF SEGMENT LOAD DO NOT BUILD HEADER
          SA5    ABS
          NZ     X5,B54      IF ABS LOAD, DO NOT BUILD 54-HEADER
          RJ     FID         PROCESS FID FILE IF NECESSARY
          SA1    NEWL1
          MX0    -6 
          BX1    -X0*X1 
          NZ     X1,B54A1    IF WE ARE NOT AT END OF LOAD 
          RJ     CII         COMPLETE FID FILE AND CLEAN UP FID LOAD
 B54A1    BSS    0
          R=     X0,10B      (X0) = LENGTH OF 54-HEADER 
          SA5    EPTC        (X5) = ENTRY POINT COUNT 
          R=     X7,100B     (X7) = *TPGM* OFFSET TO FWA OF 54-HEADER 
          SA1    OG 
          ZR     X1,B54A     IF NOT OVERLAY GENERATION LOAD 
          SX7    B0          NO PADDING IN *TPGM* 
          SA1    OGL1 
          ZR     X1,B54A     IF MAIN OVERLAY
          R=     X0,4        4-WORD 54-HEADER 
 B54A     R=     X6,5400B    54 
          SA1    OGL1        L1 
          SA2    OGL2        L2 
          SA3    MAXOV       *FOL* DIRECTORY LENGTH 
          ZR     X1,B54A2    IF MAIN OVERLAY
          MX3    0           (X3) = 0 (NO *FOL* DIRECTORY)
 B54A2    BSS    0
          LX6    48 
          LX1    42 
          LX2    36 
          BX6    X6+X1
          SA1    PO 
          BX6    X6+X2
          IX1    X1-X0
          IX1    X1-X5
          IX1    X1-X3       FWAS = PO - HEADER LENGTH - EPTC - MAXOV 
          LX1    18 
          BX6    X6+X1
          BX6    X6+X5       N
          SA1    TPGM 
          IX1    X1+X7
          SA6    X1          SAVE FIRST WORD
          SA1    A1+B1
          IX1    X1-X0
          IX1    X1-X5
          IX1    X1-X7
          IX1    X1-X3       WCS = LENGTH *TPGM* - HEADER LENGTH
*                                  - EPTC - MAXOV - *TPGM* PADDING
          LX1    42 
          SA3    PA          MINFL
          BX6    X1+X3
          IFTEST NE,IP.MECS,0,3 
          SA2    ECSPA       LMINFL 
          LX2    18 
          BX6    X6+X2
          SA6    A6+B1       SAVE SECOND WORD 
 IE       IFTEST NE,IP.MECS,0 
          SA1    ECSPO
          SA2    ECSWCL 
          BX6    X2 
          LX1    24          FWAL 
          BX6    X1+X6       FWAL,WCL 
 IE       ELSE
          MX6    0           FWAL = WCL = 0 
 IE       ENDIF 
          SA6    A6+B1       SAVE THIRD WORD
          MX6    0
          SA6    A6+B1       ZERO FOURTH WORD 
          R=     X7,X0-10B
          NZ     X7,B54C     IF ONLY 4-WORD HEADER
          SA1    NEWL1
          NZ     X1,B54B     IF HHA NOT YET KNOWN 
          SA1    PA 
          BX6    X1          HHA
          IFTEST  NE,IP.MECS,0,2
          SA2    ECSPA
          BX7    X2          LHHA 
 B54B     SA6    A6+B1       SAVE FIFTH WORD
          SA7    A6+B1       SAVE SIXTH WORD
          SA1    MAXOV       *FOL* DIRECTORY LENGTH 
          BX6    X1 
          SA6    A7+B1       SET SEVENTH WORD = LENGTH *FOL* DIRECTORY
          MX6    0
          SA6    A6+B1       ZERO EIGHTH WORD 
 B54C     SA1    A6+B1
          NZ     X1,B54D     IF LIST OF ENTRY POINTS SUPPLIED 
          SX7    B1 
          SA1    ON          NO, USE OVERLAY NAME AS ENTRY POINT NAME 
          SA2    XF          AND XFER ADDRESS AS ITS ADDRESS
          SX2    X2 
          BX6    X1+X2
          SA6    A6+B1
          IX5    X5-X7       DECREMENT ENTRY POINT COUNT
 B54D     SB5    X5 
          SA5    A6 
 B54E     SB5    B5-B1
          MI     B5,B54      IF ALL ENTRY POINTS HANDLED, EXIT
          SA5    A5+B1
          MX2    0
          BX1    X5 
          RJ     ELT         SEARCH FOR ENTRY POINT 
          NZ     X2,B54F     IF DEFINED 
          BX7    X5 
          ERROR  4271,X7     ---- UNDEFINED OVERLAY ENTRY 
          SA3    PO          PROGRAM ORIGIN 
          SX2    B5+B1       (X2) = WORD COUNT FROM *PO* TO THIS NAME 
          IX3    X3-X2       ADDRESS OF UNFOUND ENTRY POINT 
          MX2    43 
          BX2    X2+X3       USE ADDRESS OF 400000B+* 
 B54F     MX0    42 
          BX6    -X0*X2 
          BX6    X6+X5       COMBINE NAME AND ADDRESS 
          SA6    A5 
          EQ     B54E 
  
 IC       ENDIF 
          TITLE  REQUEST PROCESSOR CONTROL ROUTINES.
 REQ      SPACE  4,8
**        REQ - PROCESS LOADER REQUESTS.
* 
*              THIS ROUTINE FETCHES EACH ENTRY IN THE REQUEST TABLE 
*         *TREQ* IN TURN AND BRANCHES TO THE APPROPRIATE REQUEST
*         PROCSSSOR.  AFTER COMPLETING A REQUEST, THE ENTRY FOR THAT
*         REQUEST IS REMOVED FROM *TREQ*. 
* 
*         ENTRY  *TREQ* CONTAINS LOADER REQUESTS ENDING WITH *EXECUTE*
*                OR *NOGO*. 
*         EXIT   TO *CPL* WHEN *NOGO* OR *EXECUTE* ENCOUNTERED. 
*         USES   X - 1, 2, 3, 5, 6. 
*                B - 2. 
*                A - 1, 2, 3, 5.
*         CALLS  SETADR, ATS=, AND ALL REQUEST PROCESSORS.
  
  
 REQ      PS                 ENTRY/EXIT 
 REQ1     SA1    TREQ        (X1) = FWA OF REQUEST TABLE
          SA2    A1+B1
          SA0    A1          (A0) = REQUEST TABLE POINTER 
          SA5    X1          (X5) = HEADER OF REQUEST 
          ZR     X2,REQ      IF NO MORE REQUESTS
 IC       IFCARD
          MX6    12          MAINTAIN (CURREQBP)=CUR REQ NO.
          BX6    X6*X5
          LX6    12 
          SA6    CURREQBP 
 IC       ENDIF 
          SB2    REQ2 
          RJ     SETADR      GET ADDRESS OF REQUEST PROCESSOR 
 REQ2     ZR     B2,REQ3     IF ILLEGAL REQUEST 
          RJ     0           GO PROCESS REQUEST 
 LOADRTN  BSS    0           *** MUST FOLLOW PRECEDING RJ *** 
 REQ3     SA1    TREQ        -(B2) = NO. OF WORDS IN REQUEST TABLE
          MX3    48          PERTAINING TO REQUEST JUST 
          SA5    X1          COMPLETED
          LX5    -36
          BX5    -X3*X5 
          SB2    X5+B1
          IFUSER 3
          SA3    UCPOINT     ADVANCE POINTER FOR USER CALL
          SX6    X3+B2
          SA6    A3 
          ALLOC  A1,-B2,FRONT      RELEASE TABLE SPACE
          EQ     REQ1        PROCESS NEXT REQUEST 
          SPACE  2
          IFUSER 3
 UCPOINT  CON    3           POINTER TO CURRENT USER CALL REQUEST 
 RQP1     CON    0           POINTER IN CURRENT PRIMARY REQUEST 
 RQL1     CON    0           LENGTH OF CURRENT PRIMARY REQUEST
 REQD     SPACE  4,8
**        REQD - PROCESS LOADER REQUESTS FROM OBJECT DIRECTIVES.
* 
*              THIS ROUTINE IS IDENTICAL TO *REQ*, EXCEPT IT IS USED FOR
*         PROCESSING REQUESTS AS A RESULT OF OBJECT DIRECTIVES, AND 
*         IT USES TABLE *TREQ2*.
  
  
 REQD     PS                 ENTRY/EXIT 
 REQD1    SA1    TREQ2       (X1) = FWA OF REQUEST TABLE
          SA2    A1+B1
          SA0    A1          (A0) = REQUEST TABLE POINTER 
          SA5    X1          (X5) = HEADER OF REQUEST 
          ZR     X2,REQD     IF NO MORE REQUESTS
          SB2    REQD2
          RJ     SETADR 
 REQD2    ZR     B2,REQD3    IF ILLEGAL REQUEST 
          RJ     0           GO PROCESS REQUEST 
 REQD3    SA1    TREQ2       -(B2) = NO. OF WORDS IN REQUEST TABLE
          MX3    48          PERTAINING TO REQUEST JUST 
          SA5    X1          COMPLETED
          LX5    -36
          BX5    -X3*X5 
          SB2    X5+B1
          ALLOC  A1,-B2,FRONT      RELEASE TABLE SPACE
          EQ     REQD1       PROCESS NEXT REQUEST 
          SPACE  2
          IFUSER 2
 RQP2     CON    0           POINTER IN CURRENT SECONDARY REQUEST 
 RQL2     CON    0           LENGTH OF CURRENT SECONDARY REQUEST
 SETADR   SPACE  4,8
**        SETADR - SET ADDRESS OF REQUEST PROCESSOR.
* 
*              THIS ROUTINE IS CALLED BY EITHER *REQ* OR *REQD* TO
*         SET UP A RETURN JUMP INSTRUCTION FOR ENTRY INTO ONE OF THE
*         REQUEST PROCESSORS.  IT ALSO CHECKS TO SEE IF THE PARTICULAR
*         REQUEST IS ALLOWED FOR THE GENERAL TYPE OF PROCESSING 
*         CURRENTLY BEING DONE  (SUCH AS A *LOAD* REQUEST NOT BEING 
*         ALLOWED IF IT CAME FROM AN OBJECT DIRECTIVE). 
* 
*         ENTRY  (X5) = REQUEST HEADER. 
*                (B2) = ADDRESS OF RJ (LOWER PARCEL) TO STORE ADDRESS.
*                (A0) = REQUEST TABLE POINTER.
*                (A5) = ADDRESS OF REQUEST HEADER.
*         EXIT   (B2) = UNCHANGED IF REQUEST IS LEGAL.
*                (B2) = 0 IF REQUEST IS ILLEGAL.
*                IF (B2) " 0 -
*                (X0) = 48/12 MASK. 
*                (X4) = BITS 18-59 - REQUEST NAME.
*                            0-17  - REQUEST PROCESSOR ADDRESS. 
*                (X5) = REQUEST HEADER. 
*                (A0) = REQUEST TABLE POINTER.
*                (A5) = ADDRESS OF REQUEST HEADER.
*         USES   X - 1, 2, 4, 6.
*                B - NONE.
*                A - 1, 4, 6. 
*         CALLS  NONE.
  
  
 SETADRX  CON    0
 SETADR   PS                 ENTRY/EXIT 
          BX6    X5 
          AX6    48 
 IU       IFUSER
          MX1    -12         ISOLATE HEADER  (IN CASE TOO BIG)
          BX6    -X1*X6 
          R=     X2,X6-RQLISTE+RQLIST 
          NG     X2,SETADR1  IF HEADER IS OK
          BX7    X6          (X7) = REQUEST NUMBER
          ERROR  210,X7      ---- BAD REQUEST NO. IN USER CALL
          EQ     ABEND
  
 SETADR1  BSS    0
 IU       ENDIF 
          SA1    REQTYPE     CHECK IF THE REQUEST IS LEGAL
          SA2    X6+RQALLOW  AT THIS PARTICULAR TIME
          MX0    -12         SET MASK FOR REQUEST PROCESSORS
          BX2    X1*X2
          NZ     X2,SETADR2  IF REQUEST IS LEGAL
          MX4    42 
          SA2    X6+RQLIST   GET NAME 
          BX7    X2*X4
          BX7    X7+X1       (X7) = VFD  42/NAME,6/0,12/TYPE
          ERROR  4220,X7     ---- ILLEGAL LOADER REQUEST
          SB2    B0          SET ERROR INDICATOR
          EQ     SETADR      EXIT 
  
 SETADR2  SA4    X6+RQLIST   GET PROCESSOR ADDRESS
          SA1    B2          MODIFY RJ INSTRUCTION
          MX6    42 
          BX1    X6*X1
          BX2    -X6*X4 
          IX6    X1+X2
          SA6    B2 
          RJ     SETADRX     EXIT AND VOID INSTRUCTION STACK
          SPACE  2
*         TABLE OF LOADER REQUESTS AND ADDRESS OF CORRESPONDING ROUTINES
  
          RELOC  OFF
 RQLIST   BSS    0
          IFCARD
          VFD    42/0LLOAD,18/LOA 
          VFD    42/0LLIBLOAD,18/LLO
          VFD    42/0LSLOAD,18/SLO
          VFD    42/0LCMLOAD,18/0 
          VFD    42/0LECLOAD,18/0 
          VFD    42/0LEXECUTE,18/EXE
          VFD    42/0LNOGO,18/NOG 
          VFD    42/0LSATISFY,18/SFY
          VFD    42/0LLIB,18/LIB
          VFD    42/0LMAP,18/MAP
          VFD    42/0LPRESET,18/PRESET
          VFD    42/0LERR,18/ERR
          VFD    42/0LREWIND,18/REWIND
          VFD    42/0LUSEP,18/USEP
          VFD    42/0LUSE,18/USE
          VFD    42/0LSUBST,18/SUBST
          VFD    42/0LOMIT,18/OMIT
          VFD    42/0LENTRY,18/0
          IFTEST NE,IP.LDBG,1,1 
          VFD    42/0LDMP,18/0
          IFTEST NE,IP.LDBG,0,1 
          VFD    42/0LDMP,18/DMP
          VFD    42/0LFILES,18/FILES
          VFD    42/0LPASSLOC,18/0
          VFD    42/0LCGENT,18/CGENT
          VFD    42/0LCGNENT,18/CGNENT
          VFD    42/0LSTAT,18/STAT
          VFD    42/0LEXFLS,18/0
          VFD    42/0LEXFLL,18/0
          VFD    42/0LCOMMON,18/COMMON
          VFD    42/0LPD,18/PD
          VFD    42/0LPS,18/PS
          ENDIF 
          IFUSER
          VFD    42/0LLOAD
          RVFD   18,LOA 
          VFD    42/0LLIBLOAD 
          RVFD   18,LLO 
          VFD    42/0LSLOAD 
          RVFD   18,SLO 
          VFD    42/0LCMLOAD
          RVFD   18,CMLOAD
          VFD    42/0LECLOAD
          RVFD   18,ECLOAD
          VFD    42/0LEXECUTE 
          RVFD   18,EXE 
          VFD    42/0LNOGO
          RVFD   18,NOG 
          VFD    42/0LSATISFY 
          RVFD   18,SFY 
          VFD    42/0LLIB 
          RVFD   18,LIB 
          VFD    42/0LMAP 
          RVFD   18,MAP 
          VFD    42/0LPRESET
          RVFD   18,PRESET
          VFD    42/0LERR,18/0
          VFD    42/0LREWIND,18/0 
          VFD    42/0LUSEP
          RVFD   18,USEP
          VFD    42/0LUSE 
          RVFD   18,USE 
          VFD    42/0LSUBST 
          RVFD   18,SUBST 
          VFD    42/0LOMIT
          RVFD   18,OMIT
          VFD    42/0LENTRY 
          RVFD   18,ENTRY 
          VFD    42/0LDMP 
          RVFD   18,DMP 
          VFD    42/0LFILES 
          RVFD   18,FILES 
          VFD    42/0LPASSLOC 
          RVFD   18,PASSLOC 
          VFD    42/0LCGENT,18/0
          VFD    42/0LCGNENT,18/0 
          VFD    42/0LSTAT
          RVFD   18,STAT
          VFD    42/0LEXFLS,18/0
          VFD    42/0LEXFLL,18/0
          VFD    42/0LCOMMON
          RVFD   18,COMMON
          VFD    42/0LPD
          RVFD   18,PD
          VFD    42/0LPS
          RVFD   18,PS
          ENDIF 
 RQLISTE  BSS    0
  
*         THE FOLLOWING TABLE SHOWS WHERE EACH REQUEST IS ALLOWED 
*         OR NOT ALLOWED. 
* 
          IFCARD
  
*         BIT 0 SET - ALLOWED ON CONTROL CARD IF RELOCATABLE LOAD.
*         BIT 1 SET - ALLOWED ON CONTROL CARD IF ABSOLUTE LOAD. 
*         BIT 2 SET - ALLOWED ON CONTROL CARD IF OVERLAY GENERATION.
*         BIT 3 SET - ALLOWED AS LOADER OBJECT DIRECTIVE. 
  
 RQALLOW  BSS    0
          LOC    0
          CON    7           LOAD 
          CON    7           LIBLOAD
          CON    3           SLOAD
          CON    0           CMLOAD 
          CON    0           ECLOAD 
          CON    7           EXECUTE
          CON    7           NOGO 
          CON    5           SATISFY
          CON    15B         LIB
          CON    15B         MAP
          CON    17B         PRESET 
          CON    17B         ERR
          CON    17B         REWIND 
          CON    15B         USEP 
          CON    15B         USE
          CON    15B         SUBST
          CON    15B         OMIT 
          CON    0           ENTRY
          IFTEST NE,IP.LDBG,1,1 
          CON    0
          IFTEST NE,IP.LDBG,0,1 
          CON    7           DMP
          CON    5           FILES
          CON    0           PASSLOC
          CON    15B         *EPT*
          CON    15B         *NOEPT*
          CON    5           STAT 
          CON    0           EXFLS
          CON    0           EXFLL
          CON    15B         COMMON 
          CON    15B         PD 
          CON    15B         PS 
  
          LOC    *O 
          ENDIF 
          IFUSER
  
*         BIT 0 SET - ALLOWED IN THE USER-CALL REQUEST. 
*         BIT 1 NEVER SET.
*         BIT 2 NEVER SET.
*         BIT 3 SET - ALLOWED AS LOADER OBJECT DIRECTIVE. 
  
 RQALLOW  BSS    0
          LOC    0
          CON    1           LOAD 
          CON    1           LIBLOAD
          CON    1           SLOAD
          CON    1           CMLOAD 
          CON    1           ECLOAD 
          CON    1           EXECUTE
          CON    1           NOGO 
          CON    1           SATISFY
          CON    11B         LIB
          CON    11B         MAP
          CON    11B         PRESET 
          CON    0           ERR
          CON    0           REWIND 
          CON    11B         USEP 
          CON    11B         USE
          CON    11B         SUBST
          CON    11B         OMIT 
          CON    1           ENTRY
          CON    1           DMP
          CON    1           FILES
          IFUSER 1
          CON    1           PASSLOC
          CON    0           *EPT*
          CON    0           *NOEPT*
          CON    1           STAT 
          CON    0           EXFLS
          CON    0           EXFLL
          CON    10B         COMMON 
          CON    11B         PD 
          CON    11B         PS 
          LOC    *O 
          ENDIF 
          RELOC  ON 
 EXE      EQU    CPL
 NOG      EQU    CPL
 CAE      IFCARD
 CAE      SPACE  4,8
**        CAE - CHECK ABSOLUTE LOAD ERROR.
* 
*              THIS ROUTINE IS CALLED DURING CONTROL-CARD-INITIATED 
*         LOADS BY THE VARIOUS REQUEST PROCESSORS WHICH INVOLVE PHYSICAL
*         LOADING.  IF THE LOAD IS ALREADY KNOWN TO BE ABSOLUTE, THEN NO
*         OTHER LOADING IS ALLOWED.  THIS ROUTINE ISSUES THE ERROR IF 
*         THE CONDITION IS DETECTED.
* 
*         ENTRY  NONE.
*         EXIT   TO CALLING ROUTINE ONLY IF LOAD IS NOT ABSOLUTE. 
*                FATAL ERROR EXIT IS TAKEN OTHERWISE. 
*         USES   X - 1. 
*                B - NONE.
*                A - 1. 
*         CALLS  ERROR. 
  
  
 CAE      PS                 ENTRY/EXIT 
          SA1    ABS
          ZR     X1,CAE      EXIT IF LOAD NOT ABSOLUTE
 ABSERR   ERROR  103         ---- ATTEMPT TO LOAD MORE THAN ONE 
          EQ     ABEND       PROGRAM ON ABS LOAD
  
 CAE      ENDIF 
 LOAD     TITLE  REQUEST PROCESSOR - LOAD, SLOAD. 
**        + + + + + + + + + + + + + 
*         + REQUEST SUBROUTINES.  + 
*         + + + + + + + + + + + + + 
* 
* 
*         LOAD - PROCESS *LOAD* OR *SLOAD* REQUEST. 
* 
*              THIS ROUTINE PROCESSES ALL *LOAD* AND *SLOAD* REQUESTS.
*         THE PROCEDURE IS AS FOLLOWS 
* 
  
  
*************  DO NOT CHANGE THE FOLLOWING STRANGE ENTRY POINT WITHOUT
*  WARNING  *  THOROUGHLY READING AND UNDERSTANDING THE COMMENTS AT THE 
*************  BEGINNING OF /LOADG/INO IN THE CONTROL-CARD LOADER.
  
 LOA      EQ     LOADRTN     ENTRY (BY RJ, NOT EQ) AND EXIT 
 SLO      EQU    LOA
  
**        1)   VARIOUS POINTERS ARE INITIALIZED.  THE SUBROUTINE *CAE*
*              IS CALLED TO VERIFY THAT THE LOAD IS NOT ABSOLUTE. 
* 
*              NOTE THAT DURING ABSOLUTE LOADS, EITHER A SINGLE *LOAD*, 
*              *SLOAD*, OR *LIBLOAD* REQUEST WILL BE PROCESSED.  WHEN 
*              *CAE* IS CALLED AT THE START OF THAT REQUEST, IT IS NOT
*              YET KNOWN THAT THE LOAD IS ABSOLUTE, SINCE IT CANNOT BE
*              KNOWN UNTIL THE LOAD INPUT IS READ.
* 
  
          LX5    -36
          BX7    -X0*X5 
          NZ     X7,LOA1     IF ANY FILES SPECIFIED 
          ERROR  221         ---- LOAD FILE NOT SPECIFIED 
          EQ     ABEND       GO TO ERROR EXIT 
 LOA1     BSS    0
          IFCARD 1
          RJ     CAE         CHECK IF LOAD ALREADY ABSOLUTE 
          MX6    0
          SA7    RQL1        NUMBER OF LOAD FILES IN REQUEST
          SA6    RQP1        LOAD FILE POINTER
          LX5    -12
          SX6    B1          FLAG THE OCCURRENCE OF 
          SA6    LF          NON-LIBRARY LOADING
          IFNOS  3
          IFCARD 2
          MX6    -1          SET FOR NO *SDM=* PROCESSING 
          SA6    SDMFLAG
          BX6    -X0*X5      REQUEST TYPE NUMBER
          MX4    42 
          IFTEST NE,CLOAD,0,1 
          LD     X6,X6-CLOAD
          SA6    LSL         NON-ZERO IF *SLOAD*
          ZR     X6,LOAD4    IF *LOAD*
  
**        2)   ADDITIONAL INITIALIZATION IS NECESSARY IF AN *SLOAD* 
*              REQUEST IS BEING PROCESSED.  AN INDICATOR IS STORED WITH 
*              EACH NAME IN THE REQUEST TO SHOW WHETHER OR NOT THAT 
*              PROGRAM HAS BEEN FOUND.  THE PROCEDURE IS TO LOAD THESE
*              PROGRAMS AS THEY ARE ENCOUNTERED WHILE READING THE LOAD
*              FILE, RATHER THAN LOADING THEM IN THE ORDER THEY ARE 
*              SPECIFIED IN THE REQUEST.  THE PROGRAMS TO BE LOADED ARE 
*              RECOGNIZED AS SUCH BY THE *PRFX* TABLE PROCESSOR.
* 
  
          SX3    B1          (X7) = NO. OF PROGRAMS TO LOAD 
          IX7    X7-X3
          SA7    SLNP 
          SA1    TREQ        (B3) = FWA+1 OF *SLOAD* REQUEST
          SB3    X1+B1
          IFUSER 3
          NZ     X7,LOAD1    IF ANY PROGRAMS SPECIFIED
          ERROR  4222        ---- NO PROGRAMS SPECIFIED ON SLOAD
          EQ     LOAD2       GO TO EXIT 
  
 LOAD1    SA2    X7+B3       NEXT NAME
          ZR     X7,LOAD4    IF ALL NAMES SCANNED 
          BX6    X2*X4       CLEAR LOWER 18 BITS
          IX7    X7-X3
          SA6    A2 
          EQ     LOAD1       LOOP 
  
**        3)   CONTROL RETURNS TO THIS POINT AFTER THE PROCESSING OF
*              EACH LOAD FILE IS COMPLETE.  FOR *SLOAD*, THERE IS NEVER 
*              MORE THAN ONE FILE TO BE PROCESSED.  ANY PROGRAMS
*              SPECIFIED IN THE *SLOAD* REQUEST WHICH WERE NOT FOUND
*              ARE FLAGGED AS NON-FATAL ERRORS AT THIS POINT. 
* 
  
 LOAD2    SA3    LSL         CHECK WHETHER *LOAD* OR *SLOAD*
          MX7    0           CLEAR FLAG FOR SUBSEQUENT LOADS
          SA7    A3 
          ZR     X3,LOAD4    IF *LOAD* REQUEST
          SA1    SLNP        (B6) = NUMBER OF PROGRAMS NEEDED 
          SA2    TREQ 
          SB6    X1 
          SA5    X2+B1       FWA-1 OF LIST
 LOAD3    ZR     B6,LOA      IF NO MORE 
          SA5    A5+B1       NEXT LIST ENTRY
          SX6    X5 
          NZ     X6,LOAD3    IF THIS ONE WAS FOUND
          MX1    42          (X7) = PROGRAM NAME
          BX7    X1*X5
          ERROR  4224,X7     ---- SLOAD PROGRAM NOT FOUND 
          SB6    B6-B1
          EQ     LOAD3       LOOP 
  
**        4)   THE NAME OF THE NEXT LOAD FILE IS PLACED IN THE TABLE OF 
*              FILE NAMES *TLFN*.  IT IS ALSO PLACED IN THE 
*              COMMUNICATIONS AREA AT RA+64B. 
* 
  
 LOAD4    SA1    RQP1 
          SA2    RQL1 
          SX6    X1+B1
          IX5    X2-X6
          SA3    TREQ 
          NG     X5,LOA      IF NO MORE LOAD FILES
          SA6    A1 
          SB2    X3 
          MX0    42 
          SA5    B2+X6       NEXT LOAD FILE NAME
          BX1    X5*X0
 NAMECK   IFUSER
          RJ     /MISC/LFNCK
          PL     X6,LOAD4A   IF OK
          BX7    X1          (X7) = BAD NAME
          ERROR  4221,X7     ---- LOAD FILE NAME FORMAT ERROR 
          EQ     LOAD2       DO NOT PROCESS THIS FILE NAME
  
 LOAD4A   BSS    0
 NAMECK   ENDIF 
 IC       IFCARD
 K        IFNOS 
          SA3    SLDRCLD     CHECK IF ENTERED AT *SLDR=*
          ZR     X3,LOAD4A1  IF NOT ENTERED AT *SLDR=*
          R=     X3,2 
          BX1    X1+X3       MAKE LFN LOOK LIKE SYSTEM LIB IN *TLFN*
 LOAD4A1  BSS    0
 K        ENDIF 
 IC       ENDIF 
          ADDWRD TLFN,X1     ADD ENTRY TO FILES TABLE 
          SA3    FI          ADVANCE FILE INDEX 
          SX7    X3+B1
          SA7    A3 
          SA2    TPGM 
          IFCARD 4
          SA1    OG 
          ZR     X1,LOAD4A
          SX2    B0 
 LOAD4A   BSS    0
          BX4    X5*X0       (X4) = FILE NAME 
          R=     A1,X2+RA+COMNAME  INSERT LOAD LFN IN COMMUN. AREA
          BX6    -X0*X1 
          IX6    X4+X6
          IFTEST EQ,COMLBIT,COMNAME+1 
          SA2    A1+B1       CLEAR FILE VS. LIBRARY LOAD BIT
          ELSE
          R=     A2,X2+RA+COMLBIT  CLEAR FILE VS. LIBRARY LOAD BIT
          ENDIF 
 IU       IFUSER
          R=     A3,106B     READ RA+106B (SEE IF *FOL* DIRECTORY)
          NZ     X3,LOAD4AB  IF *FOL* PRESERVE RA+64B AND RA+65B
 IU       ENDIF 
          SA6    A1 
          SX1    B1 
          LX1    18 
          BX7    -X1*X2 
          SA7    A2 
          BX0    X4          (X0) = FILE NAME 
 LOAD4AB  BSS    0
  
**        5)   THE FET IS INITIALIZED FOR ACCESS OF THE FILE. 
* 
*              IF UNDER KRONOS/NOS AND ENTRY WAS AT *SLDR=*,
*              THEN WE HAVE BEEN CALLED TO LOAD A RELOCATABLE 
*              FROM THE *CLD*.  THE FILE MUST BE *ASSIGNED* AT
*              THIS TIME AND *RETURNED* AT LOAD COMPLETION. 
*              IN THIS CASE WE MUST NOT REWIND THE *ASSIGNED* 
*              FILE AND READ ONLY ONE RECORD FROM IT. 
* 
* 
  
          BX1    X4 
          SETFET L,A1,BINARY INITIALIZE FET 
 IC       IFCARD
 K        IFNOS 
          SA2    SLDRCLD     CHECK IF ENTERED AT *SLDR=*
          ZR     X2,LOAD4C   IF NOT ENTERED AT *SLDR=*
          SA2    L+1
          SX1    B1 
          LX1    47 
          BX7    X2+X1
          SA7    A2          SET RANDOM BIT 
          ASSIGN L,LIBRARY   ASSIGN THE FILE
          SA2    L           CHECK STATUS 
          SX2    X2 
          AX2    10 
          NZ     X2,LOAD4B   IF ANY ERROR CONDITION 
          SA1    SLDRCLD
          SA2    TSFR        ADD FILE NAME TO *TSFR*
          RJ     AET=         (FILE RETURN TABLE) 
          SX7    B0 
          SA7    RECORDS     INIT RECORD COUNT
          EQ     LOAD6       FORCE NO REWIND AND START THE READ 
  
 LOAD4B   BSS    0
          ERROR  CAT,(=C/ SYSTEM ERROR - CANNOT ACCESS CLD /) 
  
**        5A)  IF UNDER NOS, NOTHING HAS BEEN LOADED, AND THIS IS 
*              NOT A SYSTEM FILE, FORCE FUTURE EXECUTE ONLY 
*              LOADING TO RESIDE ON THIS FILE.  ALSO DISABLE *SSJ=* 
*              UNLESS DOING A NAME CALL LOAD. 
  
 LOAD4C   SA3    PC 
          NZ     X3,LOAD4E   IF NOT FIRST LOAD
          STATUS L,POS       RETRIEVE *FNT* ENTRY 
          SA1    L+5         FILE TYPE
          LX1    59-14
          PL     X1,LOAD4D   IF NOT EXECUTE-ONLY FILE 
          LX1    14-59-6     CHECK FOR DIRECT-ACCESS P.F. 
          MX3    -6 
          BX3    -X3*X1 
          LD     X2,X3-PMFT 
          ZR     X2,LOAD4F   IF DIRECT-ACCESS P.F.
          LD     X2,X3-LOFT 
          NZ     X2,LOAD4D   IF NOT LOCAL FILE
 LOAD4F   BSS    0
          SETLFE L           LIMIT EXECUTE ONLY ACCESS TO THIS FILE 
          MX3    -8 
          SA1    L           CHECK FOR ERROR CONDITION
          LX1    8-18 
          BX3    -X3*X1 
          ZR     X3,LOAD4D   IF NO ERROR CONDITION
          ERROR  CAT,(=C/LOCAL FILE LOAD OF EXECUTE-ONLY FILE NOT ALLOWE
,D/)
 LOAD4D   BX1    X0          (X1) = FILE NAME 
          SETFET L,A1,BINARY RESET FET FOR READING
          SA3    NAMCALL
          SA2    NODISSJ     NZ IF NOT TO ISSUE *DISSJ* 
          BX3    X3+X2
          NZ     X3,LOAD4E   IF THIS IS A SINGLE CARD NAME CALL LOAD
          DISSJ              DISABLE *SSJ=* PRIVILEGES
 LOAD4E   BSS    0
 K        ENDIF 
 IC       ENDIF 
  
**        6)   THE FILE IS REWOUND IF NECESSARY.
*              IF A CONTROL CARD INITIATED LOAD AND WE ARE WORKING
*              ON A *LOAD* REQUEST AND WE ARE REWINDING THE FILE, 
*              THEN THE FILE NAME IS SAVED AS THE *FOL* FILE
*              SPECIFICATION ENTRY AND 1 IS SAVED AS THE PRU NUMBER.
* 
  
          SA2    =0LINPUT    CHECK WHETHER TO REWIND
          SA1    REW         DEFAULT REWIND OPTION TO SIGN BIT
          LX5    59-1        CHECK IF REWIND INDICATOR PRESENT
          SX7    B0 
          LX1    59 
          LX3    X5,B1
          SA7    RECORDS
          NG     X5,LOAD5    IF REWIND IND. PRESENT IN REQUEST
          BX2    X4-X2
          ZR     X2,LOAD6    IF FILE IS *INPUT* 
          BX3    X1          CHECK DEFAULT REWIND OPTION
 LOAD5    PL     X3,LOAD6    IF NOT TO REWIND 
          REWIND L           REWIND FILE
 IC       IFCARD
          SA1    LSL
          NZ     X1,LOAD6    IF NOT *LOAD* REQUEST
          MX7    42 
          SA1    L
          BX7    X7*X1
          SA7    FOLFS       SAVE FILE NAME AS *FOL* FILE SPEC ENTRY
          SX7    B1 
          LX7    18 
          SA7    FOLRA       SAVE PRU 1 AS *FOL* RANDOM ADDRESS 
 IC       ENDIF 
 LOAD6    LD     X7,READ     SET TO ISSUE *READ* THE FIRST TIME 
          SA7    READFUNC 
  
**        7)   READING OF LOAD FILES CONSISTS INITIALLY OF ISSUING A
*              *READ* FUNCTION.  THEN AFTER IT IS DETERMINED THAT THE 
*              FILE IS MASS-STORAGE, THE *READNS* FUNCTION IS USED. 
*              THIS IS DETERMINED FROM THE SETTING OF THE DEVICE-TYPE 
*              FIELD IN THE FET RETURNED AFTER THE FIRST *READ* 
*              FUNCTION.
* 
*              THIS POINT IS REACHED ONLY WHEN IT IS NECESSARY TO 
*              INITIATE *CIO* AT THE START OF A LOGICAL RECORD, NEVER IN
*              THE MIDDLE OF A RECORD.  A COUNT IS KEPT OF THE TIMES
*              CONTROL PASSES HERE IN ORDER TO DETECT AN EMPTY FILE IF
*              EOR/EOF IS RETURNED THE FIRST TIME.  ALSO NOTE THAT THE
*              OCCURRENCE OF ANY EMPTY RECORD TERMINATES THE LOADING
*              FROM THE FILE ACCORDING TO LOADER EXTERNAL 
*              SPECIFICATIONS.
* 
  
 LOAD7    SA1    READFUNC    ISSUE CIO *READ* OR *READNS* 
          CIOCALL L,,X1 
          READO  L           GET 1ST WORD FROM READ 
          SA2    RECORDS     BUMP COUNT OF RECORDS READ 
          SX7    X2+B1
          SA7    A2 
          ZR     X1,LOAD9    IF NOT EOR/EOF 
          ZR     X2,LOAD8    IF POSITIONED AT EOF OR EMPTY RECORD 
          MX1    1           INDICATE EOF 
          EQ     LOAD11 
  
 LOAD8    ERROR  220         ---- EMPTY LOAD FILE 
          EQ     ABEND       GO TO ERROR EXIT 
  
 LOAD9    BSS    0
 CKABS    IFCARD
          SA3    ABS
          ZR     X3,LOAD10   IF NOT ABSOLUTE LOAD 
          EQ     ABSERR      ---- ATTEMPT TO LOAD MORE THAN ONE 
                                    PROGRAM ON ABS LOAD 
  
 LOAD10   BSS    0
 CKABS    ENDIF 
  
**        8)   THE ROUTINE *RDR* IS ENTERED TO PROCESS THE LOAD INPUT.
*              UNLESS A FATAL ERROR OCCURS, IT DOES NOT RETURN UNTIL
*              IT PROCESSES EVERYTHING READ UP TO THE NEXT END-RECORD 
*              STATUS RETURNED BY *CIO*.  THIS MAY BE MORE THAN ONE 
*              ACTUAL LOGICAL RECORD IF *READNS* IS BEING USED. 
* 
  
          BX5    X6 
          SA6    T1          GO PROCESS PHYSICAL LOAD 
          RJ     /READ/RDR
 LOAD11   SA2    LSL
          NZ     X2,LOAD14   IF *SLOAD* 
  
**        9)   WHEN END-OF-RECORD IS REACHED DURING A *LOAD* REQUEST, 
*              NO FURTHER READING WILL TAKE PLACE IF THE LOAD IS
*              ABSOLUTE.  IF THE LOAD IS RELOCATABLE, THE READ FUNCTION 
*              TO BE USED IS CHANGED TO *READNS*, PROVIDED THE FILE 
*              IS ON MASS-STORAGE AND OVERLAY GENERATION IS NOT IN
*              PROGRESS AND THE LOAD IS KNOWN TO BE RELOCATABLE.
* 
*              IF UNDER KRONOS/NOS AND ENTRY WAS AT *SLDR=*,
*              THEN WE MUST TERMINATE THE *LOAD* REQUEST AFTER
*              ONE RECORD HAS BEEN READ.
* 
* 
  
          NG     X1,LOAD12   IF EOF 
 IC       IFCARD
 K        IFNOS 
          SA3    SLDRCLD     CHECK IF ENTERED AT *SLDR=*
          NZ     X3,LOAD12   IF ENTRY AT *SLDR=*, DONE WITH FILE
 K        ENDIF 
 IC       ENDIF 
          SA3    L+1         GET DEVICE TYPE FROM FET 
 IC       IFCARD
          SA2    OG 
          NZ     X2,LOAD7    IF OVERLAY/CAPSULE/OVCAP GENERATION
          SA2    ABS
          NZ     X2,LOAD12   READ NO MORE IF ABSOLUTE LOAD
          SA2    LKR
          ZR     X2,LOAD7    IF LOAD NOT KNOWN TO BE RELOCATABLE
 IC       ENDIF 
          NG     X3,LOAD7    IF FILE IS TAPE
          R=     X7,READNS   SET TO *READNS*
          SA7    READFUNC 
          EQ     LOAD7
  
**        10)  WHEN PHYSICAL LOADING HAS BEEN COMPLETED FOR THE FILE, 
*              THE ROUTINE *CPR* IS CALLED FOR THOSE TASKS WHICH ARE
*              PERFORMED AFTER A PHYSICAL LOAD HAS BEEN COMPLETED, BUT
*              BEFORE THE NEXT ONE BEGINS.  CONTROL THEN RETURNS TO 
*              STEP 3 TO BEGIN THE NEXT FILE, IF ANY.  THIS POINT IS
*              REACHED WHEN ANY OF THE FOLLOWING OCCUR:                        .
* 
*              A)   EOF STATUS RETURNED DURING *LOAD* OR *SLOAD*. 
*              B)   AN EMPTY RECORD ENCOUNTERED DURING *LOAD*.
*              C)   THE FIRST EOR RETURNED DURING *LOAD* IF ABSOLUTE. 
*              D)   ALL SPECIFIED PROGRAMS FOUND DURING *SLOAD*.
* 
  
 LOAD12   RJ     CPR         COMPLETE READ
          EQ     LOAD2       PROCESS NEXT LOAD FILE 
  
**        11)  WHEN END-OF-RECORD IS ENCOUNTERED DURING AN *SLOAD*
*              REQUEST, THE READ IS REISSUED, UNLESS ALL SPECIFIED
*              PROGRAMS HAVE BEEN FOUND.  WHEN END-OF-FILE IS 
*              ENCOUNTERED, THE PHYSICAL LOAD IS COMPLETED
*              AS PER STEP 10.
  
 LOAD14   SA2    SLNP        NO. OF PROGRAMS NOT YET LOADED 
          ZR     X2,LOAD12   IF ALL PROGRAMS LOADED - COMPLETE
          PL     X1,LOAD7    IF EOR, READ NEXT RECORD 
          EQ     LOAD12      IF EOF, LOAD IS COMPLETE 
  
 LIBLOAD  TITLE  REQUEST PROCESSOR - LIBLOAD. 
**        LIBLOAD - PROCESS *LIBLOAD* REQUEST.
* 
*              IT IS NECESSARY THAT THE *LIBLOAD* REQUEST PROCESSOR BE
*         ABLE TO HANDLE A CASE WHERE THE LIBRARY NAME IS NOT SPECIFIED 
*         IN THE REQUEST SINCE THIS OCCURS:                                    .
* 
*           1) WHEN A *LIBLOAD* REQUEST IS GENERATED AS A RESULT OF A 
*              PROGRAM CALL CONTROL CARD WHICH SPECIFIES A LIBRARY
*              ENTRY POINT NAME.
* 
*           2) IN USER-CALL MODE, WHEN AN OLD-STYLE USER-CALL SPECIFIES 
*              LIBRARY LOADING. 
* 
*              THE *LIBLOAD* PROCEDURE IS AS FOLLOWS:                          .
* 
  
 LLO      PS                 ENTRY/EXIT 
 IC       IFCARD
  
**        0)   IF ENCAPSULATION AND THE CURRENT CAPSULE HAS NOT 
*              BEEN INITIATED, THEN IGNORE THE REQUEST COMPLETELY.
  
          SA1    OG          CHECK FOR ENCAPSULATION
          PL     X1,LIBLD1   IF NOT ENCAPSULATION 
          SA1    CGFPAF      CHECK CAPSULE ALREADY INITIATED
          ZR     X1,LLO      IF NOT ALREADY INITIATED, IGNORE REQUEST 
 LIBLD1   BSS    0
 IC       ENDIF 
  
**        1)   THE SUBROUTINE *CAE* IS CALLED TO VERIFY THAT THE LOAD IS
*              NOT ALREADY KNOWN TO BE ABSOLUTE.
* 
  
          IFCARD 1
          RJ     CAE         CHECK IF LOAD ALREADY ABSOLUTE 
          LX5    24 
          BX4    -X0*X5 
          SB7    X4          (B7) = (NO. OF ENTRY POINTS) + 1 
          SB6    B1+B1
 IU       IFUSER
          GT     B7,B1,LIBLD2 
          MX7    0
          ERROR  4225,X7     ---- FORMAT ERROR ON LIBLOAD REQUEST 
          EQ     LLO         IGNORE REQUEST COMPLETELY
  
 IU       ENDIF 
  
**        2)   THE ENTRY POINTS SPECIFIED IN THE REQUEST ARE FETCHED
*              AND PLACED IN A TABLE WHICH IS USED BY THE DIRECTORY 
*              SEARCH ROUTINE *SLD=*.  THE TABLE IS *TLNK2*, AND IT 
*              IS FORMATTED SIMILAR TO THE MAIN LINKAGE TABLE *TLNK*. 
*              THESE ENTRIES ARE NOT PLACED IN *TLNK* SINCE THEY ARE
*              NOT TO BE CONSIDERED UNSATISFIED EXTERNALS AS SUCH.
* 
  
 LIBLD2   GT     B6,B7,LIBLD6      IF NO MORE ENTRY POINTS
          SA3    A0          GET NEXT ENTRY 
          SA1    X3+B6
 SAVENT   IFCARD
 IN       IFNOS 
          RJ     SFN=        SPACE FILL NAME
          LX6    -2*6        POSITION SO NAME BEGINS AT CHAR 3
          SA6    NOFIND      SAVE ENTRY NAME FOR POSSIBLE DIAG
 IN       ENDIF 
 SAVENT   ENDIF 
 LIBENT   IFUSER
          RJ     /MISC/EPNCK CHECK FORMAT OF NAME 
          PL     X6,LIBLD3   IF NAME OK 
          BX7    X1          (X7) = BAD NAME
          ERROR  4225,X7     ---- FORMAT ERROR ON LIBLOAD REQUEST 
          EQ     LIBLD5 
  
 LIBLD3   BSS    0
 LIBENT   ENDIF 
          MX2    0
          RJ     ELT         SEARCH FOR NAME IN *TLNK*
          ZR     X2,LIBLD4   IF NAME NOT IN *TLNK*
          LX2    59-58
          PL     X2,LIBLD5   IF ENTRY DEFINED, DONT ADD TO *TLNK2*
 LIBLD4   LX1    18          RESTORE NAME 
          SX2    B1          SET ENTRY AS UNSATISFIED 
          LX2    58 
          SB1    -B1         INDICATE USE OF *TLNK2*
          RJ     ELT         ENTER *TLNK2*
 LIBLD5   BSS    0
          SB6    B6+B1       LOOP THROUGH LIST
          EQ     LIBLD2 
  
**        3)   THE LIBRARY NAME IS NOW FETCHED.  IF SPECIFIED, ONLY ONE 
*              LIBRARY IS SEARCHED.  IF NOT SPECIFIED, LIBRARIES ARE
*              SEARCHED AS FOLLOWS -- GLOBAL LIBRARY SET, THEN LOCAL     CP146A 
*              LIBRARY SET, THEN *NUCLEUS* (NOS/BE ONLY, DEFAULT         CP146A 
*              LIBRARY FOR NAME-CALL STATEMENTS.)  NOTE -- IF AN         CP146A 
*              INTERNAL LIBLOAD FOR *TRPSETR* THEN USE *SYSLIB*.         CP146A 
* 
*              NOTE THAT HAVING THE CAPABILITY TO DETERMINE THE LIBRARY 
*              NAME HERE DOES NOT IMPLY THAT THERE IS UNLIMITED 
*              CAPABILITY OF SPECIFYING *LIBLOAD* REQUESTS IN THIS
*              MANNER.  IF THE NAME IS NOT SPECIFIED, THERE MUST BE 
*              ONLY ONE ENTRY POINT SPECIFIED.  THIS SIMPLIFIES THE 
*              SEARCH PROCEDURE TO THE EXTENT THAT IT WILL NEVER BE 
*              NECESSARY TO FIND THE ENTRY POINTS SPECIFIED ON MORE 
*              THAN ONE LIBRARY.
* 
  
 LIBLD6   SA1    A0          GET LIBRARY NAME 
          IFCARD 2
          MX6    0           FLAG NOT PROGRAM CALL CARD 
          SA6    LIBLDPC
          SA1    X1+B1
 LIBNAME  IFUSER
          ZR     X1,LIBLD6A  IF NO LIB NAME SPECIFIED 
          RJ     /MISC/LFNCK CHECK LIBRARY NAME FORMAT
          PL     X6,LIBLD8   IF OK
          BX7    X1          (X7) = BAD NAME
          ERROR  4225,X7     ---- FORMAT ERROR ON LIBLOAD REQUEST 
          EQ     LIBLD14     GO TO EXIT 
  
 LIBLD6A  BSS    0
 LIBNAME  ENDIF 
  
 LIBNAME  IFCARD
          AX1    18 
          MX0    42 
          BX2    X1          +0 IF PROGRAM CALL 
          LX1    18          -0 IF NO LIBRARY NAME OTHERWISE
          BX1    X0*X1       RESTORE LIBRARY NAME 
          NZ     X2,LIBLD8   IF NAME SPECIFIED IN REQUEST 
          SX6    B1+B1
          NG     X2,LIBLD6B  IF NOT PROGRAM CALL
          SA6    A6          FLAG PROGRAM CALL
 LIBLD6B  BSS    0
 LIBNAME  ENDIF 
  
          MX6    0           INITIALIZE LIBRARY SET POINTER 
          SB2    B1+B1
          SA6    LIBLDPT
          EQ     B2,B7,LIBLD7      IF NO LIB NAME SPECIFIED, THERE MUST 
                                    BE ONLY ONE ENTRY POINT SPECIFIED 
          MX7    0           INDICATE NO NAME 
          ERROR  4225,X7     ---- FORMAT ERROR ON LIBLOAD REQUEST 
 LIBLD7   SA5    TLIB        GET NEXT LIBRARY NAME
          SA3    A5+B1
          SB3    X3 
          SA4    LIBLDPT     ADVANCE POINTER
          SX7    X4+B1
          SA7    A4 
          SB2    X4 
          EQ     B2,B3,LIBLD7A  IF NO MORE LIBS LEFT EXCEPT THE DEFAULT  CP146A 
          SA1    X5+B2       (X1) = LIBRARY NAME
          IFCARD 2
          SA3    LIBLDPC     PROG CALL FLAG + *LIBLOAD* FLAG
          SX3    X3+B1
          SX2    TLNK2
          IFUSER 1
          SX3    B1          INDICATE *LIBLOAD* 
          SA5    TREQ        STORE LIBRARY NAME IN REQUEST
          BX7    X1 
          SA7    X5+B1
          RJ     SLD=        SEARCH LIBRARY DIRECTORY 
          SA2    TPADR+1
          ZR     X2,LIBLD7   IF ENTRY NOT FOUND IN LAST LIB 
          EQ     LIBLD9 
  
 LIBLD7A  BSS    0                                                       CP146A 
          SA1    =0LSYSLIB   SET *SYSLIB* AS LIBRARY NAME                CP146A 
 IC       IFCARD                                                         CP146A 
          SA5    LIBLDPC     CHECK FOR ENTRY POINT NAME CALL             CP146A 
 K        IFNOS                                                          CP146A 
          NZ     X5,LIBLD14  IF ENTRY POINT NAME CALL                    CP146A 
 K        ENDIF                                                          CP146A 
 S        IFSCOPE                                                        CP146A 
          ZR     X5,LIBLD7B  IF NOT ENTRY POINT NAME CALL                CP146A 
          SA1    =0LNUCLEUS  SET *NUCLEUS* AS LIBRARY NAME               CP146A 
 S        ENDIF                                                          CP146A 
 IC       ENDIF                                                          CP146A 
 LIBLD7B  BSS    0                                                       CP146A 
          BX7    X1          PLACE NAME IN REQUEST
          SA5    TREQ 
          SA7    X5+B1
  
**        4)   THE ROUTINE *SLD=* IS CALLED TO PERFORM THE DIRECTORY
*              SEARCHING OF THE SPECIFIED LIBRARY.  ALSO A FLAG IS
*              PASSED TO IT SO IT WILL NOT PROCESS THE ERT (EXTERNAL
*              REFERENCE TABLE) IN ORDER TO FETCH ANY ROUTINES TO WHICH 
*              THE SPECIFIED ROUTINES MAY LINK.  SUCH PROCESSING IS ONLY
*              TO BE DONE WHEN *SLD=* IS CALLED TO SATISFY
*              EXTERNALS.  *SLD=* RETURNS ITS INFORMATION IN
*              TABLE *TPADR* WHICH CONTAINS THE ADDRESSES OF THE
*              PROGRAMS CONTAINING THE SPECIFIED ENTRY POINTS.
* 
  
 LIBLD8   SX2    TLNK2
          IFUSER 1
          SX3    B1          INDICATE *LIBLOAD* (IE NO ERT SEARCH)
          IFCARD 2
          SA3    LIBLDPC     PROG CALL FLAG + *LIBLOAD* FLAG
          SX3    X3+B1
          RJ     SLD=        SEARCH LIBRARY DIRECTORY 
  
**        5)   THE LIBRARY NAME IS PLACED IN THE COMMUNICATION AREA AT
*              RA+64B.  THEN THE ROUTINE *LLP* IS CALLED TO LOAD THE
*              PROGRAMS.
* 
  
 LIBLD9   SA1    /SLD/LIBNAME      (X1) = LIBRARY NAME
          MX7    42 
          SA4    TPGM 
          IFCARD 4
          SA3    OG          NO COMMUNICATION AREA ALLOCATED IN *TPGM*
          ZR     X3,LIBLDB   ON OVERLAY LOADS 
          SX4    B0 
 LIBLDB   BSS    0
          R=     A3,X4+RA+COMNAME  PLACE LIBRARY NAME IN
          BX3    -X7*X3      COMMUNICATION AREA 
          BX6    X1+X3       (X1) = LIBRARY NAME
 A        IFTEST EQ,COMLBIT,COMNAME+1 
          SA4    A3+B1       SET BIT TO INDICATE NAME IS LIBRARY
 A        ELSE
          R=     A4,X4+RA+COMLBIT  SET BIT TO INDICATE NAME IS LIBRARY
 A        ENDIF 
 IU       IFUSER
          R=     A5,106B     READ RA+106B (SEE IF *FOL* DIRECTORY)
          NZ     X5,LIBLD9A  IF *FOL* PRESERVE RA+64B AND RA+65B
 IU       ENDIF 
          SA6    A3 
          SX3    B1 
          LX3    18 
          BX7    X3+X4
          SA7    A4 
 LIBLD9A  BSS    0
          RJ     LLP         GO LOAD THE NEEDED PROGRAMS
  
**        6)   IN ORDER TO DETERMINE WHETHER OR NOT ALL THE SPECIFIED 
*              ENTRY POINTS WERE LOADED, IT IS NECESSARY TO FIND THEM IN
*              MAIN LOADER TABLES.  FOR RELOCATABLE LOADS, THE ENTRY
*              POINTS SHOULD NOW EXIST IN THE MAIN LINKAGE TABLE *TLNK*.
*              FOR ABSOLUTE LOADS, THEY SHOULD APPEAR IN THE TABLE OF 
*              OVERLAY ENTRY POINTS *TOVEPT*.  A NON-FATAL ERROR IS 
*              ISSUED FOR EACH ENTRY POINT WHICH IS NOT NOW LOADED. 
  
          SA1    TLNK2+1
          SB6    B0          (B6) = *TLNK2* ORDINAL 
          SB7    X1          (B7) = *TLNK2* LENGTH
 LIBLD10  EQ     B6,B7,LIBLD14     IF ALL ENTRIES SCANNED 
          SA1    TLNK2
          SB5    B1+B1
          SA1    X1+B6       NEXT ENTRY 
          SB6    B6+B5
          LX1    18 
 ABS      IFCARD
          SA2    ABS
          ZR     X2,LIBLD12  IF NOT ABSOLUTE LOAD 
          SA3    TOVEPT      IF ABSOLUTE LOAD, ENTRY POINTS SHOULD
          SA2    A3+B1       NOW BE IN *TOVEPT* 
          MX6    42 
          IX2    X3+X2
          SB2    X3 
          SB3    X2 
          BX5    X1 
 LIBLD11  EQ     B2,B3,LIBLD13     IF NOT FOUND 
          SA2    B2 
          SB2    B2+B1
          NE     B6,B7,LIBLD11A    IF NOT LAST (OR ONLY) ENTRY TO CHECK 
          BX2    X2*X6
          ZR     X2,LIBLD14  IF ONE UNNAMED ENTRY 
 LIBLD11A BX2    X2-X1
          BX2    X2*X6
          ZR     X2,LIBLD10  IF NAME FOUND
          EQ     LIBLD11     LOOP THROUGH *TOVEPT*
  
 LIBLD12  BSS    0
 ABS      ENDIF 
          BX5    X1          IF LOAD IS RELOCATABLE, SEARCH *TLNK*
          MX2    0
          RJ     ELT
          ZR     X2,LIBLD13  IF ENTRY NOT IN *TLNK* 
          LX2    1
          PL     X2,LIBLD10  IF FOUND SATISFIED IN *TLNK* 
 LIBLD13  BX7    X5          (X7) = ENTRY NAME
  
 IC       IFCARD
  
          SA2    /SLD/FLAGS 
          LX2    59-0 
          NG     X2,LIBLD13A IF PROGRAM CALL
  
 IC       ENDIF 
  
          ERROR  4227,X7     ---- ENTRY ON LIBLOAD NOT FOUND
          EQ     LIBLD10     LOOP THROUGH *TLNK2* 
  
 IC       IFCARD
  
 LIBLD13A SA1    /SLD/NOTCCC
          SX6    B1          SET FOR SYSTEM ABORT 
          SA6    ABTTYPE
          NZ     X1,LIBLD13B IF FOUND BUT NOT CONTROL-CARD-CALLBLE
          ERROR  203,X7      ---- NO SUCH PROGRAM CALL NAME 
          EQ     ABEND
  
 LIBLD13B ERROR  204,X7      ---- NOT CONTROL-CARD-CALLABLE 
          EQ     ABEND
  
 IC       ENDIF 
  
 LIBLD14  SA2    TLNK2       EMPTY *TLNK2*
          RJ     CTAB=
          EQ     LLO         EXIT 
  
 LIBLDPT  CON    0
          IFCARD 1
 LIBLDPC  CON    0           NZ IF *LIBLOAD* FROM PROG CALL CARD
  
 CMECS    IFUSER
 CMLOAD   TITLE  REQUEST PROCESSOR - CMLOAD, ECLOAD.
**        CMLOAD - PROCESS *CMLOAD* OR *ECLOAD* REQUEST.
* 
*              *CMLOAD* AND *ECLOAD* REQUESTS FUNCTION EXACTLY LIKE THE 
*         *LOAD* REQUEST, EXCEPT THE LOAD INPUT IS FETCHED FROM AN AREA 
*         IN CM OR ECS, RESPECTIVELY, INTO WHICH IT WAS STORED PRIOR TO 
*         THE LOAD OPERATION. 
* 
  
 CMLOAD   PS                 ENTRY/EXIT 
 ECLOAD   EQU    CMLOAD 
          SX7    B1          FLAG THE OCCURRENCE OF 
          SA7    LF          NON-LIBRARY LOADING
          SX6    X5          (X6) = CMLOAD FWA
          NG     X6,CMLOAD6  IF CMLOAD FWA < 0, ISSUE ERROR 
          LX5    -18         (X7) = CMLOAD LWA+1
          SX7    X5 
          MX1    -12         (B2) = LENGTH OF REQUEST 
          LX5    -18
          BX4    -X1*X5 
          LX5    -12         (X0) = 0 IF *CMLOAD* 
          SB2    X4 
          BX5    -X1*X5 
          SB3    B0          (B3) = REQUIRED LENGTH OF REQUEST
          LD     X0,X5-CCMLOAD
          ZR     X0,CMLOAD1  IF *CMLOAD*
          SB3    B1 
          MX1    -24
          SA2    A5+B1       GET ECLOAD FWA AND LWA+1 
          BX6    -X1*X2      (X6) = ECLOAD FWA
          LX6    59-23
          NG     X6,CMLOAD6  IF ECLOAD FWA < 0, ISSUE ERROR 
          LX6    60-59+23 
          LX2    -24         (X7) = ECLOAD LWA+1
          BX7    -X1*X2 
 CMLOAD1  NE     B2,B3,CMLOAD6     IF REQUEST IS NOT CORRECT LENGTH 
          IX2    X6-X7       (FWA) - (LWA)
          PL     X2,CMLOAD6  IF (LWA) @ (FWA) 
          SX3    BASE        (X3) = FWA LOADABLE AREA 
          SA4    TEND        (X4) = LWA+1 LOADABLE AREA 
          R=     X4,X4+TABOO
          SA5    FL          (X5) = FIELD LENGTH
          SB7    B1          (B7) = VALUE TO SET *RDCTL*
          ZR     X0,CMLOAD5  IF *CMLOAD*
          IFTEST NE,IP.MECS,0,2 
          SA3    ECSPO       (X3) = FWA ECS LOADABLE AREA 
          SA4    ECSLWA      (X4) = LWA+1 ECS LOADABLE AREA 
          IFTEST EQ,IP.MECS,0,2 
          SX3    B1          FORCE VALUES TO DISALLOW *ECLOAD*
          SX4    B1 
          SA5    ECSFL
          SB7    B1+B1       SET *RDCTL* = 2 FOR *ECLOAD* 
 CMLOAD5  IX1    X6-X4
          NG     X1,CMLOAD7  IF BA < LWA+1 LOADABLE AREA
          IX2    X5-X7
          PL     X2,CMLOAD8  IF EA @ FIELD LENGTH 
 CMLOAD6  ERROR  4230        ---- FORMAT ERROR ON CMLOAD OR ECLOAD
          EQ     CMLOAD      IGNORE THE REQUEST 
  
 CMLOAD7  IX1    X3-X7
          NG     X1,CMLOAD6  IF EA NOT @ FWA LOADABLE AREA
  
**        1)   ONCE THE REQUEST IS DETERMINED TO BE OF LEGAL FORMAT, A
*              FLAG IS SET IN THE READ SUBROUTINE *RDW*, SO THAT IT 
*              WILL FETCH WORDS FROM THE AREA IN CM OR ECS, INSTEAD 
*              OF A LOAD FILE.
* 
  
 CMLOAD8  SA6    /CRDW/FWALWA      SET CM OR ECS FWA AND LWA
          SA7    A6+B1
          SX7    B7 
          SA7    /CRDW/RDCTL SET READ CONTROL 
  
**        2)   A SPECIAL FILE NAME IS PLACED IN THE FILE TABLE *TLFN*.
*              THE NAME IS AS FOLLOWS 
* 
*              FOR *CMLOAD*:  *CM*
*              FOR *ECLOAD*:  *ECS* 
* 
  
          SA1    B3+CMLOADF  FETCH APPROPRIATE LFN
          ADDWRD TLFN,X1     PLACE IN *TLFN*
          SA1    FI          ADVANCE FILE INDEX 
          SX7    X1+B1
          SA7    A1 
  
**        3)   THE ROUTINE *RDR* IS CALLED TO PERFORM THE READING OF
*              THE LOAD INPUT, AND THE ROUTINE *CPR* IS CALLED TO 
*              COMPLETE THE PHYSICAL LOAD.  THE INTERFACE WITH THESE
*              ROUTINES IS IDENTICAL TO THAT WHEN PROCESSING THE *LOAD* 
*              REQUEST. 
  
          READO  L
          BX5    X6 
          SA6    T1 
          RJ     /READ/RDR   PERFORM THE PHYSICAL LOAD
          RJ     CPR         COMPLETE PHYSICAL LOAD 
          EQ     CMLOAD      EXIT 
  
 CMLOADF  VFD    24/4H*CM*,36/0    LFN USED IN MAP FOR *CMLOAD* 
          VFD    30/5H*ECS*,30/0   LFN USED IN MAP FOR *ECLOAD* 
 CMECS    ENDIF 
 SATISFY  TITLE  REQUEST PROCESSOR - SATISFY. 
**        SATISFY - PROCESS *SATISFY* REQUEST.
* 
*              THE *SATISFY* REQUEST IS PROCESSED ENTIRELY BY THE 
*         ROUTINE *SAT*.  IF THE LENGTH OF THE REQUEST IS ZERO, THE 
*         LIBRARY SET IS USED.
  
  
 SFY      PS                 ENTRY/EXIT 
 IC       IFCARD
  
**             IF ENCAPSULATION AND THE CURRENT CAPSULE HAS NOT 
*         BEEN INITIATED, THEN IGNORE THE REQUEST COMPLETELY. 
  
          SA1    OG          CHECK FOR ENCAPSULATION
          PL     X1,SFYNCG   IF NOT ENCAPSULATION 
          SA1    CGFPAF      CHECK CAPSULE ALREADY INITIATED
          ZR     X1,SFY      IF NOT ALREADY INITIATED, IGNORE REQUEST 
 SFYNCG   BSS    0
 IC       ENDIF 
          IFCARD 2
          SA1    SEGFLAG
          NZ     X1,SFY1     IF A SEGMENT LOAD IGNORE DIRECTIVE 
          LX5    -36         (B7) = LENGTH OF REQUEST 
          BX5    -X0*X5 
          SB7    X5 
          RJ     SAT         SATISFY EXTERNALS
          EQ     SFY         EXIT 
  
          IFCARD 2
 SFY1     ERROR  4421        ---- SATISFY IGNORED ON SEGMENT LOAD 
          EQ     SFY
 LIB      TITLE  REQUEST PROCESSOR - LIB. 
**        LIB - PROCESS *LIB* REQUEST.
* 
*              IF THE REQUEST IS OF ZERO LENGTH, THEN THE LIBRARY TABLE 
*         *TLIB* IS SET SO AS TO CONTAIN ONLY THE LIBRARIES IN THE
*         CURRENTLY-DEFINED GLOBAL LIBRARY SET. 
* 
*              IF THE LENGTH OF THE REQUEST > 0, EACH OF THE SPECIFIED
*         LIBRARIES WHICH IS NOT ALREADY IN *TLIB* IS ADDED TO *TLIB*.
*         THUS, A LIBRARY CANNOT BE PUT IN THE LIBRARY SET MORE THAN
*         ONCE AT ANY ONE TIME VIA THE *LIB* REQUEST. 
  
  
 LIB      PS                 ENTRY/EXIT 
          SA4    LP          POINTER IN *TLIB* TO END OF GLOBAL 
          LX5    -36         LIBRARY SET
          BX0    -X0*X5      (X0) = LENGTH OF REQUEST 
          SX7    B1          FLAG CHANGE OF LIB SET FOR USE 
          SA7    SATCHG      DURING SATISFYING EXTERNALS
          NZ     X0,LIB1     IF ONE OR MORE LIBRARIES SPECIFIED 
          SA7    SATCHG1     FLAG START SEARCH FROM FRONT 
          BX6    X4          SET *TLIB* LENGTH SO AS TO 
          SA6    TLIB+1      INCLUDE ONLY GLOBAL SET
          EQ     LIB         EXIT 
  
 LIB1     SB6    B1          (B6) = (NO. OF LIBRARIES PROCESSED)+1
          SB7    X0 
          MX5    -1          (X5) = -1
 LIB2     SA4    A0          GET NEXT LIBRARY NAME
          GT     B6,B7,LIB   IF ALL NAMES PROCESSED 
          SA1    X4+B6
          SB6    B6+B1       ADVANCE COUNT
          RJ     /MISC/LFNCK CHECK NAME FORMAT
          PL     X6,LIB3     IF OK
          BX7    X1          (X7) = BAD NAME
          ERROR  4232,X7     ---- FORMAT ERROR ON LIB REQUEST 
          EQ     LIB2        IGNORE THIS NAME 
  
 LIB3     BSS    0
          ADDWRD TLIB,X1     ADD NAME TO *TLIB* 
          SB2    B0 
          SB3    X4+B1       (B3) = NEW *TLIB* LENGTH 
          EQ     B3,B1,LIB2  IF ONE NAME IN LIBRARY SET 
 LIB4     SA4    X2+B2       FIND THE NAME IN *TLIB*
          SA1    A2+B1
          IX7    X4-X6
          SB2    B2+B1
          NZ     X7,LIB4
          EQ     B2,B3,LIB2  IF NAME NOT ALREADY PRESENT
          IX6    X1+X5       SHORTEN *TLIB* BY ONE WORD,
          SA6    A1          I.E. DO NOT ADD LAST NAME
          EQ     LIB2        LOOP 
 MAP      TITLE  REQUEST PROCESSOR - MAP. 
**        MAP - PROCESS *MAP* REQUEST.
* 
*              THE *MAP* REQUEST CONSISTS OF MERELY STORING THE 
*         OPTIONS SELECTED BY THE REQUEST, SO AS TO AFFECT WHAT WILL BE 
*         DONE WHEN IT COMES TIME TO WRITE A MAP.  THE MAP REQUEST IS A 
*         RESULT OF THE *LDSET* OPTION AND DOES NOT AFFECT THE DEFAULT
*         MAP OPTION. 
  
  
 MAP      PS                 ENTRY/EXIT 
          MX0    -12         (B2) = LENGTH OF REQUEST 
          LX5    24 
          SA1    =0LOUTPUT   DEFAULT MAP FILE = *OUTPUT*
          BX3    -X0*X5 
          BX6    X1 
          SB2    X3 
          ZR     B2,MAP3     IF NO LFN SPECIFIED IN REQUEST 
          EQ     B2,B1,MAP2  IF REQUEST NOT TOO LONG
 MAP1     ERROR  4233        ---- FORMAT ERROR ON MAP REQUEST 
          EQ     MAP         EXIT 
  
 MAP2     SA1    A5+B1       GET MAP LFN
          MX0    42 
          BX1    X0*X1
          BX6    X1          SAVE MAP LFN 
          RJ     /MISC/LFNCK CHECK LFN FORMAT 
          NG     X6,MAP1     IF LFN FORMAT ERROR
 MAP3     LX5    -24+59      POSITION TO BIT WHICH TELLS IF 
          MX4    -4          MAP TYPE WAS SPECIFIED 
          SA2    MAPDEF      (X7) = DEFAULT MAP TYPE
          BX7    X2 
          PL     X5,MAP4     IF MAP TYPE NOT SPECIFIED
          BX7    -X4*X5      (X7) = MAP TYPE AS SPECIFIED 
 MAP4     SA6    MAPLFN      SET FILE FOR MAP 
          SA3    MAPTYPE     CURRENT MAP TYPE 
          AX3    1           NZ IF BLOCKS OR GREATER
          SA7    A3          SET NEW MAP TYPE 
          NZ     X3,MAP      IF BLOCKS OR GREATER PREVIOUSLY IN EFFECT
          AX7    1
          SA7    /READ/NEEDPRX  NZ IF NEW TYPE = BLOCKS OR GREATER
          EQ     MAP         EXIT 
 PD       TITLE  REQUEST PROCESSOR - PD 
**        PD - PROCESS *PD* REQUEST.
* 
*              THE *PD* REQUEST STORES THE VALUE SELECTED FOR PRINT 
*         DENSITY IN *PRDEN*.  THE DENSITY IS USED IN PRINTING
*         AND SEGMENT LOAD TREE DIAGRAMS.  THE *PD* REQUEST IS A RESUL] 
*         OF THE *LDSET* OR *LDREQ* OPTION AND DOES NOT AFFECT THE
*         INSTALLATION DEFAULT. 
  
  
 PD       PS                 ENTRY/EXIT 
          SA1    PRDEN
          MI     X1,PD       IF MAP STARTED DON-T CHANGE DENSITY
          SX6    X5          ISOLATE PARAMETER VALUE
          R=     X1,X6-6
          ZR     X1,PD1      IF DENSITY IS 6 LINES/INCH 
          R=     X1,X6-8
          ZR     X1,PD1      IF DENSITY IS 8 LINES/INCH 
          MX6    60          ERROR BUT USE JOB DEFAULT
 PD1      SA6    A1          SET DENSITY SELECTED CELL TO VALUE 
          EQ     PD          EXIT 
 PS       TITLE  REQUEST PROCESSOR - PS.
**        PS - PROCESS *PS* REQUEST.
* 
*              THE *PS* REQUEST STORES THE VALUE SELECTED FOR PAGE SIZE 
*         IN *PGSIZ*.  THE PAGE SIZE IS USED IN PRINTING THE MAP AND
*         SEGMENT LOAD TREE DIAGRAMS.  THE *PS* REQUEST IS A RESULT 
*         OF THE *LDSET* OR *LDREQ* OPTIONS AND DOES NOT AFFECT THE 
*         DEFAULT.
  
  
 PS       PS                 ENTRY/EXIT 
          SA1    PRDEN       USE *PRDEN* AS FLAG FOR MAP STATUS 
          MI     X1,PS       IF MAP STARTED DON-T CHANGE PAGE SIZE
          MX6    -21         (X6) = SPECIFIED VALUE FOR *PS*
          BX6    -X6*X5 
          R=     X1,10D 
          IX1    X6-X1
          MI     X1,PS2      IF SPECIFIED VALUE LT 10 
          R=     X1,1000D 
          IX1    X1*X1
          IX1    X1-X6
          PL     X1,PS1      IF SPECIFIED VALUE LE 1,000,000 (DECIMAL)
 PS2      MX6    60          ERROR BUT USE JOB DEFAULT
 PS1      SA6    PGSIZ       SET PAGE SIZE CELL.
          EQ     PS          EXIT 
 PRESET   TITLE  REQUEST PROCESSOR - PRESET.
**        PRESET - PROCESS *PRESET* REQUEST.
* 
*              THE *PRESET* REQUEST CONSISTS OF MERELY STORING THE
*         OPTION SELECTED BY THE REQUEST.  THIS AFFECTS HOW ANY 
*         SUBSEQUENT PRESETTING WILL BE PERFORMED.
  
  
 PRESET   PS                 ENTRY/EXIT 
          MX0    -12         (B2) = LENGTH OF REQUEST 
          LX5    24 
          BX7    -X0*X5 
          SB2    X7 
          LE     B2,B1,PRESET1     IF REQUEST NOT TOO LONG
          ERROR  4234        ---- FORMAT ERROR ON PRESET REQUEST
          EQ     PRESET      EXIT 
  
 PRESET1  ZR     B2,PRESET3  IF NO PRESETTING SELECTED
          SA1    A5+B1       (X6) = PRESET VALUE
          BX6    X1 
          LX5    -24+59 
          SX7    -B1         SET FOR NO ADDRESS INSERTION 
          PL     X5,PRESET2  IF NO ADDRESS INSERTION
          SX7    B1          SET FOR ADDRESS INSERTION
          MX0    -17         ADDRESS WILL GO IN LOWER 17 BITS 
          BX6    X0*X6
 PRESET2  SA6    PSMB        SET PRESET VALUE 
 PRESET3  SA7    PSMA        SET PRESET FLAG
          EQ     PRESET      EXIT 
  
 ERRREW   IFCARD
 ERR      TITLE  REQUEST PROCESSOR - ERR. 
**        ERR - PROCESS *ERR* REQUEST.
* 
*              THE *ERR* REQUEST IS AVAILABLE ONLY FOR CONTROL-CARD-
*         INITIATED LOADS.  THE REQUEST CONSISTS OF MERELY SAVING THE 
*         OPTION SELECTED IN THE REQUEST.  THIS OPTION IS USED
*         DURING LOAD COMPLETION FOR DETERMINING WHETHER OR NOT TO ABORT
*         IF ANY ERRORS OCCURRED. 
  
  
 ERR      PS                 ENTRY/EXIT 
          SX7    X5          SET ERROR OPTION 
          SA7    EP 
          EQ     ERR         EXIT 
 REWIND   TITLE  REQUEST PROCESSOR - REWIND, NOREWIN. 
**        REWIND - PROCESS *REWIND* OR *NOREWIN* REQUEST. 
* 
*              THE *REWIND* OR *NOREWIN* REQUEST IS AVAILABLE ONLY FOR
*         CONTROL-CARD-INITIATED LOADS.  THE OPTION SPECIFIED BY THE
*         REQUEST IS SAVED FOR USE IN PROCESSING SUBSEQUENT LOAD FILES. 
  
  
 REWIND   PS                 ENTRY/EXIT 
          SX7    X5          0 FOR *NOREWIN*, 1 FOR *REWIND*
          SA7    REW         SAVE OPTION
          EQ     REWIND      EXIT 
  
 ERRREW   ENDIF 
 USEP     TITLE  REQUEST PROCESSOR - USEP.
**        USEP - PROCESS *USEP* REQUEST.
* 
*              EACH SPECIFIED PROGRAM NAME IS ADDED TO THE TABLE *TUSEP*
*         PROVIDED THE FOLLOWING CONDITIONS ARE MET - 
* 
*         1) THE NAME DOES NOT EXIST IN *TBLK* AS A PROGRAM (VS COMMON) 
*            WHICH WAS LOADED FROM A LIBRARY. 
*         2) THE NAME IS NOT ALREADY IN *TUSEP*.
  
  
 USEP     PS                 ENTRY/EXIT 
          LX5    -36         (B7) = NO. OF NAMES IN REQUEST 
          BX5    -X0*X5 
          SB6    B0          (B6) = FETCH POINTER FOR NAMES 
          SB7    X5 
 USEP1    SA5    A0          GET NEXT NAME  (A0) = REQ TBL POINTER
          SB6    B6+B1
          MX0    42 
          SA1    X5+B6
          GT     B6,B7,USEP  IF ALL NAMES PROCESSED 
          RJ     /MISC/EPNCK CHECK PROGRAM NAME FORMAT
          PL     X6,USEP2    IF OK
          BX7    X1          (X7) = BAD NAME
          ERROR  4235,X7     ---- FORMAT ERROR ON USEP REQUEST
          EQ     USEP1       IGNORE THIS NAME 
  
 USEP2    BSS    0
          SA5    TBLK        SEARCH *TBLK* FOR NAME 
          SB3    X5          (B3) = FWA *TBLK*
          SA3    A5+B1       (B4) = LWA+1 *TBLK*
          IX3    X5+X3
          SB4    X3 
 USEP3    EQ     B3,B4,USEP4 IF *TBLK* EXHAUSTED
          SA3    B3          NEXT ENTRY 
          SA4    A3+B1       2ND WORD OF ENTRY
          BX6    X3-X1       COMPARE NAMES
          LX3    59-0        PROG/COMMON BIT TO SIGN POS
          BX6    X0*X6
          SB3    A4+B1       ADVANCE FETCH ADDRESS
          NZ     X6,USEP3    IF NO NAME MATCH 
          SA2    TLFN 
          NG     X3,USEP3    IF NOT PROGRAM NAME
          MX6    -11
          AX4    48 
          BX4    -X6*X4      (B2) = *TLFN* INDEX
          SB2    X4 
          SA3    X2+B2       GET *TLFN* ENTRY 
          SX3    X3 
          ZR     X3,USEP3    IF NOT FROM LIBRARY FILE 
          EQ     USEP1       IF FROM LIBRARY FILE - SKIP
  
 USEP4    ADDWRD TUSEP,X1    PLACE NAME IN TABLE
          SB3    X3+B1       (B3) = TABLE LWA+1 
          SA3    X2          SEE IF NAME WAS ALREADY IN TABLE 
 USEP5    BX6    X3-X1       IF SO, IT SHOULD NOT GO IN AGAIN 
          SA3    A3+B1
          NZ     X6,USEP5    LOOP UNTIL MATCH 
          SB2    A3          (B2) = ADDRESS+1 OF MATCH
          EQ     B2,B3,USEP1 IF NAME NOT PREVIOUSLY IN TABLE
          BX7    X4          MAKE EFFECT OF NOT INSERTING BY
          SA7    A2+B1       SHORTENING TABLE BY 1 WORD AT END
          EQ     USEP1       GO GET NEXT NAME 
 USE      TITLE  REQUEST PROCESSOR - USE. 
**        USE - PROCESS *USE* REQUEST.
* 
*              EACH SPECIFIED ENTRY NAME IS PLACED IN *TLNK* BY USE 
*         OF THE ROUTINE *ELT*, THAT IS, IF IT IS ALREADY THERE, ITS
*         CURRENT DEFINITION IS NOT CHANGED, BUT IF IT IS NOT THERE,
*         (OR IS THERE BUT ITS ADDRESS FIELD IN THE *TLNK* WORD IS 0)    LDR0212
*         IT GOES IN WITH BIT 58 = 1 IN THE DEFINITION WORD TO INDICATE 
*         IT IS UNSATISFIED.  THEN, IN ANY CASE, BITS 57 AND 55 IN THE
*         DEFINITION WORD IS CLEARED.  THIS HAS THE EFFECT OF ENDING
*         *OMIT* CONTROL IN THE CASE IN WHICH THIS EXTERNAL HAD BEEN
*         PREVIOUSLY MENTIONED ON AN *OMIT* REQUEST.
*         A *USE* REQUEST NEGATES A PREVIOUS *OMIT* REQUEST,
*         I. E. THE ENTRY IS SQUEEZED OUT OF *TOMIT*. 
*         A *USE* REQUEST ENSURES THAT THE EXTERNAL IS STRONG.
  
  
 USE      PS                 ENTRY/EXIT 
          LX5    -36         (B7) = NO. OF NAMES IN REQUEST 
          BX5    -X0*X5 
          SB6    B0          (B6) = FETCH POINTER FOR NAMES 
          SB7    X5 
 USE1     SA5    A0          GET NEXT NAME  (A0) = REQ TBL POINTER
          SB6    B6+B1
          SA1    X5+B6
          GT     B6,B7,USE   EXIT IF ALL NAMES PROCESSED
          RJ     /MISC/EPNCK CHECK ENTRY NAME FORMAT
          PL     X6,USE2     IF OK
          BX7    X1          (X7) = BAD NAME
          ERROR  4236,X7     ---- FORMAT ERROR ON USE REQUEST 
          EQ     USE1        IGNORE THIS NAME 
  
 USE2     BSS    0
          SX2    B1          SET FOR NEW ENTRY = UNSATISFIED
          BX5    X1          SAVE NAME
          LX2    58 
          RJ     ELT         PLACE IN *TLNK* IF NOT THERE 
          SA1    TLNK        GET DEFINITION WORD
          SB2    X6 
          SA4    X1+B2
          R=     X2,5        CLEAR *OMIT* AND *WEAK* BITS 
          LX2    59-4        POSITION MASK BITS TO 57 AND 55
          BX7    -X2*X4 
          MX2    -24-12-18
          BX2    -X2*X4      IF STILL UNSATISFIED, ALL EXCEPT UPPER 
          NZ     X2,USE2A     SIX (6) BITS WILL BE CLEAR
          SX2    B1                                                      LDR0212
          LX2    58                                                      LDR0212
          BX7    X2+X7       SET *UNSAT* BIT IN *TLNK* DEF WORD          LDR0212
 USE2A    BSS    0                                                       LDR0212
          SA7    A4 
          SA5    A4-B1       X5 = *TLNK* NAME 
          LX5    18          LEFT ADJ NAME
          SA1    TOMIT       PROCEED TO LEAVE OUT OF *TOMIT*
          SB2    X1          B2 = *TOMIT* FWA 
          SA1    A1+B1
          SB3    X1          B3 = *TOMIT* LENGTH
          SB4    B0          B4 = *TOMIT* LOAD INDEX
          SB5    B0          B5 = *TOMIT* STORE INDEX 
          ZR     B3,USE4     IF *TOMIT* EMPTY 
 USE3     SA1    B2+B4       GET *TOMIT* NAME 
          IX1    X1-X5       CHECK FOR SAME NAME
          ZR     X1,USE3A    IF SAME NAME SQUEEZE OUT 
          SA1    B2+B4       GET *TOMIT* NAME 
          BX7    X1 
          SA7    B2+B5       STORE BACK INTO *TOMIT*
          SB5    B5+B1
 USE3A    SB4    B4+B1
          LT     B4,B3,USE3  CONTINUE SQUEEZE 
          SX7    B5 
          SA7    TOMIT+1     STORE NEW *TOMIT* LENGTH 
 USE4     BSS    0
          EQ     USE1        GO PROCESS NEXT NAME 
 IC       IFCARD
 CGENT    TITLE  REQUEST PROCESSOR - EPT. 
**        CGENT - PROCESS *EPT* REQUEST.
* 
*              IF WE ARE PROCESSING REQUESTS THAT ARE NOT FROM OBJECT 
*         DIRECTIVES OR ARE CURRENTLY IN CAPSULE OR OVCAP GENERATION
*         MODE, THEN THE SPECIFIED NAMES ARE ADDED TO TABLE *TCPENT*
*         AS AN *EPT* OPTION AND WILL BE USED TO DETERMINE CAPSULE OR 
*         OVCAP ENTRY POINT CONTROL.  OVERRIDES A PREVIOUS *NOEPT*. 
* 
*              IF WE ARE PROCESSING OBJECT DIRECTIVES AND ARE NOT IN
*         CAPSULE OR OVCAP GENERATION AND WE HAVE NOT LOADED ANYTHING 
*         YET AND WE ARE GENERATING A (0,0) LEVEL OVERLAY (OR EQUIV)
*         THEN WE ADD THE NAME TO THE ENTRY POINT NAMES ALREADY IN
*         *TPGM* (SUPPRESSING DUPLICATES) AND BUMP THE ENTRY POINT
*         COUNT AND VARIOUS PROGRAM POINTERS.  MULTIPLE ENTRY POINT 
*         MAIN OVERLAYS ARE NOW GENERATABLE.
  
 CGENT    PS                 ENTRY/EXIT 
          LX5    -36
          BX5    -X0*X5 
          SB6    B0          (B6) = REQUEST POINTER 
          SB7    X5          (B7) = REQUEST LENGTH
 CGENT1   EQ     B6,B7,CGENT  IF NO MORE NAMES
          SA1    A0          GET NEXT NAME (A0)=REQ TBL POINTER 
          SB6    B6+B1
          SA1    X1+B6
          RJ     /MISC/EPNCK
          PL     X6,CGENT2   IF VALID ENTRY POINT NAME
          BX7    X1 
          ERROR  4500,X7     ---- FORMAT ERROR ON EPT REQUEST 
          EQ     CGENT1      IGNORE THIS NAME 
  
 CGENT2   MX0    42 
          BX1    X0*X1       (X1) = 42/0LNAME,18/0
          SA2    REQTYPE     CHECK TYPE OF REQUEST (10B=OBJ DIR)
          R=     X2,X2-10B
          NZ     X2,CGENT2A  IF REQUEST NOT FROM OBJECT DIRECTIVES
          SA2    OG 
          R=     B2,X2-2
          MI     X2,CGENT2A  IF CAPSULE GENERATION
          NZ     B2,CGENT5   IF NOT OVCAP GENERATION
 CGENT2A  BSS    0
          SA2    TCPENT      CHECK IF NAME ALREADY IN *TCPENT*
          SA3    A2+B1
          SB2    X2 
          SB3    X3+B2       (B3)=LWA+1 OF *TCPENT* (LIMIT) 
          SB2    B2-B1       (B2)=FWA-1 OF *TCPENT* (POINTER) 
 CGENT3   SB2    B2+B1       POINT TO NEXT WORD IN *TCPENT* 
          GE     B2,B3,CGENT4  IF NOT CURRENTLY IN *TCPENT* 
          SA2    B2          NEXT NAME
          BX2    X0*X2
          BX2    X1-X2       COMPARE NAMES
          NZ     X2,CGENT3   IF MISMATCH
          BX6    X1          (X6) = 42/0LNAME,18/0(*EPT* INDICATOR) 
          SA6    B2          CHANGE ENTRY IN *TCPENT* 
          EQ     CGENT1      CONTINUE 
  
 CGENT4   ADDWRD TCPENT,X1   ADD *EPT* REQUEST TO *TCPENT*
          EQ     CGENT1      CONTINUE 
  
 CGENT5   SA3    TPGM        (X3) = FWA *TPGM*
          R=     B2,COMLTH   (B2) = COMLTH
          ZR     X2,CGENT6   IF NOT OVERLAY GENERATION
          R=     B2,10B      (B2) = LENGTH OF 54 TABLE OVERLAY HEADER 
 CGENT6   SA2    EPTC        (X2) = ENTRY POINT COUNT 
          SB5    X2+B2       (B5)=RELATIVE LWA+1 OF EPT LIST IN *TPGM*
          SB2    X3+B2       (B2) = ABS FWA OF EPT LIST IN *TPGM* 
          SB3    X2+B2       (B3) = ABS LWA+1 OF EPT LIST IN *TPGM* 
          SA3    SEGFLAG
          NZ     X3,CGENT6A  IF SEGMENT GENERATION
          SA3    OGL1 
          NZ     X3,CGENT6A  IF NOT (0,0) OVERLAY 
          SA3    PC 
          ZR     X3,CGENT7   IF NOTHING LOADED YET
 CGENT6A  BX7    X1 
          ERROR  4503,X7     ---- EPT REQUEST IGNORED 
          EQ     CGENT1 
  
 CGENT7   SA3    B2          GET FIRST EPT NAME FROM *TPGM* 
          NZ     X3,CGENT8   IF AT LEAST ONE NAME ALREADY THERE 
          BX6    X1          (X6) = 42/NAME,18/0
          SA6    B2          WRITE THIS NAME INTO DEFAULT NAME SLOT 
*                            WORD ALREADY ALLOCATED IN *TPGM* AND 
*                            EPTC, PA, PO, AND BI ARE ALREADY CORRECT 
          EQ     CGENT1      CONTINUE 
  
 CGENT8   SA2    B2          GET CURRENT EPT NAME FROM *TPGM* EPT LIST
          SB2    B2+B1       BUMP FETCH POINTER 
          BX2    X2-X1       COMPARE NAMES
          ZR     X2,CGENT1   IF SAME NAME (SUPPRESS DUPLICATES) 
          LT     B2,B3,CGENT8  CONTINUE SEARCH IF NOT DONE
          BX0    X1          SAVE NAME
          ALLOC  TPGM,1      ALLOCATE WORD IN *TPGM*
          SA1    TPGM        (X1) = FWA *TPGM*
          BX6    X0 
          SA6    X1+B5       ADD NAME TO EPT LIST IN *TPGM* 
          SA2    EPTC        BUMP ENTRY POINT COUNT 
          SX6    X2+B1
          SA6    A2 
          SA2    PA          BUMP PROGRAM ADDRESS 
          SX6    X2+B1
          SA6    A2 
          SA2    PO          BUMP PROGRAM ORIGIN
          SX6    X2+B1
          SA6    A2 
          SA2    BI          BUMP BINARY INDEX
          SX6    X2+B1
          SA6    A2 
          EQ     CGENT1      CONTINUE 
  
 CGNENT   TITLE  REQUEST PROCESSOR - NOEPT. 
**        CGNENT - PROCESS *NOEPT* REQUEST. 
* 
*              EACH SPECIFIED NAME IS ADDED TO TABLE *TCPENT* 
*         AS A *NOEPT* OPTION.  OVERRIDES A PREVIOUS *EPT*. 
*         A *NOEPT* REQUEST WHICH SPECIFIES NO NAMES IS USED TO 
*         INDICATE THAT THE DEFAULT ENTRY POINT DETERMINATION FOR 
*         CAPSULES/OVCAPS IS TO BE BYPASSED.  IN THIS CASE A FLAG 
*         IS SET AND USED LATER IN */LOADG/CGEPL*.
  
 CGNENT   PS                 ENTRY/EXIT 
          LX5    -36
          BX5    -X0*X5 
          SB6    B0          (B6) = REQUEST POINTER 
          SB7    X5          (B7) = REQUEST LENGTH
          NZ     B7,CGNENT1  IF SOME NAMES SPECIFIED
          SX6    B1 
          SA6    CGNDE       SET NO DEFAULT ENTRY POINT FLAG
          EQ     CGNENT      EXIT 
  
 CGNENT1  EQ     B6,B7,CGNENT  IF NO MORE NAMES 
          SA1    A0          GET NEXT NAME (A0)=REQ TBL POINTER 
          SB6    B6+B1
          SA1    X1+B6
          RJ     /MISC/EPNCK
          PL     X6,CGNENT2  IF VALID ENTRY POINT NAME
          BX7    X1 
          ERROR  4501,X7     ---- FORMAT ERROR ON NOEPT REQUEST 
          EQ     CGNENT1     IGNORE THIS NAME 
  
 CGNENT2  MX0    42 
          BX1    X0*X1       (X1) = 42/0LNAME,18/0
          SA2    TCPENT      CHECK IF NAME ALREADY IN *TCPENT*
          SA3    A2+B1
          SB2    X2 
          SB3    X3+B2       (B3)=LWA+1 OF *TCPENT* (LIMIT) 
          SB2    B2-B1       (B2)=FWA-1 OF *TCPENT* (POINTER) 
 CGNENT3  SB2    B2+B1       POINT TO NEXT WORD IN *TCPENT* 
          GE     B2,B3,CGNENT4  IF NOT CURRENTLY IN *TCPENT*
          SA2    B2          NEXT NAME
          BX2    X0*X2
          BX2    X1-X2       COMPARE NAMES
          NZ     X2,CGNENT3  IF MISMATCH
          SX6    B1 
          BX6    X1+X6       (X6) = 42/0LNAME,18/1(*NOEPT* INDICATOR) 
          SA6    B2          CHANGE ENTRY IN *TCPENT* 
          EQ     CGNENT1     CONTINUE 
  
 CGNENT4  SX6    B1 
          BX1    X1+X6
          ADDWRD TCPENT,X1   ADD *NOEPT* REQUEST TO *TCPENT*
          EQ     CGNENT1     CONTINUE 
  
 IC       ENDIF 
 SUBST    TITLE  REQUEST PROCESSOR - SUBST. 
**        SUBST - PROCESS *SUBST* REQUEST.
* 
*              EACH PAIR OF ENTRY POINT NAMES SPECIFIED IS STORED AT THE
*         FRONT OF TABLE *TSUBST*.  THEY ARE STORED AT THE FRONT SO 
*         THAT THE MOST RECENT SPECIFICATIONS TAKE PRECEDENCE IN
*         CASE OF A CONFLICT. 
  
  
 SUBST    PS                 ENTRY/EXIT 
          SB5    B1+B1       (B5) = 2 
          SB6    -B1         (B6) = POINTER TO CURRENT PAIR 
          LX5    -36         (B7) = REQUEST LENGTH
          BX5    -X0*X5 
          SB7    X5 
 SUBST1   SB6    B6+B5       ADVANCE POINTER
          GT     B6,B7,SUBST IF NO MORE PAIRS 
          SA5    A0 
          SA1    X5+B6       1ST NAME 
          NE     B6,B7,SUBST2      IF NOT A LONE ENTRY
          MX7    42          (X7) = LAST NAME SPECIFIED 
          SA5    =C+*NO 2ND*+      (X5) = INDICATOR OF ODD COUNT
          BX7    X7*X1
          ERROR  4237,X7     ---- FORMAT ERROR ON SUBST REQUEST 
          ADDWRD A2,X5       PLACE INDICATOR IN *TERR*
          EQ     SUBST       IGNORE LAST NAME 
  
 SUBST2   SA5    A1+B1       2ND NAME 
          SB4    B0 
          RJ     /MISC/EPNCK CHECK 1ST NAME 
          BX7    X1          SAVE 1ST NAME IN CASE OF ERROR 
          PL     X6,SUBST3   IF 1ST NAME OK 
          SB4    B4+B1
 SUBST3   BX1    X5          CHECK 2ND NAME 
          RJ     /MISC/EPNCK
          BX5    X1          SAVE 2ND NAME IN CASE OF ERROR 
          PL     X6,SUBST4   IF 2ND NAME OK 
          SB4    B4+B1
 SUBST4   ZR     B4,SUBST5   IF BOTH NAMES OK 
          ERROR  4237,X7     ---- FORMAT ERROR ON SUBST REQUEST 
          ADDWRD A2,X5       PLACE 2ND NAME IN *TERR* 
          EQ     SUBST1      IGNORE THIS PAIR 
  
 SUBST5   BSS    0
          ALLOC  TSUBST,2,FRONT    ALLOCATE SPACE FOR THIS PAIR 
          SA1    A0          PLACE NAMES AT FRONT OF *TSUBST* 
          MX0    42 
          SA4    X1+B6
          SA5    A4+B1
          BX6    X0*X4
          BX7    X0*X5
          SA6    X2          STORE 1ST
          SA7    X2+B1       STORE 2ND
          EQ     SUBST1      PROCESS NEXT PAIR
 OMIT     TITLE  REQUEST PROCESSOR - OMIT.
**        OMIT - PROCESS *OMIT* REQUEST.
* 
*              EACH SPECIFIED EXTERNAL NAME IS PLACED IN TABLE *TLNK* 
*         VIA THE ROUTINE *ELT*.  IF IT WAS ALREADY THERE, ITS
*         PREVIOUS DEFINITION IS UNAFFECTED.  IF IT WAS NOT THERE, IT IS
*         NOW SHOWN AS UNSATISFIED  (BIT 58 OF THE DEFINITION 
*         WORD = 1).  THEN BIT 57 OF THE DEFINITION IS SET TO 
*         INDICATE THE EXTERNAL IS UNDER *OMIT* CONTROL, THAT IS, 
*         EVEN IF IT HAS BECOME SATISFIED AT LOAD COMPLETION, IT
*         WILL BE PROCESSED AS IF UNSATISFIED.
*         THE ENTRY IS ALSO PLACED IN *TOMIT* IN *TLNK* FORMAT. 
  
  
 OMIT     PS                 ENTRY/EXIT 
          LX5    -36         (B6) = REQUEST POINTER 
          BX5    -X0*X5      (B7) = REQUEST LENGTH
          SB6    B0 
          SB7    X5 
 OMIT1    EQ     B6,B7,OMIT  IF NO MORE NAMES IN REQUEST
          SA1    A0          GET NEXT NAME  (A0) = REQ TBL POINTER
          SB6    B6+B1
          SA1    X1+B6
          RJ     /MISC/EPNCK CHECK FORMAT OF NAME 
          PL     X6,OMIT2    IF OK
          BX7    X1          (X7) = BAD NAME
          ERROR  4240,X7     ---- FORMAT ERROR ON OMIT REQUEST
          EQ     OMIT1       IGNORE THIS NAME 
  
 OMIT2    BSS    0
          SX2    B1          (X1) = NAME
          LX2    58          (X2) = UNSAT BIT 
          RJ     ELT         PUT IN *TLNK* IF NOT THERE 
          SA1    TLNK        GET DEFINITION WORD
          SB2    X1 
          SA5    X6+B2
          SX2    B1          SET *OMIT* BIT IN DEFINITION 
          LX2    55 
          BX7    -X2*X5      CLEAR WEAK BIT 
          LX2    2
          BX7    X2+X7       SET OMIT BIT 
          SA7    A5 
          SA5    A5-B1       X5 = NAME *TLNK* ENTRY WORD 1
          BX7    X2          (X7) = OMIT BIT
          SX3    B1 
          LX3    55          (X3) = WEAK BIT
          SA2    A1+B1
          SA1    A5 
          SB3    X6          (B3) = CURRENT INDEX OF DEFINITION 
          SB4    X2          (B4) = LENGTH OF *TLNK*
 OMIT1A   R=     A1,A1+2
          R=     B3,B3+2
          BX1    X1-X5
          GE     B3,B6,OMIT1B      IF END OF TABLE
          SA2    A1+B1
          NZ     X1,OMIT1B   IF NO MORE DUPLICATE ENTRIES 
          BX6    X2+X7
          BX6    -X3*X6      CLEAR WEAK BIT 
          SA6    A2          SET OMIT BIT IN ALL ENTRIES
          EQ     OMIT1A 
  
 OMIT1B   BSS    0
          SA1    TOMIT       X1 = *TOMIT* FWA 
          SB3    X1          B3 = *TOMIT* FWA (USE AS POINTER)
          SA1    A1+B1       X1 = *TOMIT* LENGTH
          SB4    X1+B3       B4 = *TOMIT* LWA+1 (USE AS LIMIT)
 OMIT2A   GE     B3,B4,OMIT2B     IF ENTRY NOT IN *TOMIT* 
          SA1    B3          GET NEXT *TOMIT* NAME
          LX1    -18         ADJUST TO *TLNK* FORMAT
          BX1    X1-X5       COMPARE NAMES
          ZR     X1,OMIT1    IF SAME THEN DO NOT ADD AGAIN TO *TOMIT* 
          SB3    B3+B1       BUMP TO *TOMIT* POINTER
          EQ     OMIT2A      CONTINUE COMPARING 
 OMIT2B   LX5    18          LEFT ADJ NAME
          ADDWRD TOMIT,X5    ADD TO *TOMIT* 
          EQ     OMIT1       GO PROCESS NEXT NAME 
 FILES    TITLE  REQUEST PROCESSOR - FILES. 
**        FILES - PROCESS *FILES* REQUEST.
* 
*              THE FILE NAMED *ZZZZZDF* IS READ AND ENTRY POINT NAMES 
*         ASSOCIATED WITH THE SPECIFIED FILES ARE PLACED INTO A 
*         *USE* REQUEST WHICH IS BUILT IN TABLE *TSCR*.  THE ROUTINE
*         *USE* IS THEN CALLED TO PROCESS A *USE* REQUEST ON THESE
*         NAMES.
  
  
 FILES    PS                 ENTRY/EXIT 
          SETFET L,(=0LZZZZZDF),BINARY   INITIALIZE FET FOR READING FILE
          REWIND X2 
          READ   X2          START READ OF 1ST RECORD  (LFNS) 
          ALLOC  TSCR2,63    EXPECTED MAXIMUM SIZE OF 1ST RECORD
          MX6    0           CLEAR *TSCR2* SO GARBAGE CANNOT BE 
          SA6    X2          INTERPRETED AS A FILE NAME IN CASE 
          IX3    X2+X6       LESS THAN 63 NAMES ARE READ
          SB3    X3 
 FILES1   SA6    A6+B1
          SB2    A6 
          LT     B2,B3,FILES1 
          SA5    A2 
          READW  L,X5,64     BRING NAMES INTO *TSCR2* 
          NZ     X1,FILES2   ERROR IF NO EOR
          ERROR  370         ---- CANNOT PROCESS FILES REQUEST - 1ST
          EQ     ABEND       RECORD OF ZZZZZDF TOO BIG
  
 FILES2   SA1    TSCR2       (X5) = NEXT LFN IN *ZZZZZDF* 
          SA3    A1+B1
          MX7    -1 
          SA5    X1 
          ZR     X3,FILES9   IF AT END OF LIST
          SX6    X1+B1       ADVANCE *TSCR2* FWA
          SA6    A1 
          IX7    X3+X7       REDUCE LENGTH
          SA7    A6+B1
          READ   L           BEGIN READ OF NEXT RECORD
          SA1    A0          SEARCH *FILES* REQUEST FOR THIS LFN
          MX0    -12
          SA2    X1 
          MX7    42 
          LX2    -36         (B3) = LENGTH OF REQUEST 
          BX2    -X0*X2 
          SB2    B1          (B2) = REQUEST POINTER 
          SB3    X2 
 FILES3   GT     B2,B3,FILES8      IF THIS FILE NOT MENTIONED IN REQUEST
          SA4    X1+B2       NEXT LFN IN REQUEST
          BX6    X4-X5       COMPARE
          BX6    X6*X7
          SB2    B2+B1
          NZ     X6,FILES3   IF MISS
          R=     X0,34       POSITION TO WORD 34 OF RECORD
          SX5    B1 
 FILES4   READO  L
          IX0    X0-X5
          NZ     X0,FILES4
          MX0    42 
 FILES5   READO  L           READ NEXT WORD OF RECORD 
          NZ     X1,FILES2   IF EOR 
          BX1    X0*X6
          ZR     X1,FILES5   IF ENTRY NOT PRESENT 
          ADDWRD TSCR,X1     SAVE ENTRY NAME
          EQ     FILES5      LOOP TO END OF RECORD
  
 FILES8   READO  L           SKIP TO END OF THIS RECORD 
          ZR     X1,FILES8
          EQ     FILES2      LOOP THROUGH LFN LIST IN 1ST RECORD
  
 FILES9   SA1    TSCR        INSERT REQUEST HEADER IN FRONT OF
          SA5    A1+B1       *TSCR* 
          ALLOC  A1,1,FRONT 
          LX5    36 
          BX7    X5          STORE HEADER WORD
          SA7    X2 
          MX0    -12         SET UP REGISTERS AS ALL REQUEST
          SA5    A7          PROCESSORS EXPECT
          SA0    A2          REQUEST TABLE POINTER = *TSCR* 
          RJ     USE         GO PROCESS *USE* REQUEST 
          SA2    TSCR        EMPTY *TSCR* 
          RJ     CTAB=
          EQ     FILES       EXIT 
 COMMON   TITLE  REQUEST PROCESSOR - COMMON.
**        COMMON - PROCESS *COMMON* REQUEST.
* 
*             EACH SPECIFIED LABELED COMMON BLOCK NAME WILL BE ADDED
*         TO TABLE *TCOM* BY ROUTINE /LOADS/ECD.  IF NO NAMES ARE 
*         SPECIFIED, THE FLAG *ALLCOM* IS SET NONZERO.
  
  
 IC       IFCARD
 COMMON4  SX6    B1 
          SA6    ALLCOM      INDICATE ALL COMMON BLOCKS AFFECTED
 IC       ENDIF 
  
 COMMON   PS     0           ENTRY/EXIT 
 IC       IFCARD
          SA1    SEGFLAG
          PL     X1,COMMON   IF NOT PASS ONE OF SEGMENT LOAD
          LX5    -36         POSITION WORD COUNT
          BX0    -X0*X5 
          ZR     X0,COMMON4  IF NO NAMES SPECIFIED
          SB7    X0          (B7) = NUMBER OF WORDS IN REQUEST
          SB6    B1 
 COMMON1  SA4    A0 
          SA5    X4+B6       GET NAME FROM REQUEST
          SB6    B6+B1
          BX1    X5 
          RJ     /MISC/EPNCK
          PL     X6,COMMON2  IF VALID NAME
          BX7    X1 
          ERROR  4242,X7     ---- FORMAT ERROR ON COMMON REQUEST
          EQ     COMMON3     IGNORE INVALID NAME
  
 COMMON2  RJ     /LOADS/ECD  ENTER COMMON DEFINITION
 COMMON3  LE     B6,B7,COMMON1  IF MORE NAMES TO PROCESS
 IC       ENDIF 
          EQ     COMMON      RETURN 
 STAT     TITLE  REQUEST PROCESSOR - STAT.
**        STAT - PROCESS *STAT* REQUEST.
* 
*              THE FILE NAMED *ZZZZZDG* IS READ AND ENTRY POINT NAMES 
*         ASSOCIATED WITH THE SPECIFIED FILES ARE PLACED INTO A 
*         *USE* REQUEST WHICH IS BUILT IN TABLE *TSCR*.  THE ROUTINE
*         *USE* IS THEN CALLED TO PROCESS A *USE* REQUEST ON THESE
*         NAMES.
  
 STAT     PS                 ENTRY/EXIT 
          SX6    A0 
          SA6    STATA0      SAVE (A0) = REQUEST TABLE POINTER
          SETFET L,(=0LZZZZZDG),BINARY  INITIALIZE FET FOR READING FILE 
          REWIND L
 STAT0    READ   L           START READ OF LFN RECORD 
          ALLOC  TSCR2,63    EXPECTED MAXIMUM SIZE OF LFN RECORD
          IX3    X2+X6
          SB3    X3          (B3) = LWA+1 *TSCR2* 
          MX6    0           CLEAR *TSCR2*
          SA6    X2          (A6) = FWA *TSCR2* 
 STAT1    SA6    A6+B1
          SB2    A6 
          LT     B2,B3,STAT1
          SA5    A2 
          READW  L,X5,64     READ LFN NAMES INTO *TSCR2*
          MI     X1,STAT     IF EOF THEN EXIT 
          NZ     X1,STAT2    IF EOR 
          ERROR  371         ---- CANNOT PROCESS STAT REQUEST 
          EQ     ABEND
  
 STAT2    SA1    TSCR2
          SA3    A1+B1
          MX7    -1 
          SA5    X1          (X5) = NEXT LFN IN *ZZZZZDG* 
          ZR     X3,STAT9    IF AT END OF LIST
          SX6    X1+B1       ADVANCE *TSCR2* FWA
          SA6    A1 
          IX7    X3+X7       REDUCE LENGTH
          SA7    A6+B1
          READ   L           BEGIN READ OF NEXT RECORD
          SA1    A0          SEARCH *STAT* REQUEST FOR THIS LFN 
          MX0    -12
          SA2    X1 
          MX7    42 
          LX2    -36
          BX2    -X0*X2 
          SB2    B1          (B2) = REQUEST POINTER 
          SB3    X2          (B3) = LENGTH OF REQUEST 
 STAT3    GT     B2,B3,STAT8  IF THIS FILE NOT MENTIONED
          SA4    X1+B2       NEXT LFN IN REQUEST
          BX6    X4-X5       COMPARE
          BX6    X6*X7
          SB2    B2+B1
          NZ     X6,STAT3    IF MISS
          READO  L           READ FIRST WORD OF RECORD
          BX0    X6          (X0) = INDEX TO FIRST EXTERNAL NAME
          SX5    B1 
          IX0    X0-X5       (X0) = WORDS TO SKIP 
 STAT4    READO  L           READ AND DISCARD HEADER WORDS
          IX0    X0-X5
          NZ     X0,STAT4    IF MORE TO DISCARD 
          MX0    42 
 STAT5    READO  L           READ ENTRY NAME
          NZ     X1,STAT2    IF EOR 
          BX1    X0*X6
          ZR     X1,STAT5    IF ENTRY NOT PRESENT 
          ADDWRD TSCR,X1     SAVE ENTRY NAME
          EQ     STAT5       LOOP TO END OF RECORD
  
 STAT8    READO  L           SKIP TO END OF THIS RECORD 
          ZR     X1,STAT8    IF NOT EOR 
          EQ     STAT2       LOOP THRU LFN LIST IN 1ST RECORD 
  
 STAT9    SA1    TSCR        INSERT REQUEST HEADER INTO *TSCR*
          SA5    A1+B1
          ALLOC  A1,1,FRONT 
          LX5    36 
          BX7    X5 
          SA7    X2          STORE HEADER WORD
          MX0    -12         SET UP REGISTERS AS ALL REQUEST
          SA5    A7          PROCESSORS EXPECT
          SA0    A2          REQUEST TABLE POINTER = *TSCR* 
          RJ     USE         GO PROCESS *USE* REQUEST 
          SA2    TSCR 
          RJ     CTAB=       CLEAR *TSCR* 
          SA2    TSCR2
          RJ     CTAB=       CLEAR *TSCR2*
          SA1    STATA0 
          SA0    X1          RESTORE (A0) = REQUEST TABLE POINTER 
          EQ     STAT0       CONTINUE WITH NEXT LFN RECORD
  
 STATA0   BSS    1           SAVE AREA
  
 IU       IFUSER
 PASSLOC  TITLE  REQUEST PROCESSOR - PASSLOC. 
**        PASSLOC - PROCESS PASSLOC REQUEST.
* 
*              THE PASSLOC ROUTINE UPDATES MANAGE TABLES *TLNK* 
*         AND/OR *TBLK* ACCORDING TO THE ARGUMENTS SPECIFIED
*         IN THE REQUEST. 
  
  
 PASSLOC  PS                 ENTRY/EXIT 
          LX5    24 
          MX2    -12
          SX7    B1          SAVE INDEX OF NEXT ENTRY                    LDR0173
          BX6    -X2*X5 
          SA6    T1 
          SA7    T2 
 PAS1     SA1    T1 
          ZR     X1,PASSLOC  IF NO MORE REQUESTS
          R=     X6,X1-2
          SA6    A1 
          SA1    A0          FWA OF REQUEST TABLE                        LDR0173
          SA5    T2 
          R=     X6,X5+2                                                 LDR0173
          IX5    X1+X5                                                   LDR0173
          SA5    X5          NEXT ENTRY IN REQUEST                       LDR0173
          SA6    T2 
          SB2    X5          REQUEST TYPE 
          MX0    42 
          BX1    X0*X5       ISOLATE NAME 
          SA5    A5+B1       NEXT WORD OF REQUEST 
  
*         ISOLATE REQUEST TYPE. 
  
*         TYPE = 0    (ENTRY) 
*         TYPE = 1    (PROGRAM BLOCK) 
*         TYPE = 2,3  (COMMON BLOCKS) 
  
          ZR     B2,PAS2     IF ENTRY 
          EQ     B2,B1,PAS3  IF PROGRAM BLOCK 
          EQ     PAS4        IF COMMON BLOCK
  
  
*         PROCESS ENTRY REQUEST.
  
 PAS2     BX2    -X0*X5      ADDRESS
          RJ     ELT         ENTER ENTRY IN *TLNK*
          EQ     PAS1 
  
*         PROCESS PROGRAM BLOCK REQUEST.
  
 PAS3     SA2    PC 
          SX7    X2+B1
          BX6    X1 
          SA6    PN          SAVE PROGRAM NAME
          SA7    A2 
          SX7    B0          FLAG PROGRAM BLOCK 
          NZ     X2,PAS5     IF NOT FIRST PROGRAM 
          SA6    ON 
          EQ     PAS5 
  
*         PROCESS COMMON BLOCK REQUEST. 
  
 PAS4     SB2    B2-B1
          SX7    B2          FLAG COMMON BLOCK
          EQ     B2,B1,PAS5  IF CM BLOCK
          SX7    X7+B1       X7=3 FOR ECS //
          SB2    B2-B1       B2=1 IF CALL IS VALID
          NE     B2,B1,PAS11 IF NOT ECS BLOCK 
 PAS5     NZ     X1,PAS9     IF NOT BLANK NAME
          ZR     X7,PAS11    IF BLANK PROGRAM NAME
          R=     X7,X7-1     // CM OR ECS 
          SA1    TBLK 
          MX3    -24
          AX5    24 
          BX5    -X3*X5 
          ZR     X7,PAS6     IF // CM 
          SX7    B1 
          R=     B2,3        INDEX=3 FOR // ECS 
          MX2    -3 
          IX5    X5-X2       ROUND UP TO *10B 
          AX5    3
          LX5    3
 PAS6     SA2    X1+B2       *TBLK* DEFINITION
          LX2    -24         PREVIOUS // LENGTH 
          BX4    -X3*X2 
          IX1    X4-X5       (OLD)-(NEW)
          LX5    24 
          LX2    24 
          MX6    0
          BX3    X7          CM=0, ECS=1
          SA4    X3+/READ/BCOM     FIRST DEF. FLAG
          PL     X2,PAS8     IF // EXISTED BEFORE 
          SA6    A4          SET // DEFINED FLAG
 PAS7     MX4    -24
          SA1    A5 
          BX1    -X4*X1      ADDRESS
          BX7    X1+X5       *TBLK* ENTRY 
          SA7    A2 
          EQ     PAS10
  
 PAS8     PL     X1,PAS10    IF PREVIOUS LENGTH GREATER 
          ZR     X4,PAS7     IF FIRST DEFINED THIS LOAD 
          BX7    X3 
          SA1    X3+/READ/BCERRF
          MX6    0
          ZR     X1,PAS1     IF ERROR ALREADY ISSUED
          SA6    A1 
          ERROR  4105,X7     // TRUNCATED 
          EQ     PAS1 
  
 PAS9     BX1    X1+X7       INPUT TO EBD 
          SA2    PA 
          LX6    X2 
          SA6    PASPA
          IFTEST NE,IP.MECS,0,1 
          SA2    ECSPA       SAVE ECS PA
          BX6    X2 
          SA6    PASECS 
          SA2    FI 
          SX6    X2+B1       UPDATE FILE INDEX
          SA6    A2 
          BX2    X5          SAVE REQUEST INFORMATION 
          LX5    -24
          MX0    -24
          BX2    -X0*X2      BLOCK ADDRESS
          BX0    -X0*X5 
          R=     X7,X7-2
          NG     X7,PAS9A    IF CM BLOCK
          MX4    -3 
          IX0    X0-X4
          AX0    3
          LX0    3
 PAS9A    LX6    24          FILE INDEX 
          BX5    X0+X6
          BX7    X2 
          SA7    PA          BLOCK ADDRESS
          IFTEST NE,IP.MECS,0,1 
          SA7    ECSPA       ECS BLOCK ADDRESS
          RJ     EBD         ENTER BLOCK
          SA2    PASPA
          SA4    PASECS 
          BX6    X2          RESTORE INITIAL PA 
          LX7    X4 
          SA6    PA 
          IFTEST NE,IP.MECS,0,1 
          SA7    ECSPA       RESTORE INITIAL ECSPA
  
 PAS10    SA1    =7L*PASSL* 
          ADDWRD TLFN,X1
          EQ     PAS1 
  
 PAS11    ERROR  4241        FORMAT ERROR ON PASSLOC REQUEST
          EQ     PASSLOC
  
  
 PASPA    DATA   0           STORAGE FOR PA 
 PASECS   DATA   0           STORAGE FOR ECSPA
  
  
 IU       ENDIF 
 DMP      TITLE  REQUEST PROCESSOR - DMP. 
 DB       IFTEST NE,IP.LDBG,0 
**        DMP - PROCESS *DMP* REQUEST.
* 
*              THE *DMP* REQUEST INVOLVES ISSUING A CALL TO THE PP
*         PROGRAM *DMP* WITH AUTO-RECALL AND THE ARGUMENTS SPECIFIED
*         IN THE REQUEST IF USING THE DEBUG VERSION OF THE LOADER,
*         OTHERWISE ISSUE THE DAYFILE MESSAGE *SECURE MEMORY, DUMP
*         DISABLED*.
  
  
 DMP      PS                 ENTRY/EXIT 
          SMSG   (=C/  CALLING DMP/)
          BX6    X5 
          AX6    18 
          DMP    X6,X5       CALL DMP 
          EQ     DMP         DONE 
 DB       ELSE
 IU       IFUSER
 DMP      PS     0           ENTRY/EXIT 
          MESSAGE  (=C*  SECURE MEMORY, DUMP DISABLED. *),RECALL
          EQ     DMP
 IU       ENDIF 
 DB       ENDIF 
  
 ENTRY    IFUSER
 ENTRY    TITLE  REQUEST PROCESSOR - ENTRY. 
**        ENTRY - PROCESS *ENTRY* REQUEST.
* 
*              FOR EACH ENTRY POINT NAME SPECIFIED IN THE REQUEST,
*         THE ADDRESS OF THE ENTRY IS DETERMINED AND PLACED IN THE
*         WORD WHICH CONTAINED THE ENTRY POINT NAME.  FOR ANY ENTRY 
*         WHICH DOES NOT EXIST, THE NAME IS LEFT INTACT, AND THE
*         LOWER 18 BITS ARE ZERO. 
*              IF THIS USER CALL IS SUCH THAT THE LOADABLE AREA OVER- 
*         WRITES THE USER CALL PARAMETER AREA, THE *ENTRY* REQUEST
*         CANNOT BE PROCESSED.
  
  
 ENTRY    PS                 ENTRY/EXIT 
          LX5    -36         (B7) = NO. OF ENTRIES IN REQUEST 
          BX5    -X0*X5      (A5) = REQUEST ENTRY POINTER 
          SA1    NOREQ
          SB7    X5 
          SB6    A5          (B6) = POINTER TO FIRST ENTRY
          ZR     X1,ENTRY1   IF PARAMETER AREA STILL INTACT 
          ERROR  211         ---- CANNOT PROCESS ENTRY REQUEST - PARAM
          EQ     ABEND       AREA OVERWRITTEN 
  
 ENTRY1   ZR     B7,ENTRY    IF NO MORE ENTRIES 
          SA5    A5+B1       (X5) = NEXT ENTRY NAME 
          SB7    B7-B1
          BX1    X5 
          MX2    0           SEARCH *TLNK*
          RJ     ELT
          MX0    0           SET TO CLEAR NAME
          ZR     X2,ENTRY2   IF NOT IN *TLNK* 
          LX3    X2,B1       UNSATISFIED BIT
          MX1    -24         ISOLATE ADDRESS FROM WORD 2 OF *TLNK*
          BX2    -X1*X2      ENTRY
          MI     X3,ENTRY2   IF UNSATISFIED                              LDR0206
          LX3    1           POSITION OMIT BIT                           LDR0206
          PL     X3,ENTRY3   IF NOT OMITTED                              LDR0206
 ENTRY2   MX0    42          SET TO KEEP NAME 
          SX2    B0          ADDRESS = 0, IF UNDEFINED
 ENTRY3   BX5    X0*X5       PLACE ADDRESS IN REQUEST 
          BX7    X2+X5
          SB2    A5-B6       (B2) = POINTER INTO *ENTRY* REQUEST
          SA1    CALLADR     (X3) = FWA OF THE *ENTRY* REQUEST
          SA2    UCPOINT
          IX3    X1+X2
          SA7    X3+B2       STORE ENTRY ADR IN ACTUAL USER CALL
          EQ     ENTRY1      GET NEXT REQUEST ENTRY 
  
 ENTRY    ENDIF 
 RDR      TITLE  LOAD INPUT - CONTROL ROUTINE.
          QUAL   READ 
  
**        ++++++++++++++++++++++++++
*         + LOAD INPUT PROCESSORS. +
*         ++++++++++++++++++++++++++
* 
* 
*              THIS IS THE BEGINNING OF THE CODE WHICH PROCESSES THE
*         LOADER INPUT WHILE IT IS BEING READ.  THE LOAD INPUT CONSISTS 
*         ENTIRELY OF LOADER BINARY TABLES AND/OR DIRECTIVES IN CARD
*         IMAGE FORMAT.  EACH BINARY TABLE BEGINS WITH A HEADER WORD
*         CONTAINING A CODE NUMBER IN THE UPPER 6 BITS.  FOR MOST 
*         TABLES, THE FORMAT OF THIS FIRST WORD IS:                            .
* 
*         VFD    6/CODE,6/0,12/WC,36/N
* 
*         CODE = TABLE IDENTIFICATION NUMBER (33B@CODE@77B).
*         WC   = WORD COUNT OF TABLE, NOT COUNTING CONTROL WORD.
*         N    = USED FOR SPECIAL PURPOSES WITH SOME TABLES.
* 
*              A TABLE IN WHICH THE FIRST SIX BITS IS LESS THAN 33B IS, 
*         IN FACT, ASSUMED TO BE NOT A TABLE, BUT THE BEGINNING OF A
*         DIRECTIVE.
* 
* 
*         + + + + + + + + + + + + + + + + 
*         + LOAD INPUT CONTROL ROUTINE. + 
*         + + + + + + + + + + + + + + + + 
* 
* 
*         RDR - READ RECORD.
* 
*              THIS ROUTINE EXAMINES THE FIRST WORD OF EACH LOADER TABLE
*         AND BRANCHES TO THE APPROPRIATE PROCESSOR.
* 
*              *RDR* IS CALLED FROM THE VARIOUS REQUEST PROCESSORS AND
*         ALSO THE LIBRARY LOADING ROUTINE, *LLP*.
* 
*         ENTRY   THE READ OF THE LOAD FILE HAS BEEN INITIATED. 
*                (X5) AND (*T1*) = FIRST CONTROL WORD.
*         EXIT   (X1) = > 0 IF EOR STATUS.
*                       < 0 IF EOF STATUS.
*         CALLS  ALL LOAD INPUT PROCESSORS. 
  
  
 RDR1     READO  L           READ NEXT CONTROL WORD 
          BX5    X6 
          SA6    T1 
          ZR     X1,RDR2     IF NOT EOR 
  
 RDR      PS                 ENTRY/EXIT 
          IFCARD 2
          SA1    SEGFLAG
          NG     X1,/LOADS/FPP     READ BINARIES FOR FIRST PASS 
 RDR2     BX4    X5          TABLE HEADER WORD
          MX0    -6          (X6) = TABLE CONTROL NUMBER
          SA2    LT          ADVANCE LAST TABLE NUMBER READ 
          LX4    6
          BX2    -X0*X2 
          BX6    -X0*X4 
          LX4    18          (B7) = TABLE WORD COUNT
          SA1    RDRB        TABLE CODE MASK
          LX2    30 
          IX7    X2+X6
          MX3    -18
          R=     B2,X6-33B
          SA7    A2 
          BX4    -X3*X4 
          NG     B2,CKD      IF UNIDENTIFIED CODE 
          AX1    X1,B2
          SB7    X4 
          CX3    X1          (X3) = JUMP INDEX
          AX4    12          BITS 48-53 
          LX1    59 
          NZ     X4,CKD      IF BITS 48-53 NZ,  WC IS TOO BIG 
          SX3    X3+B1
          PL     X1,CKD      IF UNIDENTIFIED CODE 
          LX3    -1          BIT 59 = UPPER/LOWER JUMP FLAG 
          SB3    X3 
          JP     TRDR-1+B3   JUMP TO TABLE
  
 RDRB     CON    1004016677776B  MASK FOR LEGAL TABLE CODES 
  
  
**
* 
*              THE FOLLOWING IS A JUMP TABLE TO EACH OF THE BINARY TABLE
*         PROCESSORS.  THE INDEX IS COMPUTED BY THE PRECEDING CODE
*         SEQUENCE, AND EACH WORD IN THE TABLE CONTAINS JUMPS TO TWO
*         OF THE PROCESSORS.  THE TABLE ENTRIES MUST APPEAR IN
*         DESCENDING ORDER OF BINARY TABLE NUMBER, AND, HENCE, THE
*         INSERTION OR DELETION OF TABLE TYPES PROBABLY REQUIRES THE
*         REMOVAL AND RE-INSERTION OF THE ENTIRE TABLE TO KEEP IT IN
*         THE CORRECT ORDER.
* 
*         EXIT   (X5) = TABLE HEADER WORD.
*                *T1* = TABLE HEADER WORD.
*                (B7) = WORD COUNT OF TABLE.
  
****
  
 TRDR     BSS    0
          LOC    0
  
          PL     X3,PRFX     77 = PRFX
          ZR     B0,LDSET    70 = LDSET 
  
          PL     X3,CAP      60 = CAPSULE 
          ZR     B0,LIN      57 = LINE NUMBER 
  
          PL     X3,SYM      56 = SYMBOL
          ZR     B0,OVL54    54 = ABS OVERLAY 
  
          PL     X3,OVL53    53 = ACPM
          ZR     B0,OVL51    51 = EASCM 
  
          PL     X3,OVL50    50 = ASCM
          ZR     B0,XREPL    47 = XREPL 
  
          PL     X3,XFER     46 = XFER
          ZR     B0,XLINK    45 = XLINK 
  
          PL     X3,LINK     44 = LINK
          ZR     B0,REPL     43 = REPL
  
          PL     X3,FILL     42 = FILL
          ZR     B0,XFILL    41 = XFILL 
  
          PL     X3,TEXT     40 = TEXT
          ZR     B0,XTEXT    37 = XTEXT 
  
          PL     X3,ENTR     36 = ENTR
          ZR     B0,PTEXT    35 = PTEXT 
  
          PL     X3,PIDL     34 = PIDL
          ZR     B0,CKD      UNIDENTIFIED 
  
          LOC    *O 
  
****
 CKD      TITLE  LOAD INPUT - DIRECTIVE.
**        + + + + + + + + + + + + + 
*         + DIRECTIVE PROCESSORS. + 
*         + + + + + + + + + + + + + 
* 
* 
*              THIS ROUTINE IS CALLED WHENEVER A TABLE HEADER WORD
*         DOES NOT RESEMBLE ANY OF THE POSSIBLE TABLES.  THIS IS IF 
*         EITHER THE IDENTIFICATION NUMBER DOES NOT MATCH ANY OF THE
*         TABLES, OR IF THE WORD COUNT IS GREATER THAN 7777B. 
*         IF AN *SLOAD* IS IN PROGRESS, THE INPUT FILE IS ADVANCED
*         TO THE BEGINNING OF THE NEXT RECORD.
* 
* 
  
 CKD      BSS    0
 IU       IFUSER
          SA1    LSL
          ZR     X1,CKD0.2   IF NOT *SLOAD* 
 IU       ENDIF 
 IC       IFCARD
          SA1    CURREQBP    CURRENT REQUEST NUMBER 
          R=     X1,X1-CSLOAD 
          NZ     X1,CKD0.2   IF NOT *SLOAD* 
 IC       ENDIF 
  
 CKD0.1   READO  L           SKIP RECORD IF SLOAD 
          ZR     X1,CKD0.1   IF NOT *EOR* 
          EQ     RDR         EXIT 
  
 CKD0.2   BSS    0
  
  
**        AT THIS POINT WE CAN BE PROCESSING A PROCEDURE. 
* 
*         A PROCEDURE CONSISTS OF A SET OF CYBER
*         CONTROL LANGUAGE (CCL) STATEMENTS GENERATED ON A
*         LOCAL FILE BY THE USER ACCORDING TO CCL SYNTAX. 
*         THE CCL PROCEDURE HEADER STATEMENT *.PROC,PNAME*
*         DEFINES THE PROCEDURE.  THE LOADER RECOGNIZES 
*         THE PROCEDURE HEADER AND WILL CALL
*         THE CCL BEGIN ROUTINE TO ACTUALLY PROCESS THE 
*         PROCEDURE.  THE REMAINDER OF THE PROCEDURE IS 
*         IGNORED BY THE LOADER.
* 
*         PROCEDURE HEADER: 
* 
*         DIS    ,*.PROC,PNAME,...* 
* 
*         *.PROC* DEFINES THE PROCEDURE.
* 
*         PNAME  = PROCEDURE NAME (IGNORED BY LOADER).
* 
* 
*              PROCESSING IS AS FOLLOWS:  
* 
*         1)   THE PROCEDURE HEADER *.PROC* IS VERIFIED.
  
 DIR      SA1    PROCHDR
          MX3    30 
          BX7    X3*X5
          BX7    X7-X1
          NZ     X7,DIR1     IF NOT A PROCEDURE 
  
**        2)   COMPLIANCE TO RULES FOR CALLING A PROCEDURE
*              IS VERIFIED. 
* 
*              A)   PROCEDURE CALL IS LEGAL FOR CONTROL-
*                   CARD-INITIATED LOADS ONLY.
*              B)   PROCEDURE CALL MUST BE A SINGLE CARD LOAD 
*                   SEQUENCE. 
*              C)   NOTHING ELSE HAS BEEN LOADED. 
  
 IU       IFUSER
          ERROR  341         ----PROCEDURE DISALLOWED IN
          EQ     ABEND           USER-CALL LOAD 
 IU       ENDIF 
  
 IC       IFCARD
 PROC1    SA3    CARDCT 
          NZ     X3,PRERR1   IF NOT A SINGLE CARD LOAD SEQUENCE 
          SA2    PC 
          NZ     X2,PRERR2   IF SOMETHING ALREADY LOADED
  
**        3)   BEFORE CALLING THE CCL BEGIN ROUTINE, THE LOADER 
*              WILL PERFORM THE FOLLOWING ACTIVITIES. 
* 
*              A)   DO NOT DISABLE SSJ= PRIVILEGES (NOS). 
*              B)   TURN OFF *SPY*. 
*              C)   ISSUE STATISTICS MESSAGES TO DAYFILE. 
*              D)   RETURN SYSTEM FILES.
*              E)   RELEASE THE *EDITLIB INTERLOCK*.
  
 DSSJ     IFNOS 
          SX6    B1 
          SA6    NODISSJ     FLAG THAT *SSJ=* NOT TO BE DISABLED
 DSSJ     ENDIF 
          RJ     SPYOFF      TURN OFF *SPY* 
          RJ     ISD         ISSUE STATISTICS TO DAYFILE
          RJ     RSF         RETURN SYSTEM FILES
          RJ     /SLD/RLI    RELEASE LIBRARY INTERLOCK
          RECALL L           WAIT ON LOAD FILE ACTIVITY 
  
**        4)   CALL THE CCL BEGIN ROUTINE TO PROCESS THE
*              PROCEDURE.  LOAD THE OVERLAY *CCLBRWE* FROM THE SYSTEM 
*              LIBRARY (NUCLEUS UNDER NOS/BE OR THE CLD UNDER NOS). 
  
          SMSG   (=C/ LOADING CCL BEGIN ROUTINE/) 
          SA3    BEGCALL
          SA1    FL 
          SA2    ECSFL
          BX6    X3 
          SA0    X1          (A0) = CM FIELD LENGTH 
          BX0    X2          (X0) = ECS FIELD LENGTH
          RJ     SYS=        CALL CCL AT ENTRY POINT *BEGIN*
+         EQ     *
  
 BEGCALL  VFD    18/0LLDV,24/0,18/BEGPAR
 BEGPAR   VFD    42/0LNUCLEUS,18/0
          VFD    12/0,2/2,3/0,1/1,1/1,4/0,1/1,18/0,18/RA.ORG
          VFD    42/0LCCLBRWE,18/0
          VFD    42/0LBEGIN,18/0
  
 PRERR1   BSS    0
          SX7    B1          SET FOR NO DAYFILE MESSAGE OF COMMAND
          SA7    DFMFLAG
          ERROR  342         ---- PROCEDURE CALL MUST BE SINGLE 
          EQ     ABEND           CARD LOAD SEQUENCE 
  
 PRERR2   ERROR  343         ---- PROCEDURE DISALLOWED IN RELOCATABLE 
          EQ     ABEND       LOAD 
 IC       ENDIF 
  
 PROCHDR  VFD    30/0H.PROC,30/0
**        AT THIS POINT WE ARE PROCESSING A DIRECTIVE.  IN ORDER TO 
*         BE A VALID DIRECTIVE, THE FIRST CHARACTER MUST BE ALPHABETIC
*         AND THE TOTAL NUMBER  OF CHARACTERS MUST NOT EXCEED 80. 
*         IN ORDER TO PROCESS A DIRECTIVE THE FOLLOWING IS DONE 
* 
  
 DIR1     BX7    X5          SAVE FIRST WORD OF DIRECTIVE 
          SA7    CDIMAGE
  
 IC       IFCARD
          SA1    ABS
          ZR     X1,CKD1     IF NOT ABSOLUTE LOAD 
          ERROR  300,X7      ---- DIRECTIVE OR UNRECOGNIZABLE INPUT 
          EQ     ABEND       IN ABS LOAD -
  
 IC       ENDIF 
  
**        1)   A FLAG IS SET TO TELL THE REQUEST PROCESSOR MAIN ROUTINE 
*              THAT THE UPCOMING REQUESTS CAME FROM A DIRECTIVE.  THIS
*              IS NEEDED, SINCE SOME REQUESTS ARE NOT ALLOWED TO APPEAR 
*              WITHIN A DIRECTIVE, AND IN THIS MANNER, ANY SUCH ERRORS
*              CAN BE DETECTED AT THE SAME PLACE. 
* 
  
 CKD1     SA1    REQTYPE     SET REQUEST TYPE TO SHOW DIRECTIVES
          LD     X7,10B      ARE BEING PROCESSED
          BX6    X1          ALSO SAVE THE MAIN TYPE BEING
          SA7    A1          PROCESSED
          SA6    PREVTYPE 
  
**        2)   THE CARD IMAGE SCANNING ROUTINES MAY OR MAY NOT BE IN
*              CORE AT THIS TIME, DEPENDING ON CORE REQUIREMENTS FOR
*              THE LOAD UP TO NOW.  IF NOT IN, THE OVERLAY *LOADC* OF 
*              *LOADER*, OR *LOADUC* OF *LOADU* MUST BE CALLED AT THIS
*              TIME.  THIS CODE IS COPIED IN *LOADER* AND *LOADU*, BUT
*              THE CAPABILITY EXISTS TO OVERLAY IT, IF ADDITIONAL CORE
*              IS NEEDED.  (SEE DESCRIPTION OF SYMBOL *MM* IN THE 
*              LISTING.)
* 
  
          SA1    MM 
          IFCARD 1
          SX3    /LOADC/BREAK  NEW FWA OF BUFFERS 
          IFUSER 1
          R=     X3,LOADCCE  NEW FWA OF BUFFERS 
          SX6    B1          FLAG *LOADC* AS IN AND NEEDED
          SA6    A1 
          PL     X1,CKD2     IF *LOADC* IS ALREADY IN 
          RJ     MTO=        ADVANCE TABLE ORIGIN FOR *LOADC* 
          IFCARD 1
          OVERLAY  LOADC,1,1,LOCC,/LOADC/BREAK
          IFUSER 2
          OVERLAY LOADUC,4,1,LOCC,LOADCCE                                LDR0223
          RJ     /RRLOADUC/REL-1   RELOCATE OVERLAY 
  
**        3)   UP TO NOW, ONLY THE FIRST WORD OF THE DIRECTIVE HAS BEEN 
*              READ.  NOW THE REMAINING WORDS (TO A ZERO BYTE 
*              TERMINATOR) ARE READ.
* 
  
 CKD2     SA2    T1          STORE FIRST WORD OF DIRECTIVE
          BX6    X2 
          SA6    CDIMAGE
          MX1    0           INDICATE NO EOR
          SB6    A6+B1       SET FWA OF REMAINDER OF READ 
          RJ     /LOADC/READCI     READ DIRECTIVE THRU ZERO-BYTE TERM 
  
**        4)   THE SUBROUTINE *CARD* OF THE CARD IMAGE SCANNING ROUTINES
*              IS CALLED TO BUILD AN INTERNAL LOADER REQUEST IN TABLE 
*              *TREQ2*. 
* 
  
          SA0    TREQ2       USE SECONDARY REQUEST TABLE
          SX6    CDIMAGE     (X6) = FWA OF CARD IMAGE 
          RJ     /LOADC/CARD GO BUILD INTERNAL REQUEST
 IC       IFCARD
          SA2    SEGFLAG
          SA1    OG 
          SX6    B1 
          NZ     X2,CKD3     IF SEGMENT LOAD *LOADC* IN AND NEEDED
          NZ     X1,CKD3     IF OVERLAY/CAPSULE/OVCAP GENERATION
          MX6    0           ELSE FLAG *LOADC* AS IN BUT NOT NEEDED 
 IC       ENDIF 
          IFUSER 1
          MX6    0           FLAG *LOADC* AS IN BUT NOT NEEDED
 CKD3     SA6    MM 
  
**                       ***** N O T E *****
* 
*         4A)  AT THIS POINT, CODE HAS BEEN INSERTED SO AS TO DISALLOW
*              THE PROCESSING OF OBJECT DIRECTIVES.  A NON-FATAL ERROR
*              IS ISSUED, AND THE DIRECTIVE IS IGNORED.  NOTE THAT ANY
*              *OVERLAY* OR *SEGLOAD* DIRECTIVES WILL BE PROCESSED AS 
*              THEY SHOULD BE, SINCE THEY ARE PROCESSED ENTIRELY
*              WITHIN THE ROUTINE *CARD*. 
* 
  
          SA1    DIROK
          NZ     X1,CKD7     IF OBJECT DIRECTIVES HAVE BEEN 
                                    ALLOWED 
          ERROR  4207        ---- OBJECT DIRECTIVES NOT ALLOWED 
          SA5    CDIMAGE     PLACE ENTIRE IMAGE IN *TERR* 
          MX0    -12
 CKD6A    ADDWRD A2,X5       INSERT WORD
          BX2    -X0*X5 
          SA5    A5+B1
          NZ     X2,CKD6A    IF MORE
          MX6    0           EMPTY *TREQ2*
          SA6    TREQ2+1
  
**        5)   THE REQUEST PROCESSOR CONTROL ROUTINE *REQD* IS CALLED 
*              TO PROCESS THE REQUEST.
* 
  
 CKD7     RJ     REQD        PROCESS INTERNAL FORM REQUESTS 
  
**        6)   THE FLAG INDICATING THE SOURCE OF THE REQUESTS BEING 
*              PROCESSED IS RESET TO WHAT IT WAS PREVIOUSLY.
  
          SA1    PREVTYPE 
          BX6    X1 
          SA6    REQTYPE
          EQ     RDR1        GO GET NEXT LOADER INPUT 
  
 LINE     DATA   10H               START OF SEGLOAD DIRECTIVE OUTPUT LIN
 CDIMAGE  BSSZ   13          DIRECTIVE HOLD AREA
 LTHIMAGE CON    0           LENGTH OF DIRECTIVE IN *CDIMAGE* 
 DIROK    CON    0           MUST BE SET NZ TO ALLOW OBJECT 
                                    DIRECTIVES.  CODE TO DO THIS IS 
                                     CURRENTLY NOT IN ANYWHERE. 
 LDSET    TITLE  LOAD INPUT - LDSET TABLE.
**        + + + + + + + + + + + + + + + 
*         + BINARY TABLE PROCESSORS.  + 
*         + + + + + + + + + + + + + + + 
* 
* 
*         LDSET TABLE - INTERNAL FORM OBJECT DIRECTIVES.
* 
*         CODE = 70.
* 
* 
*         CYBER LOADER LDSET TABLE PROCESSOR - INTERNAL FORM
*                KRONOS OPLD TABLE WILL BE IGNORED BY THIS ROUTINE AS 
*                ITS WC FIELD IS ZERO AND WE IGNORE ZERO-LENGTH TABLES
* 
* 
*         WORDS 1-WC CONSIST OF ONE OR MORE INTERNAL-FORM LOADER
*         REQUESTS. 
* 
*              PROCESSING IS AS FOLLOWS 
* 
  
 LDSET    BSS    0
 IC       IFCARD
          IFCARD 2
          SA1    SEGFLAG
          NZ     X1,SKT      IF WE HAVE READ THIS IN PASS 1 OF SEG LOAD 
          SA1    ABS
          SA2    =8L70-TABLE INDICATE TYPE OF DIRECTIVE IN ERROR
          BX7    X2 
          ZR     X1,LDSET1   IF NOT AN ABSOLUTE LOAD
          ERROR  300,X7      ---- DIRECTIVE IN ABSOLUTE LOAD
          EQ     ABEND
  
 LDSET1   BSS    0
 IC       ENDIF 
  
          ZR     B7,RDR1     IGNORE ANY ZERO-LENGTH TABLE 
  
**        1)   A FLAG IS SET TO TELL THE REQUEST PROCESSOR MAIN ROUTINE 
*              THAT THE UPCOMING REQUESTS CAME FROM A DIRECTIVE.
* 
  
          SA1    REQTYPE     SET REQUEST TYPE FLAG TO TELL
          R=     X7,10B      REQUEST PROCESSORS THAT DIRECTIVES 
          BX6    X1          ARE BEING PROCESSED
          SA7    A1 
          SA6    PREVTYPE 
  
**        2)   THE REMAINDER OF THE TABLE (ALL EXCEPT THE HEADER WORD)
*              IS READ DIRECTLY INTO TABLE *TREQ2*. 
* 
* 
  
          ALLOC  TREQ2,B7    ALLOCATE ROOM IN *TREQ2* FOR REQUESTS
          SB6    X2          (B6) = TABLE FWA 
          READW  L,B6,B7     READ TABLE 
  
**        3)   THE REMAINDER OF *LDSET* PROCESSING CAN TIE IN TO THE
*              POINT IN THE DIRECTIVE PROCESSOR WHERE *REQD* IS CALLED. 
  
          EQ     CKD7        GO PROCESS REQUESTS AND EXIT 
 PREFIX   TITLE  LOAD INPUT - PRFX TABLE. 
**        PRFX TABLE - PREFIX TABLE.
* 
*         CODE = 77.
* 
*         CYBER LOADER PRFX TABLE PROCESSOR - INTERNAL FORM 
* 
* 
*         WORD 1:                                                              .
* 
*         VFD    42/0LNAME,18/0 
* 
*         NAME = PROGRAM NAME.  IF THIS FIELD IS ZERO, IT IS ASSUMED
*                THAT THE TABLE IS A PADDING TABLE, AND IT IS SKIPPED 
*                OVER UNCONDITIONALLY.
* 
*         WORDS 2-WC CONTAIN DISPLAY-CODED INFORMATION ENDING WITH THE
*         LAST CHARACTER WHICH IS NOT A COLON (DISPLAY CODE VALUE = 0). 
* 
*         2      VFD    60/DATE 
*         3      VFD    60/TIME 
*         4      VFD    36/OSNAME,24/OSVER
*         5      VFD    42/LPNAME,18/LPVER
*         6      VFD    30/LPML,12/TARGET,12/VALID,6/F
*         7      VFD    6/TYPE,54/DEP 
*         10-12  LANGUAGE PROCESSOR INFORMATION 
*         13-16  USER COMMENTS
*         ANY ADDITIONAL WORDS ARE IGNORED AND SKIPPED. 
* 
*                DATE   = VALUE AS RETURNED BY OPERATING SYSTEM *DATE*
*                         REQUEST (LEFT-JUSTIFIED). 
*                TIME   = VALUE AS RETURNED BY OPERATING SYSTEM *CLOCK* 
*                         REQUEST (LEFT-JUSTIFIED). 
*                OSNAME = OPERATING SYSTEM NAME (LEFT-JUSTIFIED, BLANK
*                         FILL).
*                OSVER  = CURRENT VERSION OF THE OPERATING SYSTEM.
*                LPNAME = LANGUAGE PROCESSOR NAME (LEFT-JUSTIFIED, BLANK
*                         FILL).
*                LPVER  = CURRENT VERSION OF THE LANGUAGE PROCESSOR.
*                LPML   = LANGUAGE PROCESSOR MOD LEVEL. 
*                TARGET = 2-CHAR MNEMONIC DESIGNATING PROCESSOR TYPE ON 
*                         WHICH PROGRAM IS OPTIMIZED. 
*                VALID  = 2-CHAR MNEMONIC DESIGNATING PROCESSOR TYPE ON 
*                         WHICH PROGRAM WILL EXECUTE PROPERLY.
*                F      = SPECIAL *COMPASS* FLAG. 
*                TYPE   = A LETTER DESIGNATING TYPE OF PROGRAM (NOT 
*                         CURRENTLY BEING USED BY THE LOADER).
* 
*                         (BLANK)  RELOCATABLE CPU PROGRAM. 
*                         A        ABSOLUTE CPU PROGRAM.
*                         D        DIRECTORY (7000).
*                         L        SINGLE-SECTION PARTITION (7000). 
*                         M        MULTIPLE-SECTION PARTITION (7000). 
*                         P        PPU PROGRAM OR OVERLAY.
*                         S        ABSOLUTE CPU PROGRAM SEGMENT.
*                         T        SYSTEM TEXT. 
* 
*                DEP    = A SEQUENCE OF ZERO TO NINE (9) LETTERS
*                         DESIGNATING OPTIONAL HARDWARE FEATURES
*                         REQUIRED FOR THE PROGRAM.  THE LOADER CHECKS
*                         FOR THE PRESENCE OF THE FOLLOWING, IF 
*                         SPECIFIED.
* 
*                         C        CMU INSTRUCTIONS.
*                         I        INTEGER MULTIPLY INSTRUCTION.
*                         X        CENTRAL EXCHANGE JUMP. 
* 
* 
*         ***  *PRFX* TABLE PROCESSING ***
* 
*         1)   IF NOT YET PRESENT, THE FIRST ENTRY FOR *TPRX* IS
*              ALLOCATED.  IF A MAP OF SIZE *B* OR GREATER IS NOT 
*              SELECTED, THIS IS THE LARGEST *TPRX* WILL GROW.  THE 
*              FIRST WORD OF THIS ENTRY IS NOW CLEARED IN ANY CASE, SO
*              THAT THE *PIDL* PROCESSOR CAN TELL IF THE PROGRAM HAS
*              NO *PRFX* TABLE, AS THIS SAME FIELD LATER GETS SET TO
*              NON-ZERO IF A NEW ENTRY IS ADDED TO *TPRX*.
*              WORD 1 OF THE TABLE IS READ AND IF THE NAME FIELD IS 
*              ZERO, THE TABLE IS SKIPPED.
* 
* 
  
 PRFX     SA2    TPRX        CHECK LENGTH OF *TPRX* 
          MX6    0
          SA3    A2+B1
          SX0    B7-B1       (X0) = TABLE WORD COUNT - 1
          NZ     X3,PRX2     IF TABLE ALREADY ESTABLISHED 
          ALLOC  A2,16B      ALLOCATE 16B WORDS FOR ENTRY 0 
          SX4    B1 
          IX3    X6-X4       SET ENTRY 0 TO ALL ZEROES
          MX6    0
          SA6    X2 
 PRX1     IX3    X3-X4
          SA6    A6+B1
          NZ     X3,PRX1
 PRX2     SA6    X2          CLEAR 1ST WORD OF ENTRY
          MI     X0,RDR1     IF WC < 0, IGNORE TABLE
          READO  L           READ PROGRAM NAME
          MX3    42 
          BX6    X3*X6       (X6) = PROGRAM NAME
          SB7    X0          (B7) = REMAINING WORD COUNT
          ZR     X6,SKT      IF NAME FIELD ZERO 
          SA6    PN          SAVE PROGRAM NAME
  
 DB       IFTEST NE,IP.LDBG,0 
          BX1    X6          FORM PART OF MESSAGE 
          LX4    X6 
          RJ     SFN= 
          MX3    42 
          BX6    X3*X6
          SA2    =3R FR 
          BX6    X6+X2
          SA6    MSGL1+1     *PGMNAME FR
          SA1    FI 
          SA2    TLFN 
          IX1    X1+X2
          SA1    X1 
          BX1    X3*X1
          RJ     SFN= 
          MX3    42 
          BX6    X3*X6
          SA2    =3ROM       R= X2,3ROM  WILL NOT ASSEMBLE W/ UC LOADER 
          BX6    X6+X2
          LX6    -18
          SA6    A6+B1                  OM FILNAME* 
          BX6    X4 
 DB       ENDIF 
  
  
**        1.1) IF ENCAPSULATION IS IN PROGRESS AND THE CAPSULE
*              GENERATION OVERLAY IS NOT LOADED, IT IS LOADED AND 
*              ALL NECESSARY INITIALIZATION IS PERFORMED. 
*              IF THE CURRENT CAPSULE HAS NOT BEEN INITIATED, 
*              ALL PROGRAMS READ WILL BE DISCARDED UNTIL THE
*              PROGRAM THAT INITIATES THE CAPSULE HAS BEEN FOUND. 
*              IF THE CURRENT CAPSULE HAS BEEN INITIATED, PROGRAMS
*              ARE LOADED UNTIL THE PROGRAM WHICH INITIATES THE 
*              NEXT CAPSULE HAS BEEN FOUND, AT WHICH TIME THE 
*              CURRENT CAPSULE IS COMPLETED AND THE NEXT ONE IS 
*              SET UP TO BE INITIATED.
*              *** N O T E *** CAPSULE INITIATION/TERMINATION 
*              IS ALLOWED IFF PROCESSING *LOAD* OR *SLOAD* REQUESTS.
*              *LIBLOAD* AND *SATISFY* REQUESTS ARE IGNORED IF
*              THE CURRENT CAPSULE HAS NOT BEEN INITIATED.  IF
*              THE CURRENT CAPSULE HAS BEEN INITIATED THEN *LIBLOAD*
*              AND *SATISFY* REQUESTS ARE PROCESSED BUT NO CAPSULE
*              INITIATION/TERMINATION CHECKS ARE MADE.
  
 IC       IFCARD
          SA1    OG          CHECK FOR ENCAPSULATION
          ZR     X1,PRXCGX   IF NOT ENCAPSULATION 
          PL     X1,PRXCGX   IF NOT ENCAPSULATION 
          SA1    CURCPNAM    (CURCPNAM)=0 IFF *LOADG* NOT IN
          NZ     X1,PRXCG1   IF *LOADG* ALREADY IN AND INITIALIZED
          RECALL L           ELSE MUST LOAD *LOADG* AND INITIALIZE
          SKIPB  L,1,0,RCL   SO AWAIT I/O COMPLETE, BACKSPACE 1 REC 
          SA1    L
          MX7    42 
          BX7    X7*X1
          SA7    CGLFNSV     (CGLFNSV) = FILE NAME
          EQ     LCGO        GO TO LOAD *LOADG* AND INITIALIZE
  
 PRXCG1   SA1    CURREQBP    CHECK FOR *SLOAD* REQUEST
          R=     X1,X1-CSLOAD 
          NZ     X1,PRXCG3   IF NOT *SLOAD* 
          SA4    TREQ        PROCEED TO CHECK *SLOAD* LIST
          MX3    -12
          SA2    X4          (X7) = NUMBER OF PROGRAM NAMES 
          SX1    B1 
          LX2    -36
          SA4    X4+B1       (A4) = FWA-1 OF PROGRAM NAMES
          BX7    -X3*X2 
 PRXCG2   SA4    A4+B1       NEXT NAME IN LIST
          IX7    X7-X1
          BX2    X6-X4       COMPARE PROG NAMES 
          ZR     X2,PRXCG3   IF WANTED BY *SLOAD* THEN FURTHER CHECKS 
          NZ     X7,PRXCG2   LOOP THRU PROGRAM LIST 
          EQ     PRXCGX      CONTINUE NORMAL *PREFIX* TABLE PROCESSING
  
 PRXCG3   SA1    CGFPAF      CHECK IF CAPSULE INITIATED 
          NZ     X1,PRXCG5   IF ALREADY INITIATED 
          SA1    CURCPNAM    ELSE SEE IF THIS PROGRAM INITIATES 
          BX1    X6-X1       COMPARE PROG NAMES 
          ZR     X1,PRXCG4   IF THIS ONE INITIATES THE CAPSULE
          SX5    B7          ELSE SKIP THIS PROGRAM 
          RJ     SKP
          ZR     X1,RDR2     IF NOT AT EOR
          EQ     RDR         EXIT FILE READ IF AT EOR 
  
 PRXCG4   SX7    B1 
          SA7    CGFPAF      SET CAPSULE INITIATED FLAG 
          EQ     PRXCGX      CONTINUE NORMAL *PREFIX* TABLE PROCESSING
  
 PRXCG5   SA1    CURREQBP    ALREADY INITIATED, CHECK FOR TERMINATION 
          R=     X2,X1-CLOAD
          R=     X3,X1-CSLOAD 
          ZR     X2,PRXCG6   IF *LOAD* CHECK FOR TERMINATION
          ZR     X3,PRXCG6   IF *SLOAD* CHECK FOR TERMINATION 
          EQ     PRXCGX      CONTINUE NORMAL *PREFIX* TABLE PROCESSING
  
 PRXCG6   SA1    NEXCPNAM    CHECK FOR TERMINATION OF CAPSULE 
          ZR     X1,PRXCGX   IF NO NEXT CAPSULE DON-T TERMINATE 
          BX1    X6-X1       COMPARE PROG NAMES 
          NZ     X1,PRXCGX   IF NOT TO TERMINATE CURRENT CAPSULE
          RECALL L           ELSE TERMINATE, AWAIT I/O COMPLETE 
          SKIPB  L,1,0,RCL   BACKSPACE 1 REC
          SA1    L
          MX7    42 
          BX7    X7*X1
          SA7    CGLFNSV     (CGLFNSV) = FILE NAME
          EQ     /LOADG/CLCAP  GO COMPLETE THIS CAPSULE 
  
 PRXCGX   BSS    0           CONTINUE NORMAL *PREFIX* TABLE PROCESSING
 IC       ENDIF 
  
**        2)   IF AN *SLOAD* REQUEST IS IN PROGRESS, IT IS CHECKED TO 
*              SEE IF THE NAME IN THE *PRFX* TABLE MATCHES THAT OF ONE
*              OF THE PROGRAMS SPECIFIED IN THE *SLOAD* REQUEST BUT NOT 
*              YET LOADED.  IF NO MATCH OCCURS, THE SUBROUTINE *SKP*
*              IS CALLED TO SKIP OVER LOAD INPUT UP UNTIL THE START OF
*              THE NEXT PROGRAM.  IF A MATCH DOES OCCUR, VARIOUS
*              POINTERS FOR *SLOAD* ARE UPDATED, AND PROCESSING OF THE
*              *PRFX* TABLE CONTINUES NORMALLY. 
* 
  
 IU       IFUSER
          SA3    LSL         LOAD-SLOAD FLAG (VALID FOR *LOADU* ONLY) 
          ZR     X3,PRX6     IF *LOAD* REQUEST
 IU       ENDIF 
 IC       IFCARD
          SA3    CURREQBP    CURRENT REQUEST NUMBER 
          R=     X3,X3-CSLOAD 
          NZ     X3,PRX6     IF NOT *SLOAD* 
 IC       ENDIF 
          SA4    TREQ 
          MX3    -12
          SA2    X4          (X7) = NUMBER OF PROGRAM NAMES 
          SX1    B1 
          LX2    -36
          SA4    X4+B1       (A4) = FWA-1 OF PROGRAM NAMES
          BX7    -X3*X2 
 PRX4     SA4    A4+B1       NEXT NAME IN LIST
          IX7    X7-X1
          BX2    X6-X4
          ZR     X2,PRX5     IF FOUND, LOAD THIS PROGRAM
          NZ     X7,PRX4     LOOP THROUGH PROGRAM LIST
 DB       IFTEST NE,IP.LDBG,0 
          SA1    =10H SKIPPING
          BX6    X1 
          SA6    MSGL1
          SMSG   A6          * SKIPPING YYYYYYY FROM XXXXXXX *
 DB       ENDIF 
          SX5    B7          THIS PROGRAM NOT SPECIFIED TO BE 
          RJ     SKP         LOADED - SKIP IT 
          ZR     X1,RDR2     IF NOT AT EOR
          EQ     RDR         EXIT FILE READ IF AT EOR 
  
 PRX5     SA2    SLNP        DECREMENT COUNT OF PROGRAMS TO LOAD
          IX7    X2-X1
          SA7    A2 
          BX7    X4+X1       FLAG TABLE ENTRY AS FOUND
          SA7    A4 
 PRX6     BSS    0
  
 DB       IFTEST NE,IP.LDBG,0 
          SA1    =10H  LOADING
          BX6    X1 
          SA6    MSGL1
          SMSG   A6          * LOADING YYYYYYY FROM XXXXXXX * 
 DB       ENDIF 
  
  
**        3)   IF IT IS NOT NECESSARY TO SAVE THE *PRFX* TABLE
*              INFORMATION FOR THE MAP, THE TABLE IS SIMPLY READ INTO 
*              WORDS 1-15B OF ENTRY 0 OF *TPRX*.  IT IS FROM THERE THAT 
*              THE HARDWARE DEPENDENCIES FIELD IS EXAMINED BY 
*              SUBSEQUENT CODE. 
* 
  
          SA1    MAPTYPE
          R=     B2,15B      (B2) = MAX. NO. OF WORDS TO PROCESS
          ZR     B7,RDR1     IF NO ADDITIONAL WORDS IN TABLE
          MX6    0           (X6) = NO. WORDS TO SKIP LATER 
          LE     B7,B2,PRX7  IF TABLE NOT EXTRA-LARGE 
          SX6    B7-B2       SET SKIP COUNT FOR LATER 
          SB7    B2          SET TO PROCESS STANDARD MAXIMUM
 PRX7     AX1    1           NZ IF MAP OPTION = *B* OR GREATER
          SA6    T2          SAVE SKIP COUNT
          SA2    TPRX        (B6) = FWA TO READ TO *TPRX* 
          NZ     X1,PRX9     IF TO ADD NEW *TPRX* ENTRY 
          SB6    X2+B1
          SA0    B6+B2       (A0) = MAXIMUM LWA+1 OF READ 
          READW  L,B6,B7     READ *PRFX* TABLE
 PRX8     SB7    A0          CLEAR ANY OF THE 15B WORDS 
          MX6    0           NOT READ INTO
          EQ     B6,B7,PRX12 IF ALL WORDS EITHER READ OR ZEROED 
          SA6    B6          CLEAR NEXT WORD
          SB6    B6+B1
          EQ     PRX8        LOOP 
  
**        4)   IF THE *PRFX* INFORMATION IS TO GO INTO THE MAP, A NEW 
*              ENTRY IS FORMED IN *TPRX*.  AS PER THE *TPRX* FORMAT,
*              THE 15B WORDS IN ENTRY 0 REFLECT THE MOST RECENT VALUE 
*              FOR EACH OF THE WORDS 2-16B FROM ALL *PRFX* TABLES 
*              (ENCOUNTERED, THAT IS, WHILE THE MAP OPTION WAS SET TO 
*              *B* OR GREATER).  THUS, WHEN DONE, THESE WORDS MUST, IN
*              ALL CASES, REFLECT THE VALUES FOR THIS CURRENT TABLE.
* 
  
 PRX9     ADDWRD A2,X4-X4    ADD NEW ENTRY HEADER TO *TPRX* 
          SA0    A2          (A0) = *TPRX* POINTER
          ALLOC  A2,15B      ALLOCATE MAX PRFX TABLE TO TPRX
          SA1    =10H 
          BX6    X1          BLANK TPRX BEYOND PRFX READ
          SB6    X3+B7       (B6) = FWA OF AREA TO BLANK
          R=     B5,X3+15B   (B5) = LWA+1 OF AREA TO BLANK
 PRX9A    EQ     B6,B5,PRX9B IF ALL WORDS EITHER READ OR BLANKED
          SA6    B6          BLANK NEXT WORD
          SB6    B6+B1
          EQ     PRX9A       LOOP 
 PRX9B    BX5    X3          (X5) = FWA OF NEW AREA 
          READW  L,X5,B7     READ *PRFX* TABLE
          SA1    A0          (X2) = FWA OF VALUES IN ENTRY 0
          MX7    0           (X7) = BIT STRING
          SA3    NEEDPRX     (B2) = NZ IF MAP=B SELECTED SINCE LAST PGM 
          SB2    X3 
          SA7    A3          CLEAR FLAG FOR SUBSEQUENT PROGRAMS 
          SX2    X1+B1
          R=     B7,15B      (B7) = NO OF WORDS, USE MAX
          IX6    X5-X2       SAVE POINTER TO LATEST ENTRY AT FWA
          SB6    B0          (B6) = FETCH INDEX 
          R=     B3,60       (B3) = SHIFT COUNT TO LEFT-JUSTIFY 
          MX1    -1          - (BIT FOR INSERTION)
          SA4    A0 
          SA6    X4 
          SB5    X5          (B5) = STORE POINTER 
          SB4    B5-B1       (B4) = ADR TO STORE BIT STRING 
 PRX10    SA3    X2+B6       NEXT WORD FROM ENTRY 0 
          ZR     B2,PRX10A   IF *NEEDPRX* WAS NOT SET 
          MX3    0           FORCE NO MATCH UNLESS LATEST VALUE = 0 
 PRX10A   SA4    X5+B6       NEXT WORD FROM NEW TABLE 
          LX7    1           SHIFT BIT STRING 
          IX3    X3-X4
          SB3    B3-B1       DOWN SHIFT COUNT 
          ZR     X3,PRX11    IF NO CHANGE 
          LX6    X4 
          BX7    -X1+X7      ADD BIT IN BIT STRING
          SA6    A3          STORE NEW VALUE TO ENTRY 0 
          SA6    B5          STORE NEW VALUE IN NEW ENTRY 
          SB5    B5+B1       ADVANCE STORE POINTER
 PRX11    SB6    B6+B1       ADVANCE FETCH INDEX
          LT     B6,B7,PRX10 LOOP 
          LX7    X7,B3       LEFT-JUSTIFY BIT STRING
          SX6    B5+B1       SET ADJUSTED *TPRX* LENGTH 
          IX6    X6-X2
          SA7    B4          STORE BIT STRING 
          SA6    A0+B1
  
**        5)   THE FIELD WHICH SPECIFIES HARDWARE DEPENDENCIES FOR THE
*              PROGRAM IS EXAMINED AND, WHENEVER NECESSARY, IT IS 
*              CHECKED TO SEE IF THAT HARDWARE IS PRESENT ON THIS 
*              MACHINE.  IF ANY OF THE OPTIONS SPECIFIED AS NEEDED ARE
*              NOT PRESENT, A FATAL ERROR RESULTS.
* 
  
 PRX12    SA1    TPRX        FETCH *PRFX* WORD WITH HARD. DEP.
          BX7    X2-X2       (X7) = ERROR FLAGS 
          MX3    1
          R=     A4,X1+6
          MX2    -6          CHAR MASK
          BX1    X3+X4       INSURE END OF CHAR LOOP
          SA5    HDEP        WORD FOR COLLECTING ALL HARD. DEP. 
          LX1    6
 PRX13    LX1    6           (X3) = NEXT CHAR 
          SB2    B0          (B2) = ERROR FLAG INDICATOR
          BX3    -X2*X1 
          SX6    B1          (X6) = ERROR FLAG
          R=     B4,X3-1R0
          SB5    X3 
          SX4    B1 
          PL     B4,PRX13A   IF CHAR TOO BIG
          LX4    X4,B5       ADD BIT TO COLLECTION
          BX5    X5+X4
 PRX13A   R=     B3,X3-1RC
          SA4    HDOPTC 
          NZ     B3,PRX14    IF NOT CMU 
          ZR     X4,PRX16    IF CMU OR SIMULATED CMU NOT PRESENT, ERROR 
 PRX14    R=     B3,X3-1RI
          SB2    B2+B1       NEXT ERROR INDICATOR 
          SA4    A4+B1
          NZ     B3,PRX15    IF NOT INTEGER MULTIPLY
          ZR     X4,PRX16    IF INT. MULT. NOT PRESENT, ERROR 
 PRX15    R=     B3,X3-1RX
          SB2    B2+B1       NEXT ERROR INDICATOR 
          SA4    A4+B1
          NZ     B3,PRX17    IF NOT XJ, LOOP
          NZ     X4,PRX17    IF XJ PRESENT, LOOP
 PRX16    LX6    X6,B2       SET APPROPRIATE ERROR BIT
          BX7    X7+X6
 PRX17    PL     X1,PRX13    IF MORE DEPENDENCY CHARS 
          SA1    PN          (X7) = PROGRAM NAME + ERROR BITS 
          BX6    X5          SAVE UPDATED BIT COLLECTION
          SA6    A5 
          ZR     X7,PRX18    IF NO HARDWARE DEFICIENCIES
          BX7    X1+X7
 IC       IFCARD
          SA2    EX 
          NZ     X2,PRX17A   IF EXECUTION DESIRED, ERROR IS FATAL 
          ERROR  4310,X7     ---- POTENTIAL HARDWARE DEFICIENCY 
          EQ     PRX18
  
 PRX17A   BSS    0
 IC       ENDIF 
          ERROR  310,X7      ---- HARDWARE DEFICIENCY 
          EQ     ABEND       GO ABORT 
  
 PRX18    BSS    0
  
 IC       IFCARD
  
**        6)   IF THIS IS THE FIRST PROGRAM OF THE LOAD, (OR
*              THE CURRENT OVERLAY/CAPSULE/OVCAP), THE COMMENTS FIELD 
*              FROM THE *PRFX* TABLE (WORDS 10-16B) ARE SAVED SO AS TO
*              BE INCLUDED IN THE RESULTING OVERLAY/CAPSULE/OVCAP FILE. 
* 
  
          SA1    PC 
          NZ     X1,PRX20    IF NOT 1ST PROGRAM 
          SA2    TPRX        SAVE *PRFX* COMMENTS FOR *PRFX*
          SA3    X2+7         TABLE IN OVERLAY/CAPSULE/OVCAP
          BX6    X3 
          SA6    PFXCOM 
          SB6    6
 PRX19    SA3    A3+B1
          BX6    X3 
          SA6    A6+B1
          SB6    B6-B1
          NZ     B6,PRX19 
  
 IC       ENDIF 
  
**        7)   ANY REMAINING WORDS IN THE *PRFX* TABLE ARE SKIPPED. 
*              (THAT IS, IF THE TABLE HAD A WORD COUNT > 16B).
  
 PRX20    SA4    T2          (B7) = REMAINING WORD COUNT
          SB7    X4 
          EQ     SKT         SKIP REMAINDER OF TABLE, IF ANY
  
 NEEDPRX  CON    0           MAP=B SELECTED FLAG
  
          IFUSER 3
 HDOPTC   CON    0           SET NZ IF CMU PRESENT
 HDOPTI   CON    0           SET NZ IF INTEGER MULTIPLY PRESENT 
 HDOPTX   CON    0           SET NZ IF XJ PRESENT 
 PIDL     TITLE  LOAD INPUT - PIDL TABLE. 
**        PIDL TABLE - PROGRAM IDENTIFICATION AND LENGTH. 
* 
*         CODE = 34.
* 
*         CYBER LOADER PIDL TABLE PROCESSOR 
*                KRONOS PIDL TABLE IS PROPER SUBSET OF SCOPE PIDL TABLE 
*                AND HENCE NO CONDITIONAL CODE IS NECESSARY HERE. 
* 
* 
*              THE *PIDL* TABLE DESCRIBES THE PROGRAM AND COMMON
*         BLOCKS FOR THE FOLLOWING TABLES.  IT MUST BE THE FIRST TABLE
*         FOR THE PROGRAM, OTHER THAN THE *PRFX* TABLE, AND POSSIBLY ONE
*         OR MORE *LDSET* TABLES. 
* 
*         WORD 1:                                                              .
* 
*         VFD    42/0LNAME,18/L 
* 
*         NAME = NAME OF LOCAL CM BLOCK (PROGRAM NAME). 
*         L    = LENGTH OF BLOCK.  IF ACTUAL LENGTH IS GREATER, IT
*                WILL BE COMPUTED AS PROGRAM TEXT IS LOADED.
* 
*         WORDS 2 - WC:                                                        .
* 
*         VFD    42/0LNAME,1/T,17/L 
* 
*         NAME = COMMON BLOCK NAME.  IF ZERO, IT REPRESENTS A LOCAL ECS 
*                BLOCK WHICH IS GIVEN A UNIQUE NAME.  IF *NAME* IS
*                SEVEN BLANKS, THEN THE BLOCK IS BLANK COMMON.
*         T    = TYPE OF BLOCK AS FOLLOWS 
* 
*                T = 0 - CM BLOCK WHOSE LENGTH IS L WORDS.
*                T = 1 - ECS BLOCK WHOSE LENGTH IS L*8 WORDS. 
* 
* 
*         THE RELOCATION OF ADDRESSES REFERRING TO COMMON 
*         BLOCKS IS DESIGNATED BY THE POSITION OF THE COMMON BLOCK
*         NAMES IN THE *PIDL* TABLE.  COMMON BLOCK 1 IS IN WORD 2 
*         OF THE *PIDL* TABLE.  THE RELOCATION FIELD IN THE VARIOUS 
*         TABLES (FIELD SIZE OF 9 BITS) SPECIFIES RELOCATION OF 
*         ADDRESSES AS FOLLOWS:                                                .
* 
* 
*                RL = 0      ABSOLUTE (NO RELOCATION).
*                RL = 1      RELATIVE TO PROGRAM BLOCK. 
*                RL = 2      RELATIVE TO COMPLEMENT OF PROGRAM BLOCK. 
*                            (NEGATIVE RELOCATION). 
*                RL = 3 - N  RELATIVE TO COMMON BLOCK (RL-2)
* 
*                ALL RELOCATION UNLESS OTHERWISE SPECIFIED IS PERFORMED 
*         IN 18-BIT ONE-S COMPLEMENT ADDITION.
* 
* 
*              PROCESSING IS AS FOLLOWS 
* 
*         1)   THE RELOCATION BASE TABLE *TRLB* IS SET TO THE CORRECT 
*              LENGTH AND THE *PIDL* TABLE IS READ INTO IT. 
* 
*              THE FORMATS OF TABLES *TRLB* AND *TBLK* SHOULD BE WELL 
*              UNDERSTOOD AT THIS POINT.  REFER TO THEIR DESCRIPTIONS 
*              IN THE MANAGE TABLE SECTION OF THE IMS.  *TRLB* IS USED
*              FOR ADDRESS RELOCATION WHILE PROCESSING THE REMAINING
*              TABLES FOR THIS PROGRAM. 
* 
*              *** N O T E ***  IF CAPSULE GENERATION AND THE CURRENT 
*              CAPSULE IS NOT INITIATED, THEN THIS PROGRAM IS SKIPPED.
  
 PIDL     BSS    0
 IC       IFCARD
          SX7    B1 
          SA7    LKR         FLAG LOAD KNOWN TO BE RELOCATABLE
          SA4    ID          MAKE SURE FID PROCESSING HAS NOT BEGUN 
          NZ     X4,PDL0     FID PROCESSING HAS BEGUN, DO NOT RESET ID
          BX4    X5          CHECK HEADER BIT 35 FOR FID REQUEST
          MX3    59 
          AX4    35 
          BX7    -X3*X4 
          SA7    ID          SET ID FLAG TO REFLECT BIT 35
PDL0      SA2    OG 
          PL     X2,PDL1     IF NOT ENCAPSULATION 
          SA2    CGFPAF 
          NZ     X2,PDL1     IF CAPSULE ALREADY INITIATED 
          SX5    B7          REMAINING TABLE LENGTH 
          RJ     SKP         SKIP PROGRAM 
          ZR     X1,RDR2     IF NOT AT EOR
          EQ     RDR         EXIT FILE READ IF AT EOR 
  
 PDL1     BSS    0
 IC       ENDIF 
          SA2    TRLB        CHECK RELOCATION BASE INDEX
          ZR     B7,RDR1     IGNORE ANY ZERO-LENGTH TABLE 
          SA5    A2+B1       (X5) = CURRENT TRLB LENGTH 
          SB6    B1+B1       (X6) = REQUIRED *TRLB* LENGTH
          SX6    B7+B6
          IX1    X6-X5       (X1) = ADDITION NEEDED FOR TRLB
          ALLOC  TRLB,X1     SET *TRLB* TO CORRECT LENGTH 
          SX0    B7-B1       (X0) = NUMBER OF COMMON BLOCKS 
          SX5    X2+B6       READ BLOCK NAMES TO FWA+2 OF *TRLB*
          READW  L,X5,X0+B1 
 IC       IFCARD
          RJ     CFP         CHECK FOR FIRST PROGRAM UNDER FID
          SA1    SEGFLAG
          NZ     X1,/LOADS/PDL  IF SECOND PASS OF SEGMENT LOAD
 IC       ELSE
          MX6    0           INITIALIZE FOR BLOCK ORIGIN ERROR
          SA6    LASTORGL    CHECKING 
 IC       ENDIF 
          SA2    TRLB        (X1) = PROGRAM NAME
          R=     A2,X2+2
  
**        2)   THE SUBROUTINE *EBD* IS CALLED TO ENTER THE PROGRAM
*              BLOCK DEFINITION IN *TBLK*.
* 
  
          SA4    FI          FILE INDEX TO BITS 48-58 
          MX3    42 
          BX1    X3*X2
          LX4    24 
          BX5    -X3*X2      (X5) = LENGTH
          SA2    PC          ADVANCE PROGRAM COUNT
          SX7    X2+B1
          BX6    X1 
          SA6    PN          SAVE PROGRAM NAME
          NZ     X2,PDL2     IF NOT FIRST PROGRAM 
          SA6    ON          SET OVERLAY NAME (IN CASE NEEDED)
 IC       IFCARD
          SA3    OG 
          SB2    X3          (B2) = (OG)
          NE     B2,B1,PDL1A  IF NOT OVERLAY GENERATION 
          SA3    OGL1        CHECK FOR (0,0)
          NZ     X3,PDL1A    IF NOT (0,0) 
          SA6    CURGPNAM    SET *CURGPNAM* IN CASE OVCAP GEN FOLLOWS 
 PDL1A    LE     B2,B1,PDL1B  IF NOT OVCAP GENERATION 
          SA6    CURCPNAM    SET *CURCPNAM* FOR OVCAP GENERATION
 PDL1B    BSS    0
 IC       ENDIF 
          IFTEST NE,IP.LDBG,0,1 
          SA6    MSGON
 PDL2     SA7    A2 
          IX5    X4+X5
          RJ     EBD         ENTER BLOCK DEFINITION 
          LD     X7,X7-1     SET PROGRAM INDEX
          SA7    PI 
          ZR     X6,PDL3     IF PROGRAM PREVIOUSLY LOADED 
  
**        3)   THE NEXT THREE (3) STEPS DESCRIBE THE PROCESSING DONE FOR
*              EACH COMMON BLOCK SPECIFIED IN THE *PIDL* TABLE. 
* 
  
 ACB      BSS    0
 IC       IFCARD
          RJ     PID         PROCESS INTERACTIVE DEBUG INFORMATION
 IC       ENDIF 
          ZR     X0,ACBX     IF NO COMMON BLOCKS
          SX6    B1+B1       SET BLOCK INDEX
          SA6    T1 
          IX0    X0+X6       SET LIMIT
 ACB1     SA1    T1          ADVANCE BLOCK INDEX
          SX6    X1+B1
          IX7    X1-X0
          SA6    A1 
          ZR     X7,ACBX     IF ALL BLOCKS PROCESSED
          SB2    X6          NEXT BLOCK DESCRIPTION 
          SA2    TRLB 
          MX7    42          (X1) = BLOCK NAME
          SA5    X2+B2
          BX1    X7*X5
          LX1    6           CHECK NAME 
          LD     X6,X1-1R 
          LX1    -6 
          SX5    X5          EXTRACT LENGTH 
          ZR     X6,ACB4     IF //
          ZR     X1,ACB6     IF LOCAL ECS BLOCK 
  
**        4)   IF THE BLOCK IS NEITHER FOR BLANK COMMON NOR LOCAL ECS 
* 
*              A)   ITS DEFINITION IS PLACED IN THE BLOCK TABLE *TBLK*
*                   VIA THE SUBROUTINE *EBD*.  NOTE THAT *EBD* DOES NOT 
*                   MAKE A NEW ENTRY IF THE NAME IS ALREADY IN *TBLK*.
*                   NOTE - - A LOCAL SAVED CM COMMON BLOCK,/S$A$V$E/,IS 
*                   SPECIAL CASED AND A UNIQUE NAME IS GENERATED FOR
*                   *TBLK*.  *TLSB* ENTRIES ARE ALSO MADE FOR SUCH A
*                   BLOCK, TO BE USED LATER FOR THE LOAD MAP. 
* 
  
          SX7    B1          FLAG AS COMMON BLOCK 
          PL     X5,ACB1A    IF CM BLOCK
 ECS      IFTEST EQ,IP.MECS,0 
          ERROR  104
          EQ     ABEND
  
 ECS      ELSE
          MX4    -17         ADJUST LENGTH
          SX3    B1+B1       ADD ECS FLAG 
          BX5    -X4*X5 
          IX1    X1+X3
          LX5    3
 ECS      ENDIF 
  
          EQ     ACB2 
  
 ACB1A    SA2    LSBN 
          BX2    X1-X2       COMPARE BLOCK NAME TO KEY
          NZ     X2,ACB2     IF NOT A LOCAL SAVE BLOCK
          SA1    UNAME
          MX2    42 
          SX6    X1+B1       INCREMENT UNIQUE NAME COUNT
          SA6    A1 
          MX6    -30
          SA2    UID         LOCAL SAVE BLOCK IDENTIFIER
          BX1    -X6*X1 
          LX1    18 
          BX1    X1+X2       :ANNNNN
          BX7    X1 
          SA7    T2          SAVE UNIQUE NAME 
          ADDWRD TLSB,X1     ADD UNIQUE NAME TO *TLSB*
          SA4    PN 
          ADDWRD A2,X4       ADD CORRESPONDING PROGRAM NAME TO *TLSB* 
          SA1    T2          (X1) = 42/:ANNNNN,18/0 
          SX7    B1          FLAG AS COMMON BLOCK 
 ACB2     BX1    X1+X7
          RJ     EBD         ENTER BLOCK DEFINITION 
  
**             B)   THE ENTRY IN *TRLB* FOR THE BLOCK IS FORMED.
* 
  
          SB2    X7          (B2) = INDEX OF DEF IN *TBLK*
          SA1    TRLB 
          SA3    T1 
          LX7    36          BLOCK INDEX TO BITS 36-53
          SB3    X1 
          MX4    -24         (X4) = PROGRAM ADDRESS 
          SA1    B3+X3
          BX4    -X4*X5 
          MX3    1           ISOLATE CM/ECS FLAG
          LX1    59-17
          BX7    X7+X4       BLOCK INDEX + ADDRESS
          BX3    X3*X1       ADD IN CM/ECS FLAG 
          BX7    X7+X3
          NG     X7,ACB2B    IF ECS BLOCK 
          SA1    PO 
          SA3    BI 
          IX4    X4-X1       PA-PO
          PL     X4,ACB2A    IF BLOCK IN CURRENT LOAD 
 ACB2C    BSS    0
          MX4    -24         SET ADDRESS = 77777777B
          BX7    -X4+X7 
          EQ     ACB2B
  
 ACB2A    BSS    0
 IC       IFCARD
          SA1    OG          CHECK FOR OVCAP GENERATION 
          R=     X1,X1-2
          NZ     X1,ACB2D    IF NOT OVCAP GENERATION
          SA1    OCBPI       OVCAP BASE *PI*
          SB3    X1          (B3) = INITIAL *PI* FOR OVCAP GENERATION 
          LT     B2,B3,ACB2C  IF BLOCK NOT IN CURRENT LOAD (OVCAP GEN)
 IC       ENDIF 
 ACB2D    IX4    X3+X4       FORM LOAD ADDRESS = (PA-PO+BI) 
          MX1    -24
          BX7    X1*X7
          BX7    X4+X7
 ACB2B    SA1    TRLB        STORE *TRLB* ENTRY 
          SA3    T1 
          SB3    X1 
          SA7    X3+B3
  
**             C)   IF THIS IS THE FIRST DEFINITION OF THE BLOCK, 
*                   PROGRAM SPACE IS ALLOCATED USING THE SUBROUTINE 
*                   *APS*.
* 
  
          MX4    -24         (X1) = BLOCK LENGTH
          AX5    24 
          BX1    -X4*X5 
          ZR     X6,ACB3     IF PREVIOUSLY DEFINED
          MX3    1
          BX2    X3*X7       (X2) = 0 IF CM BLOCK 
          RJ     APS=        ALLOCATE PROGRAM SPACE 
 IC       IFCARD
          SX1    B0 
          SX2    B0 
          RJ     IDE         CREATE INTERACTIVE DEBUG ENTRY FOR BLOCK 
 IC       ENDIF 
          EQ     ACB1        PROCESS NEXT BLOCK 
  
**             D)   IF THERE WAS A PREVIOUS DEFINITION, NOTHING ELSE IS 
*                   DONE EXCEPT CHECK FOR THE ERROR CONDITION OF THE
*                   NEW DEFINITION SPECIFYING A GREATER LENGTH. 
* 
  
 ACB3     IX2    X1-X2       COMPARE LENGTHS (OLD) - (NEW)
          AX7    36          SET BLOCK INDEX
          PL     X2,ACB1     IF NEW LENGTH @ PREVIOUS LENGTH
          SA1    TBLK        FETCH BLOCK NAME 
          MX3    42 
          SB2    X1 
          SA2    B2+X7
          SA2    A2-B1
          BX7    X3*X2
          ERROR  4101,X7     ---- COMMON BLOCK REDEFINITION 
          EQ     ACB1        PROCESS NEXT BLOCK 
  
**        5)   FOR A BLANK COMMON BLOCK, THE SUBROUTINE *EBD* IS NOT
*              USED, SINCE THERE IS ALWAYS A *TBLK* DEFINITION FOR
*              BLANK COMMON WHETHER OR NOT BLANK COMMON ACTUALLY EXISTS.
* 
*              FOR CONTROL-CARD-INITIATED LOADS, PROCESSING CONSISTS OF 
*              MERELY FETCHING THE APPROPRIATE *TBLK* ENTRY (CM OR ECS
*              BLANK COMMON) AND SETTING THE LENGTH TO THE MAXIMUM
*              CURRENT DEFINITION.
* 
*              FOR USER-CALL LOADS, IT IS ALSO NECESSARY TO CHECK IF
*              THE BLANK COMMON BLOCK WAS DEFINED ON A PREVIOUS LOAD, 
*              AND, IF SO, A LARGER DEFINITION CANNOT BE ALLOWED NOW, 
*              SINCE PROGRAM SPACE WILL HAVE BEEN ALLOCATED DIRECTLY
*              ABOVE IT.
* 
  
 IC       IFCARD
 ACB4     SB2    B1          *TBLK* INDEX = 1 IF CM //
          SA1    TBLK 
          MX7    -24         ADDRESS = 77777777B = UNDEFINED
          SX3    B0          FLAG CM BLOCK
          PL     X5,ACB5     IF CM BLOCK
          SB2    B1+B1       *TBLK* INDEX = 3 
          MX3    1           FLAG ECS BLOCK 
          SB2    B2+B1
          MX4    -17         (X5) = ECS LENGTH
          BX5    -X4*X5 
          LX5    3
 ACB5     SA2    X1+B2       FETCH *TBLK* DEFINITION
          BX7    -X7
          LX2    -24         (X4) = PREVIOUS // LENGTH
          SX6    B2          POSITION *TBLK* INDEX
          BX4    X7*X2
          LX6    36 
          IX4    X4-X5       (OLD LENGTH) - (NEW LENGTH)
          BX6    X3+X6       FORM *TRLB* ENTRY
          LX2    24 
          BX6    X6+X7
          SA6    A5          STORE *TRLB* ENTRY 
          NG     X2,ACB5A    IF THIS IS FIRST DECLARATION 
          PL     X4,ACB1     IF PREVIOUS LENGTH \ NEW LENGTH
 ACB5A    BX7    X5          SET NEW LENGTH 
          LX7    24 
          SA7    A2 
          EQ     ACB1        PROCESS NEXT BLOCK 
  
 IC       ENDIF 
 IU       IFUSER
 ACB4     SB2    B1          *TBLK* INDEX = 1 IF CM //
          SA1    TBLK 
          MX7    -24         ADDRESS = 77777777B = UNDEFINED
          SX3    B0          FLAG CM BLOCK
          PL     X5,ACB5     IF CM BLOCK
          SB2    B1+B1       *TBLK* INDEX = 3 
          MX3    1           FLAG ECS BLOCK 
          SB2    B2+B1
          MX4    -17         (X5) = ECS LENGTH
          BX5    -X4*X5 
          LX5    3
 ACB5     SA2    X1+B2       FETCH *TBLK* DEFINITION
          BX7    -X7
          LX2    -24         (X4) = PREVIOUS // LENGTH
          SX6    B2          POSITION *TBLK* INDEX
          BX4    X7*X2
          LX6    36 
          IX1    X4-X5       (OLD LENGTH) - (NEW LENGTH)
          BX6    X3+X6       FORM *TRLB* ENTRY
          LX2    24 
          BX6    X6+X7
          SA6    A5          STORE *TRLB* ENTRY 
          MX6    0
          LX3    1           CM=0, ECS=1
          BX7    X5          NEW // LENGTH
          SA4    X3+BCOM     1ST BLANK COMMON FLAG
          PL     X2,ACB5B    IF // EXISTED BEFORE 
          SA6    A4          SET NEW // FLAG
 ACB5A    LX7    24          SET NEW LENGTH, AND SET ORIGIN = 0 
          SA7    A2 
          EQ     ACB1        PROCESS NEXT BLOCK 
  
 ACB5B    PL     X1,ACB1     IF PREVIOUS LENGTH GREATER 
          ZR     X4,ACB5A    IF FIRST DEFINED THIS LOAD 
          BX7    X3          CM=0, ECS=1
          SA1    X3+BCERRF
          MX6    0
          ZR     X1,ACB1     IF ERROR ALREADY ISSUED
          SA6    A1          INDICATE NOW ISSUED
          ERROR  4105,X7     ---- BLANK COMMON TRUNCATED
          EQ     ACB1        PROCESS NEXT BLOCK 
  
 BCOM     CON    1,1         ZR IF // 1ST DEFINED ON THIS LOAD
                                    (FLAGS FOR CM AND ECS, RESPECTIVELY)
 BCERRF   CON    1,1         ZR IF // TRUNCATED ERROR ALREADY 
                                    ISSUED FOR CM OR ECS, RESPECTIVELY
  
 IU       ENDIF 
  
**        6)   IF THE BLOCK IS A LOCAL ECS BLOCK, A UNIQUE NAME IS
*              GENERATED OF THE FORM '?NNNNN, WHERE NNNNN IS A DECIMAL
*              INTEGER.  THEN IT IS PROCESSED AS A LABELED COMMON BLOCK,
*              EXCEPT FOR THE FLAGS THAT INDICATE IT IS A LOCAL ECS 
*              BLOCK. 
* 
  
 ACB6     SA1    UNAME       FETCH VALUE FOR UNIQUE BLOCK NAME
          SX6    X1+B1       AND BUMP IT FOR THE NEXT TIME
          MX2    -17
          SA6    A1          (X5) = BLOCK LENGTH
          R=     X6,100000D  FAKE OUT CDD TO STOP ZERO SUPPRESSION
          IX1    X1+X6       THE EXTRA 100000 GETS CHOPPED OFF BELOW
          BX5    -X2*X5 
          RJ     CDD=        COMVERT NAME TO DECIMAL DISPLAY
          MX1    -30         FORM '?NNNNN 
          SA2    =2L'?
          BX1    -X1*X6 
          SA4    FI          FILE INDEX 
          LX1    18 
          SX3    B1+B1       ADD ECS FLAG TO NAME 
          LX4    24 
          MX7    0           CLEAR COMMON FLAG
          BX1    X1+X2       NAME 
          LX5    3           FORM FILE INDEX + LENGTH 
          BX1    X1+X3       NAME + ECS FLAG
          IX5    X5+X4       FILE INDEX + LENGTH
          EQ     ACB2        GO ENTER DEFINITION
  
**        7)   THE *TRLB* ENTRIES FOR POSITIVE AND NEGATIVE PROGRAM 
*              RELOCATION AND THE *TBLK* ENTRY WITH THE PROGRAM ADDRESS 
*              ARE NOW FORMED.  THESE ARE NOT SET UNTIL NOW, SINCE SPACE
*              FOR NEW COMMON BLOCKS IS ALLOCATED FIRST.
* 
  
 ACBX     BSS    0
          SA1    PI          EXTRACT PROGRAM DEFINITION 
          SA2    TBLK 
          SA4    TPRX        ADD *TPRX* POINTER TO WORD 1, BITS 
          MX0    36          3-17 OF *TBLK* ENTRY 
          BX6    X6-X6       CLEAR POINTER IN FWA OF *TPRX* 
          SA3    X4 
          SB2    X1 
          SA6    X4 
          LX3    3
          SA4    X2+B2
          BX6    X3+X4
          SA6    A4 
          SA5    PA          REPLACE BLOCK ADDRESS
          SA4    A4+B1
          BX7    X0*X4
          SA2    TRLB 
          SA1    PO          FORM (PA-PO+BI)
          SA3    BI 
          IX1    X5-X1
          BX7    X7+X5       PROGRAM ADDRESS TO *TBLK* DEF WORD 
          IX3    X1+X3
          SA7    A4          STORE *TBLK* DEFINITION WORD 
          SX1    B2+B1       *TBLK* INDEX FOR *TRLB* ENTRIES
          LX1    36 
          IX6    X3+X1       POSITIVE BASE FOR *TRLB* 
          AX4    24          (X1) = PROGRAM LENGTH
          BX7    -X0-X6      NEGATIVE BASE FOR *TRLB* 
          SA6    X2+B1       STORE POSITIVE BASE
          SA7    A6+B1       STORE NEGATIVE BASE
  
**        8)   THE SUBROUTINE *APS* IS NOW CALLED TO ALLOCATE SPACE FOR 
*              THE PROGRAM BLOCK. 
* 
  
 PDL2A    BSS    0           RETURN FROM /LOADS/PDL 
          BX2    X3-X3       INDICATE CM PROGRAM SPACE
          MX0    42 
          SX1    X4          ALLOCATE PROGRAM SPACE 
          RJ     APS= 
  
**        9)   THE TEXT ADDRESS RELOCATION TABLE *TXTA* USED BY THE 
*              *TEXT* AND *XTEXT* TABLE PROCESSOR IS NOW FORMED.  THIS
*              COMPLETES THE NORMAL *PIDL* TABLE PROCESSING.
* 
  
          SX1    X5          L+ 
          BX6    -X1-X0      L- 
          SA6    TXTA+2      2 = L- 
          LX7    X1          L+ 
          SA7    A6+B1       3 = L+ 
          LX6    15          M- 
          BX2    -X1-X0      L- 
          LX7    15          M+ 
          SA6    A7+B1       4 = M- 
          SA6    A6+B1       5 = M- 
          LX6    15          U- 
          SA7    A6+B1       6 = M+ 
          BX3    X6          SAVE U-
          SA7    A7+B1       7 = M+ 
          LX4    X1          PREPARE U+ 
          SA6    A7+B1       10 = U-
          IX7    X3+X2       MERGE U-, L- 
          SA6    A6+B1       11 = U-
          LX4    30 
          IX6    X3+X1       MERGE U-, L+ 
          SA7    A6+B1       12 = U-, L-
          SA6    A7+B1       13 = U-, L+
          BX7    X4          U+ 
          IX6    X4+X2       MERGE U+, L- 
          SA7    A6+B1       14 = U+
          SA7    A7+B1       15 = U+
          BX7    X4+X1       MERGE U+, L+ 
          SA6    A7+B1       16 = U+, L-
          SA7    A6+B1       17 = U+, L+
          EQ     RDR1        PROCESS NEXT TABLE 
  
**        10)  THE OCCURRENCE OF MORE THAN ONE PROGRAM OF THE SAME NAME 
*              WITHIN THE LOAD RESULTS IN A NON-FATAL ERROR.
* 
*              IF THE DUPLICATE IS FROM A FILE IT IS SKIPPED. 
* 
*              UNDER NOS, A DUPLICATE FROM A LIBRARY IS SKIPPED WITHOUT 
*              COMMENT.  THIS IS A FAIRLY COMMON OCCURRENCE DURING
*              OVERLAY GENERATION OR USER-CALL LOADING DUE TO THE 
*              STRUCTURE OF NOS LIBRARIES.
* 
*              UNDER SCOPE, A DUPLICATE FROM A LIBRARY FILE IS LOADED.
*              IN ORDER TO DO THIS, THE BLOCK DEFINITION MUST BE PLACED 
*              IN *TBLK* WITHOUT USING *EBD*, SINCE *EBD* WILL NOT
*              INSERT A DUPLICATE.
* 
  
 PDL3     SA2    FI          CHECK FILE TYPE
          SA1    TLFN 
          SB2    X2 
          SA3    X1+B2
          SX3    X3 
          MX1    42          (X7) = PROGRAM NAME
          SA4    TBLK 
          SB2    X4 
          SA2    X7+B2
          BX7    X1*X2
 IN       IFNOS 
          NZ     X3,PDL3C    IF FROM LIBRARY (SKIP WITHOUT COMMENT) 
 IN       ELSE
          NZ     X3,PDL4     IF FROM LIBRARY (LOAD ANYWAY)
 IN       ENDIF 
 PDL3B    ERROR  4103,X7     ---- DUPLICATE PROGRAM NAME FROM FILE
 PDL3C    SX5    B0 
          RJ     SKP         SKIP THIS PROGRAM
          ZR     X1,RDR2     CONTINUE FILE READ IF NO EOR 
          EQ     RDR         EXIT FILE READ IF AT EOR 
  
 PDL4     ERROR  4104,X7     ---- DUPLICATE PROGRAM NAME FROM LIBRARY 
          SA1    X2+B2       (X1) = PROGRAM NAME
          SA2    TRLB        (X4) = PROGRAM LENGTH
          SB3    B1+B1
          SA3    FI          FORM *TBLK* DEFINITION 
          SA4    X2+B3
          LX3    24 
          SX4    X4 
          SA2    PA 
          BX5    X3+X4
          LX5    24 
          BX5    X5+X2
          ADDWRD TBLK,X1     STORE NEW *TBLK* ENTRY 
          ADDWRD A2,X5
          SX7    B1          SET PROGRAM INDEX
          IX7    X4-X7
          SA7    PI 
          EQ     ACB         GO ENTER COMMON BLOCKS 
  
 ENTR     TITLE  LOAD INPUT - ENTR TABLE. 
**        ENTR TABLE - ENTRY POINT DEFINITIONS. 
* 
*         CODE = 36.
* 
*         CYBER LOADER ENTR TABLE PROCESSOR.
*                KRONOS ENTR TABLE IS PROPER SUBSET OF SCOPE ENTR TABLE 
*                AND HENCE NO CONDITIONAL CODE IS NECESSARY HERE. 
* 
* 
*              THE *ENTR* TABLE DEFINES ENTRY POINT NAMES IN A
*         RELOCATABLE SUBPROGRAM.  THE TABLE CONSISTS OF 2-WORD 
*         ENTRIES AS FOLLOWS:                                                  .
* 
*         WORDS 1 - WC:                                                        .
* 
*         VFD    42/0LNAME,9/0,9/CR 
*         VFD    24/AL,9/0,9/R,18/AS
* 
*         NAME = ENTRY POINT NAME.
*         CR   = CONDITIONAL INDICATOR, SAME FORMAT AS *R*.  THIS ENTRY 
*                IS IGNORED IF *CR* REFERS TO A COMMON BLOCK THAT WAS 
*                FIRST DECLARED BY AN EARLIER SUBPROGRAM. 
*         AL   = RELATIVE ADDRESS OF ENTRY, IF *R* REFERS TO AN ECS 
*                BLOCK. 
*         R    = RELOCATION BASE DESIGNATOR. (SEE RELOCATION FIELD
*                DESCRIPTION FOR *PIDL* TABLE.) 
*         AS   = RELATIVE ADDRESS OF ENTRY, IF *R* REFERS TO A CM BLOCK.
* 
* 
*              PROCESSING IS AS FOLLOWS 
* 
*         1)   EACH ENTRY IS READ AND THE CONDITIONAL INDICATOR IS
*              CHECKED TO SEE IF THE ENTRY IS TO BE SKIPPED.
* 
  
 ENTR     SA1    TEPT        (X0) = CURRENT *TEPT* LENGTH 
          SX5    B7          (X5) = TABLE LENGTH
          SA2    A1+B1
          BX0    X2 
          ZR     B7,RDR1     IGNORE ANY ZERO-LENGTH TABLE 
          IFCARD 2
          SA1    SEGFLAG
          NZ     X1,SKT      IF WE HAVE READ THIS IN PASS 1 OF SEG LOAD 
 ENT1     READW  L,T1,2      READ NEXT TABLE ENTRY
          SA2    TRLB        (B3) = FWA RELOCATION BASE TABLE 
          SA1    T1          (X1) = WORD 1 OF ENTRY 
          MX7    -9          (X6) = CONDITIONAL INDICATOR 
          SB3    X2 
          BX6    -X7*X1 
          SA3    PI 
          ZR     X6,ENT2     IF NO CONDITIONAL INDICATOR PRESENT
          BX1    X7*X1       REMOVE CONDITIONAL INDICATOR 
          SA2    B3+X6       (X2) = RELOC BASE TABLE ENTRY
          MX7    -18         (X6) = INDEX IN *TBLK* 
          LX2    24          IF THIS INDEX IS < PROGRAM INDEX,
          BX6    -X7*X2      THEN THE BLOCK DESIGNATED BY THE 
          IX3    X6-X3       CONDITIONAL INDICATOR WAS FIRST
                                       DECLARED BY AN EARLIER PROGRAM 
          NG     X3,ENT3     IF SO, SKIP ENTRY
  
**        2)   THE ENTRY IS PLACED IN THE TABLE *TEPT*. 
* 
  
 ENT2     ADDWRD TEPT,X1     PLACE 1ST WORD OF ENTRY IN TABLE 
          SA1    T1+1        PLACE 2ND WORD OF ENTRY IN TABLE 
          ADDWRD A2,X1
 ENT3     LD     X5,X5-2
          NZ     X5,ENT1     IF MORE ENTRIES IN TABLE 
  
**        3)   AFTER ALL ENTRIES HAVE BEEN READ, THE ADDRESSES ARE
*              RELOCATED. 
  
  
          SA2    TEPT        (X3) = NEW *TEPT* LENGTH 
          SA3    A2+B1
          IX1    X3-X0       (B7) = NUMBER OF WORDS ADDED 
          IX5    X2+X0       (X5) = FWA OF ENTRIES ADDED
          SB7    X1 
          MX0    -9          (X0) = RELOCATION BLOCK MASK 
          ZR     B7,RDR1     IF NO ENTRIES ADDED
          SA2    TRLB        (B6) = FWA RELOCATION BASE TABLE 
          SA1    X5+B1       FIRST WORD 
          MX4    -24         MASK FOR RELOCATED ADDRESS 
          SA3    PI          (X3) = PROGRAM INDEX 
          SB6    X2 
          SB2    B1+B1       (B2) = 2 
          LX3    36 
 ENT4     SX7    X1          EXTRACT CM ADDRESS 
          LX1    -18         EXTRACT RELOCATION INDEX 
          BX2    -X0*X1 
          SB5    X2 
          SA2    B6+X2       GO *TRLB* TO *TBLK* TO GET PROG ADR
 ECS      IFTEST NE,IP.MECS,0 
          PL     X2,ENT5     IF CM BLOCK
          LX1    18+3        EXTEND SIGN FOR ECS ADDRESS
          AX1    3+9+9+18    RIGHT-JUSTIFY ECS ADDRESS
          BX7    X1 
 ENT5     BSS    0
 ECS      ENDIF 
          SA5    TBLK        FETCH PROGRAM ADDRESS
          AX2    36          *TBLK* INDEX 
          SB3    X5 
          SB4    X2 
          SA2    B3+X2       FETCH *TBLK* ENTRY 
          BX2    -X4*X2      BLOCK PROGRAM ADDRESS
          NE     B5,B2,ENT5A IF NOT -PROGRAM RELOACATION
          BX2    -X2
          LX2    -18
          AX2    -18
 ENT5A    BSS    0
          IX7    X7+X2       RELOCATE ENTRY ADDRESS 
          SB7    B7-B2
          BX7    -X4*X7      REMOVE SIGN EXTENSION IF NEG VALUE 
          BX7    X3+X7       ADD PROGRAM INDEX TO DEFINITION
          EQ     B4,B1,ENT7  IF ENTRY POINT IS IN //
          SA7    A1          STORE ADDRESS
 ENT6     SA1    A1+B2
          NZ     B7,ENT4     LOOP TO END OF TABLE 
          EQ     RDR1        PROCESS NEXT TABLE 
          SPACE  1
 ENT7     LD     X4,5        SET *U* AND *BC* FIELDS
          LX4    56 
          BX7    X7+X4
          SA7    A1          STORE IN TEPT
          SA1    A1-B1
          SA3    TEPT        (X3) = *TEPT* FWA
          SB2    X3 
          SB2    A1-B2       (B2) = RELATIVE INDEX INTO *TEPT*
          ADDWRD TEPT1,X1    MOVE 1ST WORD TO TEPT1 
          SA1    TEPT        (X1) = *TEPT* FWA
          SB2    B2+B1
          SA1    X1+B2       (X1) = SECOND WORD OF *TEPT* ENTRY 
          MX4    1           CLEAR *U* FIELD
          LX4    -1 
          BX1    -X4*X1 
          ADDWRD A2,X1       MOVE 2ND WORD TO TEPT1 
          SA1    TEPT        (X1) = *TEPT* FWA
          SA1    X1+B2       RESTORE (A1) = ABS FETCH POINTER IN *TEPT* 
          SB2    B1+B1       RESTORE (B2) = 2 
          SA3    PI          RESTORE (X3) = PROGRAM INDEX 
          SA2    TRLB        RESTORE (B6) = FWA *TRLB*
          SB6    X2 
          LX3    36 
          MX4    -24
          EQ     ENT6 
 PTEXT    TITLE  LOAD INPUT - PTEXT TABLE.
**        PTEXT TABLE - PARTIAL WORD TEXT TABLE.
* 
*         CODE = 35.
* 
*         CYBER LOADER PTEXT TABLE PROCESSOR. 
* 
*             *PTEXT* TABLES ALLOW PART OF A WORD TO BE FILLED WITH 
*         TEXT WITHOUT DESTROYING THE REST OF THE WORD. 
* 
*             THE CONTROL WORD FOR *PTEXT* TABLES IS AS FOLLOWS:  
* 
*         VFD    12/3500B,12/WC,15/0,9/CR,12/0
* 
*         WC = WORD COUNT OF TABLE. 
*         CR = CONDITIONAL RELOCATION BASE DESIGNATOR.  THE *PTEXT* 
*              TABLE IS IGNORED IF *CR* REFERS TO A COMMON BLOCK THAT 
*              WAS FIRST DECLARED BY AN EARLIER PROGRAM.
* 
* 
*              THE TABLE CONSISTS OF ONE OR MORE PARTIAL TEXT GROUPS
*         OF VARIABLE WORD LENGTH IN THE FOLLOWING FORMAT:  
* 
*         VFD    18/TLB,6/FB,1/R,2/0,9/RB,24/FWA
* 
*         TLB = LENGTH IN BITS OF TEXT WORD(S). 
*         FB  = BIT SHIFT COUNT TO FIRST BIT POSITION OF TEXT.
*         R   = 1 IF REPLICATED TEXT. 
*         RB  = RELOCATION BASE DESIGNATOR. 
*         FWA = LOAD ADDRESS OF TEXT RELATIVE TO *RB*.
* 
*             IF R=1 THE FOLLOWING ADDITIONAL WORD IS PRESENT:  
* 
*         VFD    12/0,24/K,24/C 
* 
*         K = INCREMENT IN BITS BETWEEN FIRST BIT OF REPLICATED TEXT. 
*         C = REPLICATION COUNT.
* 
*             PROCESSING OF *PTEXT* CONSISTS OF:  
* 
* 
*         1)   THE TABLE LENGTH AND CONDITIONAL INDICATOR ARE SAVED.
* 
  
  
 PTEXT    ZR     B7,RDR1     IF ZERO LENGTH TABLE 
          MX6    -9 
          AX5    12 
          SX7    B7 
          BX6    -X6*X5      EXTRACT CONDITIONAL INDICATOR
          SA7    PTXTLTH     SAVE WORD COUNT
          SA6    PTXTCR 
  
**        2)   *PFE* IS CALLED TO EXTRACT THE NECESSARY FIELDS FROM 
*              THE *PTEXT* HEADER WORDS AND THE TEXT STREAM IS READ 
*              INTO *TSCR*. 
* 
  
 PTEXT1   READO  L
          BX5    X6 
          AX6    35 
          SX1    B1 
          BX6    X1*X6       EXTRACT REPLICATION INDICATOR
          SB2    X6+B1       ACCOUNT FOR HEADER WORD
          ZR     X6,PTEXT3   IF NOT REPLICATED
          READO  L
 PTEXT3   RJ     PFE         PTEXT FIELD EXTRACTION 
          SX6    X1+B2       ADD REPLICATION WORD IF PRESENT
          SA3    PTXTLTH
          IX6    X3-X6
          SA2    TSCR 
          SA6    A3          REMAINING TABLE LENGTH 
          SX5    L
          RJ     ATS=        ALLOCATE TABLE SPACE 
          SB6    X2 
          READW  X5,B6,X1 
  
**        3)   THE CONDITIONAL INDICATOR IS CHECKED AND THE TABLE IS
*              SKIPPED IF NECESSARY.
* 
  
          SA2    TRLB 
          SA4    PTXTCR 
          SB5    A0          (B5) = RELOCATION BASE 
          SB2    X2          (B2) = FWA *TRLB*
          ZR     X4,PTEXT5   IF NOT CONDITIONAL 
          SB6    X4 
          NE     B5,B6,PTEXT5  IF *CR* NOT SAME AS *RB* 
          SA3    PI 
          SB3    X3          (B3) = PROGRAM INDEX 
          SA1    B2+B5       *TRLB* ENTRY 
          LX1    24 
          SB4    X1          (B4) = *TBLK* INDEX
  
 SEG      IFCARD
          SA2    SEGFLAG
          ZR     X2,PTEXT4   IF NOT SEGMENT LOAD
          SA1    TBLK 
          MX3    -11
          SA2    X1+B4       *TBLK* DEFINITION
          SX1    B1 
          LX2    12 
          BX3    -X3*X2 
          IX3    X3-X1
          NZ     X3,PTEXT19  IF DEFINED EARLIER 
          SA1    B2+X4       *TRLB* ENTRY 
          LX1    36 
          MI     X1,PTEXT19  IF OUTSIDE SEGMENT 
          EQ     PTEXT5 
  
 PTEXT4   BSS    0
 SEG      ENDIF 
  
          LT     B4,B3,PTEXT19  IF DECLARED EARLIER 
  
**        4)   CHECKS ARE MADE FOR THE FOLLOWING POSSIBLE ERRORS
*              A)  TRIED TO LOAD INTO ABS BLOCK (NE4341). 
*              B)  TRIED TO LOAD INTO BLOCK BELOW ORIGIN (NE4340).
*              C)  TRIED TO LOAD INTO BLOCK OUTSIDE SEGMENT (NE4422). 
* 
  
 PTEXT5   BSS    0
          NZ     B5,PTEXT6   IF NOT ABS BLOCK 
          ERROR  4341        ----TRIED TO LOAD INTO ABS BLOCK 
          EQ     PTEXT19     SKIP TABLE 
  
 PTEXT6   SA1    B2+B5
          BX5    X1          (X5) = *TRLB* ENTRY
          LX1    36 
          PL     X1,PTEXT8   IF WITHIN LOADABLE AREA
          SA2    TBLK 
          AX1    12 
          SX1    X1          (X1) = *TBLK* INDEX
          SA5    PN          CURRENT PROGRAM NAME 
          IX1    X1+X2
          R=     A1,X1-1     GET NAME 
          BX7    X5 
          SA2    LASTORGM    LAST PROGRAM NAME
          SA7    A2 
          BX5    X7-X2       COMPARE NAMES
          BX7    X1 
          SA2    LASTORGL    GET LAST BLOCK ID
          SA7    A2 
          BX2    X2-X1
          BX2    X5+X2
          ZR     X2,PTEXT19  IF NAME AND BLOCK SAME AS LAST TIME
          MX7    42 
          BX7    X7*X1
  
 SEG      IFCARD
          SA1    SEGFLAG
          ZR     X1,PTEXT7   IF NOT SEGMENT LOAD
          SA1    SI 
          BX7    X7+X1
          ERROR  4422,X7     ----TRIED TO LOAD INTO BLOCK OUTSIDE SEG 
          EQ     PTEXT19     SKIP TABLE 
  
 PTEXT7   BSS    0
 SEG      ENDIF 
  
          ERROR  4340,X7     ----TRIED TO LOAD INTO BLOCK BELOW ORIGIN
          EQ     PTEXT19     SKIP TABLE 
  
**        5)   IT IS POSSIBLE THAT THE TEXT LWA WILL EXCEED THE AMOUNT
*              OF SPACE IN *TPGM*.  IF NECESSARY, ADDITIONAL SPACE IS 
*              ALLOCATED AND THE LENGTH IN THE CORRESPONDING *TBLK* 
*              ENTRY IS UPDATED.  ECS SPACE MUST HAVE ALREADY BEEN
*              ALLOCATED. 
* 
  
 PTEXT8   MX0    -24
          SA4    PTXTFWA
          BX2    -X0*X5      (X2) = FWA OF BLOCK
          IX7    X2+X4
          SA3    PTXTLWA
          SA7    A4          ABSOLUTE ADDRESS OF FIRST WORD 
          IFTEST NE,IP.MECS,0,3 
          SB3    B1          (B3) = 1 FOR ECS BLOCK 
          MI     X5,PTEXT9   IF ECS TEXT
          SB3    B0          (B3) = 0 FOR CM BLOCK
          SA4    PA          CURRENT LWA+1 OF RELOCATABLE TEXT
          SA1    PO          PROGRAM ORIGIN (FWA OF LOADABLE AREA)
          IX6    X2+X3       (X6) = LWA OF *PTEXT* BLOCK LOAD AREA
          SA3    BI          BINARY INDEX IN *TPGM* 
          IX1    X4-X1
          IX4    X1+X3       PA-PO+BI 
          IX6    X4-X6
          PL     X6,PTEXT9   IF ALL TEXT WITHIN LOAD
          MX2    0           CM INDICATOR FOR *APS* 
          BX1    -X6         SPACE NEEDED TO ADD
          RJ     APS=        ALLOCATE MORE PROGRAM SPACE
          SA1    PI          PROGRAM INDEX IN *TBLK*
          SA2    TBLK 
          SA4    PA          NEW *PA* 
          SB2    X1+B1
          SA2    X2+B2
          BX7    -X0*X2      BLOCK FWA
          LX0    24 
          IX1    X4-X7       ADD NEW LENGTH 
          BX6    X0*X2
          LX1    24 
          BX6    X6+X1
          SA6    A2 
  
**        6)   THE PARTIAL TEXT IS INSERTED INTO THE DESIGNATED BLOCK 
*              STARTING AT *FWA*.  THE TEXT STREAM OF BIT LENGTH *TLB*
*              IS INSERTED INTO THE BLOCK STARTING AT BIT *FB* OF THE 
*              FIRST WORD.  ANY BITS IN THE BLOCK NOT BETWEEN *FB* AND
*              *FB*+*TLB* ARE PRESERVED.
* 
  
 PTEXT9   SA1    TSCR 
          SA2    PTXTFB 
          SB2    X1          (B2) = FWA *TSCR*
          SB4    X2          (B4) = FB (FIRST BIT)
          MX0    1
          SB5    X2+B1       (B5) = FB+1
          R=     B6,60
          AX0    X0,B4
          SB6    B6-B5       (B6) = 59-FB 
          SA1    PTXTTLB
          LX0    X0,B5       (X0) = MASK OF LOWER BITS
          BX7    X1          (X7) = TEXT LENGTH IN BITS 
          SA2    PTXTFWA     FWA
  
 ECS      IFTEST NE,IP.MECS,0 
          ZR     B3,PTEXT10  IF CM BLOCK
          RJ     RE=
          BX5    X1          (X5) = WORD TO BE FILLED 
          EQ     PTEXT11
  
 PTEXT10  BSS    0
 ECS      ENDIF 
  
          SA1    TPGM 
          IX2    X2+X1       (X2) = CM ADDRESS
          SA5    X2          (X5) = WORD TO BE FILLED 
  
*         PERFORM PARTIAL TEXT INSERTION AND RESTORE WORD.
  
 PTEXT11  SA1    B2          GET WORD FROM  *TSCR*
          SB2    B2+B1
          SX3    B5 
          IX4    X3-X7
          LX6    X1,B5
          PL     X4,PTEXT15  IF FILL COMPLETES WITH THIS WORD 
          BX7    -X4         REMAINING TEXT LENGTH IN BITS
          BX3    X0*X6       CLEAR BITS NOT TO BE USED AS FILL
          BX4    -X0*X5      CLEAR BITS TO BE PARTIALLY FILLED
          BX5    -X0*X6      SAVE BITS WHICH OVERFLOW TO NEXT WORD
          BX6    X3+X4       MERGE PARTIAL TEXT WITH OLD WORD 
  
 ECS      IFTEST NE,IP.MECS,0 
          ZR     B3,PTEXT12  IF CM TEXT 
          RJ     WE=         REWRITE PARTIALLY FILLED ECS WORD
          SX1    B1 
          IX2    X2+X1       INCREMENT ADDRESS
          RJ     RE=         GET NEXT WORD
          EQ     PTEXT13
  
 PTEXT12  BSS    0
 ECS      ENDIF 
  
          SA6    X2          REWRITE PARTIALLY FILLED CM WORD 
          SX2    X2+B1       INCREMENT ADDRESS
          SA1    X2          GET NEXT CM WORD 
          IFTEST NE,IP.MECS,0,1 
 PTEXT13  BSS    0
          SX3    B6 
          IX4    X3-X7
          PL     X4,PTEXT14  IF FILL COMPLETES WITH THIS WORD 
          BX7    -X4         REMAINING TEXT LENGTH IN BITS
          BX4    X0*X1       CLEAR BITS TO BE FILLED
          BX5    X4+X5       ADD IN PARTIAL TEXT
          EQ     PTEXT11
  
*         FILL LAST WORD OF PARTIAL TEXT. 
  
 PTEXT14  BX6    X5          (X6) = PARTIAL TEXT
          SB5    B0          SHIFT COUNT
          BX5    X1          (X5) = WORD TO FILL
 PTEXT15  MX3    1
          R=     B7,X7-1
          AX3    X3,B7
          LX3    X3,B5
          BX6    X3*X6       SAVE PARTIAL TEXT BITS 
          BX5    -X3*X5      CLEAR BITS TO BE FILLED
          BX6    X6+X5       MERGE IN PARTIAL TEXT
  
 ECS      IFTEST NE,IP.MECS,0 
          ZR     B3,PTEXT17  IF CM BLOCK
          RJ     WE=         REWRITE PARTIALLY FILLED ECS WORD
          EQ     PTEXT18
  
 PTEXT17  BSS    0
 ECS      ENDIF 
  
          SA6    X2          REWRITE PARTIALLY FILLED CM WORD 
          IFTEST NE,IP.MECS,0,1 
 PTEXT18  BSS    0
  
**        7)   IF THE TEXT IS REPLICATED, THE INCREMENT IN BITS IS
*              ADDED TO *FB* AND *FWA* AND STEP 6 IS REPEATED WITH
*              THE NEW *FB* AND *FWA*.  THIS PROCESS IS REPEATED UNTIL
*              THE REPLICATION COUNT IS SATISIFIED. 
* 
  
          SA1    PTXTC       REPLICATION COUNT
          SX2    B1 
          IX6    X1-X2
          SA6    A1          DECREMENT REPLICATION COUNT
          ZR     X6,PTEXT19  IF THROUGH REPLICATING 
          SX2    B4+B1       FB+1 
          SA3    PTXTK       INCREMENT IN BITS
          R=     X4,60
          IX2    X4-X2       60-(FB+1)
          IX1    X2+X3
          BX6    X1 
          IX3    X1/X4,B7 
          PX2    X3          IX2  X3*X4,B7
          NX2    X2 
          FX2    X2*X4
          UX2    X2,B7
          LX2    X2,B7
          IX1    X6-X2       REMAINDER
          R=     X0,59
          IX6    X0-X1
          SA6    PTXTFB      NEW FIRST BIT
          SA4    PTXTFWA
          IX6    X4+X3       NEW FWA
          SA6    A4 
          EQ     PTEXT9 
  
**        8)   *TSCR* IS CLEARED AND IF ANY MORE *PTEXT* GROUPS ARE 
*              PRESENT, STEPS 2-7 ARE REPEATED. 
* 
  
 PTEXT19  SA2    TSCR 
          RJ     CTAB=       CLEAR *TSCR* 
          SA2    PTXTLTH     LENGTH OF *PTEXT* TABLE
          NZ     X2,PTEXT1   IF MORE *PTEXT* WORDS
          EQ     RDR1        PROCESS NEXT TABLE 
          SPACE  1
 TEXT     TITLE  LOAD INPUT - TEXT AND XTEXT TABLES.
**        TEXT TABLE - RELOCATABLE TEXT.
* 
*         CODE = 40.
* 
*         CYBER LOADER TEXT TABLE PROCESSOR 
* 
* 
*              *TEXT* TABLES CONTAIN PROGRAM INSTRUCTIONS AND DATA
*         WITH THE NECESSARY RELOCATION INFORMATION.  THE ORIGIN
*         OF THE TABLE IS SPECIFIED IN THE CONTROL WORD FOR THE TABLE 
*         AS FOLLOWS:                                                          .
* 
*         VFD    12/4000B,12/WC,2/0,1/C,6/0,9/R,18/S
* 
*         WC = WORD COUNT OF TABLE. 
*         C  = CONDITIONAL INDICATOR.  THE TABLE IS TO BE IGNORED IF
*              *R* REFERS TO A COMMON BLOCK FIRST DECLARED BY AN
*              EARLIER SUBPROGRAM.
*         R  = RELOCATION BASE DESIGNATOR.
*         S  = RELATIVE LOAD ADDRESS. 
* 
* 
*              THE TABLE CONSISTS OF ONE OR MORE TEXT GROUPS, EACH OF 
*         WHICH, EXCEPT POSSIBLY THE LAST, IS 16 WORDS IN LENGTH. 
*         EACH TEXT GROUP IS OF THE FOLLOWING FORMAT:                          .
* 
*              WORD 1 OF THE GROUP IS PARTITIONED INTO 15 4-BIT BYTES 
*         WHICH SPECIFY THE RELOCATION OF THE REMAINING WORDS OF
*         THE GROUP.  EACH OF THE TEXT WORDS TO BE RELOCATED MAY REQUIRE
*         THE RELOCATION OF 1 OR 2 18-BIT ADDRESSES IN 3 POSSIBLE 
*         POSITIONS 
* 
*         VFD    12/0,18/UPPER,12/0,18/LOWER
*         VFD    27/0,18/MIDDLE,15/0
* 
*              ALL ADDRESSES IN THE *TEXT* TABLE ARE RELOCATED TO THE 
*         PROGRAM BLOCK.  (EQUIVALENT TO *RL* = 1)
* 
*              THE VALUE AND RELOCATION OF EACH BYTE IS AS FOLLOWS:            .
* 
*         BYTE   RELOCATION 
*         000X   NO RELOCATION
*         XX10   LOWER POSITIVE 
*         XX11   LOWER NEGATIVE 
*         010X   MIDDLE POSITIVE
*         011X   MIDDLE NEGATIVE
*         10XX   UPPER POSITIVE 
*         11XX   UPPER NEGATIVE 
* 
* 
*              *TEXT* TABLE PROCESSING:                                        .
* 
*              THE ONLY DIFFERENCE BETWEEN *XTEXT* AND *TEXT* TABLES
*         IS THE FORMAT OF THE TABLE HEADER WORD.  THE *XTEXT* TABLE
*         PROVIDES FOR A TEXT LOAD ADDRESS GREATER THAN 377777B.  AS
*         A RESULT, THE HEADER WORD IS CONVERTED TO THE *XTEXT* 
*         FORMAT AND THE *XTEXT* ROUTINE IS THEN ENTERED. 
  
 TEXT     MX1    -9          MOVE RELOCATION INDEX FROM 
          LX5    -18         BITS 18-26 TO BITS 24-32 
          MX2    -15
          BX3    -X1*X5 
          BX5    X2*X5
          LX3    6
          IX5    X3+X5
          LX5    18 
*         EQ   XTEXT               NOTE THAT *XTEXT* ROUTINE FOLLOWS
 XTEXT    SPACE  4,8
**        XTEXT TABLE - EXTENDED RELOCATABLE TEXT.
* 
*         CODE = 37.
* 
*         CYBER LOADER XTEXT TABLE PROCESSOR
* 
* 
*              THE *XTEXT* AND *TEXT* TABLES ARE OF IDENTICAL FORMAT, 
*         EXCEPT FOR THE HEADER WORD. 
* 
*         VFD    12/3700B,12/WC,2/0,1/C,9/R,24/S
* 
*         FIELDS ARE THE SAME AS FOR THE *TEXT* TABLE, EXCEPT THAT *S*
*         MAY BE AS LARGE AS 77777777B. 
* 
* 
*              THE FOLLOWING PROCEDURE IS IDENTICAL FOR BOTH *TEXT* AND 
*         *XTEXT* TABLES:                                                      .
* 
* 
*         1)   THE CONDITIONAL INDICATOR IS CHECKED AND THE TABLE IS
*              SKIPPED (VIA *SKT*) IF NECESSARY.
* 
  
 XTEXT    SA1    TRLB        (X1) = FWA RELOC BASE TABLE
          BX4    X5          CONDITIONAL BIT TO SIGN POSITION 
          SX6    B7          SAVE TABLE LENGTH
          MX7    -9 
          LX4    59-33
          ZR     B7,RDR1     IGNORE ANY ZERO-LENGTH TABLE 
          SA6    TXTLTH 
          PL     X4,TXT1     IF NOT A CONDITIONAL TABLE 
          SA3    PI          (B3) = PROGRAM INDEX 
          LX4    33-59-24    (B2) = RELOCATION INDEX
          BX4    -X7*X4 
          SB3    X3 
          SB2    X4 
          SA2    X1+B2       (B4) = *TBLK* INDEX OF ENTRY 
          LX2    24 
          SB4    X2 
          IFCARD 2
          SA1    SEGFLAG
          NZ     X1,TXT0     IF SEGMENT LOAD
          LT     B4,B3,SKT   IF TABLE TO BE SKIPPED 
 SEG      IFCARD
          EQ     TXT1 
  
 TXT0     SA1    TBLK 
          MX3    -11
          SA1    X1+B4       *TBLK* DEFINITION
          SX2    B1 
          LX1    12 
          BX3    -X3*X1 
          IX2    X3-X2
          NZ     X2,SKT      IF TABLE IS TO BE SKIPPED
          SA2    A2          GET *TRLB* ENTRY 
          LX2    36 
          MI     X2,SKT      IF OUTSIDE SEGMENT 
 SEG      ENDIF 
 TXT1     SA1    TRLB        (X1) = FWA RELOC BASE TABLE
          SX0    B7          TEXT LENGTH = 15*WC/16 
          MX4    -24
          SX7    B7 
          LX0    4           16*WC
          SB2    X1 
          MX2    -9          EXTRACT RELOCATION INDEX 
          IX0    X0-X7       15*WC
          BX6    -X4*X5 
          LX5    -24
          BX3    -X2*X5      (X3) = RELOCATION INDEX
          SA1    B2+X3       SET BLOCK LOAD ADDRESS 
          AX0    4           15*WC/16 
  
*         FOR USER CALLS, CHECK THAT THE TABLE IS REFERENCING A 
*         BLOCK WITHIN THE LOADABLE AREA.  IF NOT, GET BLOCK ADDRESS
*         FROM *TBLK*.
  
 IU       IFUSER
          BX7    X1 
          LX7    59-23       NG IF BLOCK ADDRESS BELOW *PO* 
          SA7    T1          SAVE FLAG
          IFTEST NE,IP.MECS,0,1 
          NG     X1,TXT1J    IF ECS BLOCK 
          SA2    TBLK 
          PL     X7,TXT1J    IF BLOCK WITHIN THIS LOAD
          LX1    -36         (B2) = *TBLK* INDEX
          SB2    X1 
          SA2    B2+X2       (X1) = BLOCK ADR BELOW LOADABLE AREA 
          MX7    42 
          SX1    X2 
          SA2    A2-B1       SAVE BLOCK NAME FOR ERROR MESSAGE
          BX7    X7*X2
          SA7    NEWORGL
 TXT1J    BSS    0
 IU       ENDIF 
  
          BX7    X1          SAVE *TRLB* ENTRY
          SA7    TXTRLB 
          BX7    -X4*X1 
          IX2    X7+X6       RELOCATE ADDRESS 
          BX6    X2          SAVE TEXT FWA
          IX7    X2+X0       TEXT LWA+1 
          SA6    TXTFWA 
          IFCARD 2
          LX1    36 
          MI     X1,TXT1X    IF TRYING TO LOAD BELOW OVLY ORIGIN
  
**        2)   IF THE TEXT IS ABSOLUTE (I.E. RELATIVE TO RA), SPACE 
*              IN *TPGM* IS ALLOCATED, IF NECESSARY.  NOTE THAT SUCH
*              TEXT HAS NO CORRESPONDING BLOCK DEFINITION IN *PIDL* 
*              TABLES.  THE POINTER *ABSMAX* IS USED TO KEEP TRACK OF 
*              THE HIGHEST LOCATION +1 IN WHICH ABSOLUTE TEXT HAS BEEN
*              LOADED.  ALSO NOTE THAT THE USER IS RESPONSIBLE FOR THE
*              CONSEQUENCES OF ANY TEXT LOADED ABOVE RA+100B IN THAT
*              THE LOADER PLACES IT WHERE SPECIFIED, BUT MAKES NO 
*              ATTEMPT TO LET IT AFFECT THE LOADING OF NORMAL 
*              RELOCATABLE TEXT.
* 
  
          NZ     X3,TXT1B    IF NOT ABSOLUTE TEXT 
  
 IC       IFCARD
          SA4    OG 
          ZR     X4,TXT1Z    IF NOT OVERLAY/CAPSULE/OVCAP GENERATION
          ERROR  4341        NE4341  TRIED TO LOAD INTO ABS BLOCK 
          EQ     SKT         SKIP TABLE 
  
 TXT1X    AX1    12 
          SA2    TBLK 
          SX1    X1 
          IX1    X1+X2
          R=     A1,X1-1     GET NAME 
          SA5    PN          GET CURRENT PROGRAM NAME 
          SA2    LASTORGM    GET LAST PROGRAM NAME
          BX7    X5 
          SA7    A2 
          BX5    X7-X2       SEE IF CURRENT PROGRAM NAME SAME AS LAST 
          BX7    X1 
          SA2    LASTORGL    GET LAST BLOCK ID
          SA7    A2 
          BX2    X2-X1       SEE IF CURRENT BLOCK  SAME AS LAST 
          BX2    X5+X2
          ZR     X2,TXT1Y    IF PROGRAM AND BLOCK SAME AS LAST TIME 
          MX7    42 
          BX7    X7*X1
          SA1    SEGFLAG
          NZ     X1,TXT1Y1   IF SEGMENT LOAD
          ERROR  4340,X7     NE4340  TRIED TO LOAD INTO BLOCK BELOW ORGN
 TXT1Y    EQ     SKT
  
 TXT1Y1   SA1    SI 
          BX7    X7+X1
          ERROR  4422,X7     ---- TRIED TO LOAD INTO BLOCK OUTSIDE SEG. 
          EQ     TXT1Y
  
 TXT1Z    BSS    0
 IC       ENDIF 
  
*         FOR USER CALL LOADS, THE TEXT FWA OF ABSOLUTE DATA MUST 
*         BE ADJUSTED DOWNWARD BY THE DIFFERENCE OF 
*         (FWA LOAD) - (LWA COMMUNICATION AREA), BECAUSE THIS 
*         MANY WORDS ARE NOT ALLOCATED SPACE IN *TPGM*.  ALSO,
*         THIS MUST BE DONE ONLY IF THE TEXT IS TO GO 
*         ABOVE THE COMMUNICATION AREA. 
  
 IU       IFUSER
          SX1    BASE-COMLTH  SPACE NOT IN *TPGM* 
          R=     X4,X6-COMLTH 
          MI     X4,TXT1E    IF ABS TEXT WITHIN COMMUNICATIONS AREA 
          IX6    X6-X1       ADJUST TEXT FWA DOWNWARD 
          SA6    A6 
 TXT1E    BSS    0
 IU       ENDIF 
  
          SA4    ABSMAX 
          IX6    X4-X7
          PL     X6,TXT1C    IF THIS MUCH PROGRAM SPACE 
                                    ALREADY ALLOCATED 
          SA1    PA 
          SA7    A4          ADVANCE *ABSMAX* 
          IX3    X1-X4       (X1) = MAX(ABSMAX,PA)
          PL     X3,TXT1A 
          BX1    X4 
 TXT1A    IX1    X7-X1       LWA - MAX(ABSMAX,PA) 
          NG     X1,TXT1C    IF NOTHING TO ALLOCATE (*PA* LARGER) 
          ALLOC  TPGM,X1     ALLOCATE SPACE 
          BX2    X3          (X2) = FWA OF NEW SPACE
          IX3    X3+X1       (X3) = LWA+1 OF NEW SPACE
          IX4    X6-X1
          RJ     PSM         PRESET NEW SPACE 
          EQ     TXT1C
  
**        3)   IF THE TEXT IS NOT ABSOLUTE, IT IS ALSO POSSIBLE FOR THE 
*              TEXT LWA TO EXCEED THE AMOUNT OF SPACE IN *TPGM*.  THIS
*              WILL HAPPEN WHILE LOADING PROGRAMS WITH A ZERO-LENGTH
*              SPECIFIED IN THE *PIDL* TABLE.  THE DIFFERENCE IS NOW
*              ALLOCATED AND ALSO ADDED TO THE PROGRAM LENGTH AS
*              CURRENTLY SPECIFIED IN *TBLK*. NOTE THAT THE LENGTH OF 
*              THE ACTUAL TEXT IN THE TABLE IS COMPUTED AS 15*N/16, 
*              WHERE N IS THE WORD COUNT OF THE TABLE, SINCE THERE IS 
*              ONE CONTROL WORD FOR EVERY 15 TEXT WORDS.
* 
  
 TXT1B    BSS    0
 IU       IFUSER
          SA1    T1          PICK UP *ADDRESS < FWA* FLAG 
          MI     X1,TXT1C    IF LOADING BELOW FWA 
 IU       ENDIF 
          SA5    PA          CURRENT END OF LOAD (EXCEPT ABS) 
          SA1    PO 
          SA3    BI 
          IX1    X5-X1
          IX5    X1+X3       PA-PO+BI 
          MX2    0           CM INDICATOR FOR *APS* 
          IX6    X5-X7
          PL     X6,TXT1C    IF ALL TEXT WITHIN LOAD
          SA1    TXTRLB 
          MI     X1,TXT1C    IF TEXT GOES IN ECS
          MX0    -24
          BX1    -X6         SPACE NEEDED TO ADD
          RJ     APS=        ALLOCATE PROGRAM SPACE 
          SA1    PI          PROGRAM INDEX IN *TBLK*
          SA2    TBLK        (X2) = *TBLK* DEFINITION 
          SA5    A5          NEW *PA* 
          SB2    X1+B1
          SA2    X2+B2
          BX7    -X0*X2      BLOCK FWA
          LX0    24          REMOVE OLD LENGTH
          IX1    X5-X7       ADD NEW LENGTH 
          BX6    X0*X2
          LX1    24 
          BX6    X6+X1
          SA6    A2 
  
**        4)   THIS POINT IS THE BEGINNING OF THE LOOP FOR EACH OF THE
*              TEXT GROUPS IN THE TABLE.
* 
  
 TXT1C    SA4    TXTLTH      REMAINING LENGTH OF TABLE
          R=     X5,16       MAXIMUM TEXT GROUP SIZE
          MX3    -1 
          SB7    B1          FOR *SKT*
          IX6    X4+X3       (REMAINING LENGTH) - 1 
          SA2    A4+B1       (X2) = CURRENT BLOCK LOAD ADDRESS
          IFUSER 1
          NG     X6,TXT5     IF TABLE ALL DONE
          IFCARD 1
          NG     X6,RDR1     IF TABLE ALL DONE
          ZR     X6,SKT      IF REMAINING LENGTH = 1
          SA1    A2+B1       (X1) = *TRLB* ENTRY
          IX6    X4-X5       UPDATE REMAINING LENGTH
          MX7    -4          ADVANCE LOAD ADDRESS BY 15 
          SB7    X4          (B7) = LENGTH OF NEXT GROUP
          SA6    A4 
          IX7    X2-X7
          NG     X6,TXT1D    IF LAST GROUP
          SB7    X5          SET GROUP MAXIMUM SIZE 
          SA7    A2 
 TXT1D    SX0    B7-B1       (X0) = LENGTH OF TEXT THIS GROUP 
  
**        5)   THE TEXT BLOCK IS READ.  IF CM TEXT, IT IS READ DIRECTLY 
*              TO ITS PROPER PLACE IN THE CORE IMAGE IN *TPGM*.  IF ECS 
*              TEXT, IT IS READ INTO A HOLD AREA IN ORDER THAT IT MAY 
*              BE PROCESSED BY THE SAME TEXT RELOCATION ROUTINE AS FOR
*              CM TEXT.  LATER, IT IS MOVED TO ECS. 
* 
  
 ECS      IFTEST NE,IP.MECS,0 
          MX6    0           FLAG FOR CM TEXT 
          SA6    TXTECS 
          PL     X1,TXT2     IF CM TEXT 
          BX3    X0          SET ECS FLAG 
          LX3    36          = VFD  24/(-LENGTH),36/(-ECS ADR)
          BX6    -X3-X2 
          SX5    TXTBUF      SET TO READ INTO ECS TEXT BUFFER            LDR0194
          SA6    A6 
          EQ     TXT3 
  
 ECS      ENDIF 
  
 TXT2     SA3    TPGM 
          SB3    X3          FWA *TPGM* 
          SX5    B3+X2       (X5) = FWA TEXT
          IFUSER 3
          SA4    NEWORGL
          ZR     X4,TXT3     IF TEXT WITHIN LOADABLE AREA 
          SX5    X2          ADDRESS NOT RELATIVE TO *TPGM* 
 TXT3     SA5    X5          (A5) = FWA OF DESTINATION FOR TEXT          LDR0194
          READO  L           READ RELOCATION WORD                        LDR0194
          BX5    X6          SAVE RELOCATION WORD                        LDR0194
          READW  L,A5,X0     READ TEXT BLOCK                             LDR0194
  
**        6)   INITIALIZATION IS PERFORMED FOR THE TEXT RELOCATION LOOP 
*              WHICH FOLLOWS. 
*              IF CAPSULE/OVCAP GENERATION THEN CALLS */LOADG/TXTREL* 
*              TO MAINTAIN RELOCATION INDICATORS IN *TCPREL*. 
* 
  
          SB7    X0          (B7) = WORD COUNT
 IC       IFCARD
          SA1    OG 
          ZR     X1,TXT3B    IF NOT CAPSULE/OVCAP GENERATION
          R=     X1,X1-1
          ZR     X1,TXT3B    IF NOT CAPSULE/OVCAP GENERATION
 ECS      IFTEST NE,IP.MECS,0 
          SA1    TXTECS 
          ZR     X1,TXT3A    IF NOT ECS TEXT
          ERROR  503         ---- ECS TEXT DISALLOWED IN CAPSULES 
          SA1    TXTLTH 
          SB7    X1          (B7) = REMAINING LENGTH OF TABLE 
          EQ     SKT         SKIP TABLE 
  
 ECS      ENDIF 
 TXT3A    RJ     /LOADG/TXTREL  GO TO MAINTAIN *TCPREL* 
 TXT3B    BSS    0
 IC       ENDIF 
          BX1    X5          (X1) = CONTROL WORD                         LDR0194
          MX0    -4          BYTE MASK
          SB4    TXTA        (B4) = RELOCATION ADDRESSES
          SB3    TXTB        (B3) = ADDRESS MASKS 
          LX1    4           SHIFT TO FIRST BYTE
          BX4    -X0*X1      FIRST CONTROL BYTE 
          LD     B5,4        (B5) = BYTE SHIFT
          SA5    A5          READ FIRST TEXT WORD                        LDR0194
          SA3    B3+X4       FIRST ADDRESS MASK WORD
          R=     B2,18       (B2) = CARRY SHIFT 
          LX1    4           SHIFT TO NEXT CONTROL BYTE 
          SA4    B4+X4       FIRST RELOCATION WORD
          BX7    -X5*X3      EXTRACT COMPLEMENT ADDRESS FIELDS
          IX2    X7+X4       ADD COMPLEMENT ADDRESSES 
  
**        7)   THE TEXT RELOCATION LOOP IS PERFORMED BY THE FOLLOWING 
*              STEPS:                                                          .
* 
*              A) COMPLEMENT ADDRESSES.   -A
*              B) ADD TO RELOCATE.        -A+(-R) = -(A+R)
*              C) COMPLEMENT RESULT.      A+R 
*              D) MERGE RELOCATED ADDRESSES WITH TEXT WORD. 
* 
  
 TXT4     BX5    -X3*X5      REMOVE ADDRESSES FROM TEXT 
          SB7    B7-B1       DECREMENT WORD COUNT 
          BX4    -X3*X2      EXTRACT CARRYS 
          AX7    X4,B2
          IX2    X2+X7       ADD CARRYS 
          BX4    -X0*X1      NEXT RELOCATION BYTE 
          LX1    X1,B5       SHIFT CONTROL WORD 
          BX7    -X2*X3      MASK AND COMPLEMENT ADDRESSES
          SA3    B3+X4       NEXT ADDRESS MASK WORD 
          BX6    X7+X5       INSERT RELOCATED ADDRESSES 
          SA4    B4+X4       NEXT RELOCATION WORD 
          SA5    A5+B1       NEXT TEXT WORD 
          BX7    -X5*X3      EXTRACT COMPLEMENT ADDRESS FIELDS
          IX2    X7+X4       ADD COMPLEMENT ADDRESSES 
          SA6    A5-B1       STORE RELOCATED TEXT WORD                   LDR0194
          NZ     B7,TXT4     LOOP FOR ALL TEXT WORDS
  
**        8)   IF ECS TEXT, IT IS MOVED FROM THE HOLD AREA TO ITS 
*              POSITION IN ECS. 
* 
  
 ECS      IFTEST NE,IP.MECS,0 
          SA3    TXTECS 
          PL     X3,TXT1C    IF NOT ECS TEXT
          MX4    -24         (X1) = ECS LOAD ADDRESS
          BX3    -X3
          SX2    TXTBUF      (X2) = CM ADDRESS                           LDR0194
          BX1    -X4*X3 
          LX3    24          (B2) = WORD COUNT
          SB2    X3 
          RJ     WEW=        WRITE TEXT TO ECS
 ECS      ENDIF 
  
          EQ     TXT1C       LOOP FOR NEXT TEXT GROUP 
  
**        9)   FOR USER CALL LOADS, A NON-FATAL ERROR IS ISSUED IF THE
*              TEXT WAS PART OF A BLOCK BELOW THE LOADABLE AREA, I.E.,
*              FOR A COMMON BLOCK INITIALLY DECLARED IN AN EARLIER LOAD.
* 
  
 IU       IFUSER
 TXT5     SA1    NEWORGL     CHECK IF THIS *TEXT* TABLE WAS FOR 
          MX6    0           BELOW FWA OF LOADABLE AREA 
          BX7    X1 
          SA6    A1          CLEAR INDICATOR FOR NEXT TIME
          SA2    A1-B1       LAST BLOCK NAME IN WHICH ERROR ISSUED
          ZR     X1,RDR1     IF ERROR DID NOT OCCUR 
          IX3    X7-X2
          SA7    A2          SAVE CURRENT NAME
          ZR     X3,RDR1     IF SAME BLOCK AS LAST ISSUE
          ERROR  4340,X7     ---- TEXT LOADED BELOW FWA LOADABLE AREA 
          EQ     RDR1        NEXT TABLE 
  
 IU       ENDIF 
  
  
  
**             *TXTA* IS THE TABLE USED BY THE TEXT PROCESSOR TO
*         RELOCATE ADDRESSES.  IT CONTAINS COMPLEMENT RELOCATION
*         ADDRESSES AND IS INDEXED BY THE RELOCATION CONTROL BYTES FROM 
*         THE FIRST WORD OF THE *TEXT* OR *XTEXT* TABLES.  IT IS
*         GENERATED DURING *PIDL* TABLE PROCESSING. 
  
****
  
 TXTA     BSS    0
          LOC    0
  
          VFD    60/0 
          VFD    60/0 
          VFD    42/0,18/-BASE
          VFD    42/0,18/+BASE
  
          VFD    27/0,18/-BASE,15/0 
          VFD    27/0,18/-BASE,15/0 
          VFD    27/0,18/+BASE,15/0 
          VFD    27/0,18/+BASE,15/0 
  
          VFD    12/0,18/-BASE,30/0 
          VFD    12/0,18/-BASE,30/0 
          VFD    12/0,18/-BASE,12/0,18/-BASE
          VFD    12/0,18/-BASE,12/0,18/+BASE
  
          VFD    12/0,18/+BASE,30/0 
          VFD    12/0,18/+BASE,30/0 
          VFD    12/0,18/+BASE,12/0,18/-BASE
          VFD    12/0,18/+BASE,12/0,18/+BASE
  
          LOC    *O 
  
****
  
  
*         TXTB - TABLE OF ADDRESS MASKS.
*         INDEXED BY RELOCATION CONTROL BYTES.
  
  
          IFTEST NE,IP.MECS,0,1 
 TXTECS   CON    0           ECS TEXT FLAG
          IFTEST EQ,IP.MECS,0,1 
          BSS    1           (AVOID BANK CONFLICTS) 
 TXTB     BSS    0
          LOC    0
  
          VFD    60/0 
          VFD    60/0 
          VFD    42/0,18/-0 
          VFD    42/0,18/-0 
  
          VFD    27/0,18/-0,15/0
          VFD    27/0,18/-0,15/0
          VFD    27/0,18/-0,15/0
          VFD    27/0,18/-0,15/0
  
          VFD    12/0,18/-0,30/0
          VFD    12/0,18/-0,30/0
          VFD    12/0,18/-0,12/0,18/-0
          VFD    12/0,18/-0,12/0,18/-0
  
          VFD    12/0,18/-0,30/0
          VFD    12/0,18/-0,30/0
          VFD    12/0,18/-0,12/0,18/-0
          VFD    12/0,18/-0,12/0,18/-0
  
          LOC    *O 
  
*         TEMPORARY STORAGE USED DURING *TEXT* PROCESSING.  THE 
*         ORDER OF ALL OF THESE LOCATIONS MUST NOT BE CHANGED.
  
 TXTLTH   CON    0           REMAINING LENGTH OF *TEXT* TO PROCESS
 TXTFWA   CON    0           CURRENT TEXT LOAD FWA
 TXTRLB   CON    0           *TRLB* ENTRY 
          IFTEST NE,IP.MECS,0,1 
 TXTBUF   BSSZ   17B         BUFFER FOR ECS TEXT RELOCATION              LDR0194
 LASTORGL CON    0           TBLK ENTRY FOR LAST BLOCK IN NE4340(FE0450)
 LASTORGM CON    0           NAME OF LAST PROGRAM IN NE4340 (FE0450)
          IFUSER 1
 NEWORGL  CON    0           NZ IF ERROR 4340 FOR THIS TABLE
 FILL     TITLE  LOAD INPUT - FILL TABLE. 
**        FILL TABLE - RELOCATION FILL. 
* 
*         CODE = 42.
* 
*         CYBER LOADER FILL TABLE PROCESSOR 
* 
* 
*              *FILL* TABLES SPECIFY THE RELOCATION OF ADDRESSES IN 
*         THE PROGRAM WHICH ARE RELATIVE TO COMMON BLOCKS.
*         ALL RELOCATION BY *FILL* TABLES IS PERFORMED AFTER THE LOADING
*         IS COMPLETE TO ALLOW THE DEFINITION OF BLANK COMMON.
* 
*              THE *FILL* TABLE IS PARTITIONED INTO 30-BIT BYTES
*         CONSISTING OF A CONTROL BYTE FOLLOWED BY RELOCATION BYTES.
*         THE SERIES OF RELOCATION BYTES ARE TERMINATED BY ANOTHER
*         CONTROL BYTE OR A ZERO BYTE.
* 
*         CONTROL BYTE:                                                        .
* 
*         VFD    1/0,20/0,9/R 
* 
*         R = RELOCATION OF ADDRESSES SPECIFIED IN FOLLOWING RELOCATION 
*             BYTES.
* 
*         RELOCATION BYTE 
* 
*         VFD    1/1,2/P,9/BR,18/A
* 
*         A  = RELATIVE ADDRESS OF TEXT WORD. 
*         BR = RELOCATION OF *A* (MAY NOT EQUAL 2 OR REFER TO BLANK 
*              COMMON). 
*         P  = POSITION OF ADDRESS IN WORD SPECIFIED BY *A*, AS FOLLOWS 
* 
*                P           POSITION 
*                10          UPPER
*                01          MIDDLE 
*                00          LOWER
*                11          UNDEFINED
* 
* 
*              PROCESSING CONSISTS OF ADDING THE TABLE TO THE FILL BYTE 
*         CHAIN IN THE TABLE *TFBC* 
* 
*         1)   THE SUBROUTINE *CKC* IS CALLED TO CHECK IF THE TABLE IS
*              A CONDITIONAL TABLE.  NOTE THAT FOR EVERY TABLE PROCESSOR
*              WHICH CALLS *CKC*, THAT TABLE HAS A CONDITIONAL INDICATOR
*              IN BITS 12-20 OF THE HEADER WORD.
* 
  
 FILL     ZR     B7,RDR1     IGNORE ANY ZERO-LENGTH TABLE 
          RJ     CKC         CHECK IF CONDITIONAL TABLE 
  
**        2)   SPACE FOR THE TABLE IS ALLOCATED IN *TFBC*, AND THE TABLE
*              IS READ THERE. 
* 
  
          MX0    -9          (X0) = RELOCATION BLOCK MASK 
          ALLOC  TFBC,B7     ALLOCATE FILL BYTE CHAIN 
          BX5    X3          CURRENT STORE ADDRESS
          SA0    X1          SAVE WORD COUNT
          READW  L,X5,X1     READ FILL TABLE
  
**        3)   THE ADDRESSES IN THE RELOCATION BYTES ARE RELOCATED. 
* 
  
          SB7    A0          (B7) = WORD COUNT
          SA1    TRLB        (B6) = FWA RELOCATION BASE TABLE 
          SA5    X5          FIRST WORD 
          SB6    X1 
          SA4    TBLK        (B5) = FWA *TBLK*
          SB5    X4 
 FLL1     SA3    FLLA        SIGN BIT MASK
          SA4    A3+B1       CONTROL BIT MASK 
          BX6    X3*X5       CHECK BOTH SIGN BITS 
          IX7    X6-X3
          NZ     X7,FLL3     IF BOTH BYTES NOT RELOCATION 
          BX4    X4*X5       EXTRACT CONTROL BITS 
          SX6    X5          EXTRACT LOWER ADDRESS
          LX5    -18         EXTRACT RELOCATION INDEX 
          BX2    -X0*X5 
          MX7    -24         ADDRESS MASK 
          SA1    B6+X2       SET BLOCK LOAD ADDRESS 
          LX5    -12
          BX2    -X7*X1 
  
          BX7    X3*X1       CM/ECS BIT 
          LX1    59-23
          PL     X1,FLL1A    IF BLOCK IN LOAD 
          LX1    23-59-36+60 *TBLK* INDEX IN *TRLB* ENTRY 
          SA2    B5+X1       (X2) = BLOCK ADDRESS 
          MX1    1           BIT 25 TO SHOW BELOW LOADABLE AREA 
          SX2    X2 
          LX1    25-59
          BX2    X2+X1
 FLL1A    LX7    26-59       ADD CM/ECS BIT 
          IX6    X2+X6       RELOCATE LOWER ADDRESS 
          BX6    X6+X7
          MX7    -24         RESTORE X7 
          BX4    X4+X6       MERGE CONTROL BITS AND LOWER ADDRESS 
          SX6    X5          EXTRACT UPPER ADDRESS
          LX5    -18         EXTRACT RELOCATION INDEX 
          BX2    -X0*X5 
          SA1    B6+X2       SET BLOCK LOAD ADDRESS 
          BX2    -X7*X1 
  
          BX7    X3*X1       CM/ECS BIT 
          LX1    59-23
          PL     X1,FLL1B    IF BLOCK IN LOAD 
          LX1    23-59-36+60 *TBLK* INDEX IN *TRLB* ENTRY 
          SA2    B5+X1       (X2) = BLOCK ADDRESS 
          MX1    1           BIT 25 TO SHOW BELOW LOADABLE AREA 
          SX2    X2 
          LX1    25-59
          BX2    X2+X1
 FLL1B    LX7    26-59       ADD CM/ECS BIT 
          IX6    X2+X6       RELOCATE UPPER ADDRESS 
          BX6    X6+X7
          LX6    30          MERGE UPPER ADDRESS
          IX6    X4+X6
          SA6    A5          RESTORE WORD 
 FLL2     SB7    B7-B1       DECREMENT WORD COUNT 
          SA5    A5+B1       NEXT WORD
          NZ     B7,FLL1     IF NOT END OF TABLE
          EQ     RDR1        PROCESS NEXT TABLE 
  
**        4)   THE CONTROL BYTES ARE REPLACED WITH THE *TBLK* INDEX.
  
 FLL3     BX4    X4*X5       EXTRACT CONTROL BITS 
          LX4    30          POSITION LOWER BYTE FOR TEST 
          PL     X4,FLL4     IF LOWER BYTE POSITIVE 
          LX5    30          SHIFT UPPER
 FLL4     SA2    B6+X5       SET BLOCK NUMBER 
          LX5    12          EXTRACT RELOCATION INDEX 
          BX6    -X0*X5 
          AX2    36          ISOLATE BLOCK NUMBER 
          SA1    B6+X6       SET BLOCK LOAD ADDRESS 
          LX5    18          EXTRACT ADDRESS
          SX2    X2 
          MX7    -24
          BX3    X3*X1       CM/ECS BIT 
          SX6    X5          ADDRESS
          BX7    -X7*X1 
  
          LX1    59-23
          PL     X1,FLL4A    IF BLOCK IN LOAD 
          LX1    23-59-36+60 *TBLK* INDEX IN *TRLB* ENTRY 
          SA1    B5+X1       (X1) = BLOCK ADDRESS 
          MX7    1           BIT 25 TO SHOW BELOW LOADABLE AREA 
          SX1    X1 
          LX7    25-59
          BX7    X7+X1
 FLL4A    BSS    0
  
          LX3    17+9-59
          IX6    X6+X7       RELOCATE ADDRESS 
          LX2    30          POSITION BLOCK NUMBER
          BX6    X6+X3       MERGE CM/ECS BIT WITH ADDRESS
          BX2    X2+X6       MERGE ADDRESS AND BLOCK NUMBER 
          NG     X4,FLL5     IF LOWER BYTE NEGATIVE 
          LX2    30          RESTORE POSITION 
 FLL5     LX4    30          RESET X4 
          IX6    X4+X2       MERGE WITH CONTROL BITS
          SA6    A5          STORE WORD 
          EQ     FLL2 
  
          RELOC  OFF
 FLLA     VFD    1/1,29/0,1/1,29/0
          VFD    3/7,27/0,3/7,27/0
          RELOC  ON 
 XFILL    TITLE  LOAD INPUT - XFILL TABLE.
**        XFILL TABLE - EXTENDED RELOCATION FILL. 
* 
*         CODE = 41.
* 
*         CYBER LOADER XFILL TABLE PROCESSOR
* 
* 
*              *XFILL* TABLES SERVE THE SAME PURPOSE AS *FILL* TABLES,
*         EXCEPT THAT THEY PROVIDE GREATER FLEXIBILITY. 
* 
*              THE TABLE CONSISTS OF ONE-WORD ENTRIES OF THE FOLLOWING
*         FORMAT:                                                              .
* 
*         VFD    6/0,24/A,6/POS,6/SIZE,9/BR,9/R 
* 
*         A    = RELATIVE ADDRESS OF TEXT WORD. 
*         POS  = BIT POSITION OF THE LOW-ORDER BIT OF THE ADDRESS FIELD 
*                IN THE TEXT WORD.
*         SIZE = ADDRESS FIELD LENGTH IN BITS.
*         BR   = BASE ADDRESS DESIGNATOR FOR RELOCATION QUANTITY. 
*         R    = RELOCATION BASE DESIGNATOR FOR TEXT WORD ADDRESS 
*                (MAY NOT EQUAL 2 OR REFER TO BLANK COMMON).
* 
* 
*              PROCESSING CONSISTS OF ADDING THE TABLE TO THE EXTENDED
*         FILL BYTE CHAIN IN THE TABLE *TXFBC*:                                .
* 
*         1)   *CKC* IS CALLED TO CHECK IF THE TABLE IS CONDITIONAL.
* 
  
 XFILL    ZR     B7,RDR1     IGNORE ANY ZERO-LENGTH TABLE 
          RJ     CKC         CHECK IF CONDITIONAL TABLE 
  
**        2)   SPACE FOR THE TABLE IS ALLOCATED IN *TXFBC*, AND THE 
*              TABLE IS READ THERE. 
* 
  
          ALLOC  TXFBC,B7    ALLOCATE EXTENDED FILL BYTE CHAIN
          BX5    X3          CURRENT STORE ADDRESS
          SA0    X1          SAVE WORD COUNT
          READW  L,X5,X1     READ EXTENDED FILL TABLE 
  
**        3)   ADDRESSES ARE RELOCATED, AND THE BASE ADDRESS DESIGNATORS
*              (*BR*) ARE REPLACED WITH THE *TBLK* INDEX. 
* 
  
          SB7    A0          (B7) = WORD COUNT
          SA1    TRLB        (B6) = FWA RELOCATION BASE TABLE 
          SA5    X5          FIRST WORD 
          MX0    -9          (X0) = RELOCATION BLOCK MASK 
          SB6    X1 
          SB2    B1+B1       (B2) = 2 
          SA4    TBLK        (B5) = FWA *TBLK*
          SB5    X4 
 XFL1     BX1    -X0*X5      EXTRACT RELOCATION BASE FOR WORD 
          LX5    -9 
          SA1    X1+B6
          BX2    -X0*X5 
          MX4    -12
          SB3    X2          SAVE *BR*
          SA2    X2+B6       (X2) = BLOCK INDEX FOR RELOC VALUE 
          LX5    -9 
          AX2    36 
          BX4    -X4*X5      SAVE *POS* AND *SIZE* FIELDS 
          SX2    X2 
          MX7    -24
          LX5    -12
          BX6    -X7*X1      RELOCATION BASE FOR TEXT ADDRESS 
  
          BX5    -X7*X5      EXTRACT TEXT ADDRESS 
          MX3    1           EXTRACT CM/ECS BIT 
          BX7    X3*X1
          LX1    59-23
          PL     X1,XFL1A    IF BLOCK IN LOAD 
          LX1    23-59-36+60 *TBLK* INDEX IN *TRLB* ENTRY 
          SA1    B5+X1       (X1) = BLOCK ADDRESS 
          LX3    57-59-30    BIT 57 TO SHOW BELOW LOADABLE AREA 
          SX1    X1 
          BX6    X1+X3
 XFL1A    LX4    18          POSITION *POS* AND *SIZE*
          IX6    X5+X6       RELOCATE ADDRESS 
          BX1    X7          CM/ECS BIT 
          SA5    A5+B1       NEXT *XFILL* TABLE WORD
          SX3    B0          SET FOR POSITIVE RELOCATION
          NE     B3,B2,XFL2  IF POSITIVE RELOCATION 
          SX3    B1          SET FOR NEGATIVE RELOCATION
 XFL2     LX6    30          POSITION FOR STORE 
          IX4    X4+X2       FORM WORD FOR STORE
          LX3    58-0        POSITION +/- BIT 
          BX4    X4+X3
          SB7    B7-B1       DOWN WORD COUNT
          BX6    X6+X1       MERGE CM/ECS BIT 
          BX6    X6+X4       FINAL WORD 
          SA6    A5-B1       STORE WORD 
          NZ     B7,XFL1     IF NOT END OF TABLE
          EQ     RDR1        PROCESS NEXT TABLE 
 LINK     TITLE  LOAD INPUT - LINK TABLE. 
**        LINK TABLE - EXTERNAL REFERENCE LINKAGE.
* 
*         CODE = 44.
* 
*         CYBER LOADER LINK TABLE PROCESSOR 
* 
* 
*              THE *LINK* TABLE DEFINES THE NAMES OF EXTERNAL 
*         REFERENCES AND PROVIDES THE LOCATIONS OF THE REFERENCES.
* 
*              THE *LINK* TABLE IS PARTITIONED INTO 30-BIT BYTES. 
*         AN EXTERNAL NAME REQUIRES 2 BYTES AND MAY CROSS WORD
*         BOUNDARIES.  THE NAME MUST BEGIN WITH A DISPLAY CODE
*         CHARACTER OF VALUE < 40B. 
* 
*         NAME BYTES:                                                          .
* 
*         VFD    42/0LNAME,18/F 
* 
*         NAME = EXTERNAL NAME. 
*         F    = 0 IFF *STRONG* EXTERNAL. 
*                1 IFF *WEAK EXTERNAL.
* 
*         REFERENCE BYTES FOLLOW EACH NAME BYTE AND ARE OF THE SAME 
*         FORMAT AS THE RELOCATION BYTES FOR THE *FILL* TABLE.
* 
* 
*              PROCESSING CONSISTS OF ADDING THE TABLE TO THE LINK
*         BYTE CHAIN IN THE TABLE *TLBC*.  NOTE THAT *TLBC* (AND
*         SUBSEQUENTLY, *TLBC2*) ARE FORMED SO THAT NO NAMES WILL CROSS 
*         WORD BOUNDARIES.  THIS MAKES SUBSEQUENT PROCESSING EASIER.
* 
*         1)   *CKC* IS CALLED TO CHECK IF THE TABLE IS CONDITIONAL.
* 
  
 LINK     ZR     B7,RDR1     IGNORE ANY ZERO-LENGTH TABLE 
          RJ     CKC         CHECK IF CONDITIONAL TABLE 
  
**        2)   SPACE FOR *TLBC* IS ALLOCATED IN AN AMOUNT EQUAL TO
*              1 1/2 TIMES THE *LINK* TABLE LENGTH.  THEN THE TABLE 
*              IS READ TO THE UPPER-MOST PART OF THIS SPACE.  DURING
*              THE PROCESSING DESCRIBED BELOW, STORING WILL TAKE
*              PLACE AT THE BEGINNING OF THIS AREA.  THE FACTOR OF
*              1 1/2 ALLOWS FOR THE GREATEST POSSIBLE DIFFERENCE IN 
*              SIZE BETWEEN THE *LINK* TABLE AND THE RESULTING
*              ADDITION TO *TLBC*.
* 
  
          SA5    TLBC        SET CURRENT TABLE LENGTH 
          SA1    A5+B1
          SX2    B7          (B6) = 1.5 * WC
          AX2    1
          SB6    X2+B7
          SB5    B6-B7       (B5) = (B6) - WC 
          ALLOC  A5,B6       ALLOCATE 1.5*WC TO *TLBC*
          SX0    B7          LENGTH OF *LINK* TABLE 
          SB6    X3+B5       READ TABLE TO TOP PART OF NEW SPACE
          BX5    X3          SAVE FWA OF NEW SPACE
          READW  L,B6,B7
          SA1    A5          *TLBC* FWA 
          SA2    A5+B1
          IX3    X1+X2       (B7) = *TLBC* LWA+1
          SB5    X5          (B5) = STORE POINTER 
          SB7    X3 
          IX4    X3-X0       (B6) = FETCH POINTER 
          SB6    X4 
  
**        3)   EACH 30-BIT BYTE FROM THE TABLE IS FETCHED IN TURN.  ANY 
*              ZERO BYTES ARE DISCARDED.  NAME BYTES ARE STORED 
*              DIRECTLY INTO *TLBC* WITHOUT BEING MODIFIED, EXCEPT
*              THAT A ZERO BYTE IS ADDED AHEAD OF THE NAME IF NECESSARY 
*              TO FORCE THE NAME TO BEGIN IN THE UPPER HALF OF A WORD.
*              ADDRESSES IN REFERENCE BYTES ARE RELOCATED AND THEN
*              STORED IN *TLBC*.
  
          MX0    30          INITIALIZE FETCH FLAG UPPER
          SA4    TRLB        (B2) = FWA *TRLB*
          MX5    30          INITIALIZE STORE FLAG UPPER
          SB2    X4 
          SA3    TBLK        (B3) = FWA *TBLK*
          SB3    X3 
          SA1    A4+B1       (B4) = -(LENGTH *TRLB*)
          SB4    X1 
          SB4    -B4
 LNK1     RJ     LNKF        FETCH NEXT BYTE (EXIT WHEN DONE) 
          ZR     X6,LNK1     SKIP ZERO BYTE 
          NG     X6,LNK2     IF REFERENCE BYTE
          MX5    30          SET STORE FLAG UPPER 
          RJ     LNKS        STORE UPPER BYTE OF NAME 
          RJ     LNKF        FETCH LOWER BYTE OF NAME 
          RJ     LNKS        STORE LOWER BYTE OF NAME 
          EQ     LNK1        LOOP 
  
 LNK2     MX7    3           REFERENCE BYTE - CHECK CONTROL BITS
          BX4    X7*X6
          BX4    X4-X7
          LX6    12 
          ZR     X4,LNKERR   ERROR IF CONTROL BITS = 7
          MX2    -9 
          BX3    -X2*X6 
          MX7    1
          SX2    X3+B4       RELOC INDEX MUST NOT BE .GT. LENGTH *TRLB* 
          PL     X2,LNKERR   IF TOO LARGE 
          SA1    B2+X3       *TRLB* ENTRY FOR BLOCK 
          BX7    X7*X1       EXTRACT CM/ECS BIT AND POSITION IT 
          LX7    -59+26      AS FIRST ITEM OF ASSEMBLY
          MX4    -24         (X3) = BLOCK LOAD ADDRESS
          BX3    -X4*X1 
          LX6    18          POSITION ADDRESS TO LOWER 18 BITS
          MX2    3           EXTRACT CONTROL BITS 
          LX2    30 
          BX2    X2*X6
          SX6    X6          EXTRACT ADDRESS
          IX7    X2+X7       ADD CONTROL BITS TO ASSEMBLY 
  
          LX1    59-23
          PL     X1,LNK3     IF BLOCK IN LOAD 
          LX1    23-59-36+60 *TBLK* INDEX IN *TRLB* ENTRY 
          SA1    B3+X1       (X1) = BLOCK ADDRESS 
          MX2    1           BIT 25 TO SHOW BELOW LOADABLE AREA 
          SX1    X1 
          LX2    25-59
          BX3    X1+X2       ADDRESS + BIT 25 
 LNK3     BSS    0
  
 IU       IFUSER
          NZ     X3,LNK3A    IF REFERENCE NOT IN ABS DATA 
          R=     X2,X6-COMLTH 
          MI     X2,LNK3A    IF REFERENCE WITHIN COMMUNICATIONS AREA
          SX4    BASE-COMLTH  REDUCE ADDRESS BY 
          IX6    X6-X4         (FWA LOAD) - (LWA+1 COMM AREA) 
 LNK3A    BSS    0
 IU       ENDIF 
  
          IX6    X3+X6       RELOCATE ADDRESS 
          BX6    X7+X6       ADD ADDRESS TO ASSEMBLY
          LX6    30          MOVE UPPER 
          RJ     LNKS        STORE IN *TLBC*
          EQ     LNK1        LOOP 
  
**        4)   THE LENGTH OF *TLBC* IS SET TO SHOW THE ACTUAL AMOUNT
*              ADDED. 
  
 LNK4     SA1    A5          SET PROPER *TLBC* LENGTH 
          SB4    X1 
          SX7    B5-B4
          SA7    A5+B1
          EQ     RDR1        PROCESS NEXT TABLE 
*         ROUTINE TO FETCH NEXT BYTE AND STORE IT IN UPPER HALF OF X6.
  
 LNKF     PS                 ENTRY/EXIT 
          SA4    B6          NEXT WORD
          BX0    -X0         REVERSE FETCH FLAG 
          EQ     B6,B7,LNK4  IF END OF *LINK* TABLE 
          BX6    -X0*X4      ISOLATE THE DESIRED BYTE 
          PL     X0,LNKF     IF UPPER BYTE JUST PICKED UP 
          SB6    B6+B1       ADVANCE FETCH ADDRESS
          LX6    30          SHIFT BYTE TO UPPER
          EQ     LNKF        EXIT 
  
*         ROUTINE TO STORE UPPER HALF OF X6 TO NEXT BYTE OF *TLBC*. 
  
 LNKS     PS                 ENTRY/EXIT 
          BX5    -X5         REVERSE FLAG 
          NG     X5,LNKS1    IF TO STORE IN LOWER HALF OF WORD
          SA6    B5          STORE UPPER HALF OF *TLBC* WORD
          SB5    B5+B1       ADVANCE STORE ADDRESS
          EQ     LNKS        EXIT 
  
 LNKS1    SA2    B5-B1       FETCH LAST WORD ADDED TO *TLBC*
          LX6    30          AND ADD UPPER 30 BITS OF X6
          BX6    X2+X6       TO LOWER 30 BITS 
          SA6    A2 
          EQ     LNKS        EXIT 
  
 LNKERR   MX7    0           ERROR IN *LINK* TABLE
 BINERR   ERROR  340,X7      ---- BAD XXXXX BINARY TABLE
          EQ     ABEND       GO TERMINATE LOAD
 XLINK    TITLE  LOAD INPUT - XLINK TABLE.
**        XLINK TABLE - EXTENDED EXTERNAL REFERENCE LINKAGE.
* 
*         CODE = 45.
* 
*         CYBER LOADER XLINK TABLE PROCESSOR
* 
* 
*              *XLINK* TABLES SERVE THE SAME PURPOSE AS *LINK* TABLES,
*         EXCEPT THAT THEY PROVIDE GREATER FLEXIBILITY. 
* 
*              THE TABLE CONSISTS OF ONE OR MORE LINKAGE SEQUENCES, 
*         EACH OR WHICH CONSISTS OF A NAME WORD, ONE OR MORE LINKAGE
*         DESCRIPTOR WORDS, AND A ZERO WORD.  THE ZERO WORD IS NOT
*         NECESSARY FOR THE LAST LINKAGE SEQUENCE IN THE TABLE. 
* 
*              THE NAME WORD IS OF THE SAME FORMAT AS IN THE *LINK* 
*         TABLE, EXCEPT THAT IT NEVER CROSSES WORD BOUNDARIES, SINCE
*         ALL LINKAGE DESCRIPTORS ARE A FULL WORD IN LENGTH.
* 
*              THE LINKAGE DESCRIPTORS ARE OF THE SAME FORMAT AS THE
*         *XFILL* TABLE ENTRIES, EXCEPT THAT THE *BR* FIELD IS NOT
*         USED.  THE ADDRESS IS OBTAINED FROM THE DEFINITION OF THE 
*         EXTERNAL NAME.
* 
* 
*              PROCESSING CONSISTS OF ADDING THE TABLE TO THE EXTENDED
*         LINK BYTE CHAIN IN THE TABLE *TXLBC*:                                .
* 
*         1)   *CKC* IS CALLED TO CHECK IF THE TABLE IS CONDITIONAL.
* 
  
 XLINK    ZR     B7,RDR1     IGNORE ANY ZERO-LENGTH TABLE 
          RJ     CKC         CHECK IF CONDITIONAL TABLE 
  
**        2)   SPACE FOR THE TABLE IS ALLOCATED IN *TXLBC*, AND THE 
*              TABLE IS READ THERE. 
* 
  
          ALLOC  TXLBC,B7    ALLOCATE EXTENDED LINK BYTE CHAIN
          BX5    X3          CURRENT STORE ADDRESS
          SA0    X1          SAVE WORD COUNT
          READW  L,X5,X1     READ EXTENDED LINK TABLE 
  
**        3)   ALL ADDRESSES IN THE LINKAGE DESCRIPTORS ARE RELOCATED.
*              THE NAME BYTES ARE LEFT UNCHANGED. 
  
          SB7    A0-B1       (B7) = WORD COUNT
          SA1    TRLB        (B6) = FWA RELOCATION BASE TABLE 
          SA5    X5+B1       1ST LINKAGE DESCRIPTOR 
          MX0    -9          (X0) = RELOCATION BLOCK MASK 
          SB6    X1 
          SA3    TBLK        (B4) = FWA *TBLK*
          SB4    X3 
          EQ     XLK2        ENTER LOOP 
  
 XLK1     BX1    -X0*X5      EXTRACT RELOCATION BASE
          LX5    -18
          SA1    B6+X1
          MX2    60-24-12    ISOLATE ADDRESS, POS, SIZE FIELDS
          MX3    1           CM/ECS FLAG FOR RELOCATION BASE
          BX3    X3*X1
          BX7    -X2*X5 
          MX4    -24         ISOLATE RELOCATION BASE
          BX4    -X4*X1 
          LX4    12          POSITION 
          SB7    B7-B1       DOWN WORD COUNT
  
          LX1    59-23
          PL     X1,XLK1A    IF BLOCK IN LOAD 
          LX1    23-59-36+60 *TBLK* INDEX IN *TRLB* ENTRY 
          SA1    X1+B4       (X1) = BLOCK ADDRESS 
          MX2    1           BIT 57 TO SHOW BELOW LOADABLE AREA 
          SX1    X1 
          LX2    57-59-18 
          LX1    12          POSITION BLOCK ADDRESS 
          BX4    X2+X1
 XLK1A    BSS    0
  
 IU       IFUSER
          NZ     X4,XLK1B    IF REFERENCE NOT IN ABS DATA 
          SX2    BASE-COMLTH  (FWA LOAD) - (LWA+1 COMM AREA)
          LX7    -12         CHECK ADDRESS OF REFERENCE 
          R=     X1,X7-COMLTH 
          LX7    12 
          MI     X1,XLK1B    IF REFERENCE IS WITHIN COMM AREA 
          LX2    12          REDUCE ADDRESS BY NECESSARY AMOUNT 
          IX7    X7-X2
 XLK1B    BSS    0
 IU       ENDIF 
  
          IX7    X7+X4       RELOCATE ADDRESS 
          SA5    A5+B1       NEXT WORD
          LX7    18          RESTORE POSITION 
          BX7    X3+X7       ADD CM/ECS BIT 
          SA7    A5-B1       STORE WORD 
 XLK2     ZR     B7,XLK3     IF END OF TABLE
          NZ     X5,XLK1     IF NOT LAST LINKAGE DESCRIPTOR 
          SB7    B7-B1       DOWN WORD COUNT
          SA5    A5+B1       SKIP OVER NAME WORD
          ZR     B7,RDR1     IF END OF TABLE
          SB7    B7-B1       DOWN WORD COUNT
          SA5    A5+B1       1ST LINKAGE DESCRIPTOR, NEXT SET 
          EQ     XLK1        LOOP 
  
 XLK3     ADDWRD TXLBC,X3-X3 ADD ZERO-WORD TO END OF *TXLBC*
          EQ     RDR1        PROCESS NEXT TABLE 
 REPL     TITLE  LOAD INPUT - REPL TABLE. 
**        REPL TABLE - REPLICATION OF TEXT. 
* 
*         CODE = 43.
* 
*         CYBER LOADER REPL TABLE PROCESSOR 
* 
* 
*              *REPL* TABLES DEFINE DUPLICATION OF A BLOCK OF DATA. 
*         EACH ENTRY IN THE TABLE CONSISTS OF TWO WORDS 
* 
*         VFD    15/0,18/K,9/RS,18/S
*         VFD    18/C,15/B,9/RD,18/D
* 
*         S  = RELATIVE SOURCE ADDRESS. 
*         RS = RELOCATION BASE DESIGNATOR FOR SOURCE ADDRESS *S*. 
*         D  = RELATIVE DESTINATION ADDRESS.
*         RD = RELOCATION BASE DESIGNATOR FOR DESTINATION ADDRESS *D*.
*         B  = BLOCK SIZE.
*         C  = NUMBER OF TIMES BLOCK IS TO BE REPEATED. 
*         K  = DESTINATION ADDRESS INCREMENT. 
* 
*         IF B = 0, B IS INTERPRETED AS 1.
*         IF C = 0, C IS INTERPRETED AS 1.
*         IF K = 0, K IS INTERPRETED AS B.
*         IF D = 0, D IS INTERPRETED AS S+B.
* 
*              REPLICATION IS PERFORMED AFTER PHYSICAL LOADING IS 
*         COMPLETED UNLESS BIT ZERO OF THE TABLE CONTROL WORD IS SET. 
*         IF THIS OCCURS, THE REPLICATION IS PERFORMED AT THE TIME THE
*         TABLE IS ENCOUNTERED. 
* 
* 
*              THE FOLLOWING ROUTINE PROCESSES BOTH *REPL* AND
*              *XREPL* TABLES - 
* 
*         1)   *CKC* IS CALLED TO CHECK IF THE TABLE IS CONDITIONAL.
* 
  
 REPL     BX4    X5          INSTANT-DEFERRED FLAG
          ZR     B7,RDR1     IGNORE ANY ZERO-LENGTH TABLE 
          LX4    59-0 
          RJ     CKC         CHECK IF CONDITIONAL TABLE 
  
**        2)   IF INSTANT REPLICATION IS NOT SPECIFIED BY THE TABLE,
*              SPACE FOR THE TABLE IS ALLOCATED IN *TREP*. IF INSTANT 
*              REPLICATION IS SPECIFIED, THE SPACE IS ALLOCATED IN A
*              SCRATCH TABLE *TSCR*, AS THE ACTUAL REPLICATION WILL BE
*              PERFORMED SHORTLY.  THE *REPL* TABLE IS THEN READ INTO 
*              WHICHEVER TABLE WAS ALLOCATED. 
* 
  
          SA2    TREP        SET TO USE *TREP*
          PL     X4,REP1     IF NOT INSTANT REPLICATION 
          SA2    TSCR        SET TO USE *TSCR* AND CLEAR IT 
          MX6    0
          SA6    A2+B1
 REP1     SA0    A2          SAVE TYPE
          ALLOC  A2,B7       ALLOCATE FOR REPLICATIONS
          BX6    X4          SAVE TABLE INDEX 
          SA6    REPT 
          BX5    X3          CURRENT STORE ADDRESS
          SX0    X1          SAVE WORD COUNT
          READW  L,X5,X1     READ REPLICATIONS
  
**        3)   ALL OF THE FIELDS ARE ISOLATED, THE ADDRESSES ARE
*              RELOCATED, AND DEFAULT VALUES ARE SET.  THIS IS THE
*              ONLY PART OF REPLICATION PROCESSING WHERE SEPARATE 
*              CODE IS USED FOR *REPL* AND *XREPL* TABLES.
* 
  
          SB7    X0          (B7) = WORD COUNT
          SA1    TRLB        (B6) = FWA RELOCATION BASE TABLE 
          SA5    X5          FIRST WORD 
          SB6    X1 
 REP2     SA1    LT          LAST TABLE TYPE IN BITS 0-5
          SA4    A5+B1       SECOND WORD OF ENTRY 
          MX0    -9          MASK FOR RELOCATION
          MX2    -18         MASK FOR K, ALSO ADR AND C IF *REPL* 
          MX3    -15         MASK FOR B IF *REPL*, C IF *XREPL* 
          R=     X1,X1-43B
          NZ     X1,REP3     IF *XREPL* TABLE 
          BX7    -X2*X5      (X7) = S 
          BX6    -X2*X4      (X6) = D 
          AX5    18 
          AX4    18 
          BX1    -X0*X5      (X1) = RS
          BX0    -X0*X4      (X0) = RD
          AX4    9
          BX3    -X3*X4      (X3) = B 
          AX5    9
          AX4    15 
          BX5    -X2*X5      (X5) = K 
          BX4    -X2*X4      (X4) = C 
          EQ     REP4 
  
 REP3     MX6    -24         ADDRESS MASK FOR *XREPL* 
          BX7    -X6*X5      (X7) = S 
          BX6    -X6*X4      (X6) = D 
          AX5    24 
          AX4    24 
          BX1    -X0*X5      (X1) = RS
          BX0    -X0*X4      (X0) = RD
          AX5    9
          BX5    -X2*X5      (X5) = K 
          AX4    9
          MX2    -12
          BX2    -X2*X4      (X3) = B 
          AX4    12 
          BX4    -X3*X4      (X4) = C 
          BX3    X2 
 REP4     SB2    X3          (B2) = B 
          NZ     B2,REP5     IF B SPECIFIED 
          SB2    B1          B = 1
 REP5     SB3    X4          (B3) = C 
          NZ     B3,REP6     IF C SPECIFIED 
          SB3    B1          C = 1
 REP6     SA2    B6+X1       RELOCATION BASE FOR S
          NZ     X5,REP7     IF K SPECIFIED 
          SX5    B2          K = B
 REP7     MX3    -24         RELOCATE S 
          BX3    -X3*X2 
 IC       IFCARD
          SA1    OG 
          ZR     X1,REP7A    IF NOT OVERLAY/CAPSULE/OVCAP GENERATION
          MX4    24 
          LX4    24 
          IX1    X4-X3
          NZ     X1,REP7A    IF RELOCATION BASE OF S NOT -0 
 REP7E    BSS    0
          MX7    0
          SA7    A5          CLEAR CORRESPONDING *TREP* ENTRY 
          LX2    24 
          SA1    TBLK 
          R=     B5,X1-1
          SA4    B5+X2       GET BLOCK NAME FOR ERROR MESSAGE 
          SA2    PN          GET CURRENT PROGRAM NAME 
          BX7    X2 
          SA1    LASTORGM    GET LAST PROGRAM NAME
          SA7    A1 
          BX2    X2-X1       (X2)= LAST PROG. NAME.OR.CURRENT PROG.NAME 
          SA1    LASTORGL    GET LAST BLOCK ID
          BX7    X4 
          SA7    A1 
          BX7    X7-X1       (X7)= LAST BLOCK .OR.CURRENT BLOCK 
          BX2    X7+X2
          ZR     X2,RDR1     IF BLOCK AND PROGRAM SAME AS LAST TIME 
          MX3    42 
          BX7    X3*X4
          SA1    SEGFLAG
          NZ     X1,REP7F    IF SEGMENT LOAD
          ERROR  4340,X7     ----TRIED TO LOAD INTO BLOCK BELOW ORIGIN
          EQ     RDR1 
  
 REP7F    SA1    SI          (X1)=INDEX OF CURRENT SEGMENT ENTRY
          BX7    X7+X1
          ERROR  4422,X7     ---- TRIED TO LOAD INTO BLOCK OUTSIDE SEG. 
          EQ     RDR1 
 REP7A    SA1    SEGFLAG
          ZR     X1,REP7A1   IF NOT SEGMENT LOAD
          MX4    -24
          BX1    -X4-X3 
          ZR     X1,REP7E    IF RELOCATION OUTSIDE SEGMENT
 REP7A1   BSS    0
 IC       ENDIF 
          MX1    1           (X1) = CM/ECS BIT FOR S
          BX1    X1*X2
  
 IU       IFUSER
          NG     X1,REP7A    IF ECS REPLICATION 
          LX2    59-23
          PL     X2,REP7A    IF S WITHIN LOADABLE AREA
          SA3    TBLK        GET ADDRESS FROM *TBLK*
          LX2    23-59-36+60
          SB4    X2 
          SA3    B4+X3
          MX2    1           SET BIT 22 TO SHOW THAT ADDRESS IS 
          SX3    X3          BELOW LOADABLE AREA
          LX2    -59+22 
          BX3    X3+X2
 REP7A    BSS    0
 IU       ENDIF 
  
          LX1    -59+23      ADD CM/ECS BIT 
          IX7    X7+X3       RELOCATE S 
          SA2    B6+X0       RELOCATION BASE FOR D
          MX3    -24
          BX7    X7+X1       (X7) = COMPLETED S FOR *TREP*
          BX3    -X3*X2 
 IC       IFCARD
          SA1    OG 
          ZR     X1,REP7B    IF NOT OVERLAY/CAPSULE/OVCAP GENERATION
          MX4    24 
          LX4    24 
          IX1    X4-X3
          ZR     X1,REP7E    IF RELOCATION BASE OF D -0 
 REP7B    SA1    SEGFLAG
          ZR     X1,REP7D    IF NOT SEGMENT LOAD
          MX4    -24
          BX1    -X4-X3 
          ZR     X1,REP7E    IF RELOCATION OUTSIDE OF SEGMENT 
 REP7D    BSS    0
 IC       ENDIF 
          MX1    1           (X1) = CM/ECS BIT FOR D
          BX1    X1*X2
  
 IU       IFUSER
          NG     X1,REP7B    IF ECS REPLICATION 
          LX2    59-23
          PL     X2,REP7B    IF D WITHIN LOADABLE AREA
          SA3    TBLK        GET ADDRESS FROM *TBLK*
          LX2    23-59-36+60
          SB4    X2 
          SA3    B4+X3       *TBLK* ENTRY, WORD 2 
          MX2    1           SET BIT 22 TO SHOW THAT ADDRESS IS 
          LX2    -59+22      BELOW LOADABLE AREA
          SX3    X3          BLOCK ADDRESS
          SA4    A3-B1       GET NAME FROM *TBLK* ENTRY 
          BX3    X3+X2
          BX2    X7 
          MX7    42 
          BX7    X7*X4       SAVE NAME FOR MESSAGE
          SA7    NEWORGL
          BX7    X2 
 REP7B    BSS    0
 IU       ENDIF 
  
          IX2    X6+X0       D + RD 
          SX4    B2          D = S + B (FOR D NOT SPECIFIED)
          IX3    X3+X6       RELOCATE D 
          IX6    X7+X4
          ZR     X2,REP8     IF D NOT SPECIFIED 
          LX1    -59+23      USE RELOCATED D
          BX6    X3+X1
  
**        4)   IF THE TABLE IS FOR CM REPLICATION, THE HIGHEST
*              LOCATION+1 REFERENCED BY THE REPLICATION TABLE IS
*              DETERMINED AS FOLLOWS -
* 
*                       LWA = MAX[(S+B),(D+(C-1)*K+B)]
* 
  
 REP8     BX2    X6+X7
          MX4    0           SET FOR NO *TPGM* INCREASE 
          LX2    59-23
          SX1    X7+B2       (X1) = LWAS = S + B
          NG     X2,REP9     IF ECS REPLICATION 
          SX2    X6+B2       (X2) = D + (C-1)*K + B 
          SX3    B3-B1       C - 1
          PX4    X5 
          PX3    X3 
          DX4    X4*X3
          UX4    X4          (C-1)*K
          IX2    X4+X2       LWAD 
          IX4    X1-X2       (X4) = MAX(LWAS,LWAD)
                                    IF   X1\X2   X1<X2
          AX4    59          +0      -0 
          BX3    -X4*X1      X1      +0 
          BX4    X4*X2       +0      X2 
          IX4    X3+X4       X1      X2 
  
**        5)   THE ENTRY FOR *TREP* IS FORMATTED AND STORED.
* 
  
 REP9     LX5    24          MERGE VALUES INTO *TREP* ENTRY 
          SX1    B3 
          BX7    X7+X5       WORD 1 
          SX2    B2 
          LX1    24+18
          LX2    24 
          BX6    X1+X6
          BX6    X2+X6       WORD 2 
          SA7    A5 
          SA6    A5+B1
  
**        6)   IF THE REPLICATION IS SUCH THAT IT WILL EXCEED THE 
*              CURRENTLY-DEFINED LOAD SIZE, THE REQUIRED AMOUNT IS ADDED
*              TO *TPGM* AND TO *PA* BY CALLING *APS=*.  IT IS ALSO 
*              ADDED TO THE BLOCK LENGTH IN THE CURRENT *TBLK* ENTRY. 
* 
  
          SA1    PA 
 IC       IFCARD
          SA2    PO 
          SA3    BI 
          IX1    X1-X2
          IX1    X1+X3       PA-PO+BI 
 IC       ENDIF 
          MX2    0           CM INDICATOR FOR *APS=*
          IX6    X1-X4
          PL     X6,REP10    IF ALL REPL DATA WITHIN LOAD 
          SX0    B7          SAVE B7
          BX1    -X6         SPACE NEEDED TO ADD
          RJ     APS=        ALLOCATE PROGRAM SPACE 
          SA1    PI          PROGRAM INDEX IN *TBLK*
          SA2    PA          NEW *PA* 
          SA3    TBLK 
          SB7    X0          RESTORE B7 
          SB2    X1+B1
          MX0    -24
          SA1    X3+B2       *TBLK* ENTRY 
          BX7    -X0*X1      BLOCK FWA
          LX0    24          REMOVE OLD LENGTH
          IX2    X2-X7       ADD NEW LENGTH 
          BX6    X0*X1
          LX2    24 
          BX6    X6+X2
          SA6    A1 
  
**        7)   FOR USER-CALL LOADS, A NON-FATAL ERROR IS ISSUED IF THE
*              REPLICATION IS TO A BLOCK BELOW THE LOADABLE AREA, 
*              I. E., FOR A COMMON BLOCK INITIALLY DECLARED IN AN 
*              EARLIER LOAD.  THEN STEPS 3-7 ARE REPEATED FOR EACH
*              2-WORD ENTRY.
* 
  
 REP10    BSS    0
  
 IU       IFUSER
          SA1    NEWORGL     CHECK IF LAST *REPL* TABLE WAS FOR A 
          MX6    0           BLOCK BELOW THE FWA OF LOADABLE AREA 
          BX7    X1 
          SA6    A1          CLEAR INDICATOR FOR NEXT TIME
          SA2    A1-B1       LAST BLOCK NAME IN WHICH ERROR ISSUED
          ZR     X1,REP11    IF ERROR DID NOT OCCUR 
          IX3    X7-X2
          SA7    A2          SAVE CURRENT NAME
          ZR     X3,REP11    IF SAME BLOCK AS LAST ISSUE
          ERROR  4340,X7     ---- TEXT LOADED BELOW FWA LOADABLE AREA 
 REP11    BSS    0
 IU       ENDIF 
  
          SB2    B1+B1       BEGIN NEXT WORD PAIR 
          SA1    REPT        INDEX INTO *TREP* OR *TSCR*
          SX6    X1+B2       ADVANCE INDEX
          SA2    A0          FWA OF *TREP* OR *TSCR*
          SB3    X2 
          SA5    B3+X6       WORD 1 OF NEXT WORD PAIR 
          SA6    A1 
          SB7    B7-B2
          GT     B7,B1,REP2  LOOP THRU REPLICATION TABLE
  
**        8)   IF INSTANT REPLICATION IS TO BE PERFORMED, THE 
*              SUBROUTINE *RPL* IS NOW CALLED TO ACTUALLY PERFORM THE 
*              REPLICATION.  ALL DEFERRED REPLICATIONS REMAIN IN *TREP*.
  
          NEG 
          SB2    A0-TREP
          ZR     B2,RDR1     PROCESS NEXT TABLE IF NOT INSTANT
          RJ     RPL         PROCESS INSTANT REPLICATION
          EQ     RDR1        PROCESS NEXT TABLE 
  
 REPT     CON    0           INDEX INTO REPLICATION TABLE 
 XREPL    TITLE  LOAD INPUT - XREPL TABLE.
**        XREPL TABLE - EXTENDED REPLICATION OF TEXT. 
* 
*         CODE = 47.
* 
*         CYBER LOADER XREPL TABLE PROCESSOR
* 
* 
*              *XREPL* TABLES SERVE THE SAME PURPOSE AS *REPL* TABLES,
*         EXCEPT THAT PROVISION IS MADE FOR LARGER ADDRESS FIELDS.
*         EACH ENTRY CONSISTS OF TWO WORDS:                                    .
* 
*         VFD    9/0,18/K,9/RS,24/S 
*         VFD    15/C,12/B,9/RD,24/D
* 
*         ALL FIELDS HAVE THE SAME MEANING AS FOR THE *REPL* TABLE. 
* 
* 
*              THE PROCESSING IS SIMILAR TO THAT OF THE *REPL* TABLE. 
  
  
 XREPL    EQU    REPL 
 XFER     TITLE  LOAD INPUT - XFER TABLE. 
**        XFER TABLE - TRANSFER POINT.
* 
*         CODE = 46.
* 
*         CYBER LOADER XFER TABLE PROCESSOR 
* 
* 
*              THE *XFER* TABLE SPECIFIES THE ADDRESS FOR THE START 
*         OF PROGRAM EXECUTION.  WHEN THE LOAD IS COMPLETED, EXECUTION
*         WILL BEGIN AT THE ENTRY SPECIFIED BY THE LAST TRANSFER
*         ENCOUNTERED.  IF THIS ENTRY IS NOT FOUND, EXECUTION WILL
*         BEGIN AT THE PREVIOUS TRANSFER. 
* 
*         ENTRY = 1 WORD. 
* 
*         VFD    42/0LNAME,18/0 
* 
*         NAME = NAME OF ENTRY AT WHICH PROGRAM EXECUTION BEGINS. 
*                IF THE NAME IS BLANK, THERE IS NO NAMED TRANSFER.
* 
* 
*              PROCESSING CONSISTS OF READING THE TABLE AND SAVING
*         THE NAME, IF A NAME IS PRESENT. 
  
  
 XFER     ZR     B7,RDR1     IGNORE ANY ZERO-LENGTH TABLE 
          READO  L           READ TRANSFER
          IFCARD 5
          SA1    SEGFLAG
          ZR     X1,XFER1    IF NOT SEGMENT LOAD
          SA1    SN 
          NZ     X1,RDR1     IF NOT ROOT SEGMENT IGNORE NAME
 XFER1    BSS    0
          BX1    X6 
          AX1    54 
          LD     X7,X1+22B
          ZR     X7,RDR1     IF BLANK TRANSFER
          SA5    XF+1        MOVE PREVIOUS TRANSFER 
          LX7    X5 
          SA6    A5 
          SA7    A5+B1
          EQ     RDR1        PROCESS NEXT TABLE 
 OVLYCK   IFUSER
          TITLE  DISALLOW ABSOLUTE INPUT DURING USER-CALL LOADS.
**             NO ABSOLUTE INPUT IS ALLOWED DURING EXECUTION OF *LOADU*.
*         ANY LOADING OF ABSOLUTE OVERLAYS MUST BE DONE BY USE OF THE 
*         OVERLAY-TYPE REQUEST (V-BIT SET).  OVERLAYS ARE ALWAYS LOADED 
*         BY EITHER OF THE PPU ROUTINES *LDV* OR *LDW*. 
  
  
 OVL51    ERROR  303         ---- ABSOLUTE INPUT IN USER CALL 
          EQ     ABEND
  
 OVL50    EQU    OVL51
 OVL53    EQU    OVL51
 OVL54    EQU    OVL51
 OVLYCK   ENDIF 
 OVLYCK   IFCARD
 OVL54    TITLE  LOAD INPUT - 54-TABLE OVERLAY
**        54-TABLE - ABSOLUTE CPU OVERLAY.
* 
* 
*              THE 54-TABLE OVERLAY IS THE ONLY TYPE GENERATED BY THIS
*         LOADER BEGINNING WITH VERSION 1.1.  ITS FORMAT IS:  
* 
*         59        48    42    36          24    18                 0
*  -----  /-----------/-----------/-----------------/-----------------/ 
*   00    /   5400    /   LEVEL   /      FWAS       /        N        / 
*         /-----------/-----/-----/-----------------/-----------------/ 
*   01    /       WCS       /        LMINFL         /      MINFL      / 
*         /-----------/-----/-----------------/-----/-----------------/ 
*   02    /   0000    /         FWAL          /          WCL          / 
*         /-----------/-----------------------/-----------------------/ 
*   03    /                   00000000000000000000                    / 
*  -----  /-----------------------/-----------------/-----------------/ 
*   04    /       00000000        /      DEFL       /       HHA       / 
*         /-----------------/-----/-----------/-----/-----------------/ 
*   05    /     000000      /   LDEFL/1000    /         LHHA          / 
*         /-----------------/-----------------/-----------------------/ 
*   06    /                   FS                    /        DL       / 
*         /-----------------------------------------------------------/ 
*   07    /                   RA                    /      000000     / 
*  -----  /-----------------------------------------/-----------------/ 
*    '    /             ENTRY POINT NAME            /     ADDRESS     / 
* N WORDS /-----------------------------------------/-----------------/ 
*    ?    /             ENTRY POINT NAME            /     ADDRESS     / 
*  -----  /-----------------------------------------/-----------------/ 
*    '    /         OVERLAY OR OVCAP NAME           /    FWA OR 0     / 
* DL WORDS/-----------/----/------------------------/-----------------/ 
*    '    / LEVEL OR 0/0000/        PRU BIAS        / LWA+1 OR LENGTH / 
*  -----  /-----------/----/------------------------/-----------------/ 
*    '    /                                                           / 
*   WCL   /                     ECS IMAGE, IF ANY                     / 
*    ?    /                                                           / 
*  -----  /-----------------------------------------------------------/ 
*    '    /                                                           / 
*   WCS   /                         CM IMAGE                          / 
*    ?    /                                                           / 
*  -----  /-----------------------------------------------------------/ 
* 
*         WORDS 04-07 ARE PRESENT ONLY FOR A (0,0) OVERLAY, WHICH IS
*         THE ONLY KIND WE SHOULD ENCOUNTER HERE. 
* 
*         DL WORDS ARE PRESENT IFF WE HAVE A (0,0) OVERLAY WHICH
*         WAS GENERATED WITH A *FOL* DIRECTORY. TWO WORDS ARE REQUIRED
*         FOR EACH HIGHER LEVEL OVERLAY OR OVCAP IN THE OVERLAY 
*         STRUCTURE.  *FS* IN WORD 6 IS ZERO IN THE 54-TABLE HEADER,
*         BUT IS SET TO THE *LDQ*-FORMAT FILE SPECIFICATION ENTRY BY
*         ANY PROGRAM WHICH LOADS THE (0,0) OVERLAY.  *RA* IN WORD 7
*         IS ZERO IN THE 54-TABLE HEADER, BUT IS SET TO THE *LDQ*-
*         FORMAT RANDOM ADDRESS ENTRY BY ANY PROGRAM WHICH LOADS THE
*         (0,0) OVERLAY.  CONSULT *FOLRES* AND *LDQ* IMS DOCUMENTATION
*         FOR SPECIFIC DETAILS. 
* 
*         LEVEL          OVERLAY LEVEL
*         N              NUMBER OF ENTRY POINTS 
*         FWAS   FWAL    LOAD ADDRESS (SCM AND LCM) 
*         WCS    WCL     LENGTH OF CODE IMAGE 
*         MINFL  LMINFL  LWA+1 OF OVERLAY, INCLUDING BLANK COMMON 
*         DEFL   LDEFL   RESERVED FOR FUTURE USE
*         HHA    LHHA    HIGHEST-HIGH ADDRESS (MAX MINFL OVER ALL OVLYS)
* 
*         DL             *FOL* DIRECTORY LENGTH.
*         FS     RA      ZERO IN THE 54-TABLE BUT SET AT LOAD TIME
*                        AS DESCRIBED ABOVE.
*         PRU BIAS       QUANTITY TO BE ADDED TO PRU NUMBER OF (0,0)
*                        OVERLAY TO GIVE PRU NUMBER OF THIS OVERLAY.
* 
*         ALL OTHER FIELDS ARE RESERVED FOR FUTURE USE. 
* 
* 
*              PROCESSING IS AS FOLLOWS 
* 
*         1)   COMPLIANCE WITH THESE RULES IS VERIFIED
* 
*              A)   NOTHING ELSE HAS BEEN LOADED
*              B)   THE LOAD ADDRESS IS EQUAL TO 100B 
*              C)   THE OVERLAY IS A (0,0) OVERLAY
* 
  
 OVL54    BX6    X5 
          SX7    B1 
          SA2    PC 
          SA7    A2          SET PROGRAM COUNT = 1
          NZ     X2,OVLERR1  IF SOMETHING ALREADY LOADED
          LX6    -18
          SB6    X6-BASE
          NZ     B6,OVLERR3  IF LOAD ADDRESS NOT 100
          LX6    -18
          SX2    X6 
          NZ     X2,OVLERR2  IF NOT A (0,0) OVERLAY 
  
**        2)   THE HEADER AND ENTRY POINT LIST ARE READ INTO *TPGM*.
* 
  
          SB6    X5 
          SB6    B6-B1
          ALLOC  TPGM,B6     ALLOCATE SPACE FOR >1 ENTRY POINTS 
          BX6    X5 
          SA6    X2+BASE     SAVE HEADER WORD 
          READW  L,A6+B1,X5+7      READ 
  
**        3)   USING THE WORDS JUST READ INTO *TPGM* ---- 
* 
*              A)   THE ENTRY POINT LIST IS COPIED INTO *TOVEPT*, 
* 
  
          ALLOC  TOVEPT,X5
          SA4    TPGM 
          MOVE   X5,X4+COMLTH,X3
  
**             B)   IF AN *FOL* DIRECTORY IS PRESENT (DL.NE.0)
*                   THEN THE *FOL* DIRECTORY IS READ INTO *TPGM*
*                   AND THE *FS* AND *RA* FIELDS OF THE 54-TABLE
*                   (IN *TPGM*) ARE SET AS DESCRIBED ABOVE.  IF 
*                   NECESSARY, *FILINFO* IS CALLED AND THE *FOL*
*                   RANDOM ADDRESS AND FILE SPECIFICATION ENTRIES 
*                   ARE DETERMINED. 
* 
  
          SA1    TPGM 
          R=     A5,X1+BASE+6  GET FOL DIRECTORY LENGTH FROM *TPGM* 
          ZR     X5,OVL54E   IF NO FOL DIRECTORY
          SA2    FOLFS       GET FOL FILE SPECIFICATION ENTRY 
          NZ     X2,OVL54D   IF FILE SPEC (AND PRU) ALREADY DETERMINED
          SA1    L           LFN FROM FET 
          MX6    42 
          BX6    X6*X1
          SA6    A2          SET FOL FILE SPEC ENTRY
 S        IFSCOPE 
          R=     X2,50000B
          BX6    X6+X2       (X6) = 42/LFN,6/5,12/0 
          SA6    T1 
          FILINFO  T1        CALL FILINFO FOR LFN 
          SA2    T1+3        (X2) BITS 29 THRU 6 = PRU NUMBER 
          MX3    -24
          LX2    -6 
          BX6    -X3*X2      (X6) = PRU NUMBER (CURRENT)
 S        ENDIF 
 K        IFNOS 
          RECALL L           AWAIT I/O COMPLETE 
  
*                            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+6         CURRENT RANDOM INDEX (CRI) FROM FET+6
          AX1    30 
          BX6    X1          (X6) = PRU NUMBER (CRI)
 K        ENDIF 
          SA3    L+2         *IN* 
          SA2    A3+B1       *OUT*
          IX3    X3-X2       *IN* - *OUT* 
          PL     X3,OVL54F   IF *IN* .GE. *OUT* 
          R=     X3,X3+IP.LBUF
 OVL54F   BSS    0           (X3) = WORDS IN BUFFER 
          R=     X3,X3+1+LTH77     ACCOUNT FOR *PRFX* TABLE 
          SA2    TPGM+1      LENGTH OF *TPGM* 
          IX3    X3+X2       ACCOUNT FOR WORDS READ INTO *TPGM* 
          R=     X2,X3-BASE+100B   ACCOUNT FOR COMM AREA, ROUND UP
          AX2    6           DIVIDE BY 100B, PRU-S JUST READ
          IX6    X6-X2       PRU NUMBER AT START OF READ
          LX6    18          (X6) = 24/0, 18/PRU, 18/0
          SA6    FOLRA       SET FOL RANDOM ADDRESS WORD
 OVL54D   SA2    FOLFS       GET FOL FILE SPEC WORD 
          BX6    X2+X5       42/FILE SPEC, 18/DIRECTORY LENGTH
          SA6    A5          WRITE INTO *TPGM*
          SA2    FOLRA       GET FOL RANDOM ADDRESS 
          BX6    X2 
          SA6    A6+B1       WRITE INTO *TPGM*
          ALLOC  TPGM,X5     ALLOCATE SPACE IN *TPGM* FOR FOL DIRECTORY 
          READW  L,X3,X5     READ FOL DIRECTORY INTO *TPGM* 
 OVL54E   BSS    0
**        4)   ECS TEXT, IF ANY, IS READ IN AND MOVED TO ECS. 
* 
  
          SA1    TPGM 
          SA1    X1+BASE+2   GET FWAL, WCL
          MX3    -24
          BX0    -X3*X1      (X0) = WCL 
          AX1    24 
          BX5    -X3*X1      (X5) = FWAL
 IE       IFTEST NE,IP.MECS,0 
          SA2    ECSFL
          IX4    X0+X5       LWA+1 OF ECS IMAGE 
          IX2    X2-X4
          PL     X2,OVL54A   IF ENOUGH ECS FL 
          ERROR  104         ---- INSUFFICIENT ECS FL FOR LOAD
          EQ     ABEND
  
 OVL54A   SA1    ECSPA       ADVANCE ECS PROGRAM ADDRESS
          IX6    X1+X0
          SA6    A1 
 OVL54B   ZR     X0,OVL54C   IF END OF ECS IMAGE (OR NONE)
          READO  L
          BX2    X5          (X2) = NEXT STORE ADDRESS
          SX7    B1 
          IX0    X0-X7       DECREMENT WORD COUNT 
          IX5    X5+X7       INCREMENT STORE ADDRESS
          RJ     WE=         WRITE (X6) TO ECS
          EQ     OVL54B 
 IE       ELSE
          ZR     X0,OVL54C   IF NO ECS IMAGE
          ERROR  104         ---- INSUFFICIENT ECS FL FOR LOAD
          EQ     ABEND
 IE       ENDIF 
  
**        5)   THE LOAD IS FLAGGED AS ABSOLUTE TO PROHIBIT ANY FURTHER
*              LOADING
* 
  
 OVL54C   SX7    B1 
          SA7    ABS
  
**        6)   THE CM IMAGE IS READ BY BRANCHING TO STEP 5 OF THE 
*              *ASCM* (50-TABLE) PROCESSING.
  
          SA1    TPGM 
          SA1    X1+BASE+1
          LX1    -42
          SB3    X1          (B3) = WCS 
          EQ     OVL50G 
 ACPM     TITLE  LOAD INPUT - ACPM TABLE (53-HEADER). 
**        ACPM TABLE - ABSOLUTE CPU OVERLAY.
* 
*         CODE = 53.
* 
*         CYBER LOADER ACPM TABLE PROCESSOR 
* 
* 
*              THE *ACPM* TABLE PROVIDES A GENERALIZED FORMAT FOR ANY 
*         ABSOLUTE OVERLAY.  THERE ARE TWO FORMATS, DEPENDING ON THE
*         PRESENCE OF MULTIPLE ENTRY POINTS 
* 
*         FORMAT 1 (ONE UNNAMED ENTRY POINT):                                  .
* 
*         VFD    12/5300B,12/LEV,18/ORGS,1/0,17/ENTRY 
*         VFD    12/0,24/ORGL,24/WCL
* 
*                ((WCL) ECS TEXT WORDS) 
* 
*         VFD    24/ENDL,18/ENDS,18/WCS 
* 
*                (CM TEXT WORDS)
* 
*         FORMAT 2 (MULTIPLE NAMED ENTRY POINTS):                              .
* 
*         VFD    12/5300B,12/LEV,18/ORGS,1/1,17/-K
* 
*                ((K) ENTRY POINT DEFINITIONS)
* 
*         VFD    12/0,24/ORGL,24/WCL
* 
*                ((WCL) ECS TEXT WORDS) 
* 
*         VFD    24/ENDL,18/ENDS,18/WCS 
* 
*                (CM TEXT WORDS)
* 
*         LEV   = OVERLAY LEVEL NUMBERS. (MUST = 0, SINCE ONLY A MAIN 
*                 OVERLAY WILL BE LOADED.)
*         ORGS  = OVERLAY LOAD ADDRESS. 
*         ENTRY = ENTRY POINT ADDRESS OF OVERLAY. 
*         K     = NUMBER OF ENTRY POINT DEFINITIONS (OF SAME FORMAT AS
*                 IN *EASCM* TABLE).
*         ORGL  = LOAD ADDRESS OF ECS TEXT, IF ANY. 
*         WCL   = LENGTH OF ECS TEXT. 
*         ENDL  = LWA+1 OF FIXED ECS AREA USED BY THIS OVERLAY. 
*         ENDS  = LWA+1 OF FIXED CM AREA USED BY THIS OVERLAY.
*         WCS   = LENGTH OF CM TEXT.  IF ZERO, THEN THE CM TEXT CONSISTS
*                 OF THE REMAINDER OF THE LOGICAL RECORD. 
* 
* 
*              PROCESSING IS AS FOLLOWS 
* 
*         1)   THE COMPLIANCE OF RULES FOR ABSOLUTE LOADS IS VERIFIED 
* 
*              A)   NOTHING ELSE HAS BEEN LOADED. 
*              B)   THE LOAD ADDRESS IS NOT LESS THAN RA+100B.
*              C)   THE OVERLAY IS A (0,0) OVERLAY. 
* 
  
 OVL53    BX6    X5          SAVE 1ST WORD OF HEADER
          MX3    -12
          SA6    T1 
          SX7    B1          SET PROGRAM COUNT = 1
          SA2    PC 
          SA7    A2 
          NZ     X2,OVLERR1  IF SOMETHING ALREADY LOADED
          SX1    X6          (X1) = ENTRY INDICATOR 
          LX6    -18
          SB6    X6-BASE
          NG     B6,OVLERR3  IF LOAD ADR < RA+100 
          LX6    -18
          BX2    -X3*X6 
          NZ     X2,OVLERR2  IF NOT A (0,0) OVERLAY 
  
**        2)   THE ENTRY POINT(S) ARE SAVED IN THE TABLE *TOVEPT*.
*              IF MULTIPLE ENTRY POINTS ARE NOT SPECIFIED, A SINGLE 
*              ADDRESS IS PLACED IN THIS TABLE. 
* 
  
          BX0    -X1         NUMBER OF ENTRY POINTS 
          SB7    X0 
          NG     X1,OVL53B   IF MULTIPLE ENTRY POINT HEADER 
          ADDWRD TOVEPT,X1   ENTER SINGLE ENTRY ADDRESS 
          EQ     OVL53C 
  
 OVL53B   SA0    L
          ALLOC  TOVEPT,X0   ALLOCATE SPACE FOR ENTRIES 
          SB6    X2 
          READW  A0,B6,B7    READ ENTRY LIST
  
**        3)   IF ANY ECS TEXT IS PRESENT, IT IS READ AND MOVED TO THE
*              PROPER PLACE IN ECS. 
* 
  
 OVL53C   READO  L           READ ECS FIELD DESCRIPTOR
          MX3    -24
          BX0    -X3*X6      (X0) = ECS LENGTH
          AX6    24 
          BX5    -X3*X6      (X5) = ECS ORIGIN
          IFTEST EQ,IP.MECS,0,3 
          ZR     X0,OVL53E   IF NO ECS FIELD
          ERROR  104         ---- INSUFFICIENT ECS FL FOR LOAD
          EQ     ABEND
  
 ECS      IFTEST NE,IP.MECS,0 
          SA2    ECSFL
          IX4    X0+X5       LWA+1 OF ECS FIELD 
          IX2    X2-X4
          PL     X2,OVL53C1  IF ENOUGH ECS FL 
          ERROR  104         ---- INSUFFICIENT ECS FL FOR LOAD
          EQ     ABEND
  
 OVL53C1  SA1    ECSPA       ADVANCE ECS PROGRAM ADDRESS
          IX6    X1+X0
          SA6    A1 
 OVL53D   ZR     X0,OVL53E   IF END OF ECS FIELD  (OR NONE) 
          READO  L           READ NEXT WORD 
          BX2    X5          (X2) = NEXT ECS STORE ADDRESS
          SX7    B1 
          IX0    X0-X7       DOWN WORD COUNT
          IX5    X5+X7       UP STORE ADDRESS 
          RJ     WE=         WRITE (X6) TO ECS
          EQ     OVL53D      LOOP 
  
 ECS      ENDIF 
  
**        4)   THE WORD CONTAINING *ENDL* AND *ENDS* IS READ, AND, IF 
*              PRESENT, THESE FIELDS ARE STORED IN THE HEADER WORD IN 
*              BITS 36-59 AND 18-35, RESPECTIVELY.
* 
*              THE REMAINDER OF *ACPM* PROCESSING IS DONE BY THE
*              *ASCM* (50-TABLE) PROCESSOR, BEGINNING AT STEP 3.
  
 OVL53E   MX0    24+18
          READO  L           READ WORD WITH *ENDL* AND *ENDS* 
          BX4    X0*X6
          SA5    T1          (X5) = 1ST HEADER WORD 
          SB3    X6-1        (B3) = (CM TEXT LENGTH) - 1
          BX2    -X0*X5      KEEP ENTRY POINT FIELD IN HEADER 
          BX1    X5 
          ZR     X4,OVL53F   IF *ENDL* AND *ENDS* NOT GIVEN 
          IX5    X4+X2       PLACE IN HEADER WORD 
 OVL53F   AX1    18          (X1) = LOAD ADR - *BASE* 
          SX1    X1-BASE
          LX5    -18         POSITION TO TIE-IN WITH OTHER ROUTINE
          SA4    TOVEPT      SET (X0) = LENGTH OF ENTRY POINT 
          MX6    42          LIST IF MULTIPLE ENTRY POINTS
          SA3    X4 
          BX0    X6*X3
          SA3    A4+B1
          MX2    0           CM SPACE INDICATOR FOR *APS* 
          SX7    B1+B1       SET CONTROL FOR REQUEST PROCESSOR
          SA7    REQTYPE
          ZR     X0,OVL50D   IF NO MULTIPLE ENTRY POINT LIST
          BX0    X3          (X0) = LENGTH OF LIST
          EQ     OVL50D 
 EASCM    TITLE  LOAD INPUT - EASCM TABLE (51-HEADER).
**        EASCM TABLE - ABSOLUTE CPU OVERLAY. 
* 
*         CODE = 51.
* 
*         CYBER LOADER EASCM/ABS TABLE PROCESSOR
* 
* 
*              THE *EASCM* TABLE SPECIFIES AN ABSOLUTE OVERLAY
*         CONTAINING MULTIPLE NAMED ENTRY POINTS.  IT HAS NONE OF THE 
*         OTHER CAPABILITIES OF THE *ACPM* TABLE, HOWEVER.
* 
*         VFD    12/5100B,12/LEV,18/ORGS,18/K 
* 
*         LEV  = OVERLAY LEVELS (MUST BE ZERO HERE).
*         ORGS = OVERLAY LOAD ADDRESS.
*         K    = NUMBER OF ENTRY POINT DEFINITION WORDS FOLLOWING,
*                WHICH ARE OF THE FORMAT:                                      .
* 
*         VFD    42/0LNAME,18/ADR 
* 
*         NAME = ENTRY POINT NAME.
*         ADR  = ENTRY POINT ADDRESS. 
* 
*         FOLLOWING THE ENTRY POINT DEFINITION WORDS, AND TO THE END
*         OF THE LOGICAL RECORD, IS THE CM TEXT OF THE OVERLAY. 
* 
* 
*              PROCESSING IS AS FOLLOWS 
* 
*         1)   THE ENTRY POINT LIST IS PLACED IN TABLE *TOVEPT*.
* 
*              CONTROL THEN TRANSFERS TO THE *ASCM* (50-TABLE)
*              PROCESSOR, BEGINNING WITH STEP 2.
  
 OVL51    SX0    X5          (X0) = NO. OF ENTRY POINTS IN LIST 
          ZR     X0,OVL50    IF NONE, GO ENTER ONE ENTRY OF ZERO
          ALLOC  TOVEPT,X0
  
*         IT IS SAFE TO ASSUME THAT TABLE *TOVEPT* WILL BE EMPTY
*         AT THIS POINT, BECAUSE, IF IT IS NOT, THIS IS AN ERROR
*         CONDITION, SINCE NOTHING ELSE MUST HAVE BEEN LOADED BEFORE
*         AN ABSOLUTE LOAD.  IF SOMETHING HAS BEEN LOADED, SUCH 
*         WILL BE DETECTED FURTHER ON.
  
          SB6    X2 
          READW  L,B6,X0     READ ENTRY NAMES INTO TABLE
          SB3    B0          NO CM LENGTH GIVEN 
          EQ     OVL50A      GO TO PROCESSOR FOR BOTH TYPES 
 ASCM     TITLE  LOAD INPUT - ASCM TABLE (50-HEADER). 
**        ASCM TABLE - ABSOLUTE CPU OVERLAY.
* 
*         CODE = 50.
* 
*         CYBER LOADER ASCM/OVL TABLE PROCESSOR 
* 
* 
*              THE *ASCM* TABLE SPECIFIES AN ABSOLUTE OVERLAY CONTAINING
*         ONLY ONE UNNAMED ENTRY POINT AND NO ECS TEXT. 
* 
*         VFD    12/5000B,12/LEV,18/ORGS,18/ENTRY 
* 
*         LEV   = OVERLAY LEVELS (MUST BE ZERO HERE). 
*         ORGS  = OVERLAY LOAD ADDRESS. 
*         ENTRY = ENTRY POINT ADDRESS OF OVERLAY. 
* 
*         THE REMAINDER OF THE LOGICAL RECORD CONSISTS OF THE CM TEXT 
*         OF THE OVERLAY. 
* 
* 
*              PROCESSING IS AS FOLLOWS 
* 
*         1)   THE ENTRY ADDRESS IS PLACED IN *TOVEPT*. 
* 
  
 OVL50    MX1    -18         PLACE THE ENTRY ADDRESS ALONG WITH 
          SX0    B0          A ZERO NAME IN THE ENTRY POINT TABLE 
          SB3    B0          NO CM LENGTH GIVEN 
          ADDWRD TOVEPT,-X1*X5
  
**        2)   THE COMPLIANCE OF RULES FOR ABSOLUTE LOADS IS VERIFIED,
*              AS FOR THE *ACPM* TABLE. 
* 
  
 OVL50A   SX7    B1 
          SA4    PC          ERROR IF ANYTHING LOADED 
          MX2    0           CM SPACE INDICATOR 
          MX3    -12
          SA7    A4          SET FOR ONE PROGRAM LOADED 
          ZR     X4,OVL50B
 OVLERR1  SA1    PN          GET CURRENT PROGRAM NAME 
          BX7    X1 
          ERROR  304,X7      --- FE0304***ABS INPUT IN RELOCATABLE LOAD 
          EQ     ABEND
  
 OVL50B   SX7    B1+B1       SET CONTROL FOR REQUEST PROCESSOR
          SA7    REQTYPE
          LX5    24          THIS MUST BE A (0,0) OVERLAY, OR 
          BX4    -X3*X5      ELSE IT IS AN ERROR
          LX5    -42
          ZR     X4,OVL50C   IF (0,0) OVERLAY 
 OVLERR2  ERROR  305         ---- ABS INPUT NOT (0,0) LEVEL OVERLAY 
          EQ     ABEND
  
 OVL50C   SX1    X5-BASE     CHECK LOAD ADDRESS 
          PL     X1,OVL50D   IF \ RA+100B  (BASE) 
 OVLERR3  ERROR  306         ---- ABS INPUT LOAD ADR LT RA+100
          EQ     ABEND
  
**        3)   AT THIS POINT, THE LOAD IS FLAGGED AS ABSOLUTE, WHICH
*              PROHIBITS THE PROCESSING OF ANY SUBSEQUENT LOAD INPUT. 
*              ALSO, THE SUBROUTINE *APS* IS CALLED IN ORDER TO ALLOCATE
*              ANY PROGRAM SPACE BETWEEN RA+100B AND THE LOAD ADDRESS 
*              OF THE OVERLAY.  NORMALLY THESE ARE EQUAL. 
* 
  
 OVL50D   SX7    B1          SET ABSOLUTE LOAD FLAG 
          SA7    ABS
          SX7    BASE+1 
          SA7    TPGM+1 
          SA7    PO 
          SA7    PA 
          SA7    BI 
          LX5    18          RESTORE HEADER WORD
          SA0    TPGM 
          RJ     APS=        ALLOCATE SPACE FOR AREA BELOW OVERLAY
  
**        4)   THE OVERLAY HEADER WORD, AND ENTRY POINT LIST, IF
*              PRESENT, IS MOVED TO THE CORE IMAGE TABLE *TPGM*.
* 
  
          BX6    X5          STORE HEADER WORD IN HIGHEST WORD
          IX7    X2+X3       ALLOCATED TO *TPGM*  (NORMALLY TO
          SA6    X7-1        BE RA+100B)
          ALLOC  A2,X0       ALLOCATE SPACE FOR ENTRY LIST
          SA1    TOVEPT      (X1) = FWA FOR FETCH 
          SB4    X3          (B4) = STORE POINTER 
          MX3    42 
          SA1    X1          1ST ENTRY
          BX4    X3*X1
          ZR     X4,OVL50G   IF ENTRY FROM 50-TABLE 
 OVL50F   BX6    X1 
          ZR     X0,OVL50G   IF NO MORE 
          SA6    B4          STORE ENTRY
          SX0    X0-1 
          SB4    B4+B1
          SA1    A1+B1       NEXT ENTRY 
          EQ     OVL50F      LOOP 
  
**        5)   THE CM TEXT IS READ AND MOVED INTO *TPGM*. 
  
 OVL50G   SX6    B0 
          SA4    TPGM 
          SA3    A4+B1
          SA6    MT          SET MEMORY THRESHOLD TO ZERO FOR ABS LOADS 
          SA1    UP 
          ZR     X1,OVL50H   IF NO *USEP* HONORED 
          ERROR  206         ---- USEP INVALID FOR ABS LOAD 
          EQ     ABEND
  
 OVL50H   BSS    0
          SB3    B3+B1       LENGTH + 1 
          LE     B3,B1,OVL50G.1    NO LENGTH SPECIFIED FOR CM BLOCK 
  
**        5A)  IF THE CM BLOCK LENGTH IS SPECIFIED, THE OVERLAY HEADER
*              WAS ACTUALLY A 53 OR 54 TABLE.  IF SO, THE PRECONDITIONS 
*              FOR *LOADA* COMPLETION ARE CHECKED.  THESE ARE 
* 
*                1)  NO ERRORS HAVE BEEN FOUND SO FAR.
*                2)  THIS IS NOT A *CID*, *PMD*, OR TRAP RUN. 
*                3)  IF NOS/BE, THE PROGRAM IS NOT BEING LOADED FROM CM.
* 
*              IF THIS CRITERIA IS MET, THE DEFER FLAG IS SET AND AN
*              IMMEDIATE RETURN IS MADE TO *RDR*. 
  
          SA1    FE          FATAL ERROR FLAG 
          SA2    NE          NON-FATAL ERROR COUNT
          BX1    X1+X2
          SA2    TRAPADR     TRAP RUN FLAG
          NZ     X1,OVL50G.3 IF ERRORS FOUND
          SA1    ID          *CID*, *PMD* FLAG
          BX2    X1+X2
          NZ     X2,OVL50G.3 IF TRAP OR *CID* ON
 IS       IFSCOPE 
          SA1    /CCIO/CALL 
          SX2    X1-3RCIO 
          NZ     X2,OVL50G.3 IF CM LOAD 
 IS       ENDIF 
  
          SX7    X3+B3
          SX6    B3 
          SA7    PA          FINAL PA OF LOAD 
          SA6    DEFER       FLAG AS DEFERRED LOAD
          SMSG   (=C/  PERFORM DEFERRED LOAD/)
          SX1    B1          PSEUDO EOR 
          EQ     RDR         EXIT TO *RDR*
  
 OVL50G.1 BSS    0
          SA1    TN          SPACE AVAIL = TEND-TPGM-TN-SPACE USED
          SA2    TEND 
          SB2    X1 
          IX4    X2-X4       TEND-TPGM
          IX4    X4-X1       TEND-TPGM-TN 
          IX4    X4-X3
 OVL50G.2 SB2    B2-B1       DECREMENT TABLE COUNT
          R=     A3,A3+2     NEXT TABLE LENGTH
          IX4    X4-X3
          GT     B2,B1,OVL50G.2 
          SB3    X4          LENGTH ALLOCATED 
 OVL50G.3 ALLOC  TPGM,B3
          READW  L,X3,B3     READ CM TEXT BLOCK 
          R=     B3,IP.FLINC
          ZR     X1,OVL50G.3 IF NO EOR
          PL     X1,OVL50G.4  IF NOT *EOF*
          SX1    B6          LWA OF WORKING BUFFER
 OVL50G.4 BSS    0
          SA2    TPGM 
          SA3    A2+B1
          IX3    X3+X2       LWA+1 OF TPGM
          IX3    X1-X3       AMOUNT TO DEALLOCATE FROM TPGM 
          ALLOC  A2,X3
          SA6    PA          ADVANCE PROGRAM ADDRESS
          SX1    B1          FLAG LOADER STOPPED BY EOR 
          EQ     RDR         EXIT *RDR* ROUTINE 
  
 OVLYCK   ENDIF 
 SYM      SPACE  4,8
**        SYMBOL TABLE - PROCESSOR SYMBOL TABLE.
* 
*         CODE = 56.
* 
*              THE *SYMBOL* TABLE CONSISTS OF SYMBOL TABLE ENTRIES
*         CREATED BY A HIGH LEVEL PROCESSING LANGUAGE.  UNDER USER
*         CALL LOADER (AND WHEN BIT 0 OF WORD *ID* IS NOT SET) THESE
*         TABLES WILL BE IGNORED.  OTHERWISE THE *TFID* ENTRY FOR THIS
*         PROGRAM IS UPDATED, THE PROCESSOR BITS SET IN THE 
*         INTERACTIVE DEBUG CONTROL BYTE (IDCB) AND THE TABLE COPIED
*         TO FILE *ZZZZZDT*.
* 
*         HEADER WORD.
* 
*         VFD    12/5600,12/WC,12/PB,24/XX
* 
*         WC   = WORD COUNT.
*         PB   = PROCESS BITS.  BITS 0-9 ARE SAVED INTO THE IDCB. 
*         XX   = NOT USED BY LOADER.
* 
*         ENTRY  (B7) = LENGTH OF TABLE.
*         EXIT   TO *LIN*.
*                *CTLPT* UPDATED WITH PROCESSOR BITS. 
*         CALLS  SKT. 
  
  
 IC       IFUSER
 SYM      EQ     SKT         SKIP THIS TABLE
 IC       ELSE
 SYM      SA1    ID 
          LX1    59-0 
          PL     X1,SKT      IF WE ARE NOT SAVING THESE TABLES
          SA1    TFID+1 
          BX6    X5          (X6) = HEADER WORD 
          AX1    1           CHECK FOR *TFID* LENGTH .LT. 2 
          ZR     X1,LIN1     IF NOT CALLING INTERACTIVE DEBUG 
          MX6    -10
          LX6    24 
          BX6    -X6*X5      PROCESSOR BITS 
          SA2    CTLPT
          BX7    X6+X2
          SA7    A2          UPDATE PROCESSOR BITS
          LX6    24 
          SA4    PI 
          SA1    A1-B1       (X1) = FWA *TFID*
          AX4    1           PI/2 
          SA2    X1          K
          IX2    X4-X2       PI/2 - K 
          BX3    X2 
          LX3    1
          IX3    X3+X2       (PI/2 - K) * 3 
          SB4    X3+B1       (PI/2 - K) * 3 + 1 = INDEX INTO *TFID* 
          SA2    X1+B4       *TFID* ENTRY FOR THIS PROGRAM
          SA3    A2+B1
          BX6    X6+X2
          SA6    A2          UPDATE *SL* FIELD IN *TFID* ENTRY
          MX7    30 
          BX7    X7*X3
          BX6    X5 
          NZ     X7,LIN1     IF THIS IS NOT FIRST SYMBOL TABLE
          SA1    LA 
          LX1    30 
          BX7    X1+X3
          SA7    A3          UPDATE *SYM* FIELD IN *TFID* ENTRY 
          EQ     LIN1 
 IC       ENDIF 
 LIN      SPACE  4,8
**        LINE TABLE - PROCESSOR LINE NUMBERS.
* 
*         CODE = 57.
* 
*              THE *LINE* TABLE CONSISTS OF LINE NUMBERS IN THE HIGH
*         LEVEL PROCESSING LANGUAGE.  UNDER USER CALL LOADER THESE
*         TABLES ARE IGNORED.  OTHERWISE THEY ARE COPIED TO FILE
*         *ZZZZZDT* IF BIT 0 OF WORD *ID* IS SET.  THE LOGICAL DISK 
*         ADDRESS *LA* IS UPDATED ON EACH COPY.  THE FORMAT OF
*         THIS TABLE IS OF NO CONCERN TO THE LOADER.
* 
*         HEADER WORD.
* 
*         VFD    12/5700,12/WC,12/PB,24/0 
* 
*         WC   = WORD COUNT.
*         PB   = PROCESSOR BITS.  (NOT USED BY LOADER). 
* 
*         ENTRY  (B7) = LENGTH OF TABLE.
*         EXIT   TO *RDR*.
*         CALLS  RDO=, SKT, WTO=. 
  
  
 IC       IFUSER
 LIN      EQ     SKT         SKIP THIS TABLE
 IC       ELSE
 LIN      SA1    ID 
          BX6    X5 
          LX1    59-0 
          PL     X1,SKT      IF WE ARE NOT SAVING THESE TABLES
          SA1    TFID+1 
          AX1    1           CHECK FOR *TFID* LENGTH .LT. 2 
          ZR     X1,LIN1     IF NOT CALLING INTERACTIVE DEBUG 
          SA4    PI          PROGRAM INDEX
          SA1    A1-B1       (X1) = FWA *TFID*
          AX4    1           PI/2 
          SA2    X1          K
          IX2    X4-X2       PI/2 - K 
          BX3    X2 
          LX3    1
          IX3    X3+X2       (PI/2 - K) * 3 
          SB4    X3+B1       (PI/2 - K) * 3 + 1 = INDEX INTO *TFID* 
          SA2    X1+B4       CURRENT *TFID* ENTRY 
          SA2    A2+2 
          NZ     X2,LIN1     IF THIS IS NOT FIRST LINE TABLE
          SA4    LA          GET LOGICAL DISK ADDRESS 
          MX1    30 
          BX7    -X1*X4 
          SA7    A2          INSERT *LIN* FIELD INTO *TFID* 
 LIN1     SA1    LA          UPDATE LOGICAL DISK ADDRESS
          SX7    B7+B1
          IX7    X7+X1
          SA7    A1 
 LIN2     WRITEO O
          ZR     B7,RDR1     IF NO MORE WORDS TO COPY IN TABLE
          READO  L           READ NEXT WORD OF TABLE
          SB7    B7-B1       DECREMENT LENGTH OF TABLE
          EQ     LIN2 
 IC       ENDIF 
 CAP      TITLE  LOAD INPUT - CAPSULE TABLE.
**        CAPSULE/OVCAP TABLE.
* 
*         CODE = 60.
* 
*         CYBER LOADER CAPSULE/OVCAP TABLE PROCESSOR. 
* 
*              THE CAPSULE/OVCAP TABLE IS A SPECIAL RELOCATABLE BINARY
*         CREATED BY THE CAPSULE/OVCAP GENERATOR.  CAPSULES ARE 
*         LOADABLE BY THE CYBER LOADER (STATICALLY) OR BY THE FAST
*         DYNAMIC LOADER (DYNAMICALLY).  OVCAPS ARE NOT STATICALLY
*         LOADABLE.  ALL ADDRESSES IN THE CAPSULE/OVCAP BINARY ARE
*         RELOCATED RELATIVE TO THE FIRST HEADER WORD WHICH IS BY 
*         DEFINITION ADDRESS ZERO (0).  THE CAPSULE OR OVCAP
*         BINARY IS A SINGLE LOADER TABLE WHICH HAS SIX (6) LOGICAL 
*         PARTS: 1) THE HEADER, 2) THE CODE IMAGE, 3) THE ENTRY 
*         POINT LIST, 4) THE EXTERNAL REFERENCE LIST, 5) THE EXTERNAL 
*         REFERENCE CHAINS, AND 6) THE RELOCATION TABLE.  THE FORMAT
*         OF THE CAPSULE/OVCAP BINARY TABLE IS AS FOLLOWS:  
* 
*         CAPSULE/OVCAP HEADER: (3 WORDS LONG)
* 
*         VFD    12/6000B,12/EPCT,12/XRCT,5/0,1/F,18/L
*         VFD    42/0LGNAME,18/EPLPTR 
*         VFD    42/0LCNAME,18/RELPTR 
* 
*         EPCT   = ENTRY POINT COUNT. 
*         XRCT   = EXTERNAL REFERENCE COUNT.
*         F      = 0 IF CAPSULE, = 1 IF OVCAP.
*         L      = TOTAL CAPSULE LENGTH.
*         GNAME  = GROUP NAME.
*         EPLPTR = ENTRY POINT LIST POINTER.
*         CNAME  = CAPSULE NAME.
*         RELPTR = RELOCATION TABLE POINTER.
* 
*         CODE IMAGE: (VARIABLE LENGTH) 
* 
*         SELF-EXPLANATORY, RELOCATION AS INDICATED ABOVE, UNRESOLVED 
*         EXTERNAL REFERENCE FIELDS ARE SET TO 400000B+ADR+CONTENTS.
* 
*         ENTRY POINT LIST: (VARIABLE LENGTH) 
* 
*         VFD    42/0LENAME,18/ADR
* 
*         ENAME  = ENTRY POINT NAME.
*         ADR    = ENTRY POINT ADDRESS. 
* 
*         EXTERNAL REFERENCE LIST: (VARIABLE LENGTH)
* 
*         VFD    42/0LXNAME,1/W,17/CHADR
* 
*         XNAME  = EXTERNAL NAME. 
*         W      = 0 IF STRONG EXTERNAL.
*                = 1 IF WEAK EXTERNAL.
*         CHADR  = ADDRESS OF EXTERNAL REFERENCE CHAIN. 
* 
*         EXTERNAL REFERENCE CHAINS: (VARIABLE LENGTH)
* 
*         VFD    20/0,2/P,18/ADR,2/P,18/ADR,...(1 CHAIN PER EXTERNAL) 
* 
*         P      = 1 IF UPPER PARCEL. 
*                = 2 IF MIDDLE PARCEL.
*                = 3 IF LOWER PARCEL. 
*         ADR    = ADDRESS OF REFERENCE.
* 
*         RELOCATION TABLE: (VARIABLE LENGTH) 
* 
*         ONE 4-BIT RELOCATION PARCEL FOR EACH WORD IN THE CAPSULE
*         HEADER OR CODE IMAGE.  RELOCATION INDICATORS ARE IDENTICAL
*         TO RELOCATION INDICATORS IN *TEXT* TABLES.
* 
* 
*              PROCESSING IS AS FOLLOWS:  
* 
  
 CAP      BSS    0
 IC       IFCARD
          RJ     CFP         CHECK FOR FIRST PROGRAM UNDER FID
          SX1    B0 
          SX2    B0 
          RJ     IDE         CREATE *TFID* ENTRY IF NECESSARY 
 IC       ENDIF 
          BX7    X5 
          SA7    CAPHDR      SAVE FIRST WORD OF CAPSULE HEADER
          READO  L
          SA6    CAPHDR+1    SAVE SECOND HEADER WORD
          READO  L
          SA6    CAPHDR+2    SAVE THIRD HEADER WORD 
          LX5    59-18       CHECK FOR OVCAP BINARY 
          PL     X5,CAP1     IF NOT OVCAP BINARY
          MX1    42          (X7) = OVCAP NAME FOR ERROR MESSAGE
          BX7    X1*X6
          ERROR  525,X7      ---- OVCAP BINARY NOT STATICALLY LOADABLE
          EQ     ABEND
  
 CAP1     BSS    0
          MX0    42 
          BX6    X0*X6       42/0LNAME,18/0 
          SA6    PN          SAVE PROGRAM NAME
          SA1    PC 
          SX7    X1+B1
          SA7    A1          BUMP PROGRAM COUNT 
 IC       IFCARD
          NZ     X1,CAP1B    IF NOT FIRST PROGRAM LOADED
          SA2    OG 
          SB2    X2          (B2) = (OG)
          NE     B2,B1,CAP1A  IF NOT OVERLAY GENERATION 
          SA6    ON          SET OVERLAY NAME 
          SA2    OGL1        CHECK FOR (0,0)
          NZ     X2,CAP1A    IF NOT (0,0) 
          SA6    CURGPNAM    SET *CURGPNAM* IN CASE OVCAP GEN FOLLOWS 
 CAP1A    LE     B2,B1,CAP1B IF NOT OVCAP GENERATION
          SA6    CURCPNAM    SET *CURCPNAM* FOR OVCAP GENERATION
 CAP1B    BSS    0
          SA2    SEGFLAG
          NZ     X2,CAP4     IF SEGMENT LOAD, BLOCKS ALREADY DEFINED
 IC       ENDIF 
  
**        1)   THE SUBROUTINE *EBD* IS CALLED TO ENTER THE PROGRAM
*              BLOCK DEFINITION IN *TBLK*.
* 
  
          BX1    X6          (X1) = 42/0LNAME,18/0 (CM PROGRAM BLOCK) 
          SA2    CAPHDR+1    SECOND WORD OF CAPSULE HEADER
          R=     X5,X2-3     (X5) = CAPSULE LENGTH (CODE IMAGE ONLY)
          SA4    FI 
          LX4    24 
          IX5    X4+X5       (X5) = 25/0,11/FI,24/LENGTH
          RJ     EBD         ENTER BLOCK DEFINITION 
          R=     X7,X7-1
          SA7    PI          SET PROGRAM INDEX
          NZ     X6,CAP4     IF PROGRAM NOT PREVIOUSLY LOADED 
  
**        2)   THE OCCURENCE OF MORE THAN ONE PROGRAM OF THE SAME NAME
*              WITHIN THE LOAD RESULTS IN A NON-FATAL ERROR.
* 
*              IF THE DUPLICATE IS FROM A FILE IT IS SKIPPED. 
* 
*              UNDER NOS, A DUPLICATE FROM A LIBRARY IS SKIPPED WITHOUT 
*              COMMENT.  THIS IS A FAIRLY COMMON OCCURRENCE DURING
*              OVERLAY GENERATION OR USER-CALL LOADING DUE TO THE 
*              CROSS-REFERENCED STRUCTURE OF NOS LIBRARIES. 
* 
*              UNDER SCOPE, A DUPLICATE FROM A LIBRARY IS LOADED. 
*              THE BLOCK DEFINITION MUST BE PLACED INTO *TBLK*
*              WITHOUT CALLING *EBD*, SINCE *EBD* WILL NOT ENTER
*              DUPLICATE BLOCK NAMES. 
* 
  
          SA2    FI          CHECK FILE TYPE
          SA1    TLFN 
          SB2    X2 
          SA3    X1+B2
          SX3    X3          (X3) = 0 IF FILE, NONZERO IF LIBRARY 
          SA4    TBLK 
          SB2    X4 
          SA2    X7+B2
          BX7    X0*X2       (X7) = PROGRAM NAME
 K        IFNOS 
          NZ     X3,CAP2     IF FROM LIB (SKIP WITHOUT MESSAGE, NOS)
 K        ELSE
          NZ     X3,CAP3     IF FROM LIBRARY (LOAD WITH MESSAGE, SCOPE) 
 K        ENDIF 
          ERROR  4103,X7     ---- DUPLICATE PROGRAM BEING SKIPPED 
 CAP2     SA5    CAPHDR 
          R=     X5,X5-3     (X5) = REMAINING TABLE WORD COUNT
          RJ     SKP         SKIP THIS PROGRAM
          ZR     X1,RDR2     IF NOT EOR CONTINUE FILE READ
          EQ     RDR         IF AT EOR EXIT FILE READ 
  
 CAP3     ERROR  4104,X7     ---- DUPLICATE PROGRAM BEING LOADED
          SA1    X2+B2       (X1) = 42/0LNAME,18/0
          SA3    FI          FILE INDEX 
          SA2    PA          PROGRAM ADDRESS
          SA4    CAPHDR+1 
          R=     X4,X4-3     CAPSULE LENGTH (CODE IMAGE ONLY) 
          LX3    24 
          BX3    X3+X4
          LX3    24 
          BX5    X3+X2       (X5) = 12/FI,24/L,24/PA
          ADDWRD TBLK,X1     STORE NEW *TBLK* ENTRY 
          ADDWRD A2,X5
          SX7    B1 
          IX7    X4-X7
          SA7    PI          SET PROGRAM INDEX
  
**        3)   THE *TPRX* INDEX IS ADDED TO THE *TBLK* ENTRY. 
*              THE CURRENT VALUE OF *PA* IS SAVED, PROGRAM SPACE IS 
*              ALLOCATED VIA *APS=*, AND THE ENTIRE CAPSULE BINARY
*              (EXCEPT FOR THE HEADER) IS READ INTO *TPGM*. 
* 
  
 CAP4     SA3    TPRX 
          SA1    A6-B1       GET OLD DEFINITION 
          SA3    X3          GET *TPRX* INDEX 
          LX3    3           POSITION INDEX 
          BX6    X1+X3       MERGE IN INDEX 
          SA6    A1          STORE NEW DEFINITION 
          SA1    PA 
          BX6    X1 
          SA6    CAPPA       SAVE CURRENT PROGRAM ADDRESS 
          SA3    CAPHDR 
          R=     X1,X3-3     (X1) = TOTAL CAPSULE LENGTH (LESS HEADER)
          MX2    0           INDICATE CM SPACE
          SB3    X1          (B3) = REMAINING WORD COUNT OF CAPSULE 
          SA3    TPGM 
          SA4    A3+B1
          SB6    X4          (B6) = CURRENT LENGTH OF *TPGM*
          RJ     APS=        ALLOCATE PROGRAM SPACE 
          SA1    TPGM 
          SB6    X1+B6       (B6) = FWA *TPGM* + OLD LENGTH *TPGM*
          READW  L,B6,B3     READ CAPSULE BINARY INTO *TPGM*
  
**        4)   SUBROUTINE *RCI* IS CALLED TO RELOCATE THE CODE IMAGE. 
* 
  
          SA1    TPGM        FWA *TPGM* 
          SA2    CAPPA       OLD *PA* 
          R=     A0,X2-3     (A0) = OLD *PA* - HEADER LENGTH
          SA3    PO 
          SA4    BI 
          IX5    X1+X2
          IX5    X5-X3
          IX0    X5+X4       (X0) = FWA *TPGM* + OLD *PA* - PO + BI 
*                            (ABSOLUTE ADDRESS OF CAPSULE IN *TPGM*)
          SA3    CAPHDR 
          SA4    CAPHDR+2 
          SX3    X3          (X3) = TOTAL CAPSULE LENGTH
          SX4    X4          (X4) = POINTER TO RELOCATION TABLE 
          IX3    X3-X4
          SB6    X3          (B6) = WORD COUNT OF RELOCATION TABLE
          R=     B7,X4-3     (B7) = INDEX TO CAPSULE RELOCATION TABLE 
          RJ     RCI         RELOCATE CAPSULE CODE IMAGE
  
**        5)   ENTRY POINT NAMES AND ADDRESSES ARE ADDED TO TABLE 
*              *TEPT*.  SUBSEQUENT PROCESSING BY SUBROUTINE *CPR* 
*              WILL PUT THE ENTRY POINT INFORMATION INTO *TLNK*.
* 
  
          SA0    TPGM        (A0) = POINTER TO *TPGM* FWA 
          SA1    CAPPA
          R=     B2,X1-3     (B2) = RELOCATION ADDRESS (CAPPA-3)
          SA2    PO 
          SA3    BI 
          IX1    X1-X2
          IX1    X1+X3       CAPPA - PO + BI
          SB3    X1          (B3) = FWA CODE IMAGE (RELATIVE TO *TPGM*) 
          SA2    CAPHDR 
          SA3    A2+B1
          LX2    24 
          R=     X3,X3-3     ENTRY POINT LIST POINTER (RELATIVE TO HDR) 
          SX2    X2          ENTRY POINT COUNT
          SB4    X3+B3       (B4) = FWA ENTRY LIST (RELATIVE TO *TPGM*) 
          SB5    X2+B4       (B5) = LWA+1 OF ENTRY LIST POINTER 
          MX0    42 
 IC       IFCARD
          SA3    SEGFLAG
          ZR     X3,CAP5     IF NOT SEGMENT LOAD
          SB4    B5          ELSE ENTRY POINTS ALREADY DEFINED
 IC       ENDIF 
 CAP5     GE     B4,B5,CAP6  IF ENTRY POINT LIST EXHAUSTED
          SA3    A0          FWA *TPGM* 
          SA1    X3+B4       NEXT ENTRY POINT 
          SB4    B4+B1       BUMP POINTER 
          SX2    X1+B2       ENTRY POINT ADDRESS (RELOCATED)
          BX1    X1*X0       (X1) = 42/0LNAME,18/0
          SA5    PI          PROGRAM INDEX
          LX5    36 
          BX5    X2+X5       (X5) = 6/0,18/PI,12/0,24/ADR 
          ADDWRD TEPT,X1     ADD TO *TEPT*
          ADDWRD A2,X5
          EQ     CAP5        CONTINUE WITH NEXT ENTRY POINT 
  
**        6)   EXTERNAL REFERENCES ARE ADDED TO TABLE *TLBC*. 
*              SUBSEQUENT PROCESSING BY SUBROUTINE *CPR* WILL 
*              PUT THE EXTERNAL REFERENCE INFORMATION INTO *TLNK*.
* 
  
*              FROM PREVIOUS PROCESSING WE ALREADY HAVE 
*              (A0) = POINTER TO *TPGM* FWA POINTER 
*              (B4) = (B5) = LWA+1 OF ENTRY LIST (RELATIVE TO *TPGM*) 
*                          = FWA OF EXTERNAL LIST 
*              (B2) = CAPPA - 3 
*              (B3) = CAPPA - PO + BI 
  
 CAP6     SA1    CAPHDR 
          MX0    -12
          LX1    36 
          BX1    -X0*X1      NUMBER OF EXTERNALS
          SB5    X1+B5       (B5) = LWA+1 OF EXTERNAL LIST
          R=     B2,B2+400000B  (B2) = 400000B + CAPPA - 3
          R=     B3,B3-3     (B3) = CAPPA - PO + BI - 3 
                                   (ADDRESS OF WHERE *6000* HEADER
                                   WOULD BE RELATIVE TO *TPGM*) 
 CAP7     GE     B4,B5,CAP12  IF DONE WITH ALL EXTERNALS
          MX0    42 
          SA3    A0          FWA *TPGM* 
          SA1    X3+B4       NEXT EXTERNAL NAME 
          SB4    B4+B1       BUMP POINTER 
          BX2    X0*X1       42/0LNAME,18/0 
          BX3    -X0*X1      42/0,1/W,17/CHAIN ADR (REL TO HDR) 
          MX6    43 
          BX1    -X6*X1      CHAIN ADDRESS REL TO *6000* HEADER 
          SB6    X1+B3       (B6) = CHAIN ADDRESS RELATIVE TO *TPGM*
          AX3    17          WEAK BIT ONLY
          BX2    X2+X3       (X2) = 42/0LNAME,17/0,1/W
          ADDWRD TLBC,X2     ADD NAME AND *WEAK* BIT TO *TLBC*
          SA3    A0          FWA *TPGM* 
          SA5    X3+B6       (X5) = FIRST XREF CHAIN WORD FOR THIS EXT
          SB6    B6+B1       BUMP CHAIN POINTER 
          MX0    -20         (X0) = PARCEL MASK 
          R=     B7,2        (B7) = PARCEL COUNTER
          LX5    20          IGNORE FIRST ZERO PARCEL 
          MX4    0           (X4) = COLLECTION WORD 
 CAP8     NZ     B7,CAP9     IF MORE PARCELS IN THIS XREF CHAIN WORD
          SA3    A0          FWA *TPGM* 
          SA5    X3+B6       (X5) = NEXT XREF CHAIN WORD FOR THIS EXT 
          SB6    B6+B1       BUMP CHAIN POINTER 
          R=     B7,3        (B7) = PARCEL COUNTER
 CAP9     LX5    20          SHIFT TO NEXT PARCEL 
          SB7    B7-B1       DECREMENT PARCEL COUNT 
          BX3    -X0*X5      (X3) = CURRENT PARCEL (40/0,2/P,18/ADR)
          SX2    X3+B3       (X2) = ADDRESS OF WORD CONTAINING EXTERNAL 
                                    REFERENCE (RELATIVE TO *TPGM*)
          AX3    18          (X3) = 0 (END OF CHAIN), 1 (UPPER FIELD),
                                    2 (MIDDLE FIELD), 3 (LOWER FIELD) 
          NZ     X3,CAP10    IF NOT END OF CHAIN
          ZR     X4,CAP7     IF NO MORE TRAILER BYTES TO ADD TO *TLBC*
          ADDWRD TLBC,X4     ADD LAST TRAILER BYTE FOR THIS EXTERNAL
          EQ     CAP7        GO TO PROCESS NEXT EXTERNAL
  
 CAP10    R=     X1,3 
          IX1    X1-X3       CHANGE TO 2=UPPER, 1=MIDDLE, 0=LOWER 
          SX3    B1 
          LX3    2
          BX3    X3+X1
          LX3    27 
          BX3    X3+X2       (X3) = 30/0,1/1,2/P,1/0,1/0,7/0,18/ADR 
                                   (*TLBC* TRAILER PARCEL FORMAT) 
          MI     X4,CAP11    IF ONE PARCEL ALREADY IN COLLECTION WORD 
          LX3    30          SHIFT TO UPPER HALF OF WORD
          BX4    X3          COLLECT TRAILER PARCEL IN X4 
          EQ     CAP8        GO FOR NEXT XREF CHAIN PARCEL
  
 CAP11    BX4    X4+X3       COLLECT TRAILER PARCEL IN X4 
          ADDWRD TLBC,X4     ADD TRAILER BYTES FOR THIS EXTERNAL
          MX4    0           SET COLLECTION WORD EMPTY
          EQ     CAP8        GO FOR NEXT XREF CHAIN PARCEL
  
**        7)   UNSATISFIED EXTERNAL REFERENCES HAVE BEEN SET TO 
*              400000B + ADR + CONTENTS IN THE CODE IMAGE.
*              WE MUST NOW CHANGE ALL SUCH ADDRESS FIELDS BACK TO 
*              CONTENTS ONLY. 
* 
  
*              FROM PREVIOUS PROCESSING WE HAVE 
*              (A0) = POINTER TO *TPGM* FWA POINTER 
*              (B4) = (B5) = LWA+1 OF EXTERNAL LIST (RELATIVE TO *TPGM*)
*                          = FWA OF REFERENCE CHAINS
*              (B2) = 400000B + CAPPA - 3 
*              (B3) = CAPPA - PO + BI - 3 
*                   = ADDRESS OF WHERE *6000* HEADER WOULD BE RELATIVE
*                     TO FWA OF *TPGM*.  THE *6000* HEADER IS PURPOSELY 
*                     NOT LOADED TO SAVE CM SPACE.
  
 CAP12    SA1    A0          FWA *TPGM* 
          SA0    X1          (A0) = FWA *TPGM* (NO TABLE MOVES EXPECTED)
          SA1    CAPHDR+2 
          SB5    X1+B3       (B5) = LWA+1 OF REFERENCE CHAINS 
          MX0    -20         (X0) = PARCEL MASK 
          MX1    -18         (X1) = ADDRESS FIELD MASK
 CAP13    GE     B4,B5,CAP15  IF ALL REFERENCE CHAINS PROCESSED 
          SA4    A0+B4       (X4) = NEXT REFERENCE CHAIN WORD 
          SB4    B4+B1       BUMP POINTER 
          R=     B7,3        (B7) = PARCEL COUNT
 CAP14    LX4    20          SHIFT TO NEXT PARCEL 
          SB7    B7-B1       DECREMENT PARCEL COUNT 
          MI     B7,CAP13    IF DONE WITH THIS REFERENCE CHAIN WORD 
          BX5    -X0*X4      (X5) = 40/0,2/P,18/ADR (REL TO *6000* HDR) 
          BX6    X1*X5
          SX5    X5          (X5) = ADDRESS RELATIVE TO *6000* HEADER 
          AX6    18          (X6) = 0 (NO PARCEL), 1 (UPPER PARCEL),
                                    2 (MIDDLE PARCEL), 3 (LOWER PARCEL) 
          ZR     X6,CAP14    IF A DO NOTHING PARCEL 
          SX6    X6+B1       PROCEED TO CALCULATE 15(P+1) 
          BX7    X6 
          LX7    4
          IX7    X7-X6
          SB6    X7          (B6) = 15(P+1) = SHIFT COUNT 
          SX6    A0+B3
          IX6    X6+X5       (X6) = ABSOLUTE ADDRESS OF WORD WITH XREF
          SA2    X6          (X2) = WORD WITH EXTERNAL REFERENCE
          LX2    B6          SHIFT ADDRESS FIELD TO BITS 17-0 
          BX6    X1*X2       SAVE ALL BUT ADDRESS FIELD 
          BX2    -X1*X2      SAVE ONLY ADDRESS FIELD
          SX2    X2          SIGN EXTEND
          SX7    X5+B2       (X7) = 400000B + CAPPA - 3 + ADR REL TO HDR
          IX2    X2-X7       LEAVE ONLY ORIGINAL CONTENTS IN X2 
          BX2    -X1*X2      SAVE ONLY LOW ORDER 18 BITS
          BX6    X6+X2       PUT ORIGINAL CONTENTS WITH REST OF WORD
          R=     B6,B6-60    CALCULATE AMOUNT TO SHIFT BACK 
          SB6    -B6         SHIFT COUNT = 60 - ORIGINAL AMOUNT 
          LX6    B6          SHIFT BACK TO ORIGINAL FORMAT
          SA6    A2          WRITE WORD BACK INTO *TPGM*
          EQ     CAP14       GO PROCESS NEXT XREF CHAIN PARCEL
  
**        8)   *PA* AND THE LENGTH OF *TPGM* ARE ADJUSTED SUCH THAT 
*              ONLY THE CAPSULE CODE IMAGE IS RETAINED IN *TPGM*. 
* 
  
 CAP15    SA1    PA 
          SA2    TPGM+1 
          SA3    CAPHDR 
          SA4    A3+B1
          SX3    X3          TOTAL CAPSULE LENGTH 
          SX4    X4          POINTER TO ENTRY POINT LIST
          IX5    X3-X4       EXCESS LENGTH
          IX6    X1-X5       DECREMENT *PA* 
          IX7    X2-X5       DECREMENT *TPGM* LENGTH
          SA6    A1          STORE CORRECT *PA* 
          SA7    A2          STORE CORRECT *TPGM* LENGTH
          EQ     RDR1        GO TO PROCESS NEXT TABLE 
  
 CAPHDR   BSS    3           CAPSULE HEADER SAVE AREA 
 CAPPA    BSS    1           SAVE AREA FOR *PA* AT ENTRY (BEFORE *APS=*)
  
          SPACE  4,8
**        RCI - RELOCATE CAPSULE CODE IMAGE.
* 
*         ENTRY  (A0) = RELOCATION ADDRESS FOR CAPSULE. 
*                (X0) = ADDRESS OF CAPSULE CODE IMAGE.
*                (B6) = WORD COUNT OF CAPSULE RELOCATION TABLE. 
*                (B7) = INDEX TO CAPSULE RELOCATION TABLE.
*         EXIT   ADDRESSES WITHIN CAPSULE RELOCATED RELATIVE TO FWA.
*         USES   ALL REGISTERS. 
*         CALLS  /LOADG/CAPREL. 
  
 RCI      PS                 ENTRY/EXIT 
 IC       IFCARD
          SA1    OG 
          SB2    X1          (B2) = (OG)
          ZR     B2,RCI0     IF BASIC RELOCATABLE LOAD OR SEGMENT LOAD
          EQ     B2,B1,RCI0  IF OVERLAY GENERATION
          RJ     /LOADG/CAPREL  UPDATE *TCPREL* FOR CAPSULE/OVCAP GENER 
 IC       ENDIF 
 RCI0     BSS    0
  
*         FORM ADDRESS RELOCATION TABLE TXTA (RCIA).
  
          SB2    B1+B1       (B2) = 2 
          SB4    TXTA        (B4) = FWA OF RELOCATION ADDRESSES 
          MX5    42 
          SX1    A0          L+ 
          BX6    -X1-X5      L- 
          LX7    X1          L+ 
          SA6    B4+B2       (RCIA+2) = L-
          SA7    A6+B1       (RCIA+3) = L+
          LX6    15          M- 
          BX2    -X1-X5      L- 
          LX7    15          M+ 
          SA6    A7+B1       (RCIA+4) = M-
          SA6    A6+B1       (RCIA+5) = M-
          LX6    15          U- 
          SA7    A6+B1       (RCIA+6) = M+
          BX3    X6          U- 
          SA7    A7+B1       (RCIA+7) = M+
          LX4    X1 
          SA6    A7+B1       (RCIA+10) = U- 
          IX7    X3+X2       U- L-
          SA6    A6+B1       (RCIA+11) = U- 
          LX4    30          U+ 
          IX6    X3+X1       U- L+
          SA7    A6+B1       (RCIA+12) = U- L-
          SA6    A7+B1       (RCIA+13) = U- L+
          BX7    X4          U+ 
          IX6    X4+X2       U+ L-
          SA7    A6+B1       (RCIA+14) = U+ 
          SA7    A7+B1       (RCIA+15) = U+ 
          BX7    X4+X1       U+ L+
          SA6    A7+B1       (RCIA+16) = U+ L-
          SA7    A6+B1       (RCIA+17) = U+ L+
  
*         INITIALIZE FOR RELOCATION LOOP. 
  
          SA0    X0          (A0) = FWA OF CODE IMAGE (ABSOLUTE)
          SA5    A0-B1
          BX6    X5          (X6) = PREVIOUS WORD 
          SA5    A0          (A5/X5) = FIRST TEXT WORD
          SA1    A0+B7       (A1/X1) = RELOCATION BYTES 
          R=     B7,10       (B7) = BYTE COUNT FOR X1 
          R=     B2,18       (B2) = 18 = CARRY SHIFT
          SB3    TXTB        (B3) = FWA OF ADDRESS MASKS
          R=     B5,4        (B5) = 4 = BYTE SHIFT
          MX0    -4          (X0) = BYTE MASK 
          LX1    16          IGNORE HEADER RELOCATION BYTES 
          BX4    -X0*X1      FIRST CONTROL BYTE 
          SA3    B3+X4       FIRST ADDRESS MASK WORD
          LX1    4           SHIFT TO NEXT CONTROL BYTE 
          SA4    B4+X4       FIRST RELOCATION WORD
          BX7    -X5*X3      EXTRACT COMPLEMENT ADDRESS FIELDS
          IX2    X7+X4       ADD COMPLEMENT ADDRESSES 
  
*         MAIN RELOCATION LOOP, BASED ON ANCIENT CODE BY GREG MANSFIELD.
  
 RCI1     BX5    -X3*X5      REMOVE ADDRESSES FROM TEXT 
          SA6    A5-B1       STORE PREVIOUS WORD
          SB7    B7-B1       DECREMENT WORD COUNT 
          BX4    -X3*X2      EXTRACT CARRYS 
          AX7    X4,B2
          IX2    X2+X7       ADD CARRYS 
          BX4    -X0*X1      NEXT RELOCATION BYTE 
          LX1    B5          SHIFT CONTROL WORD 
          BX7    -X2*X3      MASK AND COMPLEMENT ADDRESSES
          SA3    B3+X4       NEXT ADDRESS MASK WORD 
          BX6    X7+X5       INSERT RELOCATED ADDRESSES 
          SA4    B4+X4       NEXT RELOCATION WORD 
          SA5    A5+B1       NEXT TEXT WORD 
          NO
          BX7    -X5*X3      EXTRACT COMPLEMENT ADDRESS FIELDS
          IX2    X7+X4       ADD COMPLEMENT ADDRESSES 
          PL     B7,RCI1     IF MORE RELOCATION BYTES, LOOP 
          SB7    B2-B5       RESET BYTE COUNTER 
          SA1    A1+B1       GET NEXT WORD OF RELOCATION BYTES
          SB6    B6-B1       DECREMENT RELOCATION TABLE WORD COUNT
          LX1    B5          POSITION TO FIRST RELOCATION BYTE
          GT     B6,RCI1     IF MORE, LOOP IN STACK 
          SB7    B0 
          PL     B6,RCI1     ONE LAST PASS TO FINISH THE LAST WORD
          SA6    A5-B1       STORE LAST TEXT WORD 
          EQ     RCI         EXIT 
  
 SKT      TITLE  LOAD INPUT - SUBROUTINES.
**        + + + + + + + + + + + + + + 
*         + LOAD INPUT SUBROUTINES. + 
*         + + + + + + + + + + + + + + 
* 
* 
*         SKT - SKIP TABLE. 
* 
*              THIS ROUTINE READS LOAD INPUT UNTIL THE CURRENT BINARY 
*         TABLE IS EXHAUSTED. 
* 
*         ENTRY  (B7) = REMAINING WORD COUNT OF TABLE.
*         EXIT   TO CONTROL ROUTINE.
*         CALLS  RDW=.
  
  
 SKT      SX0    B7 
          SX5    B1 
          ZR     B7,RDR1     IF TABLE EXHAUSTED AT THIS POINT 
 SKT1     READO  L
          IX0    X0-X5
          NZ     X0,SKT1     LOOP TO END OF TABLE 
          EQ     RDR1        PROCESS NEXT TABLE 
 SKP      SPACE  4,8
**        SKP - SKIP PROGRAM. 
* 
*              THIS ROUTINE IS USED TO SKIP TO THE END OF THE PROGRAM 
*         CURRENTLY BEING READ.  THE SKIPPING IS TERMINATED BY EITHER 
*         THE START OF A 77-TABLE OR BY END-OF-RECORD.
* 
*         ENTRY  (X5) = NUMBER OF WORDS REMAINING TO SKIP IN THE
*                       CURRENT TABLE.
*         EXIT   (X1) = 0 IF EOR NOT REACHED. 
*                     " 0 IF EOR REACHED. 
*                (X5) AND LOCATION *T1* = 1ST WORD OF 77-TABLE IF NO
*                     EOR.
*         USES   X - 3, 4, 5, 7.
*                B - NONE.
*                A - 5. 
*         CALLS  RDW=.
  
  
 SKP      PS                 ENTRY/EXIT 
 SKP1     ZR     X5,SKP2     IF END OF TABLE SKIP 
          READO  L
          R=     X5,X5-1     LOOP THROUGH TABLE 
          EQ     SKP1 
  
 SKP2     READO  L           READ 1ST WORD OF NEXT TABLE
          NZ     X1,SKP      EXIT IF EOR
          MX7    -6          (X3) = TABLE CODE
          BX3    X6 
          LX3    6
          BX3    -X7*X3 
          R=     X4,X3-1R0
          PL     X4,SKP4     IF A BINARY TABLE
 SKP3     MX7    -12         SKIP OVER DIRECTIVE
          BX7    -X7*X6 
          ZR     X7,SKP2     IF ZERO BYTE 
          READO  L           NEXT WORD OF DIRECTIVE 
          NZ     X1,SKP      EXIT IF EOR
          EQ     SKP3        LOOP 
  
 SKP4     BX4    -X7-X3      CHECK TABLE NUMBER 
          BX5    X6 
          ZR     X4,SKP      EXIT IF START OF 77-TABLE, (X1) = 0
          LX6    24          POSITION FOR WORD COUNT
          R=     X4,X3-50B   CHECK IF AN OVERLAY-TYPE TABLE 
          NG     X4,SKP6     IF CODE < 50 
          R=     X4,X3-54B
          PL     X4,SKP6     IF CODE > 53 
 SKP5     READO  L           READ TO EOR IF OVERLAY 
          ZR     X1,SKP5     LOOP 
          EQ     SKP         EXIT ON EOR
  
 SKP6     SX5    X6          SET TABLE WORD COUNT 
          EQ     SKP1        GO SKIP TABLE
 CKC      SPACE  4,8
**        CKC - CHECK IF CONDITIONAL TABLE. 
* 
*              THIS ROUTINE IS USED FOR CONDITIONAL TABLE PROCESSING
*         OF ALL TABLES WHICH HAVE THE CONDITIONAL INDICATOR IN 
*         BITS 12-20 OF THE HEADER WORD.
* 
*         ENTRY  (B7) = TABLE LENGTH (NOT USED BUT MUST BE SAVED).
*                (X5) = TABLE HEADER WORD.  BITS 12-20 CONTAIN ZERO OR
*                       A CONDITIONAL INDICATOR.
*         EXIT   RETURN IS THROUGH RETURN JUMP IF TABLE IS
*                  TO BE PROCESSED. 
*                RETURN IS TO LOCATION *SKT* IF TABLE IS NOT
*                  TO BE PROCESSED. 
*         USES   X - 1, 2, 3, 6, 7. 
*                B - 2, 3, 4. 
*                A - 1, 2, 3. 
*         CALLS  NONE.
  
  
 CKC      PS                 ENTRY/EXIT 
          BX1    X5 
          MX7    -9          (X6) = CONDITIONAL INDICATOR 
          LX1    -12
          BX6    -X7*X1 
          ZR     X6,CKC      IF NOT A CONDITIONAL TABLE 
          SA2    TRLB        (B2) = FWA RELOC BASE TABLE
          SA3    PI          (B3) = PROGRAM INDEX 
          SB2    X2          (X1) = RELOC BASE TABLE ENTRY
          SB3    X3 
          SA1    B2+X6       (B4) = TBLK INDEX OF ENTRY 
          LX1    24 
          SB4    X1 
          IFCARD 2
          SA2    SEGFLAG
          NZ     X2,CKC1     IF A SEGMENT LOAD
          LT     B4,B3,SKT   IF TABLE TO BE SKIPPED 
          EQ     CKC         RETURN TO PROCESS TABLE
  
 SEG      IFCARD
 CKC1     SA1    TBLK 
          MX3    -11
          SA2    X1+B4       *TBLK* DEFINITION
          SX1    B1 
          LX2    12 
          BX3    -X3*X2 
          IX3    X3-X1
          NZ     X3,SKT      IF DEFINED EARLIER 
          SA1    B2+X6       GET *TRLB* ENTRY 
          LX1    36 
          MI     X1,SKT      IF OUTSIDE SEGMENT 
          EQ     CKC
 SEG      ENDIF 
  
          QUAL
          IFUSER 3
 HDOPTC   EQU    /READ/HDOPTC 
 HDOPTI   EQU    /READ/HDOPTI 
 HDOPTX   EQU    /READ/HDOPTX 
 EBD      TITLE  MORE SUBROUTINES.
**        +++++++++++++++++++++ 
*         + MORE SUBROUTINES. + 
*         +++++++++++++++++++++ 
* 
* 
*         EBD - ENTER BLOCK DEFINITION. 
* 
*              THIS ROUTINE ADDS A BLOCK NAME AND DEFINITION TO THE 
*         TABLE *TBLK*, PROVIDED THE NAME IS NOT ALREADY IN THE TABLE.
* 
*         ENTRY  (X1) = VFD  42/NAME,16/0,1/E,1/T 
*                       E = 0 IF CM BLOCK.
*                         = 1 IF ECS BLOCK. 
*                       T = 0 IF PROGRAM BLOCK. 
*                         = 1 IF COMMON BLOCK.
*                (X5) = LENGTH IN BITS 0-23, FILE INDEX IN BITS 24-34.
*         EXIT   (X7) = INDEX OF DEFINITION.
*                (X5) = DEFINITION. 
*                (X6) = 0 IF BLOCK PREVIOUSLY DEFINED, AND
*                (X2) = NEW LENGTH. 
*         USES   X - 2, 3, 4, 5, 6, 7.
*                B - 2, 3, 4, 5.
*                A - 2, 3, 4, 5, 6. 
*         CALLS  ADW=.
  
  
 EBD2     MX2    -24         (X2) = INCOMING LENGTH 
          SX7    B5+B1       SET INDEX
          BX2    -X2*X5 
          MX3    1
          SA5    A3-B1       PREVIOUS DEFINITION
          BX6    -X3*X5      FORCE BLOCK USED 
          SA6    A5 
          MX6    0           FLAG REDEFINITION
 EBD      PS                 ENTRY/EXIT 
          SA3    TBLK        BEGIN BLOCK TABLE SEARCH 
          SA2    A3+B1
          BX6    X1          STORE NAME AT LWA+1
          SB2    B1+B1       (B2) = 2 
          SB3    X2          (B3) = LENGTH
          SB4    X3+B2       (B4) = FWA+1 ENTRY 
          SA6    X3+B3
          SA3    X3          FIRST ENTRY
          MX4    42+3 
          SB5    -B2         (B5) = POSITION COUNTER
          LX4    3
 EBD1     BX2    X3-X6       COMPARE NAMES
          SA3    A3+B2       NEXT ENTRY 
          BX2    X4*X2       CURSE - *TPRX* POINTER MUST BE MASKED
          SB5    B5+B2       ADVANCE COUNTER
          NZ     X2,EBD1     LOOP TO HIT
          NE     B5,B3,EBD2  IF NOT LAST ENTRY
  
*         ENTER NEW DEFINITION. 
  
          ADDWRD TBLK,X1     ENTER NAME 
          SA3    PA          PROGRAM ADDRESS TO BITS 0-23 
 ECS      IFTEST NE,IP.MECS,0 
          LX1    59-1        CHECK BLOCK TYPE 
          LX5    24          LENGTH TO BITS 24-47 
          PL     X1,EBD1A    IF CM BLOCK
          SA3    ECSPA       SET ECS PROGRAM ADDRESS
 EBD1A    BX5    X5+X3       (X5) = DEFINITION
 ECS      ENDIF 
          IFTEST EQ,IP.MECS,0,2 
          LX5    24          LENGTH TO BITS 24-47 
          BX5    X5+X3       (X5) = DEFINITION
          ADDWRD A2,X5       ENTER DEFINITION 
          SX6    B1          SET NEW DEFINITION 
          BX7    X4          SET INDEX
          EQ     EBD         RETURN 
 ELT      SPACE  4,8
**        ELT - ENTER LINK TABLE. 
* 
*              THIS ROUTINE IS USED FOR ALL SEARCHING AND ADDING OF 
*         ENTRIES TO THE TABLE OF ENTRY POINTS AND EXTERNALS, *TLNK*. 
*         IT IS ALSO USED FOR *TLNK2*, WHICH IS MAINTAINED IN THE SAME
*         FORMAT FOR USE AS INPUT TO THE LIBRARY DIRECTORY SEARCH 
*         ROUTINE, *SLD*, DURING *LIBLOAD* REQUESTS.
*              THESE TABLES ARE KEPT IN ASCENDING ORDER BY NAME AND 
*         SEARCHED BY A BINARY SEARCH.  ALTHOUGH MORE CPU TIME MIGHT
*         BE SPENT THAN IF THE TABLE WERE HASHED, A GREATER BENEFIT 
*         IS REALIZED IN HAVING THE TABLE IN ASCENDING ORDER WHEN IT IS 
*         USED DURING LIBRARY DIRECTORY SEARCHING.
* 
*         ENTRY  (X1) = NAME LEFT-JUSTIFIED, BITS 0-17 IGNORED. 
*                (X2) = DEFINITION FOR 2ND WORD OF ENTRY IF A NEW 
*                          ENTRY IS TO BE ADDED, OR 
*                     = 0 IF ONLY TO SEARCH.
*                (B1) =  1 IF TO USE *TLNK*.
*                       -1 IF TO USE *TLNK2*. 
*                *SN* = CURRENT SEGMENT ORDINAL IF A SEGMENT LOAD.
*         EXIT   (B1) = 1.
*                (X2) = 0 IF NO ENTRY WAS TO BE MADE AND NAME WAS NOT 
*                          IN TABLE, OR 
*                     = DEFINITION FROM 2ND WORD OF ENTRY.
*                (X6) = INDEX OF DEFINITION UNLESS X2 = 0 ON EXIT.
*                (A7) = ADDRESS OF DEFINITION IF DEFINITION ADDED.
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4. 
*                A - 1, 2, 3, 4, 6, 7.
*                   (A1 NOT USED IF CALLED WITH X2 = 0.)
*         CALLS  ATS=, MVE=.
  
  
 ELT6     ALLOC  B4,2,FRONT  ADD 2 WORDS TO FRONT OF TABLE
          BX3    X2          TO = NEW FWA 
          SB3    X2 
          IX2    X2+X1       FROM = NEW FWA + 2 
          SX1    B2          LENGTH = INDEX 
 ELT7     MOVE   X1,X2,X3    MOVE NECESSARY ENTRIES 
          SA1    ELTA 
          SA2    A1+B1
          BX6    X1 
          LX7    X2 
          SA6    B3+B2       ADD NEW ENTRY
          SA7    A6+B1       ADDRESS OF DEFINITION
          SX6    B2+B1       INDEX OF DEFINITION
  
 ELT      PS                 ENTRY/EXIT 
          SX3    B1 
          MX4    42 
          SX6    TLNK 
          SX7    TLNK2
          AX3    59 
          BX1    X4*X1
          BX6    -X3*X6 
          LD     B1,1 
          BX7    X3*X7
          LX1    -18
          IX3    X6+X7       *TLNK* OR *TLNK2* POINTER
          BX6    X2 
          SB4    X3          (B4) = TABLE POINTER 
          BX7    X1 
          SA6    ELTA+1      SAVE DEFINITION OR 0 
          SA2    B4+B1
          SA3    X3 
          SA7    A6-B1       SAVE ENTRY POINT NAME
          SB2    X3 
          SB3    X3          (B3) = FWA OF TABLE
          R=     X4,X2+2     LENGTH+2 
          ZR     X2,ELT5     IF TABLE EMPTY 
          MX7    14 
          NX6,B2 X2 
          AX2    X7,B2       -ENTIER(LOG2(LENGTH/2))+1
          BX7    -X2
          LX3    X7,B1
          SA3    X3+B3       FIRST TRY
          SX7    X7+B1
          IX6    X1-X3
          SB2    A3 
          ZR     X6,ELT2     IF A MATCH 
          AX7    1
          AX6    59 
          ZR     X7,ELT4     IF TABLE IS ONLY ONE ENTRY 
          BX6    -X6
          R=     B2,B3-2     FWA-2
          BX2    X6*X4       0 OR LENGTH+2
          SA3    X2+B2       FWA-2 OR FWA+LENGTH
 ELT1     AX6    59 
          BX2    X6-X7       DIRECTED DISTANCE
          ZR     X7,ELT4     IF ENTRY NOT IN TABLE
          LX2    1           DISTANCE * 2 FOR 2 WORD ENTRIES
          SB2    X2 
          AX7    1
          SA3    A3+B2       NEXT MIDPOINT
          IX6    X1-X3
          NZ     X6,ELT1     IF NO MATCH
          SB2    A3          (B2) = ADDRESS OF WHERE ENTRY SHOULD BE
 ELT2     EQ     B2,B3,ELT3  IF AT FRONT OF TABLE 
          R=     A3,B2-2
          IX6    X1-X3
          SB2    A3 
          MI     X6,ELT5     IF THIS IS REALLY FIRST OF DUP ENTRIES 
          ZR     X6,ELT2     IF NAMES ARE THE SAME
          R=     B2,B2+2
 ELT3     SA2    B2+B1       DEFINITION 
          SX6    A2-B3       INDEX OF DEFINITION
          IFCARD 4
          SA3    SEGFLAG
          ZR     X3,ELT      IF NOT A SEGMENT LOAD
          MI     X3,ELT      IF NOT SECOND PASS 
          RJ     /LOADS/FCE  FIND COMPATIBLE ENTRY
          EQ     ELT
  
 ELT4     SX3    B1 
          SB2    A3+B1
          BX3    X3-X6       1 OR -1
          SB2    B2+X3       (B2) = ADDRESS OF WHERE ENTRY SHOULD BE
 ELT5     SA2    ELTA+1 
          ZR     X2,ELT      IF ONLY TO SEARCH
          SB2    B2-B3       INDEX OF ENTRY 
          SA1    B4+B1
          AX1    1
          SB3    X1 
          LT     B2,B3,ELT6  IF NEW ENTRY IN LOWER HALF OF TABLE
          ALLOC  B4,2        ADD 2 WORDS TO END OF TABLE
          SX7    B2 
          SB3    X2 
          SX2    X2+B2       FROM = FWA + INDEX 
          IX3    X2+X1       TO = FWA + INDEX + 2 
          IX1    X4-X7       LENGTH = OLD LENGTH - INDEX
          EQ     ELT7 
  
 ELTA     BSSZ   2           NEW ENTRY SAVE AREA
 PFE      SPACE  4,10 
**        PFE - PTEXT FIELD EXTRACTION. 
* 
*             THIS ROUTINE EXTRACTS THE FIELDS FROM THE *PTEXT* TABLE 
*         AND SAVES THEM IN TEMPORARY CELLS.
* 
*         ENTRY  (X5) = 18/TLB,6/FB,1/R,2/0,9/RB,24/FWA 
*                (X6) = 12/0,24/K,24/C
* 
*         EXIT   (A0) = 51/0,9/RB 
*                (X1) = NUMBER OF TEXT WORDS WHICH FOLLOW 
*                (X6) = LWA+1 OF TEXT 
*                (PTXTFWA) = FWA
*                (PTXTK)   = INCREMENT IN BITS
*                (PTXTC)   = REPLICATION COUNT
*                (PTXTFB)  = FIRST BIT
*                (PTXTTLB) = TOTAL LENGTH IN BITS 
*                (PTXTLWA) = LWA+1 OF TEXT
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6, 7.
*                B - 7. 
*                A - 6, 7.
  
  
 PFE      PS     0           ENTRY/EXIT 
          MX0    -24
          BX4    -X0*X6      (X4) = C (REPLICATION COUNT) 
          AX6    24 
          BX2    -X0*X5      (X2) = FWA 
          BX3    -X0*X6      (X3) = K (INCREMENT IN BITS) 
          NZ     X4,PFE1     IF *C* NONZERO 
          SX4    B1          C = 1
 PFE1     LX6    X2 
          BX7    X4 
          SA6    PTXTFWA
          SA7    PTXTC
          LX5    18 
          MX0    -18
          BX6    -X0*X5 
          LX7    X3 
          SA6    PTXTTLB     (X6) = TLB (LENGTH IN BITS)
          NZ     X3,PFE2     IF *K* NONZERO 
          BX7    X6 
          LX3    X6          K = TLB
 PFE2     SA7    PTXTK
          LX5    6
          MX0    -6 
          BX7    -X0*X5 
          R=     X0,59
          IX7    X0-X7       59 - BIT SHIFT COUNT 
          SA7    PTXTFB      (X7) = FB (FIRST BIT)
          LX5    12 
          MX0    -9 
          BX5    -X0*X5 
          R=     X0,59
          SA0    X5          (A0) = RELOCATION BASE 
          IX5    X6+X0       TLB+59 
          IX7    X0-X7       59-FB
          IX7    X5+X7
          SX6    B1 
          IX4    X4-X6       C-1
          IX6    X3*X4       K(C-1) 
          IX3    X7+X6
          SX0    X0+B1       (X0) = 60
          IX6    X3/X0,B7    (X6) = NUMBER OF PROGRAM LOCATIONS 
          PX5    X5          IX1  X5/X0,B7
          NX5    X5 
          FX1    X5/X0
          UX1    X1,B7
          LX1    X1,B7       (X1) = NUMBER OF TEXT WORDS IN TABLE 
          IX6    X6+X2       (X6) = LWA+1 OF TEXT 
          SA6    PTXTLWA
          EQ     PFE         RETURN 
  
 PTXTLTH  CON    0           WORD COUNT OF *PTEXT* TABLE
 PTXTCR   CON    0           CONDITIONAL INDICATOR
 PTXTTLB  CON    0           TEXT LENGTH IN BITS
 PTXTFB   CON    0           FIRST BIT
 PTXTFWA  CON    0           FWA
 PTXTK    CON    0           INCREMENT IN BITS
 PTXTC    CON    0           REPLICATION COUNT
 PTXTLWA  CON    0           LWA+1 OF TEXT
  
  
          RELOC  OFF
