*DECK SEGRES
          IDENT  SEGRES,101B,SEGRES 
          ABS 
          SST 
          ORG    101B 
          B1=1
          LIST   D,F
          COMMENT SEGMENT LOADER RESIDENT.
          TITLE  SEGRES - SEGMENT LOADER RESIDENT.
          SPACE  4,8
***       SEGRES - SEGMENT LOADER RESIDENT. 
* 
*         A.F.R. BROWN       71/10/01.
*         S. MALEK           74/03/30.
*         G.E. LOGG          75/02/30.
* 
*         CONTROL DATA  PROPRIETARY PRODUCT.
*         COPYRIGHT CONTROL DATA CORP. - 1976, 1977, 1978, 1979, 1980,
*         1981, 1982. 
          SPACE  4,8
***       SEGRES - SEGMENT LOADER RESIDENT. 
* 
*         THIS OVERLAY IS CALLED BY THE BASIC LOADER, IF THE LATTER IS
*         TOLD TO LOAD A FILE AND FINDS THAT THE FIRST THING ON THE FILE
*         IS THE WORD *SEGLOAD.*.   IT IS ALSO CALLED BY SEGBILD AFTER
*         SEGBILD HAS CONSTRUCTED A FILE OF SEGMENTS, IF THE LAST LOADER
*         DIRECTIVE FOR SEGBILD IS AN IMPLICIT OR EXPLICIT EXECUTE. 
*         WHEN LOADED AND CALLED IN EITHER OF THESE WAYS, EXECUTION OF
*         SEGRES BEGINS AT LOCATION *SEGRES*. 
* 
*         SEGRES RESIDES BETWEEN 100B AND *BASE* AND SHOULD STAY THERE
*         ALL THE TIME THAT A FAMILY OF SEGMENTS IS BEING EXECUTED. 
*         WHENEVER A SEGMENT HAS TO BE LOADED, THERE WILL BE A CALL 
*         TO SEGRES BY A *RJ  RES* FROM THE OBJECT PROGRAM. 
* 
*         *BASE* IS THE ADDRESS AT WHICH CM STORAGE FOR SEGMENTS AND THE
*         MASTER TABLE OF SEGMENTS (*CELTAB*) BEGINS.  *BASE* 
*         MUST BE LESS THAN OR EQUAL TO THE VALUE DEFINED IN SEGBILD
*         OR AN ERROR MESSAGE WILL BE ISSUED BY SEGRES. 
* 
*         FET *B* IS USED FOR READING THE FILE CONTAINING THE FAMILY
*         OF SEGMENTS, OR FILE ZZZZZ31 IF THE ORIGINAL
*         FILE HAD TO BE COPIED BEFORE EXECUTION. 
* 
*         FET *G* IS USED FOR READING AND WRITING FILE ZZZZZ32, 
*         WHERE SAVE GLOBAL COMMON BLOCKS ARE SAVED.
          SPACE  4,8
***       SEGLOAD FILE FORMAT.
* 
*         THE SEGLOAD BINARY FILE HAS TWO POSSIBLE FORMATS.  IF THE 
*         FILE IS A SCOPE RANDOM FILE THE INDEX OF THE SEGLOAD FILE 
*         HAS THE FORMAT -- 
*                  VFD   1/E,5/0,24/ECSBLK,9/WC,21/PRU                   LDR0167
*                  VFD   42/ENTRY NAME,18/ADDRESS 
*                            ...         *WC* ENTRY POINT WORDS 
*                  VFD   42/ENTRY NAME,18/ADDRESS 
*         OTHERWISE THE LAST RECORD WILL CONTAIN THE ABOVE INFORMATION. 
* 
*         *ECSBLK* IS THE LENGTH OF ECS NEEDED.  THE ECS FL MUST BE 
*         LARGER THAN *ECSBLK* ELSE SEGRES WILL ABORT THE LOAD. *ECSBLK*
*         IS ALSO ADDED TO RA.ORG BITS 36-59 SO THAT OBJECT ROUTINES
*         KNOW THE ECS HHA.  *E* IS SET TO 1 IF NO ECS IMAGE IS PRESENT. LDR0167
*         THIS BIT IS CHECKED WHENEVER *ECSBLK* IS NON-ZERO IN CASE      LDR0167
*         NO ECS LABELLED COMMON WAS DECLARED.                           LDR0167
* 
*         *PRU* IS THE DISK ADDRESS OF THE SEGMENT DIRECTORY TABLE
*         *CELTAB*.  THIS DISK ADDRESS REQUIRES THE SEGLOAD FILE
*         BE ON DISK AND START AT PRU 1.  TO INSURE THIS THE SEGLOAD
*         FILE WILL BE COPIED TO A DISK FILE ZZZZZ31 IF IT IS ON TAPE OR
*         IF NO REWIND IS SPECIFIED (LOAD(ABS/NR)). 
* 
*         THE TRANSFER ENTRY POINT NAME SPECIFIED ON THE EXECUTE
*         DIRECTIVE IS COMPARED TO THE ENTRY POINTS IN THE INDEX.  WHEN 
*         A MATCH IS FOUND THE SPECIFIED ADDRESS IS USED TO TRANSFER
*         INTO THE ROOT SEGMENT.  IF NO ENTRY POINT WAS SPECIFIED ON
*         THE EXECUTE DIRECTIVE THEN THE FIRST ONE IS USED. 
* 
*         THE FIRST PRU CONTAINS THE WORD *SEGLOAD.* WHICH IS USED
*         AS A FLAG BY THE BASIC LOADER TO LOAD SEGRES. 
* 
*         THE SECOND PRU CONTAINS THE ECS COMMON BLOCKS IF ANY.  EACH 
*         RECORD THEREAFTER UNTIL THE *CELTAB* TABLE CONTAINS A SEGMENT.
 CELTAB   SPACE  4,8
***       *CELTAB* TABLE FORMAT.
* 
*         *CELTAB* IS LOADED BEGINNING AT *BASE* DURING EXECUTION.
*         DURING INITIALIZATION IT IS LOADED AT *ENDRES*.  THE ROUTINE
*         *LCS* MOVES *CELTAB* PRIOR TO THE LOADING OF THE CAIN SEGMENT.
*         *CELTAB* CONTAINS A TWO WORD ENTRY FOR EVERY SEGMENT IN THE 
*         FAMILY -- 
*                VFD  12/DLLGTH,18/DISKAD,12/FATHER,1/INOUT,17/LDFWA
*                VFD  1/B,1/L,1/C,1/N,2/0,18/SAVEDA,18/SAVELG,18/LOADLG 
*         DLLGTH = LENGTH OF DELINK TABLE, BEGINNING AT FWA OF SEGMENT. 
*         DISKAD = PRU NUMBER WHERE TO READ SEGMENT.
*         FATHER = *CELTAB* ORDINAL OF THE FATHER OF THIS SEGMENT, OR 0 
*                   IF THIS IS THE CAIN SEGMENT (NUMBER 0) OR ITS 
*                   ELDEST SON OR IS A PATRIARCH (SON OF CAIN) AND THE
*                   FIRST SEGMENT IN ITS LEVEL, OR 7777B IF THIS IS A 
*                   PATRIARCH BUT NOT THE FIRST SEGMENT IN ITS LEVEL. 
*         INOUT  = 0 INITIALLY, THEN IS 1 WHENEVER THE SEGMENT IS 
*                   LOGICALLY LOADED AND 0 WHEN LOGICALLY UNLOADED. 
*         LDFWA  = FWA OF SEGMENT IN CM.
*         B      = 1 IF BLANK COMMON WILL BE USED.
*         L      = 1 IF MULTI LEVEL STRUCTURE.
*         C      = 1 IF THE 54 TABLE IS TO BE SET UP.  THE ADDRESS OF 
*                   *CMM.SEG* WILL BE PRESENT AS AN EXTRA WORD APPENDED 
*                   TO THE RECORD CONTAINING *CELTAB*.
*         N      = 1 IF THE GLOBAL BLOCKS WILL BE PRESENT AT THE START
*                   OF EACH SEGMENT ELSE THE GLOBAL BLOCKS WILL BE AT 
*                   THE END OF THE SEGMENT. 
*         SAVEDA = PRU ON FILE ZZZZZ32 AT WHICH SAVED GLOBAL COMMON IS
*                   STORED. INITIALLY = 0, EXCEPT THAT IN THE ENTRY FOR 
*                   THE CAIN SEGMENT, THIS FIELD CONTAINS THE LWA+1 OF
*                   CM BLANK COMMON, WHICH IS THE LWA+1 FOR THE WHOLE 
*                   FAMILY OF SEGMENTS. 
*         SAVELG = LENGTH OF SAVE GLOABL COMMON AREA IN CM FOR THIS 
*                   SEGMENT.                                             LDR0167
*         LOADLG = THE LENGTH OF THE CM PART OF THE SEGMENT, INCLUDING
*                   THE SAVE GLOBAL AREA AT THE END. THIS IS THE LENGTH 
*                   OF THE RECORD ON THE INPUT FILE FROM WHICH THE
*                   SEGMENT IS LOADED.
* 
*         IF ANY TWO SEGMENTS CAN COEXIST, I.E. BE OR REMAIN LOADED AT
*         THE SAME TIME, THE *CELTAB* ENTRY FOR THE LOWER-LOADED SEGMENT
*         IS BELOW THAT FOR THE HIGHER-LOADED SEGMENT. ALL THE SEGMENTS 
*         IN A TREE HAVE A CONTINUOUS SERIES OF *CELTAB* ENTRIES, 
*         BEGINNING WITH ONE WHOSE FATHER NUMBER IS 0 OR 7777B. ALL 
*         THE TREES ON ONE LEVEL HAVE A CONTINUOUS SERIES OF *CELTAB* 
*         ENTRIES, BEGINNING WITH ONE WHOSE FATHER NUMBER IS 0. THE 
*         *CELTAB* ENTRY FOR A SON ALWAYS FOLLOWS THAT FOR ITS FATHER,
*         AND THE ENTRY FOR A YOUNGER BROTHER ALWAYS FOLLOWS
*         THOSE FOR ITS ELDER BROTHERS AND ALL THE DESCENDANTS OF 
*         THOSE ELDER BROTHERS. SEGMENT NUMBER 0 IS CONSIDERED TO BE
*         THE FATHER OF ALL THE SEGMENTS WHOSE *CELTAB* ENTRIES HAVE
*         FATHER NUMBER 0 OR 7777B. TWO SEGMENTS CAN COEXIST ONLY IF
*         ONE IS AN ANCESTOR OF THE OTHER, OR THEY ARE IN DIFFERENT 
*         LEVELS. WHENEVER A SEGMENT IS OR BECOMES LOADED, ALL ITS
*         ANCESTORS MUST BE OR BECOME LOADED, AND ANY SEGMENTS WITH 
*         WHICH IT OR ITS ANCESTORS CANNOT COEXIST MUST BE OR BECOME
*         UNLOADED. NO TWO SEGMENTS THAT BELONG TO DIFFERENT TREES ON 
*         THE SAME LEVEL CAN COEXIST. 
* 
*         IF THERE IS AN EXTRA WORD APPENDED TO *CELTAB* THEN BITS
*         0-17 CONTAIN THE ADDRESS OF *CMM.SDA* TO BE CALLED IF AN
*         ENTRY POINT STARTING WITH *CMM.* IS PRESENT.  BITS 18-35
*         CONTAIN THE ADDRESS OF *CMM.UNL* (OR ZERO) WHICH IS CALLED
*         IF *CMM.SUA* IS PRESENT.  BITS 36-53 CONTAIN THE ADDRESS OF 
*         *CMM.ALF* IF THE SEGMENTS WERE GENERATED WITH BLANK COMMON
*         FWA SET 2 WORDS ABOVE THE LWA+1 OF THE SEGMENTS.  THIS IS 
*         DONE IN THE CURRENT VERSION OF *LOADS* IN ORDER THAT *DABA* 
*         MAY BE SET TO THE LWA+1 OF THE SEGMENT CURRENTLY IN CORE AND
*         THAT THE FIRST 2 WORDS OF BLANK COMMON WILL NOT BE CLOBBERED
*         BY CMM WHEN THE LARGEST SEGMENT IS IN CORE.  FOR SEGMENTS 
*         GENERATED PRIOR TO THIS CHANGE, BITS 36-53 ARE ZERO.
*              THE CALLS TO THE CMM ROUTINES ARE PLUGGED WITH THESE 
*         ADDRESSES BY THE ROUTINE *RCT*.  WHENEVER CMM IS ACTIVE 
*         (BIT 17 OF *RA.LWP* SET), ALL MEMORY MANAGEMENT IS DONE THRU
*         THESE CALLS.  IF BLANK COMMON IS PRESENT, *CMM.ALF* IS CALLED 
*         AFTER THE LOADING OF THE ROOT SEGMENT BY *LCS* IN ORDER 
*         TO ALLOCATE A FIXED BLOCK IN THE AREA OCCUPIED BY BLANK 
*         COMMON.  SINCE THIS WILL BE THE 1ST CALL TO CMM, IT IS
*         KNOWN THAT CMM WILL ASSIGN THE BLOCK AT THE DESIRED 
*         LOCATION.  *CMM.SDA* IS USED TO MOVE *DABA* AND MOVE
*         BLOCKS IF NECESSARY TO PROVIDE THE NEEDED CM FOR A SEGMENT
*         LOAD.  IF *CMM.SUA* IS PRESENT, THEN *CMM.UNL* IS USED TO 
*         UNLOAD AREAS OF CM SO THAT BLOCK CONTROL WORDS ARE NOT
*         DESTROYED.
          SPACE  4,8
**        LOCAL SYMBOLS AND MACROS. 
  
  
 CLOAD    =      0                 INTERNAL LOAD DIRECTIVE NUMBER 
 CEXECUTE =      5                 INTERNAL EXECUTE DIRECTIVE NUMBER
          SPACE  4,8
**        ALLOCATE SPACE FOR 54 TABLE.
  
  
          CON    0                 101B=WCS, LMINFL, MINFL
          CON    0                 102B=FWAL, WCL 
          CON    0
          CON    0                 104B=DEFL, HHA 
          CON    0                 105B=LDEFL, LHHA 
          CON    0
          CON    0
          CON    0                 110B=TRANSFER AND ADDRESS
          SPACE  4,8
**        FETS. 
  
  
 B        RFILEB ENDRES,1,(IND=ENDRES,512)
 G        RFILEB ENDRES,1,(IND=B,10B) 
          SPACE  4,8
**        EXECUTION SCRATCH CELLS.
  
  
 AF       CON    0                 NZ IF *CMM* PRESENT IN LOAD AND
                                    *CMM.ALF* ADR PASSED IN *CELTAB*
 BC       CON    0                 SET TO // LENGTH IF *CMM.ALF* TO BE
                                    CALLED AFTER LOADING ROOT SEGMENT 
 CL       CON    0                 CELTAB TABLE LENGTH
 FW       CON    0                 FWA OF UNLOADED SEGMENTS 
 HA       CON    0                 HIGHEST ADDRESS OF LOADED SEGMENTS 
 LW       CON    0                 LWA+1 OF UNLOADED SEGMENTS 
 MS       CON    0                 MEMORY STATUS WORD 
 XP       BSSZ   20B               EXCHANGE PACKAGE 
          SPACE  4,8                                                     LDR0166
****      EXECUTION TIME ERROR MESSAGES.                                 LDR0166
                                                                         LDR0166
                                                                         LDR0166
 MSG0     DATA   C* NON-EXECUTABLE WORD LOADING A SEGMENT.*              LDR0166
****                                                                     LDR0166
 RES      SPACE  4,8
****      RES - RESIDENT LOADER MAIN LOOP.
* 
*         THIS IS THE SUBROUTINE THAT AN OBJECT PROGRAM CALLS TO GET
*         A SEGMENT LOADED. THE CALL TO *RES* WAS PLANTED IN THE CALLING
*         SEGMENT EITHER WHEN IT WAS FIRST LOADED, IF THE NOW-WANTED
*         SEGMENT WAS NOT THEN LOADED, OR AT SOME INTERMEDIATE TIME WHEN
*         THE NOW WANTED SEGMENT BECAME UNLOADED. 
  
  
 RES      SUBR                     ENTRY/EXIT 
          RJ     SXP               SAVE XJ PACKAGE
          SB7    BASE              FWA OF CELTAB
          RJ     GRP               PROCESS GROUP CASE 
          AX6    18 
          LX6    1                 INDEX INTO CELTAB TABLE
          SA1    X6+B7
          SX1    X1 
          NG     X1,RES1           IF OVERLAY ALREADY LOADED
          RJ     ULS               UNLOAD UNNEEDED SEGMENTS 
          RJ     LSA               LOAD SEGMENT AND ITS ANCESTORS 
          SB4    B0                DELINK ALL UNLOADED SEGMENTS 
          RJ     DLK               DELINK UNLOADED SEGMENTS 
 RES1     SYSTEM XJR,RCL,XP        RESTORE REGISTERS AND START AT P REG 
  
****      END OF RESIDENT MAIN LOOP.
          TITLE  PRIMARY ROUTINES.
 DLK      SPACE  4,8
**        DLK - DELINK UNLOADED SEGMENTS. 
* 
*         AT THIS POINT WE HAVE LOADED AND UNLOADED ALL SEGMENTS AS 
*         NECESSARY.  WE SCAN ALL OF *CELTAB* PICKING UP WORD 1 
*         OF EACH *CELTAB* ENTRY AND IF BIT 17 IS 0 FOR AN
*         UNLOADED SEGMENT, DO NOTHING.  OTHERWISE GET FROM 
*         THE *CELTAB* ENTRY THE FWA OF THE SEGMENT IN CM, WHICH
*         IS THE FWA OF ITS DELINK TABLE, AND THE LENGTH OF ITS 
*         DELINK TABLE.  IF THE LENGTH OF THE TABLE IS 0 SKIP THIS
*         SEGMENT.  FOR EACH WORD OF THE DELINK TABLE CHECK BITS 48-59. 
*         IF THEY ARE NON-ZERO THE WORD MUST BE AN EXECUTABLE WORD
*         THAT HAS BEEN SAVED THERE BY DELINKING, I.E. IT IS ALREADY
*         DELINKED ANYWAY. BUT IF THE BITS ARE 0, WE HAVE A WORD
*         POINTING TO AN EXECUTABLE WORD THAT MAY HAVE TO BE DELINKED.
*         EVERY WORD IN THE DELINK TABLE IS A GROUP OF ONE (HAS 
*         BIT 17 SET) OR IT IS A GROUP OF WORDS PERTAINING TO THE 
*         SAME OUTSIDE SEGMENT.  THE LAST WORD OF A GROUP WILL HAVE 
*         BIT 17 SET. 
* 
*         IF THERE IS ONLY ONE WORD IN A GROUP IT HAS THE FORM
*                VFD    30/0,12/S,1/1,17/T
*         WE TAKE THE WORD AT T AND SAVE IT IN THE DELINK TABLE AT D. 
*         (NOTE THAT BITS 48-59 NON-ZERO).  AT T WE STORE 
*         +      RJ     RES 
*         -      VFD    12/S,1/1,17/D 
* 
*         IF THERE IS MORE THAN ONE WORD IN A GROUP THEY HAVE THE FORM
*         (EXCEPT FOR THE LAST) 
*                VFD    30/0,12/S,1/0,17/T(I) 
*         THE LAST WORD IN A GROUP HAS THE FORM 
*                VFD    30/0,12/S,1/1,17/T(LAST)
*         WE SAVE THE CONTENT OF EACH LOCATION T(I) IN THE DELINK 
*         TABLE AND STORE AT T(0) 
*         +      RJ     RES 
*         -      VFD    12/K,1/0,17/T(1)
*         WHERE K IS THE DISTANCE BETWEEN THE START OF THE DELINK TABLE 
*         TO THIS GROUP.  AT T(I) (EXCEPT THE LAST) STORE 
*         +      RJ     RES 
*         -      VFD    12/S,1/0,17/T(I+1)
*         AND STORE FOR THE LAST ENTRY IN THE GROUP 
*         +      RJ     RES 
*         -      VFD    12/S,1/1,17/T(0)
* 
*         ENTRY  (B1) =1. 
*                (B3) = LENGTH OF *CELTAB*. 
*                (B4) = *CELTAB* INDEX FOR FIRST SEGMENT TO BE DELINKED.
*                (B7) = FWA OF *CELTAB*.
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6, 7.
*                B - 2, 4, 5, 6.
*                A - 1, 2, 3, 4, 5, 6, 7. 
  
  
 DLK      SUBR                     ENTRY/EXIT 
 DLK1     EQ     B4,B3,DLK         IF CELTAB SCAN COMPLETE
          SA1    B7+B4             WORD 1 OF CELTAB ENTRY 
          SX6    X1 
          SB4    B4+2 
          PL     X6,DLK1           IF OVERLAY NOT IN, NEEDNT DELINK 
          MX6    43 
          BX6    -X6*X1 
          SB5    X6                FWA OF DELINK TABLE
          AX1    48 
          MX7    48 
          BX7    -X7*X1 
          ZR     X7,DLK1           IF NO DELINK TABLE IN OVERLAY
          SB6    X7+B5             LWA+1 OF DELNK TABLE 
          SB2    B0                PROGRESS POINTER IN TABLE
 DLK2     MX0    12 
          SA1    B5 
          BX1    X0*X1
          ZR     X1,DLK4           IF NOT DELINKED
          SB2    B2+B1
 DLK3     SB5    B5+B1
          NE     B5,B6,DLK2        IF NOT THE END OF DELINK TABLE 
          EQ     DLK1              THIS DELINK TABLE ALL DONE 
  
 DLK4     SX6    B2 
          SA6    DLKB              OFFSET IN TABLE OF START OF GROUP
          SB2    B0                COUNT LENGTH OF GROUP
 DLK5     SA1    B5+B2             LOOK AT NEXT WORD IN GROUP 
          SB2    B2+B1             COUNT IT 
          SX6    X1 
          PL     X6,DLK5           IF NOT LAST IN GROUP 
          AX1    18                SEE IF POINTING TO ABSENT SEGMENT
          LX1    1                 2*OVERLAY NUMBER 
          SA2    X1+B7             GET WORD 1 OF RELEVANT CELTAB ENTRY
          SX2    X2                NEGATIVE IF LOADED 
          PL     X2,DLK7           IF NOT LOADED, MUST DELINK 
 DLK6     SB5    A1                JUST CONTINUE SCAN 
          SA1    DLKB 
          SB2    X1+B2
          EQ     DLK3 
  
 DLK7     MX0    1
          LX0    18                =400000B 
          SA5    DLKA 
          NE     B2,B1,DLK8        IF MORE THAN 1 IN GROUP
          SA1    A1 
          BX6    -X0*X1 
          SA2    X6                R
          BX6    X2 
          SA6    A1                STORE (R) AT A1
          MX0    12                                                      LDR0166
          BX6    X0*X6                                                   LDR0166
          ZR     X6,DLK11          IF WORD IS NOT EXECUTABLE             LDR0166
          MX7    13 
          LX7    30 
          BX7    X7*X1             12/Q,1/1,17/0
          SX6    A1 
          BX7    X7+X6             12/Q,1/1,17/A1 
          BX7    X7+X5             ADD RJ RES 
          SA7    A2                REPLACE EXECUTABLE WORD BY TRAP
          EQ     DLK6              CONTINUE SCAN OF DELINK TABLE
  
 DLK8     SA1    DLKB              DISTANCE FROM START OF TABLE 
          LX1    18 
          SA2    B5                FIRST DELINK WORD IN GROUP 
          SX6    X2 
          SA6    A1+B1             ADDRESS OF 1ST EXEC WORD IN GROUP
          SA2    X2                GET 1ST EXECUTABLE WORD
          BX6    X2 
          SA6    B5                STORE IN FIRST WORD OF DELINK GROUP
          SA3    B5+B1
          BX3    -X0*X3 
          SX3    X3                ADDRESS OF SECOND EXECUTABLE WORD
          BX6    X1+X3
          BX6    X6+X5
          SA6    A2                REPLACE 1ST EXECUTABLE WORD BY TRAP
          MX7    12 
          BX2    X7*X2                                                   LDR0166
          ZR     X2,DLK11          IF WORD IS NOT EXECUTABLE             LDR0166
          LX7    30                MASK FOR OVERLAY NUMBER
 DLK9     SB5    B5+B1
          SA1    B5 
          BX2    -X0*X1 
          SA2    X2                GET EXECUTABLE WORD
          BX3    X7*X1             OVERLAY NUMBER 
          BX6    X2 
          SA6    B5                STORE EXECUTABLE WORD IN DELINK TABLE
          SX1    X1 
          LX2    30                                                      LDR0166
          BX2    X7*X2                                                   LDR0166
          ZR     X2,DLK11          IF WORD IS NON-EXECUTABLE             LDR0166
          NG     X1,DLK10          IF THIS IS LAST IN GROUP 
          SA4    B5+B1             NO, CONTINUE 
          BX4    -X0*X4 
          SX4    X4                ADDRESS OF NEXT EXECUTABLE WORD
          BX6    X4+X3             COMBINE WITH OVERLAY NUMBER
          BX6    X6+X5             ADD RJ RES 
          SA6    A2                REPLACE EXECUTBALE WORD BY TRAP
          EQ     DLK9              AND CONTINUE 
  
 DLK10    SA4    DLKB+1            GET 1ST EXECUTABLE WORD ADDRESS
          BX6    X4+X3             COMBINE WITH OVERLAY NUMBER
          BX6    X6+X5             ADD RJ RES 
          SA6    A2                REPLACE EXECUTABLE WORD BY TRAP
          EQ     DLK6              AND SCAN DELINK TABLE FOR NEXT GROUP 
                                                                         LDR0166
 DLK11    MESSAGE MSG0             REPLACED WORD IS NON-EXECUTABLE       LDR0166
          ABORT                                                          LDR0166
  
 DLKA     RJ     RES               USED FOR STORING INTO PROGRAMS 
 -        VFD    30/0 
 DLKB     CON    0                 OFFSET FROM START OF GROUP 
          CON    0                 POINTER TO 1ST EXECUTABLE WORD 
 GRP      SPACE  4,8
**        GRP - PROCESS GROUP CASE. 
* 
*         WHEN A WORD IN A SEGMENT REFERENCES SOME OTHER SEGMENT, AND 
*         THE OTHER SEGMENT IS OR BECOMES UNLOADED, THE WORD IS 
*         SAVED OFF ON ONE SIDE, AND REPLACED BY A WORD CONTAINING
*         *RJ  RES* IN BITS 30-59, AND A CALLING SEQUENCE IN BITS 0-29. 
*         WE WANT TO FIND THE ORIGINAL WORD, AND PUT IT BACK IN PLACE.
*         THE CALLING SEQUENCE IS 
*                  VFD   12/Q,1/T,17/R
*         Q IS THE NUMBER OF THE SEGMENT (ITS ORDINAL IN TABLE
*         *CELTAB*) THAT HAS TO BE LOADED BEFORE THE REFERENCE CAN BE 
*         EXECUTED. LET S BE THE ADDRESS OF THE WORD THAT CONTAINS THE
*         RETURN JUMP AND THE CALLING SEQUENCE. 
* 
*         IF T=1, R IS THE ADDRESS AT WHICH THE EXECUTABLE WORD WAS 
*         SAVED WHEN THE RETURN JUMP TO *RES* REPLACED IT (DELINKING) 
*         AND ALL WE HAVE TO DO NOW (LINKING) IS TO COPY THE WORD AT R
*         INTO CELL S, AND AT LOCATION R STORE
*                  VFD   30/0,12/Q,1/1,17/S 
* 
*         IF T=0, THINGS ARE MORE COMPLICATED. THE EXECUTABLE 
*         WORD THAT WAS AT S IS ONE OF A GROUP IN THIS SEGMENT, ALL 
*         REFERENCING SEGMENT Q, AND WE ARE GOING TO RELINK THEM ALL
*         NOW. IT WOULD BE SIMPLER IF EACH ONE WERE HANDLED INDIVIDUALLY
*         AS IN THE PRECEDING PARAGRAPH, BUT WE GROUP THEM AND RELINK 
*         THEM ALL TOGETHER IN ORDER TO AVOID EXTRA CALLS TO *RES*, 
*         WHICH ARE TIME-CONSUMING BECAUSE OF THE ELABORATE REGISTER
*         SAVING AND RESTORATION.  WHEN T=0 R IS THE ADDRESS OF ANOTHER 
*         LOCATION IN THE SAME SEGMENT THAT CONTAINS A SIMILAR CALLING
*         SEQUENCE, REPLACING A REFERENCE TO THE SAME OUTSIDE 
*         SEGMENT. WHAT WE HAVE, AT DIFFERENT LOCATIONS IN THE
*         CALLING SEGMENT, IN A SEQUENCE FROM LOWEST TO HIGHEST 
*         ADDRESS IS
*         AT S(0)  RJ    RES
*                  VFD  12/X,1/0,17/S(1)
*         AT S(I) WHERE I IS ABOVE 0 AND BELOW N-1, THERE BEING N WORDS 
*         IN THE GROUP, 
*                  RJ   RES 
*                  VFD  12/Q,1/0,17/S(I+1)
*         AT S(N-1), THE LAST WORD IN THE GROUP,
*                  RJ   RES 
*                  VFD  12/Q,1/0,17/S(0)
* 
*         SO THE S WE HAVE FROM THE CALLING SEQUENCE THAT BROUGHT US TO 
*         *RES* POINTS TO ONE OF THE WORDS IN THE GROUP, BUT WE DONT
*         KNOW WHICH.  FOLLOW THE CIRCULAR CHAIN OF ADDRESSES UNTIL 
*         WE GET TO S(0), AT WHICH POINT WE RELINK ALL THE WORDS IN 
*         THE GROUP.  WE RECOGNIZE S(0) BECAUSE IT IS SMALLER THAN THE
*         ADDRESS OF THE WORD CONTAINING IT.
* 
*         ENTRY  (B1) = 1.
*                (B7) = FWA OF *CELTAB*.
*                (A1) = ADDRESS OF RJ INSTRUCTION.
*                (X1) = RJ INSTRUCTION OF CALLING PROGRAM.
* 
*         EXIT   (X6) = 30/0,12/Q,1/T,17/R. 
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6, 7.
*                B - 3, 4, 6. 
*                A - 1, 2, 3, 6, 7. 
  
  
 GRP      SUBR                     ENTRY/EXIT 
          MX0    1
          SX6    A1 
          LX0    18                =400000B 
          SX2    X1 
          PL     X2,GRP1           IF THE GROUP CASE
          BX3    -X0*X1            THE SIMPLE CASE
          SA2    X3                GET EXECUTABLE WORD
          BX7    X2 
          SA7    A1                INSERT IT IN CALLING PROGRAM 
          MX7    13 
          LX7    30                MASK FOR 12/Q,1/1
          BX1    X7*X1
          BX6    X1+X6             BITS 30-59=0 
          SA6    A2                PUT DELINK POINTER IN DELINK TABLE 
          EQ     GRP
  
 GRP1     IX7    X2-X6             DOES POINTER GO BACKWARDS
          NG     X7,GRP2           IF 1ST EXECUTABLE WORD IN GROUP
          SX6    X2                FOLLOW CHAIN 
          SA1    X6 
          SX2    X1 
          EQ     GRP1 
  
 GRP2     SB6    B0 
          SA1    CL 
          SB4    X1                LENGTH OF CELTAB TABLE 
 GRP3     SA1    B6+B7
          SX7    X1 
          PL     X7,GRP4           IF NOT LOADED
  
*         THE STRUCTURE OF *CELTAB* IS SUCH THAT AMONG THE ENTRIES FOR
*         CURRENTLY LOADED SEGMENTS, THE FWA"S MUST BE IN ASCENDING 
*         ORDER.  SO AS SOON AS WE FIND A LOADED FWA GREATER THAN S(0)
*         THE PRECEDING LOADED FWA MUST BE THE ONE WE WANT. 
  
          BX1    -X0*X1 
          SX7    X1                FWA OF OVERLAY 
          IX5    X7-X2
          PL     X5,GRP5           IF OVERLAY TOO HIGH, B3 MUST BE IT 
          SB3    X7                OVERLAY NOT TOO HIGH,SAVE FWA
 GRP4     SB6    B6+2 
          NE     B6,B4,GRP3        IF NOT END OF CELTAB 
 GRP5     SA1    X2 
          MX4    12 
          LX4    30                MASK FOR BITS 18-29
          BX6    X4*X1
          AX6    18 
          SA3    X6+B3             GETS THE FIRST EXECUTABLE WORD 
          BX7    X3 
          SA7    X2                STORE IT IN THE PROGRAM
          SX7    X2                REPLACE BY POINTER TO EXECUTABLE WORD
          SX6    X1                POINTER TO NEXT TRAP IN PROGRAM
          SA1    X6                GET SECOND TRAP WORD OF GROUP IN PROG
          BX5    X4*X1             GET OVERLAY NUMBER 
          BX7    X7+X5
          SA7    A3                STORE FIRST DELINK POINTER OF GROUP
 GRP6     IX7    X6-X2             IS POINTER TO TRAP BACKWARDS 
          NG     X7,GRP7           IF POINTER IS BACKWARD 
          SA1    X6                NO, GET NEXT TRAP
          SA3    A3+B1             GET NEXT WORD FROM DELINK TABLE
          SX2    X6                NOW X2=ADDRESS OF THIS TRAP
          SX6    X1                AND X6= ITS NEXT-TRAP POINTER
          BX7    X3 
          SA7    A1                STORE EXECUTABLE WORD IN PROGRAM 
          BX7    X4*X1             EXTRACT OVERLAY NUMBER FROM TRAP 
          BX7    X7+X2             COMBINE WITH ADDRESS OF WORD IN PROG 
          SA7    A3                AND STORE IN DELINK TABLE
          EQ     GRP6              CONTINUE CHAIN OF TRAPS IN PROGRAM 
  
 GRP7     SA1    A7 
          BX6    X1+X0
          SA6    A1                ADD 400000B TO LAST WORD OF GROUP
          EQ     GRP
 LSA      SPACE  4,8
**        LSA - LOAD SEGMENT AND ITS ANCESTORS. 
* 
*         WHEN WE HAVE DONE ALL THE UNLOADING FOR SEGMENT Q AND FOR 
*         EACH OF ITS ANCESTORS IN TURN (BACK TO AND INCLUDING THE
*         OLDEST UNLOADED ANCESTOR), WE SAVE ITS FATHER 
*         NUMBER, MARK ITS *CELTAB* ENTRY AS LOADED, THEN GET THE DISK
*         ADDRESS AND CM ADDRESS FROM THE *CELTAB* ENTRY AND CALL 
*         SUBROUTINE *LDS* TO READ IT IN. IF THIS IS NOT THE CAIN 
*         OVERLAY FOR WHICH SAVING GLOBAL BLOCKS IS IRRELEVANT BECAUSE
*         THE SEGMENT IS NEVER OVERLAID, AND IF THE *CELTAB* ENTRY SHOWS
*         THE GLOBAL BLOCK AREA HAS BEEN SAVED, CALL *LDS* AGAIN TO READ
*         IT IN.  CONTINUE LOADING IN THIS MANNER UNTIL WE HAVE 
*         LOADED THE OLDEST UNLOADED ANCESTOR.
* 
*         ENTRY  (B1) = 1.
*                (B2) = *CELTAB* INDEX FOR FIRST SEGMENT TO BE LOADED.
*                (B5) = *CELTAB* INDEX FOR LAST SEGMENT TO BE LOADED. 
*                (B7) = FWA OF *CELTAB*.
*                (X5) = MASK FOR FATHER NUMBER. 
*                (MS) = 0 FOR NO REDUCE OR 30/CMFL,30/0.
*                (FW) = FWA OF UNLOADED SEGMENTS. 
*                (LW) = LWA+1 OF UNLOADED SEGMENTS. 
* 
*         CALLS  LDS, RFL.
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                B - 4. 
*                A - 0, 1, 2, 3, 4, 5, 6, 7.
  
  
 LSA      SUBR                     ENTRY/EXIT 
          SA1    B2+B7
          SB4    B2 
          SA2    A1+B1
          SX1    X1 
          SX2    X2                LENGTH OF SEGMENT
          IX6    X1+X2             LWA+1
          SA1    HA                UPDATE HIGHEST ADDRESS 
          SA2    LW 
          SA3    FW 
          IX2    X2-X1
          MI     X2,LSA0           IF HA .GT. LWA+1 OF UNLOADED AREA
          SX7    X3 
          BX1    X3 
          SA7    A1                SET HA = FW
 LSA0     IX2    X1-X6
          AX2    60 
          BX1    -X2*X1 
          BX6    X2*X6
          BX6    X1+X6             MAX(HA,LWA+1 OF SEGMENT) 
          RJ     RFL
 LSA1     SA1    B4+B7
          MX3    42 
          SX7    X1                FWA OF SEGMENT 
          SA2    A1+B1
          BX4    X5*X1             FATHER NUMBER (BITS 18-29) 
          SX0    X2                LENGTH OF SEGMENT AND GLOBALS
          LX1    30 
          LX2    24 
          ZR     B4,LSA2           IF ROOT SEGMENT
          BX6    -X3*X2            DISK ADDRESS OF GLOBAL 
          LX2    18 
          ZR     X6,LSA2           NO SAVED GLOBAL YET
          SA3    B7+B1             CHECK N BIT
          LX3    59-56
          MI     X3,LSA2           IF N=1 THEN GLOBAL BLOCK IS FIRST
          SX2    X2                LENGTH OF GLOBAL 
          IX0    X0-X2             LENGTH OF SEGMENT ONLY 
          IX7    X7+X0             FWA OF GLOBALS 
          SA6    G+6
          RJ     LDS               LOAD GLOBALS 
          SA1    B4+B7
          MX3    42 
          SX7    X1                FWA OF SEGMENT 
          LX1    30 
 LSA2     MX2    1
          LX2    18+30
          BX6    X1+X2             MARK SEGMENT AS LOADED IN CELTAB 
          MX3    42 
          LX6    30 
          SX2    X0                LENGTH OF LOAD 
          SA6    A1 
          BX6    -X3*X1 
          SA6    B+6               DISK ADDRESS OF SEGMENT
          RJ     LDS               LOAD SEGMENT 
          SA1    B7+B1             CHECK N BIT
          LX1    59-56
          PL     X1,LSA3           IF GLOBAL BLOCK ALREADY LOADED 
          SA1    B4+B7
          MX3    42 
          SA2    A1+B1
          BX7    -X3*X1 
          LX2    24 
          AX1    48                LENGTH OF DELINK TABLE 
          ZR     B4,LSA3           IF ROOT SEGMENT
          IX7    X7+X1             FWA OF GLOBAL BLOCKS 
          BX6    -X3*X2            INDEX OF RECORD
          LX2    18 
          MX3    43 
          ZR     X6,LSA3           IF NO SAVED BLOCK
          BX7    -X3*X7            CLEAR SEGMENT LOADED BIT 
          SX2    X2                LENGTH OF BLOCK
          SA6    G+6
          RJ     LDS               LOAD GLOBAL BLOCKS 
 LSA3     EQ     B4,B5,LSA         IF OLDEST UNLOADED ANCESTOR LOADED 
          AX4    17                2*FATHER NUMBER
          SB4    X4 
          EQ     LSA1              GO TO LOAD FATHER
 SXP      SPACE  4,8
**        SXP - SAVE XJ PACKAGE.
* 
*         SAVE ALL REGISTERS INCLUDING MINUS ZERO IN AN XJ PACKAGE. 
*         THE RETURN ADDRESS IS ENTERED INTO THE P REGISTER FIELD.
*         THE RETURN ADDRESS IS THE SAME WORD THAT CALLED *RES*.
* 
*         ENTRY  (RES) = WHO CALLED US (BITS 30-47).
* 
*         EXIT   (B1) = 1.
*                (X1) = RJ INSTRUCTION OF CALLING PROGRAM.
*                (A1) = ADDRESS OF RJ INSTRUCTION.
*                (XP) = EXCHANGE PACKAGE WITH P REGISTER SET FOR RETURN.
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 1, 2, 3, 4.
*                A - 1, 2, 3, 6, 7. 
  
  
 SXP      SUBR                     ENTRY/EXIT 
          NG     B1,SXP1           IN CASE B1=-0
          SB1    B1-1 
          ZR     B1,SXP2           IF B1=1
          SB1    B1+1 
 SXP1     LT     B1,*+2            IF BIT 17 OF B1 SET
  
*         DECODE B1 BY A SERIES OF RJ INST. 
  
 +        RJ     *
 -        VFD    30/1 
          DUP    17 
          SB1    B1+B1
          LT     B1,*+2            IF BIT OF B1 IS SET
 +        RJ     *
 -        VFD    30/1 
          ENDD
 +        EQ     SXP3 
 -        RJ     SXP2 
 SXP2     RJ     *
 SXP3     SB1    A7-B0
          SA7    XP+15             X7 
          BX7    X6 
          SX6    B1-B0
          SB1    1
          SA7    XP+14             X6 
          ECHO   2,XN=(X5,X4,X3,X2,X1,X0) 
          BX7    XN 
          SA7    A7-B1             X5-X0
          MX4    -18
          SX7    B7 
          BX6    -X4*X6 
          BX7    -X4*X7 
          LX6    18 
          BX7    X6+X7
          SA7    XP+7              A7,B7
          ECHO   7,AN=(A6,A5,A4,A3,A2,A1),BN=(B6,B5,B4,B3,B2,B1)
          SX6    AN-B0
          SX7    BN-B0
          BX6    -X4*X6 
          BX7    -X4*X7 
          LX6    18 
          BX7    X6+X7
          SA7    A7-B1             A6-A1,B6-B1
          SA1    SXP2 
          LX1    3                 TEST FOR EQ OR RJ INSTRUCTION
          PL     X1,SXP5           IF A RJ INSTRUCTION
          SA1    A1-B1
          BX7    X1 
          LX7    30 
          SA7    A1+B1
          EQ     SXP7 
  
 SXP4     RJ     SXP1-1            USED TO RESTORE RJ TABLE 
 -        VFD    30/1 
  
*         RECONSTRUCT B1 AND RESTORE THE RJ"S ABOVE.
  
 SXP5     SB2    B1 
          SB3    36 
          SB4    B2+B2
          SX1    B2 
          SA2    SXP4 
          LX1    30+1 
          BX6    X2 
          SX7    B0 
 SXP6     SA3    B2+SXP1
          SB2    B2+B4
          LX7    1
          IX6    X6+X1
          SX3    X3 
          SA6    A3 
          IX7    X7+X3
          LT     B2,B3,SXP6        IF RECONSTRUCTION OF B1 INCOMPLETE 
          SA1    XP+1 
          BX6    X4*X1
          BX7    X6+X7
          SA7    A1                A1,B1
 SXP7     SA1    RES
          AX1    30 
          SX7    A0 
          SX6    X1-1              ADDRESS OF RJ INSTRUCTION
          BX7    -X4*X7 
          SA1    X6 
          LX6    18 
          BX6    X6+X7
          LX6    18 
          SA6    XP                P,A0,B0
          EQ     SXP
 ULS      SPACE  4,8
**        ULS - UNLOAD UNNEEDED SEGMENTS. 
* 
*         AT THIS POINT WE HAVE SWITCHED THE WORD WHICH CALLED
*         *RES*, AND MAYBE SOME OTHER SIMILAR WORDS RELATING TO 
*         THE SAME SEGMENT, WITH THE EXECUTABLE WORDS KEPT IN 
*         THE DELINK TABLE.  THIS ROUTINE WILL BE CALLED IF THE 
*         SEGMENT WE WANT IS NOT ALREADY LOADED.  WE MUST 
* 
*         (1) WORK BACKWARD IN *CELTAB* FROM THE WANTED SEGMENT,
*         CALL IT Q, TO ITS NEAREST ANCESTOR THAT IS LOADED,
*         UNLOADING ANY SEGMENTS IN BETWEEN.  IF IN THE CHAIN OF
*         ANCESTORS WE REACH A PATRIARCH WHOSE FATHER NUMBER IS 0, STOP 
*         THE PROCESS BECAUSE IT REPRESENTS THE BOTTOM OF A LEVEL, AND
*         LOADING ON ONE LEVEL CANNOT EFFECT THE LOADING ON A LOWER ONE.
*         IF WE REACH A PATRIARCH WHOSE FATHER NUMBER IS 7777B, AND IF
*         ANYTHING HAS ACTUALLY BEEN UNLOADED SO FAR, WE ALSO STOP THE
*         BACKWARD SCAN, BECAUSE THIS PATRIARCH IS THE ROOT OF A TREE,
*         AND IF ANYTHING IN THAT TREE WAS PREVIOUSLY LOADED, (WHICH IT 
*         WAS, BECAUSE WE JUST HAD TO UNLOAD IT), NOTHING IN ANY OTHER
*         TREE IN THE SAME LEVEL COULD HAVE BEEN LOADED.  OTHERWISE,
*         WE WORK BACK FROM THIS PATRIARCH, UNLOADING ANY LOADED SEGMENT
*         WE MEET, UNTIL WE MEET THE BOTTOM OF THE LEVEL, OR HAVING 
*         UNLOADED AT LEAST ONE SEGMENT WE MEET ANOTHER PATRIARCH.
* 
*         (2) WORK FORWARD IN *CELTAB* FROM SEGMENT Q, UNLOADING ANY
*         LOADED SEGMENTS WE MEET, UNTIL WE MEET A PATRIARCH AT THE 
*         BOTTOM OF A LEVEL (WITHOUT UNLOADING IT) OR A PATRIARCH 
*         OF A NEW TREE ON THE SAME LEVEL, PROVIDED WE HAVE UNLOADED AT 
*         LEAST ONE SEGMENT ALREADY (OR SEEN A LOADED ANCESTOR OF Q ON
*         THE SAME LEVEL AS Q) -- THEN STOP AND DONT UNLOAD THAT
*         PATRIARCH.
* 
*         THE LOGIC OF STEPS (1) AND (2) IS THAT IF WE LOAD A PREVIOUSLY
*         UNLOADED SEGMENT ON A GIVEN LEVEL, THE ONLY OTHER SEGMENTS ON 
*         THE SAME LEVEL THAT CAN BECOME OR REMAIN LOADED ARE ITS 
*         ANCESTORS. ONCE WE MEET AN ALREADY-LOADED ANCESTOR, WE CAN
*         STOP SCANNING BACK, BECAUSE THE SEGMENTS PRECEDING THAT 
*         ANCESTOR MUST HAVE BEEN CLEANED UP WHEN HE WAS LOADED.
* 
*         ENTRY  (B1) = 1.
*                (B7) = FWA OF *CELTAB*.
*                (X6) = INDEX INTO *CELTAB* FOR DESIRED SEGMENT.
*                (CL) = LENGTH OF *CELTAB*. 
* 
*         EXIT   (B2) = *CELTAB* INDEX FOR FIRST SEGMENT TO BE LOADED.
*                (B3) = LENGTH OF CELTAB. 
*                (B5) = *CELTAB* INDEX FOR LAST SEGMENT TO BE LOADED. 
*                (X5) = MASK FOR FATHER NUMBER (BITS 18-29).
*                (FW) = FWA OF UNLOADED SEGMENTS. 
*                (LW) = LWA+1 OF UNLOADED SEGMENTS. 
* 
*         CALLS  UNL. 
* 
*         USES   X - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2, 3, 4, 5, 6. 
*                A - 1, 2, 3, 6, 7. 
  
  
 ULS      SUBR                     ENTRY/EXIT 
          SB2    X6                CELTAB OFFSET OF KEY OVERLAY 
          SA1    X6+B7
          SX6    X1                FWA OF SEGMENT 
          SA6    FW 
          SA6    LW 
          SA1    CL 
          SB3    X1                LENGTH OF CELTAB 
          SB4    B2                SCAN POINTER 
          SX4    B0 
          MX5    12 
          LX5    30                MASK FOR FATHER NUMBERS IN CELTAB
 ULS1     SB5    B4                B5 POINTS TO OLDEST UNLOADED ANCESTOR
          SA1    B7+B4
          BX6    X5*X1             EXTRACT FATHER NUMBER
          ZR     X6,ULS7           IF O.U.A. IS 1ST PATR IN LEVEL 
          IX7    X6-X5
          ZR     X7,ULS4           IF O.U.A. IS OTHER PATRIARCH 
          AX6    17 
          SB6    X6                B6 POINTS TO NEXT ANCESTOR 
 ULS2     SB4    B4-2              STEP BACK IN CELTAB
          EQ     B4,B6,ULS3        IF NEXT ANCESTOR REACHED 
          SA1    B7+B4             INTERVENING NONANCESTOR
          SX1    X1 
          PL     X1,ULS2           IF NOT LOADED ALREADY
          BX4    X5                LOADED - SET X4=7777000000 
          RJ     UNL               UNLOAD IT
          EQ     ULS2 
  
 ULS3     SA1    B7+B6
          SX1    X1 
          PL     X1,ULS1           IF NEXT ANCESTOR UNLOADED
          BX4    X5                LOADED - SET X4=7777000000 
          EQ     ULS7              UNLOADED ALL BELOW KEY OVERLAY 
  
 ULS4     NZ     X4,ULS7           IF A LOADED OVERLAY HAS BEEN SEEN, 
 ULS5     SB4    B4-2              BACK UP IN CELTAB
          SA1    B7+B4
          SX1    X1 
          PL     X1,ULS6           IF NOT LOADED
          BX4    X5                LOADED - SET X4=7777000000 
          RJ     UNL               AND UNLOAD IT
 ULS6     SA1    B7+B4
          BX2    X5*X1             FATHER NUMBER
          ZR     X2,ULS7           IF BOTTOM OF LEVEL REACHED 
          BX7    X2-X4
          NZ     X7,ULS5           IF ONE OVERLAY HAS BEEN LOADED 
 ULS7     SB4    B2                UNLOAD TO END OF TREE OR LEVEL 
 ULS8     SB4    B4+2 
          EQ     B3,B4,ULS         IF END OF CELTAB TABLE 
          SA1    B7+B4
          BX2    X5*X1             GET FATHER NUMBER
          ZR     X2,ULS            IF TOP OF TREE FOUND 
          IX2    X2-X4
          ZR     X2,ULS            IF TOP OF TREE FOUND 
          SX6    X1 
          PL     X6,ULS8           IF NOT LOADED
          RJ     UNL               UNLOAD IT
          BX4    X5                SET X4=77770...0 
          EQ     ULS8 
          TITLE  COMMON SUBROUTINES.
 CMM      SPACE  4,8
**        CMM - CALL MEMORY MANAGER.
* 
*         ENTRY  (FW) = FWA OF UNLOADED SEGMENTS. 
*                (LW) = LWA+1 OF UNLOADED SEGMENTS. 
*                (X6) = LWA+1 NEEDED = NEW DABA.
* 
*         CALLS  CMM.UNL, CMM.SDA.
* 
*         USES   X - 1, 2, 6. 
*                B - NONE.
*                A - 1, 2, 3, 4, 5, 6, 7. 
  
  
 CMM      PS                       ENTRY/EXIT 
          SA6    CMMA              SAVE REGISTERS 
          SA7    A6+B1
          BX6    X3 
          LX7    X4 
          SA6    A7+B1
          SA7    A6+B1
          SX6    B4 
          SX7    B5 
          SA6    A7+B1
          SA7    A6+B1
          SX6    B6 
          SX7    B7 
          SA6    A7+B1
          SA7    A6+B1
          SA1    FW 
          SA2    LW 
 CMM1     EQ     CMM2              RJ CMM.UNL         *** MODIFIED ***
 CMM2     SA1    CMMA 
 CMM3     EQ     CMM4              RJ CMM.SDA         *** MODIFIED ***
 CMM4     SA1    CMMA+1            RESTORE REGISTERS
          SA3    A1+B1
          SA4    A3+B1
          BX7    X1 
          SA1    A4+B1
          SA2    A1+B1
          SB4    X1 
          SB5    X2 
          SA1    A2+B1
          SA2    A1+B1
          SB6    X1 
          SB7    X2 
          EQ     CMM
  
 CMMA     BSSZ   8                 REGISTER SAVE AREA 
 LCS      SPACE  4,8
**        LCS - LOAD CAIN SEGMENT.
* 
*         *LCS* WILL LOAD THE CAIN SEGMENT BY CALLING *RES* AS ANY OTHER
*         SEGMENT WOULD.  BIT 17 OF *LCSA* SHOWS THIS AS A SIMPLE ONE 
*         WORD DELINK.  BITS 0-16 POINT TO *LCSD*.  THE WANTED
*         SEGMENT NUMBER IS 0 SPECIFIED IN BITS 18-29 OF *LCSA*.
*         THE CODE AT *LCSB* CHECKS IF A BLANK COMMON LENGTH HAS
*         BEEN SPECIFIED, AND, IF SO, ISSUES A CALL TO *CMM.ALF* TO 
*         ALLOCATE A FIXED-POSITION BLOCK OF THE LENGTH OF //.
*         *LCSC* IS PRESET TO A JUMP TO THE TRANSFER ADDRESS
*         IN THE CAIN SEGMENT.  AFTER *RES* LOADS SEGMENT 0,
*         THE CONTENTS OF *LCSD* HAVE BEEN MOVED TO *LCSA*, WHICH IS
*         WHERE CONTROL RETURNS AFTER THE *XJ* IS EXECUTED BY *RES*.
* 
*         ENTRY  (A0) = CM FL.
*                (X0) = ECS FL. 
*                (B2) = FWA OF *CELTAB* DESIRED ON CALL TO *RES*. 
*                (B3) = PRESENT FWA OF *CELTAB* TABLE.
*                (B4) = LENGTH OF *CELTAB* TABLE. 
*                (B5) = 0.
*                (B6) = LWA OF CM TO PRESET.
*                (B7) = FWA OF CM TO PRESET.
*                (X3) = 0 IF NO ADDRESS INSERTION.
*                     = 2 IF ADDRESS INSERTION. 
*                (X4) = (X5) = PRESET VALUE.
*                (LCSC) = JUMP INSTRUCTION INTO CAIN SEGMENT. 
* 
*         EXIT   TO TRANSFER ADDRESS IN (LCSA+1). 
* 
*         CALLS  RES. 
* 
*         USES   X - 1, 2, 6, 7.
*                B - 5. 
*                A - 1, 2, 6, 7.
  
  
 LCS      SA1    B3+B5             MOVE CELTAB
          SA2    A1+B1
          BX6    X1 
          LX7    X2 
          SA6    B2+B5
          SB5    B5+2 
          SA7    A6+B1
          GT     B4,B5,LCS         IF CELTAB NOT COMPLETELY MOVED 
          BX6    X4 
          LX7    X5 
 PSM      SA6    B7                STORE WORD 
          IX6    X6+X3             INCREMENT IF DOING ADDRESS INSERTION 
          SA7    B7+B1
          IX7    X7+X3             INCREMENT IF DOING ADDRESS INSERTION 
          SB7    B7+2              BUMP STORE ADDRESS 
          LT     B7,B6,PSM         IF MORE TO PRESET
 LCSA     RJ     RES               SIMULATES A DELINKED JUMP FROM AN
 -        VFD    12/0,18/LCSD+400000B  IMAGINARY SEGMENT TO ROOT SEGMENT
 LCSB     SA2    BC                (X2) = // LENGTH OR ZERO 
          ZR     X2,LCSC           IF // BLOCK NOT TO BE ALLOCATED
 CMM5     MX3    0                 SIZE CODE, GROUP-ID = 0
          NO
          EQ     LCSC              RJ CMM.ALF         *** MODIFIED ***
  
 LCSC     EQ     **                JUMP TO STARTING ADDRESS 
  
 LCSD     EQ     LCSB              START EXECUTION AT CHECK FOR CMM CALL
 LDS      SPACE  4,8
**        LDS - LOAD A SEGMENT OR GLOBAL COMMON BLOCK.
* 
*         WE SET FWA, IN AND OUT = FWA AND LIMIT = FWA+LENGTH+1 BEFORE
*         DOING A READ. 
* 
*         ENTRY  (A6) = FET + 6 WITH PRU INDEX STORED INTO FET. 
*                (X7) = FWA OF LOAD.
*                (X2) = LENGTH OF LOAD. 
* 
*         EXIT   (A1) = FET ADDRESS.
*                (X2) = IN ADDRESS. 
*                (A2) = FET+2.
* 
*         CALLS  CIO=.
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                B - NONE.
*                A - 1, 2, 6, 7.
  
  
 LDS      SUBR                     ENTRY/EXIT 
          IX1    X2+X7             LWA+1
          SA2    A6-5              FIRST
          MX6    42 
          SA7    A2+B1             IN 
          BX2    X6*X2
          SA7    A7+B1             OUT
          SX3    X1+B1             LWA+2
          BX7    X7+X2
          SA1    A7+B1
          SA7    A2 
          BX1    X6*X1
          BX6    X3+X1
          SA6    A1                LIMIT
          READSKP A7-B1,RCL 
          EQ     LDS
 RFL      SPACE  4,8
**        RFL - REQUEST FL CHANGE.
* 
*         RFL CALLS *MEM* TO CHANGE THE FL AND SET THE LIMIT FIELD
*         FOR FET *B*.  IF WE ARE NOT IN REDUCE MODE THEN NO
*         MEMORY CHANGE IS MADE.  IF THE HHA AT RA.LWP (BITS 0-17)
*         DOES NOT AGREE WITH THE HHA IN RA.ORG (BITS 18-35) THEN 
*         THE RUNNING PROGRAM HAS REQUESTED FL ABOVE THE HHA AND
*         WE MUST NOT CHANGE THE FL UNTIL IT HAS BEEN UNLOADED. 
* 
*         ENTRY  (X6) = LWA+1 NEEDED. 
*                (MS) = 0 MEANS WE ARE NOT IN REDUCE MODE OTHERWISE 
*                       THE CURRENT FL IS IN BITS 30-59.
* 
*         EXIT   (X6) = NEW FL IF CHANGED.
*                (A0) = NEW FL IF CHANGED.
*                (MS) = NEW FL IF CHANGED (BITS 30-59). 
*                (B) = FL ADDED TO FET LIMIT. 
*                (HA) = UPDATED TO HIGH ADDRESS.
* 
*         CALLS  CMM, SYS=. 
* 
*         USES   X - 1, 2, 6. 
*                B - NONE.
*                A - 0, 1, 2, 3, 4, 5, 6, 7.
  
  
 RFL      SUBR                     ENTRY/EXIT 
          SA1    RA.ORG 
          SA2    RA.LWP 
          AX1    18 
          SX2    X2 
          MI     X2,RFL2           IF CMM IS PRESENT
          SX1    X1 
          ZR     X1,RFL3           IF THIS IS A 54 TABLE LOAD 
          IX2    X1-X2
          NG     X2,RFL            IF CURRENT HHA .GT. HHA OF SEGMENTS
 RFL1     SA1    HA 
          SA6    A1                UPDATE HIGH ADDRESS
          IX1    X1-X6
          PL     X1,RFL            IF HA .GE. LWA+1 THEN DO NOT MEM 
          SA2    MS 
          ZR     X2,RFL            IF WE ARE NOT IN REDUCE MODE 
          SX6    X6+103B           ROUND UP BY 4 WORDS AT LEAST          LDR0199
          MX1    -6 
          AX2    30 
          BX6    X1*X6
          IX2    X2-X6
          ZR     X2,RFL            IF NO FL CHANGE NEEDED 
          SA0    X6 
          MEMORY CM,MS,RCL,X6 
          SA2    B+4
          MX6    42 
          BX2    X6*X2             SAVE BITS 18-59 OF LIMIT 
          SX6    A0 
          BX6    X6+X2
          SA6    A2 
          EQ     RFL
  
 RFL2     SA2    AF 
          NZ     X2,RFL2A          IF *CMM.ALF* WAS CALLED TO ALLOCATE
                                    A FIXED BLOCK WHERE //, IF PRESENT, 
                                    RESIDES 
          SA1    RA.ORG+4          USE MAX (REQUEST, HHA) 
          SX1    X1 
          IX2    X1-X6
          MI     X2,RFL2A    USE REQUEST
          BX6    X1          USE HHA
 RFL2A    SA6    HA          UPDATE HHA 
          RJ     CMM               CALL MEMORY MANAGER
          EQ     RFL
  
 RFL3     SA1    RA.ORG+4 
          SX1    X1                HHA FROM 54 TABLE
          IX2    X1-X2
          ZR     X2,RFL1           IF HHA = LWA+1 OF LOAD 
          EQ     RFL
 UNL      SPACE  4,8
**        UNL - UNLOAD A SEGMENT. 
* 
*         THIS ROUTINE FLAGS A SEGMENT AS UNLOADED IN *CELTAB*. 
*         IF NECESSARY IT WRITES OUT THE SAVE GLOBAL COMMON BLOCKS. 
*         IF THE GLOBAL BLOCK HAS NOT BEEN SAVED PREVIOUSLY THE PRU 
*         INDEX IS ENTERED INTO THE *CELTAB* ENTRY. 
* 
*         ENTRY  (B1) = 1.
*                (B4) = INDEX INTO *CELTAB* FOR UNLOADED SEGMENT. 
*                (B7) = FWA OF *CELTAB*.
*                (FW) = FWA OF UNLOADED SEGMENTS. 
*                (LW) = LWA+1 OF UNLOADED SEGMENTS. 
* 
*         EXIT   (FW) = UPDATED.
*                (LW) = UPDATED.
* 
*         CALLS  CIO=.
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                B - NONE.
*                A - 1, 2, 3, 6, 7. 
  
  
 UNL      SUBR                     ENTRY/EXIT 
          SA1    B4+B7
          MX7    59 
          LX7    17 
          BX7    X7*X1
          SA7    A1                SET TO UNLOADED IN CELATB
          SA2    A1+B1             WORD 2 OF CELTAB ENTRY 
          SX6    X2                LENGTH OF OVERLAY
          SX1    X7                FWA OF OVERLAY 
          SA3    FW 
          IX7    X3-X1
          AX7    60 
          BX3    X7*X3
          BX7    -X7*X1 
          BX7    X7+X3             MIN(FW,FWA OF SEGMENT) 
          SA7    A3 
          SA3    LW 
          IX7    X1+X6             LWA+1 OF SEGMENT 
          IX1    X7-X3
          AX1    60 
          BX6    -X1*X7 
          BX3    X1*X3
          BX6    X3+X6             MAX(LW,LWA+1 OF SEGMENT) 
          SA6    A3 
          LX2    42 
          SX3    X2                LENGTH OF SAVE GLOBAL
          SA1    B7+B1             GET N BIT
          ZR     X3,UNL            IF NO SAVED GLOBAL BLOCKS
          LX1    59-56
          IX6    X7-X3             FWA OF SAVE GLOBAL 
          PL     X1,UNL0           IF N=0 GLOBAL BLOCKS ARE LAST
          SA1    A2-B1
          SX6    X1                FWA OF GLOBAL BLOCKS 
          AX1    -12               DELINK TABLE LENGTH
          IX6    X6+X1
          IX7    X6+X3             LWA+1 OF GLOBAL BLOCKS 
 UNL0     SA3    G+1               PRESERVE BITS 18-59 OF FET+1 
          MX1    42 
          BX3    X1*X3
          BX6    X6+X3
          SA6    A3                FWA=FIRST
          SA7    A6+B1             IN=LWA+1 
          SX6    X6 
          SA6    A7+B1             OUT=FWA
          SA3    A6+B1
          SX7    X7+B1
          BX3    X1*X3             PRESERVE BITS 18-59
          BX7    X7+X3
          LX2    42                POSITION DISK ADDRESS
          SA7    A3 
          BX7    -X1*X2 
          NZ     X7,UNL1           IF MUST REWRITE
          SX6    UNLA              MUST WRITE 1ST TIME AND GET PRU
          SA6    G+6
          WRITER G,RCL
          MX6    42 
          SA1    UNLA 
          BX6    -X6*X1 
          LX6    36 
          SA2    A2                WORD 2 OF CELTAB ENTRY 
          BX6    X2+X6             INSERT D.A. OF SAVED GLOBAL IN CELTAB
          SA6    A2 
          EQ     UNL
  
 UNL1     SA7    G+6
          REWRITER G,RCL
          EQ     UNL
  
 UNLA     CON    0                 WRITE STATUS WORD
          SPACE  4,8
*CALL     COMCCIO                  I/O FUCTION PROCESSOR. 
  
*CALL     COMCSYS                  PROCESS SYSTEM REQUEST.
  
 BASE     BSS    0                 LWA+1 OF SEGRES AFTER INITIALIZATION 
          ERRMI  1000B-BASE        SEGRES TOO LARGE FOR EXECUTION 
          TITLE  SEGRES INITIALIZATION. 
          SPACE  4,8
**        INITIALIZATION DEFINITIONS. 
  
  
 A        FILEB  ENDRES,1          FET FOR COPYING LOAD FILE TO RANDOM
 DA       CON    0                 DISK ADDRESS OF CELTAB TABLE 
 EX       CON    0                 TRANSFER ENTRY POINT NAME
 FE       CON    0                 ECS FL 
 LE       CON    0                 ECS USED IN SEGMENT LOAD 
 MF       CON    0                 MAXIMUM FL ALLOWED 
 NF       CON    0                 NOMINAL FL 
 NR       CON    0                 REWIND INDICATOR (LOAD FILE ON TAPE) 
 Z1       VFD    42/0LZZZZZ31,18/3 SEGMENT FILE IF LOAD FILE IS ON TAPE 
 Z2       VFD    42/0LZZZZZ32,18/3 GLOBAL BLOCKS ARE SAVED ON THIS FILE 
 PSMA     CON    0                 PRESET FLAG
 PMSB     CON    0                 PRESET VALUE 
 ERRORS   SPACE  4,8
****      SEGRES INITIALIZATION ERRORS. 
  
  
 MSG1     DATA   C* MISSING EXECUTE.* 
 MSG2     DATA   C* CM FL TOO SMALL.* 
 MSG3     DATA   C* ECS FL TOO SMALL.*
 MSG5     DATA   C* NO TRANSFER ADDRESS.* 
 MSG50    DATA   C* IGNORING EXTRA LOAD FILES.* 
 MSG101   DATA   C* SEGRES TOO LARGE.*
 MSG102   DATA   C* ECS WRITE ABORT.* 
 MSG103   DATA   C* MISSING LOAD.*
 MSG104   DATA   C* BAD SEGLOAD BINARY.*
  
****
 SEGRES   SPACE  4,8
 SEGRES   SPACE  4,8
***       SEGRES - SEGMENT LOADER INITIALIZATION. 
* 
*         THE DIRECTIVE TABLE MUST CONTAIN AT LEAST ONE LOAD
*         DIRECTIVE AND ONLY ONE EXECUTE DIRECTIVE.  ANY OTHER
*         DIRECTIVES ARE IGNORED.  THE FIRST LOAD FILE IS A FILE
*         CONTAINING THE FAMILY OF SEGMENTS.  SEGRES WILL COPY THE FILE 
*         TO A RANDOM ACCESS FILE IF IT IS NOT ON DISK OR IF NO REWIND
*         IS SPECIFIED ON THE LOAD DIRECTIVE.  THIS IS NECESSARY
*         BECAUSE THE DISK ADDRESSES IN THE *CELTAB* TABLE REQUIRES THE 
*         FILE TO BE ON DISK AND START AT PRU 1.  FILE ZZZZZ32 IS 
*         RETURNED IN PREPARATION FOR WRITING THE SAVED GLOBAL
*         COMMON BLOCKS.  ECS IS INITIALIZED AND THE *CELTAB* TABLE 
*         IS LOADED STARTING AT *ENDRES*.  INITIALIZATION DOES ALL
*         ERROR CHECKING BEFORE CALLING *RES* TO LOAD AND START 
*         EXECUTION OF THE ROOT SEGMENT.
* 
*         ENTRY  (A0) = CM FL.
*                (X0) = ECS FL. 
*                (B2) = PRESET FLAG.
*                (B3) > 0 IF IN REDUCE MODE.
*                (B4) = MFL (MAXIMUM FL FOR THIS JOB).
*                (B5) = NFL (NOMINAL FL). 
*                (B6) = FWA OF LOAD DIRECTIVES (.GT. HHA OF SEGRES).
*                (B7) = LWA+1 OF LOAD DIRECTIVES. 
*                (X5) = PRESET VALUE. 
* 
*         EXIT   TO *LCS*.
* 
          SPACE  4,8
****      INITIALIZATION MAIN LOOP. 
  
  
 SEGRES   SB1    1
          RJ     CSS               CHECK SYSTEM STATUS
          RJ     CDT               CHECK DIRECTIVE TABLE
          RJ     RIR               READ INDEX RECORD
          RJ     PIR               PROCESS INDEX RECORD 
          RJ     WEI               WRITE ECS IMAGE
          RJ     RCT               READ CELTAB TABLE
          RJ     IPM               INITIALIZE FOR PRESETTING OF MEMORY
          EQ     LCS               LOAD ROOT SEGMENT AND START EXECUTION
  
****      END OF INITIALIZATION MAIN LOOP.
          TITLE  PRIMARY INITIALIZATION ROUTINES. 
 CDT      SPACE  4,8
**        CDT - CHECK DIRECTIVE TABLE.
* 
*         LOOK AT THE FIRST DIRECTIVE.  IF BITS 48-59 ARE NOT ZERO
*         THEN THIS IS NOT A LOAD DIRECTIVE SO WE ABORT.  OTHERWISE 
*         TAKE THE FILE NAME FROM THE DIRECTIVE AND INSERT THIS 
*         INTO FET *B*.  IF MORE THAN ONE LOAD FILE IS GIVEN THEN 
*         ISSUE A WARNING MESSAGE.  THIS ROUTINE WILL SKIP ALL OTHER
*         DIRECTIVES UNTIL A EXECUTE DIRECTIVE IS FOUND.  THE FIRST 
*         PARAMETER IF ANY IS THE TRANSFER ENTRY POINT NAME.  WORDS 
*         FOLLOWING ARE STORED STARTING AT RA.ARG.  THE LWA+1 OF THE
*         PARAMETERS IS SAVED INTO RA.ACT.
* 
*         ENTRY  (B1) = 1.
*                (B6) = FWA OF DIRECTIVES.
*                (B7) = LWA+1 OF DIRECTIVES.
* 
*         EXIT   (NR) = REWIND INDICATOR FROM LOAD DIRECTIVE. 
*                (B) = LOAD FILE ADDED TO FET.
* 
*         CALLS  ERR, SYS=. 
* 
*         USES   X - 0, 1, 2, 3, 6, 7.
*                B - 2, 6.
*                A - 1, 2, 6, 7.
  
  
 CDT      SUBR                     ENTRY/EXIT 
          MX0    -12
          SA1    B6 
          LX1    12 
          BX6    -X0*X1 
          SA2    B6+B1
          IFNE   CLOAD,0,1
          SX6    X6-CLOAD 
          NZ     X6,ERR103         IF NO LOAD TABLE 
          MX6    42 
          SX7    X2 
          SX3    3                 ADD FILE MODE BITS TO FET
          BX6    X6*X2
          BX6    X6+X3
          SA7    NR                SET REWIND INDICATOR 
          LX1    12 
          SA6    B                 FILE NAME
          BX2    -X0*X1            L-1 OF SUBTABLE
          SB6    B6+B1
          SX2    X2-1 
          ZR     X2,CDT2           IF LOAD TABLE HAS ONLY ONE FILE
 CDT1     MESSAGE MSG50,LOCAL      ISSUE WARNING MESSAGE
 CDT2     SB6    B6+B1
          SB6    B6+X2
          GE     B6,B7,ERR1        IF MISSING EXECUTE DIRECTIVE 
          SA1    B6 
          LX1    12 
          BX6    -X0*X1 
          LX1    12 
          BX2    -X0*X1 
          SX3    X6-CEXECUTE
          IFNE   CLOAD,0,1
          SX6    X6-CLOAD 
          ZR     X6,CDT1           IF MORE LOAD DIRECTIVES
          NZ     X3,CDT2           IF NO EXECUTE DIRECTIVE YET
          SB2    RA.ARG 
          SX6    B0 
          SB6    B6+B1
          SA6    EX 
          EQ     B6,B7,CDT4        IF NO MORE PARAMS
          SA1    B6 
          MX6    42 
          BX6    X6*X1
          SA6    A6                START NAME IN SEGRES+1 
 CDT3     SB6    B6+B1
          EQ     B6,B7,CDT4        IF NO MORE PARAMS
          SA1    B6 
          BX6    X1 
          SA6    B2 
          SB2    B2+B1
          EQ     CDT3 
  
 CDT4     SA1    B           FILE NAME
          MX6    42 
          BX6    X6*X1
          SX1    B2-RA.ARG         COUNT OF PARAMETERS
          BX6    X1+X6
          SA6    RA.ACT 
          MX6    0
 CDT5     SA6    B2          ZERO REMAINDER OF PARAMETER WORDS
          SX1    B2-RA.LAPR 
          SB2    B2+B1
          NZ     X1,CDT5     IF MORE TO ZERO OUT
          EQ     CDT
 CSS      SPACE  4,8
**        CSS - CHECK SYSTEM STATUS.
* 
*         SAVE THE REDUCE FLAG, MAXIMUM FL AND NOMINAL FL (LAST RFL 
*         GIVEN IF ANY) GIVEN TO USE BY THE LOADER.  ADD OUR LWA+1 TO 
*         RA.ORG AND RA.LWP SO *RFL* DOESN"T THINK SOMEONE HAS FL 
*         ASSIGNED ABOVE US.  FINALLY WE RETURN ZZZZZ32 BECAUSE WE
*         WILL BE NEEDING IT TO SAVE GLOBAL COMMON BLOCKS.
* 
*         ENTRY  (B1) = 1.
*                (B2) = PRESET FLAG.
*                (B3) > 0 IF IN REDUCE MODE.
*                (B4) = MFL.
*                (B5) = NFL.
*                (B6) = FWA OF DIRECTIVE TABLE. 
*                (B7) = LWA+1 OF THE DIRECTIVE TABLE. 
*                (A0) = CM FL.
*                (X0) = ECS FL. 
*                (X5) = PRESET VALUE. 
* 
*         EXIT   (FE) = ECS FL ASSIGNED TO THIS PROGRAM.
*                (MS) = 0 IF WE ARE NOT IN REDUCE MODE. 
* 
*         CALLS  CIO=, ERR. 
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2. 
*                A - 1, 2, 3, 6, 7. 
  
  
 CSS      SUBR                     ENTRY/EXIT 
          SX7    B2 
          BX6    X5 
          SA7    PSMA              SAVE PRESET FLAG 
          SA6    A7+B1             SAVE PRESET VALUE
          BX7    X0 
          MX2    42 
          SA1    B+4
          SB2    ENDRES 
          SX6    A0 
          BX1    X2*X1             SAVE BITS 18-59
          GT     B2,B6,ERR101      IF SEGRES IS TOO LARGE 
          SA7    FE 
          BX6    X6+X1
          SA6    A1 
          SX6    B4 
          SX7    B5 
          SA6    MF 
          SA7    NF 
          SA2    RA.LWP 
          MX6    1
          LX6    18-59
          BX6    -X6*X2      CLEAR LOADED-FROM-LIBRARY FLAG 
          SA6    A2 
          SA3    RA.ORG 
          SX7    X2 
          MX4    -18
          LX7    18 
          BX6    -X4*X3 
          BX6    X7+X6             ADD LWA+1 TO RA.ORG FOR RFL
          SA6    A3 
          NG     B3,CSS1           IF NOT IN REDUCE MODE
          SX7    A0 
          LX7    30 
          SA7    MS                SAVE CURRENT FL
 CSS1     SA1    Z2 
          SX2    G
          BX6    X1 
          SA6    X2                ADD FILE NAME TO FET 
          RETURN X2 
          EQ     CSS
 IPM      SPACE  4,10 
**        IPM - INITIALIZE FOR PRESETTING OF MEMORY.
* 
*         THIS ROUTINE DOES THE INITIALIZING OF REGISTERS FOR THE LOOP
*         IN ROUTINE *LCS* WHICH PRESETS MEMORY.
* 
*         ENTRY  (A0) = CM FL.
*                (B2) = DESIRED FWA OF *CELTAB*.
*                (B4) = LENGTH OF *CELTAB*. 
*                (PSMA) = -1 IF PRESETTING WITHOUT ADDRESS INSERTION. 
*                       =  0 IF NO PRESETTING.
*                       = +1 IF PRESETTING WITH ADDRESS INSERTION.
*                (PSMB) = PRESET VALUE. 
* 
*         EXIT   (B5) = 0.
*                (B6) = LWA OF CM TO PRESET.
*                (B7) = FWA OF CM TO PRESET.
*                (X3) = 0 IF NO ADDRESS INSERTION.
*                     = 2 IF ADDRESS INSERTION. 
*                (X4) = (X5) = PRESET VALUE.
* 
*         USES   X - 1, 2, 3, 4, 5. 
*                B - 6, 7.
*                A - 4, 5.
  
  
 IPM      PS     0                 ENTRY/EXIT 
          SX3    B2+B4             (X3) = LWA+1 OF *CELTAB* TABLE 
          SA4    PSMA              PRESET FLAG
          SX3    X3+B1             LWA+2
          MX1    59 
          BX2    X1*X3             CLEAR BIT 0
          SB7    X2                (B7) = LWA+1 OR LWA+2
          SB6    A0-B1             FL-1 
          MX3    0
          SX5    B0 
          ZR     X4,IPM1           IF NONE SPECIFIED, PRESET TO ZEROS 
          SA5    A4+B1             (X5) = PRESET VALUE
          MI     X4,IPM1           IF NO ADDRESS INSERTION
          MX1    43 
          BX3    X1*X5             CLEAR ADDRESS FIELD
          IX4    X2+X3             ADD ADDRESS TO PRESET VALUE
          SX2    X2+B1
          IX5    X2+X3             ADD ADDRESS TO PRESET VALUE
          SX3    B1+B1             (X3) = 2 
          SB5    B0 
          EQ     IPM
 IPM1     BX4    X5                (X4) = (X5) = PRESET VALUE 
          SB5    B0 
          EQ     IPM               RETURN 
 PIR      SPACE  4,8
**        PIR - PROCESS INDEX RECORD. 
* 
*         THIS ROUTINE PROCESSES THE INDEX STORED AT *ENDRES*.  THE 
*         FIRST WORD OF THE INDEX HAS THE FORM
*                  VFD   1/E,5/0,24/C,9/A,21/B                           LDR0167
*         IF *E* IS 1 THEN NO ECS IMAGE EXISTS EVEN IF *C* IS NON-ZERO.  LDR0167
*         *B* IS THE PRU NUMBER ON THE FILE AT WHICH THE *CELTAB* RECORD
*         BEGINS.  *C* IS THE ECS FIELD LENGTH REQUIRED TO EXECUTE
*         THE SEGMENTS.  *A* IS THE NUMBER OF WORDS THAT FOLLOW THIS
*         WORD IN THE INDEX.  THE *A* WORDS BEGINNING AT *ENDRES*+1 
*         HAVE THE FORMAT 
*                  VFD   42/NAME,18/ADDRESS 
*         WHERE *NAME* IS THE NAME OF AN ENTRY POINT IN THE ROOT SEGMENT
*         AT WHICH THE EXECUTION CAN BEGIN.  *ADDRESS* IS ITS ADDRESS.
*         IF *EX* CONTAINS ZERO THERE WAS NO STARTING POINT NAMED 
*         IN THE EXECUTE DIRECTIVE, SO WE USE THE FIRST ONE.
*         OTHERWISE WE MATCH THE NAME IN THE CELL *EX* AGAINST
*         THE LIST OF STARTING ENTRY POINTS AND ABORT IF THERE IS 
*         NO MATCH. 
* 
*         ENTRY  (B1) = 1.
*                (EX) = TRANSFER ENTRY POINT NAME (0L FORMAT).
*                (ENDRES) = FWA OF INDEX. 
* 
*         EXIT   (LCSC) = TRANSFER ADDRESS ADDED FOR CALL TO *RES*. 
*                (DA) = PRU OF *CELTAB* TABLE ON SEGMENT FILE.
*                (LE) = LENGTH OF ECS IMAGE.
* 
*         CALLS  ERR. 
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                B - 2. 
*                A - 1, 2, 3, 6.
  
  
 PIR      SUBR                     ENTRY/EXIT 
          SA1    ENDRES            INDEX STARTS HERE
          SX6    X1                DISK ADDRESS OF CELTAB 
          AX1    21 
          SA6    DA 
          MX6    51 
          BX6    -X6*X1            NUMBER OF REMAINING WORDS
          SB2    X6 
          ZR     B2,ERR5           IF EMPTY TANSFER TABLE 
          AX1    9
          BX6    X1                LENGTH OF ECS
          SA6    LE 
          SA2    A1+B1             FIRST TRANSFER NAME
          MX7    -24                                                     LDR0167
          BX6    -X7*X6            ECS LWA+1                             LDR0167
          SA6    RA.ORG+5          PUT LHHA INTO 54 TABLE 
          SA3    RA.ORG            ADD ECS FL TO RA.ORG FOR RECORD MAN. 
          SA1    EX                FIRST EXECUTE PARAMETER NAME 
          LX6    36 
          MI     X6,ERR104         IF ECS USED HAS BIT 24 SET 
          BX6    X6+X3
          SA6    A3 
          MX6    42 
          ZR     X1,PIR2           IF NO TRANSFER NAME GIVEN
 PIR1     BX7    X2-X1
          BX7    X6*X7
          ZR     X7,PIR2           IF NAME MATCHES
          SA2    A2+B1
          SB2    B2-B1
          NZ     B2,PIR1           IF MORE TRANSFER NAMES 
          EQ     ERR5              CANNOT FIND TRANSFER ENTRY POINT 
  
 PIR2     BX6    X2 
          SX2    X2 
          SA6    110B              ADD TRANSFER NAME INTO 54 TABLE
          SX6    B1 
          LX6    26 
          BX6    X6+X2
          LX6    30 
          SA6    LCSC              JUMP INSTRUCTION TO CAIN SEGMENT 
          EQ     PIR
 RIR      SPACE  4,8
**        RIR - READ INDEX RECORD.
* 
*         WE OPEN THE FILE CONTAING THE SEGMENTS.  IF THE FILE IS A 
*         SCOPE RANDOM FILE (BIT 47 WILL BE SET IN FET+1) THEN THE INDEX
*         WILL BE LOCATED AT *ENDRES*.  IF THE FILE IS NOT A RANDOM 
*         ACCESS FILE (BIT 59 IS NOT SET) OR IF NO REWIND WAS 
*         SPECIFIED THEN THE FILE WILL BE COPIED TO ZZZZZ31.  THE COPY
*         IS TERMINATED WHEN AN END-OF-FILE IS ENCOUNTERED.  NOTE 
*         THAT THE INDEX IS LESS THAN 512 WORDS IN LENGTH SO THAT 
*         NO MORE ACTION IS NEEDED.  AFTER THE FILE IS COPIED THE 
*         LAST RECORD IS READ AS THE INDEX. 
* 
*         ENTRY  (B1) = 1.
*                (NR) = REWIND INDICATOR FROM LOAD DIRECTIVE. 
* 
*         EXIT   INDEX OF SEGMENT FILE LOADED STARTING AT *ENDRES*. 
* 
*         CALLS  CIO=, SYS=.
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - NONE.
*                A - 1, 2, 3, 4, 6, 7.
  
  
 RIR      SUBR                     ENTRY/EXIT 
          OPEN   B,NR,RCL 
          MX6    1
          SA1    B+1
          LX6    48 
          BX6    X6+X1
          SA6    A1                SET RANDOM BIT 
          PL     X1,RIR3           IF RANDOM ACCESS FILE
 RIR1     SA1    B                 USE ZZZZZ31 AS SEGMENT FILE
          SA2    Z1 
          BX6    X1 
          LX7    X2 
          SA3    B+4
          SA6    A
          SA4    A+4
          MX6    42 
          SA7    A1 
          BX4    X6*X4             SAVE BITS 18-59
          BX6    -X6*X3 
          SA3    NR 
          SX3    X3-2 
          BX6    X6+X4
          SA6    A4                LIMIT
          RETURN A1                RETURN ZZZZZ31 
          ZR     X3,RIR2           IF NO REWIND SPECIFIED 
          REWIND A
 RIR2     SX6    ENDRES 
          SA6    A+2               IN 
          SA6    A6+B1             OUT
          SA6    B+2               IN 
          SA6    A6+B1             OUT
          READ   A,RCL
          SA1    A
          SX6    30B
          BX1    X6*X1
          IX6    X1-X6
          ZR     X6,RIR            IF EOF REACHED ON SEGMENT FILE 
          SX7    X1+4              14B OR 24B (WRITE OR WRITER) 
          SA1    A+2               IN 
          SX2    B
          LX6    X1 
          BX7    -X7               CALL CIO WITH AUTO-RECALL
          SA6    B+2
          RJ     CIO=              WRITE OR WRITER FOR COPY 
          EQ     RIR2              DO NEXT RECORD 
  
 RIR3     LX1    12 
          NG     X1,RIR            IF RANDOM INDEX ALREADY READ 
          SX2    A1-B1             FET ADDRESS
          SA3    NR 
          SX3    X3-2 
          ZR     X3,RIR1           IF NO REWIND COPY TO ZZZZZ31 
          REWIND X2 
          SKIPFF X2                SKIP TO EOF
 RIR4     BKSP   X2 
          SX6    ENDRES 
          SA6    B+2               IN 
          SA6    A6+B1             OUT
          READ   X2,RCL 
          SA1    X2 
          SX6    30B
          BX1    X6*X1
          IX1    X6-X1
          NZ     X1,RIR            IF INDEX READ
          BKSP   X2 
          EQ     RIR4              BKSP TWICE THEN READ AGAIN 
 RCT      SPACE  4,8
**        RCT - READ *CELTAB* TABLE.
* 
*         THIS ROUTINE READS THE *CELTAB* TABLE INTO SEGRES STARTING
*         AT *ENDRES*.  ABORT UNLESS EOR WAS DETECTED AFTER READING 
*         *CELTAB*.  SET THE LWA+1 (BITS 36-53 OF WORD 2 OF SEGMENT 0)
*         INTO RA.ORG AND RA.LWP.  IF BLANK COMMON IS USED
*         WE MUST NOT USE DYNAMIC FL MANAGEMENT SO
*         WE MEM TO THE LWA+1 USED AND CLEAR OUR AUTO REDUCE FLAG.
*         ABORT IF INSUFFICIENT CM WAS PROVIDED. IF WE ARE NOT IN REDUCE
*         MODE WE MEM TO THE NFL BECAUSE A0 MAY BE DIFFERENT THAN NFL.
*         IF THERE IS AN EXTRA WORD APPENDED TO *CELTAB* THEN BITS
*         0-17 CONTAIN THE ADDRESS OF *CMM.SDA* TO BE CALLED IF AN
*         ENTRY POINT STARTING WITH *CMM.* IS PRESENT.  BITS 18-35
*         CONTAIN THE ADDRESS OF *CMM.UNL* (OR ZERO) WHICH IS CALLED
*         IF *CMM.SUA* IS PRESENT.  BITS 36-53 CONTAIN EITHER THE 
*         ADDRESS OF *CMM.ALF* OR ZERO.  LOCATIONS WHERE THE CMM
*         CALLS ARE TO BE MADE ARE SET TO THE RESPECTIVE ADDRESSES. 
* 
*         ENTRY  (B1) = 1.
*                (A0) = CM FL.
*                (DA) = PRU OF *CELTAB* TABLE.
*                (MF) = MAX CM FL ALLOWED.
*                (NF) = NOMINAL FL. 
*                (MS) = 0 IF WE ARE NOT IN REDUCE MODE. 
* 
*         EXIT   (X0) = ECS FL. 
*                (B2) = DESIRED FWA OF *CELTAB*.
*                (B3) = ACTUAL FWA OF *CELTAB*. 
*                (B4) = LENGTH OF *CELTAB* TABLE. 
*                (CL) = LENGTH OF *CELTAB* TABLE. 
*                (MS) = 0 IF WE SHOULD NEVER REDUCE OUR FL. 
* 
*         CALLS  ERR, CIO=, RFL.
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                B - 2, 3, 4. 
*                A - 0, 1, 2, 3, 4, 5, 6, 7.
  
  
 RCT      SUBR                     ENTRY/EXIT 
          SA1    DA 
          BX6    X1 
          SA6    B+6               DISK ADDRESS OF CELTAB 
          SA1    B+1
          SX6    X1                BASE 
          SA6    A1+B1             IN 
          SA6    A6+B1             OUT
          READ   A1-B1,RCL
          SA1    X2 
          SX6    30B
          BX2    X6*X1
          IX2    X2-X6
          LX1    55 
          ZR     X2,ERR104         IF EOF NOT ANTICIPATED 
          PL     X1,ERR104         IF EOR WAS ANTICIPATED 
          SB3    ENDRES            PRESENT FWA OF CELTAB
          SA2    B+2
          SA1    B3+B1             WORD 2 OF ROOT SEGMENT 
          MX7    42 
          SB4    X2-ENDRES         LENGTH OF CELTAB 
          AX1    36 
          SX0    X1                (X0) = LWA+1 OF // 
                                   THIS WILL BECOME THE VALUE OF HHA
                                   UNLESS CMM AND // ARE BOTH PRESENT,
                                   AND CMM.ALF IS PRESENT (SEE BELOW) 
          SX6    B4 
          LX6    59-0 
          PL     X6,RCT8           IF EXTRA *CELTAB* WORD NOT PRESENT 
                                    (I.E., NO CMM)
          SB4    B4-B1             SET *CELTAB* LENGTH EVEN 
          MX2    1
          SA1    B3+B4             WORD WITH CMM ADDRESSES
          LX2    54-59             RJ 
          BX6    -X7*X1            *CMM.SDA* WHICH MUST BE PRESENT
          LX6    30 
          BX6    X6+X2
          AX1    18 
          SA6    CMM3              STORE CALL TO *CMM.SDA*
          BX6    -X7*X1            *CMM.UNL*
          ZR     X6,RCT2           IF *CMM.UNL* NOT PRESENT 
          LX6    30 
          BX6    X6+X2
          SA6    CMM1              STORE CALL TO *CMM.UNL*
 RCT2     AX1    18 
          SX6    X1                *CMM.ALF* OR ZERO
          SA6    AF                SET FLAG TO INDICATE NEW FORMAT
                                    WITH FWA // INCREASED BY 2 WORDS
          ZR     X6,RCT8           IF NOT THE NEW FORMAT
          SA1    CMM5              INSERT RJ CMM.ALF
          MX4    30                 IN LOWER HALF OF WORD 
          BX1    X4*X1
          LX2    -30               RJ TO LOWER
          BX1    X1+X2
          BX6    X1+X6             RJ CMM.ALF IN LOWER 30 BITS
          SA6    A1 
          SB2    B0                SCAN ALL *CELTAB* ENTRIES TO FIND
                                    THE HIGHEST SEGMENT LWA+1 
                                    (I.E., NOT INCLUDING //)
          MX4    0                 (X4) = INITIAL LWA+1 HIGHEST SEGMENT 
 RCT4     SA1    B3+B2             NEXT *CELTAB* ENTRY
          SA2    A1+B1
          SX1    X1                FWA OF SEGMENT 
          SX2    X2                LENGTH OF SEGMENT
          IX2    X1+X2             LWA+1 OF SEGMENT 
          IX3    X4-X2             COMPARE
          SB2    B2+2 
          PL     X3,RCT5
          BX4    X2                REPLACE WITH LARGER VALUE
 RCT5     LT     B2,B4,RCT4        IF MORE ENTRIES
          IX6    X0-X4             COMPARE LWA+1 // WITH LWA+1 OF 
                                    HIGHEST SEGMENT 
          BX0    X4                VALUE FOR HHA
          ZR     X6,RCT8           IF VALUES EQUAL, NO // PRESENT 
          SX6    X6-2              ADJUST FOR 2 WORDS ADDED 
                                    DURING GENERATION 
          SA6    BC                SAVE // LENGTH AS FLAG TO CALL 
                                    *CMM.ALF* 
 RCT8     SX6    B4                SET *CELTAB* LENGTH
          SA1    RA.LWP            SET LWA+1 IN RA+65B
          BX1    X7*X1
          SA6    CL 
          SA3    RA.ORG            RESET CM HHA IN RA.ORG 
          BX6    X1+X0
          SA6    A1 
          LX3    -18
          BX3    X7*X3
          BX7    X3+X0
          LX7    18 
          SA7    A3 
          SX6    X0                SET *HHA* FIELD
          SA6    RA.ORG+4 
          SA2    MS 
          SA1    B3 
          SA4    B3+B1
          SX1    X1                FWA OF ROOT
          SX4    X4                LENGTH OF ROOT 
          IX1    X1+X4             LWA+1 OF ROOT = MINFL
          AX7    18 
          MX4    42 
          BX7    X4*X7             LHHA 
          BX7    X7+X1             LMINFL, MINFL
          SA7    A3+B1             ADD LMINFL AND MINFL INTO 54 TABLE 
          SA3    MF 
          NZ     X2,RCT10          IF IN REDUCE MODE
          SA1    NF 
          SX3    X6 
          SX6    A0 
          LX6    30 
          SA6    MS                SET NON-ZERO FOR THIS CALL ONLY
          SX6    X1-10B 
          RJ     RFL               MEM TO NFL 
          SX6    B0 
          SA6    MS 
          SX6    X3 
          SA6    HA          SET HA TO HHA
          SA3    NF 
          SX2    B0 
 RCT10    SX1    X6+103B           CHECK FOR SUFFICIENT FL
          AX1    6
          LX1    6
          IX3    X3-X1
          SA1    B3+B1
          NG     X3,ERR2           IF INSUFFICIENT CM FL
          PL     X1,RCT12          IF BLANK COMMON NOT USED 
          SA1    RA.ORG+4          PUT HHA IN MINFL FIELD 
          BX7    X4*X7
          SX1    X1 
          BX7    X7+X1
          SA7    A7                RESET RA.ORG+1 
          ZR     X2,RCT12          IF NOT IN REDUCE MODE
          SX1    B3+B4             LWA+1 OF CELTAB
          IX2    X1-X6
          AX2    60 
          BX1    -X2*X1 
          BX6    X2*X6
          IX6    X1+X6             MAX(X6,LWA+1 OF CELTAB)
          RJ     RFL               REQUEST FL CHANGE
          SX6    B0 
          SA6    MS                CLEAN REDUCE MODE
 RCT12    SA1    FE 
          BX0    X1                ECS FL 
          SB2    BASE              DESIRED FWA OF CELTAB
          SA1    B3 
          SX2    B2+B4
          SX3    X1 
          IX3    X3-X2
          NG     X3,ERR101         IF FWA OF ROOT SEGMENT IS TOO LOW
          SA1    B3+B1             CHECK FOR C=1
          LX1    59-57
          PL     X1,RCT            IF C = 0 
          SX6    54B
          LX6    60-6 
          SX1    B1 
          BX6    X6+X1             ADD K=1 FOR ENTRY POINT
          SA6    RA.ORG            SAVE 54 TABLE HEADER 
          EQ     RCT
 WEI      SPACE  4,8
**        WEI - WRITE ECS IMAGE.
* 
*         THIS ROUTINE ADDS THE ECS BLOCKS TO ECS PROVIDING THERE 
*         WAS ENOUGH ECS ASSIGNED TO THIS JOB.  THE ECS IMAGE IS
*         READ FROM THE LOAD FILE STARTING AT PRU 2 AND WRITTEN TO
*         ECS STARTING AT RAX+0.
* 
*         ENTRY  (B1) = 1.
*                (A0) = CM FL.
*                (FE) = ECS FL. 
*                (LE) = LENGTH OF ECS IMAGE.
* 
*         CALLS  ERR, CIO=. 
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6, 7.
*                B - 2. 
*                A - 1, 2, 3, 6, 7. 
  
  
 WEI      SUBR                     ENTRY/EXIT 
          SX5    A0                SAVE A0
          SA3    LE                ECS BLOCK LENGTH 
          MX0    0
          MX4    -24                                                     LDR0167
          BX4    -X4*X3                                                  LDR0167
          ZR     X4,WEI            IF NO ECS WAS USED                    LDR0167
          SA2    FE 
          SX6    B1+B1             2 = FIRST PRU OF ECS RECORD
          IX2    X2-X4                                                   LDR0167
          NG     X2,ERR3           IF ECS FL TOO SHORT
          MI     X3,WEI            IF NO ECS IMAGE                       LDR0167
          SA6    B+6
          SX6    ENDRES+1001B 
          SA6    B+4               LIMIT
          SA1    B
          SA0    ENDRES 
          SX4    1000B
          SX6    A0                BASE 
          SA6    B+2               IN 
          SA6    A6+B1             OUT
 WEI1     READ   A1,RCL 
          SA1    B+2               IN 
          SX2    X1-ENDRES
          SB2    X2                LENGTH 
          ZR     B2,WEI2     IF ALL WORDS READ
 +        WE     B2 
 -        EQ     ERR102            ECS WRITE ABORT
          SA1    B
          SA2    A1+B1
          IX0    X0+X4             ADD 1000B
          SX6    X2                BASE 
          SA6    A2+B1             SET IN=FIRST 
          LX1    55 
          PL     X1,WEI1           IF NOT EOR 
 WEI2     BX6    X5 
          SA0    X5                RESTORE A0 
          SA6    B+4               LIMIT = FL 
          EQ     WEI
          TITLE  COMMON INITIALIZATION SUBROUTINES. 
 ERRORS   SPACE  4,8
**        ERR - ISSUE ERROR MESSAGE AND ABORT.
* 
*         ERRORS ARE ISSUED TO THE DAYFILE AND THE JOB ABORTED. 
*         FOR CONVIENENCE THE FOLLOWING CONVENTIONS ARE USED. 
*         ERROR NUMBERS 1 TO 49 ARE FATAL USER ERRORS.  THE ERRORS
*         NUMBERED 100 TO 199 ARE FATAL SYSTEM ERRORS WHICH SHOULD
*         NOT OCCUR UNLESS THE OPERATING SYSTEM HAS FAILED. 
* 
*         ENTRY  (X1) = FWA OF MESSAGE. 
* 
*         EXIT   ABORT JOB TO EXIT. 
* 
*         CALLS  SYS=.
  
  
 ERR      MESSAGE X1
          ABORT                    ABORT AND SKIP TO EXIT 
  
 ERR1     SX1    MSG1              MISSING EXECUTE
          EQ     ERR
  
 ERR2     SX1    MSG2              NOT ENOUGH CM
          EQ     ERR
  
 ERR3     SX1    MSG3              NOT ENOUGH ECS 
          EQ     ERR
  
 ERR5     SX1    MSG5              NO TRANSFER ADDRESS
          EQ     ERR
  
 ERR101   SX1    MSG101            SEGRES TOO LARGE 
          EQ     ERR
  
 ERR102   SX1    MSG102            ECS WRITE ABORT
          EQ     ERR
  
 ERR103   SX1    MSG103            MISSING LOAD 
          EQ     ERR
  
 ERR104   SX1    MSG104            BAD SEGRES BINARY
          EQ     ERR
  
          DIS    ,*CONTROL DATA  PROPRIETARY PRODUCT.*
          DIS    ,*COPYRIGHT CONTROL DATA CORP. 1976, 1977, 1978, 1979, 
,1980, 1981, 1982.* 
  
 ENDRES   END 
