*COMDECK BLOAD1 
 MACROS   TITLE  MACRO DEFINITIONS. 
**        ++++++++++++++++++++++
*         + MACRO DEFINITIONS. +
*         ++++++++++++++++++++++
* 
* 
*         ++++ I/O MACROS. ++++ 
* 
* 
*         SETFET - SET FET. 
* 
*         SETFET  FET,LFN,MODE
*         ENTRY  *FET* = FET ADDRESS
*                *LFN* = ADDRESS OF FILE NAME 
*                *MODE* = MODE OF FILE (BINARY OR CODED)
  
          PURGMAC SETFET
 SETFET   MACRO  A,B,C
          IFC    NE, A1 B ,1
          SA1    B
          R=     X6,C+1 
          BX6    X1+X6
          IFC    NE, X2 A ,1
          SX2    A
          RJ     SETFET=
          ENDM
          SPACE  4,2
**        CIOCALL - ISSUE *CIO* FUNCTION. 
* 
*         CIOCALL  FET,RCL,FUNC 
*         ENTRY  *FET* = FET ADDRESS
*                *RCL* = AUTO-RECALL INDICATOR
*                *FUNC* = CIO FUNCTION
  
          PURGMAC CIOCALL 
 CIOCALL  MACRO  A,B,C
          IFC    NE, X2 A ,1
          SX2    A
          IFC    EQ,**B*,1
          R=     X7,C 
          IFC    NE,**B*,1
          R=     X7,-C
          RJ     CIO= 
          ENDM
          SPACE  4
**        SKIPCALL - ISSUE *CIO* SKIP FUNCTION
* 
*         SKIPCALL  FET,RCL,FUNC,N,LVL
*         ENTRY  *FET* = FET ADDRESS
*                *RCL* = AUTO-RECALL INDICATOR
*                *FUNC* = CIO SKIP FUNCTION 
*                *N* = SKIP COUNT 
*                *LVL* = EOR LEVEL
  
          PURGMAC SKIPCALL
 SKIPCALL MACRO  F,RC,C,N,L 
          IFC    NE, X2 F ,1
          SX2    F
          R=     X7,40000B*L+C
          IFGE   L,10B,2
          MX1    -18
          BX7    -X1*X7 
          IFC    NE,**RC*,1 
          BX7    -X7
          IFC    NE, X6 N ,1
          R=     X6,N 
          RJ     SKIP=
          ENDM
          SPACE  4,2
**        REWIND - REWIND FILE. 
* 
*         REWIND  FET,RCL 
*         ENTRY  *FET* = FET ADDRESS
*                *RCL* = AUTO-RECALL INDICATOR
  
          PURGMAC REWIND
 REWIND   MACRO  A,B
          CIOCALL A,B,REWINDER
          ENDM
          SPACE  4,2
**        CLOSE - ISSUE CLOSE-RETURN ON FILE. 
* 
*         CLOSE  FET,RCL
*         ENTRY  *FET* = FET ADDRESS
*                *RCL* = AUTO-RECALL INDICATOR
  
          PURGMAC CLOSE 
 CLOSE    MACRO  A,B
          CIOCALL A,B,CLOSER
          ENDM
          SPACE  4,2
**        OPENNR - OPEN FILE WITH NO REWIND 
* 
*         OPENNR  FET,RCL 
*         ENTRY  *FET* = FET ADDRESS
*                *RCL* = AUTO-RECALL INDICATOR
  
          PURGMAC OPENNR
 OPENNR   MACRO  A,B
          CIOCALL A,B,OPENNR
          ENDM
          SPACE  4
**        REWRITE - REWRITE RECORD IN PLACE 
* 
*         REWRITE  FET,RCL
*         ENTRY  *FET* = FET ADDRESS
*                *RCL* = AUTO-RECALL INDICATOR
  
          PURGMAC REWRITE 
 REWRITE  MACRO  A,B
          CIOCALL A,B,REWRITE 
          ENDM
          SPACE  4
**        BKSPRU - BACKSPACE PRU
* 
*         BKSPRU  FET,N,RCL 
*         ENTRY  *FET* = FET ADDRESS
*                *N* = SKIP COUNT 
*                *RCL* = AUTO-RECALL INDICATOR
  
          PURGMAC BKSPRU
 BKSPRU   MACRO  F,N,R
          SKIPCALL F,R,BKSPRU,N 
          ENDM
          SPACE  4
**        SKIPF - SKIP FORWARD
* 
*         SKIPF  FET,N,LVL,RCL
*         ENTRY  *FET* = FET ADDRESS
*                *N* = SKIP COUNT 
*                *LVL* = EOR LEVEL
*                *RCL* = AUTO-RECALL INDICATOR
  
          PURGMAC SKIPF 
 SKIPF    MACRO  F,N,L,R
          SKIPCALL F,R,SKIPF,N,L
          ENDM
          SPACE  4
**        SKIPEI - SKIP TO END OF INFORMATION.
* 
*         SKIPEI FET,RCL
*         ENTRY  *FET* = FET ADDRESS
*                *RCL* = AUTO-RECALL INDICATOR
  
          PURGMAC SKIPEI
 SKIPEI   MACRO  A,B
          IFC    NE,*X2*A*,1
          SX2    A
          R=     X7,SKIPF 
          MX6    18 
          LX6    18 
          IFC    NE,*B**,1
          BX7    -X7
          RJ     SKIP=
          ENDM
          SPACE  4
**        SKIPB - SKIP BACKWARD 
* 
*         SKIPB  FET,N,LVL,RCL
*         ENTRY  *FET* = FET ADDRESS
*                *N* = SKIP COUNT 
*                *LVL* = EOR LEVEL
*                *RCL* = AUTO-RECALL INDICATOR
  
          PURGMAC SKIPB 
 SKIPB    MACRO  F,N,L,R
          SKIPCALL F,R,SKIPB,N,L
          ENDM
          SPACE  4,2
**        READ - READ FILE. 
* 
*         READ   FET,RCL
*         ENTRY  *FET* = FET ADDRESS
*                *RCL* = AUTO-RECALL INDICATOR
  
          PURGMAC READ
 READ     MACRO  A,B
          CIOCALL A,B,READ
          ENDM
          SPACE  4,2
**        READLS - READ LISTED RECORDS. 
* 
*         READLS  FET,RCL 
*         ENTRY  *FET* = FET ADDRESS
*                *RCL* = AUTO-RECALL INDICATOR
  
          PURGMAC READLS
 READLS   MACRO  A,B
          CIOCALL A,B,READLS
          ENDM
          SPACE  4
**        READNS - READ NON-STOP. 
* 
*         READNS FET,RCL
*         ENTRY  *FET* = FET ADDRESS
*                *RCL* = AUTO-RECALL INDICATOR
  
          PURGMAC READNS
 READNS   MACRO  A,B
          CIOCALL A,B,READNS
          ENDM
          SPACE  4,2
**        READSKP - READSKIP ONE RECORD 
* 
*         READSKP FET,RCL 
*                *FET* = FET ADDRESS
*                *RCL* = AUTO-RECALL INDICATOR
  
          PURGMAC READSKP 
 READSKP  MACRO  F,R
          CIOCALL F,R,READSKP 
          ENDM
          SPACE  4,2
**        READW - MOVE WORDS FROM CIRCULAR BUFFER TO WORKING BUFFER.
* 
*         READW  FET,FWA,WORDS
*         ENTRY  *FET* = FET ADDRESS
*                *FWA* = FWA OF WORKING BUFFER
*                *WORDS* = WORD COUNT OF WORKING BUFFER 
  
          PURGMAC READW 
 READW    MACRO  A,B,C
          IFC    NE, X2 A ,1
          SX2    A
          IFC    NE, B6 B ,1
          SB6    B
          R=     B7,C 
          RJ     RDW= 
          ENDM
          SPACE  4,8
**        READO - READ ONE WORD TO X6.
* 
*         READO  FET
*         ENTRY  *FET* = FET ADDRESS
  
  
          PURGMAC READO 
 READO    MACRO  A
          IF     REG,A,2
          R=     A1,A+2 
          ELSE   1
          SA1    A+2
          RJ     RDO= 
          ENDM
          SPACE  4
**        WRITE - WRITE FILE. 
* 
*         WRITE  FET,RCL
*         ENTRY  *FET* = FET ADDRESS
*                *RCL* = AUTO-RECALL INDICATOR
  
          PURGMAC WRITE 
 WRITE    MACRO  A,B
          CIOCALL A,B,WRITE 
          ENDM
          SPACE  4,8
**        WRITEF - WRITE END-OF-FILE. 
* 
*         WRITEF FET,RCL
*         ENTRY  *FET* = FET ADDRESS. 
*                *RCL* = AUTO-RECALL INDICATOR. 
  
          PURGMAC WRITEF
 WRITEF   MACRO  A,B
          CIOCALL A,B,WRITEF
          ENDM
          SPACE  4,8
**        WRITEO - WRITE ONE WORD.
* 
*         WRITEO FET
*         ENTRY  *FET* = FET ADDRESS. 
*                (X6) = WORD TO WRITE.
  
          PURGMAC WRITEO
 WRITEO   MACRO  A
          IF     REG,A,2
          R=     A1,A+2 
          SKIP   1
          SA1    A+2
          RJ     WTO= 
          ENDM
          SPACE  4,2
**        WRITER - ISSUE END-RECORD WRITE.
* 
*         WRITER  FET,RCL 
*         ENTRY  *FET* = FET ADDRESS
*                *RCL* = AUTO-RECALL INDICATOR
  
          PURGMAC WRITER
 WRITER   MACRO  A,B
          CIOCALL A,B,WRITER
          ENDM
          SPACE  4,2
**        WRITEW - MOVE WORDS FROM WORKING BUFFER TO CIRCULAR BUFFER. 
* 
*         WRITEW  FET,FWA,WORDS 
*         ENTRY  *FET* = FET ADDRESS
*                *FWA* = FWA OF WORKING BUFFER
*                *WORDS* = WORD COUNT OF WORKING BUFFER 
  
          PURGMAC WRITEW
 WRITEW   MACRO  A,B,C
          IFC    NE, X2 A ,1
          SX2    A
          IFC    NE, B6 B ,1
          SB6    B
          R=     B7,C 
          RJ     WTW= 
          ENDM
          SPACE  4,2
**        WRITEC - MOVE LINE IMAGE FROM WORKING BUFFER TO CIRCULAR
*                  BUFFER.
* 
*         WRITEC  FET,FWA 
*         ENTRY  *FET* = FET ADDRESS
*                *FWA* = FWA OF WORKING BUFFER
  
          PURGMAC WRITEC
 WRITEC   MACRO  A,B
          IFC    NE, X2 A ,1
          SX2    A
          IFC    NE, B6 B ,1
          SB6    B
          RJ     WTC= 
          ENDM
          SPACE  4,2
**        PRINT - PRINT LINE. 
* 
*         PRINT  ADDRESS,N
*         ENTRY  *ADDRESS* = ADDRESS OF THE LINE IN *C* FORMAT
*                *N* = NUMBER OF BLANK LINES BEFORE LINE TO BE PRINTED
*         CALLS  WBL, WTC=. 
  
          PURGMAC PRINT 
 PRINT    MACRO  A,N
          IFC    NE,$N$$,2
          R=     X6,N 
          RJ     WBL
          IFC    NE,$A$$,3
          IFC    NE,$A$X1$,1
          SX1    A
          RJ     WOF
          ENDM
          SPACE  4,2
**        ++++ SYSTEM REQUEST MACROS. ++++
* 
* 
*         RECALL - WAIT NOT BUSY. 
* 
*         RECALL  FET 
*         ENTRY  *FET* = FET ADDRESS (IF ABSENT, ISSUE SINGLE RECALL) 
  
          PURGMAC RECALL
 RECALL   MACRO  A
          IFC    EQ,*A**,1
          RJ     RCL= 
          IFC    NE,*A**,3
          IFC    NE, X2 A ,1
          SX2    A
          RJ     WNB= 
          ENDM
  
 SMACS    IFSCOPE 
          SPACE  4,2
**        MESSAGE - ISSUE DAYFILE MESSAGE.
* 
*         MESSAGE  ADR,RCL,TYP
*         ENTRY  *ADR* = MESSAGE ADDRESS
*                *RCL* = AUTO-RECALL INDICATOR
*                *TYP* = MESSAGE TYPE 
  
          PURGMAC MESSAGE 
 MESSAGE  MACRO  A,B,C
          IFC    NE,#X1#_A_#,1
          SX1    A
          IFC    EQ,**B*,1
          MX6    0
          IFC    NE,**B*,1
          MX6    1
          IFC    NE,**C*,2
          R=     X2,C 
          BX6    X2+X6
          RJ     MSG= 
          ENDM
 SMACS    ELSE
          SPACE  4,2
**        MESSAGE - ISSUE DAYFILE MESSAGE.
* 
*         MESSAGE  ADR,RCL
*         ENTRY  *ADR* = MESSAGE ADDRESS
*                *RCL* = AUTO-RECALL INDICATOR
  
          PURGMAC MESSAGE 
 MESSAGE  MACRO  A,B
          IFC    NE,#X1#_A_#,1
          SX1    A
          IFC    EQ,**B*,1
          MX6    0
          IFC    NE,**B*,1
          MX6    1
          RJ     MSG= 
          ENDM
 SMACS    ENDIF 
          SPACE  4
**        SMSG - ISSUE STATUS MESSAGE.
*                NO CODE IS GENERATED UNLESS IP.LDBG IS NONZERO.
* 
*         SMSG   ADR
  
          PURGMAC SMSG
 SMSG     MACRO  A
          IFNE   IP.LDBG,0,2
          SA1    A
          RJ     SMS= 
          ENDM
          SPACE  4,2
**        TIME - GET CURRENT CPU TIME 
*              - KRONOS TIME MACRO MODIFIED FOR CYBER LOADER
* 
*         TIME   ADR
*         ENTRY  *ADR* = ADDRESS TO STORE TIME
  
          PURGMAC TIME
 TIME     MACRO  ADR
          LD     X6,3RTIM 
          SX1    ADR
          LX6    42D
          BX6    X6+X1
          LD     X1,200000B 
          LX1    24D
          BX6    X6+X1
          RJ     SYS= 
          ENDM
          SPACE  4,2
**        RTIME - GET CURRENT REAL-TIME CLOCK READING 
*               - KRONOS RTIME MACRO MODIFIED FOR CYBER LOADER
*               - SCOPE RTIME FORMAT REQUESTED
* 
*         RTIME  ADR
*         ENTRY  *ADR* = ADDRESS TO STORE TIME
  
          PURGMAC RTIME 
 RTIME    MACRO  ADR
          LD     X6,3RTIM 
          SX1    ADR
          LX6    42D
          BX6    X6+X1
          LD     X1,200004B 
          LX1    24D
          BX6    X6+X1
          RJ     SYS= 
          ENDM
          SPACE  4,2
**        CLOCK - GET CURRENT SYSTEM CLOCK READING
*               - KRONOS CLOCK MACRO MODIFIED FOR CYBER LOADER
* 
*         CLOCK  ADR
*         ENTRY  *ADR* = ADDRESS TO STORE TIME
  
          PURGMAC CLOCK 
 CLOCK    MACRO  ADR
          LD     X6,3RTIM 
          SX1    ADR
          LX6    42D
          BX6    X6+X1
          LD     X1,200002B 
          LX1    24D
          BX6    X6+X1
          RJ     SYS= 
          ENDM
          SPACE  4,2
**        DATE - GET DATE 
*              - KRONOS DATE MACRO MODIFIED FOR CYBER LOADER
* 
*         DATE   ADR
*         ENTRY  *ADR* = ADDRESS TO STORE DATE
  
          PURGMAC DATE
 DATE     MACRO  ADR
          LD     X6,3RTIM 
          SX1    ADR
          LX6    42D
          BX6    X6+X1
          LD     X1,200001B 
          LX1    24D
          BX6    X6+X1
          RJ     SYS= 
          ENDM
          SPACE  4
 KTRCD    IFNOS 
          SPACE  4,2
**        DISSJ - DISABLE SSJ= (SPECIAL SYSTEM JOB PRIVILEGES)
*               - COPY OF *DISSJ* AS IN *COMCMAC* 
* 
*         DISSJ 
* 
*         CALLS  CPM= 
  
          PURGMAC DISSJ 
 DISSJ    MACRO 
          MX1    0
          LD     X2,43B 
          RJ     =XCPM= 
          ENDM
          SPACE  4,2
**        GETFLC - READ FIELD LENGTH CONTROL WORD 
*                - COPY OF *GETFLC* AS IN *COMCMAC* 
* 
*         GETFLC ADR
* 
*         ENTRY  *ADR* = ADDRESS FOR RESPONSE 
* 
*         EXIT   (ADR) = 12/JC,12/CC,12/0,12/RI,12/IN 
*         JC = JOB CARD FL
*         CC = LAST CONTROL CARD FL 
*         RI = ROLLIN FL
*         IN = FL INCREASE REQUEST
* 
*         CALLS  CPM= 
  
          PURGMAC GETFLC
 GETFLC   MACRO  ADR
          SX1    ADR
          LD     X2,33B 
          RJ     =XCPM= 
          ENDM
          SPACE  4,2
**        SETLC - SET LOADER CONTROL WORD 
*               - COPY OF *SETLC* AS IN *COMCMAC* 
* 
*         SETLC  ADR
* 
*         ENTRY  *ADR* = ADDRESS OF NEW LOADER CONTROL WORD 
* 
*         CALLS  CPM= 
  
          PURGMAC SETLC 
 SETLC    MACRO  ADR
          SX1    ADR
          LD     X2,22B 
          RJ     =XCPM= 
          ENDM
          SPACE  4,2
**        GETLC - GET LOADER CONTROL WORD FROM CONTROL POINT AREA 
* 
*         GETLC  ADR
* 
*         ENTRY  *ADR* = ADDRESS FOR RESPONSE 
* 
*         CALLS  CPM= 
  
          PURGMAC GETLC 
 GETLC    MACRO  ADR
          SX1    ADR
          LD     X2,45B 
          RJ     =XCPM= 
          ENDM
          SPACE  4,2
**        GETGLS - GET GLOBAL LIBRARY NAMES FROM LOADER CONTROL WORDS 
* 
*         GETGLS ADR
* 
*         ENTRY  *ADR* = ADDRESS OF PARAMETER WORD
*                (ADR) = 6/FLAG(0=GET),18/B(=FWA BUFFER),36/0 
* 
*         EXIT   (ADR) = 6/0,18/C(=LWA+1 OF TRANSFER),36/1
* 
*         CALLS  CPM= 
  
          PURGMAC GETGLS
 GETGLS   MACRO  ADR
          SX1    ADR
          LD     X2,46B 
          RJ     =XCPM= 
          ENDM
          SPACE  4,2
**        SETGLS - SET GLOBAL LIBRARY SET IN LOADER CONTROL WORDS 
* 
*         SETGLS ADR
* 
*         ENTRY  *ADR* = ADDRESS OF PARAMETER WORD
*                (ADR) = 6/FLAG(1=SET),18/B(=FWA BUFFER),36/0 
*                (BUFFER) = LIST OF NAMES, LEFT JUST, ZERO FILLED,
*                           ONE PER WORD, TERMINATED BY ZERO WORD.
* 
*         EXIT   (ADR) = 6/1,18/B(=FWA BUFFER),36/1 
* 
*         CALLS  CPM= 
  
          PURGMAC SETGLS
 SETGLS   MACRO  ADR
          SX1    ADR
          LD     X2,47B 
          RJ     =XCPM= 
          ENDM
          SPACE  4,8
**        SETSSM - SET SECURE SYSTEM MEMORY STATUS BIT. 
* 
*         SETSSM N           N=0  CLEAR SSM STATUS BIT
*                            N=1  SET SSM STATUS BIT
* 
*         CALLS  CPM= 
  
          PURGMAC SETSSM
 SETSSM   MACRO  N
          LD     X1,N 
          LD     X2,10B 
          RJ     =XCPM= 
          ENDM
          SPACE  4,2
**        STATUS - GET FILE STATUS
* 
*         STATUS FET,POS
*         ENTRY *FET* = FET ADDRESS 
*                *POS* = NONBLANK IF TO RETURN POSITION 
  
          PURGMAC STATUS
 STATUS   MACRO  FET,POS
          SX2    FET
          IFC    EQ,*POS**,2
          R=     X7,012B
          SKIP   1
          R=     X7,013B
          RJ     =XLFM= 
          ENDM
          SPACE  4,30 
**        GETPAGE - READ PAGE SIZE PARAMETERS.
* 
*         GETPAGE  ADDR 
* 
*         ENTRY  ADDR = ADDRESS FOR RESPONSE. 
* 
*         EXIT   (ADDR) - (ADDR+1) CONTAIN THE FOLLOWING
* 
*                ADDR  = 28/RES,4/JPD,8/JPS,8/JPW,11/URES,1/C 
*                ADDR+1= 28/RES,4/SPD,8/SPS,8/SPW,12/URES 
*                JPD   = JOB PRINT DENSITY ( 6 OR 8 ) 
*                JPS   = JOB PAGE SIZE ( 16 - 255 ) 
*                JPW   = JOB PAGE WIDTH ( 40 - 255 )
*                C     = COMPLETE BIT 
*                SPD   = SYSTEM PRINT DENSITY 
*                SPS   = SYSTEM PAGE SIZE 
*                SPW   = SYSTEM PAGE WIDTH
*                RES   = RESERVED FIELD 
*                URES  = USER RESERVED FIELD
  
          PURGMAC GETPAGE 
 GP       IFGLS 
 GETPAGE  MACRO  A
          SX1    A
          LD     X2,127B
          RJ     =XCPM= 
          ENDM
 GP       ENDIF 
 GP       IFNOTGLS
 GETPAGE  MACRO  A
          LOCAL  DP,SP,WP 
          QUAL   MACRO$ 
 GETPAGE  SET    *
          QUAL   *
 =        IF     -DEF,IP.PD 
 DP       SET    6
 =        ELSE
 DP       SET    IP.PD
 =        ENDIF 
  
 =        IF     -DEF,IP.PS 
 SP       SET    60D
 =        ELSE
 SP       SET    IP.PS
 =        ENDIF 
  
 =        IF     -DEF,IP.PW 
 WP       SET    136D 
 =        ELSE
 WP       SET    IP.PW
 =        ENDIF 
  
          SA6    A
          LD     X1,DP*1S8+SP 
          LX1    12D+8
          LD     X6,WP
          LX6    12D
          BX6    X1+X6
          MX1    59 
          SA6    A6+B1
          BX6    -X1+X6 
          SA6    A6-B1
          ENDM
 GP       ENDIF 
          SPACE  4,8
**        GETMC - GET MACHINE CHARACTERISTICS.
* 
*         GETMC  ADR
* 
*         ENTRY  *ADR* = ADDRESS OF REPLY WORD
* 
*         EXIT   (ADR) - MACHINE CHARACTERISTICS AS DESCRIBED IN NOS REF. MAN.
*                        (VOL. 2) IN SECTION ON *GETMC* MACRO.
*                      - (NOTE - LOADER USES ONLY BIT 20, SET IF SIMULATED
*                        CMU PRESENT.)
* 
*         CALLS  CVL=.
  
          PURGMAC  GETMC
 GETMC    MACRO  A
          SX1    A
          LD     X2,2 
          RJ     =XCVL= 
          ENDM
          SPACE  4
**        ASSIGN - ASSIGN COMMON FILE TO JOB. 
* 
*         ASSIGN FILE,LIBRARY 
*         ENTRY  *LIBRARY* IS PRESENT, FILE WILL BE ASSIGNED FROM 
*                SYSTEM LIBRARY IF AVAILABLE. 
*         CALLS  LFM=.
  
  
          PURGMAC ASSIGN
 ASSIGN   MACRO  F,L
          SX2    F
          IFC    EQ,*L**,2
          R=     X7,1 
          SKIP   1
          R=     X7,20B 
          RJ     =XLFM= 
          ENDM
 KTRCD    ENDIF 
          SPACE  4,2
 SMACS    IFSCOPE 
          SPACE  4,30 
**        GETPAGE - READ PAGE SIZE PARAMETERS.
* 
*         GETPAGE  ADDR 
* 
*         ENTRY  ADDR = ADDRESS FOR RESPONSE. 
* 
*         EXIT   (ADDR) - (ADDR+1) CONTAIN THE FOLLOWING
* 
*                ADDR  = 28/RES,4/JPD,8/JPS,8/JPW,11/URES,1/C 
*                ADDR+1= 28/RES,4/SPD,8/SPS,8/SPW,12/URES 
*                JPD   = JOB PRINT DENSITY ( 6 OR 8 ) 
*                JPS   = JOB PAGE SIZE ( 16 - 255 ) 
*                JPW   = JOB PAGE WIDTH ( 40 - 255 )
*                C     = COMPLETE BIT 
*                SPD   = SYSTEM PRINT DENSITY 
*                SPS   = SYSTEM PAGE SIZE 
*                SPW   = SYSTEM PAGE WIDTH
*                RES   = RESERVED FIELD 
*                URES  = USER RESERVED FIELD
  
          PURGMAC GETPAGE 
 GETPAGE  MACRO  A
          QUAL   MACRO$ 
 GETPAGE  SET    *
          QUAL   *
          R=     X6,3RFIN 
          PX6 
          LX6    42D
          R=     X2,1000B 
          LX2    18D
          IX6    X6+X2
          SX1    A
          BX6    X6+X1
          RJ     SYS= 
          ENDM
          SPACE  4,2
**        STATUS - STATUS FILE
* 
*         STATUS LIST,CODE,RCL
*         ENTRY  *LIST* = PARAMETER LIST ADDRESS
*                *CODE* = FUNCTION CODE 
*                *RCL* = NONBLANK IF TO CALL WITH RECALL
  
          PURGMAC STATUS
 STATUS   MACRO  LIST,X,RCL 
          SYSTEM STS,RCL,LIST,X*100B
          ENDM
          SPACE  4,2
 SMACS    ENDIF 
          SPACE  4,10 
**        SYSTEM - REQUEST SYSTEM FUNCTION. 
* 
*         SYSTEM REQUEST,RECALL,P1,P2 
* 
*         ENTRY  *REQUEST* = 3 CHARACTER SYSTEM REQUEST NAME. 
*                *RECALL* = NONEMPTY IF TO CALL WITH RECALL.
*                *P1* = PARAMETER FOR BITS 0 -17 OF REQUEST.
*                *P2* = PARAMETER FOR BITS 18 - 35 OF REQUEST.
* 
*         USES   X1, X2, X6.
* 
*         CALLS  SYS=.
  
          PURGMAC  SYSTEM 
 SYSTEM   MACRO  C,L,P1,P2
          IFC    NE, C  ,4
          R=     X6,3R;A
          IFC    NE, L  ,1
          PX6 
          LX6    42D
          IFC    NE, P2  ,3 
          R=     X2,P2
          LX2    18D
          IX6    X6+X2
          IFC    NE, P1  ,2 
          SX1    P1 
          BX6    X6+X1
          IFC    EQ, C  ,4
          IFC    NE, L  ,3
          MX1    1
          LX1    41D
          IX6    X6+X1
          RJ     =XSYS= 
          ENDM
          SPACE  4,10 
**        FILINFO - GET FILE INFORMATION. 
* 
*         FILINFO ADDR
* 
*         ENTRY  *ADDR* = ADDR OF TABLE TO RECEIVE FILE INFORMATION.
*                TABLE FORMAT - 
*                 ADDR   = 42/0LFILENAME, 6/LG, 12/C. 
*                           WHERE LG = TABLE LENGTH (SHOULD = 5). 
*                                 C  = COMPLETE BIT (ZERO AT ENTRY).
* 
*         EXIT   *ADDR* - *ADDR+4* CONTAIN INFO (OR ZERO IF NOT FOUND). 
*                IF FILE FOUND THEN - 
*                 ADDR   = 42/0LFILENAME, 6/LG, 12/1 (COMPLETE BIT).
*                 ADDR+1 = 12/DEVCODE, 24/0, 18/ STATUS, 6/FILTYPE. 
*                 ADDR+2 = 12/ESTORD, 48/0. 
*                 ADDR+3 = 30/MAXPRU, 30/CURRPOS(PRU).
*                 ADDR+4 = ZERO.
* 
*         USES   X1, X2, X6.
* 
*         CALLS  SYS=.
  
          PURGMAC  FILINFO
 FILINFO  MACRO  ADDR 
          SYSTEM FIN,RECALL,ADDR,100B 
          ENDM
          SPACE  4,2
**        ++++ TABLE MANAGEMENT MACROS. ++++
* 
* 
*         TABLE - GENERATE MANAGED TABLE. 
* 
*         TABLE  TNAME
*         ENTRY  *TNAME* = TABLE NAME.
  
          PURGMAC TABLE 
          MACRO  TABLE,TNAM 
 TNAM     RVFD   60,MEML+NTAB 
          CON    0
 NTAB     SET    NTAB+1 
          ENDM
          SPACE  4,2
**        ALLOC - ALLOCATE TABLE SPACE. 
* 
*         ALLOC  TABLE,WORDS,FRONT
*         ENTRY  *TABLE* = TABLE POINTER
*                *WORDS* = WORD COUNT OF TABLE
*                *FRONT* = IF PRESENT, INDICATES CHANGE IS TO FRONT 
*                          OF TABLE.
  
          PURGMAC ALLOC 
 ALLOC    MACRO  A,B,C
          R=     X1,B 
          IFC    NE, A2 A ,1
          SA2    A
          IFC    EQ,*C*FRONT*,1 
          RJ     ATF= 
          IFC    NE,*C*FRONT*,1 
          RJ     ATS= 
          ENDM
          SPACE  4,2
**        ADDWRD - ADD WORD TO TABLE. 
* 
*         ADDWRD  TABLE,XREG
*         ENTRY  *TABLE* = TABLE POINTER
*                *XREG* = X REGISTER OR X REG EXPRESSION FOR WORD TO ADD
  
          PURGMAC ADDWRD
 ADDWRD   MACRO  A,B
          IFC    NE,$X1$B$,1
          BX1    B
          IFC    NE, A2 A ,1
          SA2    A
          RJ     ADW= 
          ENDM
          SPACE  4,2
**        ++++ MISCELLANEOUS MACROS. ++++ 
* 
* 
*         OVERLAY - LOAD ABSOLUTE OVERLAY.
* 
*         OVERLAY  NAME,L1,L2,FWA,LWA,EX
*         ENTRY  *NAME* = NAME OF OVERLAY.
*                *L1,L2* = LEVEL OF OVERLAY.
*                *FWA* = LOAD ADDRESS OF OVERLAY. 
*                *LWA* = LWA+1 OF OVERLAY.
*                *EX*, IF PRESENT, MEANS EXECUTE THE OVERLAY. 
  
          PURGMAC OVERLAY 
 OVERLAY  MACRO  A,L1,L2,B,C,EX 
          SA1    =0L_A
          IFC    NE, X2 B ,1
          SX2    B
          IFC    EQ, C  ,2
          MX3    0
          SKIP   2
          IFC    NE, X3 C ,1
          SX3    C
          IFC    EQ, EX  ,1 
          R=     X4,L1*200B+L2*2
          IFC    NE, EX  ,1 
          R=     X4,L1*200B+L2*2+1
          RJ     LOV
          ENDM
          SPACE  4
**        CALL - CALL SUBROUTINE AT VARIABLE ADDRESS. 
* 
*         CALL   R
*         ENTRY  *R* = REGISTER CONTAINING ADDRESS OF SUBROUTINE
  
          PURGMAC CALL
 CALL     MACRO  R
          SB4    R+B1 
          RJ     CALL 
          ENDM
  
  
          SPACE  4,2
**        LDL - CALL PP PROGRAM *LDL*.
* 
*         LDL    PARAM
*         ENTRY  *PARAM* = ADDRESS OF *LDL* PARAMETER AREA. 
  
          PURGMAC LDL 
 LDL      MACRO  A
          IFC    NE, X1 A ,1
          SX1    A
          RJ     LDL
          ENDM
          SPACE  4
**        DMP - CALL PP PROGRAM *DMP*.
* 
*         DMP    FROM,TO           PARAMETERS AS PER O.S. REFERENCE MAN.
* 
*         THIS MACRO IS USED IN PROCESSING THE *DMP* REQUEST. 
*         IT CAN ALSO BE A VERY USEFUL DEBUGGING TOOL.
* 
*         USES   A1, A6, X1, X6.
  
          PURGMAC DMP 
 DMP      MACRO  P1,P2
          BASE   O
          IFC    EQ,*P2**,2 
          DMP    B0,P1
          SKIP   8D 
          IFC    NE,*P1*X1*,4 
          IFC    EQ,*P1**,2 
          SX1    B0 
          SKIP   1
          SX1    P1 
          IFC    NE,*P2*X6*,1 
          SX6    P2 
          RJ     DMP= 
          BASE   *
          ENDM
          SPACE  4,2
**        MOVE - MOVE DATA. 
* 
*         MOVE   WORDS,FROM,TO
*         ENTRY  *WORDS* = WORD COUNT.
*                *FROM* = SOURCE ADDRESS. 
*                *TO* = DESTINATION ADDRESS.
  
          PURGMAC MOVE
 MOVE     MACRO  A,B,C
          R=     X1,A 
          IFC    NE, X2 B ,1
          SX2    B
          IFC    NE, X3 C ,1
          SX3    C
          RJ     MVE= 
          ENDM
          SPACE  4,2
**        ERROR - PROCESS ERROR.
* 
*         ERROR  P1,P2
*         ENTRY  *P1* = *CAT*.
*                *P2* = ADDRESS OF DAYFILE MESSAGE. 
*         OR     *P1* = ERROR NUMBER (MUST NOT HAVE B SUFFIX).
*                *P2* = INDICATOR OF ADDITIONAL PARAMETER.
  
          PURGMAC ERROR 
 ERROR    MACRO  VALUE,ARG
          BASE   O
          IFC    EQ,*VALUE*CAT*,4 
 ERRCAT   =      1
          MX1    1
          SX2    ARG
          SKIP   6
          IFC    EQ,*ARG**,2
          SB2    B0 
          SKIP   1
          SB2    B1 
          R=     X1,VALUE 
          SX2    /LOADM/EP;A
          BASE   *
          RJ     ERROR
          ENDM
          SPACE  4,8
 IC       IFCARD
  
**        REPRIEVE - REQUEST REPRIEVE PROCESSING. 
* 
*         REPRIEVE FWA,CODE,MASK
*         ENTRY  *FWA*  = FWA OF EXTENDED REPRIEVE PARAMETER BLOCK. 
*                *CODE* = NOT USED. 
*                *MASK* = BIT LIST OF RECOVERY CONDITIONS.
  
          PURGMAC REPRIEVE
 REPRIEVE MACRO  A,B,C
          MX6    59 
          SA1    A
          BX6    X6*X1
          SA6    A1 
          R=     X6,C 
          LX6    36D
          R=     A6,A6+3
          R=     X1,0LRPV 
          MX6    1
          LX6    40D-59 
          LX1    42D
          BX1    X1+X6
          LX6    18-40D 
          BX1    X1+X6
          SX6    A1 
          BX6    X1+X6
          RJ     =XSYS= 
          ENDM
  
 IC       ENDIF 
          SPACE  4,2
**        IFTEST - CHECK SYMBOL AND FORCE ENTRY IN REFERENCE TABLE. 
* 
*TAG      IFTEST  OPCODE,ARG1,ARG2,ARG3 
  
          PURGMAC IFTEST
          MACRO  IFTEST,TAG,A,B,C,D 
 '?SYMBOL SET    B
 MIC      MICRO  1,,**
          IFC    NE,**D*,1
 MIC      MICRO  1,,*,D+1*
 TAG      IF_A   B,C"MIC" 
          ENDM
          SPACE  4
**        IXI XJ/XK,BN  -  INTEGER DIVISION 
* 
*         DESTROYS XJ, XK, BN.
  
          PURGDEF IXX/X,B 
 IXX/X,B  OPDEF  I,J,K,N
          PX.J
          NX.J
          PX.K
          NX.K
          FX.I   X.J/X.K
          UX.I   B.N
          LX.I   B.N
          ENDM
          SPACE  4
**        ENTRY - DEFINE ENTRY POINT
* 
*         DEFINE ENTRY POINT AND KEEP TRACK OF HOW MANY 
*         (ELIMINATES THE NEED TO CHANGE THE IDENT AND ORG CARDS
*         WHEN ADDING OR DELETING ENTRY POINTS) 
* 
*         ENTRY  EPTNAME
  
  
 .ENTRY   OPSYN  ENTRY
          PURGMAC ENTRY 
 ENTRY    MACRO  EPTNAME,X
          .ENTRY EPTNAME
 .OFFSET  SET    .OFFSET+1
          IFC    NE,*X**,1
          ERR    REDEFINED *ENTRY* OPCODE TAKES ONLY ONE ARGUMENT 
          ENDM
          SPACE  4,8
**        +++++++++++++++++++++++++++ 
*         + SELF-RELOCATION MACROS. + 
*         +++++++++++++++++++++++++++ 
* 
* 
*              A SERIES OF OPDEFS, CPOPS, AND MACROS ARE DEFINED DUE TO 
*         THE NEED TO PERFORM RELOCATION OF ALL OF THE USER-CALL LOADER 
*         ROUTINES WHEN THEY GET LOADED.  THE METHOD USED IS BASED
*         ON THE ASSUMPTION THAT THE MAJORITY OF 30-BIT INSTRUCTIONS
*         WILL CONTAIN RELOCATABLE QUANTITIES.  WHEN ANY OF THE USER- 
*         CALL ROUTINES *LOADU*, *LOADUC*, OR *LOADUM* ARE ENTERED
*         FOR THE FIRST TIME, THE ROUTINE *REL* SCANS ALL AREAS OF CODE 
*         AS DIRECTED BY THE *RELOC* MACRO AND RELOCATES ALL ADDRESS
*         FIELDS OF 30-BIT INSTRUCTIONS (EXCEPT PS).  SINCE SOME OF 
*         THESE WILL HAVE CONTAINED ABSOLUTE QUANTITIES, THE REMAINING
*         MACROS PROVIDE FOR THIS.  THEY CAUSE GENERATION OF ENTRIES
*         INTO A TABLE AT THE END OF THE OVERLAY WHICH ALLOW *REL* TO 
*         RELOCATE PROPERLY.
* 
*                          + + N O T E + +
* 
*         +++    THE FOLLOWING RULES MUST BE ADHERED TO IN THE USER-
*         +++    CALL ROUTINES.  THEY MAY BE, BUT IT DOES NOT MATTER, 
*         +++    IN THE CONTROL CARD ROUTINES.  SINCE MOST CODE IS
*         +++    COMMON TO BOTH, IT IS RECOMMENDED TO DO SO FOR BOTH. 
*         +++    IN THE CONTROL CARD ROUTINE, THE MACROS GENERATE 
*         +++    NOTHING, AND THE OPDEFS MERELY GENERATE THE STANDARD 
*         +++    INSTRUCTIONS.
*         +++ 
*         +++    1) THE *BR* AND *LD* INSTRUCTIONS MUST BE USED FOR 
*         +++       THOSE INSTRUCTIONS CONTAINING ABSOLUTE QUANTITIES.
*         +++       NORMALLY THE R= PSEUDO-OP IS USED INSTEAD OF THE
*         +++       *LD* INSTRUCTION, SINCE R= IS ALSO REDEFINED AS A 
*         +++       MACRO IN THE USER CALL ROUTINES.
*         +++    2) INSTRUCTIONS CONTAINING NEGATIVE RELOCATABLE
*         +++       ADDRESSES MUST BE PRECEEDED BY THE *NEG* MACRO. 
*         +++    3) *RVFD* OR *MVFD* MUST BE USED IN PLACE OF *VFD* 
*         +++       FOR POSITIVE RELOCATABLE OR NEGATIVE RELOCATABLE
*         +++       FIELDS, RESPECTIVELY. 
*         +++    4) THE *RELOC* MACRO MUST BE USED IN PAIRS TO DELIMIT
*         +++       AREAS OF CODE WHICH ARE TO BE SCANNED BY *REL*
*         +++       FOR 30-BIT INSTRUCTIONS.
* 
*         THE GENERATED TABLE IS OF THE FOLLOWING FORMAT -
* 
*         VFD    6/WIDTH,6/POS,1/SIGN,29/0,18/ADR 
* 
*         FOR WIDTH = 0 --- 
* 
*                POS AND SIGN ARE IGNORED.  EACH 2 OCCURRENCES OF A 
*                WORD IN THIS FORMAT PROVIDE A PAIR OF ADDRESSES
*                (FROM ADR) WHICH SPECIFY THE FWA AND LWA+1 OF AN 
*                AREA OF CODE IN WHICH ALL 30-BIT INSTRUCTIONS GET
*                RELOCATED.  SINCE SOME OF THESE ARE ABSOLUTE (OR 
*                NEGATIVE RELOCATION), THE FORM BELOW ALLOWS THE
*                MACROS TO ADJUST FOR THIS. 
* 
*         FOR WIDTH " 0 --- 
* 
*                WIDTH = WIDTH OF FIELD TO BE RELOCATED.
*                POS = POSITION OF FIELD (0 = RIGHT JUSTIFIED). 
*                SIGN = 0 FOR + RELOCATION. 
*                       1 FOR - RELOCATION. 
*                ADR = ADDRESS OF WORD TO BE RELOCATED. 
* 
*         A WORD OF ALL ZEROES TERMINATES PROCESSING OF THIS TABLE. 
          SPACE  4,8
 BRQ      OPDEF  Q
          IFUSER 1
          RMTGEN
          JP     Q
          BSS    0
 BRQ      ENDM
 BRB      OPDEF  P
          IFUSER 1
          RMTGEN
          JP     B.P
          BSS    0
 BRB      ENDM
 BRBQ     OPDEF  P,Q
          IFUSER 1
          RMTGEN
          JP     Q+B.P
          BSS    0
 BRBQ     ENDM
 LDA,AQ   OPDEF  P,R,Q
          IFUSER 1
          RMTGEN
          SA.P   Q+A.R
 LDA,AQ   ENDM
 LDA,Q    OPDEF  P,Q
          IFUSER 1
          RMTGEN
          SA.P   Q
 LDA,Q    ENDM
 LDA,BQ   OPDEF  P,R,Q
          IFUSER 1
          RMTGEN
          SA.P   Q+B.R
 LDA,BQ   ENDM
 LDA,XQ   OPDEF  P,R,Q
          IFUSER 1
          RMTGEN
          SA.P   Q+X.R
 LDA,XQ   ENDM
 LDB,AQ   OPDEF  P,R,Q
          IFUSER 1
          RMTGEN
          SB.P   Q+A.R
 LDB,AQ   ENDM
 LDB,Q    OPDEF  P,Q
          IFUSER 1
          RMTGEN
          SB.P   Q
 LDB,Q    ENDM
 LDB,BQ   OPDEF  P,R,Q
          IFUSER 1
          RMTGEN
          SB.P   Q+B.R
 LDB,BQ   ENDM
 LDB,XQ   OPDEF  P,R,Q
          IFUSER 1
          RMTGEN
          SB.P   Q+X.R
 LDB,XQ   ENDM
 LDX,AQ   OPDEF  P,R,Q
          IFUSER 1
          RMTGEN
          SX.P   Q+A.R
 LDX,AQ   ENDM
 LDX,Q    OPDEF  P,Q
          IFUSER 1
          RMTGEN
          SX.P   Q
 LDX,Q    ENDM
 LDX,BQ   OPDEF  P,R,Q
          IFUSER 1
          RMTGEN
          SX.P   Q+B.R
 LDX,BQ   ENDM
 LDX,XQ   OPDEF  P,R,Q
          IFUSER 1
          RMTGEN
          SX.P   Q+X.R
 LDX,XQ   ENDM
 LDA,A    OPDEF  P,R
          SA.P   A.R
 LDA,A    ENDM
 LDB,A    OPDEF  P,R
          SB.P   A.R
 LDB,A    ENDM
 LDX,A    OPDEF  P,R
          SX.P   A.R
 LDX,A    ENDM
 LDA,B    OPDEF  P,R
          SA.P   B.R
 LDA,B    ENDM
 LDB,B    OPDEF  P,R
          SB.P   B.R
 LDB,B    ENDM
 LDX,B    OPDEF  P,R
          SX.P   B.R
 LDX,B    ENDM
 LDA,X    OPDEF  P,R
          SA.P   X.R
 LDA,X    ENDM
 LDB,X    OPDEF  P,R
          SB.P   X.R
 LDB,X    ENDM
 LDX,X    OPDEF  P,R
          SX.P   X.R
 LDX,X    ENDM
 LDA,A+B  OPDEF  P,R,S
          SA.P   A.R+B.S
 LDA,A+B  ENDM
 LDB,A+B  OPDEF  P,R,S
          SB.P   A.R+B.S
 LDB,A+B  ENDM
 LDX,A+B  OPDEF  P,R,S
          SX.P   A.R+B.S
 LDX,A+B  ENDM
 LDA,A-B  OPDEF  P,R,S
          SA.P   A.R-B.S
 LDA,A-B  ENDM
 LDB,A-B  OPDEF  P,R,S
          SB.P   A.R-B.S
 LDB,A-B  ENDM
 LDX,A-B  OPDEF  P,R,S
          SX.P   A.R-B.S
 LDX,A-B  ENDM
 LDA,B+B  OPDEF  P,R,S
          SA.P   B.R+B.S
 LDA,B+B  ENDM
 LDB,B+B  OPDEF  P,R,S
          SB.P   B.R+B.S
 LDB,B+B  ENDM
 LDX,B+B  OPDEF  P,R,S
          SX.P   B.R+B.S
 LDX,B+B  ENDM
 LDA,B-B  OPDEF  P,R,S
          SA.P   B.R-B.S
 LDA,B-B  ENDM
 LDB,B-B  OPDEF  P,R,S
          SB.P   B.R-B.S
 LDB,B-B  ENDM
 LDX,B-B  OPDEF  P,R,S
          SX.P   B.R-B.S
 LDX,B-B  ENDM
 LDA,-B   OPDEF  P,S
          SA.P   -B.S 
 LDA,-B   ENDM
 LDB,-B   OPDEF  P,S
          SB.P   -B.S 
 LDB,-B   ENDM
 LDX,-B   OPDEF  P,S
          SX.P   -B.S 
 LDX,-B   ENDM
 LDA,X+B  OPDEF  P,R,S
          SA.P   X.R+B.S
 LDA,X+B  ENDM
 LDB,X+B  OPDEF  P,R,S
          SB.P   X.R+B.S
 LDB,X+B  ENDM
 LDX,X+B  OPDEF  P,R,S
          SX.P   X.R+B.S
 LDX,X+B  ENDM
 RELDEFS  IFUSER
 ERQ      CPOP   3,011B,000B
 ERB      CPOP   3,011B,020B
 ERBQ     CPOP   3,011B,020B
 EWQ      CPOP   3,012B,000B
 EWB      CPOP   3,012B,020B
 EWBQ     CPOP   3,012B,020B
 JRQ      CPOP   5,010B,000B
 QEQ      CPOP   5,040B,000B
 RZQ      CPOP   5,040B,000B
          PURGDEF REQ 
 REQ      OPDEF  Q
          BSS    0
          RMTGEN
          ER     Q
 REQ      ENDM
          PURGDEF REB 
 REB      OPDEF  R
          BSS    0
          RMTGEN
          ER     B.R
 REB      ENDM
          PURGDEF REBQ
 REBQ     OPDEF  R,Q
          BSS    0
          RMTGEN
          ER     Q+B.R
 REBQ     ENDM
          PURGDEF WEQ 
 WEQ      OPDEF  Q
          BSS    0
          RMTGEN
          EW     Q
 WEQ      ENDM
          PURGDEF WEB 
 WEB      OPDEF  R
          BSS    0
          RMTGEN
          EW     B.R
 WEB      ENDM
          PURGDEF WEBQ
 WEBQ     OPDEF  R,Q
          BSS    0
          RMTGEN
          EW     Q+B.R
 WEBQ     ENDM
          PURGDEF RJQ 
 RJQ      OPDEF  Q
          JR     Q
          BSS    0
 RJQ      ENDM
          PURGDEF EQQ 
 EQQ      OPDEF  Q
          QE     Q
          BSS    0
 EQQ      ENDM
          PURGDEF ZRQ 
 ZRQ      OPDEF  Q
          RZ     Q
          BSS    0
 ZRQ      ENDM
 RELDEFS  ENDIF 
 NEG      MACRO 
          LOCAL  AAAAAAAA,BBBBBBBB
 A        IFUSER
          IFLT   $,29D,1
          BSS    0
          QUAL
 AAAAAAAA SET    *
 BBBBBBBB SET    $
          QUAL   *
          RMTFIELD 18D,BBBBBBBB-29D,1,AAAAAAAA
          RMTFIELD 18D,BBBBBBBB-29D,1,AAAAAAAA
 A        ENDIF 
 NEG      ENDM
 RVFD     MACRO  WIDTH,VALUE
          IFUSER 1
          GENVFD WIDTH,VALUE,0
          IFCARD 1
          VFD    WIDTH/VALUE
 RVFD     ENDM
 MVFD     MACRO  WIDTH,VALUE
          IFUSER 1
          GENVFD WIDTH,VALUE,1
          IFCARD 1
          VFD    WIDTH/VALUE
 MVFD     ENDM
 RELOC    MACRO 
          LOCAL  AAAAAAAA 
 A        IFUSER
          IFLT   $,59D,1
          BSS    0
          QUAL
 AAAAAAAA SET    *
          QUAL   *
          RMTFIELD 0,0,0,AAAAAAAA 
 A        ENDIF 
 RELOC    ENDM
 RELDEFS  IFUSER
 RMTGEN   MACRO 
          LOCAL  AAAAAAAA,BBBBBBBB
          IFLT   $,29D,1
          BSS    0
          QUAL
 AAAAAAAA SET    *
 BBBBBBBB SET    $
          QUAL   *
          RMTFIELD 18D,BBBBBBBB-29D,1,AAAAAAAA
 RMTGEN   ENDM
 GENVFD   MACRO  WIDTH,VALUE,SIGN 
          LOCAL  AAAAAAAA,BBBBBBBB
          QUAL
 AAAAAAAA SET    *
 BBBBBBBB SET    $
          QUAL   *
          ERRNG  $+1-WIDTH   ERROR IF RELOC VFD CROSSES WORD BNDRY
          VFD    WIDTH/VALUE
          RMTFIELD WIDTH,BBBBBBBB-WIDTH+1,SIGN,AAAAAAAA 
 GENVFD   ENDM
 RMTFIELD MACRO  WIDTH,POS,SIGN,ADR 
 RELTABLE RMT 
 +        VFD    6/WIDTH,6/POS,1/SIGN,29D/0,18D/ADR 
 RELTABLE RMT 
 RMTFIELD ENDM
          PURGMAC R=
 R=       MACRO  P,ADR
          IFC    NE, P ADR ,15
          IF     -REG,ADR,13
          IF     DEF,ADR,12 
          IFEQ   ADR,-1,2 
          LD     P,-B1
          SKIP   10 
          IFEQ   ADR,0,2
          LD     P,B0 
          SKIP   7
          IFEQ   ADR,1,2
          LD     P,B1 
          SKIP   4
          IFEQ   ADR,2,2
          LD     P,B1+B1
          SKIP   1
          LD     P,ADR
 R=       ENDM
 PS       MACRO 
          CON    00000000006100046000B
 PS       ENDM
 RELDEFS  ENDIF 
          TITLE  ENTRY POINTS, CONTROL WORD DEFINITION. 
 .OFFSET  SET    1
  
  
 C        IFCARD
          ENTRY  LOADLDR                                                 LDR0238
          ENTRY  LOAD 
          ENTRY  LIBLOAD
          ENTRY  SLOAD
          ENTRY  EXECUTE
          ENTRY  NOGO 
          ENTRY  SATISFY
          ENTRY  SEGLOAD
          ENTRY  LDSET
          ENTRY  GROUP
          ENTRY  CAPSULE
          IFTEST NE,IP.LDBG,0,1 
          ENTRY  LDPATCH
          ENTRY  LDR= 
 N        IFNOS 
          ENTRY  SLDR=
          ENTRY  MFL= 
          ENTRY  SSJ= 
 SSJ=     EQU    0
 N        ENDIF 
          ENTRY  SDM= 
 SDM=     EQU    1
 C        ENDIF 
  
 U        IFUSER
          ENTRY  LOADU
 U        ENDIF 
  
  
 OFFSET   EQU    .OFFSET
          ORG    BASE+OFFSET
          SPACE  4
          B1=1
          SPACE  4
 RELOC    IFUSER
          QUAL   RRLOADU
 OVLYFWA  EQU    BASE 
          QUAL
 RELOC    ENDIF 
          TITLE  FET AREA.
**        +++++++++++++ 
*         + FET AREA. + 
*         +++++++++++++ 
* 
* 
*              THE MAIN LOADER FET IS LOCATED AT THE ORIGIN ADDRESS OF
*         THE LOADER PROGRAM.  NOTE THAT THE I/O SUBROUTINES USE THE
*         WORD PRIOR TO THE START OF THE FET TO HOLD THE LAST 
*         FUNCTION CODE ISSUED. 
* 
*              THE ALTERNATE FET *O* IS USED FOR FORTRAN INTERACTIVE
*         DEBUG (FID), SEGMENT LOADING AND BY *BLOADM* TO SPOOL 
*         FILES.  NO BUFFER SPACE IS ALLOCATED FOR IT UNTIL IT IS 
*         NEEDED. 
* 
  
 L        CON    1           9-WORD FET 
          RVFD   60,MEML-IP.LBUF
          CON    0,0
          RVFD   60,MEML
          BSSZ   4
  
 IC       IFCARD
          CON    0           LAST FUNCTION CODE ISSUED
 O        CON    1           9-WORD FET 
          VFD    60/MEML
          VFD    60/MEML
          VFD    60/MEML
          VFD    60/MEML
          BSSZ   4
 IC       ENDIF 
          SPACE  4,8
**             THIS IS ALSO THE START OF THAT PORTION OF THE LOADER 
*         WHICH REMAINS IN CORE THROUGHOUT THE LOADING PROCESS, WHEREAS 
*         OTHER HIGHER PORTIONS MAY BE OVERWRITTEN.  THIS AREA RESIDES
*         BETWEEN THE LOCATIONS *BASE* AND *LOCL* AND INCLUDES:                .
* 
*                THE MAIN FET.
*                MANAGE TABLE POINTERS. 
*                FLAGS AND CONSTANTS. 
*                SMALL ABSOLUTE LOAD ROUTINES.
*                I/O ROUTINES.
*                TABLE MANAGER. 
*                MISCELLANEOUS SUBROUTINES. 
*                EXECUTION PROCESSOR. 
          QUAL
          SPACE  4,8
**        +++++++++++++++++++++++++ 
*         + SMALL ABSOLUTE LOADER + 
*         +++++++++++++++++++++++++ 
* 
* 
*         THIS SECTION CONTAINS ROUTINES OF VARIOUS TYPES USED BY 
*         THE SMALL ABSOLUTE LOADER TO COMPLETE THE LOAD.  THEY 
*         MUST REMAIN AT THE TOP OF THE FIELD LENGTH. 
  
  
 IC       IFCARD
 DEFER    CON    0           LENGTH OF ABS CM IMAGE IN DEFERRED LOADS 
 PA       CON    0           MAX LWA+1 ABS DATA 
          IFNOS  1
 NODISSJ  CON    0           NZ IF NOT TO ISSUE *DISSJ* 
 SPYWORD  VFD    12/10B,36//LOADS/ENDS/100B+1,12/0
 IC       ENDIF 
 FNTS     VFD    60/0LZZZZZ03      TABLE FOR PROVIDING FNT ADDRESSES OF 
          VFD    60/0LZZZZZ04       VARIOUS FILES.  IF PRESENT, FNT 
          VFD    60/0LZZZZZ06        ADR GETS STORED IN LOWER 12 BITS.
 LFNTS    EQU    *-FNTS 
 SLDRCLD  CON    0           SET NONZERO IF SLDR= ENTRY (REL FROM CLD)
 IC       IFCARD
 SDMFLAG  CON    0           =1, SYSTEM PROG WITH SDM=, =-1, NON-SYSTEM 
                             =0, SYSTEM PROG W/O SDM= 
 DFMFLAG  CON    0           =0, DAYFILE MESSAGE NOT ISSUED, <>0, ISSUED
 IC       ENDIF 
  
  
          QUAL   CCIO 
          BASE   D
  
**        SETFET - SET UP FET.
* 
*                THIS ROUTINE IS NORMALLY CALLED VIA THE *SETFET* MACRO 
*         PRIOR TO ACCESSING A FILE.  IT INITIALIZES THE FET AS FOLLOWS-
* 
*         1) STORES (X6) IN THE FIRST WORD. 
*         2) SETS *IN* = *FIRST*. 
*         3) SET *OUT* = *FIRST*. 
*         4) SETS FET LENGTH TO 9 WORDS (*L* FIELD = 4).
*         5) SETS *EP* BIT. 
*         6) SETS FNT ADDRESS IN WORD 4 IF IT CAN BE FOUND IN TABLE 
*            *FNTS* FOR THIS FILE.
*         7) CLEARS ALL WORDS BEYOND THE FIRST FIVE.
* 
*         ENTRY  (X2) = ADDRESS OF FET. 
*                (X6) = FILE NAME + MODE. 
*                *FIRST* AND *LIMIT* ARE SET UP.
*         EXIT   (X2) = ADDRESS OF FET. 
*         USES   X - 1, 6, 7. 
*                B - NONE.
*                A - 1, 6, 7. 
*         CALLS  NONE.
  
  
          RELOC  ON 
  
 SETFET   EQ     *+400000B         ENTRY/EXIT 
          SA6    X2                SET FILE NAME
          SA1    X2+B1             (X7) = *FIRST* 
          SX7    X1 
          SX1    B1 
          LX1    18+2              SET FOR 9-WORD FET 
          BX6    X7+X1
          LX1    44-18-2           SET *EP* BIT 
          BX6    X6+X1
          SA6    A6+B1             STORE FET(1) 
          SA7    A6+B1             SET FIRST = IN = OUT 
          SA7    A7+B1
          SA1    A7+B1             (X7) = *LIMIT* 
          SX7    X1 
          SA1    X2                FET(0) 
          BX6    X1                SAVE FILE NAME 
          SA6    A1                SAVE FET ADDRESS 
          SA1    FNTS-1            INITIALIZE SEARCH
 SETFET1  SA1    A1+B1             NEXT ENTRY FROM *FNTS* 
          ZR     X1,SETFET2        IF END OF TABLE
          SX2    X1                SAVE FNT ADDRESS 
          BX1    X1-X6             COMPARE FILE NAMES 
          AX1    18 
          NZ     X1,SETFET1        IF NO MATCH
          LX2    48                ADD FNT ADR TO FET(4), OK IF ZERO
          BX7    X7+X2
 SETFET2  SX2    A6                RESTORE FET ADDRESS
          MX6    0
          SA7    A7+B1             STORE FET(4) 
          SA6    A7+B1             CLEAR REMAINING WORDS
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
          EQ     SETFET            EXIT 
  
          BASE   *
          QUAL
 ABORT    SPACE  4,8
**        ABORT - ISSUE ABORT 
* 
 ABORT    BSS    0
          RJ     RSF               RETURN SYSTEM FILES
          SA1    ABTTYPE           ISSUE *ABT* WITH BIT 36 SET IF 
          R=     X6,3RABT          SYSTEM ABORT 
          LX1    36-42
          BX6    X6+X1
          LX6    42 
          RJ     SYS= 
          EQ     *
  
 ABTTYPE  CON    0                 SET TO ONE IF SYSTEM ABORT TO BE USED
 PSM      SPACE  4,8
**        PSM - PRESET CENTRAL MEMORY.
* 
*         ENTRY  (X2) = PRESET FWA. 
*                (X3) = PRESET LWA+1. 
*                (X4) = VALUE TO USE AS ADDRESS INSERTION AT FWA. 
*                       NEEDED FOR PRESETTING AREAS WHICH ARE ABOVE 
*                       THEIR EXECUTION ADDRESSES.
*                PSMA AND PSMB ALREADY SET UP.
*         EXIT   NONE.
*         USES   X - 1, 6, 7. 
*                B - 2, 7.
*                A - 1, 6, 7. 
*         CALLS NONE. 
  
  
 PSM      EQ     *+1S17      ENTRY/EXIT 
          SA1    PSMB 
          R=     B2,X2-2     (B2) = FWA-2 
          LX6    X1          (X6) = (X7) = PRESET VALUE 
          BX7    X1 
          R=     B7,X3-3     (B7) = (LWA+1)-3 = LWA-2 
          SA1    A1-B1       PRESET OPTION
          NZ     X1,PSM0     IF PRESETTING USED 
          MX6    0           *NONE* SPECIFED. FORCE PRESETTING TO ZERO
          MX7    0           PRESET VALUE 
          EQ     PSM4        GO PRESET CORE 
  
 PSM0     BSS    0
          MI     X1,PSM4     IF PRESETTING WITHOUT ADDRESS INSERTION
          R=     X1,X4-2
          BX6    X6+X1       INSERT INITIAL ADDRESSES 
          SX1    X1+B1
          BX7    X7+X1
          SX1    B1+B1       (X1) = 2 
          GE     B2,B7,PSM2  IF < 2 WORDS TO PRESET 
 PSM1     IX6    X6+X1       INCREMENT ADDRESS FIELD
          R=     B2,B2+2     INCREMENT STORE ADDRESS
          IX7    X7+X1       INCREMENT ADDRESS FIELD
          SA6    B2          STORE
          SA7    B2+B1       STORE
          LT     B2,B7,PSM1  IF AT LEAST TWO MORE 
 PSM2     GT     B2,B7,PSM   IF NO MORE, EXIT 
          IX6    X6+X1
          R=     A6,B2+2     PRESET LAST ODD WORD 
          EQ     PSM         EXIT 
  
 PSM3     R=     B2,B2+2     INCREMENT STORE ADDRESS
          SA6    B2          STORE
          SA7    B2+B1       STORE
 PSM4     LT     B2,B7,PSM3  IF AT LEAST TWO MORE 
          GT     B2,B7,PSM   IF NO MORE,EXIT
          R=     A6,B2+2     PRESET LAST ODD WORD 
          EQ     PSM         EXIT 
  
 PSMA     CON    -1          PRESET FLAG -
                                    =  0 IF NO PRESETTING 
                                    = -1 IF PRESETTING WITHOUT INSERTION
                                    =  1 IF PRESETTING WITH INSERTION 
                             ---- *PSMB* MUST IMMEDIATELY FOLLOW *PSMA* 
 PSMB     CON    0           PRESET VALUE 
  
          QUAL   SLD
RLI       SPACE  4,8
**        RLI - RELEASE LIBRARY INTERLOCK.
* 
*              THIS ROUTINE (USED FOR NOS/BE ONLY) CLEARS THE LIBRARY 
*         INTERLOCK IN THE CONTROL POINT AREA, PROVIDED THE FLAG
*         *LOCK* INDICATES THAT IT IS CURRENTLY SET.
* 
*              THIS IS DONE BY ISSUING CODE 2030B TO *LDL*.  THE FLAG 
*         IS IN THE CONTROL POINT AREA AT WORD *W.CPFLAG*,
*         BYTE *C.CPFLAG*, BIT *S.CPLDAF*.
* 
*         ENTRY  *LOCK* = NZ IF INTERLOCK CURRENTLY SET.
*         EXIT   NONE.
*         USES   X - 1, 2, 6, 7.
*                B - NONE.
*                A - 1, 7.
*         CALLS  SYS=.
  
  
 RLI      EQ     *+1S17      ENTRY/EXIT 
 IS       IFSCOPE 
          SA1    LOCK 
          R=     X7,2030B 
          ZR     X1,RLI      IF INTERLOCK NOT SET 
          SA7    A1 
          SX1    A7 
          R=     X2,4RLDLP/16  FORM *LDL* CALL WORD 
          MX7    -18         REMOVE SIGN EXTENSION
          BX2    -X7*X2 
          LX2    36+4        VFD  60/0LLDLP 
          BX6    X1+X2
          RJ     SYS=        CALL *LDL* 
          MX7    0           FLAG INTERLOCK AS NOT SET
          SA7    A7 
 IS       ENDIF 
          EQ     RLI         EXIT 
  
 LOCK     CON    0           NZ WHEN LIBRARY INTERLOCK SET
          QUAL
 RLI=     EQU    /SLD/RLI 
 RSF      SPACE  4,8
**        RSF - RETURN SYSTEM FILES.
* 
*                THIS ROUTINE RETURNS ANY SYSTEM FILES WHICH MAY BE 
*         CURRENTLY ATTACHED.  IT IS CALLED BOTH AT NORMAL TERMINATION
*         AND DURING *REPRIEVE* PROCESSING IN THE CASE OF ABNORMAL
*         TERMINATION.  NOTE THAT IT USES ITS OWN FET (RSFA), SO AS TO
*         AVOID ANY CONFLICTS WITH *L* OR *O* IN CASE EITHER ARE STILL
*         ACTIVE OR SET TO BUSY BUT NOT YET INITIATED.
*                IF UNDER NOS, THEN SSJ= PRIVILEGES ARE DISABLED
*         UNLESS WE ARE GOING TO LOAD CCL FROM THE CLD IN RESPONSE
*         TO A LOCAL FILE NAME CALL STATEMENT TO LOAD A CCL PROC. 
  
  
 RSF      EQ     *+400000B         ENTRY/EXIT 
 K        IFNOS 
 IC       IFCARD
          SA2    DEFER
          NZ     X2,RSF1A    IF DEFERRED LOAD, SMS= OVERWRITTEN 
          SMSG   (=C/  RETURNING SYSTEM FILES/) 
 RSF1A    SA1    NODISSJ
          NZ     X1,RSF3     IF NOT TO DISABLE *SSJ=* 
          SA1    SLDRCLD     IF ENTERED AT SLDR= DO NOT DISSJ AGAIN 
          NZ     X1,RSF3
          DISSJ              ELSE DISABLE SSJ= PRIVILEGES 
 RSF3     BSS    0
 IC       ENDIF 
          RECALL L           WAIT ON PREVIOUS ACTIVITY
          SA1    TSFR              TABLE OF SYSTEM FILES TO BE RETURNED 
          SA2    A1+B1
          IX2    X2+X1
          SB2    X1                FWA OF *TSFR*
          SB3    X2                LWA+1 OF *TSFR*
 RSF1     EQ     B2,B3,RSF4        IF ALL FILES RETURNED
          SA1    B2                NEXT FILE NAME 
          MX3    42                FORM *CLOSER* REQUEST IN FET, WD 0 
          R=     X6,2 
          BX1    X3*X1
          BX6    X1+X6
          R=     X2,CLOSER
          BX6    X6+X2
          SA6    RSFA 
          SA1    A6+B1             SET *IN* = *OUT* = *FIRST* 
          SX6    X1 
          SA6    A1+B1
          SA6    A6+B1
          SYSTEM CIO,R,RSFA  ISSUE *CIO* WITH RECALL
 RSF2     SB2    B2+B1
          EQ     RSF1              LOOP FOR NEXT ENTRY
  
 RSF4     BSS    0
  
 K        ELSE
          R=     B2,LFNTS-1 
          MX3    42 
 RSF1     SA1    B2+FNTS
          BX2    -X3*X1 
          BX1    X3*X1
          ZR     X2,RSF2     IF FILE DOES NOT EXIST 
          R=     X6,2        FORM *CLOSER* REQUEST IN FET, WD 0 
          BX6    X1+X6
          R=     X2,CLOSER
          BX6    X6+X2
          SA6    RSFA 
          SA1    A6+B1       SET *IN* = *OUT* = *FIRST* 
          SX6    X1 
          SA6    A1+B1
          SA6    A6+B1
          SYSTEM CIO,R,RSFA  ISSUE *CIO* WITH RECALL
 RSF2     SB2    B2-B1
          PL     B2,RSF1
  
 K        ENDIF 
  
 IC       IFCARD
          SA1    RPVEXCH+1   WILL BE NZ ONLY IF REPRIEVED 
          NZ     X1,RSF5     IF LOADER WAS REPRIEVED
          REPRIEVE  RPVPM,,0  CLEAR MASK FIELD
 RSF5     BSS    0
 IC       ENDIF 
          EQ     RSF               EXIT 
  
 RSFA     VFD    42/0LZZZZZ17,18/CLOSER+2+0  FET FOR RETURNING FILES
                             (FIRST USED FOR RETURNING *ZZZZZ17*) 
          CON    2,2,2,3     DUMMY BUFFER POINTERS
  
          QUAL
 RPV      SPACE  4,8
 IC       IFCARD
  
**        RPV - LOADER *REPRIEVE* ROUTINE.
* 
*              THIS ROUTINE GETS CONTROL AFTER ANY OF THE TYPES 
*         OF ABORTS LISTED AT THE BEGINNING OF THE INITIALIZATION 
*         CODE (*INIT*).  IT DOES THE FOLLOWING - 
* 
*         1) SETS THE COMPLETION BIT IN FET *L*, IF NO FUNCTION CODE
*            IS PRESENT.
*         2) IF THE ERROR CODE IS FOR TERMINAL INTERRUPT, CONTROL IS
*            PASSED TO *ABORT*, WHERE *RSF* WILL BE CALLED TO RETURN
*            SYSTEM FILES, AND AN *ABT* REQUEST ISSUED.  (NOTE THAT A 
*            *RESET* CANNOT BE ISSUED AFTER A TERMINAL INTERRUPT. 
*         3) FOR ALL OTHER CODES, *RSF* IS CALLED TO RETURN SYSTEM
*            FILES, AND A *RESET* IS ISSUED TO RESET THE PREVIOUS 
*            ERROR CONDITION. 
  
  
 RPVPM    VFD    36/0,12/RPVPME-*,11/1,1/1  LENGTH, *SETUP* FUNCTION, CPL BIT 
          VFD    42/0,18/RPV  TRANSFER ADDRESS TO RPV CODE
          VFD    60/0 
          VFD    60/0        24/MASK,24/(ERROR CLASS),12/(ERROR CODE) 
          BSSZ   5           REMAINDER OF PARAM BLOCK 
 RPVEXCH  BSSZ   16          EXCHANGE PACKAGE 
 RPVPME   BSS    0           END OF PARAM BLOCK 
  
 RPV      BSS    0           START OF *REPRIEVE* ROUTINE
          MX2    -9 
          SA1    L
          SX6    B1 
          BX2    -X2*X1 
          NZ     X2,RPV5     IF FUNCTION CODE PRESENT 
          SA6    A1          SET COMPLETION BIT IN FET
 RPV5     SA6    ABTTYPE     SET FOR SYSTEM ABORT 
          SA1    RPVPM+3     CHECK ERROR CODE 
          MX2    -12
          BX3    -X2*X1 
          SX3    X3-40B 
          ZR     X3,ABORT    IF TERMINAL INTERRUPT
          RJ     RSF         RETURN SYSTEM FILES
          SA4    RPVPM       SET *RESET* CODE IN PARAMETER AREA 
          MX2    -12
          BX4    X2*X4
          SX6    3S1
          BX6    X4+X6
          SA6    A4 
          REPRIEVE  RPVPM,,0  ISSUE REPRIEVE *RESET*
  
          QUAL   CSYS 
          BASE   D
 SPYOFF   SPACE  4,8
**        SPYOFF - TURN OFF *SPY*.
* 
  
  
 SPYOFF   EQ     *+400000B         ENTRY/EXIT 
 SPY      IFTEST NE,IP.LDBG,0 
 SPY      IFSCOPE 
          SA1    B0 
          LX1    48 
          PL     X1,SPYOFF         IF NOT SPYING
          R=     X6,3RRCL 
          SX7    B0 
          LX6    42 
          SA7    SPYWORD
          R=     X1,377777B 
          BX6    X6+X1
          RJ     SYS=              RECALL SO *SPY* NOTICES
 SPY      ENDIF 
          EQ     SPYOFF            EXIT 
  
          BASE   *
          QUAL
 IC       ENDIF 
  
          QUAL   CCPM 
          BASE   D
 CPM      SPACE  4,8
  
**        CPM - CONTROL POINT MANAGER PROCESSOR 
*             - COPY OF KRONOS *COMCCPM* MODIFIED FOR CYBER LOADER. 
* 
*         CPM CALLS THE PP PROGRAM *CPM* TO PERFORM TASKS 
*         INVOLVING CONTROL POINT ACTIVITY. 
* 
*         ENTRY  (X1) = PARAMETER 
*                (X2) = REQUEST 
* 
*         EXIT   NONE 
* 
*         USES   X - 1, 2, 6. 
*                B - NONE.
*                A - NONE.
* 
*         CALLS  SYS= 
  
 CPM1     RJ     =XSYS= 
  
 CPM=     PS                       ENTRY/EXIT 
          MX6    -24
          BX1    -X6*X1 
          LX2    24 
          LD     X6,4RCPMP/16 
          BX1    X2+X1
          LX6    40 
          BX6    X6+X1
          EQ     CPM1 
  
          BASE   *
          QUAL   *
 CPM=     EQU    /CCPM/CPM= 
  
          QUAL   CSYS 
          BASE   D
 WNB      SPACE  4,8
**        WNB - WAIT NOT BUSY.
* 
*         WAIT FOR FET STATUS WORD BIT 0 TO BE SET. 
*         IF WORD IS INITIALLY 0, RETURN. 
* 
*         ENTRY  (X2) = ADDRESS OF STATUS WORD. 
*         EXIT   RETURN WHEN BIT 0 OF STATUS WORD IS SET. 
*         USES   X - 1, 6.
*                B - NONE.
*                A - 1. 
*         CALLS  SYS=.
  
  
 WNB2     LX1    40 
          IX6    X6+X1
          RJ     SYS= 
 WNB      EQ     *+400000B         ENTRY/EXIT 
          LD     X6,3RRCL 
          LX6    42 
          IX6    X6+X2
 WNB1     SA1    X6                CHECK STATUS WORD
          LX1    59 
          NG     X1,WNB            RETURN IF STATUS BIT SET 
          ZR     X1,WNB            RETURN IF BLANK STATUS 
          LD     A1,1              WAIT (RA+1) CLEAR
          NZ     X1,WNB1
          SX1    A1                CONTINUE RECALL
          EQ     WNB2 
  
          BASE   *
          QUAL
  
          QUAL   CSYS 
          BASE   D
 SYS      SPACE  4,8
**        SYS - PROCESS SYSTEM REQUEST. 
* 
*              THIS ROUTINE ISSUES REQUESTS TO THE OPERATING SYSTEM BY
*         STORING RA+1.  UPON ITS FIRST ENTRY, THE XJ FLAG (SIGN BIT OF 
*         RA+66B) IS EXAMINED AND, IF SET, THIS ROUTINE MODIFIES ITSELF 
*         SO AS TO PERFORM AN XJ FOR EACH REQUEST.
* 
*         ENTRY  (X6) = SYSTEM REQUEST. 
*         EXIT   REQUEST PROCESSED. 
*         USES   X - 1.             (ALSO USES X6 ON FIRST ENTRY ONLY)
*                B - NONE.
*                A - 1, 6.
*         CALLS  NONE.
  
  
 SYSA     SA1    A1                WAIT (RA+1) CLEAR IF AUTO RECALL 
          LX1    59-40
          MI     X1,SYS1
 SYS1     EQ     SYS2              FIRST ENTRY
  
 SYS      EQ     *+1S17            ENTRY/EXIT 
+         R=     A1,1              WAIT (RA+1) CLEAR
          NZ     X1,* 
          SA6    A1                ENTER REQUEST
          EQ     SYS1 
  
*         INITIAL ENTRY TO SET TYPE OF CALL.
  
 SYS2     SA1    SYSA              SET FOR NO CENTRAL EXCHANGE JUMP 
          BX6    X1 
          R=     A1,COMXJ 
          PL     X1,SYS3           IF CEJ NOT SUPPORTED 
          R=     X6,0130B          XJ INSTRUCTION 
          LX6    48 
 SYS3     SA6    SYS1              SET MONITOR CALL 
          R=     A1,1              RESTORE (A1) 
          BX6    X1 
          RJ     SYSA              CLEAR STACK
  
          BASE   *
          QUAL
  
 IC       IFCARD
 LOADA    SPACE  4,8
**        LOADA - LOAD ABSOLUTES. 
* 
*             *LOADA* CONTAINS THE CODE USED TO COMPLETE LOADING OF 
*         53- AND 54-TABLE ABSOLUTE OVERLAYS WITH A MINIMUM OF SPACE
*         OVERHEAD. 
* 
*            AT THE POINT *LOADA* IS CALLED, LOADER WAS ON THE VERGE
*         OF JUMPING TO THE MOVE-DOWN LOOP CODE ON THE (ERRONEOUS)
*         ASSUMPTION THAT THE ENTIRE PROGRAM WAS LOADED INTO TPGM.
* 
*            *LOADA* WILL FINISH READING THE PROGRAM TEXT AND THEN
*         COMPLETE THE LOAD.
* 
*         ENTRY  B1 = 1 
*                B5 = PRESET FLAG 
*                B6 = LWA+1 TO PRESET 
*                B7 = FIRST WORD ADDRESS OF MOVE LOOP 
*                A0 = CM FL 
*                A5 = TRANSFER ADDRESS
*                X0 = ECS FL
*                X5 = PRESET VALUE
* 
*         THESE VALUES WILL BE PASSED TO THE MOVE-DOWN ROUTINE. 
* 
*            *LOADA* WORKS AS FOLLOWS.. 
* 
*         1) THE TSFR TABLE IS MOVED DOWN TO IMMEDIATELY FOLLOW *LOADA*.
*            (NOS ONLY) 
  
 LOADA    BSS    0
 IK       IFNOS 
          SA2    TSFR+1      NUMBER OF WORDS
          SB2    LOADAX      PLACE TO MOVE THEM TO
          SA1    A2-B1       LOCATION OF FIRST WORD 
          ZR     X2,LDAFX    NULL LIST
          SB3    X2 
          SA2    X1          FIRST WORD 
  
 LDAFR    BX6    X2 
          SA2    A2+B1       NEXT WORD
          SB3    B3-B1       COUNT
          SA6    B2 
          SB2    B2+B1       NEXT STORE ADDRESS 
          NZ     B3,LDAFR 
  
 LDAFX    SX7    LOADAX 
          SX6    B2 
          SA7    A1          NEW START FOR TSFR 
          SA6    PTGM        FUTURE BASE FOR TPGM 
 IK       ENDIF 
  
**
*         2)  MOVE TPGM DOWN TO ORIGIN PTGM (AFTER TSFR). 
* 
  
          SMSG   (=C/BEGINNING DEFERRED LOAD/)
          SA1    TPGM 
          SA3    PTGM 
          SA2    A1+B1
          SA1    X1          FIRST WORD 
          SB3    X2          COUNT
          BX7    X1 
          SA7    X3          FIRST STORE
          SB3    B3-B1
  
 LDAML    SA1    A1+B1       MOVE LOOP
          SB3    B3-B1
          BX7    X1 
          SA7    A7+B1
          NZ     B3,LDAML 
  
**        3)  APPEND ANY DATA IN BUFFER TO NEW TPGM.
* 
  
          RECALL L           WAIT FOR FILE QUIET
          SA1    L+1         FIRST
          SA2    A1+B1       IN 
          SA3    A2+B1       OUT
          SA4    A3+B1       LIMIT
          SB2    X2 
          SB3    X3 
          SB4    X4 
 LDAUL    EQ     B3,B2,LDAUX  EMPTY BUFFER
  
          SA2    B3          MOVE A WORD
          SB3    B3+B1
          BX7    X2 
          SA7    A7+B1
          NE     B3,B4,LDAUL
          SB3    X1          OUT=LIMIT, SET TO FIRST
          EQ     LDAUL
  
**        4)  READ THE REST OF THE RECORD INTO NEW TPGM.
* 
  
 LDAUX    SX7    A7+B1       NEXT LOAD ADDRESS
          SA2    PTGM 
          SA7    A1          SET FIRST, IN, OUT 
          SA3    PA 
          SA7    A7+B1
          SA7    A7+B1
          IX6    X2+X3
          SX6    X6+B1
          SA6    A7+B1       LIMIT = PA + START + 1 
          MX7    0           CLEAR 4 WORDS PAST FET IN CASE *CIO* 
          SA7    A6+B1        STILL THINKS THIS FILE IS BEING USED
          SA7    A7+B1         WITH A 5 WORD FET
          SA7    A7+B1
          SA7    A7+B1
          SX7    READSKP
          SA1    L
          SX6    B1+B1
          MX4    42 
          IX4    X4+X6
          BX6    X1*X4
          IX6    X6+X7
          SA6    A1          SET UP FET 
          SYSTEM CIO,R,L     ISSUE REQUEST
          SA2    L+2         PRESET 1ST 10B WORDS BEYOND THE END OF 
          R=     X3,X2+10B    *PTGM* TO COMPENSATE FOR THE 1ST FEW WORDS
          SA4    PA           PAST THE END OF THE LOAD NOT BEING PRESET 
                              DUE TO THE 8-WORD MOVE LOOP USED
          SB4    X2          SAVE LWA+1 LOADED
          SB6    B7          SAVE JUMP ADDRESS
          RJ     PSM
          SB7    B6 
  
**        5)  CALL *RLI*, *RSF*, AND *SPYOFF*.
* 
  
          RJ     RLI=        RELEASE LIBRARY INTERLOCK
          RJ     RSF         RETURN SYSTEM FILES
          RJ     SPYOFF 
  
**        6)  FINALLY, COMPLETE SETUP AND CALL THE MOVEDOWN ROUTINE.
* 
  
          SA1    PTGM        START OF PSEUDO-TPGM 
          SX2    B4          LAST WORD LOADED + 1 
          SB2    B1+B1       B2 = 2 
          IX3    X2-X1       NUMBER OF WORDS LOADED 
          SB3    X1          B3 = MOVE DIFFERENTIAL 
          SX3    X3+7 
          SA1    X1          A1 = ADDRESS OF FIRST WORD, X1 = FIRST WD. 
          AX3    3
          SA2    A1+B1       A2 = ADDRESS OF 2ND WORD, X2 = 2ND WD. 
          SB4    X3          B4 = NO. OF WORDS TO MOVE/8
  
          JP     B7          ENTER MOVE LOOP
  
* 
 PTGM     VFD    60/LOADAX   POINTS TO START OF PSEUDO-TPGM 
* 
  
 IC       ENDIF 
  
          RELOC  OFF
 MANTAB   TITLE  MANAGE TABLE DEFINITIONS.
**        ++++++++++++++++++
*         + MANAGE TABLES. +
*         ++++++++++++++++++
* 
* 
*              ALL VARIABLE-LENGTH INFORMATION PROCESSED BY THE LOADER
*         IS STORED IN MANAGE TABLES.  EACH TABLE IS CONTROLLED BY A
*         TWO-WORD POINTER AREA.  THIS POINTER AREA IS GENERATED BY THE 
*         *TABLE* MACRO AND IS OF THE FOLLOWING FORMAT -
* 
*                VFD    60/FWA
*                VFD    60/L
* 
*                WHERE  FWA = FWA OF TABLE. 
*                       L   = LENGTH OF TABLE.
* 
* 
*              THE TABLES ARE AS FOLLOWS:                                      .
          SPACE  4,2
**        TPGM - PROGRAM. 
* 
*         AREA USED TO FORM CORE IMAGE.  IT IS MOVED TO THE BEGINNING OF
*         THE LOADABLE AREA JUST PRIOR TO EXECUTION.
*         THIS TABLE SHOULD BE THE FIRST IN LINE.  IN THE EVENT *LOADA* 
*         IS USED, EVERYTHING BEYOND *TPGM* WILL BE OVERWRITTEN.
          SPACE  4,8
**        TERR1 - SEGMENT LOAD ERROR INDEX TABLE. 
* 
*         DURING PASS 1 OF A SEGMENT LOAD THE *PI* FIELD IN TABLE *TERR*
*         IS AN INDEX INTO *TSEG* NOT *TBLK*.  AT THE END OF PASS 1 
*         WE WANT TO CHANGE THE PROGRAM INDEX TO REFERENCE *TBLK*.
*         THIS TABLE PROVIDES THE INDEX OF ALL ERROR ENTRY HEADER WORDS.
* 
*         ENTRY = 1 WORD. 
* 
*         VFD    60/INDEX OF HEADER WORD IN *TERR*. 
          SPACE  4,2
**        TSCR1 - SCRATCH TABLE.
* 
*         THIS IS ONE OF TWO SUCH TABLES.  ROUTINES USING ANY OF THE
*         SCRATCH TABLES ARE RESPONSIBLE FOR EMPTYING THEM WHEN 
*         COMPLETED WITH THEM.
          SPACE  4,2
**        TLIB - LIBRARY NAMES OF LIBRARY SET.
* 
*         ENTRY = 1 WORD. 
* 
*         VFD    42/0LNAME,18/0 
* 
*         NAME = LIBRARY NAME 
          SPACE  4,2
**        TREQ - LOADER REQUESTS. 
* 
*         INTERNAL-FORM LOADER REQUESTS RESULTING FROM THE LOADER 
*         CONTROL-CARD SEQUENCE (*LOADER*) OR FROM THE USER-CALL
*         PARAMETER AREA (*LOADU*). 
          SPACE  4,2
**        TREQ2 - ADDITIONAL LOADER REQUESTS. 
* 
*         LOADER REQUESTS ENCOUNTERED AS OBJECT DIRECTIVES, ALSO STORED 
*         IN THE INTERNAL FORM. 
          SPACE  4,2
**        TBLK - BLOCK DEFINITIONS. 
* 
*         DEFINITIONS OF BLOCKS ARE GENERATED FROM *PIDL* TABLES FROM 
*         LOAD FILES. 
* 
*         ENTRY = 2 WORDS.
* 
*         VFD    42/NAME,15/TPRX,1/0,1/E,1/T
*         VFD    1/R,11/FI,24/L,24/PA 
* 
*         NAME = PROGRAM/COMMON BLOCK NAME. 
*         TPRX = INDEX TO CORRESPONDING *TPRX* ENTRY (PROGRAM BLOCKS).
*                FOR A SEGMENT ENTRY THIS CONATINS THE SEGMENT INDEX
*                OF THIS SEGMENT.  FOR COMMON BLOCK ENTRIES DURING
*                A SEGMENT LOAD THIS FIELD HAS THE FORMAT 
*                   VFD  12/OWN,1/V,1/Q,1/G 
*                *V*, *Q* AND *G* ARE THE SAME AS IN *TSEG*.
*                *OWN* IS THE ORDINAL+1 INTO *TCEL* OF SEGMENT OWNING 
*                THIS GLOBAL OR EQUAL BLOCK.  IF THIS SEGMENT OWNS THE
*                BLOCK THEN THIS FIELD IS ZERO. 
*         E    = 0 IF CM BLOCK. 
*                1 IF ECS BLOCK.
*         T    = 0 IF PROGRAM BLOCK.
*                1 IF COMMON BLOCK. 
*         R    = 1 IF BLOCK NOT REFERENCED. 
*         FI   = FILE INDEX IN *TLFN* FOR PROGRAM BLOCK.
*                FOR A SEGMENT LOAD THIS CONTAINS THE NUMBER OF TIMES 
*                THIS BLOCK WAS DEFINED IN A *PIDL* TABLE.  THIS IS 
*                USED FOR CONDITIONAL TABLE PROCESSING. 
*         L    = BLOCK LENGTH.
*         PA   = PROGRAM ADDRESS.  DURING A SEGMENT LOAD THIS CONATINS
*                THE DISK ADDRESS OF WHERE THE PROGRAM CAN BE FOUND ON
*                FILE *ZZZZZ31*.  ONCE THE PROGRAM HAS BEEN READ DURING 
*                PASS 2 THE PROGRAM ADDRESS IS INSERTED INTO THIS FIELD.
* 
*         ENTRY 0 = CM BLANK COMMON.
*               1 = ECS BLANK COMMON. 
*               2 = SYSTEM ABSOLUTE BLOCK  (RA THRU RA+77B).
          SPACE  4,8
**        TLSB - LOCAL SAVE BLOCKS. 
* 
*         FOR EACH USER SAVED BLOCK OF LOCAL VARIABLES OR SAVED COMMON
*         BLOCK THERE WILL BE AN ENTRY IN THIS TABLE WHICH GIVES THE
*         OWNER PROGRAM NAME. ENTRIES ARE GENERATED FROM *PIDL* TABLES
*         TO BE USED AS KEYS FOR CORRESPONDING ENTRIES IN *TBLK* AND/OR 
*         *TSEG*. 
* 
*         ENTRY = 2 WORDS.
* 
*         VFD    42/:ANNNNN,18/0
*         VFD    42/PROGBLK,18/0
* 
*         :ANNNNN = A GENERATED UNIQUE NAME.
*         PROGBLK = OWNER PROGRAM BLOCK NAME. 
* 
          SPACE  4,8
**        TCEL - SEGMENT GENERATION PROGRAM DIRECTORY.
* 
*         THIS TABLE CONTAINS ALL THE INFORMATION NEEDED BY *SEGRES*
*         TO EXECUTE THIS FAMILY OF SEGMENTS.  THIS TABLE HAS THE SAME
*         MEANING AND FORMAT AS THE *CELTAB* TABLE IN *SEGRES*. 
* 
*         ENTRY  = 2 WORDS. 
* 
*         VFD    12/DLLGTH,18/DISKAD,12/FATHER,1/I,17/LDFWA 
*         VFD    1/B,1/L,1/C,1/N,2/0,18/SAVEDA,18/SAVELG,18/LOADLG
* 
*         DLLGTH = LENGTH OF DELINK TABLE FOR THIS SEGMENT. 
*         DISKAD = DISK ADDRESS OF SEGMENT ON THE ABS FILE. 
*         FATHER = ORDINAL OF FATHER FOR THIS SEGMENT.  0 FOR THE ROOT
*                SEGMENT OR THE FIRST PATRIARCH ON A LEVEL.  7777B
*                FOR THE PATRIARCHS OTHER THAN THE FIRST. 
*                THE ELDEST SON IS CONSIDERED AS THE FIRST PATRIARCH
*                ON A LEVEL AND ALL OTHER SONS OF THE ROOT SEGMENT
*                ARE PATRIARCHS BUT NOT THE FIRST ON A LEVEL. 
*         I      = 1 IF THE SEGMENT IS CURRENTLY LOADED (SEE *SEGRES*). 
*         LDFWA  = FWA OF LOAD FOR THIS SEGMENT.
*         B      = 1 IF THIS LOAD USES BLANK COMMON (ROOT ONLY).
*         L      = 1 IF THIS IS A MULTI-LEVEL TREE STRUCTURE. THIS WILL 
*                BE SET IN THE FIRST PATRIARCH OF EACH LEVEL. 
*         C      = 1 IF THIS IS A 54 TABLE LOAD (ROOT ONLY).
*         N      = 1 IF THE GLOBAL BLOCKS ARE AT THE BEGINNING OF 
*                EACH SEGMENT (ROOT ONLY).
*         SAVEDA = DISK ADDRESS OF SAVE GLOBAL COMMON BLOCKS.  FOR
*                THE ROOT SEGMENT THIS IS THE LWA+1 OF THE LOAD.
*         SAVELG = LENGTH OF SAVE GLOBAL COMMON BLOCKS.                  LDR0167
*         LOADLG = LENGTH OF THE SEGMENT INCLUDING DELINK TABLE,
*                COMMON BLOCKS AND PROGRAM. 
          SPACE  4,8
**        TSEG - SEGMENT GENERATION CM BLOCK DESCRIPTION TABLE. 
* 
*         THIS TABLE IS MADE UP OF TWO PARTS.  THE FIRST PART CONTAINS
*         THE SEGMENTS IN THE SAME ORDER AS THEY WILL APPEAR IN 
*         *TCEL*.  THE SECOND PART CONSISTS OF THE PROGRAM AND CM BLOCK 
*         ENTRIES.
* 
*         ENTRY  = 2 WORDS. 
* 
*         VFD    42/NAME,15/TSEG,1/S,1/E,1/T
*         VFD    1/R,11/FI,1/V,1/Q,1/G,21/L,1/P,23/PRU
* 
*         NAME   = BLOCK, SEGMENT, OR PROGRAM NAME. 
*         TSEG   = INDEX INTO *TSEG* OF OWNING SEGMENT OR PROGRAM.
*                MOVABLE PROGRAMS CONTAIN 77777B.  FOR A SEGMENT ENTRY
*                THIS HAS THE SAME MEANING AS *FATHER* IN *TCEL*. 
*         S      = 1 IF THIS IS A SEGMENT ENTRY.
*         E      = 1 IF THIS IS AN ECS BLOCK. 
*         T      = 1 IF THIS IS A COMMON BLOCK. 
*         R      = 1 IF THIS BLOCK IS NOT REFERENCED. 
*         FI     = INDEX INTO *TLFN* FOR SOURCE OF PROGRAM. 
*                LEVEL NUMBER FOR SEGMENT ENTRY.
*         V      = 1 IF THIS IS A SAVE GLOBAL BLOCK.
*         Q      = 1 IF THIS IS AN EQUAL BLOCK. 
*         G      = 1 IF THIS A GLOBAL BLOCK.
*         L      = LENGTH OF BLOCK, PROGRAM OR SEGMENT. 
*         P      = 1 IF THIS BLOCK IS PRESET BY THE PROGRAM SPECIFIED 
*                IN *TSEG*. 
*         PRU    = DISK ADDRESS OF PROGRAM ON *ZZZZZ31*.  FOR A 
*                BLOCK THIS CONTAINS THE INDEX+1 OF THE GLOBAL BLOCK
*                DEFINITION FOR GLOBAL AND EQUAL BLOCKS.
          SPACE  4,8
**        TCII - CORE IMAGE INDEX TABLE FOR INTERACTIVE DEBUG OR
*                FAST OVERLAY LOADING.
* 
*         FOR BASIC AND OVERLAY LOADS THIS MANAGED TABLE WILL CONTAIN 
*         AN ENTRY FOR EACH CORE IMAGE GENERATED (OVCAPS INCLUDED). 
* 
*         ENTRY = 3 WORDS.
* 
*         VFD    42/NAME,18/FWA 
*         VFD    6/L1,6/L2,30/RELPRU,18/LWA 
*         VFD    30/EP,30/B 
* 
*         NAME   = OVERLAY OR OVCAP NAME.  ZERO IF RELOCATABLE LOAD.
*         FWA    = FWA IF OVERLAY, ZERO IF OVCAP. 
*         LWA    = LWA+1 IF OVERLAY, LENGTH IF OVCAP. 
*         L1     = PRIMARY OVERLAY NUMBER.  ZERO IF OVCAP.
*         L2     = SECONDARY OVERLAY NUMBER.  ZERO IF OVCAP.
*         RELPRU = PRU NUMBER RELATIVE TO PRU NUMBER OF (0,0).
*         EP     = LOGICAL DISK ADDRESS OF ENTRY POINT TABLE.  ZERO 
*                  IF OVCAP.
*         B      = LOGICAL DISK ADDRESS OF BLOCK TABLE.  ZERO IF OVCAP. 
          SPACE  4,8
**        TFID - FORTRAN INTERACTIVE DEBUG EXTENSION OF *TBLK*. 
* 
*         UNDER FORTRAN INTERACTIVE DEBUG EACH ENTRY IN *TBLK* MUST 
*         HAVE MORE INFORMATION THAN THERE IS ROOM IN A *TBLK* ENTRY. 
*         ALL *TBLK* ENTRIES WHICH NEED ROOM FOR DEBUGGING INFO 
*         WILL HAVE A CORRESPONDING ENTRY IN THIS TABLE.
* 
*         FIRST WORD OF TABLE.
* 
*         VFD    42/0,18/K
* 
*         K      = THE NUMBER OF *TBLK* ENTRIES NOT HAVING *TFID* 
*                  ENTRIES.  I.E., *K* PROGRAMS/BLOCKS WERE PROCESSED 
*                  BEFORE THE FIRST ONE REQUIRING A *TFID* ENTRY. 
*                  ONCE AN ENTRY IS CREATED, THEN EVERY SUBSEQUENT
*                  *TBLK* ENTRY MUST HAVE A *TFID* ENTRY.  IF *TFID*
*                  IS PRESENT, *K* IS ALWAYS .GE. 3.  THE FIRST 3-WORD
*                  ENTRY IMMEDIATELY FOLLOWS THIS WORD. 
* 
*         ENTRY  = 3 WORDS. 
* 
*         VFD    12/SL,36/0,12/PWC
*         VFD    30/SYM,30/P
*         VFD    30/0,30/LIN
* 
*         SL     = SOURCE LANGUAGE ORDINAL.  ZERO FOR COMMON BLOCKS.
*         PWC    = WORD COUNT FROM *PIDL* TABLE.  ZERO FOR BLOCKS.
*         SYM    = LOGICAL DISK ADDRESS ON *ZZZZZDT* OF FIRST *SYMBOL*
*                TABLE FOR THIS PROGRAM.  ZERO IF NONE AND FOR COMMON 
*                BLOCKS.
*         P      = LOGICAL DISK ADDRESS ON *ZZZZZDT* OF *PIDL* TABLE FOR
*                THIS PROGRAM.  ZERO FOR COMMON BLOCKS AND CAPSULES.
*         LIN    = LOGICAL DISK ADDRESS ON *ZZZZZDT* OF 
*                *LINE NUMBER* TABLE FOR THIS PROGRAM.
          SPACE  4,2
**        TLNK - LINKAGES.
* 
*         TABLE OF ENTRY/EXTERNAL NAMES AND THEIR DEFINITIONS,
*         GENERATED FROM *TEPT*, *TLBC*, AND *TXLBC* DURING LINKAGE 
*         BY *CPR*. THIS TABLE IS MAINTAINED VIA THE ROUTINE *ELT*, 
*         AND IS KEPT IN ASCENDING ORDER SO AS TO ALLOW A BINARY SEARCH 
*         AND ALSO ALLOW A FAST SEARCH OF THE ENTRY POINT NAME TABLE
*         WHILE SEARCHING LIBRARY DIRECTORIES.
* 
*         ENTRY = 2 WORDS.
* 
*         VFD    18/0,42/NAME 
*         VFD    1/R,1/U,1/UF,1/BC,1/W,1/0,18/PI,12/SI,24/A 
* 
*         NAME = EXTERNAL/ENTRY NAME. 
*         R    = 0 IFF ENTRY NOT REFERENCED.
*                1 IFF ENTRY REFERENCED.
*         U    = 0 IF EXTERNAL TO BE CONSIDERED SATISFIED.
*                1 IF EXTERNAL NOT TO BE CONSIDERED SATISFIED.
*         UF   = 0 IF ADDRESS IS TO BE USED FOR DEFINITION. 
*                1 IF TO BE DEFINED AS UNSATISFIED. 
*         BC   = 0 IF ENTRY IS NOT IN BLANK COMMON
*                1 IF ENTRY IS DEFINED IN BLANK COMMON
*                1 IF ENTRY IS DEFINED WITH ABS RELOCATION (PASS 1 OF 
*                  SEGMENT LOAD). 
*         W    = 0 IFF EXTERNAL IS *STRONG*.
*                1 IFF EXTERNAL IS *WEAK*.
*         PI   = PROGRAM INDEX IN *TBLK*. 
*         SI   = INDEX INTO *TCEL* /2 OF SEGMENT DEFINING ENTRY POINT.
*                THIS FIELD IS ZERO FOR NON-SEGMENTED LOADS.
*         A    = ADDRESS. 
          SPACE  4,2
**        TLNK2 - ENTRY POINT LIST FOR LIBRARY SEARCHING. 
* 
*         THIS TABLE IS OF THE SAME FORMAT AS *TLNK*, BUT IS USED ONLY
*         FOR THE CALLING SEQUENCE TO THE DIRECTORY SEARCH ROUTINE, 
*         *SLD*, DURING THE PROCESSING OF *LIBLOAD* REQUESTS. 
          SPACE  4,2
**        TEPT - ENTRY POINT NAMES. 
* 
*         CONSISTS OF RELOCATED *ENTR* TABLES FROM LOAD FILES.  DURING
*         COMPLETION OF A LOAD FILE, IT IS EMPTIED, AND ITS CONTENTS
*         ARE MOVED TO *TLNK*.
          SPACE  4
**        TEPT1 - ENTRY POINT NAMES.
* 
*         SAME AS TEPT EXCEPT CONSISTS ONLY OF ENTRY POINTS IN
*         BLANK COMMON.  AFTER BLANK COMMON HAS BEEN ESTABLISHED, 
*         ITS CONTENTS ARE MOVED TO TEPT FOR LINKING. 
* 
*         SEGMENT GENERATION LOADS USE THIS TABLE DURING PASS 1 TO HOLD 
*         ALL EXTERNAL REFERENCES FROM PROGRAMS READ.  THE FORMAT IS
*         SIMILAR TO *TEPT* EXCEPT THE *SI* FIELD CONTAINS A COUNT OF 
*         THE NUMBER OF REFERENCES TO THIS ENTRY ENTRY POINT FROM THE 
*         PROGRAM GIVEN BY *PI*.
          SPACE  4,2
**        TSCR2 - SCRATCH TABLE.
          SPACE  4,2
**        TRLB - RELOCATION BASES.
* 
*         RELOCATION CONTROL WORDS WHICH ARE INDEXED BY THE RELOCATION
*         CONTROL BYTES IN ALL TABLES FROM LOAD FILES.  GENERATED 
*         FROM *PIDL* TABLES FROM LOAD FILES. 
* 
*         ENTRY = 1 WORD. 
* 
*         VFD    1/T,23/DI,12/0,24/LA 
* 
*         T  = 0 IF CM BLOCK. 
*              1 IF ECS BLOCK.
*         DI = INDEX OF BLOCK DEFINITION IN *TBLK*. 
*                DEFINITION IN *TSEG* FOR FIRST PASS OF SEGMENT LOAD. 
*         LA = LOAD ADDRESS.  (SET -0 IF BLOCK BELOW FWA LOADABLE AREA) 
* 
*         ENTRY 0 = ABSOLUTE BLOCK. 
*         ENTRY 1 = POSITIVE PROGRAM BLOCK. 
*         ENTRY 2 = NEGATIVE PROGRAM BLOCK. 
*         ENTRY 3 - N = COMMON BLOCKS.
          SPACE  4,2
**        TFBC - FILL BYTE CHAIN. 
* 
*         CONSISTS OF MODIFIED *FILL* TABLES:                                  .
* 
*         HEADER BYTES:                                                        .
* 
*                VFD    1/0,20/0,9/DI 
* 
*                DI = *TBLK* INDEX OF THE RELOCATION QUANTITY.
* 
*         TRAILER BYTES 
* 
*                VFD    1/1,2/P,1/F,1/A,7/0,18/ADR
* 
*                P   = ADDRESS FIELD DESIGNATOR 
*                   00 - LOWER ADDRESS. 
*                   01 - MIDDLE ADDRESS.
*                   10 - UPPER ADDRESS. 
* 
*                F   = 1 IF *ADR* REPRESENTS AN ECS ADDRESS.
*                A   = 1 IN USER CALLS IF CM ADR NOT RELATIVE TO *TPGM*.
*                ADR = RELOCATED ADDRESS OF TEXT WORD.
          SPACE  4,2
**        TXFBC - EXTENDED FILL BYTE CHAIN. 
* 
*         CONSISTS OF MODIFIED *XFILL* TABLES 
* 
*         VFD    1/F,1/N,1/A,3/0,24/ADR,6/POS,6/SIZE,18/DI
* 
*         F    = 1 IF *ADR* REPRESENTS AN ECS ADDRESS.
*         N    = 1 IF NEGATIVE RELOCATION IS TO BE USED.
*         A    = 1 IN USER CALLS IF CM ADR NOT RELATIVE TO *TPGM*.
*         ADR  = RELOCATED ADDRESS OF TEXT WORD.
*         POS  = BIT POSITION OF LOW-ORDER BIT OF THE ADDRESS FIELD IN
*                THE TEXT WORD. 
*         SIZE = ADDRESS FIELD WIDTH. 
*         DI   = *TBLK* INDEX OF THE RELOCATION QUANTITY. 
          SPACE  4,2
**        TLBC - LINK BYTE CHAIN. 
* 
*         CONSISTS OF MODIFIED *LINK* TABLES:                                  .
* 
*         HEADER BYTE - 
* 
*                VFD    42/0LNAME,18/F
* 
*                NAME = EXTERNAL NAME.
*                F    = 0 IFF *STRONG* EXTERNAL.
*                       1 IFF *WEAK* EXTERNAL.
* 
*         TRAILER BYTES 
* 
*                VFD    1/1,2/P,1/F,1/A,7/0,18/ADR
* 
*                P   = ADDRESS FIELD DESIGNATOR 
*                   00 - LOWER ADDRESS. 
*                   01 - MIDDLE ADDRESS.
*                   10 - UPPER ADDRESS. 
*                F   = 1 IF *ADR* REPRESENTS AN ECS ADDRESS.
*                A   = 1 IN USER CALLS IF CM ADR NOT RELATIVE TO *TPGM*.
*                ADR = RELOCATED ADDRESS OF TEXT WORD.
* 
*         TRAILER BYTES MAY BE ALL ZERO, AND, IF SO, ARE IGNORED. 
*         WHILE READING *LINK* TABLES, ZERO TRAILER BYTES ARE INSERTED
*         AS NECESSARY TO INSURE THAT ALL NAMES IN *TLBC* BEGIN IN THE
*         UPPER HALF OF A WORD. 
          SPACE  4,2
**        TXLBC - EXTENDED LINK BYTE CHAIN. 
* 
*         CONSISTS OF MODIFIED *XLINK* TABLES 
* 
*         HEADER WORD - 
* 
*                VFD    42/0LNAME,18/F
* 
*                NAME = EXTERNAL NAME.
*                F    = 0 IFF *STRONG* EXTERNAL.
*                       1 IFF *WEAK* EXTERNAL.
* 
*         TRAILER BYTES 
* 
*                VFD    1/F,1/0,1/A,3/0,24/ADR,6/POS,6/SIZE,18/0
* 
*                F    = 1 IF *ADR* REPRESENTS AN ECS ADDRESS. 
*                A    = 1 IN USER CALLS IF CM ADR NOT RELATIVE TO *TPGM*
*                ADR  = RELOCATED ADDRESS OF TEXT WORD. 
*                POS  = BIT POSITION OF LOW-ORDER BIT OF THE ADDRESS
*                       FIELD IN THE TEXT WORD. 
*                SIZE = ADDRESS FIELD WIDTH.
* 
*         A ZERO WORD SIGNALS THE END OF THE TRAILER BYTES AFTER EACH 
*         HEADER BYTE.
          SPACE  4,2
**        TLBC2 - LINK BYTE CHAIN FOR MAP.
* 
*         FORMED FROM ENTRIES IN *TLBC* AND *TXLBC* ONLY IF A CROSS-
*         REFERENCE LIST IN THE MAP IS REQUESTED.  FORMAT IS SIMILAR
*         TO THAT OF *TLBC*, EXCEPT THAT ONLY THE *LI*, *F*, AND *ADR*
*         FIELDS ARE SIGNIFICANT.  AS IN *TLBC*, ZERO TRAILER BYTES ARE 
*         IGNORED, BUT, IN ADDITION, A ZERO TRAILER BYTE MUST APPEAR IN 
*         THE LOWER HALF OF THE LAST WORD BEFORE EACH NAME, SINCE, AS 
*         PER THE RULES FOR *TXLBC*, NAMES MAY HAVE THE UPPER-MOST
*         BIT SET.  JUST PRIOR TO CALLING THE MAP ROUTINE, ALL NAMES ARE
*         REPLACED WITH THE INDEX OF THE DEFINITION IN *TLNK*.
*         DURING A SEGMENT LOAD THE LOWER 18 BITS OF EACH NAME WORD 
*         CONTAINS THE INDEX OF THE SEGMENT ENTRY IN *TBLK* CONTAINING
*         THE PROGRAM MAKING THIS REFERENCE.  WHEN THE NAME IS
*         CONVERTED TO AN INDEX BEFORE CALLING *MAP* THE SEGMENT
*         INDEX IS MOVED TO BITS 18-35. 
          SPACE  4,2
**        TREF - REFERENCE CHAIN. 
* 
*         USED ONLY DURING MAP GENERATION.
* 
*         ENTRY = 1 WORD. 
* 
*         VFD    24/ADR,18/L,18/C 
* 
*         ADR = ADDRESS.
*         L = *TBLK* INDEX. 
*         C = CHAIN TO NEXT ENTRY.
          SPACE  4,2
**        TLIB2 - LIBRARY NAMES.
* 
*         IDENTICAL TO *TLIB*.  USED ONLY BY THE ROUTINE *SAT*. 
          SPACE  4,2
**        TREP - REPLICATIONS.
* 
*         ENTRY = 2 WORDS IN A FORM DERIVED FROM BOTH *REPL* AND *XREPL*
*                 TABLES.  ADDRESSES ARE RELOCATED.  THEY CONSIST ONLY
*                 OF DEFERRED REPLICATIONS, SINCE INSTANT REPLICATIONS
*                 ARE PROCESSED WHEN ENCOUNTERED AND NEED NOT BE SAVED. 
*                 ALL FIELDS WHICH WERE ZERO IN THE BINARY TABLES HAVE
*                 BEEN SET TO THE DEFAULT VALUES. 
* 
*         VFD    18/0,18/K,1/TS,1/AS,22/S 
*         VFD    18/C,18/B,1/TD,1/AD,22/D 
* 
*         K  = DESTINATION ADDRESS INCREMENT. 
*         TS = CM/ECS INDICATOR FOR S  (=1 IF ECS). 
*         AS = 1 IN USER CALLS IF S IS NOT RELATIVE TO *TPGM*. (TS = 0) 
*         S  = RELOCATED SOURCE ADDRESS.
*         C  = REPLICATION COUNT. 
*         B  = BLOCK SIZE.
*         TD = CM/ECS INDICATOR FOR D  (=1 IF ECS). 
*         AD = 1 IN USER CALLS IF D IS NOT RELATIVE TO *TPGM*. (TD = 0) 
*         D  = RELOCATED DESTINATION ADDRESS. 
          SPACE  4,2
**        TLFN - LOAD FILE NAMES. 
* 
*         ENTRY = 1 WORD. 
* 
*         VFD    42/0LNAME,18/F 
* 
*         NAME = FILE NAME. 
*         F    = 0 IF NON-LIBRARY FILE. 
*                1 IF USER LIBRARY. 
*                2 IF SYSTEM LIBRARY. 
          SPACE  4,2
          SPACE  4
 IC       IFCARD
  
**        TCPENT - CONTAINS *EPT*/*NOEPT* REQUESTS. 
* 
*         ENTRY = 1 WORD. 
* 
*         VFD    42/0LNAME,18/F 
* 
*         NAME = ENTRY POINT NAME.
*         F    = 0 IFF *EPT* REQUEST. 
*                1 IFF *NOEPT* REQUEST. 
          SPACE  4
**        TCPFMT - CAPSULE GENERATION FORMAT TABLE. 
* 
*         ENTRY = 1 WORD. 
* 
*         VFD    42/0LNAME,18/F 
* 
*         NAME = GROUP/CAPSULE NAME.
*         F    = 1 IFF GROUP NAME.
*                0 IFF CAPSULE NAME.
          SPACE  4
**        TCPREL - CAPSULE GENERATION RELOCATION TABLE. 
* 
*         ENTRY - ONE 4-BIT RELOCATION PARCEL (SAME FORMAT AS 
*                 IN *TEXT* TABLE) FOR EACH WORD IN *TPGM*. 
*                 INDEX OF WORD INTO *TPGM* IS ALSO INDEX OF
*                 RELOCATION PARCEL IN *TCPREL*.
          SPACE  4
**        TCPENTR - TABLE OF CAPSULE ENTRY POINTS.
* 
*         ENTRY = 1 WORD. 
* 
*         VFD    42/0LNAME,18/ADDR. 
* 
*         NAME = ENTRY POINT NAME.
*         ADDR = ENTRY POINT ADDRESS. 
* 
*         FORMED FROM TABLES *TLNK* AND *TCPENT* IN ROUTINE 
*         */LOADG/CGEPL* AS DESCRIBED THEREIN.
          SPACE  4
**        TCPEXTR - TABLE OF CAPSULE EXTERNAL REFERENCES. 
* 
*         ENTRY = 1 WORD. 
* 
*         VFD    42/0LNAME,1/W,17/ADDR. 
* 
*         NAME = EXTERNAL NAME. 
*         W    = 1 IFF *WEAK* EXTERNAL. 
*                0 IFF *STRONG* EXTERNAL. 
*         ADDR = ADDRESS OF REFERENCE CHAIN.
* 
*         FORMED FROM TABLES *TLNK* AND *TLBC2* IN ROUTINE
*         */LOADG/CGXRL* AS DESCRIBED THEREIN.
          SPACE  4
 IC       ENDIF 
 IC       IFCARD
  
**        TOVEPT - OVERLAY ENTRY POINT LIST.
* 
*         ENTRY = 1 WORD. 
* 
*         VFD    42/0LNAME,18/ADR 
* 
*         NAME = ENTRY POINT NAME.
*         ADR = ADDRESS.
  
 IC       ENDIF 
          SPACE  4,2
**        TUSEP - NAMES SPECIFIED IN *USEP* REQUESTS. 
* 
*         ENTRY = 1 WORD = PROGRAM NAME LEFT JUSTIFIED WITH ZERO FILL.
          SPACE  4,2
**        TSUBST - SUBSTITUTION TABLE.
* 
*         ENTRY = 2 WORDS.
* 
*         VFD    42/0LNAME1,18/0
*         VFD    42/0LNAME2,18/0
* 
*         NAME2 IS TO BE SUBSTITUTED FOR NAME1. 
          SPACE  4,2
**        TOMIT - OMIT TABLE
* 
*         ENTRY = 1 WORD = 42/0LNAME,18/0.
          SPACE  4,2
**        TPADR - PROGRAM ADDRESSES AS RETURNED BY *SLD=*.
* 
*         ENTRY = 1 WORD = PROGRAM ADDRESS (RMS, ECS, OR CM)
          SPACE  4,2
**        TPRX - INFORMATION FROM *PRFX* TABLES.
* 
*              ENTRIES ARE PLACED IN THIS TABLE UPON ENCOUNTERING 
*         *PRFX* TABLES WHICH CONTAIN NON-ZERO INFORMATION BEGINNING
*         IN WORD 2.  THIS INFORMATION IS NOT SAVED UNLESS A MAP
*         OF OPTION *B* OR GREATER IS SELECTED AT THE TIME THE
*         TABLE IS ENCOUNTERED. 
* 
*         ENTRY  0 - EXISTS FOR ANY LOAD REGARDLESS OF THE MAP OPTION.
* 
*                WORD 0 CONTAINS OFFSET TO FWA OF MOST RECENT ENTRY.
* 
*                NEXT 15B WORDS REPRESENT THE MOST RECENT VALUE 
*                       ENCOUNTERED FOR EACH OF THE WORDS 2-16B OF THE
*                       *PRFX* TABLE. 
* 
*         ENTRIES 1-N (N PROGRAMS ENCOUNTERED) ARE OF VARIABLE
*                       LENGTH L, WHERE 1 @ L @ 16B.
* 
*                WORD 0 CONTAINS A BIT STRING WHICH INDICATES THE 
*                       PRESENCE OF EACH WORD (2-16B) WHICH IS DIFFERENT
*                       THAN THE CORRESPONDING WORD OF THE LAST TABLE.
* 
*                WORDS 1-K (K = NO. OF BITS SET IN WORD 0.  0 @ K @ 15B)
*                       CONSIST OF THE CONTENTS OF THE WORDS OF THE 
*                       *PRFX* TABLE WHICH ARE DIFFERENT THAN THE 
*                       CORRESPONDING WORDS OF THE LAST TABLE.  FOR 
*                       EXAMPLE, IF WORDS 2 AND 4 ARE THE ONLY WORDS
*                       WHICH ARE NOT IDENTICAL TO THE LAST TABLE, THEN 
*                       WORD 0 WOULD HAVE BITS 59 AND 57 SET, AND WORDS 
*                       1 AND 2 OF THIS ENTRY WOULD HAVE THE NEW
*                       VALUES FOR WORDS 2 AND 4, RESPECTIVELY, OF
*                       THIS *PRFX* TABLE.
* 
*              NOTE THAT THIS TABLE IS DESIGNED IN A WAY TO KEEP IT AS
*         SMALL AS POSSIBLE, SINCE ADDING 15B WORDS FOR EACH
*         PROGRAM LOADED COULD MAKE IT ENORMOUS.  ITS FORMAT IS SUCH
*         THAT IT CANNOT BE RE-ARRANGED OR HAVE THE LAST ENTRY DELETED, 
*         SINCE THE INFORMATION IN THE FIRST ENTRY COULD THEN BE
*         INCORRECT.  HOWEVER, THIS IS OKAY, SINCE THERE IS NO HARM 
*         FOR IT TO HAVE THE *PRFX* CONTENTS OF SOME PROGRAM WHICH ENDS 
*         UP NOT GETTING LOADED (AS IN THE CASE OF DUPLICATE PROGRAM
*         FROM A LOAD FILE), SINCE THE *TBLK* ENTRIES CONTAIN A POINTER 
*         TO THE CORRESPONDING *TPRX* ENTRY.  THIS ALLOWS FOR THE NEEDED
*         FLEXIBILITY OF *TBLK*, WHICH INVOLVES THE SORTING OF IT AT
*         MAP TIME AND THE POSSIBILITY OF DISCARDING SOME OF ITS
*         ENTRIES AT THE START OF A USER-CALL LOAD.  *TPRX* IS ONE OF 
*         THE MANAGE TABLES WHICH IS SAVED ON FILE *ZZZZZ17* FOR
*         USER-CALL LOADS.
          SPACE  4,2
 K        IFNOS 
**        TSFR - TABLE OF SYSTEM FILES TO BE RETURNED.
* 
*         ENTRY = 1 WORD = 42/0LNAME,18/0 
* 
*         NEEDED UNDER KRONOS/NOS ONLY AS SCOPE SYSTEM FILES ARE
*         EXACTLY ZZZZZ03, ZZZZZ04, AND ZZZZZ06.
* 
          SPACE  4,2
 K        ENDIF 
**        TERR - ACCUMULATED ERRORS.
* 
*         ENTRY = 1 WORD. 
* 
*         VFD    12/FI,18/PI,12/NUM,18/EP 
* 
*         FI   = FILE INDEX IN *TLFN*.
*         PI   = PROGRAM INDEX IN *TBLK*. 
*         NUM  = ERROR NUMBER.
*         EP   = ADDRESS OF ERROR PROCESSOR ROUTINE.
          SPACE  4,8
**        TERR1 - SEGMENT GENERATION ERROR INDEX TABLE. 
* 
*         ENTRY  1 WORD.
* 
*         VFD    60/INDEX OF ERROR HEADER WORD IN *TERR*. 
* 
*         USED TO RELOCATE THE *PI* FIELD IN *TERR* ENTRIES WHEN *TBLK* 
*         IS CREATED FROM *TSEG*. 
          SPACE  4
**        TCOM - BLOCK NAMES FROM LDSET(COMMON).
* 
*             THIS TABLE CONTAINS LABELED COMMON BLOCK NAMES FROM THE 
*         LDSET(COMMON) CONTROL CARD OR FROM THE LDSET(COMMON) 7000 
*         BINARY BLOCK OR FROM THE COMMON SEGMENT LOAD DIRECTIVE. 
*         *G* BIT IS SET BY *GLOBAL* PROCESSOR TO ALLOW *GLOBAL*
*         DECLARATIONS TO OVERIDE *COMMON*. 
* 
*         ENTRY = 1 WORD. 
* 
*         VFD    42/0LNAME,1/G,17/SEG 
* 
*         NAME = LABELED COMMON BLOCK NAME. 
*         G    = 1 IF GLOBAL, 0 IF COMMON.
*         SEG  = INDEX OF OWNING SEGMENT. 
          SPACE  4
**        TPAT - PATCH TABLE. 
* 
*         ENTRY = 2 WORDS.
* 
*         VFD    60/DATA
*         VFD    42/OVLNAME,18/ADDR 
* 
*         USED TO PATCH OVERLAYS FOR DEBUGGING PURPOSES.  WHEN OVERLAY
*         *OVLNAME* IS LOADED, THE WORD AT *ADDR* IS PLUGGED WITH 
*         *DATA*. 
          SPACE  4,2
 IC       IFCARD
**        TCAPS - *CAPSULE* BINARY TABLE. 
* 
*         CONSISTS OF THE *CAPSULE* TABLE FROM THE EXTERNAL NAME
*         LIST TO THE END OF THE TABLE.  THIS MANAGE TABLE IS 
*         USED ONLY FOR SEGMENT STATIC LOADING OF CAPSULES. 
          SPACE  4,8
 IC       ENDIF 
**        TEND - DUMMY TABLE. 
* 
*         THE FWA OF THIS TABLE REPRESENTS THE LWA+1 OF AVAILABLE 
*         TABLE SPACE.
          SPACE  4,8
 FTAB     BSS    0
 NTAB     SET    0
  
          LIST   -G 
 TPGM     TABLE 
          BASE   D
 K        IFNOS 
 TSFR     TABLE 
 K        ENDIF 
  
**        CODE USED BY *LOADA* MUST RESIDE PRIOR TO THIS POINT. 
* 
  
 LOADAX   BSS    0
* 
 TSCR1    TABLE 
 TSCR     EQU    TSCR1
 TLIB     TABLE 
 TREQ     TABLE 
 TREQ2    TABLE 
 TBLK     TABLE 
 TLSB     TABLE 
 IC       IFCARD
 TCEL     TABLE 
 TSEG     TABLE 
 TCII     TABLE 
 TFID     EQU    TSEG 
 IC       ENDIF 
 TLNK     TABLE 
 TLNK2    TABLE 
 TEPT     TABLE 
 TEPT1    TABLE 
 TSCR2    TABLE 
 TRLB     TABLE 
 TFBC     TABLE 
 TXFBC    TABLE 
 TLBC     TABLE 
 TXLBC    TABLE 
 TLBC2    TABLE 
 TREP     TABLE 
 TLFN     TABLE 
          IFCARD 1
 TOVEPT   EQU    TEPT 
 IC       IFCARD
 TCPENT   TABLE 
 TCPFMT   TABLE 
 TCPREL   TABLE 
 TCPENTR  EQU    TCEL 
 TCPEXTR  EQU    TSEG 
 IC       ENDIF 
 TUSEP    TABLE 
 TSUBST   TABLE 
 TOMIT    TABLE 
 TPADR    TABLE 
 TPRX     TABLE 
 TREF     TABLE 
 TLIB2    EQU    TREF 
 TERR     TABLE 
 IC       IFCARD
 TERR1    TABLE 
 TCOM     EQU    TFBC 
          IFTEST NE,IP.LDBG,0,1 
 TPAT     TABLE 
 TCAPS    EQU    TCPREL 
 IC ENDIF 
 TEND     TABLE 
          LIST   *
 STORAGE  TITLE  CONSTANTS, POINTERS, FLAGS, TEMPORARIES. 
**        ++++++++++++++++++++++++++
*         + FLAGS, CONSTANTS, ETC. +
*         ++++++++++++++++++++++++++
* 
* 
*              THE FOLLOWING AREA CONTAINS THE MAJORITY OF THE VARIOUS
*         CONSTANTS, POINTERS, FLAGS, AND TEMPORARIES USED THROUGHOUT 
*         LOADING 
  
****
  
 DB       IFTEST NE,IP.LDBG,0 
 MSGL1    BSSZ   3           MESSAGE LINE 1 
          BSSZ   1           SET TO BLANKS ON OVERLAY GENERATION LOAD 
 MSGL2    DATA   30H  GENERATING (**,**) OVERLAY
 MSGON    BSSZ   1           OVERLAY NAME FOR MESSAGE 
 CGMSG1   DATA   20H  GENERATING CAPSULE
 CGMSGCN  BSSZ   1           CAPSULE NAME FOR MESSAGE 
 DB       ENDIF 
  
 MU       CON    0           MEMORY USED
 LM       RVFD   60,MEML     LOW MEMORY ADDRESS 
 TN       CON    NTAB        NUMBER OF MANAGED TABLES 
 TO       RVFD   60,/TMGR/TOV      ADDRESS OF TABLE OVERFLOW PROCESSOR
          IFCARD 1
 MT       CON    IP.FLINC/10 MEMORY THRESHOLD BEFORE NEXT IP.FLINC
 MM       CON    1           MEMORY FLAG -
                                   +1 IF *LOADC* IS IN AND NEEDED 
                                   +0 IF *LOADC* IS IN BUT NOT NEEDED 
                                   -0 IF *LOADC* IS NOT IN
          IFNOS  1
 SLDACT   CON    0           1 IF *SLD* ACTIVE
 T1       CON    0           TEMPORARY STORAGE
 T2       CON    0
 T3       CON    0
 T4       CON    0
 T5       CON    0
 TM       CON    0           LOAD START TIME
 RTM      CON    0           REAL-TIME AT START OF LOAD 
 FLI      CON    0           CM FIELD LENGTH AT START OF LOAD 
 FL       CON    0           CM FIELD LENGTH DURING LOADING 
 ECSFL    CON    0           ECS FIELD LENGTH DURING LOADING
 CARDCT   CON    -1          (NUMBER OF CARDS PROCESSED) - 1
 IC       IFCARD
 CPYF     CON    0           NZ IF SPOOLING BINARY OUTPUT TO *ZZZZZ32*
 LOCFILE  CON    0           SET NONZERO IFF CC VERB IS LOCAL FILE
 RUNG     CON    0           LDV ZERO WORD CALL FLAG
                                  -1 IF RUN(G) TYPE CALL
                                   0 IF CALLED BY 1AJ OR NOT AT LDR=
                                   1 IF REQUEST TABLE CALL
          IFTEST  NE,IP.LDBG,0,1
          DATA   10HLOADER
 K        IFNOS 
 SLDRNAM  EQU    SLDRCLD     FILE/ENTRY NAME FOR SLDR= ENTRY
 EXPCCEX  CON    0           SET NON-ZERO IFF EXPLICIT *EXECUTE* CC 
 TCSBACK  VFD    24/0LTCSP,18/500B,18/COMLDCC 
 NAMCALL  CON    0           SET NONZERO IF ENTRY AT *LDR=* 
 XEQOF    CON    0           1 = EXECUTE ONLY FILE
 VHD      CON    0           NZ IF $ DELIMITERS IN LAST COMMAND VERB
 K        ENDIF 
 IC       ENDIF 
 IC       IFCARD
          IFSCOPE 1 
 AL       CON    0           ACCESS LEVEL FROM CONTROL POINT AREA 
 UP       CON    0           NZ IF *USEP* REQUEST HONORED 
 ABS      CON    0           NZ IF ABSOLUTE LOAD
 EF       CON    1S59        EXECUTION FL (BIT 59 SET = NO REDUCE)
 PFL      CON    0           PROGRAM FL  (BIT 11 = FLO BIT) 
 MFL      CON    0           MAXIMUM FL AVAILABLE TO JOB
 NFL      CON    0           NOMINAL FL / 100 
 IC       ENDIF 
 ECS      IFTEST NE,IP.MECS,0 
 ECSWCL   CON    0           NUMBER OF ECS LABELLED COMMON WORDS
 ECSPO    CON    0           FWA ECS LOADABLE AREA
 ECSPA    CON    0           CURRENT ECS PROGRAM ADDRESS
 ECSLWA   EQU    ECSFL       LWA+1 OF ECS LOADABLE AREA 
 ECS      ENDIF 
 IC       IFCARD
 IBI      CON    6           INITIAL BLOCK INDEX FOR THIS CORE IMAGE
 ID       CON    0           INTERACTIVE DEBUG FLAG 
                             BIT 59=KERNEL FOR INTERACTIVE DEBUG LOADED 
                             BIT 1=CALL INTERACTIVE DEBUG 
                             BIT 0=CREATE FULL *ZZZZZDT* FILE FOR *PMD* 
                             AND *CID*
 LA       CON    100B        LOGICAL DISK ADDRESS ON FILE *ZZZZZDT* 
 TA       CON    0L"DGBNAME" TRAP NAME AND ADDRESS FOR INTERACTIVE DEBUG
 IDVER    CON    1           INTERACTIVE DEBUG VERSION NUMBER 
 PO       CON    COMLTH+1    PROGRAM ORIGIN (FWA LOADABLE AREA) 
 ABSMAX   CON    0           MAX LWA+1 ABS DATA (RELOC LOADS ONLY)
 BI       CON    COMLTH+1    BINARY INDEX IN *TPGM* 
 IC       ELSE
 PO       RVFD   60,BASE     PROGRAM ORIGIN (FWA LOADABLE AREA) 
 PA       RVFD   60,BASE-COMLTH    CURRENT LWA+1 OF RELOCATABLE TEXT
 ABSMAX   RVFD   60,BASE-COMLTH    MAX LWA+1 ABS DATA (RELOC LOADS ONLY)
 BI       CON    COMLTH      BINARY INDEX IN *TPGM* 
 IC       ENDIF 
          IFCARD 1
 PCTYPE   CON    -1          FLAG FILE VS. LIBRARY ON PROG CALL 
 IU       IFUSER
 CALLADR  CON    0           FWA OF USER-CALL REQUEST AREA
 OVERLOAD CON    0           NZ IF LOADABLE AREA OVER PREV. LOAD
 NOREQ    CON    0           NZ IF LOADABLE AREA CLOBBERS CALL
 RETURN   CON    0           RETURN ADDRESS FROM USER CALL
 ERRNUM   CON    0           ERROR NUMBER TO GO IN REPLY WORD 
 PLDP     CON    0           *PILOAD* PARAMETER BLOCK ADDRESS 
 IU       ENDIF 
 CTLPT    CON    0           CONTENTS OF W.CPLDR1 
 MAPDEF   CON    0           DEFAULT MAP TYPE 
 MAPTYPE  CON    0           TYPE OF MAP TO GENERATE
 MAPFLAG  CON    0           NZ IF WRITING MAP
 MAPLFN   VFD    42/0LOUTPUT,18/0  MAP FILE NAME
          IFCARD 1
 EP       CON    IP.LDER     ERROR PROCESSING OPTION
 LP       CON    0           LENGTH OF GLOBAL LIBRARY SET 
  
 FI       CON    -1          FILE INDEX IN *TLFN* 
 LI       CON    0           LINK INDEX IN *TLBC* 
 XLI      CON    0           LINK INDEX IN *TXLBC*
 PI       CON    0           PROGRAM INDEX IN *TBLK*
  
 PC       CON    0           PROGRAM COUNT
 PN       CON    0           NAME OF MOST RECENTLY LOADED PROGRAM 
 XF       CON    0,0,0       TRANSFER NAMES 
 EX       CON    -1          EXECUTE
 FE       CON    0           FATAL ERROR
 NE       CON    0           NON-FATAL ERROR COUNT
 IH       VFD    12/7700B,12/LTH77,36/0    PREFIX HEADER
 ON       CON    0           OVERLAY NAME   *** MUST FOLLOW IH ***
 OF       CON    0           LFN ON WHICH OVERLAY WAS WRITTEN 
 LSBN     CON    0L"LS"      SAVED LOCAL VARIABLES BLOCK NAME 
 UID      CON    0L"UI"      UNIQUE IDENTIFIER FOR LOCAL SAVE BLOCKS
          QUAL   READ 
 UNAME    CON    2           VALUE FOR NEXT UNIQUE BLOCK NAME 
          QUAL   *
 LT       CON    0           LAST TABLE READ
 LF       CON    0           SET NZ IF ANY NON-LIBRARY LOADING
 LDFILE   CON    0           THIS ENTRY IS FOR LOAD FILE
          CON    0           END OF TABLE INDICATOR 
  
 IU       IFUSER
 LASTCARD CON    1           FLAG TO INDICATE OBJECT DIRECTIVES(LOADU)
 REW      CON    IP.REW      DEFAULT REWIND OPTION(LOADU) 
 IU       ENDIF 
 IC       IFCARD
 TTFLAG   CON    -1          0  - CONTROL STATEMENTS IN JOB STREAM
                             +1 - CONTROL STATEMENTS FROM TERMINAL
 LASTCARD CON    0           =0 IFF STILL FETCHING CONTROL CARDS
 CURGPNAM CON    0           CURRENT GROUP NAME 
 LASCPNAM CON    0           LAST CAPSULE NAME
 CURCPNAM CON    0           CURRENT CAPSULE NAME 
 NEXCPNAM CON    0           NEXT CAPSULE NAME
 TCPFMTP  CON    0           POINTER INTO *TCPFMT*
 CURREQBP CON    0           CURRENT REQUEST BEING PROCESSED
 CGNDE    CON    0           NO DEFAULT EPT FLAG (0=DEFAULT)
 CGREQSV  CON    0           REQUEST NUMBER SAVE AREA 
 CGFPAF   CON    0           CURRENT CAPSULE INITIATED (0=NO) 
 CGLFNSV  CON    0           CAPSULE GENERATION FILE NAME SAVE WORD 
 DFLTLFN  VFD    60/0LABS    DEFAULT OUTPUT FILE FOR BINARIES 
 IC       ENDIF 
*                            *LOAD*/*SLOAD* FLAGS 
 LSL      CON    0           NZ IFF PROCESSING *SLOAD* REQUEST
 SLNP     CON    0           NO. OF PROGRAMS TO FIND (*SLOAD*)
 READFUNC CON    0           INPUT FUNCTION TO USE FOR LOAD FILES 
 RECORDS  CON    0           NO. OF RECORDS READ (1 PER READNS) 
* 
 IC       IFCARD
 OG       CON    0           =1 IF OVERLAY GENERATION LOAD
                                   -1 IFF CAPSULE GEN (OBJ DIR INIT)
                                   -2 IFF CAPSULE GEN (CC INIT) 
                                   2 IFF OVERLAY-CAPSULE GENERATION 
 OCOG     CON    0           =1 IFF OVERLAY GENERATION COMING UP
                                   2 IFF OVCAP GENERATION COMING UP 
 OCBPI    CON    0           BASE *PI* FOR OVCAPS 
 OCOGBC   CON    0           CONTENTS OF *OGBC* BEFORE */LOADG/PBC* 
 Z32      CON    0L"SFN"     SPOOLING FILE NAME 
 EPTC     CON    1           ENTRY POINT COUNT FOR OVERLAY
 OGLDFIL  CON    7L(LDFIL)   CURRENT LOAD FILE
 OGLINE   CON    1H          ** MUST PRECEDE OGCARD **
 OGCARD   BSSZ   9           *OVERLAY* CARD IMAGE 
 NOGOLFN  CON    0           LFN IF SPECIFIED ON NOGO CARD
 OGLFN    CON    0           ABSOLUTE BINARY OUTPUT FILE
 OGL1     CON    0           PRIMARY LEVEL OF CURRENT OVERLAY 
 OGL2     CON    0           SECONDARY LEVEL OF CURRENT OVERLAY 
 MLWCM    CON    0           MAIN OVERLAY LWA+1 IN CM 
 MLWCMEB  CON    0           MAIN OVERLAY LWA+1 IN CM EXCLUDING //
 MINPFWA  CON    377777B     CURRENT MINIMUM PRIMARY OVERLAY FWA
 MLWECS   CON    0           MAIN OVERLAY LWA+1 IN ECS
 PLWCM    CON    0           PRIMARY OVERLAY LWA+1 IN CM
 PLWCMEB  CON    0           PRIMARY OVERLAY LWA+1 IN CM EXCLUDING // 
 MINSFWA  CON    377777B     CURRENT MINIMUM SECONDARY OVERLAY FWA
 PLWECS   CON    0           PRIMARY OVERLAY LWA+1 IN ECS 
 OGECSBC  CON    0           ECS BLANK COMMON ORIGIN
 OGEBCL   CON    0           ECS BLANK COMMON LENGTH
 OGEBCLV  CON    0           ECS BLANK COMMON LEVEL 
                             0=NONE 1=MAIN 2=PRIMARY
 OGBC     CON    0           BLANK COMMON ORIGIN
 OGBCL    CON    0           BLANK COMMON LENGTH
 OGBCLVL  CON    0           BLANK COMMON LEVEL 
                                      0=NONE  1=MAIN  2=PRIMARY 
 OG1ST00  CON    0           LFN OF FIRST (0,0) OVERLAY WRITTEN 
 OGLST00  CON    0           LFN OF LAST (0,0) OVERLAY WRITTEN
 OGSKIP   CON    0           SKIP COUNT TO REPOSITION OGLST00 
 HHAPRU   CON    0           RANDOM ADDRESS OF SECTOR TO CONTAIN HHA
 HHACM    CON    0           HIGHEST-HIGH-ADDRESS IN CM 
 HHAECS   CON    0           HIGHEST-HIGH-ADDRESS IN ECS
 NEWCARD  BSSZ   9           (FOR NEXT OVERLAY) DIRECTIVE IMAGE 
 NEWLFN   CON    0           (FOR NEXT OVERLAY) LFN 
 NEWL1    CON    0           (FOR NEXT OVERLAY) PRIMARY LEVEL 
 NEWL2    CON    0           (FOR NEXT OVERLAY) SECONDARY LEVEL 
 NEWORG   CON    0           (FOR NEXT OVERLAY) ORIGIN SPECIFICATN
 NEWERR   CON    0           (FOR NEXT OVERLAY) NZ=ERR ON OVLY DIR
  
 LKR      CON    0           LOAD KNOWN TO BE RELOCATABLE (1=YES) 
 MAXOV    CON    0           *OV* SPECIFICATION(*2) FROM *OVERLAY* CARD 
 NEWMAXOV CON    0           NEW *MAXOV* FROM *OVERLAY* CARD
 FOLFS    CON    0           FILE SPEC ENTRY FOR *FOL* (RA+106B)
 FOLRA    CON    0           RANDOM ADDRESS FOR *FOL* (RA+107B) 
 FOLCRI   CON    0           PRU NUMBER FROM RANDOM WRITE 
 IS       IFSCOPE 
 Z03FSE   CON    0           ZZZZZ03 FILE SPECIFICATION ENTRY 
 Z04FSE   CON    0           ZZZZZ04 FILE SPECIFICATION ENTRY 
 IS       ENDIF 
 HDOPTC   CON    0           SET NZ IF CMU OR SIMULATED CMU PRESENT 
 HDOPTI   CON    0           SET NZ IF INTEGER MULTIPLY PRESENT 
 HDOPTX   CON    0           SET NZ IF XJ PRESENT 
 RQP1     CON    0           POINTER IN CURRENT PRIMARY REQUEST 
 RQL1     CON    0           LENGTH OF CURRENT PRIMARY REQUEST
 RQP2     CON    0           POINTER IN CURRENT SECONDARY REQUEST 
 RQL2     CON    0           LENGTH OF CURRENT SECONDARY REQUEST
 REW      CON    IP.REW      DEFAULT REWIND OPTION
          IFCARD 2
          IFNOS  1
 SEPF     CON    0           SPECIAL ENTRY POINT FLAG (MFL=, RFL=)
 SEG      IFCARD
 SEGFLAG  CON    0           NZ IF THIS IS A SEGMENT LOAD 
                             NEGATIVE IF THIS IS PASS 1 OF SEGMENT LOAD 
 SI       CON    0           INDEX OF CURRENT SEGMENT ENTRY 
          CON    6           NEXT SEGMENT INDEX - SEE MAP PROCESSING
 SN       CON    0           SEGMENT NUMBER = INDEX/2 OF ENTRY IN *TCEL*
 TSEGFIN  CON    0           FINAL (MAXIMUM) NO. OF *TSEG* ENTRIES
 TSEGMAX  EQU    40000B      MAXIMUM ALLOWABLE SIZE OF *TSEG* 
 TSEGMX   DECMIC TSEGMAX/2
 ALLCOM   CON    0           NZ IF ALL COMMON BLOCKS AFFECTED 
 SEGIII   CON    0LINPUT     *SEGLOAD* INPUT FILE (DEFAULT) 
 SEGBBB   CON    0LABS       *SEGLOAD* BINARY FILE (DEFAULT)
 SEGMAP   CON    1S59+3      *SEGLOAD* LO PARAMETER VALUES (DEFAULT=DT) 
                                   BIT 0 - LO=D 
                                   BIT 1 - LO=T 
                                   BIT 59 - IF LO NOT SPECIFIED 
 GLOBLFN  DATA   0LOUTPUT    LAST MAP LFN SPECIFIED 
 GLOBMAP  CON    0           LAST MAP SPECIFIED 
 SEG      ENDIF 
          QUAL   LOADM
 TITL     DATA   20H1         LOAD MAP -
 PNAM     DATA   40H (PNAME)
          DATA   30H    CYBER LOADER "VER"-"LEVEL"
 DATE     DATA   0
 TIME     DATA   0
          DATA   10H      PAGE
 PAGE     CON    0
 LC       CON    PGSIZ
 PC       CON    1           PAGE COUNT FOR MAP 
          QUAL   *
 IC       ENDIF 
 PRDEN    CON    0           SET PRINT DENSITY
 PGSIZ    CON    0           SET PAGE SIZE
 PGWID    CON    0           PAGE WIDTH 
 PGPAR    BSSZ   2           *GETPAGE* PARAMETER RETURN BLOCK 
  
*         THE FOLLOWING FLAG INDICATES THE TYPE OF REQUESTS BEING 
*         PROCESSED AS FOLLOWS -
  
          IFCARD
*           1 - CONTROL CARDS DURING RELOCATABLE LOAD, NO OVERLAY GEN.
*           2 - CONTROL CARDS DURING ABSOLUTE LOAD. 
*         10B - OBJECT DIRECTIVES.
          ENDIF 
          IFUSER
*           1 - REQUESTS ISSUED VIA THE USER CALL.
*         10B - OBJECT DIRECTIVES.
          ENDIF 
  
 REQTYPE  CON    1           CURRENT REQUEST TYPE 
 PREVTYPE CON    0           STORAGE FOR PREVIOUS TYPE
  
  
*         I/O FUNCTION DEFINITIONS
  
 CODED    EQU    0
 BINARY   EQU    2
 REWINDER EQU    50B
 CLOSE    EQU    130B 
 CLOSER   EQU    174B 
 WRITE    EQU    14B
 WRITER   EQU    24B
 WRITEF   EQU    34B
 READ     EQU    10B
 READLS   EQU    210B 
 READNS   EQU    250B 
 SKIPB    EQU    640B 
 BKSPRU   EQU    44B
 OPENNR   EQU    120B 
 READNR   EQU    100B 
 WRITENR  EQU    104B 
 REWRITE  EQU    214B 
 REWRITER EQU    224B 
 SKIPF    EQU    240B 
 READSKP  EQU    20B
  
****
  
          RELOC  ON 
 CIO      TITLE  I/O SUBROUTINES. 
          QUAL   CCIO 
          BASE   D
  
  
**        ++++++++++++++++++++++++++++++++
*         + SUBROUTINES USED THROUGHOUT. +
*         ++++++++++++++++++++++++++++++++
* 
* 
*         + + + + + + + + + + + 
*         + I/O SUBROUTINES.  + 
*         + + + + + + + + + + + 
* 
* 
*         CIO - CIO I/O FUNCTION PROCESSOR. 
* 
*         G.R. MANSFIELD,  69/12/08.
*         ADAPTED FOR 3.4 LOADER. 
* 
*              THIS ROUTINE PERFORMS *CIO* TYPE I/O FUNCTIONS.
* 
*         ENTRY  (X2) = ADDRESS OF FET FOR FILE.
*                (X7) = FUNCTION CODE.
*                IF (X7) < 0, (X7) IS COMPLEMENT OF REQUEST, AND
*                       AUTO-RECALL IS REQUESTED. 
*                THE LOCATION *CALL* CONTAINS THE NAME OF THE PP
*                       PROGRAM TO BE CALLED.  IT IS NORMALLY SET TO
*                       *CIO*, BUT SOMETIMES IT IS SET TO *LDL*.
*         EXIT   (X2) = ADDRESS OF FET FOR FILE.
*         USES   X - 1, 2, 6, 7.
*                B - NONE.
*                A - 1, 7.
*         CALLS  SYS=, WNB=.
  
  
 CIO3     LX6    42          PROCESS REQUEST
          IX6    X6+X2
          RJ     SYS= 
          RJ     IOERR=      CHECK ERROR STATUS 
  
 CIO      EQ     *+400000B   ENTRY/EXIT 
          SA1    X2          CHECK BUFFER STATUS
          LX1    59 
          NG     X1,CIO1     IF BUFFER NOT BUSY 
          ZR     X1,CIO1     IF ZERO FILE STATUS
          RECALL X2 
 CIO1     PL     X7,CIO2     IF NO AUTO RECALL
          LD     X1,1        SET AUTO RECALL BIT
          BX7    -X7
          LX1    40 
          NO
          IX2    X1+X2
 CIO2     MX6    42          MASK FILE NAME AND MODE
          SX1    B1+B1
          BX6    X6+X1
          SA1    X2 
          BX6    X6*X1
          SA7    A1-B1       SAVE FUNCTION CODE 
          BX7    X6+X7       STORE BUFFER STATUS
          SA7    X2 
          SX1    L           CHECK IF USING FET *L* 
          SX6    X2          (X6) = FET ADDRESS 
          IX1    X1-X6
          ZR     X1,CIO2A    IF USING FET *L* 
          R=     X1,3RCIO    SET UP TO CALL *CIO* 
          EQ     CIO2B
  
 CIO2A    SA1    CALL        GET PP CALL WORD (*CIO* OR *LDL*)
 CIO2B    BSS    0
          BX6    X1 
          EQ     CIO3 
  
 CALL     VFD    42/0,18/3RCIO     MAY BE MODIFIED TO CALL A DIFFERENT
                                    PPU PROGRAM, PROVIDED THE PROGRAM 
                                     USES CIRCULAR BUFFER POINTERS AND
                                      RETURNS STATUS AS DOES *CIO*. 
*         SKIP - SKIP FUNCTION PROCESSOR. 
* 
*              THIS ROUTINE SETS A SKIP COUNT IN THE PP CALL, THEN
*         CALLS *CIO=*, THEN RESETS THE PP CALL.
* 
*         ENTRY  (X2) AND (X7) AS FOR *CIO=*
*                (X6) = SKIP COUNT
  
  
 SKIP     EQ     *+400000B   ENTRY/EXIT 
          SA1    CALL 
          SX1    X1 
          LX6    36 
          BX6    X1+X6
          SA6    A1 
          RJ     CIO= 
          SA1    CALL 
          SX6    X1 
          SA6    A1 
          EQ     SKIP 
          SPACE  4
          QUAL
          BASE   *
 SETFET=  EQU    /CCIO/SETFET 
 CIO=     EQU    /CCIO/CIO
 SKIP=    EQU    /CCIO/SKIP 
 RDO      SPACE  4,8
          QUAL   CRDO 
          BASE   D
 RDO      SPACE  4,8
**        RDO - READ ONE WORD.
* 
*         D. A. CAHALANDER.  70/10/09.
*         ENTRY  (A1) = ADDRESS OF IN POINTER.
*                (X1) = IN. 
* 
*         EXIT   (X1) = 0 FOR TRANSFER COMPLETE.
*                (X1) = -1 IF EOF OR EOI DETECTED ON FILE.
*                (X1) = 1 IF EOR DETECTED ON FILE.
*                (X2) = ADDRESS OF FET FOR FILE.
*                (X6) = WORD READ.
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - NONE.
*                A - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  CIO=.
  
  
 RDO1     SX7    X3+B1       INCREMENT OUT
          BX6    X4 
          MX1    0           RESPONSE = 0 
          SA7    A3          UPDATE OUT 
  
 RDO=     PS                 ENTRY/EXIT 
 RDO2     BSS    0
          SA3    A1+B1       READ OUT 
          IX7    X3-X1       OUT - IN 
          R=     X2,A1-2
          SA4    X3          READ WORD
          NG     X7,RDO1     IF NO WRAP AROUND
          SA1    A3+B1       READ LIMIT 
          SX6    X1 
          ZR     X7,RDO3     IF BUFFER EMPTY
          SX7    X3+B1       ADVANCE OUT
          IX1    X7-X6
          NZ     X1,RDO1     IF OUT " LIMIT 
          SA1    X2+B1       READ FIRST 
          R=     X3,X1-1
          EQ     RDO1        RETURN 
  
*         LOAD CIRCULAR BUFFER. 
  
 RDO3     SA1    X2          CHECK BUFFER STATUS
          LX1    59-0 
          NG     X1,RDO5     IF BUFFER NOT BUSY 
          RECALL
 RDO4     R=     A1,X2+2     READ IN
          EQ     RDO2        CONTINUE READ
  
 RDO5     SA4    A3-B1
          IX4    X4-X3       RECHECK IN = OUT 
          NZ     X4,RDO4     IF IN " OUT
          LX1    -4 
          NG     X1,RDO6     IF EOR SET 
          LX1    4           ISSUE PREVIOUS READ FUNCTION 
          R=     X6,740770B/2 
          BX7    X6*X1
          LX7    1
          RJ     IOERR=      CHECK FOR I/O ERROR
          RJ     =XCIO= 
          EQ     RDO4        CONTINUE READ
  
 RDO6     LX3    X1,B1
          SA1    A1+B1       SET IN = OUT = FIRST 
          SX7    X1 
          SA7    A1+B1
          SA7    A7+B1
          SX1    B1          RESPONSE = 1 
          PL     X3,RDO=     IF NOT EOF 
          LX3    3-9
          SX1    -B1         RESPONSE = -1
          EQ     RDO=        RETURN 
          SPACE  4,8
          BASE   *
          QUAL
          SPACE  4
 IC       IFCARD
 RDO=     EQU    /CRDO/RDO= 
 IC       ELSE
 RDO1     RJ     /CRDO/RDO= 
 RDO=     PS                 ENTRY/EXIT 
          SA4    /CRDW/RDCTL
          ZR     X4,RDO1     NOT *CMLOAD* OR *ECLOAD* 
          READW  X2,RDOA,1   READ FROM CM OR ECS
          SA4    RDOA 
          BX6    X4 
          EQ     RDO=        EXIT 
 RDOA     CON    **          BUFFER FOR READ FROM CM OR ECS 
 IC       ENDIF 
 RDW      EJECT  4,8
          QUAL   CRDW 
          BASE   D
  
  
**        RDW - READ WORDS TO WORKING BUFFER. 
* 
*         G.R. MANSFIELD, 69/12/08. 
*         ADAPTED FOR 3.4 LOADER. 
* 
*              *RDW* READS WORDS FROM A CIRCULAR BUFFER TO
*         A WORKING BUFFER. 
* 
*         ENTRY  (X2) = ADDRESS OF FET FOR FILE.
*                (B6) = FWA WORKING BUFFER. 
*                (B7) = WORD COUNT OF WORKING BUFFER. 
*         EXIT   (X1) = 0 FOR TRANSFER COMPLETE.
*                (X1) = -1 IF EOF DETECTED ON FILE. 
*                (X1) = ADDRESS OF LAST WORD TRANSFERRED INTO WORKING 
*                            BUFFER IF EOR DETECTED ON FILE BEFORE
*                            TRANSFER WAS COMPLETED.
*                (B6) = ADDRESS OF LAST WORD TRANSFERRED TO WORKING 
*                            BUFFER.
*                (X2) = ADDRESS OF FET FOR FILE.
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*         CALLS  LCB=, RDX=.
  
  
          IFUSER 3
 RDCTL    CON    0           0 - READ FROM CIRCULAR BUFFER
                                    1 - READ FOR *CMLOAD* (USER ONLY) 
                                    2 - READ FOR *ECLOAD* (USER ONLY) 
  
 +        EQ     RDW1 
  
 RDW      EQ     *+400000B   ENTRY/EXIT 
          IFUSER 2
          SA1    RDCTL
          NZ     X1,RDW10    IF *CMLOAD* OR *ECLOAD*
 RDW0     SA4    RDW         SET RETURN ADDRESS 
          LD     A1,X2+4     (B5) = LIMIT 
          SA3    X2+B1       (X3) = FIRST 
          SB7    B6+B7       (B7) = LWA+1 WORKING BUFFER
          SB5    X1 
  
*         INITIALIZE REGISTERS FOR TRANSFER.
  
 RDW1     SA1    A3+B1       (B3) = IN
          SA2    A1+B1       (B4) = OUT 
          SB3    X1 
          SB4    X2 
  
*         TRANSFER DATA FROM CIRCULAR BUFFER TO WORKING BUFFER. 
  
 RDW2     EQ     B4,B3,LCB=  LOAD CIRCULAR BUFFER IF OUT = IN 
          SA1    B4          READ WORD
          BX6    X1 
          SB4    B4+B1       (OUT+1)
          NE     B4,B5,RDW3  IF (OUT+1) " LIMIT 
          SB4    X3          (OUT+1) = FIRST
 RDW3     SA6    B6          STORE WORD 
          SB6    B6+B1       ADVANCE WORKING BUFFER 
          NE     B6,B7,RDW2  LOOP TO FILL WORKING BUFFER
*         EQ   RDX=                EXIT 
 RDX      SPACE  4,6
**        RDX - READ EXIT.
* 
*         EXIT FROM READ SUBROUTINE TO CALLER.
*         IF CIRCULAR BUFFER IS BUSY, OR EOR/EOF IS SENSED, NO ACTION 
*         IS TAKEN. 
*         OTHERWISE, THE WORD COUNT REMAINING IN THE BUFFER IS CHECKED
*         AND A READ FUNCTION ISSUED IF NECESSARY.
* 
*         ENTRY  (A2) = ADDRESS OF OUT. 
*                (A3) = ADDRESS OF FIRST. 
*                (A4) = RETURN ADDRESS. 
*                (X3) = FIRST.
*                (B3) = IN. 
*                (B4) = OUT.
*                (B5) = LIMIT.
*         EXIT   TO RETURN ADDRESS. 
*         CALLS  CIO=.
  
  
 RDX      SX2    A3-B1       RESET (X2) 
          SX7    B4          STORE OUT
          RJ     IOERR=      CHECK ERROR STATUS 
          LX1    59 
          SA7    A2 
          PL     X1,RDX1     IF BUFFER BUSY 
          LX1    -4 
          NG     X1,RDX1     IF EOR/EOF SET 
  
*         IF BUFFER IS NOT BUSY, CHECK BUFFER SIZE. 
*         ISSUE READ IF BUFFER THRESHOLD IS REACHED.
  
 IS       IFSCOPE 
 IC       IFCARD
          MX6    6
          BX6    X3*X6
          LX6    6           DEVICE TYPE IN X6
          SX6    X6-61B 
          ZR     X6,RDX1     IF CONNECTED FILE
 IC       ENDIF 
 IS       ENDIF 
  
          SX6    B3-B4       (IN-OUT) 
          SB2    X3          (LIMIT-FIRST)
          LX3    X6,B1       2*(IN-OUT) 
          SX7    B5-B2
          AX6    60          SIGN OF (IN-OUT) 
          BX4    X6-X7       INVERT BUFFER IF OUT \ IN
          IX6    X4-X3       BUFFER SIZE - 2*(IN-OUT) 
          NG     X6,RDX1     IF BUFFER THRESHOLD NOT REACHED
          SA1    A1-B1       ISSUE PREVIOUS READ FUNCTION 
          BX7    X1 
          RJ     CIO= 
 RDX1     SX1    B0          RESPONSE = 0 
          SB2    A4          SET RETURN ADDRESS 
          BR     B2          RETURN 
 LCB      SPACE  4,6
**        LCB - LOAD CIRCULAR BUFFER. 
* 
*         REQUEST READ IF BUFFER IS EMPTY, NOT BUSY AND NOT EOR/EOF.
*         IF BUFFER IS BUSY, RECALL AND RETURN. 
* 
*         ENTRY  (A2) = ADDRESS OF OUT. 
*                (A3) = ADDRESS OF FIRST. 
*                (A4) = RETURN ADDRESS. 
*                (B4) = OUT.
*         EXIT   TO RETURN ADDRESS - 1 IF CONTINUATION READ.
*                TO RETURN ADDRESS IF EOR/EOF.
*                (X1) = LAST WORD ADDRESS OF WORKING BUFFER.
*                (X1) = -1 IF EOF.
*         CALLS  CIO=, RCL=.
* 
  
 LCB      SA1    A3-B1       CHECK BUFFER STATUS
          SX6    B4          STORE OUT
          LX1    59 
          SA6    A2 
          NG     X1,LCB2     IF BUFFER NOT BUSY 
          RECALL
 LCB1     SB2    A4-B1       CONTINUE READ
          BR     B2 
  
 LCB2     SA1    A2-B1       RE-READ IN 
          SB3    X1 
          NE     B3,B4,LCB1  IF BUFFER NOT EMPTY
          SX2    A3-B1       RESET (X2) 
          RJ     IOERR=      CHECK ERROR STATUS 
          LX1    59-4 
          NG     X1,LCB3     IF EOR SET 
          SA1    A1-B1       ISSUE PREVIOUS READ FUNCTION 
          BX7    X1 
          RJ     CIO= 
          SB2    A4-B1       CONTINUE READ
          BR     B2 
  
 LCB3     LX6    B1,X1
          MX7    0           FLAG START OF NEW RECORD 
          SA7    LT 
          SA1    A3          SET IN = OUT = FIRST 
          SX7    X1 
          SA7    A1+B1
          SX1    B6          RESPONSE = LAST WORD ADDRESS 
          PL     X6,LCB4     IF NOT EOF 
          SX1    -B1         RESPONSE = -1
 LCB4     SB2    A4          SET RETURN ADDRESS 
          SA7    A7+B1
          BR     B2          RETURN 
  
**             *LCB* HAS BEEN MODIFIED TO FETCH THE INPUT BY ANY OF THE 
*         FOLLOWING ALTERNATE METHODS 
* 
*         1)   FROM CM WHILE PROCESSING A *CMLOAD* REQUEST. 
*         2)   FROM ECS WHILE PROCESSING AN *ECLOAD* REQUEST. 
  
 CMECS    IFUSER
  
 RDW10    SA4    FWALWA      (X2) = REMAINING WORD COUNT
          SX6    B7          (X6) = (B2) = NO. WORDS TO BE READ 
          SA3    A4+B1
          IX2    X3-X4
          SB2    B7 
          IX7    X2-X6
          SB4    B0          SET NO EOR/EOF STATUS
          PL     X7,RDW11    IF NOT PAST END OF INFORMATION 
          SB2    X2 
          SB4    -B1         SET EOF STATUS 
 RDW11    SB3    X1 
          ZR     B2,RDW13    IF NOTHING TO READ 
 ECS      IFTEST NE,IP.MECS,0 
          EQ     B3,B1,RDW12 IF READ FROM CM
          BX1    X4          (X1) = ECS FWA 
          SX2    B6          (X2) = CM FWA
          RJ     REW=        READ (B2) WORDS FROM ECS 
          EQ     RDW13
  
 RDW12    MOVE   B2,X4,B6    MOVE INPUT 
 ECS      ENDIF 
          IFTEST EQ,IP.MECS,0,1 
          MOVE   B2,X4,B6    MOVE INPUT 
 RDW13    SA4    FWALWA      ADVANCE FWA POINTER BY AMOUNT READ 
          SX3    B2 
          SX1    B4          (X1) = EOF FLAG
          IX7    X4+X3
          SB6    B6+B2       ADVANCE WORKING BUFFER FWA 
          MX6    0
          SA7    A4 
          ZR     X1,RDW      IF NOT EOF 
          SA6    RDCTL       RESET READ CONTROL FOR NORMAL READ 
          EQ     RDW         EXIT 
  
 FWALWA   CON    0,0         FWA AND LWA+1 OF CM OR ECS READ AREA 
 CMECS    ENDIF 
  
          QUAL
          BASE   *
 RDW=     EQU    /CRDW/RDW
 RDX=     EQU    /CRDW/RDX
 LCB=     EQU    /CRDW/LCB
  
 IC       IFCARD
 RDC      SPACE  4,8
          QUAL   CRDC 
          BASE   D
  
  
***       RDC - READ CODED LINE, -C- FORMAT.
*         G. R. MANSFIELD.  70/10/09. 
 RDC      SPACE  4
***              RDC READS 1 CODED LINE FROM A CIO BUFFER TO A
*         WORKING BUFFER. 
* 
*         ENTRY  (X2) = ADDRESS OF FET FOR FILE.
*                (B6) = FWA WORKING BUFFER. 
*                (B7) = WORD COUNT OF WORKING BUFFER. 
* 
*         EXIT   (X1) = 0 FOR TRANSFER COMPLETE.
*                (X1) = -1 IF EOF DETECTED ON FILE. 
*                (X1) = -2 IF EOI DETECTED ON FILE. 
*                (X1) = (B6) IF EOR WAS DETECTED ON FILE BEFORE 
*                             TRANSFER WAS COMPLETED. 
*                (B6) = ADDRESS PLUS ONE OF LAST WORD TRANSFERRED TO
*                             WORKING BUFFER. 
*                (X2) = ADDRESS OF FET FOR FILE.
*                (X4) = CONTENTS OF LAST DATA WORD TRANSFERRED
*                            BEFORE EOL GUARANTEED, IF TRANSFER 
*                            COMPLETED ((X1)=0).
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 1, 2, 3, 4, 5, 6, 7. 
*                A - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  LCB=, RDX=.
  
  
 +        EQ     RDC1 
  
 RDC=     PS                 ENTRY/EXIT 
          SA4    *-1         SET RETURN ADDRESS 
  
          IF     -DEF,B1=1,1
          SB1    1
  
          SA1    X2+4        (B5) = LIMIT 
          SA3    X2+B1       (X3) = FIRST 
          SB7    B6+B7       (B7) = LWA+1 WORKING BUFFER
          MX4    -12         (X4) = BYTE MASK 
          SB5    X1 
  
*         INITIALIZE REGISTERS FOR TRANSFER.
  
 RDC1     SA1    A3+B1       (B3) = IN
          SA2    A1+B1       (B4) = OUT 
          SB3    X1 
          SB4    X2 
  
*         TRANSFER DATA FROM CIRCULAR BUFFER TO WORKING BUFFER. 
  
 RDC2     EQ     B4,B3,LCB=  LOAD CIRCULAR BUFFER IF OUT = IN 
          SA1    B4          READ WORD
          BX6    X1 
          SB4    B4+B1       (OUT+1)
          EQ     B4,B5,RDC5  IF (OUT+1) = LIMIT 
          SA6    B6          STORE WORD 
 RDC3     BX7    -X4*X6      CHECK LOWER BYTE 
          SB6    B6+B1       ADVANCE WORKING BUFFER 
          ZR     X7,RDC4     IF END OF LINE ENCOUNTERED 
          NE     B6,B7,RDC2  LOOP TO FILL WORKING BUFFER
          BX7    X4*X6       CLEAR LAST BYTE
          SA7    A6 
 RDC4     BX4    X6          RETURN LAST WORD BEFORE EOL CLEARED
          EQ     RDX=        EXIT 
  
 RDC5     SB4    X3          (OUT+1) = FIRST
          SA6    B6          STORE WORD 
          EQ     RDC3        LOOP 
  
  
          BASE   *
          QUAL   *
 RDC=     EQU    /CRDC/RDC= 
  
 IC       ENDIF 
 WTO      SPACE  4,8
          QUAL   CWTO 
          BASE   D
  
  
**        WTO - WRITE ONE WORD INTO A CIO BUFFER. 
* 
*         D. A. CAHALANDER.  70/10/09.
*         ENTRY  (A1) = ADDRESS OF IN POINTER.
*                (X1) = IN. 
*                (X6) = WORD TO WRITE.
*         EXIT   (X2) = ADDRESS OF FET OF FILE. 
*                (X6) = WORD WRITTEN. 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - NONE.
*                A - 1, 2, 3, 4, 6, 7.
  
  
 WTO1     SA6    X1          STORE WORD 
          LD     X2,A1-2
          SA7    A1          UPDATE IN
  
 WTO=     PS                 ENTRY/EXIT 
 WTO2     BSS    0
          SA3    A1+B1       READ OUT 
          SX7    X1+B1       IN+1 
          NO
          IX4    X7-X3       IN+1 - OUT 
          NG     X4,WTO1     IF NO WRAP AROUND
          SA3    A3+B1       READ LIMIT 
          SX2    X3 
          ZR     X4,WTO3     IF BUFFER FULL 
          IX4    X7-X2       IN+1 - LIMIT 
          NZ     X4,WTO1     IF IN+1 " LIMIT
          SA3    A1-B1       READ FIRST 
          SA2    A1+B1       READ OUT 
          SX7    X3          IN+1 
          IX4    X7-X2
          NZ     X4,WTO1     IF IN+1 " OUT
  
*         DUMP CIRCULAR BUFFER. 
  
 WTO3     BX4    X6          SAVE WORD
          LD     A1,A1-2
          SX2    A1 
          LX1    -1 
          NG     X1,WTO5     IF NOT BUSY
          ZR     X1,WTO=     IF BLANK FET 
          RECALL X2 
 WTO4     LD     A1,X2+2     READ IN
          BX6    X4 
          SA3    A1+B1       READ OUT 
          EQ     WTO2        CONTINUE WRITE 
 WTO5     WRITE  X2 
          EQ     WTO4        CONTINUE WRITE 
  
  
          BASE   *
          QUAL   *
 WTO=     EQU    /CWTO/WTO= 
 WTW      SPACE  4,8
 WTW      EJECT  4,6
          QUAL   CWTW 
          BASE   D
  
  
**        WTW - WRITE WORDS FROM WORKING BUFFER.
* 
*         G.R. MANSFIELD, 69/12/08. 
* 
*              *WTW* TRANSFERS DATA FROM A WORKING BUFFER TO A
*         CIRCULAR BUFFER.
* 
*         ENTRY  (X2) = ADDRESS OF FET FOR FILE.
*                (B6) = FWA WORKING BUFFER. 
*                (B7) = WORD COUNT OF WORKING BUFFER. 
*                IF (B7) = 0, NO TRANSFER WILL BE PERFORMED.
*         EXIT   (X2) = ADDRESS OF FET FOR FILE.
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*         CALLS  DCB=, WTX=.
  
  
 +        EQ     WTW1 
  
 WTW      EQ     *+400000B   ENTRY/EXIT 
          SA4    *-1
          ZR     B7,WTW      IF WORKING BUFFER EMPTY
          LD     A1,X2+4     (B5) = LIMIT 
          SA3    X2+B1       (X3) = FIRST 
          SB7    B6+B7       (B7) = LWA+1 WORKING BUFFER
          SB5    X1 
  
*         INITIALIZE REGISTERS FOR TRANSFER.
  
 WTW1     LD     A1,A3+2     (B4) = OUT 
          SA2    A3+B1       (X2) = IN
          SB4    X1 
  
*         TRANSFER DATA FROM WORKING BUFFER TO CIRCULAR BUFFER. 
  
 WTW2     SB3    X2+B1       (IN+1) 
          NE     B3,B5,WTW3  IF (IN+1) " LIMIT
          SB3    X3          (IN+1) = FIRST 
 WTW3     SA1    B6          NEXT WORD
          EQ     B3,B4,DCB=  DUMP CIRCULAR BUFFER IF (IN+1) = OUT 
          SB6    B6+B1       ADVANCE WORKING BUFFER 
          BX6    X1 
          SA6    X2          STORE WORD 
          NO
          SX2    B3          IN = IN+1
          NE     B6,B7,WTW2  LOOP TO END OF WORKING BUFFER
*         EQ   WTX                 EXIT 
 WTX      SPACE  4,6
**        WTX - WRITE EXIT. 
* 
*         IF BUFFER IS BUSY, RETURN.
*         OTHERWISE, WORD COUNT OF BUFFER IS CHECKED, AND A WRITE 
*         FUNCTION IS REQUESTED IF NECESSARY. 
* 
*         ENTRY  (A2) = ADDRESS OF IN.
*                (A3) = ADDRESS OF FIRST. 
*                (A4) = RETURN ADDRESS. 
*                (B3) = IN+1. 
*                (B4) = OUT.
*                (B5) = LIMIT.
*                (X2) = IN. 
*         EXIT   TO RETURN ADDRESS. 
*         CALLS  CIO=.
  
  
 WTX      SX7    X2          STORE IN 
          SX2    A3-B1       RESET (X2) 
          RJ     IOERR=      CHECK ERROR STATUS 
          LX1    59 
          SA7    A2 
          PL     X1,WTX1     IF BUFFER BUSY 
  
*         IF BUFFER IS NOT BUSY, CHECK SIZE OF BUFFER.
*         ISSUE WRITE IF THRESHOLD IS REACHED.
  
          SA3    A3          FIRST
          SX6    B4-B3       (OUT-IN+1) 
          SB2    X3          (LIMIT-FIRST)
          LX3    X6,B1       2*(OUT-IN+1) 
          SX7    B5-B2
          AX6    60          SIGN OF (OUT-IN+1) 
          BX4    X6-X7       INVERT BUFFER IN IN+1 \ OUT
          IX6    X4-X3       BUFFER SIZE - 2*(OUT-IN+1) 
          NG     X6,WTX1     IF BUFFER THRESHOLD NOT REACHED
          R=     X7,WRITE    ISSUE WRITE
          RJ     CIO= 
 WTX1     SB2    A4          SET RETURN ADDRESS 
          BR     B2          RETURN 
 DCB      SPACE  4,6
**        DCB - DUMP CIRCULAR BUFFER. 
* 
*         IF BUFFER IS BUSY, RECALL AND RETURN. 
*         IF BUFFER IS NOT BUSY, REQUEST WRITE FUNCTION AND RETURN. 
* 
*         ENTRY  (A2) = ADDRESS OF IN.
*                (A3) = ADDRESS OF FIRST. 
*                (A4) = RETURN ADDRESS. 
*                (X2) = IN. 
*         EXIT   TO RETURN ADDRESS - 1. 
*         CALLS  CIO=, RCL=.
  
  
 DCB      SA1    A3-B1       CHECK BUFFER STATUS
          SX6    X2          STORE IN 
          LX1    59 
          SA6    A2 
          NG     X1,DCB1     IF NOT BUSY
          ZR     X1,DCB1     IF BLANK FET 
          RECALL
          SB2    A4-B1       CONTINUE WRITE 
          BR     B2 
  
 DCB1     SX2    A3-B1
          RJ     IOERR=      CHECK ERROR STATUS 
          LD     X7,WRITE 
          RJ     CIO= 
          SB2    A4-B1       CONTINUE WRITE 
          BR     B2 
  
          QUAL
          BASE   *
 WTW=     EQU    /CWTW/WTW
 WTX=     EQU    /CWTW/WTX
 DCB=     EQU    /CWTW/DCB
 WTC      EJECT  4,6
          QUAL   CWTC 
          BASE   D
  
  
**        WTC - WRITE CODED LINE. 
* 
*         G.R. MANSFIELD, 69/12/08. 
* 
*              *WTC* TRANSFERS ONE CODED LINE (TO A ZERO-BYTE LINE
*         INDICATOR) FROM A WORKING BUFFER TO A CIRCULAR BUFFER.
* 
*         ENTRY  (X2) = ADDRESS OF FET FOR FILE.
*                (B6) = FWA WORKING BUFFER. 
*         EXIT   (X2) = ADDRESS OF FET FOR FILE.
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*         CALLS  DCB=, WTX=.
  
  
 +        EQ     WTC1 
  
 WTC      EQ     *+400000B   ENTRY/EXIT 
          SA4    *-1
          LD     A1,X2+4     (B5) = LIMIT 
          SA3    X2+B1       (X3) = FIRST 
          MX4    -12         (X4) = BYTE MASK 
          SB5    X1 
  
*         INITIALIZE REGISTERS FOR TRANSFER.
  
 WTC1     LD     A1,A3+2     (B4) = OUT 
          SA2    A3+B1       (X2) = IN
          SB4    X1 
  
*         TRANSFER DATA FROM WORKING BUFFER TO CIRCULAR BUFFER. 
  
 WTC2     SB3    X2+B1       (IN+1) 
          NE     B3,B5,WTC3  IF (IN+1) " LIMIT
          SB3    X3          (IN+1) = FIRST 
 WTC3     SA1    B6          NEXT WORD
          EQ     B3,B4,DCB=  DUMP CIRCULAR BUFFER IN (IN+1) = OUT 
          LX6    X1 
          SB6    B6+B1       ADVANCE WORKING BUFFER 
          BX7    -X4*X1 
          SA6    X2          STORE WORD 
          SX2    B3          IN = IN+1
          NZ     X7,WTC2     LOOP TO END OF LINE
          EQ     WTX=        EXIT 
  
          QUAL
          BASE   *
 WTC=     EQU    /CWTC/WTC
 SYS      TITLE  SYSTEM REQUEST SUBROUTINES.
          QUAL   CSYS 
          BASE   D
  
  
**        + + + + + + + + + + + + + + + + 
*         + SYSTEM REQUEST SUBROUTINES. + 
*         + + + + + + + + + + + + + + + + 
* 
* 
*         RCL - PLACE PROGRAM ON RECALL.
* 
*         EXIT   REQUEST PROCESSED. 
*         USES   X - 1, 6.
*                B - NONE.
*                A - 1. 
*         CALLS  SYS=.
  
  
 RCL1     LX6    42          PROCESS REQUEST
          RJ     SYS= 
 +        LD     A1,1        WAIT (RA+1) CLEAR
          NZ     X1,* 
 RCL      EQ     *+400000B   ENTRY/EXIT 
          LD     A1,1 
          NZ     X1,RCL      RETURN IF (RA+1) NOT CLEAR 
          LD     X6,3RRCL    FORM RECALL REQUEST
          EQ     RCL1 
 MSG      SPACE  4,6
**        MSG - SEND MESSAGE. 
* 
*         ENTRY  (X1) = ADDRESS OF MESSAGE. 
*                (X6) = 1/RECALL,59/0 
*         EXIT   RETURN WHEN OPERATION COMPLETE.
*         USES   X - 1, 2, 6. 
*                B - NONE.
*                A - 6. 
*         CALLS  SYS=.
  
 IS       IFSCOPE 
  
 MSG1     LX2    19          FORM *MSG* REQUEST 
          R=     X6,3RMSG*2 
          BX6    X6+X2
          LX6    41 
          RJ     SYS=        ISSUE REQUEST
 MSG      EQ     *+400000B   ENTRY/EXIT 
          MX2    -6          EXTRACT FLAGS
          BX2    -X2*X6 
          LX2    24D
          BX2    X1+X2       FLAGS + ADDRESS
          PL     X6,MSG1     IF NO AUTO-RECALL
          BX2    X2-X1       REMOVE ADDRESS 
          SX6    B1          ADD AUTO-RECALL BIT
          LX6    40 
          BX2    X2+X6
          SX6    X1          SET INDIRECT ADDRESS 
          LX6    30 
          SA6    MSGA 
          SX1    A6 
          BX2    X1+X2
          EQ     MSG1 
  
 MSGA     CON    0           INDIRECT MESSAGE ADDRESS 
  
 IS       ELSE
  
 MSG      EQ     *+400000B   ENTRY/EXIT 
          R=     X2,3RMSG 
          LX6    -19
          LX2    42 
          BX6    X1+X6
          BX6    X2+X6
          RJ     SYS=        CALL MSG 
          EQ     MSG         EXIT 
  
 IS       ENDIF 
  
 DB       IFTEST NE,IP.LDBG,0 
 SMSG     SPACE  4
**        SMSG - ISSUE STATUS MESSAGE.
* 
*         ENTRY  (A1) = ADDRESS OF MESSAGE
*                (X1) = FIRST WORD OF MESSAGE 
*         EXIT   MESSAGE ISSUED 
*         USES   X - 1, 2, 6. 
*                A - 1, 6.
*                B - NONE.
*         CALLS  SYS=.
  
  
 SMSG     EQ     *+400000B   ENTRY/EXIT 
          BX6    X1          MOVE MESSAGE INTO BUFFER 
          SA6    MSGL1
          SA1    A1+B1
          BX6    X1 
          SA6    A6+B1
          SA1    A1+B1
          BX6    X1 
          SA6    A6+B1
          SX6    MSGL1
          SX2    B1 
          SA1    B0 
          LX6    30 
          SA6    SMSGA       SET UP INDIRECT POINTER
          AX1    10 
          BX6    X1*X2       EXTRACT SWITCH 5 BIT 
          SA1    A6+B1
          LX6    24 
          BX6    X1-X6
          RJ     SYS=        ISSUE MESSAGE
          EQ     SMSG        EXIT 
  
 SMSGA    CON    **          INDIRECT MESSAGE POINTER 
 SMSG     IFCARD
 SMSGB    VFD    24/0LMSGP,12/1,6/0,18/SMSGA
 SMSG     ELSE
          RELOC  OFF
 SMSGB    VFD    24/0LMSGP,12/1,6/0 
          RVFD   18,/CSYS/SMSGA 
          RELOC  ON 
 SMSG     ENDIF 
  
 DB       ENDIF 
 DMP      SPACE  4
**        DMP - ISSUE *DMP* REQUEST 
* 
*         ENTRY  (X1) = FIRST *DMP* PARAMETER 
*                (X6) = SECOND *DMP* PARAMETER
*         EXIT   DUMP WRITTEN 
*         USES   X - 1, 6.
*                B - NONE.
*                A - 1, 6.
*         CALLS  SYS= 
  
  
 IS       IFSCOPE 
  
 DMP      EQ     *+400000B   ENTRY/EXIT 
          LX1    30 
          LX6    12 
          BX6    X1+X6
          SA6    DMPA        SET PARAMETER WORD 
          R=     X1,4RDMPP/16 
          LX1    40 
          SX6    A6 
          BX6    X1+X6
          RJ     SYS=        CALL DMP 
          EQ     DMP
  
 DMPA     CON    0           INDIRECT DUMP ADDRESS
  
 IS       ELSE
  
 DMP      EQ     *+400000B
          LX1    18 
          BX6    X1+X6
          R=     X1,4RDMPP/16 
          LX1    40 
          BX6    X6+X1
          RJ     SYS= 
          EQ     DMP
  
 IS       ENDIF 
 MEM      SPACE  4,6
 IC       IFCARD
  
**        MEM - ISSUE *MEM* REQUEST.   (*LOAD* ONLY)
* 
*              THIS SUBROUTINE IS USED FOR *MEM* CALLS TO MODIFY EITHER 
*         THE CM OR ECS FIELD LENGTH.  THE REQUEST IS ISSUED IN THE 
*         MANNER SO THAT *MEM* WILL NOT ABORT IF THE REQUESTED FL 
*         IS TOO LARGE AND CANNOT BE GRANTED. 
* 
*         ENTRY  (X1) = DESIRED FL. 
*                (X2) = 0 IF CM REQUEST.
*                       1 IF ECS REQUEST. 
*         EXIT   (X1) = DESIRED FL IF GRANTED.
*                     < 0 IF NOT GRANTED. 
*                (X2) = CM/ECS INDICATOR. 
*         USES   X - 3, 6, 7. 
*                B - NONE.
*                A - 1, 7.
*         CALLS  SYS=, AMU=.
  
  
 MEM      PS                 ENTRY/EXIT 
          R=     X3,4RMEMP/16      FORM *MEM* CALL WORD 
          MX6    -18         REMOVE SIGN EXTENSION
          BX3    -X6*X3 
          SX6    MEMCALL     ARGUMENT ADDRESS 
          R=     X2,X2+2     FLAG BIT TO RETURN STATUS
          LX3    36+4 
          LX2    18 
          BX6    X6+X3
          LX1    30          POSITION FL
          BX6    X6+X2
          BX7    X1 
          SA7    X6          STORE ARGUMENT 
          LX2    -18
          LX7    30 
          RJ     SYS=        MAKE RA+1 CALL 
          SX3    B1 
          BX3    X2*X3       SAVE CM/ECS FLAG 
          RJ     AMU=        ACCUMULATE MEMORY USED 
          SA1    A7          FETCH STATUS 
          AX1    30          COMPARE CURRENT FL WITH
          IX6    X1-X7       REQUESTED FL 
          BX2    X3          RESTORE CM/ECS FLAG
          ZR     X6,MEM      IF REQUEST GRANTED 
          MX1    1           RETURN WITH ERROR STATUS 
          EQ     MEM         EXIT 
  
 MEMCALL  CON    0           *MEM* ARGUMENT WORD
 K        IFNOS 
 SSM      SPACE  4,8
**        SSM - SECURE SYSTEM MEMORY CHECK. 
* 
*             THIS ROUTINE WILL CLEAR SSM STATUS BIT IF THE 
*         FOLLOWING CONDITIONS ARE ALL MET. 
*         1.  THE FILE WAS NOT EXECUTE ONLY.
*         2.  THE LOAD WAS NOT TERMINATED BY NOGO.
*         3.  THE LOAD IS NOT BEING ABORTED.
* 
*         USES   X - 1, 2.
*                A - 1. 
* 
*         CALLS  CFA, CPM=. 
  
  
 SSM      PS     0           ENTRY/EXIT 
          SA1    EX          EXECUTE FLAG 
          ZR     X1,SSM      IF LOAD TERMINATED BY *NOGO* 
          RJ     /MISC/CFA   CHECK FOR ABORT
          MI     X6,SSM      IF LOAD BEING ABORTED
          SA1    XEQOF       EXECUTE ONLY FILE FLAG 
          NZ     X1,SSM      IF EXECUTE ONLY FILE 
          SETSSM 0           CLEAR SSM STATUS 
          EQ     SSM         EXIT 
  
 K        ENDIF 
 IC       ENDIF 
  
 K        IFNOS 
          SPACE  4,8
**        CVL - CHECK VALIDATION INTERFACE PROCESSOR. 
* 
*              CALLS *CVL* TO PERFORM VALIDATION OF ON-LINE DIAGNOSTIC
*         USERS AND EQUIPMENT TO BE TESTED. 
* 
*         ENTRY  (X1) = ADDRESS OF PARAMETER BLOCK. 
*                (X2) = REQUEST.
* 
*         USES   X - 1, 2, 6. 
* 
*         CALLS  SYS=.
  
  
 CVL1     RJ     SYS=        MAKE SYSTEM REQUEST
 CVL      EQ     *+1S17      ENTRY/EXIT 
          MX6    -18
          BX1    -X6*X1 
          LX2    18 
          R=     X6,4RCVLP/16  SET *CVL* CALL 
          BX1    X2+X1       MERGE REQUEST
          LX6    40 
          BX6    X6+X1
          EQ     CVL1        MAKE CALL
  
 K        ENDIF 
  
          QUAL
          BASE   *
 SYS=     EQU    /CSYS/SYS
 RCL=     EQU    /CSYS/RCL
 WNB=     EQU    /CSYS/WNB
 MSG=     EQU    /CSYS/MSG
          IFTEST NE,IP.LDBG,0,1 
 SMS=     EQU    /CSYS/SMSG 
 DMP=     EQU    /CSYS/DMP
          IFCARD 1
 MEM=     EQU    /CSYS/MEM
          IFCARD 1
 SPYOFF   EQU    /CSYS/SPYOFF 
 K        IFNOS 
          IFCARD 1
 SSM      EQU    /CSYS/SSM
 CVL=     EQU    /CSYS/CVL
 K        ENDIF 
 ECS      IFTEST NE,IP.MECS,0 
          TITLE  ECS READ/WRITE SUBROUTINES.
          QUAL   ECS
  
  
**        + + + + + + + + + + + + + + 
*         + ECS TRANSFER ROUTINES.  + 
*         + + + + + + + + + + + + + + 
* 
* 
*              ALL ECS TRANSFERS BY THE LOADER ARE PROCESSED BY THE 
*         ROUTINES *RE*, *REW*, *WE*, AND *WEW*.  IN ALL CASES, 
*         REGISTERS A0 AND X0 ARE SAVED AS WITH THE CONVENTION
*         OBSERVED BY NEARLY ALL LOADER SUBROUTINES.  IF AN ECS ERROR 
*         OCCURS, A FATAL LOADER ERROR IS ISSUED. 
* 
*              THESE ROUTINES ARE A PART OF THE ECS CONDITIONAL CODE. 
 RE       SPACE  4,6
**        RE - READ ONE WORD FROM ECS.
* 
*         ENTRY  (X2) = ECS ADDRESS.
*         EXIT   (X1) = WORD FROM ECS.
*                (X2) = ECS ADDRESS.
*         USES   X - 3, 4.
*                B - NONE.
*                A - 1. 
*         CALLS  NONE.
  
  
 RE       PS                 ENTRY/EXIT 
          BX3    X0          SAVE X0 AND A0 
          SX4    A0 
          BX0    X2          (X0) = ECS ADDRESS 
          SA0    HOLD        (A0) = CM ADDRESS
 +        RE     B1          READ ONE WORD FROM ECS 
          EQ     ECRDERR     ECS ERROR EXIT 
          SA1    A0          (X1) = WORD
          BX0    X3          RESTORE X0 AND A0
          SA0    X4 
          EQ     RE          EXIT 
  
 ECRDERR  ERROR  CAT,(=C* ECS READ ERROR*)
  
 HOLD     CON    0           ECS BUFFER FOR ONE WORD
 WE       SPACE  4,6
**        WE - WRITE ONE WORD TO ECS. 
* 
*         ENTRY  (X2) = ECS ADDRESS.
*                (X6) = WORD TO BE WRITTEN. 
*         EXIT   (X2) = ECS ADDRESS.
*                (X6) = WORD. 
*         USES   X - 3, 4.
*                B - NONE.
*                A - 6. 
*         CALLS  NONE.
  
  
 WE       PS                 ENTRY/EXIT 
          BX3    X0          SAVE X0 AND A0 
          SX4    A0 
          SA6    HOLD        STORE WORD 
          BX0    X2          (X0) = ECS ADDRESS 
          SA0    A6          (A0) = CM ADDRESS
 +        WE     B1          WRITE ONE WORD TO ECS
          EQ     ECWRERR     ECS ERROR EXIT 
          BX0    X3          RESTORE X0 AND A0
          SA0    X4 
          EQ     WE          EXIT 
  
 ECWRERR  ERROR  CAT,(=C* ECS WRITE ERROR*) 
 REW      SPACE  4,6
**        REW - READ WORDS FROM ECS.
* 
*         ENTRY  (X1) = ECS FWA.
*                (X2) = CM FWA. 
*                (B2) = WORD COUNT. 
*         EXIT   ABOVE REGISTERS UNCHANGED, TRANSFER COMPLETE.
*         USES   X - 3, 4, 6, 7.
*                B - NONE.
*                A - NONE.
*         CALLS  NONE.
  
  
 REW      PS                 ENTRY/EXIT 
          BX3    X0          SAVE X0 AND A0 
          SX4    A0 
          BX0    X1          (X0) = ECS FWA 
          SA0    X2          (A0) = CM FWA
          SX6    B2          SAVE B2
          R=     X7,1777B 
 REW1     R=     B2,B2-1777B
          LE     B2,REW2     IF READ LESS THAN MAXIMUM
 +        RE     1777B       READ ECS 
 -        EQ     ECRDERR     IF ECS ERROR 
          IX0    X0+X7
          R=     A0,A0+1777B
          EQ     REW1 
  
 REW2     R=     B2,B2+1777B
 +        RE     B2          MOVE (B2) WORDS FROM (X0) TO (A0)
 -        EQ     ECRDERR     ECS ERROR EXIT 
          BX0    X3          RESTORE X0 AND A0
          SA0    X4 
          SB2    X6          RESTORE B2 
          EQ     REW         EXIT 
 WEW      SPACE  4,6
**        WEW - WRITE WORDS TO ECS. 
* 
*         ENTRY  (X1) = ECS FWA.
*                (X2) = CM FWA. 
*                (B2) = WORD COUNT. 
*         EXIT   ABOVE REGISTERS UNCHANGED, TRANSFER COMPLETE.
*         USES   X - 3, 4, 6, 7.
*                B - NONE.
*                A - NONE.
*         CALLS  NONE.
  
  
 WEW      PS                 ENTRY/EXIT 
          BX3    X0          SAVE X0 AND A0 
          SX4    A0 
          BX0    X1          (X0) = ECS FWA 
          SA0    X2          (A0) = CM FWA
          SX6    B2          SAVE B2
          R=     X7,1777B 
 WEW1     R=     B2,B2-1777B
          LE     B2,WEW2     IF WRITE LESS THAN MAXIMUM 
 +        WE     1777B       WRITE ECS
 -        EQ     ECWRERR     IF ECS ERROR 
          IX0    X0+X7
          R=     A0,A0+1777B
          EQ     WEW1 
  
 WEW2     R=     B2,B2+1777B
 +        WE     B2          MOVE (B2) WORDS FROM (A0) TO (X0)
 -        EQ     ECWRERR     ECS ERROR EXIT 
          BX0    X3          RESTORE X0 AND A0
          SA0    X4 
          SB2    X6          RESTORE B2 
          EQ     WEW         EXIT 
  
          QUAL
 RE=      EQU    /ECS/RE
 WE=      EQU    /ECS/WE
 REW=     EQU    /ECS/REW 
 WEW=     EQU    /ECS/WEW 
 ECS      ENDIF 
 KPP      IFNOS 
          QUAL   CLFM 
          BASE   D
  
**        LFM -  LOCAL FILE MANAGER PROCESSOR 
*             -  COPY OF KRONOS *COMCLFM* MODIFIED FOR CYBER LOADER 
* 
*         LFM PROCESSES REQUESTS FOR THE LOCAL FILE MANAGER 
*         PP PROGRAM *LFM*. 
* 
*         IF THE SPECIFIED FET IS BUSY, A FILE RECALL IS PERFORMED. 
* 
*         IF THE SPECIFIED FET IS BLANK, LFM RETURNS WITH NO ACTION 
*         TAKEN.
* 
*         ENTRY  (X2) = ADDRESS OF FET. 
*                (X7) = FUNCTION CODE.
* 
*         EXIT   (X2) = ADDRESS OF FET. 
* 
*         USES   X - 1, 6, 7. 
*                B - NONE.
*                A - 1. 
* 
*         CALLS  SYS= 
  
 LFM2     SX2    X2 
          RJ     =XSYS= 
  
 LFM=     PS                 ENTRY/EXIT 
          SA1    X2          CHECK FILE STATUS
          LX1    59-0 
          NG     X1,LFM1     IF NOT BUSY
          ZR     X1,LFM=     IF BLANK FET 
          RJ     =XWNB=      WAIT NOT BUSY
  
 LFM1     SA1    X2          SET FET BUSY 
          MX6    59 
          BX6    X6*X1
          SA6    A1 
          R=     X1,3RLFM 
          PX1 
          LX1    42 
          LX7    24 
          BX1    X1+X7
          BX6    X1+X2
          EQ     LFM2 
  
          BASE   *
          QUAL   *
 LFM=     EQU    /CLFM/LFM= 
 KPP      ENDIF 
  
 IC       IFCARD
 UPC      SPACE  4,10 
          QUAL   CUPC 
          BASE   D
  
  
***       UPC - UNPACK CONTROL CARD.
*         G. R. MANSFIELD.  70/12/12. 
*         F. E. TERHAAR-YONKERS.  80/06/01
 UPC      SPACE  4
***              UPC UNPACKS A CONTROL CARD TO INDIVIDUAL PARAMETERS. 
*         THE FOLLOWING CONDITIONS ARE NOTED. 
*         (1.)  IMBEDDED SPACES ARE IGNORED.
*         (2.)  THE CHARACTERS +-/=,($ ARE CONSIDERED AS PARAMETER
*                SEPARATORS.
*         (3.)  THE CHARACTERS ). ARE CONSIDERED AS THE TERMINATION OF
*                THE CONTROL CARD.
*         (4.)  CHARACTERS WITH DISPLAY CODE VALUES 0, OR 60B - 77B 
*                ARE ILLEGAL BEFORE THE TERMINATOR. 
*         (5.)  THE PARAMETER MUST CONTAIN 7 OR LESS CHARACTERS.
*         (6.)  THE PARAMETERS ARE STORED LEFT JUSTIFIED WITH ZERO
*                FILL.
*         (7.)   THE CHARACTER , WILL NOT BE PLACED IN THE LOWER
*                18 BITS OF THE KEYWORD PARAMETER.
*         (8.)  TWO SUCCESSIVE SEPARATORS OR A SEPARATOR FOLLOWED BY
*                A TERMINATOR RESULTS IN A PARAMETER OF ALL ZERO. 
*         (9.)  THE FIRST PARAMETER IS EXAMINED TO DETERMINE IF 
*                THE CONTROL STATEMENT IS TO BE UNPACKED IN NOS(A /)
*                OR SCOPE(PRODUCT SET) FORMAT 
* 
*         EXIT   (X6) = 0 IF NO ERROR DURING UNPACK.
*                (B6) = PARAMETER COUNT.
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6, 7.
*                B - 1, 2, 3, 4, 5, 6.
*                A - 1, 2, 4, 5, 6, 7.
* 
*         CALLS  NONE.
  
  
 UPC      PS                 ENTRY/EXIT 
          SB1    1
          SA5    //COMLDCC   ADDRESS OF CONTROL STATEMENT 
          MX0    6           CHARACTER MASK 
          SA1    A5          FIRST WORD OF CONTROL STATEMENT
          BX6    X0*X1
          LX6    6
          SX7    X6-1R/ 
          SA7    NFORM       FLAG ZERO IF NOS FORMAT
          ZR     X7,UPC0.01  IF FIRST CHARACTER A / 
          SX7    X6-1R$ 
          ZR     X7,UPC0.01  IF FIRST CHARACTER A $ 
          EQ     UPC0.3 
  
*         IF NOS FORMAT, MOVE THE STATEMENT ONE CHARACTER TO THE LEFT.
  
 UPC0.01  SB2    7
          SB3    B0 
 UPC0.1   BX6    -X0*X1 
          LX6    6
          EQ     B2,B3,UPC0.2  IF ALL DONE
          SB3    B3+B1
          SA1    A1+B1
          BX2    X0*X1       EXTRACT FIRST CHAR OF NEXT WORD
          LX2    6
          BX6    X6+X2       FINISHED WORD
          SA6    A1-B1       STORE FINISHED WORD
          EQ     UPC0.1 
  
 UPC0.2   SA6    A1          RESTORE FINAL WORD 
          SA5    A5          READ IN NEW FIRST WORD 
  
 UPC0.3   SB7    //COMARGS   ADDRESS TO PUT UNPACKED STATEMENT
          SB7    B7-B1
          SX3    4100B       (X3) = MASK FOR TERMINATORS
          SB5    60          (B5) = CONSTANT 60 
          MX0    -6          (X0) = CHARACTER MASK
          BX6    X6-X6       CLEAR ASSEMBLY 
          SB2    B5          CLEAR CHARACTER COUNT
          MX2    18          (X2) = EXCESS CHARACTER MASK 
          MX4    1           (X4) = CHARACTER COUNTER 
          SB6    B0          (B6) = ASSEMBLY INDEX
          EQ     UPC2        ENTER LOOP 
  
 UPC1     LX6    6           ADVANCE ASSEMBLY 
          SB2    B2-6 
          BX6    X6+X7
 UPC2     LX5    6           NEXT CHARACTER 
          BX7    -X0*X5 
          SB3    X7-1R9      CHECK CHARACTER
          LX4    6           ADVANCE DISASSEMBLY
          PL     X4,UPC3
          SX5    B6-//COMARGCT
          PL     X5,UPC5     IF TOO MANY ARGUMENTS
          SA5    A5+B1
 UPC3     ZR     X7,UPC5     IF CHARACTER = 00
          LT     B3,B1,UPC1  IF ALPHA/NUMERIC 
  
          SB4    X7-1R* 
          ZR     B4,UPC1     IF CHARACTER = * 
          SB4    X7-1R       CHECK CHARACTER
          ZR     B4,UPC2     IF CHARACTER = * * 
          BX1    X2*X6       CHECK ASSEMBLY 
          LX6    X6,B2       LEFT JUSTIFY ASSEMBLY
          NZ     X1,UPC5     IF > 7 CHARACTERS ASSEMBLED
          AX1    X3,B3       CHECK FOR TERMINATOR 
          SA7    UPCSVE      SAVE (X7)
          BX7    X4 
          SA7    A7+B1       SAVE (X4)
          SA4    NFORM       READ NOS FORMAT FLAG 
          ZR     X4,UPC3.1   IF NOS FORMAT
          SA4    A7-B1       RETRIEVE (X7)
          SX7    X4-1R+      COMPUTE TABLE REFERENCE
          SA4    TSEP+X7     READ SEPARATOR CODE
          BX6    X6+X4       INSERT SEPARATOR CODE
          SA4    UPCSVE 
          BX7    X4          RESTORE (X7) 
          SA4    A4+B1       RESTORE (X4) 
          EQ     UPC4 
  
 UPCSVE   BSS    2
  
 UPC3.1   SA4    UPCSVE 
          BX7    X4          RESTORE (X7) 
          SA4    A4+B1       RESTORE (X4) 
          EQ     B4,B1,UPC4  IF SEPARATOR = *,* 
          BX6    X6+X7       INSERT SEPARATOR 
 UPC4     NZ     B6,UPC4.1   IF NOT FIRST ARGUMENT
          SA6    //COMARGCT  STORE INTO ARGUMENT COUNT
          EQ     UPC4.2 
  
 UPC4.1   SA6    B7+B6       STORE ASSEMBLY 
 UPC4.2   SB2    B5          RESET ASSEMBLY 
          BX6    X6-X6
          LX1    59 
          SB6    B6+B1
          SA6    B7+B6       CLEAR LAST + 1 
          PL     X1,UPC2     LOOP IF NOT TERMINATOR 
          MX3    42 
          SA2    //COMARGCT 
          BX7    X3*X2       MASK OFF FILE NAME 
          SX2    B6-B1
          BX7    X7+X2       MERGE WITH ARGUMENT COUNT
          SA7    //COMARGCT  RESTORE INTO ARGUMENT COUNT
          SA2    NFORM       READ NOS FORMAT FLAG 
          NZ     X2,UPC      IF PRODUCT SET FORMAT
          SA2    A6-1        CLEAR TERMINATOR 
          BX7    X3*X2
          SA7    A2 
          EQ     UPC         RETURN 
  
 UPC5     SX6    B1          RETURN ERROR 
          SB6    B0 
          EQ     UPC
  
**        TSEP - TABLE OF PRODUCT SET SEPARATOR CODES 
* 
  
  
 TSEP     BSS    0
          LOC    0
          DATA   5B          *+*
          DATA   6B          *-*
          DATA   0           N/A
          DATA   3B          */*
          DATA   4B          *(*
          DATA   17B         *)*
          DATA   16B         *$*
          DATA   2B          *=*
          DATA   7B          * *
          DATA   1B          *,*
          DATA   17B         *.*
          BSSZ   15 
          DATA   10B         *;*
          CON    0           END OF TABLE 
          LOC    *O 
  
 NFORM    DATA   0
  
          BASE   *
          QUAL   *
 UPC=     EQU    /CUPC/UPC
  
 IC       ENDIF 
 CDD      TITLE  MISCELLANEOUS SUBROUTINES. 
          QUAL   MISC 
          BASE   D
  
  
**        + + + + + + + + + + + + + + + + 
*         + MISCELLANEOUS SUBROUTINES.  + 
*         + + + + + + + + + + + + + + + + 
* 
* 
*         CDD - CONSTANT TO DECIMAL DISPLAY CODE CONVERSION.
* 
*         G.R. MANSFIELD, 69/11/13. 
*         ADAPTED FROM SUBROUTINE *CONDEC* IN *COMPASS VER 2.0*.
* 
*              *CDD* CONVERTS UP TO TEN DIGITS TO DISPLAY CODE WITH 
*         LEADING ZERO SUPPRESSION.  CONVERSION CONTAINS SPACE FILL 
*         AND IS RIGHT JUSTIFIED. 
* 
*         ENTRY  (X1) = NUMBER TO BE CONVERTED. 
*         EXIT   (X6) = DPC CONVERSION. 
*                (B2) = 6*COUNT OF DIGITS IN (X6).
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5.
*                A - 2, 3, 4. 
*         CALLS  NONE.
  
  
 CDD1     DX6    X1*X2       COMPUTE QUOTIENT 
          FX1    X1*X2
          SB5    X1          SET NEXT DIGIT 
          LX4    60-6        SHIFT ASSEMBLY 
          SB2    B2+B4
          FX6    X6*X3       EXTRACT REMAINDER DIGIT
          SX7    X6+B3       CONVERT DIGIT
          IX4    X7+X4
          NZ     B5,CDD1     LOOP TO ZERO DIGIT 
          LX4    60-6        RIGHT JUSTIFY ASSEMBLY 
          LX6    X4,B2
 CDD      PS                 ENTRY/EXIT 
          SA2    CDDA        =.1P48+1 
          SA3    A2+B1       =10.P
          PX1    X1 
          SB2    B0          CLEAR JUSTIFY COUNT
          SA4    A3+B1       =1H
          LD     B3,1R0-1R   (B3) = CONVERSION CONSTANT 
          LD     B4,6        (B4) = SHIFT INCREMENT 
          EQ     CDD1 
  
          RELOC  OFF
 CDDA     CON    0.1000000001P48,10.0P0,1H
          RELOC  ON 
 COD      SPACE  4,8
**        COD - CONSTANT TO OCTAL DISPLAY CODE CONVERSION.
*         G.R. MANSFIELD.  69/12/05.
* 
*              UP TO TEN DIGITS ARE CONVERTED TO DISPLAY CODE WITH
*         LEADING ZERO SUPPRESSION.  CONVERSION CONTAINS SPACE FILL 
*         AND IS RIGHT-JUSTIFIED. 
* 
*         ENTRY  (X1) = NUMBER TO BE CONVERTED. 
*         EXIT   (X6) = DISPLAY CODE CONVERSION.
*                (B2) = 6*COUNT OF DIGITS IN (X6).
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4. 
*                A - 2. 
*         CALLS  NONE.
  
  
 COD      PS                 ENTRY/EXIT 
          SA2    CODA        =1H
          LD     B3,6        (B3) = SHIFT INCREMENT 
          MX4    -3          (X4) = DIGIT MASK
          SB2    B0          CLEAR JUSTIFY COUNT
          LD     B4,1R0-1R   (B4) = CONVERSION COUNT
 COD1     BX7    -X4*X1      EXTRACT DIGIT
          LX2    -6          SHIFT ASSEMBLY 
          SB2    B2+B3
          SX3    X7+B4       CONVERT DIGIT
          AX1    3           SHIFT OFF DIGIT
          IX2    X2+X3       ADD DIGIT TO ASSEMBLY
          NZ     X1,COD1     LOOP TO ZERO DIGIT 
          LX2    -6          RIGHT JUSTIFY ASSEMBLY 
          LX6    X2,B2
          EQ     COD         RETURN 
  
 CODA     DATA   1H 
 TCV      SPACE  4,8
**        TCV - TIME CONVERSION.
* 
*              THIS ROUTINE CONVERTS TIME INTO DECIMAL DISPLAY. 
*         LEADING ZEROES LEFT OF THE DECIMAL POINT ARE SUPPRESSED.
* 
*         ENTRY  (X1) =  VFD  24/JUNK,24/SEC,12/MSC 
*         EXIT   (X6) = DPC CONVERSION = *SSSSSS.MMM* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2. 
*                A - 2. 
*         CALLS  CDD. 
  
  
 TCV      PS                 ENTRY/EXIT 
          LX1    -12         MMXXXXSSSS 
          SA3    TCVA 
          SX2    X1          NOTE SECONDS ARE MODULO 1S18 
          AX1    -12
          R=     X6,1E3-1 
          PX2    X2 
          BX4    X1 
          DX2    X2*X3
          AX4    12          -0 IF MSEC .LT. 0, ELSE +0 
          BX4    X4*X6       0 OR 1E3-1 
          SB2    X6+B1
          IX3    X1+X4
          UX2    X2 
          SX7    X3+B2
          IX1    X7+X2       = SEC*(1E4) + 1E3 + MSEC 
          RJ     CDD         CONVERT DECIMAL DIGITS 
          LD     X1,1R.-1R1 
          LX1    3*6
          IX6    X1+X6       *SSSSSS.MMM* 
          EQ     TCV         EXIT 
  
          RELOC  OFF
 TCVA     CON    1.0E4P0
          RELOC  ON 
 SFN      SPACE  4,6
**        SFN - SPACE FILL NAME.
* 
*         G. R. MANSFIELD.  12/08/69. 
*         ADAPTED FROM ROUTINE DEVELOPED AT PURDUE UNIVERSITY.
* 
*              SFN APPENDS SPACE CODES (55B) TO A WORD. 
* 
*         ENTRY  (X1) = NAME LEFT JUSTIFIED, ZERO FILL. 
*         EXIT   (X6) = NAME SPACE FILLED.
*         USES   X - 2, 6, 7. 
*                B - 2. 
*                A - 2. 
*         CALLS  NONE.
  
  
 SFN      PS                 ENTRY/EXIT 
          SX7    B1 
          SA2    SFNA        =40404040404040404040B 
          IX7    X1-X7       FIND LOWEST BIT SET
          BX6    -X7+X1 
          LD     B2,60-5
          BX7    X2*X6       BUILD MASK OF NON-ZERO CHARACTERS
          SA2    A2+B1       =1H
          LX6    X7,B2
          IX6    X7-X6
          IX7    X7+X6
          BX2    -X7*X2 
          IX6    X1+X2
          EQ     SFN         RETURN 
  
          RELOC  OFF
 SFNA     CON    40404040404040404040B,1H 
          RELOC  ON 
 LFNCK    SPACE  4,6
**        LFNCK - CHECK NAME FORMAT.
* 
*              THIS ROUTINE VERIFIES THAT A NAME IS OF THE FORMAT 
*         ALLOWED FOR FILE NAMES AND LIBRARY NAMES.  CHECKS MADE ARE AS 
*         FOLLOWS 
* 
*                1) 1ST CHAR ALPHABETIC.
*                2) REMAINING CHARS ALPHANUMERIC. 
* 
*         ENTRY  (X1) = LFN LEFT JUSTIFIED ZERO FILL. 
*                       LOWER 18 BITS OF X1 ARE IGNORED AND MASKED OFF. 
*         EXIT   (X6) = LFN LEFT JUSTIFIED ZERO FILL, IF FORMAT IS OK 
*                     < 0 IF LFN IS BAD 
*                (X1) = UNCHANGED EXCEPT LOWER 18 BITS ARE CLEARED. 
*         USES   X - 2, 3, 4. 
*                B - 2. 
*                A - NONE.
*         CALLS  NONE.
  
  
 LFNCK    PS                 ENTRY/EXIT 
          MX2    42 
          SB2    B0          INITIALIZE CHAR COUNT
          BX1    X2*X1
          MX3    -6 
          BX2    X1 
          ZR     X1,LFNCK2   IF EMPTY NAME, FLAG ERROR
          BX6    X1          SAVE IN X6 FOR RETURN
 LFNCK1   LX2    6           LOOK AT NEXT CHAR
          BX4    -X3*X2 
          ZR     X4,LFNCK    IF NO MORE CHARS, EXIT 
          R=     X4,X4-1R+
          PL     X4,LFNCK2   IF NOT ALPHANUMERIC, FLAG ERROR
          SB2    B2+B1
          NE     B2,B1,LFNCK1      IF NOT 1ST CHAR
          R=     X4,X4+1R+-1R0
          NG     X4,LFNCK1   IF 1ST CHAR ALPHABETIC 
 LFNCK2   MX6    1           SET ERROR FLAG FOR RETURN
          EQ     LFNCK       EXIT 
 EPNCK    SPACE  4,6
**        EPNCK - CHECK NAME FORMAT.
* 
*              THIS ROUTINE VERIFIES THAT A NAME IS OF THE FORMAT 
*         ALLOWED FOR ENTRY POINT OR PROGRAM NAMES.  CHECKS MADE
*         ARE AS FOLLOWS:                                                      .
* 
*                1) THE NAME IS NOT EMPTY.
*                2) NO EMBEDDED CHARACTERS OF DISPLAY CODE VALUE OF ZERO
*                   (COLON) ARE PRESENT.
* 
*         ENTRY AND EXIT CONDITIONS ARE THE SAME AS WITH *LFNCK*. 
*         USES   X - 2, 3, 4. 
*                B - 2. 
*                A - NONE.
*         CALLS  NONE.
  
  
 EPNCK    PS                 ENTRY/EXIT 
          MX2    42 
          R=     B2,7        (B2) = NO. OF CHARS YET TO CHECK 
          BX1    X2*X1
          ZR     X1,EPNCK3   ERROR IF NAME IS EMPTY 
          MX3    -6 
          BX6    X1          X6 FOR RETURN
          BX2    X1 
          LX2    -18         RIGHT JUSTIFY
 EPNCK1   BX4    -X3*X2      NEXT CHAR
          SB2    B2-B1
          AX2    6
          ZR     X4,EPNCK1   LOOP UNTIL RIGHT-MOST NZ CHAR
 EPNCK2   ZR     B2,EPNCK    IF NO MORE CHARS, EXIT 
          BX4    -X3*X2      MUST NOT BE ANY MORE ZERO CHARS
          SB2    B2-B1
          AX2    6
          NZ     X4,EPNCK2   IF THIS CHAR IS NON-ZERO 
 EPNCK3   MX6    1           SET ERROR FLAG FOR RETURN
          EQ     EPNCK       EXIT 
 CALL     SPACE  4
**        CALL - CALL SUBROUTIME AT VARIABLE ADDRESS. 
* 
*         ENTRY  (B4) = SUBROUTINE ENTRY ADDRESS +1 
*         USERS  X - 4, 7.
*                B - NONE.
*                A - 4, 7.
  
  
 CALL     EQ     *+400000B   ENTRY
          SA4    CALL 
          BX7    X4 
          SA7    B4-B1       SET SUBROUTINE RETURN ADDRESS
          BR     B4          ENTER IT 
 IC       IFCARD
 CFA      SPACE  4
*         CFA - CHECK FOR ABORT.
* 
*              THIS ROUTINE RETURNS AN INDICATION OF WHETHER THE LOADER 
*         SHOULD ABORT OR CONTINUE, BASED ON THE PRESENCE OF FATAL OR 
*         NON-FATAL ERRORS, AND BASED ON THE LDSET,ERR= OPTION. 
* 
*         ENTRY  FE     = FATAL ERROR COUNT.
*                NE     = NON-FATAL ERROR COUNT.
*                NEWERR = FATAL ERROR CODE IF ERROR ON NEXT OVERLAY 
*                         DIRECTIVE.
* 
*         EXIT   X6 =  0 IF NOT TO ABORT.  THAT IS, IF THERE ARE NO 
*                        ERRORS, OR IF ONLY NON-FATAL ERRORS AND
*                        ERR=ALL NOT SELECTED.
*                   =  1 IF TO TERMINATE THE LOAD, BUT ISSUE AN *END*.
*                        THAT IS, IF THERE ARE FATAL ERRORS, AND
*                        ERR=NONE SELECTED. 
*                   = -1 IF TO TERMINATE THE LOAD, AND ABORT.  THAT IS, 
*                        IF EITHER THERE ARE FATAL ERRORS AND ERR=NONE
*                        NOT SELECTED, OR ONLY NON-FATAL ERRORS AND 
*                        ERR=ALL SELECTED.
* 
*         USES   X - 1, 2, 6. 
*                B - NONE.
*                A - 1, 2.
* 
*         CALLS  NONE.
  
  
 CFA      EQ     *+1S17      ENTRY/EXIT 
          SA1    EP          LDSET ERR= OPTION
          BX6    X1          2 IF NONE, 1 IF FATAL, 0 IF ALL
          SA1    NEWERR 
          SA2    FE 
          BX1    X1+X2       NZ IF ANY FATAL ERRORS 
          SA2    NE 
          BX2    X1+X2       NZ IF ANY ERRORS, FATAL OR NON-FATAL 
          ZR     X2,CFA2     IF NO ERRORS 
          NZ     X1,CFA1     IF FATAL ERRORS
          NZ     X6,CFA2     IF NOT ERR=ALL 
          EQ     CFA4        NON-FATAL ERRORS AND ERR=ALL - ABORT 
  
 CFA1     SX6    X6-2        =0 IF ERR=NONE 
          ZR     X6,CFA3     IF FATAL ERRORS AND ERR=NONE 
          EQ     CFA4        FATAL ERRORS AND NOT ERR=NONE
  
 CFA2     MX6    0           CONTINUE ON FLAG 
          EQ     CFA         RETURN 
  
 CFA3     SX6    B1          STOP LOAD AND END FLAG 
          EQ     CFA         RETURN 
  
 CFA4     MX6    -1          STOP LOAD AND ABORT FLAG 
          EQ     CFA         RETURN 
 IC       ENDIF 
 IOERR    SPACE  4,8
**        IOERR - PROCESS I/O ERROR.
* 
*              THIS ROUTINE IS CALLED IN SEVERAL PLACES WITHIN THE
*         VARIOUS I/O ROUTINES TO CHECK IF AN ERROR CODE HAS BEEN 
*         RETURNED TO BITS 9-13 OF THE FIRST WORD OF THE APPROPRIATE
*         *FET*.  THE ROUTINE RETURNS IMMEDIATELY IF THERE IS NO ERROR, 
*         OR IF AN ERROR CODE OF ONE (1) FOR EOI IS PRESENT.
*              THE ENTRY, EXIT CONDITIONS, AND REGISTER USAGE APPLY 
*         ONLY FOR SUCH A RETURN. 
* 
*         ENTRY  (X2) = FWA OF *FET*. 
*         EXIT   (X1) = CONTENTS OF FIRST WORD OF *FET*.
*                (X2) = FWA OF *FET*. 
*                (A1) = FWA OF *FET*. 
*         USES   X - 1, 6.
*                B - NONE.
*                A - 1. 
*         CALLS  NONE.
* 
*         PROCEDURE - 
* 
*             1) THE ERROR STATUS FIELD IS EXAMINED, AND AN IMMEDIATE 
*                EXIT IS MADE UNLESS AN ERROR CODE OF TWO (2) OR
*                GREATER IS PRESENT.
* 
  
 IOERR    PS                 ENTRY / EXIT 
          SA1    X2          FETCH FET(0) 
          MX6    -5          ISOLATE ERROR CODE FIELD 
          LX1    -9 
          BX6    -X6*X1 
          LX1    9           RESTORE FET(0) 
          R=     X6,X6-2     IGNORE EOI 
          NG     X6,IOERR    EXIT IF NO ERROR 
  
**            2) THE FOLLOWING DAYFILE MESSAGES ARE ISSUED -
* 
*                       LOADER I/O ERROR (NUMBER) 
*                       FILE --- (NAME) 
* 
  
 IC       IFCARD
          SA1    DFMFLAG     DAYFILE FINAL COMMAND IF NECESSRY
          NZ     X1,IOERR0   IF MESSAGE ALREADY ISSUED
          BX3    X2          SAVE X2
          BX4    X6          SAVE X6
          SX6    B1 
          SA6    A1 
          IFNOS  1
          MESSAGE  COMLDCC,R  DAYFILE THE COMMAND 
          IFSCOPE  1
          MESSAGE  COMLDCC,R,6  DAYFILE THE COMMAND (NOT TO TERMINAL) 
          BX2    X3          RESTORE X2 
          BX6    X4          RESTORE X6 
 IOERR0   BSS    0
 IC       ENDIF 
          MX3    -3          INSERT ERROR CODE IN MESSAGE 
          SX4    B1+B1
          IX7    X6+X4       ERROR CODE 
          BX5    X3*X7       UPPER 2 BITS 
          BX3    -X3*X7      LOWER 3 BITS 
          LX5    3
          IX6    X5+X3
          SX1    =28L --- LOADER I/O ERROR 00 
          R=     A4,X1+2
          LX6    -24
          BX5    X2          SAVE *FET* ADDRESS 
          IX6    X6+X4       INSERT ERROR CODE
          SA6    A4 
          MX0    7*6         (X0) = 7-CHAR MASK 
          SB7    X7          (B7) = ERROR CODE
          MESSAGE X1,RCL     ISSUE I/O ERROR MESSAGE
          SA3    X5          FETCH FILE NAME
          BX1    X0*X3
          RJ     SFN=        SPACE FILL 
          MX4    48          FORM ZERO BYTE AT END
          SX1    =20H FILE ---
          BX6    X4*X6
          SA6    X1+B1       INSERT NAME
          MESSAGE X1,RCL     ISSUE FILE NAME MESSAGE
  
**            3) IF THE ERROR OCCURRED WHILE ACCESSING A SYSTEM LIBRARY 
*                FILE, THE FOLLOWING MESSAGE IS ISSUED -
* 
*                       LIBRARY- (NAME) 
* 
  
          SA1    =0LZZZZZDF 
          SA2    X5          (X2) = FILE NAME 
          BX3    X1-X2
          MX7    5*6
          BX3    X0*X3
          ZR     X3,IOERR4   IF *ZZZZZDF* 
          BX3    X7*X3       CHECK IF 1ST 5 CHARS = *ZZZZZ* 
          SB6    -B1         (B6) = -1
          NZ     X3,IOERR1   IF NOT A SYSTEM LIBRARY FILE 
          SA1    /SLD/LIBNAME      FETCH LIBRARY NAME 
          RJ     SFN=        SPACE FILL 
          SX1    =20H LIBRARY-
          BX6    X4*X6       FORM ZERO BYTE AT END
          SA6    X1+B1       INSERT NAME
          MESSAGE X1,RCL     ISSUE LIBRARY NAME MESSAGE 
  
**            4) IF THE ERROR OCCURRED DURING ONE OF THE TYPES OF READ
*                OPERATIONS, THE FOLLOWING MESSAGE IS ISSUED -
* 
*                       PROGRAM- (NAME) 
* 
  
 IOERR1   SA2    X5+B6       FETCH LAST *CIO* CODE ISSUED 
          SB2    X2 
          R=     B3,READ
          R=     B4,READNS
          R=     B5,READLS
          SA1    PN          NAME OF LAST PROGRAM ENCOUNTERED 
          ZR     X1,IOERR3   IF PROGRAM NAME NOT KNOWN
          EQ     B2,B3,IOERR2      IF *READ*
          EQ     B2,B4,IOERR2      IF *READNS*
          NE     B2,B5,IOERR4      IF NOT ANY TYPE OF READ
 IOERR2   SX3    =20H PROGRAM-
          RJ     SFN=        SPACE FILL 
          BX6    X4*X6       FORM ZERO BYTE AT END
          SA6    X3+B1       INSERT NAME
          MESSAGE X3,RCL     ISSUE PROGRAM NAME MESSAGE 
 IOERR3   BSS    0
  
**            5) THE LOAD IS ABORTED AT THIS POINT. 
  
 IOERR4   BSS    0
 DEI      IFSCOPE 
          R=     X7,2030B    CALL *LDL* TO DROP EDITLIB INTERLOCK 
          SA7    T1 
          LDL    A7 
 DEI      ENDIF 
          ERROR  CAT,B0      ABORT LOAD 
  
          QUAL
          BASE   *
 CDD=     EQU    /MISC/CDD
 COD      EQU    /MISC/COD
 TCV=     EQU    /MISC/TCV
 SFN=     EQU    /MISC/SFN
 IOERR=   EQU    /MISC/IOERR
 CALL     EQU    /MISC/CALL 
 ATS      TITLE  TABLE MANAGEMENT SUBROUTINES.
          QUAL   TMGR 
  
**        + + + + + + + + + + + + + + + + + 
*         + TABLE MANAGEMENT SUBROUTINES. + 
*         + + + + + + + + + + + + + + + + + 
* 
* 
*         ATS - ALLOCATE TABLE SPACE. 
* 
*              THIS ROUTINE ADDS REQUESTED SPACE TO A MANAGED TABLE.  IF
*         NECESSARY, TABLES ARE MOVED.  NO SINGLE TABLE WILL EVER RUN 
*         OUT OF SPACE UNLESS ALL TABLES RUN OUT OF SPACE.
* 
*         ENTRY  (A2) = TABLE FWA POINTER.
*                (X1) = CHANGE (+ OR -) TO TABLE SIZE.
*         EXIT   (A2) = TABLE FWA POINTER.
*                (X1) = CHANGE. 
*                (X2) = FWA OF TABLE. 
*                (X3) = ADDRESS OF NEW SPACE. 
*                (X4) = PREVIOUS LENGTH.
*                (X6) = NEW LENGTH. 
*         SAVES  X - 0, 1, 5. 
*                B - ALL. 
*                A - 0, 2, 5. 
*         CALLS  AMU, MVE, (ROUTINE SPECIFIED IN *TO*). 
* 
  
 ATS      PS                 ENTRY / EXIT 
          SA2    A2          CURRENT FWA
          SA4    A2+B1       CURRENT LENGTH 
          IX6    X4+X1       SET NEW LENGTH 
          SA3    A4+B1       NEXT TABLE FWA 
          IX7    X3-X2       CHECK ROOM BETWEEN TABLES
          SA6    A4 
          IX7    X6-X7
          IX3    X2+X4       (X3) = FWA NEW SPACE 
          MI     X7,ATS      RETURN IF ROOM FOR CHANGE + 1 WORD 
          SX7    X4          RESTORE PREVIOUS LENGTH
  
*         INITIALIZE FOR TABLE MOVE.
  
          BX6    X0          SAVE (X0)
          SA7    A4 
          SA6    ATSB 
          BX7    X1          SAVE (X1)
          LX6    X5          SAVE (X5)
          SA7    A6+B1
          SA6    A7+B1
          SX7    B2          SAVE B REGISTERS 
          SX6    B3 
          SA7    A6+B1
          SA6    A7+B1
          SX7    B4 
          SX6    B5 
          SA7    A6+B1
          SA6    A7+B1
          SX7    B6 
          SX6    B7 
          SA7    A6+B1
          SA6    A7+B1
          SX7    A0          SAVE (A0)
          SA7    A6+B1
          SA0    A2          (A0) = TABLE POINTER 
  
*         COMPUTE REMAINING TABLE SPACE.
  
 ATS1     SA3    TN          (B2) = NUMBER OF TABLES
          SA1    ATSB+1      (X1) = INCREASE
          SB2    X3 
          IX4    X1+X3       LENGTH = NO. OF TABLES + INCREASE
          SB3    B2+B2       (B3) = (NUMBER OF TABLES)*2
          SB4    B1+B1
 ATS2     SB3    B3-B4       LENGTH = LENGTH + TABLE LENGTH 
          SA3    B3+FTAB-1
          IX4    X4+X3
          GT     B3,B4,ATS2  LOOP FOR ALL TABLES
          SA2    LM          SET AVAILABLE LENGTH 
          SB2    B2+B2       (B2) = (NUMBER OF TABLES)*2
          SB4    X4          (B4) = TOTAL ASSIGNED LENGTH 
          SA3    B2+FTAB-2
          IX6    X3-X2
          IX7    X6-X4
          BX0    X3          (X0) = FWA(I+1) FOR ASSIGNING SPACE
          SB5    X7          (B5) = LENGTH AVAILABLE
          IFCARD 2
          SA1    MT          MEMORY THRESHOLD FOR INCREASING FL 
          IX7    X7-X1
          SB7    B1+B1
          MI     X7,ATS7     IF NO REMAINING SPACE
          SA3    FTAB        SET OFFSET FOR FIRST TABLE 
          MX7    30 
          IX4    X2-X3       OFFSET 
          SA1    ATSB+1      INCREMENT SIZE OF REQUESTED TABLE
          LX4    30 
          SA2    A0+B1
          BX4    X7*X4
          IX6    X2+X1
          BX7    X3+X4
          SA6    A2 
          SA7    A3 
  
**        WHEN TABLES HAVE TO BE MOVED, THE FOLLOWING OCCURS -
* 
*         1) ALL TABLES, EXCEPT THE LOWEST, HAVE THE NEW FWA COMPUTED 
*            SO THAT THE FREE SPACE LEFT ABOVE EACH TABLE WILL BE 
* 
*                S = (LA/2N) + ((TL*LA)/2)/AL + 1 
* 
*                WHERE  S  = SPACE ABOVE TABLE. 
*                       LA = TOTAL FREE SPACE.
*                       N  = NUMBER OF TABLES EXCLUDING DUMMY AT END. 
*                       TL = LENGTH OF TABLE. 
*                       AL = TOTAL ASSIGNED LENGTH. 
* 
*         2) THEN ALL TABLES WILL BE MOVED TO THEIR NEW POSITIONS.
*            THIS IS ACCOMPLISHED BY STARTING AT THE LAST TABLE AND 
*            MOVING ALL TABLES WHICH MOVE UP.  THEN STARTING AT THE 
*            FIRST TABLE MOVE ALL TABLES WHICH MOVE DOWN. 
  
          SB6    B2-B7       I = INDEX TO LAST TABLE
 ATS5     SB6    B6-B7       I = I - 2
          SA2    B6+FTAB     FWA(I) 
          SX4    B5          LA (LENGTH AVAILABLE)
          SA1    A2+B1       TL (LENGTH OF TABLE) 
          SX3    B2-B1
          AX3    1           N (NUMBER OF TABLES) 
          AX5    X4,B1       LA/2 
          IX6    X4/X3,B3    L1 = LA/N
          SX3    B4          AL (TOTAL ASSIGNED LENGTH) 
          IX7    X5*X1       (LA/2)*TL
          AX6    1           L1 = LA/2N 
          IX7    X7/X3,B3    L2 = ((TL*LA)/2)/AL
          SX1    X1+B1       TL + 1 
          IX6    X6+X7       L = L1 + L2
          IX4    X0-X6       FWA(I+1) - L 
          IX7    X4-X1       FWA(I) = FWA(I+1) - L - TL -1
          IX6    X7-X2       OFFSET TO NEW FWA
          MX3    30 
          LX6    30          ADD OFFSET TO FWA WORD 
          BX6    X3*X6       REMOVE SIGN EXTENSION IF ANY 
          LX0    X7          FWA(I+1) = FWA(I)
          BX6    X6+X2
          SA6    A2          30/OFFSET,30/OLD FWA 
 ATS6     NE     B6,B7,ATS5  LOOP 
          SA1    ATSB+1 
          SA2    A0+B1
          SB6    B2-B7
          IX6    X2-X1
          SA6    A2          REMOVE INCREASE
 ATS6.1   SB6    B6-B7
          SA3    B6+FTAB
          SX2    X3          SOURCE 
          NG     X3,ATS6.2   IF TABLE IS TO BE MOVED DOWN 
          AX3    30 
          IX6    X2+X3       NEW FWA = DESTINATION
          ZR     X3,ATS6.2   IF TABLE IS NOT MOVING 
          SA1    A3+B1
          SA6    A3 
          SX1    X1+B1       MOVE EXTRA WORD AT END OF TABLE
          MOVE   X1,X2,X6    MOVE TABLE 
 ATS6.2   NE     B6,B7,ATS6.1  LOOP MOVING TABLES UPWARD
          SB2    B2-B7
          SB6    B0 
 ATS6.3   GE     B6,B2,ATS6.4  IF NO MORE TABLES TO MOVE DOWN 
          SA3    B6+FTAB
          SB6    B6+B7
          PL     X3,ATS6.3   IF TABLE ALREADY MOVED 
          SX2    X3          SOURCE 
          SA1    A3+B1
          AX3    30 
          IX6    X3+X2       NEW FWA = DESTINATION
          SA6    A3 
          SX1    X1+B1       MOVE EXTRA WORD AT END OF TABLE
          MOVE   X1,X2,X6    MOVE TABLE 
          EQ     ATS6.3 
  
*         RESTORE REGISTERS.
  
 ATS6.4   SA3    A0+B1       ADD INCREASE BACK TO SPECIFIED TABLE 
          SA1    ATSA        COUNT TABLE MOVES
          SX6    X1+B1
          SA6    A1 
          SA2    ATSB        RESTORE (X0) 
          SA1    A2+B1       RESTORE (X1) = CHANGE
          IX6    X3+X1
          SA6    A3          ADD INCREASE TO TABLE
          BX0    X2 
          SA3    A1+B1       RESTORE (X5) 
          SA2    A3+B1       RESTORE B REGISTERS
          BX5    X3 
          SB2    X2 
          SA3    A2+B1
          SB3    X3 
          SA4    A3+B1
          SB4    X4 
          SA2    A4+B1
          SB5    X2 
          SA3    A2+B1
          SB6    X3 
          SA4    A3+B1
          SB7    X4 
          SA2    A0          (A2) = POINTER, (X2) = FWA 
          SA3    A4+B1       RESTORE (A0) 
          SA0    X3 
          SA4    A2+B1       (X4) = PREVIOUS LENGTH 
          BX6    X4          (X6) = NEW LENGTH
          IX4    X4-X1
          IX3    X2+X4       (X3) = FWA NEW SPACE 
          EQ     ATS         RETURN 
  
**             IF NOT ENOUGH FREE SPACE EXISTS TO MAKE THE REQUESTED
*         INCREASE, THE FOLLOWING STEPS ARE ATTEMPTED - 
* 
*         1) A SMALL AMOUNT OF SPACE CAN BE GAINED IF IT IS POSSIBLE
*            TO OVERWRITE THE REMAINDER OF THE *LOADC* CODE AT THIS 
*            TIME.  THE FLAG *MM* TELLS WHETHER OR NOT THIS CAN BE DONE.
* 
  
 ATS7     SA2    MM 
          NZ     X2,ATS8     IF *LOADC* CANNOT BE OVERWRITTEN 
          MI     X2,ATS8     IF *LOADC* ALREADY OVERWRITTEN 
          IFNOS  2
          SA3    SLDACT 
          NZ     X3,ATS8     IF *SLD* ACTIVE
          SX3    LOCC        NEW FWA OF BUFFERS 
          MX6    60          FLAG *LOADC* AS OVERWRITTEN
          SA6    A2 
          RJ     MTO=        MOVE TABLE ORIGIN
          EQ     ATS1        TRY TABLE MOVE AGAIN 
  
 ATS8     BSS    0
  
**        2) THE NEXT STEP IS TO INCREASE THE FIELD LENGTH.  THIS 
*            IS NOT DONE FOR USER-CALL LOADS UNLESS *CMM* IS ACTIVE 
*            AND NO FWA/LWA WERE GIVEN IN THE ORIGINAL USER CALL. 
* 
*         AS MANY MULTIPLES OF THE STANDARD FL INCREASE FACTOR
*         (IP.FLINC) ARE SELECTED AS REQUIRED TO CONTAIN THE AMOUNT 
*         OF ADDITIONAL SPACE NEEDED (CURRENT CONTENTS OF X6).  THIS
*         AMOUNT IS THEN COMPARED WITH THE MAXIMUM FL.  IF GREATER, THE 
*         MAXIMUM WILL BE REQUESTED IF IT IS ENOUGH;  IF NOT, THE LOAD
*         WILL BE ABORTED.
* 
  
          R=     B2,IP.FLINC (B2) = BASIC UNIT OF FL INCREASE            LDR0172
          SA3    FL          (X3) = CURRENT FL
          BX6    -X7         (X6) = AMOUNT NEEDED 
          SB3    B0          (B3) = AMOUNT BY WHICH TO INCREASE 
          SB4    X6          (B4) = AMOUNT NEEDED DUE TO TABLES 
 UPFL     SB3    B3+B2
          LT     B3,B4,UPFL  GET SMALLEST MULTIPLE OF (B2)
          SX2    B3 
  
 OVERFLOW IFCARD
          IX1    X3+X2       ADD IT TO CURRENT FL 
          SA2    MFL         (X2) = MAXIMUM FL
          IX7    X2-X1       MAXIMUM FL - NEW REQUEST 
          PL     X7,CALLMEM  IF REQUEST ATTAINABLE
          IX7    X3+X6       CURRENT FL + REQUIREMENT 
          IX7    X2-X7       MAXIMUM FL - REQUIREMENT 
          MI     X7,ATS9     IF WE CANT GET ENOUGH TO CONTINUE, ABORT 
          BX1    X2          REQUEST MAXIMUM AVAILABLE
          IX7    X1-X3       NEW FL - OLD FL
          SB3    X7          (B3) = AMOUNT OF INCREASE
 CALLMEM  MX2    0           CM/ECS FLAG FOR *MEM*
          RJ     MEM=        ISSUE REQUEST TO *MEM* 
          MI     X1,ATS9     IF REQUEST NOT GRANTED 
          BX7    X1          SET FOR NEW FL 
          SA7    A3 
          R=     X7,X7-TABOO SET HIGH MEMORY ADDRESS
          SA7    TEND 
          EQ     ATS1        GO PERFORM TABLE MOVE
  
 OVERFLOW ELSE
          SA3    PLDP 
          ZR     X3,ATS9     IF NO *PILOAD* PARAM BLOCK 
          SA3    X3+B1
          ZR     X3,ATS9     IF *CMM.GLF* NOT AVAILABLE 
          SA4    FL                                                      LDR0234
          IX6    X4+X2                                                   LDR0234
          SA6    A4          UPDATE *FL* = LWA+1 OF LOADABLE AREA        LDR0234
          SA4    TEND 
          IX6    X2+X4       UPDATE *TEND* (=LWA+1-TABOO) FOR NEW MEMORY
          SA6    A4 
          SX1    BASE        (X1) = FWA OF BLOCK
          SB2    A5          SAVE A5 REGISTER 
          CALL   X3          CALL *CMM.GLF* TO GROW BLOCK 
          BX1    X5          SAVE X5
          SA5    B2          RESTORE A5 
          LX5    X1          RESTORE X5 
          EQ     ATS1 
  
 OVERFLOW ENDIF 
  
 ATS9     SA4    TO          PROCESS TABLE OVERFLOW 
          IFCARD 4
          SA2    MT 
          SX6    B0 
          SA6    A2          RESET THRESHOLD TO ZERO
          NZ     X2,ATS1     IF THRESHOLD WAS NOT ZERO
          SB2    X4 
          BR     B2 
  
 ATSA     CON    0           COUNT OF TABLE MOVES 
  
 ATSB     CON    0,0,0       (X0, X1, X5) SAVE
          CON    0,0,0,0,0,0 (B2 - B7) SAVE 
          CON    0           (A0) SAVE
  
          ORG    ATSB 
 COPYRGHT DATA   C/ CONTROL DATA PROPRIETARY PRODUCT /
          DATA   C/ COPYRIGHT CONTROL DATA CORP. 1976, 1977, 1978,/ 
          DATA   C/ 1979, 1980, 1981, 1982./
          ORG    ATSB+10
 TOV      SPACE  4,8
**        TOV - PROCESS TABLE OVERFLOW. 
* 
*              THIS IS THE EXIT TAKEN IF REQUIRED TABLE SPACE CANNOT BE 
*         OBTAINED.  A FATAL ERROR IS ISSUED.  IT IS ENTERED ONLY AFTER 
*         THOSE ACTIONS DESCRIBED ABOVE HAVE FAILED.  IT GETS CONTROL 
*         BECAUSE ITS STARTING ADDRESS IS STORED IN THE LOCATION *TO*.
*         THE FATAL ERROR CAN BE AVOIDED BY STORING ANOTHER ADDRESS 
*         IN *TO*, WHICH IS, IN FACT, EXACTLY WHAT IS DONE AT MAP TIME. 
* 
*              THIS ROUTINE MUST NOT BE CALLED TWO CONSECUTIVE TIMES
*         DUE TO THE HANDLING OF *TERR*.  THEREFORE, IT SETS *TO* SO
*         THAT CONTROL WILL GO TO *CPL12* IF ANOTHER TABLE OVERFLOW 
*         OCCURS (I.E., DURING ERROR PROCESSING). 
* 
*              DO NOTE THAT REGISTERS ARE NOT RESTORED PRIOR TO 
*         TAKING THE ERROR EXIT.
  
  
 TOV      SA5    ATSB+1      AMOUNT REQUESTED 
          RJ     AMU         ACCUMULATE MEMORY USED 
          IX6    X1+X5       (AMOUNT REQUESTED) + (CURRENT SPACE) 
          SA6    A6          = VALUE TO SHOW IN MAP 
          SA3    TERR        REDUCE THE SIZE OF *TERR* BY THE 
          SA2    A3+B1       2 EXTRA WORDS PLACED IN IT DURING
          SX4    B1+B1       INITIALIZATION.  ONE WORD ALLOWS 
          IX6    X3+X4       FOR THE ENTRY MADE BELOW, AND THE
          SA6    A3          OTHER ALLOWS FOR ANOTHER ENTRY 
          IX6    X2-X4       FOR EITHER *EMPTY LOAD* OR *NO 
          SA6    A2          TRANSFER ADDRESS*
          ERROR  100         ---- INSUFFICIENT FL FOR LOAD
          SX6    CPL12       GO TO MAP PROCESSING IF TABLE OVERFLOW 
          SA6    TO           OCCURS WHILE IN ERROR PROCESSING
          EQ     ABEND       GO TO STANDARD FATAL ERROR EXIT
  
 ATF      SPACE  4,6
**        ATF - ALLOCATE TABLE AT THE FRONT.
* 
*              THIS ROUTINE IS THE SAME AS *ATS*, EXCEPT THE NEW
*         WORDS ARE ADDED TO THE FRONT OF THE TABLE.  WORDS ARE 
*         REMOVED FROM THE FRONT IF (X1) IS NEGATIVE. 
* 
*              NOTE - THIS ROUTINE MUST NOT BE USED FOR THE 1ST TABLE.
* 
*         ENTRY  SAME AS FOR *ATS*. 
*         EXIT   SAME AS FOR *ATS*. 
*         SAVES  SAME AS FOR *ATS*. 
*         CALLS  ATS. 
  
  
 ATF      PS                 ENTRY / EXIT 
          SA2    A2          CURRENT FWA
          SA3    A2-B1       LENGTH OF NEXT LOWER TABLE 
          SA4    A3-B1       FWA OF NEXT LOWER TABLE
          IX7    X3+X1       CHECK ROOM BETWEEN TABLES
          IX4    X2-X4
          IX4    X7-X4
          MI     X4,ATF1     IF ROOM FOR CHANGE + 1 WORD
          ALLOC  A4,X1       ADD NEEDED SPACE TO NEXT LOWER TABLE 
          BX6    X4          SET LENGTH TO PREVIOUS VALUE 
          SA6    A2+B1
          R=     A2,A2+2     RESTORE (A2), (X2) 
 ATF1     IX7    X2-X1       SET NEW FWA
          SA4    A2+B1       (X4) = CURRENT LENGTH
          SA7    A2 
          IX6    X4+X1       (X6) = NEW LENGTH
          BX2    X7          (X2) = FWA TABLE 
          SA6    A4          SET NEW LENGTH 
          BX3    X7          (X3) = FWA NEW SPACE 
          EQ     ATF         RETURN 
 ADW      SPACE  4,6
**        ADW - ADD WORD TO TABLE.
* 
*         ENTRY  (A2) = TABLE POINTER.
*                (X1) = WORD. 
*         EXIT   (X1) = (X6) = WORD.
*                (X2) = FWA TABLE.
*                (X3) = (A6) = ADDRESS OF WORD. 
*                (X4) = INDEX OF WORD (LENGTH-1). 
*                (A2) = TABLE POINTER.
*         SAVES  X - 0, 1, 5. 
*                B - ALL. 
*                A - 0, 2, 5. 
*         CALLS  ATS. 
  
  
 ADW      PS                 ENTRY / EXIT 
          SA2    A2          CURRENT FWA
          SA4    A2+B1       CURRENT LENGTH 
          SX6    X4+B1       SET NEW LENGTH 
          SA3    A4+B1       NEXT TABLE FWA 
          IX7    X3-X2       CHECK ROOM BETWEEN TABLES
          SA6    A4 
          IX7    X6-X7
          BX6    X1          STORE WORD 
          IX3    X2+X4
          SA6    X3 
          MI     X7,ADW      RETURN IF ROOM FOR ENTRY + 1 WORD
          SX6    X4          RESTORE PREVIOUS LENGTH
          SA6    A4 
          ALLOC  A2,1        ALLOCATE 1 WORD
          SA1    X3          RESTORE ENTRY
          BX6    X1 
          R=     A6,X3+0
          EQ     ADW         RETURN 
 AMU      SPACE  4,6
**        AMU - ACCUMULATE MEMORY USED. 
* 
*              THIS ROUTINE KEEPS RECORD OF THE MAXIMUM AMOUNT OF 
*         FIELD LENGTH REQUIRED FOR THE LOAD. 
* 
*         ENTRY  NONE.
*         EXIT   (X6) = (MU) = MAX[MU,(CURRENT SPACE)]. 
*                (X1) = CURRENT SPACE.
*                (A1) = (A6) = MU.
*         USES   X - 1, 2, 6. 
*                B - 2. 
*                A - 1, 2, 6. 
*         CALLS  NONE.
  
  
 AMU      PS                 ENTRY / EXIT 
          SA2    AMUA 
          SA1    LM          LOW MEMORY ADDRESS 
          NG     X2,AMU1     IF MAP ROUTINE IS IN 
          SA2    MM 
          NZ     X2,AMU1     IF *LOADC*/*LOADUC* NEEDED 
          SX1    LOCC+IP.LBUF      USE LENGTH NOT INCL. *LOADC*/*LOADUC*
 AMU1     SA2    TN          (B2) = NUMBER OF TABLES
          IX1    X1+X2       LOADER SIZE + 1 WORD PER TABLE 
          SB2    X2 
          IFCARD 1
          SX6    X1+TABOO    + (FORBIDDEN AREA BEYOND TABLES) 
          IFUSER 3
          NEG 
          SX6    X1-BASE+TABOO      - (AREA BELOW LOAD) 
                                    + (FORBIDDEN AREA BEYOND TABLES)
          SA2    FTAB+1      FIRST TABLE LENGTH 
 AMU2     IX6    X6+X2       ACCUMULATE LENGTH
          SB2    B2-B1
          R=     A2,A2+2     NEXT LENGTH
          NE     B2,B1,AMU2  LOOP FOR ALL TABLES
          SA1    MU          SET *MU* = MAX(MU,X6)
          IX2    X1-X6       IF   MU\X6   MU<X6 
          AX2    59          +0      -0 
          SB2    X6 
          BX1    -X2*X1      MU      +0 
          BX2    X2*X6       +0      X6 
          BX6    X1+X2       MU      X6 
          SA6    A1 
          SX1    B2          (X1) = CURRENT SPACE 
          EQ     AMU         RETURN 
  
 AMUA     CON    0           SET NG WHEN MAP ROUTINE COMES IN 
 MTO      SPACE  4,6
**        MTO - MOVE TABLE ORIGIN.
* 
*              THIS ROUTINE MAKES THE NECESSARY ADJUSTMENTS TO
*         CHANGE THE MANAGE TABLE ORIGIN.  THIS INVOLVES -
* 
*         1) MOVING THE I/O BUFFER(S), SINCE THEY ARE TO BE KEPT JUST 
*            BELOW THE BEGINNING OF THE MANAGE TABLE AREA.  THEY ARE NOT
*            KEPT AS MANAGE TABLES THEMSELVES, SINCE THEIR SIZE NEVER 
*            CHANGES MORE THAN TWICE DURING THE LIFE OF THE LOAD, 
*            AND THE EXTRA SPACE ALLOCATED ABOVE THEM WOULD BE
*            UNUSED AND PROBABLY CAUSE MORE TABLE MOVES THAN WOULD
*            OCCUR OTHERWISE.  TO MOVE AN I/O BUFFER, IT IS NECESSARY 
*            TO (1) WAIT FOR I/O ACTIVITY TO CEASE, (2) MOVE THE
*            BUFFER, AND (3) ADJUST THE POINTERS IN THE *FET*.
* 
*         2) IF THE MOVE IS UPWARD, AND FORCES THE 1ST TABLE TO BE
*            MOVED UPWARD, ENOUGH SPACE IS ALLOCATED TO THE 1ST TABLE,
*            THE TABLE FWA IS MOVED UP BY THE AMOUNT ALLOCATED, THE 
*            LENGTH RESET AS BEFORE, AND THE TABLE CONTENTS MOVED 
*            UPWARD BY THE AMOUNT ALLOCATED.
* 
*         3) THE TABLE ORIGIN SPECIFIED IN *LM* IS ADJUSTED.
* 
*         ENTRY  (X3) = NEW FWA OF BUFFERS = LWA+1 OF OVERLAY.
*                (MM) = +0 (*ATS* CALLS *MTO* IF *MM* = +0).
*         EXIT   MOVE COMPLETED.
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2. 
*                A - 1, 2, 3, 4, 6, 7.
*         CALLS  WNB=, ATS, MVE.
  
  
 MTO      PS                 ENTRY/EXIT 
          RECALL L           MAKE SURE BUFFER IS INACTIVE 
          IFCARD 1
          RECALL O           WAIT I/O COMPLETION
          SA1    L+1
          SX1    X1 
          IX3    X3-X1       AMOUNT TO MOVE 
          SA2    FTAB        FWA OF 1ST TABLE 
          SA1    LM          LOW MEMORY ADDRESS 
          IX7    X1+X3       NEW LOW MEMORY ADDRESS 
          SB2    X3          (B2) = MOVE DISTANCE 
          IX6    X2-X7
          BX1    X3 
          PL     X6,MTO1     IF 1ST TABLE NEED NOT BE MOVED 
          ALLOC  A2,X1       ADD REQUIRED SPACE TO 1ST TABLE
          IX7    X2+X1       BRING TABLE FWA UP 
          BX6    X4          RESET LENGTH AS BEFORE 
          SA7    A2 
          SA6    A2+B1
          MOVE   X4,X2,X7    MOVE TABLE UP
 MTO1     SA1    LM          ADJUST LOW MEMORY ADDRESS
          SX6    X1+B2
          SX4    B2 
          SA6    A1 
 IC       IFCARD
          SA1    O+1
          SA2    A1+B1
          IX6    X1+X4
          IX7    X2+X4
          SA6    A1          ADJUST *FIRST* OF *O*
          SA7    A2          ADJUST *IN* OF *O* 
          SA3    A2+B1
          SA1    A3+B1
          IX6    X3+X4
          IX7    X1+X4
          SA6    A3          ADJUST *OUT* OF *O*
          SA7    A1          ADJUST *LIMIT* OF *O*
 S        IFSCOPE 
          SA2    O+6         ADJUST *READLS* POINTER IF ANY 
 S        ELSE
          SA2    O+5         ADJUST *READLS* POINTER IF ANY 
 S        ENDIF 
          MX7    -24
          BX7    -X7*X2 
          ZR     X7,MTO1A    IF NO *READLS* POINTER 
          IX6    X1+X4
          SA6    A2 
 MTO1A    BSS    0
 IC       ENDIF 
          SA2    L+1         ADJUST *FIRST* OF *L*
          IX6    X2+X4
          SA6    A2 
          SA3    A2+B1       ADJUST *IN* OF *L* 
          IX6    X3+X4
          SA6    A3 
          SA3    A3+B1       ADJUST *OUT* OF *L*
          IX6    X3+X4
          SA6    A3 
          SA3    A3+B1       ADJUST *LIMIT* OF *L*
          IX6    X3+X4
          SA6    A3 
          SX2    X2          (X2) = CURRENT BUFFER FWA
          SX3    X2+B2       (X3) = NEW BUFFER FWA
 IS       IFSCOPE 
          SA1    L+6         ADJUST *READLS* POINTER, IF PRESENT
 IS       ELSE
          SA1    L+5         ADJUST *READLS* POINTER, IF PRESENT
 IS       ENDIF 
          MX7    -24
          BX7    -X7*X1 
          ZR     X7,MTO2     IF NOT PRESENT 
          IX6    X1+X4
          SA6    A1 
 IC       IFCARD
 MTO2     SA1    O+4
          SX1    X1 
          IX1    X1-X4       OLD *LIMIT* OF FET *O* 
          IX1    X1-X2       LENGTH OF BUFFERS
          MOVE   X1,X2,X3    MOVE BUFFERS 
 IC       ELSE
 MTO2     MOVE   IP.LBUF,X2,X3
 IC       ENDIF 
          EQ     MTO         EXIT 
 APS      SPACE  4,6
**        APS - ALLOCATE PROGRAM SPACE. 
* 
*              THIS ROUTINE INCREASES THE CM OR ECS SPACE ALLOCATED TO
*         THE LOADED PROGRAM.  IF CAPSULE/OVCAP GENERATION THEN CALLS 
*         */LOADG/ACRTS* TO ALLOCATE SPACE IN TABLE *TCPREL*. 
* 
*         ENTRY  (X1) = CHANGE FOR PROGRAM TABLE. 
*                (X2) = 0 IF TO ALLOCATE CM SPACE.
*                       NZ IF TO ALLOCATE ECS SPACE.
*         EXIT   (PA) = (PA) + (X1).
*                (A2) = *TPGM* TABLE POINTER IF CM SPACE ALLOCATED. 
*                (X2) = FWA *TPGM*  (OR ECS PROGRAM ORIGIN).
*                (X3) = LENGTH *TPGM*  (OR ECS PROGRAM LENGTH). 
*         USES   X - 2, 3, 4, 6, 7. 
*                B - NONE.
*                A - 2, 3, 4, 6.
*         CALLS  ATS, PSM, PSECS, /LOADG/ACRTS. 
  
  
 APS2     SA2    TPGM        (X2) = FWA *TPGM*
          SA3    A2+B1       (X3) = LENGTH *TPGM* 
  
 APS      PS                 ENTRY/EXIT 
 IC       IFCARD
          SA3    OG 
          ZR     X3,APS1A    IF NOT CAPSULE/OVCAP GENERATION
          R=     X3,X3-1
          ZR     X3,APS1A    IF NOT CAPSULE/OVCAP GENERATION
          RJ     /LOADG/ACRTS  ALLOCATE AND MAINTAIN *TCPREL* 
 APS1A    BSS    0
 IC       ENDIF 
          SA3    PA 
          NZ     X2,APS10    IF TO ALLOCATE ECS SPACE 
          SA4    ABSMAX      (X2) = AMOUNT TO ALLOCATE
          IX2    X3-X4       = MIN[(LTH+PA-ABSMAX),LTH] 
          IX2    X1+X2
          IX7    X2-X1
          NG     X7,APS1     IF (LTH+PA-ABSMAX) < (LTH) 
          BX2    X1 
 APS1     IX6    X3+X1       ADVANCE CM PROGRAM ADDRESS 
          SA6    A3 
          NG     X2,APS2     IF NOTHING TO BE ALLOCATED 
          IFCARD 2
          SX6    X6 
          MI     X6,APS3     IF *PA* .GE. 400000B 
          BX1    X2 
          ALLOC  TPGM,X1     ALLOCATE PROGRAM TABLE 
          BX2    X3          FWA
          IX3    X2+X1       LWA+1
          SA4    PA          CURRENT PROGRAM ADDRESS
          IX4    X4-X1       PREVIOUS PROGRAM ADDRESS 
          RJ     PSM         PRESET MEMORY
          EQ     APS2 
  
          IFCARD 2
 APS3     ERROR  107         --- INSUFFICIENT FL FOR EXECUTION
          EQ     ABEND
  
 ECS      IFTEST NE,IP.MECS,0 
 APS10    SA2    ECSPA       (X7) = ECS SPACE LEFT
          SA3    ECSWCL      ADVANCE ECS LABELLED COMMON WORD COUNT 
          IX6    X3+X1
          SA6    A3 
          SA4    ECSLWA 
          IX7    X4-X2
          IX6    X2+X1       (X6) = NEW PROGRAM ADDRESS 
          BX3    X6 
          IX7    X7-X1       (SPACE LEFT) - (SPACE NEEDED)
          PL     X7,APS14    IF ENOUGH SPACE
          SA6    A2          SET ECS PROGRAM ADR AS IF GRANTED
 ECABORT  ERROR  104         ---- INSUFFICIENT ECS FL FOR LOAD
          EQ     ABEND
  
 APS14    SA6    A2          ADVANCE ECS PROGRAM ADDRESS
          RJ     PSECS       PRESET ECS IF REQUESTED
          SA2    ECSPO       (X2) = ECS PROGRAM FWA 
          SA3    ECSPA       (X3) = ECS PROGRAM LENGTH
          IX3    X3-X2
          EQ     APS
  
 ECS      ELSE
 APS10    ERROR  104         ---- INSUFFICIENT ECS FL FOR LOAD
          EQ     ABEND
  
 ECS      ENDIF 
 CTAB     SPACE  4,6
**        CTAB - CLEAR TABLE. 
* 
*              THIS ROUTINE EMPTIES A MANAGE TABLE BY SETTING ITS LENGTH
*         = 0.  THIS CAN BE DONE AS EASILY BY NOT CALLING THIS ROUTINE, 
*         BUT THE ADVANTAGE OF DOING IT BY THIS ROUTINE IS THAT THE 
*         ROUTINE *AMU* IS FIRST CALLED IN ORDER TO RECORD THE MAXIMUM
*         TABLE SPACE USED BEFORE REDUCING TABLE SPACE. 
* 
*         ENTRY  (A2) = TABLE POINTER.
*                (X2) = FIRST POINTER WORD OF TABLE.
*         EXIT   (X7) = 0.
*         USES   X - 7. 
*                B - 3. 
*                A - 7. 
*         CALLS  AMU. 
  
  
 CTAB     PS                 ENTRY/EXIT 
          SB3    A2          SAVE TABLE POINTER 
          RJ     AMU         ACCUMULATE MEMORY USED 
          MX7    0
          SA7    B3+B1       CLEAR TABLE
          EQ     CTAB        EXIT 
 MVE      SPACE  4,6
**        MVE - MOVE BLOCK OF DATA. 
* 
*         G.R. MANSFIELD, 69/12/05. 
* 
*         ADAPTED FROM SUBROUTINE *MOVE* IN *COMPASS VER 2.0*.
* 
*         ENTRY  (X1) = WORD COUNT. 
*                (X2) = SOURCE ADDRESS. 
*                (X3) = DESTINATION ADDRESS.
*         EXIT   NONE.
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - NONE.
*                A - 2, 4, 6, 7.
*         CALLS  NONE.
  
  
*         BEGIN UPWARD MOVE.
  
 MVE2     LD     B7,-2       UPWARD MOVE
          SX2    X2+B7
          SX3    X3+B7
          SB7    B1+B1
          ZR     X6,MVE3     IF WORD COUNT EVEN 
          SA4    X2+B7       MOVE INITIAL WORD
          IX2    X2+X6
          BX7    X4 
          SA7    X3+B7
          IX3    X3+X6
  
*         INITIALIZE MOVE LOOP. 
  
 MVE3     ZR     X1,MVE5     IF MOVE COMPLETE 
          SA2    X2+B7       MOVE FIRST 2 WORDS 
          SA4    A2+B1
          BX6    X2 
          LX7    X4 
          SA6    X3+B7
          SA7    A6+B1
          SX3    B1+B1
          IX1    X1-X3
          ZR     X1,MVE5     IF MOVE COMPLETE 
          SA2    A2+B7       NEXT 2 WORDS 
          SA4    A4+B7
  
*         MOVE LOOP.
  
 MVE4     BX6    X2 
          SA2    A2+B7
          LX7    X4 
          SA4    A4+B7
          IX1    X1-X3
          NO
          SA6    A6+B7
          SA7    A7+B7
          NZ     X1,MVE4
  
 MVE5     SA2    MVES        RESTORE B7 
          SB7    X2 
 MVE      EQ     *+400000B   ENTRY/EXIT 
          SX7    B7          SAVE B7
          IX4    X2-X3       CHECK DIRECTION OF MOVE
          SA7    MVES 
          MX7    59 
          BX6    -X7*X1 
          IX1    X1-X6       REDUCE WORD COUNT TO EVEN NUMBER 
          PL     X4,MVE2     IF MOVE UP 
  
*         BEGIN DOWNWARD MOVE.
  
          ZR     X6,MVE1     IF WORD COUNT EVEN 
          SB7    X1 
          SA4    X2+B7       MOVE INITIAL WORD
          BX6    X4 
          SA6    X3+B7
 MVE1     IX2    X2+X1
          IX3    X3+X1
          LD     B7,-2
          EQ     MVE3 
  
 MVES     CON    0
  
 NOS      IFNOS 
 AET      SPACE  4,8
**        AET - ADD ENTRY TO TABLE. 
* 
*              THIS ROUTINE ADDS A SINGLE-WORD ENTRY TO A MANAGE
*         TABLE, AFTER VERIFYING THAT THE ENTRY IS NOT ALREADY
*         PRESENT IN THE TABLE. 
* 
*         ENTRY  (A2) = TABLE POINTER.
*                (X1) = WORD TO BE ADDED. 
* 
*         EXIT   SAME REGISTERS AS *ADW*. 
* 
*         SAVES  X - 0, 1, 5. 
*                B - ALL EXCEPT B7. 
*                A - 0, 2, 5. 
* 
*         CALLS  ADW. 
  
  
 AET      EQ     *+1S17      ENTRY / EXIT 
          SA2    A2          (X2) = TABLE FWA 
          BX6    X1          (X6) = WORD
          MX4    -1          (X4) = INDEX - 1 
          SA3    A2+B1       (B7) = TABLE LENGTH
          SB7    X3 
          SA3    X2          FIRST WORD IN TABLE
 AET1     ZR     B7,AET2     IF WORD NOT IN TABLE 
          IX7    X3-X6       COMPARE WORDS
          SB7    B7-B1       DECREMENT COUNT
          SX4    X4+B1       ADVANCE INDEX
          SA3    A3+B1       NEXT WORD
          NZ     X7,AET1     LOOP ON NO MATCH 
          SA6    A3-B1       WORD ALREADY IN TABLE, (A6) = ADR OF WORD
          SX3    A6          (X3) = ADR OF WORD 
          EQ     AET         RETURN 
  
 AET2     ADDWRD  A2,X1      ADD WORD TO TABLE
          EQ     AET         RETURN 
  
 NOS      ENDIF 
  
          QUAL
 ATS=     EQU    /TMGR/ATS
 ATF=     EQU    /TMGR/ATF
 ADW=     EQU    /TMGR/ADW
 MTO=     EQU    /TMGR/MTO
 APS=     EQU    /TMGR/APS
 AMU=     EQU    /TMGR/AMU
 CTAB=    EQU    /TMGR/CTAB 
 MVE=     EQU    /TMGR/MVE
          IFNOS  1
 AET=     EQU    /TMGR/AET
 SEG      IFCARD
 CCS      SPACE  4,8
**        CCS - CHECK FOR COMPATIBLE SEGMENTS.
* 
*              THIS ROUTINE DETERMINES WHETHER TWO GIVEN SEGMENTS ARE 
*         COMPATIBLE AND IF SO WILL LOADING OCCUR IF ONE CALLS THE
*         OTHER.  THIS ROUTINE IS USED AFTER *TCEL* HAS BEEN CREATED
*         OTHERWISE *CCP* IS USED WITHIN *LOADS*. 
* 
*         ENTRY  (B2) = *TCEL* INDEX OF CALLING SEGMENT.
*                (B3) = *TCEL* INDEX OF CALLED SEGMENT. 
*         EXIT   (X6) < 0 IF SEGMENTS ARE INCOMPATIBLE. 
*                     = 0 IF NO LOADING WILL OCCUR. 
*                     > 0 IF LOADING MAY OCCUR. 
*         USES   X - 1, 2, 3, 4, 6. 
*                B - NONE.
*                A - 2. 
  
  
 CCS      PS                 ENTRY/EXIT 
          MX6    0
          EQ     B2,B3,CCS   IF IN SAME SEGMENT 
          SX3    B3 
          ZR     B3,CCS      IF BLOCK IS IN ROOT SEGMENT
          SA2    TCEL 
          SX6    B1 
          BX1    X2 
          SX4    B2 
          LT     B2,B3,CCS1  IF USING SEGMENT IS CLOSER TO ROOT 
          SX3    B2 
          MX6    0
          SX4    B3 
 CCS1     IX2    X1+X3       SEE IF (X4) IS ANCESTOR OF (X3)
          SA2    X2          *TCEL* ENTRY 
          MX3    -13
          AX2    17 
          BX3    -X3*X2      INDEX OF FATHER OF (X3)
          SA2    A2+B1       *TCEL* DEFINITION
          LX2    1
          MI     X2,CCS4     IF FIRST PATRIARCH ON LEVEL
          IX2    X3-X4
          ZR     X2,CCS      IF ANCESTOR IS (X4)
          MI     X2,CCS3     IF INCOMPATIBLE SEGMENTS 
          SX2    X3-7777B*2 
          NZ     X2,CCS1     IF THIS NOT A PATRIARCH
 CCS2     SA2    A2-2        GET PREVIOUS *TCEL* ENTRY
          SX3    A2-B1
          LX2    1
          IX3    X3-X1
          ZR     X3,CCS5     IF FIRST PATRIARCH IS ROOT SEGMENT 
          PL     X2,CCS2     FIND FIRST PATRIARCH ON LEVEL
          SX6    B1 
          IX2    X4-X3
          MI     X2,CCS      IF ON DIFFERENT LEVELS 
 CCS3     MX6    1
          EQ     CCS
  
 CCS4     SX6    B1 
          EQ     CCS
  
 CCS5     ZR     X4,CCS      IF (X4)=ROOT IS ANCESTOR OF (X3) 
          EQ     CCS3 
 SEG      ENDIF 
 PSECS    TITLE  CORE PRESET ROUTINES.
**        + + + + + + + + + + + + + 
*         + CORE PRESET ROUTINES. + 
*         + + + + + + + + + + + + + 
  
  
 ECS      IFTEST NE,IP.MECS,0 
**        PSECS - PRESET ECS. 
* 
*              THIS ROUTINE PRESETS ECS USING THE SAME OPTIONS
*         SPECIFIED FOR CM PRESETTING.  SEE LOCATIONS *PSMA* AND *PSMB*.
*         TO AVOID EXCESSIVE ONE-WORD ECS TRANSFERS, THIS ROUTINE USES
*         THE LARGEST GAP BETWEEN MANAGE TABLES (IN CM) FOR A BUFFER
*         TO ECS. 
* 
*              THIS ROUTINE IS PART OF THE CONDITIONAL CODE FOR ECS.
* 
*         ENTRY  (X2) = FWA TO PRESET.
*                (X3) = LWA+1 TO PRESET.
*         EXIT   NONE.
*         USES   X - 2, 3, 4, 6, 7. 
*                B - 2, 3, 7. 
*                A - 1, 2, 3, 4, 6, 7.
*         CALLS  WEW=.
  
  
 PSECS    PS                 ENTRY/EXIT 
          SA4    PSMA        (X4) = PRESET OPTION 
          ZR     X4,PSECS    IF PRESET(NONE)
          IX7    X3-X2
          BX6    X0 
          ZR     X7,PSECS    IF NOTHING TO PRESET 
          SA6    PSECSS      SAVE X0
          LX7    X1          SAVE X1
          BX6    X5          SAVE X5
          SA7    A6+B1
          SA6    A7+B1
          BX0    X2          (X0) = ECS STORE ADDRESS 
          LX5    X3          (X5) = ECS STORE LWA+1 
          SA1    FTAB        FIND LARGEST GAP BETWEEN TABLES
          SB7    TEND 
          SB2    B0 
 PSE1     SA3    A1+B1       (B3) = NEXT GAP SIZE 
          IX3    X1+X3       LWA+1 OF TABLE 
          SA1    A3+B1
          SX7    A1-B7
          IX6    X1-X3
          ZR     X7,PSE2     IF ALL GAPS EXAMINED 
          SB3    X6 
          GE     B2,B3,PSE1  IF NO MORE SPACE HERE
          SB2    B3          ADVANCE CM BUFFER LENGTH 
          SX2    X3          SET BUFFER FWA 
          EQ     PSE1 
  
 PSE2     SA1    PSMB        (X6) = PRESET VALUE
          SB7    B0          INDEX FOR STORE
          BX7    X0 
          BX6    X1 
          MX3    60          SET INCREMENT FOR NO ADR INSERTION 
          NG     X4,PSE3     IF NO ADDRESS INSERTION
          MX3    60-24       SET UP FOR ADDRESS INSERTION 
          BX6    X6*X3
          IX6    X6+X7
          SX3    B1 
 PSE3     SA6    X2+B7       PRESET LOOP
          SB7    B7+B1
          IX6    X6+X3       ADD ONE IF ADDRESS INSERTION 
          LT     B7,B2,PSE3  LOOP 
 PSE4     IX7    X5-X0       REMAINING ECS TO PRESET
          SX6    B2          CM BUFFER LENGTH 
          IX4    X6-X7
          BX1    X0          ECS FWA
          NG     X4,PSE5     IF STILL MORE ECS THAN CM BUFFER 
          SB7    B0          FLAG LAST TIME 
          SB2    X7          ADJUST CM BUFFER SIZE
 PSE5     RJ     WEW=        WRITE BUFFER TO ECS
          ZR     B7,PSE8     IF LAST TIME 
          SA1    PSMA        ADVANCE ADDRESSES IN CM BUFFER IF
          SB3    B0          PRESETTING WITH ADDRESS INSERTION
          SX6    B2          CM BUFFER LENGTH 
          NG     X1,PSE7     IF NO ADDRESS INSERTION
 PSE6     SA1    X2+B3       ADVANCE ADDRESSES
          IX7    X1+X6
          SB3    B3+B1
          SA7    A1 
          LT     B3,B2,PSE6 
 PSE7     IX0    X0+X6       ADVANCE ECS PRESET ADDRESS 
          EQ     PSE4        LOOP 
  
 PSE8     SA2    PSECSS      RESTORE REGISTERS
          SA1    A2+B1       X1 
          BX0    X2          X0 
          SA3    A1+B1       X5 
          BX5    X3 
          EQ     PSECS       EXIT 
  
 PSECSS   BSSZ   3
 ECS      ENDIF 
 LOV      TITLE  LOAD OVERLAY.
**        + + + + + + + + + + + + + + + 
*         + OVERLAY LOAD SUBROUTINE.  + 
*         + + + + + + + + + + + + + + + 
* 
* 
*         LOV - LOAD OVERLAY. 
* 
*              THIS ROUTINE LOADS THE VARIOUS LOADER OVERLAYS BY
*         INTERFACING WITH THE PPU ROUTINE *LDV*.  IT CAN BE ASKED
*         TO EXIT DIRECTLY TO A (0,0) OVERLAY SUCH AS ITSELF
*         OR *SEGRES* BY CALLING *LDV* WITH THE E-BIT SET.  REFER TO
*         THE *LDV* IMS FOR A DESCRIPTION OF THE CALLING SEQUENCE.
* 
*         ENTRY  (X1) = NAME OF OVERLAY.
*                (X2) = OVERLAY LOAD ADDRESS (FWA). 
*                (X3) = LWA+1.
*                (X4) = 47/0,6/L1,6/L2,1/EX 
*         EXIT   OVERLAY IS LOADED. 
*                (B7) = OVERLAY LOAD ADDRESS IF NOT AN OVERWRITE CALL.
*                IF AN OVERWRITE CALL, NO B-REGISTERS ARE USED. 
*                *LDV* TRANSFERS CONTROL DIRECTLY TO THE OVERLAY. 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 4, 7.
*                A - 1, 2, 3, 6, 7. 
*         CALLS  SYS=.
  
  
 LOV      PS                 ENTRY/EXIT 
          BX7    X1 
          SA7    LOVMESS+2   PUT NAME IN ERROR MESSAGE
 IC       IFCARD
          SA7    LOVPARAM+2  AND IN LDV PARAMETER LIST
          SA1    LOVPARAM 
          MX7    42 
          BX7    X7*X1
 IC       ENDIF 
          SA7    LOVPARAM    SET FIRST WORD OF PARAMETER LIST 
          LX3    18 
          BX7    X2+X3       BUILD SECOND WORD
          MX1    59 
          BX1    X1*X4
          BX4    -X1*X4 
          LX1    47 
          BX7    X7+X1
          SA1    LOVLDV+X4   PICK UP LDV CALL 
          SA3    LOVFLAGS 
          BX3    X3+X4
          LX3    36 
          BX7    X7+X3
          SA7    A7+B1       SET SECOND WORD OF LDV CALL
          BX6    X1 
          NZ     X4,LOV1     IF IT IS AN OVERWRITE CALL 
          SB7    X2          SAVE FWA FOR RETURN
 LOV1     BSS    0
  
 IU       IFUSER
          SA2    PLDP 
          ZR     X2,LOV1B    IF NO *PILOAD* PARAM BLOCK 
          SA2    X2 
          SX1    X6 
          NZ     X4,LOV1A    IF TO EXECUTE
          CALL   X2          CALL *LOD=* TO LOAD OVERLAY
          SX4    B0          FLAG NO EXECUTE
          EQ     LOV2 
  
 LOV1A    LX4    36 
          BX7    X7-X4       CLEAR *E* BIT
          SA7    A7 
          CALL   X2          CALL *LOD=* TO LOAD OVERLAY
          SA1    LOVPARAM+1 
          SB4    X1          (B4) = EPTADDR 
          LX1    59-36
          MI     X1,LOV4     IF FATAL ERROR 
          SB4    B4+B7
          BR     B4          ENTER OVERLAY
  
 IU       ENDIF 
  
 LOV1B    RJ     SYS= 
 LOV2     NZ     X4,LOV2     IF OVERWRITE, WAIT TO BE DROPPED 
          SA1    A7          CHECK FE (FATAL ERROR) BIT 
          LX1    59-36
          MI     X1,LOV4     IF FATAL ERROR 
  
 PATCH    IFCARD
 PATCH    IFTEST NE,IP.LDBG,0 
          SA1    TPAT+1 
          R=     X7,2        (X7) = 2 
          BX4    X1          (X4) = WORDS LEFT IN PATCH TABLE 
          SA1    A1-B1
          BX3    X1          (X3) = CURRENT *TPAT* ENTRY ADDRESS
 LOV3     ZR     X4,LOV      IF NO MORE TO PATCH, EXIT
          SA1    X3 
          IX4    X4-X7
          IX3    X3+X7
          BX6    X1          (X6) = DATA WORD 
          SA1    A1+B1
          BX2    X1          (X2) = NAME AND ADDRESS
          SA1    LOVMESS+2
          BX1    X1-X2
          AX1    18 
          NZ     X1,LOV3     IF WRONG OVERLAY 
          SA6    X2          PATCH
          EQ     LOV3 
 PATCH    ELSE
          EQ     LOV
 PATCH    ENDIF 
  
 LOV4     ERROR  CAT,LOVMESS ABORT ON LDV ERROR 
  
          RELOC  OFF
 LOVLDV   VFD    24/0LLDVP,18/0 
          RVFD   18,LOVPARAM
          VFD    18/0LLDV,24/0
          RVFD   18,LOVPARAM
          IFCARD 1
 LOVFLAGS DATA   2140B       N=1 + U + V
          IFUSER 1
 LOVFLAGS DATA   0140B       U + V
 LOVPARAM BSSZ   3           LDV REQUEST
 LOVMESS  DATA   H*SYSTEM ERR LOADING- *
          CON    0           PROGRAM NAME GOES HERE 
          RELOC  ON 
          SPACE  4,6
 SLDL     IFSCOPE 
*         LDL - CALL *LDL*. 
* 
*         ENTRY  (X1) = FWA OF *LDL* PARAMETER AREA.
*                PARAMETER AREA IS SET UP.
*         EXIT   CALL HAS BEEN MADE.
*         USES   X - 2, 6.
*                B - NONE.
*                A - NONE.
*         CALLS  SYS=.
  
  
 LDL      PS                 ENTRY/EXIT 
          R=     X2,4RLDLP/16      FORM *LDL* CALL WORD 
          MX6    -18         REMOVE SIGN EXTENSION
          BX2    -X6*X2 
          LX2    36+4        VFD  60/0LLDLP 
          BX6    X1+X2
          RJ     SYS=        CALL *LDL* 
          EQ     LDL         EXIT 
 SLDL     ENDIF 
 IC       IFCARD
 LMO      SPACE  4
**        LMO - LOAD MAP FOR OVERLAY
* 
* 
*              EACH EXTERNAL NAME IN *TLBC2* IS REPLACED BY THE INDEX OF
*         THE 2ND WORD OF ITS *TLNK* ENTRY.  THIS MUST BE DONE BEFORE 
*         *ELT* IS OVERWRITTEN.  THEN THE MAP ROUTINE IS CALLED.  IF
*         CONTROL RETURNS, *LOADZ* IS RELOADED AND CONTROL TRANSFERS TO 
*         *INO* TO BEGIN GENERATION OF THE NEXT OVERLAY.
  
  
 LMO      SA1    TLBC2
          SA3    A1+B1
          MX0    30          (X0) = BYTE MASK 
          IX3    X1+X3
          SB6    X1          (B6) = CURRENT POINTER 
          SB7    X3          (B7) = LWA+1 
 LMO1     EQ     B6,B7,LMO3  IF END OF TABLE
          MX2    0
          SA1    B6          GET NAME 
          RJ     ELT         GET ORDINAL
          SA6    B6          REPLACE NAME WITH ORDINAL
          SB6    B6+B1
 LMO2     EQ     B6,B7,LMO3  IF END OF TABLE
          SA1    B6 
          SB6    B6+B1
          BX2    -X0*X1 
          NZ     X2,LMO2     IF NOT END OF TRAILER BYTES
          EQ     LMO1        YES, GET NEXT ENTRY
  
 LMO3     OVERLAY  LOADM,2,0,LOCL,MAPEND
          RJ     /LOADM/MAP 
          OVERLAY  LOADZ,1,0,LOCL,/LOADG/END
          EQ     /LOADG/INO 
 XEQ      SPACE  4
**        XEQ - EXECUTE OVERLAY.
* 
* 
*              XEQ IS CALLED WHEN AN *EXECUTE* CARD TERMINATES AN 
*         OVERLAY GENERATION LOAD.  *LOADER* IS RELOADED WITH PARAMETERS
*         IN FORMAT 2 (SEE COMMENTS AT BEGINNING OF LISTING). 
* 
*         ENTRY  LFN OF FILE TO BE EXECUTED IN *OG1ST00*
  
  
 XEQ      SA4    OG1ST00     PICK UP LFN
          ERRNZ  CLOAD
          SX7    B1 
          LX7    36 
          SA7    COMARGS     SAVE LOAD REQUEST IN ARGUMENT LIST 
          BX7    X4 
          SX6    A7 
          SA7    A7+B1       PUT LFN IN LOAD REQUEST
          SA2    TREQ 
          SA1    A2+B1
          SX3    X1+4        LENGTH OF REQUEST TABLE
          LX3    30 
          SA4    FL 
          SA5    ECSFL
          BX6    X3+X6
          BX0    X5          (X0) = ECS FL
          SA6    COMNAME     PUT REQUEST TABLE CALL IN RA+64B 
          SA3    PSMA 
          SX6    CPRESET
          SA0    X4          (A0) = CM FL 
          SX7    B1 
          SA4    A3+B1
          LX6    48 
          BX5    X7*X3       1 IF PRESETING WITH ADDRESS INSERTION
          LX7    36 
          NZ     X3,XEQ1     IF PRESETING PRESENT 
          SX7    B0 
 XEQ1     BX6    X6+X7       ADD WORD COUNT OF 0 OR 1 
          BX7    X4 
          BX6    X6+X5       ADD ADDRESS INSERTION FLAG 
          SA6    A7+B1       PUT PRESET HEADER WORD IN REQUEST TABLE
          NZ     X3,XEQ2     IF PRESETING PRESENT 
          BX7    X6          USE NO PRESET TWICE TO FILL TABLE
 XEQ2     SA7    A6+B1       ADD PRESET VALUE OR ANOTHER PRESET HEADER
          MOVE   X1,X2,A7+B1 MOVE REQUEST TABLE INTO PLACE
          SX6    3RLDV       ISSUE LDV REQUEST W/O PARAMETER ADDRESS
          LX6    42 
          RJ     SYS= 
          EQ     *           WAIT FOR LDV 
          OVERLAY LOADLDR,0,0,0,0,EX   RELOAD LOADER                     LDR0238
 IC       ENDIF 
 IC       IFCARD
 LCGO     SPACE  4,8
**        LCGO - LOAD CAPSULE GENERATION OVERLAY. 
* 
*              THIS ROUTINE IS CALLED FROM *PREFIX* TABLE PROCESSING
*         WHEN WE DETERMINE THAT THE CAPSULE GENERATION OVERLAY IS
*         NEEDED.  LOADS OVERLAY *LOADG* AND JUMPS TO */LOADG/INCAP*. 
  
 LCGO     SX3    /LOADG/END  (X3) = NEW FWA OF BUFFERS
          RJ     MTO=        MOVE TABLES TO MAKE ROOM FOR *LOADG* 
          OVERLAY  LOADG,1,2,LOCG,/LOADG/END
          SX7    B1 
          SA7    MM          FLAG *LOADC* IN AND NEEDED 
          EQ     /LOADG/INCAP  GO TO INITIALIZE FOR NEXT CAPSULE
  
 IC       ENDIF 
 ERROR    TITLE  ERROR PROCESSOR. 
**        + + + + + + + + + + + 
*         + ERROR PROCESSOR.  + 
*         + + + + + + + + + + + 
* 
* 
*         ERROR - PROCESS ERRORS. 
* 
*              THIS ROUTINE IS CALLED WHEN AN ERROR IS DETECTED 
*         DURING THE LOADING PROCESS.  THERE ARE TWO TYPES OF CALLS 
* 
*         1) REQUEST TO ISSUE DAYFILE MESSAGE AND ABORT - 
* 
*         ENTRY  (X1) = NEGATIVE. 
*                (X2) = ADDRESS OF MESSAGE, OR ZERO IF NOT TO ISSUE 
*                       MESSAGE.
* 
*         2) REQUEST TO FORM *TERR* ENTRY AND RETURN TO CALLER -
* 
*         ENTRY  (X1) = ERROR NUMBER. 
*                (X2) = ADDRESS OF ERROR ROUTINE AT MAP TIME.  THIS 
*                       ROUTINE NAME IS OF THE FORM EP"NUM", WHERE *NUM*
*                       IS THE ERROR NUMBER.
*                (B2) = 0 IF THERE IS NO ADDITIONAL PARAMETER.
*                     = 1 IF (X7) CONTAINS AN ADDITIONAL PARAMETER. 
* 
*         EXIT   A WORD OF THE FOLLOWING FORMAT IS PLACED IN *TERR* - 
* 
*                  VFD    12/FI,18/PI,12/NUM,18/EP
* 
*                  WHERE  FI  = FILE INDEX
*                         PI  = PROGRAM INDEX 
*                         NUM = ERROR NUMBER FROM X1. 
*                         EP  = ERROR PROCESSOR ADDRESS FROM X2.
* 
*                         (IT IS DESIRABLE TO RECORD BOTH FI AND PI 
*                         BECAUSE IF AN ERROR OCCURS AT THE START OF
*                         A FILE AFTER SUCCESSFULLY LOADING FROM A
*                         PREVIOUS FILE, THEN PI WILL POINT TO THE
*                         PREVIOUS FILE AND NOT THE FILE IN ERROR.) 
* 
*                IF (B2) = 1 ON ENTRY, THEN (X7) IS ENTERED IN *TERR* 
*                          FOLLOWING THE ABOVE WORD.
*                (A2) = *TERR* TABLE POINTER. 
*                (X2) = FWA *TERR*. 
*                (X3) = LENGTH *TERR*.
*                (B2) = INDEX OF LAST WORD PLACED IN *TERR*  (LENGTH-1).
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3.
*                A - 2, 3, 4, 6, 7. 
*         CALLS  ADW=, MSG=, RSF, SYS=. 
  
  
 ERROR    PS                 ENTRY/EXIT 
          NG     X1,ERROR2   IF CATASTROPIC ERROR 
          SA7    ERRORSV     SAVE ADDITIONAL PARAM, IF PRESENT
          LX1    18          FORM *TERR* ENTRY
          SA3    PI          PROGRAM INDEX
          BX7    X1+X2
          SB3    B2          SAVE ADDITIONAL PARAM FLAG 
          LX3    18+12
          SA4    FI          FILE INDEX 
          LX1    59-11-18    FATAL-NONFATAL FLAG TO SIGN POSITION 
          SA2    FE          FATAL ERROR FLAG 
          MX6    12 
          BX7    X7+X3
          LX4    18+12+18 
          BX4    X6*X4       FI MIGHT BE NEGATIVE 
          PL     X1,ERROR1   IF ERROR IS FATAL
          SA2    NE          NONFATAL ERROR COUNT 
 ERROR1   BX1    X7+X4
          SX6    X2+B1       ADVANCE ERROR COUNT
          SA6    A2 
          ADDWRD TERR,X1     ENTER *TERR* ENTRY 
          SB2    X4          (B2) = INDEX OF ENTRY
          SX3    X4+B1       (X3) = *TERR* LENGTH 
 SEG      IFCARD
          SA1    SEGFLAG
          PL     X1,ERROR0   IF NOT FIRST PASS OF SEGMENT LOAD
          ADDWRD TERR1,X4    ADD INDEX OF ERROR ENTRY 
          SA2    TERR 
          SA3    TERR+1 
 ERROR0   BSS    0
 SEG      ENDIF 
          ZR     B3,ERROR    IF NO ADDITIONAL PARAM, EXIT 
          SA1    ERRORSV     ENTER ADDITIONAL PARAM 
          ADDWRD A2,X1
          SB2    X4          (B2) = INDEX OF ENTRY
          SX3    X4+B1       (X3) = *TERR* LENGTH 
          EQ     ERROR       EXIT 
  
 ERROR2   ZR     X2,ABORT    IF NO MESSAGE
          BX5    X2          YES, SAVE ADDRESS
 IC       IFCARD
          SA1    DFMFLAG
          NZ     X1,ERROR3   IF MESSAGE ALREADY ISSUED
          SX1    COMLDCC
          IFNOS  1
          MESSAGE  X1,R      DAYFILE THE COMMAND
          IFSCOPE  1
          MESSAGE X1,R,6     DAYFILE THE COMMAND (NOT TO TERMINAL)
  
 ERROR3   BSS    0
 IC       ENDIF 
          MESSAGE (=C*LOADER ABORT*),R
          MESSAGE X5
          EQ     ABORT
  
 ERRORSV  CON    0           STORAGE FOR ADDITIONAL *TERR* PARAM
 CPL      TITLE  LOAD COMPLETION MAIN ROUTINE.
**        +++++++++++++++++++++++++ 
*         + LOAD COMPLETION CODE. + 
*         +++++++++++++++++++++++++ 
* 
* 
*              THIS IS THE BEGINNING OF THE CODE WHICH PERFORMS ALL 
*         LOAD COMPLETION FUNCTIONS.  IT CONSISTS OF THE MAIN ROUTINES
*         *CPL* AND *EXP, PLUS SEVERAL ASSOCIATED SUBROUTINES.
* 
* 
*         + + + + + + + + + + + + + + + 
*         + MAIN COMPLETION ROUTINE.  + 
*         + + + + + + + + + + + + + + + 
* 
* 
*         CPL - COMPLETE LOAD.
* 
*              ENTRY TO THIS ROUTINE WILL TAKE PLACE IN ONE OF THE
*         FOLLOWING WAYS FOR EVERY LOAD PERFORMED 
* 
*         1)   AS A RESULT OF AN *EXECUTE* OR *NOGO* REQUEST IN EITHER
*              THE PROGRAM *LOADER* OR *LOADU*. 
* 
*         2)   AS A RESULT OF HAVING PROCESSED ALL REQUESTS IN *LOADU*. 
*              (IN USER-CALL PROCESSING, AN *EXECUTE* OR *NOGO* 
*              REQUEST IS OPTIONAL.)
* 
*         3)   TO THE SPECIAL ENTRY *ABEND* ANYTIME A FATAL ERROR 
*              OCCURS.
* 
*              EXCEPT FOR CASE (3) ABOVE, ON ENTRY, TABLE *TREQ* POINTS 
*         TO THE FWA OF THE *EXECUTE* OR *NOGO* REQUEST.  IF IN *LOADU*,
*         *TREQ* WILL BE EMPTY IF NO SUCH REQUEST WAS PRESENT.
* 
* 
*                ++++ MAIN FLOW OF LOAD COMPLETION ++++ 
* 
* 
 CPL      PS                 ENTRY/EXIT 
  
**        --   IF A CONTROL-CARD-INITIATED LOAD, THE SUBROUTINE *SAT* 
*              IS CALLED TO SATISFY EXTERNALS FROM THE LIBRARY SET. 
*              THIS OPERATION IS IDENTICAL TO THE PROCESSING OF A 
*              *SATISFY* REQUEST ON THE LIBRARY SET.  THIS IS NOT 
*              PERFORMED DURING USER-CALL LOADS, SINCE THE SATISFYING 
*              OF EXTERNALS IS ENTIRELY OPTIONAL. 
* 
*              THEN, FOR ALL TYPES OF LOADS, THE SUBROUTINE *USX* IS
*              CALLED TO PROCESS UNSATISFIED EXTERNALS. 
* 
  
 IC       IFCARD
          SA1    SEGFLAG
          NG     X1,REQ      RETURN THRU *REQ* IF PASS 1 SEGMENT LOAD 
          NZ     X1,CPL1     IF SEGMENT LOAD - LOAD HAS BEEN COMPLETED
          SA1    OG 
          ZR     X1,CPL0E    IF NOT OVERLAY/CAPSULE/OVCAP GENERATION
          PL     X1,/LOADG/CPL  IF OVERLAY/OVCAP GENERATION 
          SA1    PC 
          NZ     X1,/LOADG/CPL  IF PROGRAMS LOADED
          EQ     ABEND       EMPTY LOAD 
  
 CPL0E    BSS    0
          SB7    B0          SATISFY EXTERNALS FROM LIBRARY SET 
          RJ     SAT
* 
*         THE TRANSFER ADDRESS CELL, *XF+1*, IS SET UP FOR LATER USE, 
*         AND WILL CONTAIN THE FIRST ENTRY POINT NAME (IF ONE EXISTS) 
*         FROM THE 54-TABLE IN *TPGM*.  THIS WILL BE THE FIRST ENTRY
*         POINT NAME FROM THE *NOGO* CARD OR THE FIRST INTERNAL *EPT=*
*         REQUEST NAME. 
* 
          SA1    TPGM        (X1) = FWA *TPGM*
          R=     A1,X1+COMLTH  (X1)=FIRST EPT NAME FROM *TPGM* HEADER 
          ZR     X1,CPL0D    IF NO EPT NAME EXISTS THERE
          MX6    42          ELSE WE HAVE NAMES FROM *NOGO* OR *EPT=* 
          BX6    X6*X1       42/NAME,18/0 
          SA6    XF+1        USE FIRST NAME (EPT=/NOGO) AS XFER ADDR
 CPL0D    BSS    0
 IC       ENDIF 
          RJ     PNF         PROCESS PROGRAMS NOT FOUND 
          RJ     USX         PROCESS UNSATISFIED EXTERNALS
  
**        --   AT THIS POINT, ALL PROGRAMS WHICH ARE TO BE LOADED HAVE
*              BEEN LOADED.  THEREFORE, THE ORIGIN OF BLANK COMMON CAN
*              BE ESTABLISHED.  THIS IS DONE FOR BOTH CM AND ECS BLANK
*              COMMON.  ECS BLANK COMMON IS PRESET AT THIS TIME,
*              WHEREAS CM BLANK COMMON IS PRESET LATER WHEN ALL UNUSED
*              CM IS PRESET.
* 
  
          SA1    TBLK        SET ADDRESS OF BLANK COMMON
          SA2    PA          ADDRESS = CURRENT (FINAL) PROGRAM ADR
          SA4    ABSMAX      SET PA = MAX(PA,ABSMAX)
          IX6    X2-X4
          MX5    -24
          SA3    X1+B1       CM BLANK COMMON = 1ST *TBLK* ENTRY 
          PL     X6,CPL0C 
          BX2    X4 
 CPL0C    BX6    X2          UPDATE *PA*
          SA6    A2 
          BX6    -X5*X3      ISOLATE BLANK COMMON ADDRESS FIELD 
          SB2    B1+B1
          IX7    X3+X2       FORM ADDRESS IN *TBLK* 
          NZ     X6,CPL0A    IF BLANK COMMON ALREADY ESTABLISHED
          SA7    A3          STORE BLANK COMMON ORIGIN
 CPL0A    BSS    0
 ECS      IFTEST NE,IP.MECS,0 
          SA3    A3+B2       ECS BLANK COMMON = 2ND *TBLK* ENTRY
          SA2    ECSPA       ECS PROGRAM ADDRESS
 IU       IFUSER
          SA4    /READ/BCOM+1 
          NZ     X4,CPL0B    IF PREVIOUS OR NO ECS // 
 IU       ENDIF 
          BX6    -X5*X3 
          IX7    X3+X2       FORM ADDRESS FOR *TBLK*
          NZ     X6,CPL0B    IF ORIGIN ALREADY ESTABLISHED (USER) 
          SA7    A3          STORE ORIGIN 
 CPL0B    SA3    ECSLWA      PRESET REMAINDER OF ECS
          RJ     PSECS
 ECS      ENDIF 
  
**        --   ALL *FILL* AND REMAINING *LINK* BYTES ARE PROCESSED BY 
*              THE SUBROUTINES *FBC* AND *LBC*, RESPECTIVELY. 
* 
  
          RJ     AMU=        ACCUMULATE STORAGE 
          RJ     RBE         RELOCATE // ENTRY POINTS 
          RJ     FBC         PROCESS FILL BYTE CHAINS 
          RJ     LBC         PROCESS LINK BYTE CHAINS 
          EQ     CPL1 
  
**        --   ANY TIME A FATAL ERROR OCCURS DURING THE LOAD PROCESS, 
*              CONTROL TRANSFERS TO THIS POINT IN *CPL*.  LIKEWISE, THIS
*              STEP IS SKIPPED DURING NORMAL COMPLETION PROCESSING. 
*              THE REQUEST TABLE *TREQ* IS SCANNED TO POINT TO THE LAST 
*              REQUEST.  THIS ALLOWS THE REMAINDER OF *CPL* TO BE USED
*              AS IS. 
* 
  
 ABEND    R=     X6,3RCIO    RESET I/O CONTROL IN CASE IT WAS 
          SA6    /CCIO/CALL  SET FOR *LDL*
          SB2    B0 
          SA1    TREQ 
          SA3    A1+B1       (B3) = LENGTH OF *TREQ*
 IC       IFCARD
          MX6    0
          SA6    DEFER       END DEFERRED LOADING OF ABSOLUTES
 IC       ENDIF 
          SB3    X3 
          ZR     B3,CPL1     IF DONE WITH LAST REQUEST
 ABEND1   SA5    X1+B2       NEXT REQUEST TABLE ENTRY 
          LX5    12 
          MX0    -12
          BX6    -X0*X5 
          LD     X6,X6-CEXECUTE 
          ZR     X6,ABEND2   IF *EXECUTE* REQUEST 
          LD     X6,X6+CEXECUTE-CNOGO 
          ZR     X6,ABEND2   IF *NOGO* REQUEST
          LX5    12          ADVANCE LENGTH OF ENTRIES SKIPPED
          BX6    -X0*X5 
          SB2    B2+X6
          SB2    B2+B1
          LT     B2,B3,ABEND1      IF NOT END OF REQUEST TABLE
 ABEND2   ZR     B2,CPL1     IF NOTHING TO RELEASE
          ALLOC  A1,-B2,FRONT      RELEASE ALL BUT LAST REQUEST 
  
*         THE EXECUTION FLAG, *EX*, IS ALREADY SET AS FOLLOWS 
*                 1 - *EXECUTE* REQUEST.
*                 0 - *NOGO* REQUEST. 
*                -1 - NEITHER.  (USER CALL ONLY)
  
 CPL1     SA1    EX          PICK UP EXECUTION FLAG 
          SB6    X1 
  
**        --   A CLOSE-RETURN FUNCTION IS PERFORMED 
*              ON EACH OF THE EXISTING LOCAL COPIES OF THE SYSTEM 
*              LIBRARY FILES UNLESS PLANNING A DEFERRED LOAD OF AN
*              ABSOLUTE.
* 
  
 IC       IFCARD
          SA2    DEFER
          NZ     X2,CPL1B    IF DEFERRED LOAD 
 IC       ENDIF 
          RJ     RSF         RETURN SYSTEM FILES
  
 IC       IFCARD
  
**        --   IF A CONTROL-CARD-INITIATED LOAD, AN EMPTY LOAD RESULTS
*              IN A FATAL ERROR.
* 
  
 CPL1B    SA5    PC 
          NZ     X5,CPL1A    IF LOAD IS NON-EMPTY 
 K        IFNOS 
          SA5    SEGFLAG
          NZ     X5,CPLE101  IF SEGMENT LOAD THEN DO NOT RETURN CARD
          SA5    SLDRCLD     CHECK IF ENTERED AT *SLDR=*
          NZ     X5,CPLE101  IF ENTERED AT *SLDR=*
          SA5    EX          PICK UP EXECUTE FLAG 
          ZR     X5,CPLE101  IF *NOGO*
          SA5    LOCFILE     NONZERO IFF LOCAL FILE LOAD
          NZ     X5,CPLE101  IF LOCAL FILE LOAD 
          SA5    EXPCCEX     NON-ZERO IFF EXPLICIT *EXECUTE* CON CARD 
          NZ     X5,CPLE101  IF EXPLICIT *EXECUTE* CONTROL CARD 
          SA1    CTLPT       CHECK IF THIS WAS PASSED BY *1AJ*
          LX1    59-49
          PL     X1,CPL1B1   IF *1AJ* HAS NOT ALREADY DONE SEARCH 
          ERROR  CAT,NOFIND  DO NOT GIVE CARD BACK TO SYSTEM
  
 CPL1B1   SA2    VHD
          ZR     X2,CPL1B2   IF NO $ DELIMITERS IN COMMAND VERB 
          ERROR  CAT,(=C* ILLEGAL LOADER CONTROL STATEMENT*)
  
 CPL1B2   BSS    0
          MESSAGE  (=C* LOAD SEQUENCE IGNORED *),R
          MESSAGE  (=C* NEXT CONTROL STATEMENT GIVEN BACK TO SYSTEM*),R 
          SA5    TCSBACK     GIVE CONTROL BACK TO KRONOS *1AJ*
          BX6    X5 
          RJ     SYS=        CALL *TCS* TO EXECUTE CONTROL CARD 
+         EQ     *
 CPLE101  SA5    PC 
 K        ENDIF 
          ERROR  101         ---- EMPTY LOAD
          SA4    MAPTYPE     IF A MAP IS REQUESTED, FORCE 
          ZR     X4,CPL12    MINIMUM-SIZE MAP FOR EMPTY LOAD
          SX7    B1          (STATISTICS AND ERRORS)
          SA7    A4 
          EQ     CPL12       GO FOR MAP, IF REQUESTED 
  
          IFNOS  2
 NOFIND   DATA   10H
          DATA   C*NOT IN LIBRARY SET*
 CPL1A    BSS    0
  
          IFTEST NE,IP.TRAP,0,1 
          SA5    TRAPADR     (X5) = NZ IF *TRAP* RUN
  
 IC       ENDIF 
  
**        --   IF ANY LOADING OCCURRED FROM OTHER THAN SYSTEM LIBRARIES,
*              THE SYSTEM PROTECT BIT IS SET IN THE CONTROL POINT 
*              AREA AT WORD *W.CPLDR1*, BYTE *C.CPLP*, BIT *S.CPLP*.
* 
  
          SA1    TLFN        SCAN *TLFN* FOR A NON-LIBRARY FILE 
          SA2    A1+B1
          IX2    X2+X1
          SB2    X1 
          SB3    X2 
 CPL2P    SB2    B2+B1       ADVANCE FETCH ADDRESS
          GE     B3,B2,CPL2Q IF MORE *TLFN* ENTRIES 
          MX7    0           ALL LOADING WAS FROM SYSTEM
          SA7    MAPTYPE     LIBRARIES, SO SUPPRESS MAP 
          SX7    B1 
          SA7    NOPRO       INDICATE ALL LOADING WAS FROM SYSTEM 
          MX7    60 
          SA7    MAPFLAG     INDICATE MAP WAS SUPPRESSED
          EQ     CPL2R       DO NOT SET BIT 
  
          IFSCOPE  1
 LDLPBIT  VFD    26/0,1/1,6/S.CPLP,3/C.CPLP,12/W.CPLDR1,12/0
 NOPRO    CON    0           IF NZ, PROTECT BIT WILL NOT BE SET 
  
 CPL2Q    SA3    B2-B1       NEXT *TLFN* ENTRY
          LX3    59-1        CHECK SYSTEM LIBRARY INDICATOR 
          NG     X3,CPL2P    IF SYSTEM LIBRARY
 CPL2R    BSS    0
  
 IC       IFCARD
 IT       IFTEST NE,IP.TRAP,0 
  
**        --   IF A CONTROL-CARD-INITIATED LOAD, AND IF A *TRAP* RUN IS 
*              TO TAKE PLACE, THE ENTRY ADDRESS TO THE *TRAP* ROUTINE 
*              IS DETERMINED AND SAVED IN ORDER TO BE USED AS A 
*              SUBSTITUTE TO THE ACTUAL TRANSFER ADDRESS. 
* 
  
          ZR     X5,CPL2H    IF NOT A *TRAP* RUN
          SA1    =0L"TRAPNAME"     USE SPECIAL XFER ADDRESS 
          MX2    0
          RJ     ELT
          SX7    X2          SAVE ADDRESS 
          SA7    TRAPADR
 CPL2H    BSS    0
 IT       ENDIF 
  
**        --   IF THE PROGRAM IS NOT IN REDUCE MODE, THE NOMINAL FL 
*              (LAST RFL) MUST BE LARGE ENOUGH TO HOLD THE PROGRAM OR 
*              THE JOB IS ABORTED.  NOTE THAT BLANK COMMON HAS NOT YET
*              BEEN ALLOCATED.  IF THAT MAKES THINGS TOO BIG, A 
*              NONFATAL ERROR WILL BE GIVEN AT THAT TIME. 
  
          SA1    EF 
          PL     X1,CPL2C    IF IN REDUCE MODE
          SA1    NFL         (X1) = NOMINAL FL
          NE     B6,B1,CPL2C IF NO *EXECUTE*
          LX1    6
          SA2    TBLK 
          SA2    X2+B1
          SX2    X2          (X2) = LWA+1 OF LOAD 
          IX2    X1-X2
          PL     X2,CPL2C    IF ENOUGH ROOM 
          ERROR  107         ---- INSUFFICIENT FL FOR EXECUTION 
          EQ     CPL2I
  
**        --   THE EXECUTION FIELD LENGTH IS NOW DETERMINED.  FOR 
*              CONTROL-CARD-INITIATED LOADS, IT IS DONE AS FOLLOWS:            .
* 
*              A)   THE BLANK COMMON LENGTH IS ADDED TO THE BLANK COMMON
*                   ORIGIN.  IF THERE IS NO BLANK COMMON, THIS IS SIMPLY
*                   THE LWA+1 OF THE LAST BLOCK LOADED. 
* 
  
 CPL2C    SA2    TBLK        EXECUTION FIELD LENGTH 
          SA4    X2+B1       = BLANK COMMON ORIGIN
          SX1    X4          BLANK COMMON LENGTH
          AX4    24 
          SX4    X4 
          IX6    X1+X4       (X6) = LWA+1 OF LOAD 
  
**             B)   THIS AMOUNT IS ROUNDED UP TO AN EVEN 100B IN A
*                   MANNER THAT ALLOWS A MINIMUM OF 4 AND A MAXIMUM      LDR0199
*                   OF 103B WORDS OF PADDING IN CASE THE FIELD LENGTH    LDR0199
*                   IS REDUCED.  THIS IS THE EXECUTION FIELD LENGTH.
* 
  
          R=     X1,103B
          IX1    X1+X6       ROUND UP FL BY 103B
          MX7    -6 
          BX1    X7*X1       (X1) = EXECUTION FL
  
**             C)   BLANK COMMON IS TRUNCATED IF THE MAXIMUM AVAILABLE
*                   FL IS TOO SMALL, OR IF THE JOB IS NOT IN REDUCE MODE
*                   AND THE NOMINAL FL (LAST RFL) IS TOO SMALL. 
  
          SA2    MFL         (X2) = MAXIMUM FL
          SA5    EF 
          NE     B6,B1,CPL2E IF NO *EXECUTE*
          PL     X5,CPL2D    IF IN REDUCE MODE
          SA2    NFL
          LX2    6           NO, USE LAST RFL AS MAXIMUM
 CPL2D    IX3    X2-X1
          PL     X3,CPL2E    IF ENOUGH
          R=     X1,77B 
          IX1    X1+X6       ROUND UP FL BY 77B 
          BX1    X7*X1
          IX3    X2-X1
          PL     X3,CPL2E    IF ENOUGH WITHOUT EXTRA THREE WORDS
          SA4    A4 
          LX4    -24
          IX6    X4+X3       REDUCE LGTH OF BLANK COMMON BY NEEDED AMT
          LX6    24 
          SA6    A4 
          BX7    -X3
          LX7    18 
          ERROR  4105,X7     ---- CM BLANK COMMON TRUNCATED BY 0000B WDS
          EQ     CPL2C       REPEAT - WILL BE OK NOW
  
 CPL2E    BX7    X5+X1       STORE REDUCE BIT + EXEC FL 
          SA6    PA          STORE FINAL PROGRAM ADDRESS
          SA7    A5 
 CPL2E1   BSS    0
  
**             D)   THE ECS EXECUTION FIELD LENGTH IS COMPUTED IN THE 
*                   THE SAME MANNER, EXCEPT THAT THERE IS CURRENTLY 
*                   NO CAPABILITY FOR MODIFYING THE ECS FIELD LENGTH. 
* 
  
 ECS      IFTEST NE,IP.MECS,0 
 CPL2F    SB2    B1+B1
          MX7    -24         SET FINAL ECS PROGRAM ADDRESS
          SA4    A4+B2       = ECS BLANK COMMON ORIGIN
          BX2    -X7*X4      + ECS BLANK COMMON LENGTH
          AX4    24 
          BX4    -X7*X4 
          SA3    ECSFL
          IX6    X2+X4       (X6) = FINAL ECS PROGRAM ADDRESS 
          IX4    X3-X6       (CURRENT ECS FL) - (ECS PROG ADR)
          PL     X4,CPL2G    IF ROOM FOR ECS BLANK COMMON 
          NE     B6,B1,CPL2G IF NO *EXECUTE*
          SA1    A4          REDUCE ECS BLANK COMMON LENGTH 
          BX7    -X4
          LX4    24          BY THE EXCESS
          IX6    X1+X4
          SA6    A1 
          SA5    A4-B2       SAVE A4
          LX7    18 
          MX1    -1 
          BX7    -X1+X7      FLAG ECS //, NUMBER OF WORDS TRUNCATED 
          ERROR  4105,X7     ---- ECS BLANK COMMON TRUNCATED
          SA4    A5          RESTORE A4 
          EQ     CPL2F       REPEAT - WILL BE ENOUGH NOW
  
 CPL2G    SA6    ECSPA       STORE FINAL ECS PROGRAM ADDRESS
 ECS      ENDIF 
 IC       ENDIF 
 IU       IFUSER
  
**        --   FOR USER-CALL LOADS, THE EXECUTION FIELD LENGTH PROCEDURE
*              INVOLVES ONLY COMPUTING ENDING LOAD ADDRESS AND CHECKING 
*              FOR BLANK COMMON OVERFLOW, SINCE THERE IS NO FIELD LENGTH
*              REDUCTION CAPABILITY.  IT HAS TO BE NOTED THAT THE ENDING
*              LOAD ADDRESS MIGHT NOT ALWAYS BE THE END OF BLANK COMMON,
*              SINCE BLANK COMMON MAY HAVE BEEN ESTABLISHED DURING AN 
*              EARLIER LOAD.
* 
 CPL2A    SA1    /READ/BCOM 
          SA2    TBLK 
          SA4    X2+B1       CM // *TBLK* ENTRY 
          NZ     X1,CPL2C    IF PREVIOUS OR NO CM //
          SB2    X4 
          AX4    24          (X6) = BLANK COMMON LWA+1
          SX6    X4+B2
          SA1    TEND 
          R=     X1,X1+TABOO
          IX2    X1-X6       (LWA LOADABLE AREA) - (BL COM LWA+1) 
          PL     X2,CPL2B    IF ROOM FOR BLANK COMMON 
          SA1    A4          REDUCE THE BLANK COMMON LENGTH 
          BX7    -X2
          LX2    24          BY THE EXCESS
          IX6    X1+X2
          SA6    A1 
          LX7    18          FLAG CM //, NUMBER OF WORDS TRUNCATED
          ERROR  4105,X7     ---- CM BLANK COMMON TRUNCATED 
          EQ     CPL2A       REPEAT - WILL FIT THIS TIME
  
 CPL2B    SA6    PA          ADVANCE CM PROG ADR TO INCLUDE //
 CPL2C    BSS    0
 ECS      IFTEST NE,IP.MECS,0 
          SB2    B1+B1       DETERMINE MAX ECS ADDRESS
          SA4    A4+B2       IN SAME MANNER AS FOR CM 
          MX7    -24
          BX2    -X7*X4 
          SA3    /READ/BCOM+1 
          NZ     X3,CPL2E    IF PREVIOUS OR NO ECS // 
          SA1    ECSLWA 
          AX4    24 
          BX4    -X7*X4 
          IX6    X2+X4
          IX2    X1-X6
          SA1    A4 
          PL     X2,CPL2D    IF ROOM FOR NEW ECS BLANK COMMON 
          BX7    -X2
          LX2    24          REDUCE ECS BLANK COMMON LENGTH 
          IX6    X1+X2       BY THE EXCESS
          SA6    A1 
          SB7    A4-B2       SAVE A4
          LX7    18 
          MX1    -1 
          BX7    -X1+X7      FLAG ECS //, NUMBER OF WORDS TRUNCATED 
          ERROR  4105,X7     ---- ECS BLANK COMMON TRUNCATED
          SA4    B7          RESTORE A4 
          EQ     CPL2C       REPEAT - WILL FIT THIS TIME
  
 CPL2D    SA6    ECSPA       ADVANCE ECS PROG ADR TO INCLUDE // 
 CPL2E    BSS    0
 ECS      ENDIF 
 IU       ENDIF 
  
**        --   EXECUTION PARAMETERS, IF ANY WERE SPECIFIED IN AN
*              *EXECUTE* REQUEST, ARE NOW MOVED FROM *TREQ* TO THE
*              COMMUNICATION AREA BEGINNING AT RA+2.  FOR CONTROL-CARD- 
*              INITIATED LOADS, THE REMAINING WORDS UP TO RA+54B ARE
*              CLEARED. 
* 
*              IF UNDER KRONOS/NOS AND ENTRY WAS AT *SLDR=*,
*              THEN WE MUST LEAVE THE COMMUNICATION AREA ALONE, 
*              AS IT HAS ALREADY BEEN SETUP FOR US. 
* 
* 
  
 CPL2I    SA1    TREQ 
          SA2    X1          REQUEST HEADER 
          MX0    -12
          SA5    A2+B1       SAVE ENTRY NAME, IF PRESENT
 SEG      IFCARD
          SA1    SEGFLAG
          ZR     X1,CPL2J    IF NOT SEGMENT LOAD
          SA1    FE 
          NZ     X1,CPL2J    IF FATAL ERROR THEN NO LOAD TABLE
          SA2    A2+2 
          SA1    ABS
          SA5    A5+2        SKIP DUMMY *LOAD* REQUEST IN *TREQ*
          NZ     X1,CPL9A    IGNORE TRANSFER NAME 
 CPL2J    BSS    0
 SEG      ENDIF 
          NE     B6,B1,CPL4  IF NOT *EXECUTE* 
  
 IC       IFCARD
  
 K        IFNOS 
          SA3    SLDRCLD     CHECK IF ENTERED AT *SLDR=*
          NZ     X3,CPL4     IF ENTERED AT *SLDR=*
 K        ENDIF 
 CPL3B    LX2    -36         (X0) = PARAM COUNT 
          BX2    -X0*X2 
          SX0    -B1
          IX0    X2+X0
          PL     X0,CPL3C    IF *EXECUTE* REQUEST OF ZERO LENGTH
          MX0    0           NO PARAMS
          MX5    0           NO ENTRY NAME
 CPL3C    SA3    TPGM        (X3) = PARAM STORE ADDRESS 
          SX3    X3+RA+COMARGS
          MOVE   X0,A5+B1,X3 MOVE PARAMS
 CPL3E    SA1    TPGM        STORE PARAMETER COUNT
          SA1    X1+RA+COMARGCT 
          MX2    -18
          BX6    X2*X1
          IX6    X0+X6
          SA6    A1 
  
**        --   THE STARTUP PROGRAM (3 WORDS IN LENGTH) IS PLACED IN THE 
*              COMMUNICATION AREA.  CONTROL PASSES FROM THE MOVE-DOWN 
*              PROGRAM (SEE *EXP*) TO THIS PROGRAM.  IT INSURES THAT
*              RA+1 IS CLEAR, STORES (X7) IN RA+1, WAITS FOR RA+1 TO
*              CLEAR AGAIN, AND THEN ENTERS THE PROGRAM AT THE
*              TRANSFER ADDRESS WHICH HAS PREVIOUSLY BEEN PLACED IN A5. 
* 
  
 CPL4     SA1    STARTER     SET START-UP PROGRAM 
          SA3    TPGM 
          SA2    A1+B1
          BX6    X1 
          LX7    X2 
          SA4    A2+B1
          SA6    X3+RA+COMBOOT
          SA7    A6+B1
          BX6    X4 
          SA6    A7+B1
  
 IC       ENDIF 
 IU       IFUSER
  
          LX2    -36
          BX2    -X0*X2 
          SX0    -B1         (X0) = PARAMETER COUNT 
          IX0    X2+X0
          PL     X0,CPL3A 
          MX0    0
          MX5    0           NO ENTRY NAME SPECIFIED
 CPL3A    R=     X2,42       CHECK VALIDITY OF PARAM COUNT
          IX3    X2-X0       MAXIMUM = 42 
          PL     X3,CPL3B    IF NOT TOO MANY
          IX0    X0+X3       SET PARAM COUNT = 42 
          ERROR  4272        ---- TOO MANY PARAMS IN EXECUTE REQUEST
 CPL3B    BX1    X0          MOVE PARAMETERS
          SX2    A5+B1
          SA3    TPGM 
          SB5    X3 
          R=     X3,X3+RA+COMARGS 
          RJ     MVE= 
          R=     A1,B5+RA+COMARGCT  STORE PARAMETER COUNT 
          MX2    -18
          BX6    X2*X1
          IX6    X0+X6
          SA6    A1 
 CPL4     BSS    0
  
**        --   THE TRANSFER ADDRESS IS NOW DETERMINED.  FOR USER-CALL 
*              LOADS, IT IS SELECTED AS FOLLOWS 
* 
*              1)   IF THE LAST REQUEST WAS *EXECUTE*:  IF THE *EXECUTE*
*                   REQUEST SPECIFIED AN ENTRY POINT NAME, THAT NAME IS 
*                   USED.  OTHERWISE, THE LAST *XFER* NAME ENCOUNTERED
*                   IS USED.
* 
*              2)   IF THE LAST REQUEST WAS ANYTHING OTHER THAN 
*                   *EXECUTE*:  IF THE PREVIOUSLY LOADED AREA WAS 
*                   OVERWRITTEN BY THIS LOAD, THE LAST *XFER* NAME
*                   ENCOUNTERED IS USED.  OTHERWISE, THE POINT FROM 
*                   WHICH THE USER CALL WAS ISSUED IS USED. 
* 
  
          MX0    42 
          SX2    B0          INDICATE SEARCH ONLY TO *ELT*
          NE     B6,B1,CPL5  IF NOT *EXECUTE* 
          ZR     X5,CPL5     IF NO ENTRY NAME SPECIFIED 
          BX1    X5          TRANSFER ADDRESS = ENTRY NAME
          RJ     ELT         GET DEFINITION 
          SX2    X2          MERGE NAME AND ADDRESS 
          BX5    X0*X5
          IX3    X2+X5
          EQ     CPL7 
  
 CPL5     SA1    XF+1        GET XFER NAME ADDRESSES, IF PRESENT
          RJ     ELT         GET DEFINITION 
          SA5    A1          RE-FETCH 1ST NAME
          SX2    X2          MERGE WITH ADDRESS 
          BX5    X0*X5
          SA1    A1+B1       2ND XFER NAME, IF PRESENT
          IX7    X2+X5
          SA7    A1-B1
          MX2    0
          RJ     ELT         GET DEFINITION 
          SA5    A1          RE-FETCH 2ND NAME
          SX2    X2          MERGE WITH ADDRESS 
          BX5    X0*X5
          IX7    X2+X5
          SA7    A1 
          EQ     B6,B1,CPL6  IF *EXECUTE* 
          SA2    OVERLOAD 
          SA3    RETURN      USE RETURN ADDRESS IF NO OVERWRITE 
          ZR     X2,CPL7     IF OVERWRITE, USE LAST XFER
 CPL6     SA3    XF+1        LAST XFER
          BX1    -X0*X3      TRANSFER ADDRESS 
          NZ     X1,CPL7     IF 1ST XFER DEFINED
          SA3    A3+B1       USE 2ND XFER 
 CPL7     BX7    X3          STORE TRANSFER ADDRESS 
          SA7    XF 
  
 IU       ENDIF 
 IC       IFCARD
 K        IFNOS 
  
**        --   FOR CONTROL CARD INITIATED ABSOLUTE LOADS, THE ENTRIES 
*              *MFL=* AND *RFL=* HAVE SPECIAL MEANINGS.  IN ORDER TO
*              MORE EFFICIENTLY USE CENTRAL MEMORY FOR SOME PROGRAMS, 
*              THESE ENTRIES HAVE THE SAME MEANING AS THEY WOULD IF 
*              THEY WERE LOADED FROM THE SYSTEM OR A GLOBAL LIBRARY.
* 
*              1)   THE *MFL=* ENTRY POINT PROVIDES THE MINIMUM FIELD 
*                   LENGTH NEEDED BY THE PROGRAM.  IT REPLACES *EF*.
* 
*              2)   THE *RFL=* ENTRY POINT PROVIDES THE EXECUTION FIELD 
*                   LENGTH.  IT REPLACES *NFL*. 
* 
*              ALSO, PRESENCE OF THE ENTRY POINT *SDM=* IS CHECKED, AND 
*              IF FOUND, IT INDICATES THAT THE LOADER MUST NOT DAYFILE
*              THE COMMAND THAT LOADED IT, PROVIDED LOADING WAS FROM A
*              SYSTEM LIBRARY.
* 
  
          SA1    ABS
          SB4    B0          FLAG NO *MFL=* OR *RFL=* PRESENT 
          ZR     X1,CPL4.7   IF NOT AN ABSOLUTE LOAD
          SA1    TOVEPT      POINTER TO OVLY ENTRY POINT NAMES
          SA2    A1+B1       (B3) = LENGTH OF LIST
          SB2    B0          CHECK FOR *RFL=* ENTRY POINT 
          SA3    =C*RFL=* 
          MX0    42 
          SB3    X2 
 CPL4.1   SA4    X1+B2       GET NEXT ENTRY POINT NAME
          EQ     B2,B3,CPL4.2  IF NOT FOUND 
          BX2    X0*X4       EXTRACT NAME 
          IX6    X2-X3       COMPARE TO *RFL=*
          SB2    B2+B1
          NZ     X6,CPL4.1   IF NOT ALL ENTRIES SEARCHED
          SX6    X4+77B      ROUND RFL VALUE TO NEXT 100B 
          AX6    6           AND LEAVE AS MULTIPLE OF 100B
          SA6    NFL         NEW NOMINAL FIELD LENGTH 
          SB4    B1+         FLAG MFL=/RFL= PRESENT 
 CPL4.2   SB2    B0+         NOW CHECK FOR *MFL=* ENTRY POINT 
          SA3    =C*MFL=* 
 CPL4.3   SA4    X1+B2
          EQ     B2,B3,CPL4.5  IF NOT FOUND 
          BX2    X0*X4       EXTRACT NAME 
          IX6    X2-X3       COMPARE TO *MFL=*
          SB2    B2+B1
          NZ     X6,CPL4.3   IF NOT ALL ENTRIES SEARCHED
          MX0    -16         MAY NEED TO REMOVE A 200000B OFFSET
          BX6    -X0*X4      EXTRACT VALUE
          SA6    EF 
          SB4    B1+         FLAG MFL=/RFL= ENTRY POINT PRESENT 
 CPL4.5   SX6    B4+         NON-ZERO IF MFL= OR RFL= PRESENT 
          SA6    SEPF 
          SA3    SDMFLAG     IF NOT LOADED FROM SYSTEM, DO NOT CHECK
          MI     X3,CPL4.7    FOR *SDM=* ENTRY POINT
          SB2    B0          CHECK FOR *SDM=* 
          SA3    =C*SDM=* 
 CPL4.6   SA4    X1+B2       NEXT *TOVEPT* ENTRY
          EQ     B2,B3,CPL4.7  IF NOT FOUND 
          BX2    X0*X4
          IX6    X2-X3       COMPARE TO *SDM=*
          SB2    B2+B1
          NZ     X6,CPL4.6   IF NOT ALL ENTRIES SEARCHED
          SX7    B1          *SDM=* PRESENT, DO NOT DAYFILE LAST COMMAND
          SA7    SDMFLAG
          EQ     CPL4.8 
  
 CPL4.7   SA4    DFMFLAG     DAYFILE THE FINAL COMMAND IN LOAD SEQUENCE 
          NZ     X4,CPL4.8   IF ALREADY ISSUED
          SX6    COMLDCC
          SA6    A4 
          MESSAGE  X6,R 
 CPL4.8   BSS    0
 K        ENDIF 
  
**        --   FOR CONTROL-CARD-INITIATED LOADS, THE TRANSFER ADDRESS IS
*              SELECTED AS FOLLOWS:                                            .
* 
*              1)   FOR ABSOLUTE LOADS:  IF AN ENTRY POINT NAME WAS 
*                   SPECIFIED ON AN *EXECUTE* REQUEST, THAT NAME IS 
*                   USED.  IT IS EXPECTED THAT THE NAME APPEARED IN AN
*                   ENTRY POINT LIST IN THE OVERLAY HEADER.  IF NO
*                   ENTRY NAME WAS SPECIFIED, THE FIRST (OR ONLY) ENTRY 
*                   ADDRESS FROM THE OVERLAY HEADER IS USED.
* 
*              2)   FOR RELOCATABLE LOADS:  IF AN ENTRY POINT NAME WAS
*                   SPECIFIED ON AN *EXECUTE* REQUEST, THAT NAME IS 
*                   USED.  OTHERWISE THE ADDRESS OF THE FIRST NAME
*                   SPECIFIED ON AN *EPT=* REQUEST IS USED.  OTHERWISE
*                   THE ADDRESS OF THE LAST ENCOUNTERED *XFER* NAME 
*                   IS USED.
* 
  
          SA1    ABS
          ZR     X1,CPL7     IF NOT ABSOLUTE LOAD 
          SA1    TOVEPT      POINTER TO OVLY ENTRY POINT NAMES
          SA2    A1+B1       (B3) = LENGTH OF LIST
          SB2    B0 
          MX0    42 
          SB3    X2 
          SX3    B0          SET FOR NO ADDRESS 
          NE     B6,B1,CPL6  IF NOT *EXECUTE* 
          BX5    X0*X5
          ZR     X5,CPL6     IF ENTRY NAME NOT SPECIFIED
          EQ     B3,B1,CPL6  IF ONLY ONE ENTRY IN LIST (EG 50-OVL 
 CPL5     SA4    X1+B2       FIND NAME IN OVLY ENTRY PT LIST
          EQ     B2,B3,CPL9  IF ENTRY LIST EXHAUSTED
          BX6    X0*X4       EXTRACT NAME 
          IX6    X6-X5       COMPARE WITH DESIRED NAME
          SB2    B2+B1
          NZ     X6,CPL5     LOOP THROUGH LIST
          BX3    -X0*X4      NAME FOUND - SET ADDRESS 
          EQ     CPL9 
  
 CPL6     SA1    X1          GET 1ST ADDRESS IN LIST, IF PRESENT
          BX3    -X0*X1 
          EQ     CPL9 
  
 CPL7     MX0    42 
          SX2    B0          INDICATE SEARCH ONLY TO *ELT*
          NE     B6,B1,CPL8  IF NOT *EXECUTE* 
          BX5    X0*X5
          ZR     X5,CPL8     IF NO ENTRY NAME SPECIFIED 
          BX1    X5          TRANSFER ADDRESS = ENTRY NAME
          RJ     ELT         GET DEFINITION 
          SX2    X2          MERGE NAME AND ADDRESS 
          BX5    X0*X5
          IX3    X2+X5
          EQ     CPL9 
  
 CPL8     SA1    XF+1        GET ADDRESSES OF XFER NAMES, 
          RJ     ELT         GET DEFINITION 
          SA5    A1          RE-FETCH 1ST NAME
          SX2    X2          MERGE WITH ADDRESS 
          BX5    X0*X5
          SA1    A1+B1       2ND XFER NAME, IF PRESENT
          IX7    X2+X5
          SA7    A1-B1
          MX2    0
          RJ     ELT         GET DEFINITION 
          SA5    A1          RE-FETCH 2ND NAME
          SX2    X2          MERGE WITH ADDRESS 
          BX5    X0*X5
          IX7    X2+X5
          SA7    A1 
          SA3    A1-B1       FETCH 1ST TRANSFER ADDRESS 
          BX1    -X0*X3 
          NZ     X1,CPL9     IF 1ST XFER IS DEFINED 
          SA3    A3+B1       USE 2ND XFER 
 CPL9     BX7    X3          STORE TRANSFER ADDRESS 
          SA7    XF 
  
 IC       ENDIF 
  
**        --   THE TRANSFER ADDRESS HAS NOW BEEN RECORDED.  UNLESS THE
*              FINAL REQUEST WAS *NOGO*, A FATAL ERROR WILL OCCUR IF
*              THERE WAS NO TRANSFER ADDRESS, OR IF THE ENTRY POINT 
*              OR *XFER* NAME WHICH IS TO BE USED IS NOT PRESENT IN THE 
*              LOAD.
* 
  
          SX7    X7 
          ZR     B6,CPL9A    IF *NOGO*
          NZ     X7,CPL9A    IF KNOWN TRANSFER ADDRESS
          ERROR  102         ---- NO TRANSFER ADDRESS 
  
**        --   THE SUBROUTINE *WLI* IS NOW CALLED TO DETERMINE IF IT IS 
*              NECESSARY TO, AND IF NECESSARY, UPDATE THE LOADER
*              INFORMATION TO BE SAVED FOR PROCESSING USER CALLS OR 
*              *TRAP* RUNS. 
* 
  
 CPL9A    RJ     WLI         WRITE LOADER TABLES, IF NECESSARY
  
**        --   FOR CONTROL-CARD-INITIATED LOADS, SUBROUTINE *B54* IS
*              CALLED TO BUILD A 54-TABLE IN *TPGM*.
  
 CPL10    BSS    0
 IC       IFCARD
          RJ     B54
          RJ     SDE         SET DEBUG ENTRY ADDRESS
 IS       IFSCOPE 
          SA1    NOPRO
          NZ     X1,CPL10B   IF ALL LOADING WAS FROM SYSTEM 
          LDL    LDLPBIT     SET PROTECT BIT IN CONTROL POINT AREA
 CPL10A   BSS    0
          SA2    DFMFLAG
          NZ     X2,CPL10C   IF MESSAGE ALREADY ISSUED
          SA1    TPGM 
          BX6    X1 
          R=     X1,X1+70B
          SA6    A2          INDICATE MESSAGE ISSUED
          MESSAGE X1,R,6     DAYFILE THE COMMAND (NOT TO TERMINAL)
          EQ     CPL10C 
  
 CPL10B   SA1    SDMFLAG
          R=     X1,X1-1
          MI     X1,CPL10A
 CPL10C   BSS    0
 IS       ENDIF 
 IC       ENDIF 
  
**        --   THE SUBROUTINE *WOV* IS CALLED TO WRITE THE CORE IMAGE OF
*              THE LOAD AS AN ABSOLUTE (0,0) OVERLAY, IF THE FOLLOWING
*              CONDITIONS ARE MET 
* 
*              1)   THERE WERE NO FATAL ERRORS. 
*              2)   THE LOAD WAS NOT AN ABSOLUTE LOAD.
*              3)   THE LOAD TERMINATED WITH A *NOGO* REQUEST.  *WOV* 
*                   EXITS IMMEDIATELY IF THE *NOGO* REQUEST DOES NOT
*                   SPECIFY THAT AN OVERLAY IS TO BE WRITTEN. 
* 
  
          SA1    FE 
          NZ     X1,CPL12    IF FATAL ERROR 
          IFCARD
          SA2    ABS
          NZ     X2,CPL11    IF ABSOLUTE LOAD 
          SA1    OF 
          ZR     X1,CPL12    IF OVERLAY NOT TO BE WRITTEN 
          SETFET L,A1,BINARY
          RJ     WOV         WRITE OVERLAY
          ENDIF 
          EQ     CPL12
          SPACE  1
**        --  ISSUE ERROR 4107 IF ABSOLUTE LOAD NOT FOLLOWED BY 
*             AN *EXECUTE* STATEMENT. 
* 
          SPACE  1
 CPL11    EQ     B6,B1,CPL12 IF *EXECUTE* 
          ERROR  4107        *ABSOLUTE LOAD NOT FOLLOWED BY EXECUTE*
  
 CPL12    BSS    0
  
*         --   ON NOS, ISSUE LAST COMMAND IN LOAD SEQUENCE TO DAYFILE 
*              IF NOT ALREADY DONE SO, AND IF NOT A SYSTEM LOAD WITH AN 
*              *SDM=* ENTRY POINT.
* 
  
  
 IC       IFCARD
 IN       IFNOS 
          SA1    SDMFLAG     =1 IFF SYSTEM PROGRAM WITH *SDM=*
          SX1    X1-1 
          PL     X1,CPL12A   IF *SDM=* IN EFFECT, NO DAYFILE MESSAGE
          SA2    DFMFLAG
          NZ     X2,CPL12A   IF MESSAGE ALREADY ISSUED
          SX6    B1 
          SA6    A2          INDICATE MESSAGE ISSUED
          MESSAGE  COMLDCC,R  FINAL COMMAND IS IN RA+70B
 CPL12A   BSS    0
 IN       ENDIF 
 IC       ENDIF 
  
*         --   MAP ENTRY FOR LOADS WITH NO ERRORS AND FOR LOADS THAT
*              ENCOUNTERED TABLE OVERFLOW MORE THAN ONE TIME. 
* 
*              NO TABLE MANAGEMENT MAY OCCUR FROM HERE UNTIL AFTER THE
*              MAP OVERLAY IS CALLED, OR AT ALL IF NO MAP IS GENERATED. 
*              IF EITHER OF THE FOLLOWING CONDITIONS APPLY, WE NOW CALL 
*              *LOADM* FOR CONTROL-STATEMENT-INITIATED LOADS OR *LOADUM*
*              FOR USER-CALL LOADS: 
* 
*              1)   THERE ARE FATAL OR NON-FATAL ERRORS.
*              2)   A MAP IS REQUESTED, THE LOAD IS A RELOCATABLE LOAD, 
*                   AND AT LEAST ONE PROGRAM WAS LOADED FROM A NON- 
*                   LIBRARY FILE. 
* 
*              IF A MAP IS REQUESTED, THE FORMAT OF *TLBC2* IS
*              CHANGED SO THAT EACH EXTERNAL NAME IS REPLACED WITH THE
*              INDEX OF THE 2ND WORD OF THE APPROPRIATE *TLNK* ENTRY. 
*              THIS MUST BE DONE NOW, RATHER THAN IN THE MAP ROUTINE, 
*              BECAUSE THE ROUTINE *ELT* IS OVERLAYED BY THE MAP
*              OVERLAY. 
* 
  
          SA1    FE          FATAL ERROR FLAG 
          SA2    NE          NON-FATAL ERROR FLAG 
          BX1    X1+X2
          IFCARD 2
          SA3    CPYF 
          BX1    X1+X3       CALL *LOADM* FOR COPY OF SPOOL FILE
          NZ     X1,CPL16    GO TO MAP ROUTINE IF ANY ERRORS
  
 K        IFNOS 
          IFCARD  2 
          SA1    XEQOF
          NZ     X1,CPL17    IF EXECUTE-ONLY FILE, NO MAP 
 K        ENDIF 
  
          IFCARD 2
          SA1    ABS
          NZ     X1,CPL17    BYPASS MAP IF ABSOLUTE LOAD
          SA2    MAPTYPE
          ZR     X2,CPL17    BYPASS MAP IF NOT REQUESTED
 CPL16    SA1    TLBC2       (B6) = *TLBC2* FWA 
          SA3    A1+B1       (B7) = *TLBC2* LWA+1 
          MX0    30          BYTE MASK
          IX3    X1+X3
          SB6    X1 
          SB7    X3 
 CPL16A   EQ     B6,B7,CPL16C      IF AT END OF *TLBC2* 
          MX2    0           (X2) = 0 MEANS *ELT* SEARCHES ONLY 
          SA1    B6          FETCH NEXT NAME
 SEG      IFCARD
          SA4    SEGFLAG
          SA3    TBLK 
          ZR     X4,CPL16A1  IF NOT SEGMENT LOAD
          SB2    X3 
          SA3    X1+B2       *TBLK* ENTRY OF SEGMENT MAKING REFERENCE 
          SX6    X3 
          AX6    4
          SA6    SN          SAVE SEGMENT ORDINAL FOR *ELT* 
 CPL16A1  BSS    0
 SEG      ENDIF 
          RJ     ELT         FIND *TLNK* ORDINAL
          IFCARD 4
          SA1    B6 
          SX1    X1          SEGMENT INDEX
          LX1    18 
          BX6    X1+X6       ADD TO *TLNK* INDEX
          SA6    B6          REPLACE NAME WITH ORDINAL
          SB6    B6+B1       ADVANCE FETCH POINTER
 CPL16B   EQ     B6,B7,CPL16C      IF AT END OF *TLBC2* 
          SA1    B6          NEXT WORD
          SB6    B6+B1       ADVANCE FETCH POINTER
          BX2    -X0*X1      LOOP TO LOWER 30 BITS = 0
          NZ     X2,CPL16B   IF NOT AT END OF TRAILER BYTES 
          EQ     CPL16A      LOOP 
  
 CPL16C   BSS    0
          SX2    LOCL        FWA OF MAP ROUTINE 
          SX3    MAPEND      LWA+1 OF MAP ROUTINE 
          IFCARD 1
          OVERLAY  LOADM,2,0,X2,X3
          IFUSER 2
          OVERLAY LOADUM,4,2,X2,X3                                       LDR0223
          RJ     /RRLOADUM/REL-1   GO RELOCATE MAP OVERLAY
          RJ     /LOADM/MAP  GO TO MAP ROUTINE
 CPL17    BSS    0
  
**        --   THE FWA AND LWA+1 OF THE LOAD ARE NOW PLACED IN RA+66B 
*              AND RA+65B, RESPECTIVELY.  THIS IS ALSO DONE FOR THE ECS 
*              CORE IMAGE IF THE ECS CODE IS ASSEMBLED. 
* 
*              IF CMM IS ACTIVE, ONLY RA+66 IS UPDATED. 
* 
  
          SA3    TPGM 
          SA4    PA          LWA+1 LOAD = FINAL PROGRAM ADDRESS 
          R=     A1,X3+RA+COMLDLWA  LWA+1 OF CM LOAD TO RA+65, BITS 0-17
          R=     A2,X3+RA+COMLDFWA  FWA OF CM LOAD TO RA+66,BITS 0-17 
          SB2    X1          SAVE CMM FLAG
  
 IC       IFCARD
          R=     A5,X3+RA+BASE     GET RA+100 
          AX5    54 
          R=     X5,X5-54B+77B
          NZ     X5,CPL17M   IF NO 54-TABLE 
          SA4    A5+B1
          SX4    X4          USE MINFL AS LWA+1 
 CPL17M   BSS    0
 IC       ENDIF 
  
          MX0    42 
          BX1    X0*X1
          SA3    PO          FWA LOAD = PROGRAM ORIGIN
          BX2    X0*X2
          IX6    X1+X4
          BX7    X2+X3
 ECS      IFTEST NE,IP.MECS,0 
          MX0    23 
          SA4    ECSPA       ECS LWA+1 TO RA+65, BITS 36-58 
          SA3    ECSPO       ECS FWA TO RA+66, BITS 36-58 
  
 IC       IFCARD
          NZ     X5,CPL17B   IF NO 54-TABLE 
          SA4    A5+B1
          AX4    18 
          MX5    -23
          BX4    -X5*X4      USE LMINFL AS LWA+1
 CPL17B   BSS    0
 IC       ENDIF 
  
          LX0    -1 
          BX6    -X0*X6 
          BX7    -X0*X7 
          LX4    36 
          LX3    36 
          BX6    X6+X4
          BX7    X7+X3
 ECS      ENDIF 
          SA7    A2          RA+66
          MI     B2,CPL17A   IF CMM UP, DONT CHANGE RA+65 
          SA6    A1          RA+65
 CPL17A   BSS    0
  
 IU       IFUSER
  
**        --   FOR USER-CALL LOADS, THE USER REPLY WORD (THE THIRD WORD 
*              IN THE USER CALL HEADER) IS SET WITH THE APPROPRIATE 
*              REPLY INFORMATION.  THIS CONSISTS OF THE ADDRESSES OF THE
*              TWO MOST RECENT *XFER* SYMBOLS, THE FATAL AND NON-FATAL
*              ERROR BIT SETTINGS, AND THE APPROPRIATE ERROR NUMBER,
*              IF NECESSARY.
* 
*              THIS UPDATING OF THE REPLY WORD DOES NOT TAKE PLACE IF 
*              THE LOADABLE AREA OVERWRITES THE AREA IN WHICH THE USER
*              CALL PARAMETER AREA RESIDED. 
* 
  
          SA1    NOREQ
          NZ     X1,CPL19    IF REPLY WORD CANNOT BE UPDATED
          SA1    FE          FATAL ERROR COUNT
          SA2    NE          NON-FATAL ERROR COUNT
          SA3    ERRNUM      ERROR NUMBER TO GO IN STATUS 
          SA4    XF+1        LAST XFER
          SA5    A4+B1       NEXT-TO-LAST XFER
          SX4    X4          ISOLATE ADDRESSES
          SX5    X5 
          ZR     X2,CPL18    IF NO NON-FATAL ERRORS 
          SX2    B1          SET BIT FOR NON-FATAL ERRORS 
 CPL18    LX5    18 
          ZR     X1,CPL18A   IF NO FATAL ERROR
          MX1    1           FATAL ERROR FLAG 
 CPL18A   LX2    58          FORM REPLY WORD
          LX3    36 
          BX1    X1+X2
          SB2    B1+B1
          BX3    X3+X4
          SA2    CALLADR     (X2) = FWA OF PARAM AREA 
          BX1    X1+X3
          BX6    X1+X5
          SA6    X2+B2       STORE REPLY
  
**        --   FOR USER-CALL LOADS, CONTROL NOW TRANSFERS TO THE
*              EXECUTION PROCESSOR *EXP*. 
* 
  
 CPL19    SA1    XF          (B5) = TRANSFER ADDRESS
          SB5    X1          GO TO EXECUTION PROCESSOR IF KNOWN 
          NZ     B5,EXP      TRANSFER ADDRESS 
          MESSAGE (=C*NO  RETURN ADDRESS FOR USER CALL*)
          EQ     ABORT
  
 IU       ENDIF 
 IC       IFCARD
  
**        --   FOR CONTROL-CARD-INITIATED LOADS, *ISD* IS CALLED TO 
*              ISSUE STATISTICS TO THE DAYFILE. 
  
          RJ     ISD
  
 K        IFNOS 
  
**        --   FOR CONTROL-CARD-INITIATED LOADS ON NOS ONLY,
*              *SSM* IS CALLED TO CLEAR THE SECURE SYSTEM MEMORY
*              BIT IF NECESSARY.
  
          RJ     SSM         CLEAR SSM STATUS IF NECESSARY
  
 K        ENDIF 
  
**        --   FOR CONTROL-CARD-INITIATED LOADS, CONTROL NOW TRANSFERS
*              TO THE EXECUTION PROCESSOR *EXP* IF EXECUTION OF THE 
*              LOADED PROGRAM IS TO TAKE PLACE.  OTHERWISE, THE CPU IS
*              EITHER DROPPED OR ABORTED, DEPENDING ON THE PRESENCE OF
*              A *NOGO* REQUEST AND/OR ERRORS.
  
          RJ     /MISC/CFA
          SA1    DEFER
          MI     X6,CPL18A   IF TO ABORT DUE TO *LDSET,ERR=* SETTING
          NZ     X1,CPL18B   IF DEFERRED LOAD WITHOUT ERRORS
 CPL18A   BX5    X6          SAVE ERROR FLAG
          RJ     SPYOFF      TURN OFF *SPY* 
          MI     X5,ABORT    IF TO ABORT
 CPL18B   SA5    XF 
          SB5    X5          (B5) = XFER ADDRESS
          SA4    EX 
          NZ     X4,CPL19    IF TO EXECUTE
          R=     X6,4RENDP/16 
          LX6    40 
          RJ     SYS=        ENDRUN 
  
 CPL19    BSS    0
          SA1    SEGFLAG
          ZR     X1,CPL20    IF NOT SEGMENT LOAD
          SA1    RA+COMRSS
          LX1    59-18
          PL     X1,CPL19.1  IF *RSS* FLAG NOT SET
          ENDRUN             RETURN TO SYSTEM 
  
 CPL19.1  SA1    FL 
          SA2    ECSFL
          SA0    X1          (A0) = CM FL 
          BX0    X2          (X0) = ECS FL
          SA3    TREQ 
          SA4    A3+B1
          SB6    X3          (B6) = FWA OF LOAD DIRECTIVES
          SB7    X4+B6       (B7) = LWA+1 OF LOAD DIRECTIVES
          SA1    MFL
          SA2    NFL
          SA5    EF 
          AX5    58 
          SB3    X5          (B3) > 0 FOR REDUCE MODE 
          SA3    PSMA 
          SA5    A3+B1       (X5) = PRESET VALUE
          SB2    X3          (B2) = PRESET FLAG 
          LX2    6
          SB4    X1          (B4) = MFL 
          SB5    X2          (B5) = NFL 
          OVERLAY SEGRES,0,0,0,0,EX 
  
 CPL20    NZ     B5,EXP      IF TRANSFER ADDRESS KNOWN
          MESSAGE (=C*CANNOT EXECUTE - NO TRANSFER ADDRESS*)
  
 IC       IFCARD
          SA4    EP          CHECK ERROR PROCESSING OPTION
          R=     X6,X4-2
          NZ     X6,CPL21    IF NOT ERROR=NONE
          RJ     RSF         RETURN SYSTEM FILES
          R=     X6,4RENDP/16  ISSUE *END* TERMINATION INSTEAD OF *ABT* 
          LX6    40 
          RJ     SYS= 
  
 CPL21    BSS    0
 IC       ENDIF 
  
          EQ     ABORT
  
          IFTEST NE,IP.TRAP,0,3 
 TRAPADR  VFD    26/0,1/0,6/S.CPLT,3/C.CPLT,12/W.CPLDR1,12/0  SET TO
                                   ZR OR NZ DEPENDING ON WHETHER OR NOT 
                                    *TRAP* RUN
  
 STARTER  SA1    B1          WAIT (RA+1) CLEAR
          NZ     X1,RA+COMBOOT
          SA7    A1          MAKE 2ND RA+1 REQUEST
          SA1    1           WAIT (RA+1) CLEAR
          NZ     X1,RA+COMBOOT+1
          SB5    A5          GET TRANSFER ADR AND ENTER PROGRAM 
          JP     B5 
 IC       ENDIF 
 RBE      SPACE  4,10 
**        RBE - RELOCATE BLANK COMMON ENTRY POINTS. 
* 
*              THIS SUBROUTINE IS CALLED FROM *CPL* AND */LOADG/CLO*
*         AND IS RESPONSIBLE FOR RELOCATING ENTRY POINTS FOUND IN 
*         BLANK COMMON.  THESE ENTRY POINTS ARE IN TABLE *TEPT1* AND
*         MUST BE RELOCATED AND ADDED TO TABLE *TEPT*.  ONCE THIS IS
*         DONE THEN TABLE *TEPT1* IS CLEARED AND *CPR* IS CALLED
*         TO ENTER THE NAMES INTO TABLE *TLNK* AND PERFORM OTHER
*         RELATED FUNCTIONS.
* 
*         USES   X - 0, 1, 2, 3, 4, 5.
*                B - 2, 3, 7. 
*                A - 1, 2, 3. 
* 
*         CALLS  ADW=, CPR, CTAB=.
* 
  
 RBE      PS                 ENTRY/EXIT 
          SA2    TEPT1+1     (X2) = *TEPT1* LENGTH
          ZR     X2,RBE      IF NO ENTRY POINTS IN // 
          SB7    X2          (B7) = *TEPT1* LENGTH
          SB3    B0          (B3) = *TEPT1* INDEX 
          SA1    TBLK        GET // ADDRESS FROM *TBLK* 
          MX4    -24
          SA2    X1+B1
          BX5    -X4*X2      (X5) = // ADDRESS
          SB2    B1+B1       (B2) = 2 
 RBE1     SA3    TEPT1       (X3) = *TEPT1* FWA 
          SA1    X3+B3       (X1) = FIRST WORD OF *TEPT1* ENTRY 
          SA3    A1+B1       (X3) = SECOND WORD OF *TEPT1* ENTRY
          IX0    X3+X5       (X0) = RELOCATED ENTRY POINT ADDRESS 
          SB3    B3+B2       BUMP INDEX 
          ADDWRD TEPT,X1     ADD FIRST WORD TO *TEPT* 
          ADDWRD A2,X0       ADD SECOND WORD TO *TEPT*
          LT     B3,B7,RBE1  IF NOT FINISHED WITH *TEPT1* 
          SA2    TEPT1
          RJ     CTAB=       CLEAR *TEPT1*
          RJ     CPR         COMPLETE READ
          EQ     RBE         EXIT 
  
 IC       IFCARD
 ISD      TITLE  ISSUE STATISTICS TO DAYFILE. 
**        ISD - ISSUE STATISTICS TO DAYFILE.
* 
*              THE INSTALLATION PARAMETER *IP.FLMSG* CONTROLS THE 
*         ISSUANCE OF A DAYFILE MESSAGE GIVING CORE REQUIREMENTS FOR
*         LOADING AND EXECUTION.  THE MESSAGE APPEARS ON A BASIC
*         RELOCATABLE LOAD IF NO MAP WAS SELECTED AND AT LEAST ONE
*         PROGRAM CAME FROM OTHER THAN A SYSTEM LIBRARY.  THE MESSAGE 
*         HAS THE FORM: 
* 
*                  CM LWA+1 = 22374B, LOADER USED  34700B 
* 
*         A SECOND LINE GIVING THE ECS LWA+1 IS PRESENT IF APPROPRIATE. 
* 
*              NO MESSAGE IS GIVEN IN THE MORE COMPLEX CASE OF AN 
*         OVERLAY GENERATION LOAD BECAUSE GIVING A SINGLE VALUE FOR 
*         LWA+1 COULD BE MISLEADING IN MANY CASES.
* 
*              IF IP.LRT IS NONZERO, A PERFORMANCE MESSAGE WILL BE
*         ISSUED FOR ALL LOADS.  THE MESSAGE HAS THE FORM 
* 
*                //LOADER    418      1.234 CP    12.345 RT 
*                //LOADER    034603/030000-040000 CM   5 TM 
* 
*         AND GIVES THE FOLLOWING INFORMATION:  
*                LOADER MOD LEVEL (SET BY *ID PSRLEVEL OR BY ML=) 
*                CP TIME USED BY THE LOADER 
*                REAL TIME (WALL CLOCK TIME) USED BY THE LOADER 
*                CM ACTUALLY USED 
*                CM ASSIGNED WHEN LOADER WAS INITIAITED 
*                CM ASSIGNED WHEN LOADER FINISHED 
*                NUMBER OF TABLE MOVES
* 
*         THE VALUE IF IP.LRT CONTROLS WHERE THE MESSAGE IS TO BE SENT. 
*         IF IP.LRT>1000B THEN THE VALUE (IP.LRT-1000B) WILL BE PLACED
*         IN BITS 35-24 OF THE *MSG* CALL; 0 WILL BE USED OTHERWISE.
* 
*         SINCE AN OVERLAY GENERATION LOAD TERMINATED BY AN EXPLICIT
*         OR IMPLICIT *EXECUTE* IS HANDLED AS TWO LOGICALLY SEPARATE
*         LOAD SEQUENCES, TWO PERFORMANCE MESSAGES WILL BE GIVEN IN 
*         THIS CASE.
  
  
 ISD      EQ     *+400000B   ENTRY/EXIT 
  
 CMSG     IFTEST NE,IP.FLMSG,0
          SA1    MAPFLAG
          NZ     X1,ISD2     IF MAP WRITTEN 
          MI     X1,ISD2     IF SUPPRESSED BECAUSE ALL FROM SYSTEM
          SA1    ABS
          NZ     X1,ISD2     IF ABS 
          SA1    OG 
          NZ     X1,ISD2     IF OVERLAY GENERATION
          SA1    PA          LWA+1
          SX6    X1-COMLTH-2
          MI     X6,ISD2     IF NOTHING LOADED
          RJ     COD
          SA1    CMSG+1 
          LX6    12 
          BX6    X6-X1
          SA6    A1          PUT IN MESSAGE 
          SA1    MU 
          R=     X1,X1+77B
          MX2    -6 
          BX1    X2*X1       ROUND CM USED UP TO MULTIPLE OF 100B 
          RJ     COD
          SA1    CMSG+3 
          LX6    6
          BX6    X6-X1
          SA6    A1 
  
 IE       IFTEST NE,IP.MECS,0 
          SA1    ECSPA       ECS LWA+1
          ZR     X1,ISD1     IF NO ECS
          RJ     COD
          SA1    =10H  ECS LWA+ 
          BX7    X1 
          SA7    CMSG+4      ENABLE SECOND LINE OF MESSAGE
          MX2    -6 
          BX7    -X2*X6 
          BX6    X2*X6
          LX6    -6 
          SA1    A7+B1
          BX6    X1-X6
          SA6    A1 
          LX7    6
          LD     X7,X7+1R 
          LX7    48 
          SA7    A6+B1
 IE       ENDIF 
  
 ISD1     MESSAGE CMSG,RCL   ISSUE MESSAGE
          SX6    1           SET LINE 1 RESET NECESSARY 
          SA6    ISDF 
 CMSG     ENDIF 
  
 ISD2     BSS    0
  
 LRT      IFTEST NE,IP.LRT,0
          SA2    RTM         STARTING REAL TIME 
          MX3    -36
          BX2    -X3*X2 
          RTIME  A2 
          SA1    X6          CURRENT REAL TIME
          BX1    -X3*X1 
          IX1    X1-X2       DIFFERENCE 
          MX2    -12
          BX7    -X2*X1      CONVERT FRACTION INTO MSEC 
          BX1    X2*X1       (X1) = INTEGRAL SECONDS
          LX3    X7,B1       *2 
          IX3    X3+X7       *3 
          LX7    7           *128 
          IX7    X7-X3       *125 
          AX7    9           *125/512 = *1000/4096 = MSEC 
          IX1    X1+X7       SECONDS + MSEC 
          RJ     TCV=        CONVERT TIME 
          MX0    42 
          LX6    18 
          SA1    =3R RT 
          BX5    -X0*X6 
          BX6    X0*X6
          IX6    X6+X1
          SA6    PMSG+3      PUT RT SEC IN MESSAGE
          TIME   T1 
          SA1    X6 
          MX3    24 
          BX1    -X3*X1      (X1) = CP TIME 
          SA2    TM          (X2) = START TIME
          IX1    X1-X2
          RJ     TCV=        CONVERT DIFFERENCE 
          LX6    36 
          MX0    30 
          BX7    X0*X6
          BX6    -X0*X6 
          IX7    X7+X5
          R=     X4,2RCP
          LX4    18 
          IX7    X7+X4
          SA7    PMSG+2      PUT CP SEC IN MESSAGE
          SA1    A7-B1
          BX6    X6+X1
          SA6    A1 
          SA1    MU          (X1) = CM USED 
          SA2    FLI         (X2) = FL INITIALLY
          SA3    FL          (X3) = FL NOW
  
*         CONVERT THEM ALL TO DISPLAY CODE SIMULTANEOUSLY 
  
          R=     B2,6 
          MX4    0
          BX5    X5-X5
          SX6    B0 
          MX0    57 
 ISD3     BX7    -X0*X1 
          BX4    X4+X7
          BX7    -X0*X2 
          BX5    X5+X7
          BX7    -X0*X3 
          BX6    X6+X7
          LX0    6
          LX1    3
          LX2    3
          LX3    3
          SB2    B2-B1
          GT     B2,ISD3
          SA1    =6R000000
          IX4    X4+X1
          IX5    X5+X1
          IX6    X6+X1
  
*         PUT IN MESSAGE
  
          R=     X2,1R- 
          LX2    36 
          BX6    X6+X2
          LX5    42 
          MX0    18 
          BX2    X0*X5
          BX6    X6+X2
          SA6    PMSG+6 
          BX5    -X0*X5 
          LX4    24 
          BX7    X4+X5
          R=     X2,1R/ 
          LX2    18 
          BX7    X7+X2
          SA7    A6-B1
          SA1    /TMGR/ATSA  NUMBER OF TABLE MOVES
          RJ     CDD= 
          MX0    36 
          BX6    -X0*X6 
          SA1    =6L TM CM
          BX6    X1+X6
          LX6    18 
          SA6    A6+B1
          SA1    ISDA        PICK UP *MSG* CALL 
          SX6    X1+B1
          LX6    30 
          SA6    A1          SET INDIRECT POINTER IN SAME WORD
          BX6    X1 
          RJ     SYS=        ISSUE MESSAGE
          SX6    1           SET LINE 1 RESET NECESSARY 
          SA6    ISDF 
 LRT      ENDIF 
  
 ZMSG     IFTEST NE,IP.LDBG,0 
          SMSG   COMLDCC
 ZMSG     ELSE
          IFTEST NE,IP.FLMSG,0,1
          SKIP   1
          IFTEST NE,IP.LRT,0
          SA1    ISDF 
          ZR     X1,ZMSG1    IF NO STATISTICAL MESSAGE ISSUED 
          SX6    COMLDCC
          SX2    3RMSG
          LX6    30          INDIRECT REQUEST WORD
          SA6    ZMSG 
          LX2    42 
          SX6    A6 
          SX1    200001B
          BX6    X2+X6
          LX1    24-0 
          BX6    X1+X6       18/3RMSG,6/20,12/1,6/0,18/ZMSG 
          RJ     SYS= 
 ZMSG1    BSS    0
 ZMSG     ENDIF 
  
          EQ     ISD         EXIT 
  
 ZMSG     BSS    0
  
 CMSG     IFTEST NE,IP.FLMSG,0
 CMSG     CON    10H  CM LWA+1     MESSAGE BUFFER FOR CORE USED 
          CON    10H =      B,&10H
          CON    10H LOADER US
          CON    10HED       B&10H
          CON    0
          CON    10H1 =       &9R 
          CON    2L B 
 CMSG     ENDIF 
  
  
 LRT      IFTEST NE,IP.LRT,0
 MSGF     MAX    0,IP.LRT-1000B 
 ISDA     VFD    24/4LMSGP,12/MSGF,6/0,18/*   ** MUST PRECEDE PMSG ** 
 PMSG     DATA   15L//LOADER  "LEVEL"     PERFORMANCE MESSAGE 
          BSSZ   2
          DATA   40H//LOADER
          CON    0           END-OF-MESSAGE INDICATOR 
 LRT      ENDIF 
  
          IFTEST NE,IP.FLMSG+IP.LRT,0,1 
 ISDF     CON    0           NZ IF STATISTIC MESSAGE WAS ISSUED 
  
 IC       ENDIF 
 EXP      TITLE  EXECUTION PROCESSOR. 
**        + + + + + + + + + + + + + 
*         + EXECUTION PROCESSOR.  + 
*         + + + + + + + + + + + + + 
* 
* 
*         EXP - EXECUTION PROCESSOR.
* 
*              THIS ROUTINE PREPARES THE LOADABLE AREA FOR EXECUTION. 
*         THIS CONSISTS PRIMARILY OF MOVING THE CORE IMAGE TO THE START 
*         OF THE LOADABLE AREA, PRESETTING THE REMAINDER OF CORE, 
*         DETERMINING THE FIELD LENGTH FOR EXECUTION, AND ENTERING THE
*         PROGRAM.  IN ORDER TO ENTER THIS ROUTINE, THERE MUST BE A 
*         KNOWN TRANSFER ADDRESS, AND IT IS TO BE IN THE B5 REGISTER. 
*         THE PROCEDURE IS AS FOLLOWS 
* 
  
 EXP      SA5    FL          (A0) = CM FL 
  
**        1)   IF A CONTROL-CARD-INITIATED LOAD AND IF THE LOAD INVOLVES
*              THE *TRAP* ROUTINE (FOR THE DEBUG AIDS), THE ENTRY 
*              ADDRESS TO THE *TRAP* ROUTINE IS SUBSTITUTED FOR THE 
*              ACTUAL TRANSFER ADDRESS.  THE SAME CHECK IS ALSO MADE
*              FOR A FORTRAN INTERACTIVE DEBUG RUN. 
* 
  
          IFCARD 2
          IFTEST NE,IP.TRAP,0,1 
          SA3    TRAPADR     SPECIAL *TRAP* ENTRY ADDRESS 
          SA0    X5 
 IC       IFCARD
 T        IFTEST NE,IP.TRAP,0 
          ZR     X3,EXP0A    IF NOT A TRAP RUN
          SB5    X3          SET ALTERNATE TRANSFER ADDRESS 
 T        ENDIF 
 EXP0A    SA3    TA 
          SX3    X3          (X3) = DEBUG TRANSFER ADDRESS OR ZERO
          ZR     X3,EXP0A1   IF NOT AN INTERACTIVE DEBUG RUN
          SB5    X3          SET ACTUAL TRANSFER ADDRESS
 EXP0A1   BSS    0
 IC       ENDIF 
  
**        2)   FOR CONTROL-CARD-INITIATED LOADS, THE PROPER EXECUTION 
*              FIELD LENGTH IS NOW DETERMINED.  THE ALGORITHM USED IS 
*              SHOWN BELOW, AND IS THE SAME AS USED BY *1AJ*, EXCEPT
*              THAT IT ALSO HANDLES THE POSSIBILITIES FOR RELOCATABLE 
*              LOADS.  NOTE THAT UP TO THIS POINT, THE LOCATION *EF*
*              CONTAINS THE FIELD LENGTH AS IT WOULD BE SET IF THE
*              MAXIMUM POSSIBLE REDUCTION IS TO TAKE PLACE.  IT WILL
*              NOW BE SET TO THE VALUE ARRIVED AT IN THE FOLLOWING
*              ALGORITHM:                                                      .
* 
*              A) IF *PFL* " 0, GO TO (B); OTHERWISE, GO TO (E).
*              B) IT *OVR* = 0, GO TO (C); OTHERWISE, GO TO (D).
*              C) SET *K* = *PFL*; GO TO (N). 
*              D) IF IN REDUCE MODE, GO TO (C); OTHERWISE, GO TO (F). 
*              E) IF IN REDUCE MODE, GO TO (G); OTHERWISE, GO TO (F). 
*              F) SET *K* = *NFL*; GO TO (N). 
*              G) IF LOAD IS RELOCATABLE, GO TO (H); OTHERWISE, TO (I). 
*              H) SET *K* = *EF*; GO TO (N).
*              I) IF 53-TABLE PRESENT WITH *HHA*, GO TO (J); OTHERWISE, 
*                 GO TO (K).
*              J) SET *K* = *HHA*; GO TO (N). 
*              K) IF *LF* " 0, GO TO (M); OTHERWISE, GO TO (L). 
*              L) IF *OVR* = 0, GO TO (H); OTHERWISE, GO TO (M).
*              M) SET *K* = MAX(EF,NFL); GO TO (N). 
*              N) IF LOAD IS ABSOLUTE AND USING SMALL ABS LOADER
*                 (*DEFER* " 0), GO TO (O); OTHERWISE GO TO (P).
*              O) SET *K* = MAX[K,(PA+EXPAL+LOADAX+10B)]; GO TO (P).
*              P) USE *EF* = MIN(K,MFL) FOR EXECUTION FL. 
* 
*              PFL = FL SPECIFIED FOR THE PROGRAM IN THE PROGRAM NAME 
*                    TABLE (PNT). 
*              OVR = FIELD LENGTH OVERRIDE BIT AS SPECIFIED IN THE
*                    PROGRAM NAME TABLE.
*              NFL = NOMINAL FL (FL FROM LAST *RFL* CARD, OR JOB CARD 
*                    FL IF NO *RFL* CARDS YET, OR VALUE OF *IP.SFL* 
*                    IF NEITHER). 
*              MFL = MAXIMUM FIELD LENGTH ALLOWED THIS JOB. 
*              EF  = VALUE OF MINIMUM FL POSSIBLE TO INCLUDE LOADED 
*                    PROGRAM.  ROUNDED UP AS FOLLOWS:                          .
* 
*                        FL = [(FL+176B)/100B]*100B.
* 
*              HHA = LWA+1 OF HIGHEST OVERLAY AS SPECIFIED IN 53-TABLE. 
*              LF  = FLAG SET NON-ZERO IF ANY NON-LIBRARY LOADING HAS 
*                    TAKEN PLACE. 
*              PA     = LWA+1 OF LOAD AT COMPLETION TIME. 
*              EXPAL  = LENGTH OF MOVE-DOWN PROGRAM TO BE PLACED AT THE 
*                       END OF THE FL.
*              LOADAX = LWA+1 OF THE SMALL ABSOLUTE LOADER CODE.
* 
*              AFTER THE FINAL VALUE FOR *EF* HAS BEEN DETERMINED, IF 
*              IT IS GREATER THAN THE CURRENT FIELD LENGTH, THE 
*              FIELD LENGTH IS IMMEDIATELY SET TO THE NEW VALUE, SO 
*              THAT THE MOVE-DOWN PROGRAM (SEE BELOW) CAN BE PLACED AT
*              THE TOP OF THE NEW FL.  IF THE NEW VALUE IS LESS, IT WILL
*              BE SET BY ISSUING A *MEM* REQUEST JUST PRIOR TO ENTERING 
*              THE PROGRAM. 
* 
  
 IC       IFCARD
  
          SA1    PFL
          SA5    NFL         (X5) = NOMINAL FL
          MX7    -11
          BX3    X7*X1       (X3) = NZ IF OVERRIDE BIT SET
          LX5    6
          BX1    -X7*X1      (B7) = PROGRAM FL
          LX1    6
          SA4    EF          (X4) = EF, AND PL IF IN REDUCE MODE
          SB7    X1 
          ZR     X1,EXP0B    IF NO PFL SPECIFIED
          ZR     X3,EXP0H    IF OVERRIDE BIT NOT SET
          PL     X4,EXP0H    IF IN REDUCE MODE
          EQ     EXP0C
  
 EXP0B    SX7    121B        SET FOR REQUIRED ROUND-UP OF *HHA* 
                                    17B OF THESE WORDS HAS TO DO WITH 
                                     *LDW* AND THE *PRFX* TABLE.
          PL     X4,EXP0D    IF IN REDUCE MODE
 EXP0C    SB7    X5          SET FOR NOMINAL FL 
          EQ     EXP0H
  
 EXP0D    SA1    ABS
          NZ     X1,EXP0E    IF ABSOLUTE LOAD 
          SB7    X4          SET FOR MINIMUM POSSIBLE FL
          EQ     EXP0H
  
 EXP0E    SA1    TPGM        EXAMINE (RA+100B)
          IFNOS  2
          SA2    SEPF        CHECK FOR MFL= AND RFL= ENTRY POINTS 
          NZ     X2,EXP0F    IF EITHER OR BOTH WERE PRESENT 
          R=     A1,X1+RA+BASE
          MX2    -18
          AX1    18 
          PL     X1,EXP0E1   IF HHA PRESENT BUT NOT FROM 54-TABLE 
          AX1    36 
          R=     X1,X1-54B+77B
          NZ     X1,EXP0F    IF NOT 54-TABLE
          R=     A1,A1+4     GET HHA
 EXP0E1   MX6    -6 
          BX1    -X2*X1 
          IX1    X1+X7
          BX6    X1*X6
          SB7    X6 
          EQ     EXP0H
  
 EXP0F    SA2    LF 
          SB7    X4          (B7) = MINIMUM FL
          NZ     X2,EXP0G    IF OVERLAY LOADED FROM LOCAL FILE
          ZR     X3,EXP0H    IF OVERRIDE BIT NOT SET
 EXP0G    SB6    X5          (B7) = MAX(EF,NFL) 
          GE     B7,B6,EXP0H
          SB7    B6 
 EXP0H    SA1    DEFER
          ZR     X1,EXP0HM   IF NOT A DEFERRED ABSOLUTE LOAD
          SA3    PA          (STEP O) -- MAX[K,(PA+EXPAL+LOADAX+10B)] 
          IFNOS  2
          SA1    TSFR+1      INCLUDE LENGTH *TSFR* IN LOAD
          IX3    X1+X3
          R=     X1,X3+EXPAL+LOADAX+10B  FL NEEDED TO FINISH
          MX2    -6          ROUND UP TO EVEN 100B
          IX1    X1-X2
          BX1    X2*X1
          SB6    X1          (B6) = FL NEEDED TO FINISH 
          GE     B7,B6,EXP0HM  IF USING A LARGER FL ANYHOW
          SB7    B6          SET VALUE NEEDED 
 EXP0HM   SA1    MFL         (STEP P) -- (B7) = MIN(B7,MFL) 
          SB6    X1 
          LE     B7,B6,EXP0I
          SB7    B6 
 EXP0I    SB4    A0 
          LE     B7,B4,EXP0J IF EXEC. FL NOT GT CURRENT FL
          SX1    B7          REQUEST EXECUTION FL 
          MX2    0           CM REQUEST TO *MEM*
          SA0    B7          (A0) = NEW FL
          RJ     MEM= 
 EXP0J    BSS    0
  
 IC       ENDIF 
  
**        3)   IN ORDER TO MOVE THE CORE IMAGE TO THE BEGINNING OF THE
*              LOADABLE AREA, A SMALL PROGRAM IS PLACED AT THE TOP OF 
*              THE FIELD LENGTH.  THIS PROGRAM IS APPROXIMATELY 16B 
*              WORDS IN LENGTH.  AT THE TIME IT IS ENTERED, MOST OF THE 
*              REGISTERS CONTAIN THE INFORMATION IT NEEDS TO BE ABLE TO 
*              MOVE THE CORE IMAGE, PRESET THE REMAINDER OF CORE, AND 
*              ALLOW FOR FIELD LENGTH REDUCTION IF SELECTED.  THE 
*              CODE THAT FOLLOWS PREPARES FOR THE ENTRY TO THIS 
*              SMALL PROGRAM. 
* 
*              NOTE THAT IN BOTH *LOADER* AND *LOADU*, THE FIRST 100B 
*              WORDS OF THE CORE IMAGE IN *TPGM* CONSIST OF THAT
*              INFORMATION TO BE PLACED IN THE COMMUNICATIONS AREA
*              FROM RA THROUGH RA+77B.
* 
*              BEYOND THIS POINT, NO TABLE MANAGEMENT MAY OCCUR.
* 
  
          GE     B5,B0,EXP.5 TEST FOR NEGATIVE TRANSFER ADDRESS 
          ERROR  CAT,(=C* ILLEGAL TRANSFER ADDRESS*)
  
 EXP.5    BSS    0
          SA1    TBLK 
          SA3    TPGM 
          SA2    A3+B1       PRESET 1ST 10B WORDS BEYOND THE END
          IX2    X3+X2       OF *TPGM* TO COMPENSATE FOR THE 1ST
          SA1    X1+B1       FEW WORDS PAST THE END OF THE LOAD 
          MX4    -24         NOT BEING PRESET DUE TO THE 8-WORD 
          SB6    B7          MOVE LOOP USED BELOW 
          BX4    -X4*X1 
          R=     X3,X2+10B
          RJ     PSM
          SB7    B6          RESTORE B7 
          SA1    PSMA        CORE PRESETTING OPTION 
          SA5    B5          SAVE TRANSFER ADDRESS IN A5
 IU       IFUSER
          SA2    FE 
          ZR     X2,EXP0A    IF NO FATAL ERROR
          SA2    RETURN      RETURN IMMEDIATELY 
          SA5    X2          SET RETURN ADDRESS TO RETURN TO USER 
 EXP0A    SA4    TEND        END OF MANAGE TABLES 
          R=     X4,X4+TABOO END OF LOADABLE AREA 
 IU       ENDIF 
          IFCARD 1
          SX4    B7          (X4) = EXECUTION FL
          SA3    PSMB        (X5) = PRESETTING VALUE
          IFCARD 1
          LD     B6,A0-EXPAL+EXPD-EXPB  (B6)=LWA+1 IF NO REDUCE 
          IFUSER 1
          LD     B6,X4-EXPAL+EXPD-EXPB  (B6)=LWA+1 TO PRESET
          SB5    -B1         FLAG STRAIGHT PRESETTING 
          MX5    0           ZERO PRESET VALUE
          ZR     X1,EXP1     IF PRESET(NONE), PRESET TO ZEROS 
          BX5    X3          PRESET VALUE 
          NG     X1,EXP1     IF TO PRESET WITHOUT ADR INSERTION 
          SB5    B1          SET ADDRESS PRESET FLAG
 EXP1     SA1    EXPA+EXPC-EXPB    RELOCATE MOVE DOWN PROGRAM 
          IFCARD 1
          LD     B7,A0-EXPAL (B7) = BASE OF MOVE DOWN PROGRAM 
          IFUSER 1
          LD     B7,X4-EXPAL (B7) = BASE OF MOVE DOWN PROGRAM 
          SX6    B7 
          BX2    X6 
          LX6    15          AT EXPC, ADDRESS IS MIDDLE 
          IX7    X1+X6
          SA7    A1 
          SA1    EXPA+EXPF-EXPB 
          IX7    X1+X6       RELOCATE MIDDLE ADDRESS AT *EXPF*
          SA7    A1 
          SA1    EXPA+EXPD-EXPB 
          LX6    15 
          IX7    X1+X6       RELOCATE UPPER ADDRESS AT *EXPD* 
          SA7    A1 
          SA1    EXPA+EXPE-EXPB 
          IX7    X1+X6       RELOCATE UPPER ADDRESS AT *EXPE* 
          IX7    X2+X7       RELOCATE LOWER ADDRESS AT *EXPE* 
          SA7    A1 
  
*         MOVE THE MOVE-DOWN PROGRAM. 
  
          IFCARD 1
          SB2    A0-B1       LWA-1 LOADABLE AREA
          IFUSER 1
          LD     B2,X4-1     LWA-1 LOADABLE AREA
          SA1    EXPA 
          BX6    X1 
          SA6    B7          FIRST WORD 
 EXP2     SA1    A1+B1       MOVE REMAINING WORDS 
          BX6    X1 
          SB3    A6+B1
          SA6    A6+B1
          LT     B3,B2,EXP2 
          SA1    ECSFL       (X0) = ECS FL
          BX0    X1 
  
 IU       IFUSER
          SA1    PLDP 
          ZR     X1,EXP4     IF NO PARAMETER BLOCK
          R=     A1,X1+2
          ZR     X1,EXP4     IF NO RETURN ADDRESS 
          SA2    A1-B1
          ZR     X2,EXP3     IF CMM.GLF NOT USED
          SA2    PA 
          IX6    X4-X2
          SA6    A1+B1       SET SHRINK COUNT FOR *PILOAD*
 EXP3     SX6    A5 
          R=     A6,A1+2     SET RETURN ADDRESS FOR *PILOAD*             LDR0195
          SA5    X1          SET OUR RETURN TO GO TO *PILOAD* 
 EXP4     BSS    0
 IU       ENDIF 
  
 IC       IFCARD
          SA2    DEFER
          NZ     X2,EXP2A    IF DEFERRED LOAD 
          RJ     SPYOFF      TURN OFF *SPY* 
 IC       ENDIF 
 EXP2A    SA1    TPGM        (X1)=FWA OF PROGRAM
  
**        4)   IN CONTROL-CARD-INITIATED LOADS, A TINY STARTUP PROGRAM
*              WAS PLACED STARTING AT RA+54B.  IF THE FIELD LENGTH
*              IS TO BE REDUCED, A PP CALL WORD TO *MEM* AND THE *MEM*
*              ARGUMENT WORD ARE PLACED JUST AFTER THE STARTUP PROGRAM. 
*              OTHERWISE, A ZERO WORD IS PLACED THERE.  THE LAST THING
*              THE MOVE-DOWN PROGRAM DOES IS TO PLACE THAT PP CALL OR 
*              ZERO WORD WORD IN RA+1 AND JUMP TO RA+54B.  AT THAT
*              POINT, THE STARTUP PROGRAM WAITS FOR RA+1 TO CLEAR AND 
*              JUMPS TO THE TRANSFER ADDRESS. 
* 
  
 IC       IFCARD
          MX2    0           SET FOR NO CALL TO *MEM* 
          SB2    A0          CHECK IF NECESSARY TO REDUCE 
          SB3    X4 
          EQ     B2,B3,EXP3  IF ALREADY SET AT EXECUTION FL 
          SB6    X4          NEW FL = LWA FOR PRESETTING
          SX6    X4          SET MEM REQUEST
          SA0    X4          (A0) = NEW FL
          LX6    30 
  
 NOS      IFNOS 
          MX2    1
          LX2    47-59
          BX6    X6+X2       FLAG OVERRIDE OF NO-REDUCE 
 NOS      ENDIF 
  
          SA2    MEMCALL     SET FOR CALL TO MEM
          SA6    X1+RA+COMBOOT+5
 EXP3     SX6    3REND       SET TO ISSUE *END* 
          SA3    X1+RA+COMRSS      CHECK *RSS* BIT
          BX7    X2 
          SA7    X1+RA+COMBOOT+4   STORE *MEM* CALL OR ZERO 
          LX6    42 
          LX3    59-18
          NG     X3,EXP4     IF *RSS* 
          MX6    0
 EXP4     SA6    A7-B1       ISSUE *END* ONLY IF *RSS* PRESENT
          SA2    A1+B1
          SX3    X2+7        (B4) = (PROGRAM LENGTH) / 8
          SB2    B1+B1       (B2) = 2 
          AX3    3
          SB3    X1          (B3) = MOVE DIFFERENTIAL 
          SB4    X3 
  
**        4A)  IF THIS IS A DEFERRED ABSOLUTE LOAD, GO TO *LOADA* 
*              TO FINISH THE LOAD. OTHERWISE, ENTER MOVE LOOP.
  
          SA3    DEFER
          NZ     X3,LOADA    IF A DEFERRED LOAD 
          SA1    X1          FIRST WORD 
          SA2    A1+B1       NEXT WORD
          JP     B7          ENTER MOVE LOOP
 IC       ENDIF 
  
**        5)   IN USER-CALL INITIATED LOADS, THE FIRST 110B WORDS OF THE
*              CORE IMAGE MUST BE HANDLED SPECIALLY, SINCE THIS AREA IS 
*              NOT CONTIGUOUS WITH THE LOADABLE AREA.  IT IS NOW MOVED
*              TO RA THROUGH RA+107B, AND THE SIZE OF THE IMAGE TO BE 
*              MOVED BY THE MOVE-DOWN PROGRAM IS ADJUSTED ACCORDINGLY.
  
 IU       IFUSER
          SA3    A1+B1       (B4) = (PROGRAM LENGTH / 8)
          R=     X4,COMLTH
          IX2    X1+X4       FIRST 110B WORDS OF *TPGM* GO TO 
          IX3    X3-X4       RA THROUGH RA+107
          R=     X3,X3+7
          SB3    X2 
          AX3    3
          BX2    X1 
          SB4    X3 
          MOVE   X4,X2,B0    MOVE FIRST 107B WORDS
          SA4    PO          (B3) = MOVE DIFFERENTIAL 
          SA1    B3          FIRST WORD 
          SB2    X4 
          SB3    B3-B2
          SB2    B1+B1       (B2) = 2 
          SA2    A1+B1       SECOND WORD
          BR     B7          ENTER MOVE LOOP
 IU       ENDIF 
 EXPA     SPACE  4,8
**        EXPA - PROGRAM MOVE-DOWN LOOP.
* 
*              THIS PROGRAM EXECUTES AT THE VERY TOP OF THE LOADABLE
*         AREA. 
* 
*         ---------------- W A R N I N G ---------------- 
*         THIS ROUTINE MUST NOT CONTAIN ANY 30-BIT INSTRUCTIONS 
*         WHICH USE ABSOLUTE CONSTANTS.  OTHERWISE THE RELOCATION 
*         ROUTINE OF THE USER CALL LOADER WILL NOT PROPERLY 
*         RELOCATE *LOADU* WHEN IT IS LOADED. 
* 
*         ENTRY  (B1) = 1.
*                (B2) = 2.
*                (B3) = MOVE DIFFERENTIAL.
*                (B4) = NO. OF WORDS TO MOVE / 8. 
*                (B5) = 0 IF NO PRESETTING. 
*                       -1 IF PRESETTING WITHOUT ADDRESS INSERTION. 
*                       1 IF PRESETTING WITH ADDRESS INSERTION. 
*                (B6) = LWA+1 TO PRESET.
*                (A0) = CM FL.
*                (A1) = ADR. OF 1ST WORD. 
*                (A2) = ADR. OF 2ND WORD. 
*                (A5) = TRANSFER ADDRESS. 
*                (X0) = ECS FL. 
*                (X1) = 1ST WORD. 
*                (X2) = 2ND WORD. 
*                (X5) = VALUE TO PRESET.
* 
*              IT DOES THE FOLLOWING:                                          .
* 
*         1)   THE CORE IMAGE FROM TABLE *TPGM* IS MOVED TO THE 
*              BEGINNING OF THE LOADABLE AREA.  A MOVE LOOP IS USED 
*              WHICH MOVES EIGHT WORDS EACH TIME THROUGH THE LOOP.
* 
  
 EXPA     BSS    0
          RELOC  OFF
          LOC    0
 EXPB     SA3    A1+B2
          SA4    A2+B2
          BX6    X1 
          LX7    X2 
          SA6    A1-B3
          SA7    A2-B3
          SA1    A3+B2
          SA2    A4+B2
          BX6    X3 
          LX7    X4 
          SA6    A3-B3
          SA7    A4-B3
          SA3    A1+B2
          SA4    A2+B2
          BX6    X1 
          LX7    X2 
          SA6    A1-B3
          SA7    A2-B3
          SB4    B4-B1
          SA1    A3+B2
          SA2    A4+B2
          BX6    X3 
          LX7    X4 
          SA6    A3-B3
 EXPC     SA7    A4-B3
          GE     B4,B1,EXPB-EXPB   LOOP TO END OF TRANSFER
  
**        2)   THE REMAINDER OF THE LOADABLE AREA IS PRESET ACCORDING 
*              TO THE SELECTED PRESET OPTION. 
* 
  
          SB4    A7 
          SX4    B1+B1       (X4) = 2 
          IFCARD 1
          SA2    RA+COMBOOT+4  *MEM* CALL OR ZERO 
          IFUSER 2
          NO
          NO
 EXPD     PL     B5,EXPEA-EXPB  IF PRESETTING WITH ADDRESS INSERTION
          BX6    X5          (X6) = PRESET VALUE
          LX7    X5          (X7) = PRESET VALUE
 EXPDA    SB4    B4+X4       CURRENT ADDRESS BEING PRESET 
          SA6    A6+B2       PRESET TWO WORD PAIR 
          NO
          SA7    A7+B2
 EXPE     LT     B4,B6,EXPDA-EXPB  IF MORE TO PRESET
          EQ     EXPG-EXPB
  
 EXPEA    SX7    A6          (X7) = FWA-2 TO PRESET 
          IX6    X5+X7       ADD ADDRESS TO PRESET VALUE
          SX7    X7+B1       (X7) = FWA-1 TO PRESET 
          IX7    X5+X7       ADD ADDRESS TO PRESET VALUE
 EXPEB    IX6    X4+X6       INCREASE PRESET VALUE BY TWO 
          SB4    B4+X4       CURRENT ADDRESS BEING PRESET 
          IX7    X4+X7       INCREASE PRESET VALUE BY TWO 
          SA6    A6+B2       PRESET TWO WORD PAIR 
 EXPF     SA7    A7+B2
          LT     B4,B6,EXPEB-EXPB  IF MORE TO PRESET
  
**        3)   IN *LOADER*, THE MOVE-DOWN PROGRAM TERMINATES BY STORING 
*              EITHER A *MEM* CALL FOR REDUCE OR A ZERO WORD IN RA+1, 
*              MAKING SURE THAT NONE OF THE A-REGISTERS WILL CONTAIN
*              VALUES LARGER THAN THE NEW FIELD LENGTH, AND ENTERING THE
*              STARTUP PROGRAM AT RA+54B. 
* 
*              IN *LOADU*, SINCE THERE ARE NO REDUCE CONSIDERATIONS,
*              THE TRANSFER ADDRESS IS ENTERED DIRECTLY.
  
          IFCARD
 EXPG     SA3    A2-B1
          SA1    B1 
          SA4    B1 
          BX6    X2 
          BX7    X3 
  
*         THE NEXT TWO INSTRUCTIONS MUST BE IN THE SAME WORD. 
  
          SA6    B1          *MEM* CALL OR ZERO TO RA+1 
          JP     RA+COMBOOT  GO TO PROGRAM STARTER
  
          CON    0,0         AVOID MODE ERROR 
          ELSE
 EXPG     SB5    A5          ENTER PROGRAM
          JP     B5 
  
          CON    0,0         AVOID MODE ERROR 
          ENDIF 
  
          LOC    *O 
          BSS    0
 EXPAL    EQU    *-EXPA 
  
          IFCARD 1
 MEMCALL  VFD    24/0LMEMP,36/RA+COMBOOT+5
          USE    // 
 LOCL     BSS    0
          RELOC  ON 
 WOV      TITLE  LOAD COMPLETION SUBROUTINE - WRITE OVERLAY.
          IDENT              LOAD CODE
