*COMDECK BLOAD3 
          USE    // 
 LOCC     BSSZ   1           ORIGIN FOR LOADC AND LOADUC
 BLOADC   TITLE  EXTERNAL REQUEST SCANNER.
          IDENT              EXTERNAL REQUEST SCANNER 
          IFCARD 1
 SCAN'    SET    0
          IFUSER 1
 SCAN'    SET    2
          QUAL   LOADC
*CALL BLOADC
 INIT     TITLE  INITIALIZATION.
          IDENT              INITIALIZATION 
          SPACE  4,8
 IC       IFCARD
**        *LOADLDR* ENTRY POINT.                                         LDR0238
* 
*              THIS ENTRY POINT PROVIDES A WAY TO TEST THE LOADER 
*         WITHOUT INSTALLING IT IN THE RUNNING SYSTEM.  IT JUST READS 
*         UP THE NEXT CONTROL CARD AND THEN PASSES CONTROL TO THE LOADER
*         PROPER.  SINCE THIS IS THE FIRST DECLARED ENTRY POINT, IT IS
*         THE ONE ENTERED IF THE LOADER IS EXECUTED FROM A LOCAL FILE.
*         IT CAN ALSO BE USED TO CALL THE LOADER FROM A SCOPE USER
*         LIBRARY.
* 
*         EXAMPLE - LOADER EXECUTED FROM A FILE:  
*                ATTACH(LOADER....
*                LOADER.
*                <LOAD SEQUENCE TO BE PROCESSED>
* 
*         EXAMPLE - LOADER EXECUTED FROM A LIBRARY: 
*                ATTACH(LDRLIB....
*                LDSET(LIB=LDRLIB)
*                LOADLDR.                                                LDR0238
*                <LOAD SEQUENCE TO BE PROCESSED>
  
  
 LOADLDR  SB1    1           (B1) = 1                                    LDR0238
 NOS      IFNOS 
  
          SA1    TEND        INSURE MINIMUM FL AVAILABLE
          SX1    X1+IP.FLINC  = (INITIAL LWA OF TABLES) + IP.FLINC
          SX2    A0          (X2) = CURRENT FL
          MX7    -6          (X1) = DESIRED FL, ROUNDED UP
          IX1    X1-X7
          BX1    X7*X1
          IX6    X2-X1       CURRENT - DESIRED
          PL     X6,LDR1     IF FL ALREADY ADEQUATE 
          SA0    X1          (A0) = NEW FL
          MX2    0           (X2) = CM INDICATOR FOR *MEM=* 
          RJ     MEM=        INCREASE FL
 LDR1     SA1    COMLBIT     IF LOCAL FILE LOAD, SET *NODISSJ* = 1
          SX2    B1           ELSE SET IT = 0 
          AX1    18 
          BX6    X2*X1
          BX6    X2-X6
          SA6    NODISSJ
          SX6    X6+B1       IF LOCAL FILE LOAD, SET *DFMFLAG* = MI 
          LX6    59-1         OTHERWISE, SET PL, NZ 
          SA6    DFMFLAG
          MI     X6,LDR1A    IF LOCAL FILE LOAD, MESSAGE ALREADY ISSUED 
          MESSAGE 70B,R      DAYFILE COMMAND THAT INVOKED LOADER
 LDR1A    BSS    0
 NOS      ENDIF 
 IS       IFSCOPE 
          MESSAGE 70B,R,6 
          SX6    B1 
          SA6    DFMFLAG
 IS       ENDIF 
  
          R=     A1,COMREST 
          MI     X1,INIT     IF RELOADED ITSELF 
          R=     A1,COMARGCT
          SB2    X1 
          ZR     B2,LDR2     IF NO PARAMETERS 
          MESSAGE (=C/ PARAMETERS IGNORED./)
 LDR2     R=     A5,COMNAME  (X5) = FILE NAME 
          RJ     /LOADC/ACE  READ NEXT CONTROL CARD 
          MX6    42 
          SA1    A5 
          BX5    X6*X5
          BX1    -X6*X1 
          BX6    X5+X1       PUT LFN BACK IN RA+64
          SA6    A5 
          SX7    B0 
          SA7    A0-B1       SET (FL-1) = 0 TO FLAG NO LIBRARY SET INFO 
          EQ     INIT 
  
 IC       ENDIF 
          SPACE  4,8
**        + + + + + + + + + + + + + 
*         + INITIALIZATION CODE.  + 
*         + + + + + + + + + + + + + 
* 
* 
*              THIS IS THE FIRST CODE EXECUTED IN *LOADER* OR *LOADU* 
*         (WITH THE EXCEPTION OF THE SELF-RELOCATION CODE IN *LOADU*).
*         IT PERFORMS ALL INITIALIZATION FUNCTIONS REQUIRED BEFORE
*         REQUEST PROCESSING BEGINS.  AFTERWARDS, THE POINTER TO THE
*         START OF THE MANAGE TABLES IS SET SO THAT THIS CODE WILL BE 
*         OVERWRITTEN.
* 
*              REFERENCE SHOULD BE MADE TO THE SECTION IN THE FRONT OF
*         BOTH THE *LOADER* AND *LOADU* IMS WHICH DESCRIBES THE ENTRY 
*         INFORMATION.
* 
*              THE ACTIONS DESCRIBED ARE PREFIXED WITH EITHER OR BOTH 
*         OF THE LETTERS C AND U TO INDICATE THAT IT IS PERFORMED 
*         DURING CONTROL-CARD-INITIATED LOADS OR USER-CALL INITIATED
*         LOADS, RESPECTIVELY 
* 
*         -CU- THE B1 REGISTER IS SET EQUAL TO ONE.  AS DESCRIBED IN THE
*              REGISTER USAGE CONVENTION AT THE START OF THE IMS, 
*              IT IS EXPECTED TO BE LEFT THIS WAY.
* 
  
          RELOC  ON 
 IC       IFCARD
 K        IFNOS 
 SLDR=    BSS    0           SLDR= ENTRY IFF REL LOAD FROM NOS CLD
          R=     A1,COMNAME  GET FILE/ENTRY NAME
          MX7    42 
          BX7    X7*X1       NAME, LEFT JUST, ZERO FILLED 
          SA7    SLDRNAM     SAVE NAME (ALSO USED AS FLAG)
          EQ     INIT        GO TO NORMAL INITIALIZATION
  
 K        ENDIF 
  
 LDR=     SX7    1
          SA7    RUNG        SET RUN(G) INTERMEDIATE FLAG 
 K        IFNOS 
          SA7    NAMCALL
 K        ENDIF 
 IC       ENDIF 
  
 INIT     BSS    0
 LOAD     EQU    INIT 
 LIBLOAD  EQU    INIT 
 SLOAD    EQU    INIT 
 EXECUTE  EQU    INIT 
 NOGO     EQU    INIT 
 SATISFY  EQU    INIT 
 LDSET    EQU    INIT 
 GROUP    EQU    INIT 
 CAPSULE  EQU    INIT 
 SEGLOAD  EQU    INIT 
          IFTEST NE,IP.LDBG,0,1 
 LDPATCH  EQU    INIT 
          LD     B1,1 
  
**        --U- THE POINTERS PASSED IN THE X6 REGISTER ARE STORED, SO AS 
*              TO FREE THE REGISTER.
* 
  
          IFUSER 1
          SA6    T2          SAVE USER CALL INFORMATION 
  
  
**        -C-- *RPV* IS CALLED TO SET RETURN FROM UNCONTROLLED ABORTS.
* 
  
 IC       IFCARD
                             ERROR CLASSES                 SELECTED 
                             -------------                 -------- 
                             001 CPU ERROR EXIT            YES
                             002 PP CALL ERROR             YES
                             004 SRU (RESOURCE) LIMITS     YES
                             010 OPERATOR TERMINATION      YES
                             020 PP ABORT                  YES
                             040 CPU ABORT                 NO 
                             100 NORMAL TERMINATION        NO 
                             200 TERMINAL INTERRUPT        YES
          REPRIEVE  RPVPM,,237B 
 IC       ENDIF 
  
**        -C-- IF THE DEBUGGING CODE WAS ASSEMBLED AND SWITCH(6) IS 
*              ON, *SMP* OR *SPY* IS CALLED.
  
 SPY      IFTEST NE,IP.LDBG,0 
 SPY      IFCARD
          SA1    B0 
          LX1    48 
          PL     X1,NOSPY    IF SSW 6 IS OFF
          IFNOS  2
          R=     X6,3RSMP 
          R=     X1,10000B
          IFSCOPE 3 
          R=     X6,3RSPY 
          SX1    SPYWORD
          PX6 
          LX6    42 
          BX6    X1+X6
          RJ     SYS=        TURN ON *SPY*
 NOSPY    BSS    0
 SPY      ENDIF 
  
  
**        -CU- THE CM AND ECS FIELD LENGTHS ARE SAVED.
*         --U- THE *PILOAD* POINTER (IF ANY) IS SAVED.
* 
  
 IU       IFUSER
          MX6    30 
          BX7    X6*X0
          BX0    -X6*X0      LEAVE X0 WITH ONLY ECS FL
          AX7    30 
          SA7    PLDP        SAVE *PILOAD* POINTER
 IU       ENDIF 
  
          BX7    X0          SAVE ECS FL
          SA7    ECSFL
          SX7    A0          SAVE CM FL 
          SA7    FL 
          SA7    FLI
          IFCARD 1
          SX7    X7-100B     SET INITIAL TABLE LWA+1
 IC       IFCARD
 K        IFNOS 
          SX6    B0 
          SA6    A0-B1       RA+FL-1=0, NO INFO PASSED BY *NOS/1AJ* 
 K        ENDIF 
 IC       ENDIF 
  
**        -C-- THE CURRENT CPU TIME IS OBTAINED IN ORDER TO BE ABLE TO
*              COMPUTE THE TOTAL LOAD TIME AT THE END.  NOTE THAT FOR 
*              USER-CALL LOADS, THE TIME IS OBTAINED IN THE SELF- 
*              RELOCATION ROUTINE.
* 
  
          IFCARD 2
          TIME   TM          GET LOAD START TIME
          RTIME  RTM         GET REAL-TIME
  
  
**        --U- THE USER CALL INFORMATION (ORIGINALLY PASSED IN X6) IS 
*              FETCHED AND FROM THE REQUEST HEADER, THE FWA AND LWA+1 
*              OF THE LOADABLE AREA ARE DETERMINED. 
* 
  
 IU       IFUSER
          SA1    T2          FETCH USER CALL INFORMATION
          SB3    X1          (B3) = FWA USER CALL PARAMETER AREA
          AX1    18          (B4) = LWA+1 USER CALL PARAMETER AREA
          SB4    X1          (B2) = RETURN ADDRESS FROM USER CALL 
          AX1    18 
          SX6    X1 
          SA6    RETURN 
          SB2    X6 
          SX6    B3 
          SA6    CALLADR
          SA1    B3          (B6) = LWA+1 LOADABLE AREA 
          SB6    X1 
          NZ     B6,INIT1    IF NOT SPECIFIED, USE CM FL
          SB6    A0 
 INIT1    AX1    30          (B5) = FWA LOADABLE AREA 
          LD     A2,RA+COMLDLWA 
          SB5    X1 
          MX3    -23
          NZ     B5,INIT2    IF NOT SPECIFIED, USE LWA+1 OF 
          SB5    X2          LAST LOAD
 INIT2    BSS    0
 ECS      IFTEST NE,IP.MECS,0 
          SA1    A1+B1       GET 2ND WORD OF HEADER 
          BX6    -X3*X1      (X6) = ECS LWA+1 
          LX2    24          (X2) = ECS LWA+1 FROM PREVIOUS LOAD
          LX1    30 
          BX2    -X3*X2 
          NG     X1,INIT2A   IF ECS LWA+1 IS TO BE USED 
          NZ     X6,INIT2A   IF ECS LWA NOT SPECIFIED, USE ECS FL 
          BX6    X0 
 INIT2A   BX7    -X3*X1      (X7) = ECS FWA 
          LX1    30 
          NG     X1,INIT2B   IF ECS FWA IS TO BE USED 
          NZ     X7,INIT2B   IF ECS FWA NOT SPECIFIED,
          BX7    X2          USE ECS LWA+1 OF LAST LOAD 
 INIT2B   NZ     X6,INIT2C   IF ECS USED,CHECK LIMITS 
          ZR     X7,INIT2D   IF NO ECS USED, LIMITS ARE OKAY
 INIT2C   IX1    X6-X7       (ECS LWA+1) - (ECS FWA)
          PL     X1,INIT2D   IF ECS LIMITS OKAY 
          ERROR  CAT,(=C*ECS LIMITS ERROR ON USER CALL*)
          SPACE  1
 INIT2D   SA6    ECSLWA 
          SA7    ECSPO
          SA7    ECSPA
 ECS      ENDIF 
  
**        --U- IT THE REQUEST WAS ANYWHERE WITHIN THE LOADABLE AREA, IT 
*              WAS MOVED TO THE TOP OF THE LOADABLE AREA BY *UCLOAD*. 
*              IF THIS IS THE CASE, THE UPPER LIMIT OF THE MANAGE 
*              TABLE AREA WILL BE INITIALLY SET LOWER, SO THAT THE
*              REQUEST WILL REMAIN INTACT UNTIL THE MAIN LOADER REQUEST 
*              TABLE *TREQ* HAS BEEN FORMED.
* 
  
          SX7    B6          TABLE LWA+1 = LOAD AREA LWA+1
          SX6    B1 
          LE     B4,B5,INIT3 IF REQUEST IS ANYWHERE IN LOAD AREA, 
          GE     B3,B6,INIT3 IT WAS PLACED AT TOP OF LOAD AREA
          SA6    NOREQ       BY UCLOAD.  IF SO, SET FLAG. 
          SX7    B3          REDUCE TABLE LWA+1 TEMPORARILY 
 INIT3    GE     B2,B6,INIT4 SET FLAG IF LOCATION OF RETURN FROM
          LT     B2,B5,INIT4 USER CALL IS WITHIN LOAD AREA
          SA6    OVERLOAD 
 INIT4    R=     X7,X7-TABOO SET BELOW FORBIDDEN AREA 
 IU       ENDIF 
  
**        -CU- ABORT IF NOT ENOUGH FL TO EVEN GET STARTED 
* 
  
          SA2    TEND 
          IX2    X7-X2
          PL     X2,INIT4A   IF FL OK TO START
          SX7    B1 
          SA7    ABTTYPE     SET TO ABORT TO EXIT(S)
          ERROR  CAT,(=C*INSUFFICIENT FL FOR LOAD*) 
 INIT4A   BSS    0
          SA7    TEND        SET END OF MANAGE TABLE AREA 
  
**        -C-- ALL FREE SPACE IS NOW CLEARED FOR THE DEBUG VARIANT
*              OF THE LOADER BECAUSE A *DMP* CONTROL CARD IN A LOAD 
*              SEQUENCE WOULD ALLOW ACCESS TO SECURE SYSTEM MEMORY. 
* 
 IC       IFCARD
 DEBUG    IFTEST NE,IP.LDBG,0 
  
          IFNOS  1
          SX3    A0-B1       (X3) = FL - 1
 IS       IFSCOPE 
          MX6    -12
          SA2    A0-B1       (X2) = (FL-1)
 INIT4A1  ZR     X2,INIT4A2  IF NO LIBRARY TABLE
          BX3    -X6*X2      LAST WORD HAS LOWER 12 BITS = 7777B
          BX3    -X6-X3 
          SA2    A2-B1       GET NEXT ENTRY 
          NZ     X3,INIT4A1  IF NOT END OF LIBRARY TABLE
 INIT4A2  SX3    A2          LWA+1 OF AREA TO CLEAR 
 IS       ENDIF 
          SA2    LM          CLEAR ENTIRE TABLE AREA
          RJ     PSM         PRESET MEMORY
  
 DEBUG    ENDIF 
  
**        -C-- LDV/LDR PARAMETERS ARE SET UP TO LOAD THE
*              LOADER OVERLAYS FROM THE CORRECT PLACE.
* 
  
          SA1    COMNAME     FILE/LIBRARY NAME
          BX6    X1 
          R=     A1,A1+COMLBIT-COMNAME
          SA6    LOVPARAM    *LOV* ALWAYS CLEARS LOWER 18 BITS
          LX1    -18         LIBRARY BIT TO BIT 0 
          MX6    59 
          BX6    X6+X1
          LX6    6
          SA1    LOVFLAGS 
          BX6    X6*X1       CLEAR U-BIT IF LOADED FROM FILE
          SA6    A1 
  
**        -C-- THE MAXIMUM ALLOWABLE FL (*MAXFL*) IS OBTAINED.
* 
  
          MX7    29          *T1* = 30/-1,30/0
          SA7    T1 
          SX6    3RMEM
          PX6    X6 
          LX6    42 
          SX1    A7 
          BX6    X6+X1       18/MEM,6/20B,18/0,18/T1
          RJ     SYS= 
          SA1    X6          SAVE MAXIMUM FL
          BX6    X1 
          AX6    30 
          SA6    MFL
  
 IC       ENDIF 
  
          SA1    TPRX                                                    LDR0192
          MX6    0                                                       LDR0192
          SA6    X1          SET FIRST WORD OF *TPRX* TO ZERO            LDR0192
  
**        -CU- THE FLAGS WHICH SPECIFY THE PRESENCE OR ABSENCE OF 
*              VARIOUS HARDWARE OPTIONS ARE NOW SET.
* 
  
          SX1    B1 
          DX7    X1*X1       IX7 IF HARDWARE PRESENT, AND ONLY
          SA7    HDOPTI      THEN RESULT IS NONZERO 
          R=     A3,RA+COMXJ BIT 59 OF *COMXJ* = XJ FLAG
          SA4    MACHAR 
          GETMC  A4          STORE MACHINE CHARACTERISTICS IN *MACHAR*
          SA4    A4 
          LX4    59-20
          MI     X4,INIT4A3  IF SIMULATED CMU PRESENT 
          IFTEST EQ,COMCMU,COMXJ-1,1
          SA4    A3-B1       BIT 59 OF *COMCMU* = CMU FLAG
          IFTEST NE,COMCMU,COMXJ-1,1
          R=     A4,RA+COMCMU      BIT 59 OF *COMCMU* = CMU FLAG
 INIT4A3  MX6    1
          BX7    X6*X3
          BX6    X6*X4
          SA7    HDOPTX 
          SA6    HDOPTC 
  
**        -CU- TWO ZERO WORDS ARE PLACED IN THE ERROR TABLE *TERR*. 
*              THIS INSURES THAT THERE WILL BE TWO AVAILABLE WORDS THERE
*              IN CASE THE MEMORY OVERFLOW ERROR HAS TO BE ISSUED.
* 
  
          ADDWRD TERR,X1-X1 
          ADDWRD A2,X1
  
**        -CU- THE ABSOLUTE BLOCK IS ALLOCATED VIA THE SUBROUTINE *APS*.
*              THEN THE COMMUNICATIONS AREA (RA TO RA+107B) IS MOVED
*              TO THE FRONT OF *TPGM*.  ANYTHING TO BE STORED IN
*              THIS AREA FOR THE LOADED PROGRAM MUST HENCEFORTH BE
*              STORED RELATIVE TO THE START OF *TPGM*.
* 
  
          IFCARD 1
          SX1    COMLTH+1    ALLOCATE ABSOLUTE BLOCK
          IFUSER 1
          R=     X1,COMLTH   ALLOCATE ABSOLUTE BLOCK
          MX2    0           INDICATOR FOR CM SPACE 
          RJ     APS= 
          SA1    B0          SAVE RA
          MX6    0           CLEAR RA+1 
          BX7    X1          SAVE RA+2 THRU RA+77 
          LX5    X2          SAVE FWA *TPGM*
          SA7    X2          (THIS WAY AVOIDS MODE ERROR IN MVE=) 
          SA6    A7+B1
          MOVE   COMLTH-2,B1+B1,A6+B1 
 IC       IFCARD
          MX6    0           ZERO DEFAULT ENTRY POINT WORD
          SA6    X5+COMLTH
          MX7    0
 K        IFNOS 
          SA1    SLDRCLD     CHECK IF SPECIAL ENTRY AT SLDR=
          NZ     X1,INIT4C   IF SLDR= ENTRY LEAVE COMM AREA ALONE 
 K        ENDIF 
          SB2    B1+B1       CLEAR RA+2 THRU RA+53B 
          SB3    RA+COMBOOT 
 INIT4B   SA7    X5+B2
          SB2    B2+B1
          LT     B2,B3,INIT4B 
 INIT4C   BSS    0
 IC       ENDIF 
  
**        -C-- THE *ZZZZZ17* FILE IS RETURNED.  SINCE THIS LOAD WILL
*              OVERWRITE ANYTHING FROM A PREVIOUS LOAD, ITS CURRENT 
*              CONTENTS, IF IT WERE PRESENT, WOULD BE MEANINGLESS.
* 
  
 IC       IFCARD
          SYSTEM CIO,R,RSFA  ISSUE CLOSE-RETURN ON *ZZZZZ17*
                             (FET AT *RSFA* SET UP AT ASSEMBLY TIME)
 IC       ENDIF 
  
 IU       IFUSER
  
**        --U- THE INDIVIDUAL REQUESTS SPECIFIED IN THE USER CALL 
*              REQUEST AREA ARE PLACED IN TABLE *TREQ*.  ALSO, EACH 
*              REQUEST IS EXAMINED SO AS TO PROPERLY SET THE EXECUTE
*              FLAG IN CASE THE LAST REQUEST IS *EXECUTE* OR *NOGO*.
*              ALSO, THE INITIAL PROGRAM ORIGIN MUST BE ADVANCED IN THE 
*              CASE OF A *NOGO* REQUEST FOR WHICH AN OVERLAY IS TO BE 
*              WRITTEN. 
* 
  
          SB2    B4          (B2) = LWA+1 OF REQUEST TABLE
          R=     B3,B3+3     SKIP OVER HEADER 
          RJ     CRT         COPY REQUEST TABLE TO *TREQ* 
  
**        --U- THE MANAGE TABLE LWA+1 IS SET TO THE LWA+1 OF THE
*              LOADABLE AREA, LESS THE FORBIDDEN AREA, SINCE IT 
*              MAY HAVE BEEN SET SOMEWHAT BELOW THIS VALUE INITIALLY. 
* 
  
          R=     X7,B6-TABOO (X7) = END OF TABLES 
                                        = END OF LOAD. AREA - FOR. AREA 
          SA2    TEND        FWA FOR PRESET 
          SA7    A2 
  
          BX3    X7 
          RJ     PSM         CLEAR FREED SPACE, IF ANY
  
 IU       ENDIF 
  
 IC       IFCARD
  
**        -C-- THE NOS RUN(G) FLAG IS SET, RA IS SETUP. 
* 
  
          SA2    RUNG        SET LDR= ENTRY FLAG
          SX6    B0 
          SA6    A2          RESET RUN(G) FLAG
          ZR     X2,LDR=EX   IF NOT ENTERED AT *LDR=* 
 LDR=0    BSS    0
 K        IFNOS 
          SA1    COMNAME
          MX6    42 
          BX1    X1*X6       EXTRACT FILE NAME
          SETFET L,A1,BINARY
          STATUS L,POS
          SA1    L+5
          SX7    B1 
          AX1    14-0 
          BX7    X1*X7       EXTRACT EXECUTE ONLY FILE STATUS BIT 
          SA7    XEQOF       SAVE STATUS BIT
          MX6    0
 K        ENDIF 
          SA1    =0LNUCLEUS 
          SA2    LOVFLAGS 
          SA6    A0-B1       SET FL-1 = 0 IF ENTERED AT *LDR=*
          SX7    B1 
          BX6    X1 
          LX7    6           POSITION U BIT 
          SA6    LOVPARAM    SET NAME FOR LOAD FROM SYSTEM LIBRARY
          BX6    X7+X2
          SA6    A2          SET U BIT FOR SYSTEM LIBRARY LOAD
          SA1    COMLDRR
          MX7    6
          LX1    59-29       LDV/LDR COMPLETE BIT 
          PL     X1,LDR=EX   IF NOT STARTED BY RUN(G) TYPE CALL 
          SX6    -B1
          SA6    RUNG        SET RUN(G) FLAG
          SA1    COMNAME     GET FILE NAME
          MX6    12 
          BX6    X6*X1
          NZ     X6,LDR=1    IF LOCAL FILE CALL 
          SB3    X1          (B3) = FWA OF REQUEST TABLE
          SX6    B1 
          LE     B3,B1,LDR=0A IF FWA IS TOO SMALL 
          SA6    RUNG        SET LDCMR TYPE CALL FLAG 
          AX1    30 
          SB2    X1+B3       (B2) = LWA+1 OF REQUEST TABLE
          SX6    B3-COMBOOT-1 
          PL     X6,LDR=0A   IF LWA+1 TOO HIGH
          IFNOS  2
          SX7    B1 
          SA7    EXPCCEX     FLAG FOR EXPLICIT CC EXECUTE 
          RJ     CRT         COPY REQUEST TABLE TO *TREQ* 
          EQ     LDR=EX 
  
 LDR=0A   ERROR  CAT,(=C* ILLEGAL REQUEST TABLE.*)
  
 LDR=1    BX6    -X7*X1 
          ZR     X6,LDR=2 
          AX7    6
          EQ     LDR=1
  
 LDR=2    SA2    =8L .......
          BX2    -X7*X2 
          BX6    X1+X2       ADD TERMINATOR TO FILE NAME
          SA6    COMLDCC     PLACE IN RA+70 TO SERVE AS CTL CARD IMAGE
          SX6    B0 
 LDR=3    SA6    A6+B1       ZERO FILL REST OF CONTROL CARD IMAGE 
          SB7    A6-COMLDCC-7 
          MI     B7,LDR=3 
 LDR=EX   BSS    0
  
**        -C-- IF THE ENTRY INFORMATION DEFINED FOR THE TOP OF THE
*              FIELD LENGTH WAS PASSED TO *LOAD* (BY *1AJ*), IT IS
*              NOW SAVED.  THE NAMES COMPOSING THE GLOBAL LIBRARY SET 
*              ARE PLACED IN TABLE *TLIB*.
* 
  
          SA1    A0-B1       FETCH (RA+FL-1)
          MX0    42 
          ZR     X1,INIT8B   IF THE INFORMATION DOES NOT EXIST
          SB7    B1          INITIALIZE FETCH POINTER 
          MX5    -12
 INIT7    SA2    A0-B7       FETCH NEXT WORD
          SB7    B7+B1       ADVANCE FETCH
          BX3    -X5*X2      LAST WORD HAS LOWER 12 BITS = 7777B
          BX3    -X5-X3 
          ZR     X3,INIT8    IF NO MORE LIBRARY NAMES 
          ADDWRD TLIB,X0*X2  FOR NOW, USE THE NAME ONLY 
          SA3    LP          ADVANCE LENGTH OF GLOBAL LIB SET 
          SX7    X3+B1
          SA7    A3 
          EQ     INIT7       LOOP 
  
 INIT8    BSS    0
          LX2    -12         SET FLAG TO INDICATE WHETHER 
          BX6    -X5*X2      PROGRAM CALL CARD SPECIFIES A
          SA6    LDFILE      FILE NAME OR ENTRY POINT 
          MX7    0
          NZ     X6,INIT8A   IF NAME IS A LOCAL FILE
          SX7    B1 
 INIT8A   SA7    PCTYPE      STORE FLAG 
          SX6    A0-TABOO    SET LWA+1 OF TABLES
          LX2    -12
          SA6    TEND 
          BX7    -X5*X2 
          SA7    NFL         SAVE NOMINAL FL
          EQ     INIT10 
  
 INIT8B   SX6    A0-TABOO    SET LWA+1 OF TABLES
          SA6    TEND        = FL - FORBIDDEN AREA
  
 IC       ENDIF 
 IU       IFUSER
  
**        --U- THE LOADER INFORMATION IS READ FROM THE LOADER SCRATCH 
*              FILE *ZZZZZ17*.  THIS INFORMATION DESCRIBES WHAT HAS BEEN
*              LOADED DURING PREVIOUS LOADS AS FAR BACK AS THE MOST 
*              RECENT CONTROL-CARD-INITIATED LOAD.  THE CONTENTS OF 
*              THIS FILE IS SHOWN IN THE ROUTINE DESCRIPTION FOR *WLI*. 
* 
  
 INIT7    SETFET L,(=0LZZZZZ17),BINARY
          REWIND X2 
          READ   X2          START READ OF 1ST RECORD 
          SA0    T1          (A0) = POINTER TO SCRATCH WORD 
          READO  L           1ST WORD = XFER, NOT NEEDED
          NZ     X1,INIT9    IF EOR-EOF, FILE DOES NOT EXIST
          READO  L           READ (W.CPLDR1)
          SA6    CTLPT
 INIT7A   READO  L           LOOP TO EOR
          ZR     X1,INIT7A
          SA5    TEND        (X5) = LWA+1 OF LOADABLE AREA
          R=     X5,X5+TABOO
          READ   X2          START READ OF NEXT RECORD
          MX0    0           KEEP COUNT OF ENTRIES READ 
 INIT8    READW  L,A0,2      READ 2 WORDS (*TBLK* ENTRY)
          NZ     X1,INIT8E   IF END OF THIS RECORD
          ADDWRD TSCR,X1     ADD ZERO WORD IF *TBLK* ENTRY NOT USED 
          SB2    BASE        (B2) = FWA LOADABLE AREA 
          SB3    X5          (B3) = LWA+1 LOADABLE AREA 
          SA1    A0          1ST WORD OF ENTRY
          SA2    A0+B1       2ND WORD OF ENTRY
          SB7    X2          (B7) = BLOCK FWA 
          SA3    FL 
          SB4    X3          (B4) = CM FIELD LENGTH 
          SB6    X0          (B6) = ENTRY COUNT - 1 
          SX0    X0+B1
 ECS      IFTEST NE,IP.MECS,0 
          BX3    X1 
          LX3    59-1 
          NG     X3,INIT8B   IF ECS BLOCK 
 ECS      ENDIF 
          GE     B7,B4,INIT8AA     IF BLOCK ORIGIN ABOVE CM FL
          GE     B7,B3,INIT8A      IF BLOCK ORIGIN ABOVE LOADABLE AREA
          LT     B7,B2,INIT8A      IF BLOCK ORIGIN BELOW LOADABLE AREA
 INIT8AA  GT     B6,B0,INIT8 IF NOT A BLANK COMMON ENTRY
          SX1    B1          SET FOR NEW BLANK COMMON 
          MX7    1
          SA7    A0+B1
 INIT8A   ADDWRD TBLK,X1     ADD 1ST WORD OF *TBLK* ENTRY 
          SA1    TSCR 
          LX6    59-1 
          MX3    1
          SA2    A1+B1
          BX6    X3*X6       SET BIT 59 IF ECS ENTRY POINT
          IX2    X1+X2
          BX6    X6+X4
          R=     A6,X2-1     ADD NEW *PI* AND *E* BIT TO *TSCR* ENTRY 
          SA1    A0+B1
          ADDWRD TBLK,X1
          EQ     INIT8
 ECS      IFTEST NE,IP.MECS,0 
  
 INIT8B   SA3    ECSPO       (X3) = FWA ECS LOADABLE AREA 
          SA4    ECSLWA      (X4) = LWA+1 ECS LOADABLE AREA 
          MX6    -24         (X6) = ECS BLOCK FWA 
          BX6    -X6*X2 
          IX7    X6-X4
          IX2    X6-X3
          PL     X7,INIT8A   IF BLOCK ORIGIN ABOVE ECS LOAD AREA
          NG     X2,INIT8A   IF BLOCK ORIGIN BELOW ECS LOAD AREA
          GT     B6,B1,INIT8 IF NOT ECS BLANK COMMON
          R=     X1,3        SET FOR NEW ECS BLANK COMMON 
          MX7    1
          SA7    A0+B1
          EQ     INIT8A 
  
 ECS      ENDIF 
  
 INIT8E   SA1    TBLK+1      (X1) = *TBLK* LENGTH 
          BX6    X1 
          SA6    /READ/UNAME INITIALIZE UNIQUE NAME COUNT 
          READ   X2          START READ OF NEXT RECORD
 INIT8F   READW  L,A0,2      READ 2 WORDS (*TLNK* ENTRY)
          NZ     X1,INIT8K   IF END OF THIS RECORD
          SA2    A0+B1       (X2) = 2ND WORD FOR *TLNK* ENTRY 
          SA1    A0          1ST WORD OF ENTRY
          SB2    BASE        (B2) = FWA LOADABLE AREA 
          SB3    X5          (B3) = LWA+1 LOADABLE AREA 
          BX3    X2 
          LX3    2
          PL     X3,INIT8F1  IF *OMIT* NOT SET
          LX3    2
          PL     X3,INIT8F1  IF (WEAK* NOT SET
          SX4    B1 
          LX4    57 
          BX3    -X4*X2      CLEAR *OMIT* FLAG
          LX4    1
          BX2    X3+X4       SET *UNSAT* FLAG 
 INIT8F1  MX4    -30
          SB7    X2          ADDRESS OF ENTRY 
          LX4    24 
          BX4    X4*X2       REMOVE BITS 24-53
          SA3    TSCR        GET CORRESPONDING *TBLK* INDEX 
          SB4    X3 
          LX2    6
          AX2    43 
          SA3    X2+B4
          SX2    X3          NEW INDEX
          LX2    36 
          BX2    X2+X4       NEW *TLNK* DEFINITION
 ECS      IFTEST NE,IP.MECS,0 
          NG     X3,INIT8H   IF ENTRY POINT IN ECS BLOCK
 ECS      ENDIF 
          SA3    FL 
          SB4    X3 
          GE     B7,B4,INIT8F      IF ENTRY ABOVE CM FL 
          GE     B7,B3,INIT8G      IF ENTRY ABOVE LOADABLE AREA 
          GE     B7,B2,INIT8F      IF ENTRY WITHIN LOADABLE AREA
 INIT8G   RJ     ELT         ENTER LINK TABLE 
          SX2    L           LOOP THROUGH *TLNK* RECORD 
          EQ     INIT8F 
 ECS      IFTEST NE,IP.MECS,0 
  
 INIT8H   SA3    ECSPO       (X3) = FWA ECS LOADABLE AREA 
          SA4    ECSLWA      (X4) = LWA+1 ECS LOADABLE AREA 
          MX6    -24         (X6) = ADDRESS OF ENTRY
          BX6    -X6*X2 
          IX7    X6-X4
          IX6    X6-X3
          PL     X7,INIT8G   IF ENTRY ABOVE ECS LOADABLE AREA 
          NG     X6,INIT8G   IF ENTRY BELOW ECS LOADABLE AREA 
          EQ     INIT8F      ENTRY WITHIN - DISCARD 
  
 ECS      ENDIF 
  
 INIT8K   READ   X2          START READ OF NEXT RECORD
          SA2    TSCR 
          RJ     CTAB=
 INIT8L   READO  L           READ *TLFN* ENTRY
          NZ     X1,INIT8M   IF END OF RECORD 
          ADDWRD TLFN,X6
          SA1    FI          ADVANCE FILE INDEX 
          SX6    X1+B1
          SA6    A1 
          SX2    L           LOOP 
          EQ     INIT8L 
  
 INIT8M   READ   X2          START READ OF NEXT RECORD
          READO  L           READ LENGTH OF GLOBAL LIBRARY SET
          SA6    LP 
 INIT8N   READO  L           READ ONE *TLIB* ENTRY
          NZ     X1,INIT8O   IF AT END OF RECORD
          ADDWRD TLIB,X6     PLACE ENTRY IN *TLIB*
          EQ     INIT8N 
  
 INIT8O   READ   X2          START READ OF NEXT RECORD (*TPRX*) 
 INIT8P   READO  L           NEXT WORD OF *TPRX*
          NZ     X1,INIT11   IF AT END OF RECORD
          ADDWRD TPRX,X6     PLACE ENTRY IN *TPRX*
          EQ     INIT8P      LOOP 
  
 INIT9    BSS    0
  
 IU       ENDIF 
  
**        -CU- THE CONTENTS OF THE LOADER FLAGS ARE OBTAINED AND SAVED
*              IN WORD *CTLPT*.  TABLE *TLIB* IS ALLOCATED TO 
*              MAX SIZE AND GLOBAL LIBRARY NAMES ARE OBTAINED AND 
*              SAVED THERE. 
  
* 
  
 KFLG     IFNOS 
          GETLC  CTLPT
 KFLG     ENDIF 
          ALLOC  TLIB,62     ALLOCATE *TLIB* TO MAXIMUM SIZE
 SGLS     IFSCOPE 
          SX1    B1+B1       FORM *LDL* CALL TO STORE LIBRARY 
          LX2    36          NAMES AT FWA OF *TLIB* 
          IX1    X1+X1
          BX7    X1+X2
          SA7    T1 
          LDL    A7 
          SA1    A7          SET *TLIB* LENGTH TO REFLECT 
          AX1    36          ACTUAL STORING OF NAMES
          SX6    X1 
          SA3    A2          SAVE LENGTH OF GLOBAL LIBRARY SET
          IX7    X6-X3       = LENGTH OF *TLIB* 
          SA7    A2+B1
          SA7    LP 
 SGLS     ENDIF 
 KGLS     IFNOS 
          LX2    36          FWA *TLIB*,36/0
          BX7    X2 
          SA7    T1          *CPM* PARAM WORD IN T1 
          SA1    CTLPT       (X1) = CURRENT LOADER CONTROL WORD 
          MX7    36D
          BX1    -X7*X1      (X1)=ONLY GLOBAL LIB ORDINALS
          NZ     X1,IN8KGL1  IF GLOBAL LIBRARY SET NON-EMPTY
          SA3    TLIB        ELSE SET A3 AND X7 AS NEEDED TO
          SX7    B0          INDICATE AN EMPTY GLOBAL LIB SET 
          EQ     IN8KGL2     THEN GO TO INDICATE AN EMPTY GLS 
  
 IN8KGL1  GETGLS T1 
          SA1    T1 
          AX1    36 
          SX6    X1 
          SA3    TLIB 
          IX7    X6-X3
 IN8KGL2  SA7    A3+B1       SET ACTUAL *TLIB* LENGTH 
          SA7    LP          SAVE LENGTH OF GLOBAL LIBRARY SET
 KGLS     ENDIF 
  
 INIT10   BSS    0
  
 S        IFSCOPE 
          SX1    CTLPT
          R=     X2,W.CPLDR1
          RJ     LDLCP       CALL LDL TO FETCH LOADER CONTROL WORD
 S        ENDIF 
  
 IC       IFCARD
  
**        -C-- THE NOMINAL FL (IF NOT ALREADY KNOWN) IS OBTAINED. 
* 
  
 KCID     IFNOS  1
          SA1    CTLPT
          MX7    -10
          LX7    24 
          BX7    X7*X1
          SA7    A1          CLEAR *IDCB* PROCESSOR BITS
          SA1    NFL
          NZ     X1,INIT10Y  IF NFL KNOWN 
  
 IS       IFSCOPE 
          SX1    NFL
          R=     X2,W.CPCC
          RJ     LDLCP       CALL LDL TO GET NFL
          SA1    NFL
          MX6    -12
          LX1    12+12*C.CPNFL
          BX6    -X6*X1      NOMINAL FL/100B
          SA6    A1 
 IS       ELSE
          R=     X6,4RCPMP/16 
          R=     X1,33B 
          LX6    40 
          LX1    24 
          SX2    NFL
          BX6    X6+X1
          BX6    X6+X2
          RJ     SYS=        CALL CPM TO GET FL INFO
          SA1    X6 
          LX1    -36
          MX6    48 
          BX6    -X6*X1 
          SA6    A1          SAVE NFL 
 IS       ENDIF 
  
 INIT10Y  BSS    0
  
**        --C- THE LOADER CONTROL WORD IS EXAMINED AND THE *ID* 
*              FLAGS ARE SET UP FOR INTERACTIVE DEBUG.
  
          SA2    CTLPT       (X2) = LOADER CONTROL WORD 
          MX6    -2 
          AX2    24+10       GET BITS 10 AND 11 OF IDCB (BYTE 2)
          BX6    -X6*X2 
          SA6    ID          SET INTERACTIVE DEBUG FLAGS
 IC       ENDIF 
  
**        -CU- THE DEFAULT *PRESET* OPTION IS SET.
* 
  
          R=     X6,IP.PSET  DEFAULT *PRESET* OPTION
          ZR     X6,INIT10A  IF NO PRESETTING 
          SA1    X6+/LOADC/PRSVAL-1  GET *PRESET* VALUE 
          R=     X0,X6-11B   CHECK *DEBUG* OPTION 
          R=     X2,X6-6     CHECK *NGING* OPTION 
          BX7    X1 
          SA7    PSMB        STORE VALUE
          SX6    B1          FLAG ADDRESS INSERTION 
          ZR     X0,INIT10A  IF *DEBUG* 
          ZR     X2,INIT10A  IF *NGINF* 
          BX6    -X6         FLAG NO ADDRESS INSERTION
 INIT10A  SA6    PSMA        STORE FLAG FOR TYPE OF *PRESET*
          IFCARD 1
 INIT10B  BSS    0
  
 IC       IFCARD
 IT       IFTEST NE,IP.TRAP,0 
  
**        -C-- IF THIS LOAD IS INDICATED TO BE A *TRAP* RUN (DEBUG
*              AIDS), A LOADER REQUEST IS INSERTED SO AS TO FORCE THE 
*              LOADING OF THE TRAP ROUTINE. 
* 
  
          SA1    CTLPT
          R=     X6,CLIBLOAD
          R=     X2,1        ISOLATE *TRAP* BIT 
          LX2    48-12*C.CPLT+S.CPLT
          BX0    X1*X2
          BX7    -X2*X1      CLEAR *TRAP* BIT IN *CTLPT*
          SA7    A1 
          ZR     X0,INIT4T   IF NOT A *TRAP* RUN
 IK       IFNOS 
          SA1    XEQOF
          ZR     X1,INIT10E  IF NOT EXECUTE ONLY FILE 
          SX6    B0 
          MX0    0           CLEAR TRAP FLAG
          SA6    ID          DISABLE INTERACTIVE DEBUG
          EQ     INIT10C     IGNORE TRAP REQUEST
 INIT10E  BSS    0
 IK       ENDIF 
          R=     X7,2        FORM *LIBLOAD* HEADER
          LX6    48 
          LX7    36 
          BX1    X6+X7
          SA5    =0L"TRAPNAME"     ENTRY POINT NAME 
          ADDWRD TREQ,X1     INSERT HEADER
          MX1    42          INDICATE NO LIBRARY NAME 
          ADDWRD A2,X1
          SX0    B1          SET FLAG SHOWING *TRAP* RUN
          ADDWRD A2,X5       INSERT ENTRY NAME
          SA1    ID 
          ZR     X1,INIT10C  IF NOT INTERACTIVE DEBUG 
          SX6    B0 
          SA6    A1 
          ERROR  4111        ---- TRAP OVERRIDES INTERACTIVE DEBUG
 INIT10C  BSS    0
 SCTB     IFSCOPE 
          LDL    TRAPADR     CALL *LDL* TO CLEAR *TRAP* BIT 
 SCTB     ENDIF 
 KCTB     IFNOS 
          SETLC  CTLPT       CLEAR TRAP BIT IN LOADER CONTROL WORD
 KCTB     ENDIF 
 INIT4T   BX6    X0          SET OR CLEAR *TRAP* FLAG 
          SA6    TRAPADR
  
 IT       ENDIF 
 IC       ENDIF 
  
**        -CU- THE BLOCK TABLE *TBLK* IS SET UP TO CONTAIN THE FIRST
*              THREE ENTRIES WHICH ARE ALWAYS IN THE TABLE:                    .
* 
*              1) CM BLANK COMMON.
*              2) ECS BLANK COMMON. 
*              3) ABSOLUTE BLOCK IN RA THROUGH RA+77B.
* 
  
          SX1    B1          ENTER BLANK COMMON 
          MX5    0
          RJ     EBD
          R=     X1,3        ENTER ECS BLANK COMMON BLOCK 
          RJ     EBD
          SX1    B1          ENTER ABSOLUTE BLOCK USING 
          SX2    B1          UNIQUE NAME
          IFCARD 1
          SX5    COMLTH+1 
          IFUSER 1
          R=     X5,COMLTH
          LX1    18 
          BX1    X1+X2
          RJ     EBD
          SA1    TBLK        SET ABOVE BLOCKS UNUSED
          MX6    1
          SA6    X1+B1
          SB2    B1+B1
          SA6    A6+B2
          SA2    A6+B2
          BX6    X6+X2
          MX2    -24         CLEAR SYSTEM BLOCK ADDRESS 
          BX6    X2*X6
          SA6    A2 
  
**        -CU- THE FIRST WORD IS INSERTED IN THE RELOCATION BASE TABLE
*              *TRLB*.  FOR ALL PROGRAMS, THIS ENTRY REPRESENTS 
*              RELOCATION RELATIVE TO THE ABSOLUTE BLOCK (I.E. NO 
*              RELOCATION). 
* 
  
 INIT11   BSS    0
          ALLOC  TRLB,1      ALLOCATE START OF RELOC BASE TABLE 
          R=     X6,2*2+1    ENTER ABSOLUTE BLOCK 
          LX6    36 
          SA6    X2 
  
 S        IFSCOPE 
**        -CU- RETURN ZZZZZ03, ZZZZZ04, AND ZZZZZ06.
*              THIS IS DONE UNDER *SCOPE* ONLY. 
* 
  
          R=     B2,LFNTS-1 
          MX4    42 
 INIT16   SA1    B2+FNTS     RETURN *FNTS* FILE 
          BX1    X4*X1
          SETFET L,A1,BINARY
          CLOSE  X2,RCL 
          SB2    B2-B1
          PL     B2,INIT16   IF NOT DONE WITH *FNTS*
  
 IC       IFCARD
**        -C-- FETCH THE ACCESS LEVEL FOR NOS/BE ONLY.
* 
  
          SX1    AL 
          SX2    W.IACES
          RJ     LDLCP       FETCH ACCESS LEVEL FROM CONTROL POINT AREA 
          SA2    AL 
          MX1    -11
          LX2    12+12*C.IACES
          BX6    -X1*X2 
          SA6    A2          WE USE ONLY 11 BITS FOR ACCESS LEVEL 
 IC       ENDIF 
 S        ENDIF 
  
**        -CU- THE DEFAULT MAP OPTION IS SET. 
* 
  
          SA5    CTLPT
          BX1    X5          SAVE (CTLPT) FOR LATER CHECKING
          MX4    -4 
          LX5    -48+12*C.CPLM-S.CPLM  MAP BITS TO LOWER 4 BITS 
          BX6    -X4*X5 
          LX1    11+12*C.CPLM-S.CPLV                                     LDR0153
          MI     X1,INIT16V  IF VALID OPTIONS 
          R=     X6,IP.MAP   ELSE USE IP.MAP
 INIT16V  BSS    0
          SA6    MAPDEF      SAVE DEFAULT OPTION
          SA6    MAPTYPE     SAVE CURRENTLY-SELECTED OPTION 
  
 IC       IFCARD
  
**        -C-- THE DEFAULT REDUCE OPTION IS SET.
* 
  
          MX1    1           MOVE REDUCE BIT TO SIGN POSITION 
          LX5    12*C.CPLR-12*C.CPLM+S.CPLM-S.CPLR-1
          BX6    X1*X5
*         SET *EF* NEGATIVE IF NOT TO REDUCE. 
*         IFSCOPE THEN REDUCE BIT = 1 MEANS REDUCE. 
*         IFNOS THEN REDUCE BIT = 0 MEANS REDUCE. 
 S        IFSCOPE 
          BX6    X1-X6       IFSCOPE THEN TOGGLE THE BIT
 S        ENDIF 
          SA6    EF 
  
**        -C-- THE ROUTINE *LOADC* IS CALLED TO FETCH ALL CONTROL 
*              CARDS IN THE LOAD SEQUENCE.
**        *** NOTE ***  IF UNDER KRONOS/NOS AND ENTERED AT *SLDR=*
*                       THEN NO CONTROL CARDS ARE FETCHED.  INTERNAL
*                       TABLE *TREQ* IS SETUP TO LOAD AND EXECUTE 
*                       THE RELOCATABLE PROGRAM FROM THE *CLD*. 
*                       (LOCAL FILE HAS BEEN CREATED FOR US BUT 
*                       MUST BE *ASSIGNED* AND *RETURNED* LATER.) 
* 
  
 K        IFNOS 
          SA2    SLDRCLD     CHECK IF SPECIAL ENTRY AT SLDR=
          ZR     X2,INIT16A  IF NOT ENTERED AT SLDR=
          SX6    B0 
          SA6    TREQ+1      EMPTY *TREQ* 
          SX6    B1 
          SA6    EX          SET EXECUTE FLAG 
          R=     X1,CLOAD*10000B+1   LOAD CODE, WC=1
          LX1    36          POSITION TO *TREQ* FORMAT
          ADDWRD TREQ,X1     PUT INTO *TREQ*
          SA1    SLDRCLD     GET FILE NAME
          ADDWRD TREQ,X1     PUT INTO *TREQ*
          R=     X1,CEXECUTE*10000B+1   EXECUTE CODE, WC=1
          LX1    36          POSITION TO *TREQ* FORMAT
          ADDWRD TREQ,X1     PUT INTO *TREQ*
          SA1    SLDRCLD     GET FILE NAME (= ENTRY NAME) 
          ADDWRD TREQ,X1     PUT INTO *TREQ*
          EQ     INIT16B     BYPASS CONTROL CARD FETCHING 
  
 INIT16A  BSS    0
 K        ENDIF 
  
          SA1    RUNG 
          SX1    X1-1 
          ZR     X1,INIT16B  IF *TREQ* ALREADY CONTAINS REQUESTS
          RJ     /LOADC/LOADC 
  
**        -CU- THE MANAGE TABLE ORIGIN IS ADJUSTED SO AS TO OVERWRITE 
*              ALL OF THIS INITIALIZATION CODE AND ALSO THAT PORTION
*              OF THE CARD SCANNING CODE NOT NEEDED FOR DIRECTIVE 
*              PROCESSING.
* 
  
 INIT16B  BSS    0
          SA3    /LOADC/OVHOLD     SET TO ALLOW *OVERLAY* DIRECTIVE 
          BX7    X3 
          MX6    0           CLEAR WORD SO AS TO INDICATE NEW END 
          SA6    /LOADC/BREAK-1     OF TABLE USED BY CARD SCANNER 
          SA7    /LOADC/TABLE 
          MX7    0
          RJ     AMU=        DETERMINE MEMORY NEEDED
          SA7    MM 
  
**        -CU- REQUEST PROCESSING NOW BEGINS. 
  
          RJ     REQ         PROCESS REQUESTS (NO RETURN) 
  
 IC       ENDIF 
 IU       IFUSER
  
*         ADJUST MANAGE TABLE ORIGIN DOWN TO THE END OF THE CARD
*         SCANNER CODE SO AS TO FREE THE SPACE OCCUPIED BY CODE THAT
*         WILL NEVER BE USED AGAIN. 
  
          SX6    /LOADC/BREAK+IP.LBUF  NEW TABLE FWA
          SA3    LM          CURRENT TABLE FWA
          IX5    X6-X3       NEW - CURRENT
          SA6    A3          SET NEW TABLE FWA
          SA1    L+1         ADJUST *FIRST* POINTER IN *FET*
          IX6    X1+X5
          SA6    A1 
          SA1    L+4         ADJUST *LIMIT* POINTER 
          IX6    X1+X5
          SA6    A1 
          RJ     AMU=        DETERMINE MEMORY NEEDED
          SA1    MU          DURING INITIALIZATION
          R=     X2,ENDREL-LOADCCE
          IX6    X1+X2
          MX7    0           FLAG *LOADC* AS IN BUT NOT NEEDED
          SA6    A1 
          SA7    MM 
  
*         END OF INITIALIZATION.  GO PROCESS LOADER REQUESTS. 
  
          RJ     REQ         PROCESS REQUESTS (NO RETURN) 
  
 IU       ENDIF 
  
 MACHAR   DATA   0           HARDWARE INFO OBTAINED BY *GETMC* MACRO
 CRT      SPACE  4,8
**        CRT - COPY REQUEST TABLE TO *TREQ*. 
* 
*         ENTRY  (B3) = FWA OF USERS TABLE. 
*                (B2) = LWA+1 OF USERS TABLE. 
*         EXIT   (EX) = *EXECUTE* OR *NOGO* FLAG. 
*                (LASTCARD) = 1 FOR CONTROL STATEMENTS READ.
*                (PO) = PROGRAM ORIGIN. 
*                (PA) = PROGRAM ADDRESS.
*                (BI) = BASE INDEX. 
*                (EPTC) = NUMBER OF ENTRY POINTS ON *NOGO*. 
*                ENTRY POINTS ADDED TO *TPGM*.
*         USES   X - 1, 2, 3, 4, 5, 6, 7. 
*                B - 3, 4, 7. 
*                A - 1, 2, 3, 4, 6, 7.
*         CALLS  ADW=.
  
 CRT      PS                 ENTRY/EXIT 
          SX7    B1 
          SA7    LASTCARD    FLAG FOR *TREQ* ALREADY SET UP 
 CRT1     SA1    B3          NEXT REQUEST TABLE HEADER WORD 
          ZR     X1,CRT7     IF ZERO WORD - END OF REQUESTS 
          MX2    -12
          GE     B3,B2,CRT7  IF END OF TABLE
          BX5    X1 
          LX5    12 
          BX6    -X2*X5      REQUEST NUMBER 
          LX5    12 
          BX5    -X2*X5      WORD COUNT 
          SX7    B1 
          SB4    X5          (B4) = WORD COUNT
          R=     X2,X6-CEXECUTE 
          ZR     X2,CRT4     IF *EXECUTE* REQUEST 
          R=     X7,X6-CNOGO
          NZ     X7,CRT5     IF NOT *NOGO*
          SA7    EX          SET FLAG FOR *NOGO*
          SB7    B1+B1       (B7) = CURRENT INDEX INTO *NOGO* REQUEST 
 IC       IFCARD
          ZR     B4,CRT5     IF NO OVERLAY OR ENTRY POINTS GIVEN
          SA3    B3+B1
          BX7    X3 
          SA7    OF          SAVE OVERLAY FILE NAME 
          LE     B4,B1,CRT5  IF NO ENTRY POINTS GIVEN 
          SA2    PO 
          SA3    PA          DECREMENT *PO* AND *PA* TO REMOVE IMPL. EPT
          SX4    B1 
          IX6    X2-X4
          IX7    X3-X4
          SA6    A2 
          SA7    A3 
          SA2    BI          DECREMENT *BI* AND *TPGM* LENGTH 
          SA3    TPGM+1 
          IX6    X2-X4
          IX7    X3-X4
          SA6    A2 
          SA7    A3 
          SX6    B4-B1
          SA6    EPTC        SAVE NUMBER OF ENTRY POINTS
 IC       ENDIF 
 CRT2     GT     B7,B4,CRT3  IF NO MORE ENTRY POINTS
          SA1    B3+B7       ENTRY POINT
          SB7    B7+B1       INCREMENT COUNT INTO *NOGO* TABLE
          ADDWRD TPGM,X1     ADD ENTRY POINT TO OVERLAY HEADER
          SA1    PO 
          SA2    PA 
          SA3    BI          INCREMENT *PA*, *PO* AND *BI*
          SX6    X1+B1
          SX7    X2+B1
          SA6    A1 
          SA7    A2 
          SX6    X3+B1
          SA6    A3 
          EQ     CRT2 
  
 CRT3     SA1    B3 
          EQ     CRT5 
  
 CRT4     SA7    EX          SET FLAG FOR *EXECUTE* 
 CRT5     ADDWRD TREQ,X1     ADD HEADER WORD
 CRT6     SB3    B3+B1       GET NEXT WORD FROM TABLE 
          ZR     B4,CRT1     IF NO MORE WORDS TO ADD TO REQUEST TABLE 
          SA1    B3 
          ADDWRD A2,X1       ADD REMAINDER OF REQUEST 
          SB4    B4-B1
          EQ     CRT6 
  
 CRT7     SA1    EX 
          PL     X1,CRT      IF *NOGO* OR *EXECUTE* PRESENT 
          MX7    0
          R=     X1,CNOGO 
          SA7    A1          SET FLAG FOR *NOGO*
          LX1    48 
          ADDWRD TREQ,X1     ADD *NOGO* REQUEST TO TABLE
          EQ     CRT
 LDLCP    SPACE  4,8
 S        IFSCOPE 
**        LDLCP - FETCH BYTE FROM CONTROL POINT AREA. 
* 
*         ENTRY  (X1) = ADDRESS OF WHERE TO STORE THIS WORD.
*                (X2) = CONTROL POINT AREA WORD.
*         EXIT   WORD READ FROM CONTROL POINT AREA
*         USES   X - 1, 2, 4, 6, 7. 
*                B - 2. 
*                A - 6. 
*         CALLS  LDL. 
  
  
 LDLCP    PS                 ENTRY/EXIT 
          SX7    B1+B1       FUNCTION CODE TO LDL 
          LX2    12 
          SX6    B1          LENGTH OF READ 
          LX1    36 
          BX7    X2+X7
          LX6    24 
          BX6    X1+X6
          BX6    X6+X7
          SA6    T1 
          LDL    A6          CALL *LDL* 
          EQ     LDLCP       EXIT 
 S        ENDIF 
  
          RELOC  OFF
  
          USE    // 
 IC       IFCARD
          IFGT   /LOADC/BREAK+IP.LBUF,*,2 
 MEML     =      /LOADC/BREAK+IP.LBUF 
          SKIP   1
 MEML     =      *           LOW MEMORY LIMIT 
 IC       ELSE
 MEML     =      *+IP.LBUF
 IC       ENDIF 
  
 MFL=     EQU    240000B     MINIMUM FIELD LENGTH (KRONOS/NOS)
  
 RELOC    IFUSER
          RELOC  ON 
          EQ     INIT        RETURN HERE FROM SELF-RELOCATOR
          RELOC  OFF
 LOADU=   BSS    0           ENTRY POINT OF *LOADU* 
 LOADU    BSS    0           ENTRY POINT OF *LOADU* 
 LOADREL' SET    0
          QUAL   RRLOADU
*CALL LOADREL 
          QUAL
 ENDREL   EQU    *
 RELOC    ENDIF 
