*COMDECK BLOADC 
  
  
**        +++++++++++++++++++++++++++++++++++++ 
*         + INITIALIZATION AND CARD CRACKING. + 
*         +++++++++++++++++++++++++++++++++++++ 
* 
* 
*         + + + + + + + + + + + + 
*         + CARD IMAGE SCANNER. + 
*         + + + + + + + + + + + + 
* 
* 
*              THIS IS THE START OF THE COMMON DECK NAMED *BLOADC*
*         WHICH CONTAINS THE CODE NEEDED TO SCAN CARD IMAGES AND TAKE 
*         THE APPROPRIATE ACTION. 
* 
*              *BLOADC* IS USED IN FOUR PLACES IN THE BASIC LOADER, AND 
*         OF THESE, IT IS NECESSARY THAT IT TAKE ON THREE DIFFERENT 
*         FORMS.  THE SYMBOL *SCAN'* IS USED TO CONTROL THE CONDITIONAL 
*         CODE USED TO FORM IT AS FOLLOWS 
* 
*         1)   *SCAN'* = 0:  FORMS THE LOADER CONTROL CARD SCANNER FOR
*              *LOADER*.  THIS CONSISTS OF THE MAIN ROUTINE 
*              *LOADC*, THE CARD IMAGE SUBROUTINE *CARD*, AND ITS 
*              ASSOCIATED SUBROUTINES.
* 
*         2)   *SCAN'* = 1:  FORMS THE CARD IMAGE SCANNER FOR THE 
*              PROGRAM *LOADC*.  THIS CONSISTS ONLY OF THE SUBROUTINE 
*              *CARD* AND ITS ASSOCIATED SUBROUTINES.  IT HAS ONLY
*              THOSE CAPABILITIES NEEDED FOR THE FORMS ALLOWED ON 
*              OBJECT DIRECTIVES, AND IS ONLY USED IF THE CORRESPONDING 
*              CODE IN *LOADER* HAS BEEN OVERWRITTEN DUE TO CORE
*              REQUIREMENTS.
* 
*         3)   *SCAN'* = 2:  FORMS THE CARD IMAGE SCANNER FOR BOTH THE
*              PROGRAMS *LOADU* AND *LOADUC*.  IT IS VERY SIMILIAR TO 
*              THE CASE FOR *SCAN'* = 1, AND HAS ONLY THOSE CAPABILITIES
*              NEEDED FOR THE FORMS ALLOWED ON OBJECT DIRECTIVES. 
*              *LOADUC* IS AN OVERLAY USED BY *LOADU* IF ITS CODE IS
*              NEEDED AFTER IT HAS BEEN OVERWRITTEN DUE TO CORE 
*              REQUIREMENTS.
* 
*              THE ROUTINES IN *BLOADC* ARE PLACED SUCH THAT THE ONES 
*         WHICH APPEAR REGARDLESS OF THE VALUE OF *SCAN'* COME FIRST. 
*         ALSO NOTE THAT DUE TO THE MANNER IN WHICH THE SUBROUTINE
*         *CARD* IS REFERENCED, IT IS ESSENTIAL THAT THE CODE UP TO 
*         THE SYMBOL *CARD* BE OF IDENTICAL LENGTH IN ALL CASES.
* 
* 
*         ******* REGARDING THE DISALLOWING OF OBJECT DIRECTIVES *******
* 
*              IT HAS BEEN DECIDED, IN ORDER TO MAINTAIN 7000 
*         COMPATIBILITY, TO NOT ALLOW OBJECT DIRECTIVES, EXCEPT FOR 
*         *OVERLAY* AND *SEGLOAD*.  THUS THE ONLY ACCEPTABLE WAY
*         WHICH THE LOADER MAY OBTAIN SUCH INFORMATION FROM LOAD
*         FILES IS FROM *LDSET* (70) TABLES.
*              A HOOK IS AVAILABLE SO AS TO ALLOW OBJECT DIRECTIVES.
*         IN ORDER TO MAKE USE OF IT, CODE MUST BE ADDED TO PROVIDE A 
*         MEANS TO SET THE FLAG DEFINED BY THE LOCATION /READ/DIROK.
*         IF THIS IS NON-ZERO, OBJECT DIRECTIVES ARE ALLOWED.  FOR
*         EXAMPLE, THIS COULD BE DONE BY A SPECIAL *LDSET* OPTION.
* 
*         IF UNDER KRONOS/NOS SEE THE ADDITIONAL COMMENTS IN THE
*         LOAD INPUT SECTION CONCERNING *COS* BINARY PROCESSING.
*         **************************************************************
  
          RELOC  ON 
 GNE      SPACE  4,8
**        GNE - GET NEXT ELEMENT. 
* 
*              THIS ROUTINE IS USED BY THE CARD IMAGE SCANNER ROUTINES. 
*         IT FETCHES CHARACTERS FROM THE CURRENT CARD IMAGE UNTIL EITHER
*         A SEPARATOR OR TERMINATOR IS FOUND, OR UNTIL SEVEN CHARACTERS 
*         HAVE BEEN PUT IN A CHARACTER STRING WITH THE NEXT NOT BEING 
*         A SEPARATOR OR TERMINATOR.
* 
*              IF END-OF-CARD IS INDICATED UPON ENTRY TO *GNE*, THEN
*         EITHER *ACE* OR *READCI* IS CALLED TO FETCH THE NEXT CARD 
*         IMAGE.  END-OF-CARD WITHIN AN ELEMENT IS ILLEGAL, AND RESULTS 
*         IN A FATAL ERROR. 
* 
*         ENTRY  LOCATIONS *CCWA*, *CFWA*, *CCHAR*, *CLIT*, *CFIRST*, 
*                AND *CSAVE* ARE SET UP.
*         EXIT   (X5) = VFD 42/0LSTRING,18/CODE 
*                       *STRING* = CHAR STRING OF 0-7 CHARS 
*                       *CODE* DESCRIBES CHAR AFTER THE STRING -
*                                  00 IF STRING > 7 CHARS 
*                                  01 IF ,
*                                  02 IF =
*                                  03 IF /
*                                  04 IF (
*                                  05 IF +
*                                  06 IF -
*                                  07 IF BLANK
*                                  10 IF ;
*                                  17 IF . OR ) 
*                                  16 IF ANY OTHER
*                (B4) = NO. OF CHARACTERS IN ELEMENT. 
*                (B6) =  0 IF NO $ DELIMITERS ENCOUNTERED IN ELEMENT. 
*                       NZ IF $ DELIMITERS WERE ENCOUNTERED.
*                (B7) =  0 IF LAST CHAR AFTER STRING WAS =
*                        1 IF LAST CHAR AFTER STRING WAS , OR ( 
*                        2 IF LAST CHAR AFTER STRING WAS . OR ) 
*                       -1 IF LAST CHAR AFTER STRING WAS /
*                       -2 OTHERWISE
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*         CALLS  GNC, SNC, ACE, READCI. 
  
  
 GNE      PS                 ENTRY/EXIT 
 GNE0     SA3    CCWA 
          SA2    A3+B1       FWA OF CARD IMAGE (*CFWA*) 
          MX6    0
          PL     X3,GNE1     IF NOT AT END-OF-CARD
          BX7    X2 
          SA7    A3          RESET WORD POINTER (*CCWA*)
          SA6    A2+B1       RESET CHARACTER COUNT (*CCHAR*)
 IC       IFCARD
          SA1    LASTCARD 
          NZ     X1,GNE0A    IF PROCESSING A DIRECTIVE
          SA2    CEXEC
          MX7    0
          SA7    A2 
          NZ     X2,/LOADC/EXECUTE6  IF *EXECUTE* OR PROGRAM CALL CARD
          RJ     /LOADC/ACE  FETCH NEXT CONTROL CARD
          EQ     GNE1        GO GET ELEMENT 
  
 GNE0A    BSS    0
 IC       ENDIF 
          READO  L
          SA6    /READ/CDIMAGE     READ 1ST WORD OF DIRECTIVE 
          SB6    A6+B1
          NZ     X1,CIERR    IF EOR BEFORE 1ST WORD, ERROR
          RJ     READCI      READ CARD IMAGE
 GNE1     SB7    -B1         (B7) = -2
          SA1    CSAVE
          MX5    0           INITIALIZE CHAR STRING 
          SB7    B7-B1
          SB4    B0          (B4) = NO. OF CHARS IN STRING
          SB6    B0          (B6) = 0 FOR NO $ DELIMITERS 
          ZR     X1,GNE2     IF NO SAVED CHAR 
          MX7    0           CLEAR SAVE FLAG
          SA7    A1 
          SA2    A1+B1       (X6) = PREVIOUS CHAR 
          BX6    X2 
          EQ     GNE32
  
 CIERR    SA1    LASTCARD 
          NZ     X1,GNERR    IF A DIRECTIVE 
          SX6    B1          SET FOR SYSTEM ABORT 
          SA6    ABTTYPE
          ERROR  CAT,GNENT
  
**
* 
*              NOTE THAT THE LOCATION *GNERR* IS THE ENTRY ADDRESS
*         TO ISSUE THE ERROR FOR MOST ERROR CONDITIONS RELATED
*         TO LOAD INPUT ERRORS.  THE RESULTING ERROR MESSAGE SHOWS
*         THE NUMBER OF WORDS SPECIFIED BY THE SYMBOL *DATA2OUT*
*         SPECIFIED IN *LDRCOM*.  THE FIRST WORDS TO BE OUTPUT ARE
*         THOSE IN THE AREA *CDIMAGE*.  THE NUMBER OF WORDS THERE IS
*         SPECIFIED BY THE LOCATION *LTHIMAGE*.  THE REMAINING WORDS
*         ARE YET TO BE READ. 
  
 GNERR    MX0    0           INITIALIZE WORD COUNT
          ERROR  301,X7      ---- BAD LOADER INPUT OR DIR. SYNTAX ERROR 
          SA5    /READ/CDIMAGE-1   INITIALIZE FETCH 
          SA0    B2          SAVE *TERR* ORDINAL OF 2ND WORD
 GNERR1   SA1    /READ/LTHIMAGE    LENGTH OF DATA IN *CDIMAGE*
          R=     X2,X0-DATA2OUT 
          BX7    X0          (X7) = WORD COUNT FOR STORE
          ZR     X2,GNERR5   IF REQUIRED NO. WORDS ALL DONE 
          SA5    A5+B1       NEXT WORD FROM *CDIMAGE* 
          IX3    X0-X1
          PL     X3,GNERR3   IF REALLY NO MORE IN *CDIMAGE* 
          BX1    X5 
 GNERR2   ADDWRD TERR,X1     NEXT WORD TO *TERR*
          SX0    X0+B1       ADVANCE WORD COUNT 
          EQ     GNERR1      LOOP 
  
 GNERR3   READO  L           NEXT WORD FROM INPUT 
          NZ     X1,GNERR4   IF AT EOR
          BX1    X6 
          EQ     GNERR2 
  
 GNERR4   MX7    1           SET EOR FLAG 
          BX7    X7+X0
 GNERR5   SA3    TERR        STORE EOR FLAG, LAST TABLE CODE, 
          SB2    A0          AND WORD COUNT IN WORD 2 OF *TERR* 
          SA1    LT          ENTRY
          MX2    30 
          BX1    X2*X1
          IX7    X7+X1
          SA7    X3+B2
          EQ     ABEND       GO TERMINATE LOAD
  
 GNE2     RJ     GNC         GET NEXT CHARACTER 
 GNE4     SA1    CLIT 
          NZ     X1,GNE38    IF IN LITERAL MODE (WITHIN $S) 
          NZ     X6,GNE8     CHECK FOR COLON
 GNE6     R=     X7,16B      *COLON* SEPARATOR FOUND
          EQ     GNE36
  
 GNE8     R=     X1,X6-1R;
          NZ     X1,GNE10 
          R=     X7,10B      ; SEPARATOR FOUND
          EQ     GNE36
  
 GNE10    R=     X1,X1+1R;-1R#
          PL     X1,GNE6     IF ANY CHAR WHICH  60B @ CODE @ 76B
          SX1    X1+B1       X1+1R#-1R. 
          NZ     X1,GNE14    IF NOT . 
 GNE12    R=     X7,17B      . OR ) TERMINATOR FOUND
          SB7    B1+B1
          EQ     GNE36
  
 GNE14    SX1    X1+B1       X1+1R.-1R, 
          NZ     X1,GNE18 
 GNE16    SX7    B1          , SEPARATOR FOUND
          SB7    B1          FLAGS ARE SAME FOR , AND BLANK AFTER 
          EQ     GNE36       VERB 
  
 GNE18    SX1    X1+B1       X1+1R,-1R
 IS       IFSCOPE 
          NZ     X1,GNE20    IF NOT BLANK 
          SA2    CFIRST 
          NZ     X2,GNE42    IGNORE BLANK IF NOT 1ST CALL FOR CARD
          ZR     X5,GNE42    IGNORE BLANKS BEFORE VERB BEGINS 
          SA2    CCWA 
          NG     X2,GNE16    IF END-OF-CARD, GO INDICATE SEPARATOR
          RJ     SNC         LOOK AT NEXT CHAR, TO CHECK FOR BLANK
          LD     X6,X6-1R 
          ZR     X6,GNE2     IF IT IS A BLANK, SKIP IT
          EQ     GNE16       TREAT LAST BLANK(S) AS SEPARATOR 
  
 IS       ELSE
          ZR     X1,GNE42    IF BLANK, IGNORE 
 IS       ENDIF 
 GNE20    SX1    X1+B1       X1+1R -1R= 
          SX7    B1+B1
          NZ     X1,GNE22 
          SB7    B0          = SEPARATOR FOUND
          EQ     GNE36
  
 GNE22    SX1    X1+B1       X1+1R=-1R$ 
          NZ     X1,GNE24 
          SB6    B1          (B6) = NZ TO INDICATE $ DELIMITERS 
          SA7    CLIT        $ ENCOUNTERED, SET LITERAL FLAG
          EQ     GNE2        GO GET NEXT CHAR 
  
 GNE24    SX1    X1+B1       X1+1R$-1R) 
          ZR     X1,GNE12    IF ) 
          SX1    X1+B1       X1+1R)-1R( 
          NZ     X1,GNE26 
          IX7    X7+X7       ( SEPARATOR FOUND, SET X7 = 4
          SB7    B1 
          EQ     GNE36
  
 GNE26    SX1    X1+B1       X1+1R(-1R/ 
          NZ     X1,GNE28 
          SB7    -B1         / SEPARATOR FOUNE
          R=     X7,3 
          EQ     GNE36
  
 GNE28    SX1    X1+B1       X1+1R/-1R* 
          ZR     X1,GNE32    ON A CONTROL CARD,* IS CONSIDERED ALPHANUM.
          SX1    X1+B1       X1+1R*-1R- 
          NZ     X1,GNE30 
          R=     X7,6        - SEPARATOR FOUND
          EQ     GNE36
  
 GNE30    SX1    X1+B1       X1+1R--1R+ 
          NZ     X1,GNE32 
          R=     X7,5        + SEPARATOR FOUND
          EQ     GNE36
  
*         CHARACTER IS ALPHANUMERIC, AS ALL OTHER POSSIBILITIES HAVE
*         BEEN CHECKED. 
  
 GNE32    R=     X2,B4-7
          SX7    B1 
          ZR     X2,GNE34    IF STRING LONGER THAN 7 CHARS
          SB4    B4+B1       ADVANCE CHARACTER COUNT
          LX5    6           ADD CHARACTER TO STRING
          BX5    X6+X5
          EQ     GNE42       GO GET NEXT CHARACTER
  
 GNE34    SA7    CSAVE       SET CHAR SAVED FLAG
          SA6    A7+B1       SAVE THE CHARACTER 
          MX7    0           FLAG FOR CONTINUATION
  
*         LEFT JUSTIFY THE CHAR STRING IN X5 AND ADD IN THE RA+2 CODE,
*         WHICH IS CURRENTLY IN X7. 
  
 GNE36    R=     B2,10       (B2) = 6 * (10-NO. OF CHARS IN STRING
          SB2    B2-B4
          SB2    B2+B2
          SB3    B2 
          SB2    B2+B2
          SB2    B2+B3
          LX5    X5,B2       LEFT-JUSTIFY STRING
          BX5    X5+X7       ADD IN CODE
          SX7    B1          SET TO INDICATE NOT THE FIRST CALL 
          SA7    CFIRST      FOR THIS CARD
          EQ     GNE         EXIT 
  
*         PROCESSING OF CHARACTERS WHEN IN LITERAL MODE.
  
 GNE38    SA2    CCWA 
          R=     X1,X6-1R$
          NG     X2,CIERR    IF LITERAL SPANS CARDS, ERROR
          NZ     X1,GNE32    IF NOT $, ADD TO CHAR STRING 
          BX4    X6 
          RJ     SNC         LOOK AHEAD TO NEXT CHAR
          IX4    X4-X6
          MX7    0
          ZR     X4,GNE40    IF $, TREAT CONSECUTIVE $S AS ONE
          SA7    CLIT        IF NOT $, FLAG END OF LITERAL MODE 
          EQ     GNE2 
  
 GNE40    RJ     GNC         FETCH THE $
          EQ     GNE32       GO PUT $ IN STRING 
  
 GNE42    SA2    CCWA 
          ZR     X5,GNE0     IF BLANKS BETWEEN ELEMENTS 
          NG     X2,CIERR    IF END-OF-CARD WITHIN ELEMENT, ERROR 
          EQ     GNE2        GET NEXT CHARACTER 
  
          IFCARD 2
 CEXEC    CON    0           NZ IF GETTING PARAMS FROM *EXECUTE*
                                    OR PROGRAM CALL CARD
          SPACE  2
 CCWA     BSS    0           CURRENT WORD BEING PROCESSED IN CARD 
 CFWA     EQU    CCWA+1      FWA OF CURRENT CARD IMAGE
 CCHAR    EQU    CFWA+1      NO. CHARS PROCESSED IN CURRENT WORD
 CLIT     EQU    CCHAR+1     NZ IF FETCHING WITHIN A LITERAL
 CFIRST   EQU    CLIT+1      ZERO IF 1ST CALL TO GNE THIS CARD
 CSAVE    EQU    CFIRST+1    IF NZ, 2ND WORD IS CHAR PICKED UP
                                    ON THE LAST CALL TO *GNE*.
          BSSZ   CSAVE-CCWA+2 
 CSVCHAR  DATA   0
 GNENT    DATA   C* INCOMPLETE PARAM ON CONTROL CARD* 
 GNC      SPACE  4,8
**        GNC - GET NEXT CHARACTER. 
* 
*              THIS ROUTINE IS USED BY *GNE* TO FETCH THE NEXT
*         CHARACTER FROM A CARD IMAGE.
* 
*         ENTRY  *CCHAR*, *CFWA*, AND *CCWA* ARE SET TO CURRENT VALUES. 
*         EXIT   (X6) = NEXT CHARACTER FROM CARD IMAGE. 
*                *CCHAR* AND *CCWA* ARE UPDATED.
*                *CCWA* = NG IF CHAR IN X6 IS LAST NON-BLANK ON CARD. 
*         USES   X - 1, 2, 3, 7.
*                B - NONE.
*                A - 3, 7.
*         CALLS  SNC. 
  
  
 GNC      PS                 ENTRY/EXIT 
          RJ     SNC         PICK UP NEXT CHARACTER 
          SX7    X1+B1       ADVANCE CHAR COUNT 
          SA7    A1          (A1) AND (X1) AS LEFT BY *SNC* 
          R=     X7,X7-10 
          ZR     X7,GNC3     IF LAST CHAR IN WORD 
          SX7    X7+B1
          MX1    6           MASK FOR CHECK ON REMAINING CHARS
          ZR     X7,GNC4     IF ONLY ONE CHAR LEFT IN WORD
 GNC1     AX1    X1,B2       FORM MASK
          BX3    -X1*X3      (X3) AS LEFT BY *SNC* OR BELOW 
          NZ     X3,GNC      IF SOMETHING ELSE LEFT, EXIT 
 GNC2     MX7    1           SET *CCWA* NG TO INDICATE AT 
          SA7    A2          END OF CARD
          EQ     GNC         EXIT 
  
 GNC3     SA7    A1          RESET CHAR COUNT (*CCHAR*) 
          SX7    X2+B1       ADVANCE ADDRESS (*CCWA*) 
          SA7    A2 
          SA3    A1-B1       *CFWA* 
          IX2    X7-X3       *CCWA* - *CFWA*
          SA3    X7          (X3) = NEXT WORD OF CARD 
          R=     X2,X2-8
          ZR     X2,GNC2     IF COLUMN 80 JUST PICKED UP
          MX1    0           SET MASK TO CHECK ENTIRE WORD
          EQ     GNC1        GO CHECK IF NEXT WORD IS ALL ZERO
          SPACE 
 GNC4     SA6    CSVCHAR     SAVE CURRENT CHARACTER 
          RJ     SNC         GET NEXT CHAR
          BX7    X6 
          SA3    CSVCHAR     RESTORE CURRENT CHARACTER TO X6
          BX6    X3 
          NZ     X7,GNC      EXIT IF NEXT CHAR IS NOT A ZERO
          SA3    X2+B1       GET NEXT WORD
          ZR     X3,GNC2     IF ZERO WORD FOUND, GO END CARD
          EQ     GNC         EXIT IF NOT END-OF-CARD
          SPACE  4
**        SNC - SEE NEXT CHARACTER. 
* 
*              THIS ROUTINE IS USED BY *GNE* AND *GNC* TO FETCH THE 
*         NEXT CHARACTER FROM A CARD IMAGE, BUT NOT ADVANCE THE 
*         CHARACTER POINTERS.  THEREFORE, THE NEXT TIME EITHER *GNC*
*         OR *SNC* IS CALLED, THE SAME CHARACTER WILL BE FETCHED. 
* 
*         ENTRY  *CCHAR* AND *CCWA* ARE SET TO CURRENT VALUES.
*         EXIT   (X1) = VALUE IN CCHAR. 
*                (X2) = VALUE IN CCWA.
*                (X3) = CURRENT WORD OF CARD IMAGE. 
*                (X6) = CURRENT CHARACTER IN CARD IMAGE.
*                (B2) = 6*(CCHAR).
*                (A1) = ADDRESS OF CCHAR. 
*                (A2) = ADDRESS OF CCWA.
*         USES   X - 1, 2, 3, 6, 7. 
*                B - 2, 3.
*                A - 1, 2, 3. 
*         CALLS  NONE.
  
  
 SNC      PS                 ENTRY/EXIT 
          SA1    CCHAR       (X3) = CURRENT WORD OF CARD IMAGE
          SA2    CCWA 
          SB2    X1          (B2) = (CURRENT CHARACTER) * 6 
          SA3    X2 
          SB2    B2+B2
          MX6    -6 
          SB3    B2 
          SB2    B2+B2
          SB2    B2+B3
          LX7    X3,B2       SHIFT CHARACTER TO LOWER 6 BITS
          LX7    6
          BX6    -X6*X7      ISOLATE CHARACTER
          EQ     SNC         EXIT 
 GOP      SPACE  4
**        GOP - GET OCTAL PARAMETER.
* 
*         ENTRY  AS FOR GNC 
*         EXIT   (X6) = 1ST CHAR NOT PROCESSED, OR NG IF END OF CARD
*                (X7) = CONVERTED PARAMETER 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 5. 
*                A - 1, 2, 3, 7.
*         CALLS  GNC. 
  
 GOPX     BX7    X4 
 GOP      EQ     *+400000B   ENTRY/EXIT 
          SX4    0           BUILD INTO X4
          R=     B5,20
 GOP1     SA1    CCWA 
          MI     X1,GOP2     IF END OF CARD 
          RJ     GNC         GET CHARACTER
          R=     X1,X6-55B
          ZR     X1,GOP1     IF BLANK, IGNORE 
          ZR     B5,GOPX     IF 20 CHARS ALREADY PROCESSED, EXIT
          R=     X1,X6-1R0
          MI     X1,GOPX     IF : OR ALPHABETIC, EXIT 
          R=     X2,X6-1R8
          PL     X2,GOPX     IF SPECIAL CHARACTER, EXIT 
          LX4    3
          BX4    X4+X1       ADD IN DIGIT 
          SB5    B5-B1
          EQ     GOP1        LOOP 
  
 GOP2     MX6    1           INDICATE END OF CARD 
          EQ     GOPX        EXIT 
 CDB      SPACE  4,10 
**        CDB - CONVERTS DECIMAL DISPLAY CODE TO BINARY.
* 
*         ENTRY  X5= PARAMETER AS RETURNED FROM *GNE*.
*         EXIT   X2=BINARY EQUIVALENT, MINUS IF ERROR.
*         USES   X - 0,2,3,4,5. 
*                B - 2. 
*                A - NONE.
* 
*         CALLS  NONE.
  
  
 CDB      PS     0           ENTRY/EXIT 
          MX0    42 
          SB2    B1+B1       (B2) = 2 
          BX4    X0*X5       EXTRACT UPPER SEVEN CHARACTERS 
          SX2    B0          CLEAR ACCUMULATOR
 CDB1     MX0    -6 
          LX4    6           POSITION NEXT CHARACTER
          BX5    -X0*X4 
          ZR     X5,CDB      IF NO MORE DIGITS
          R=     X3,X5-1R9-1
          PL     X3,CDB2     IF NOT ALPHANUMERIC
          R=     X3,X5-1R0   CONVERT NEW DIGIT TO BINARY
          MI     X3,CDB2     IF NOT A NUMBER
          LX5    X2,B2       MULTIPLY BY FOUR 
          IX2    X2+X5       ADD IN NUMBER
          LX2    1           MULTIPLY BY TWO
          IX2    X2+X3       ADD IN NEW DIGIT 
          EQ     CDB1        LOOP FOR NEXT DIGIT
  
 CDB2     SX2    -B1
          EQ     CDB         RETURN 
 READCI   SPACE  4,8
**        READCI - READ CARD IMAGE. 
* 
*              THIS ROUTINE READS THE NEXT CARD IMAGE FROM THE LOAD 
*         FILE. 
* 
*         ENTRY  THE FIRST WORD OF THE IMAGE HAS ALREADY BEEN READ INTO 
*                   THE LOCATION /READ/CDIMAGE. 
*                (X1) = STATUS OF THE ABOVE READ FROM *RDW=*. 
*                (B6) = /READ/CDIMAGE+1.
*         EXIT   ENTIRE IMAGE IS IN AREA BEGINNING AT /READ/CDIMAGE.
*                /READ/LTHIMAGE IS SET TO THE LENGTH OF THE IMAGE.
*                ERROR EXIT TO *CIERR* IS TAKEN IF IMAGE IS TOO LONG. 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*         CALLS  RDW=.
  
  
 READCI   PS                 ENTRY/EXIT 
          MX6    0           INITIALIZE LENGTH
          SA6    /READ/LTHIMAGE 
 READCI1  SA2    /READ/LTHIMAGE    ADVANCE LENGTH 
          NZ     X1,CIERR    IF EOR BEFORE ZERO BYTE, ERROR 
          SX6    X2+B1
          MX3    -12
          SA4    B6-B1       CHECK FOR ZERO BYTE ON LAST WORD READ
          SA6    A2 
          BX3    -X3*X4 
          ZR     X3,READCI   EXIT ON ZERO BYTE
          R=     X6,X6-13 
          ZR     X6,CIERR    IF MAX AMOUNT READ WITHOUT ZERO BYTE 
          READO  L           READ NEXT WORD 
          SA6    B6 
          SB6    B6+B1
          EQ     READCI1     LOOP 
 CARD     SPACE  4,8
**        CARD - PROCESS CARD IMAGE.
* 
*              THIS ROUTINE PROCESSES EXACTLY ONE CARD IMAGE.  IF IT IS 
*         THE NAME OF A LOADER REQUEST, THE APPROPRIATE ENTRY IS
*         PLACED IN THE APPROPRIATE REQUEST TABLE.  FOR OTHER TYPES OF
*         CARDS (*OVERLAY*, *MAP*, *REDUCE*, ETC.), THE REQUIRED
*         ACTION IS TAKEN.
* 
*         ENTRY  (X6) = FWA OF CARD IMAGE.
*                (A0) = POINTER TO APPROPRIATE REQUEST TABLE. 
*         EXIT   CARD IS PROCESSED. 
*         USES   ALL REGISTERS EXCEPT A0 AND B1.
*         CALLS  GNE, MOVEIN, SYS=, /MISC/LFNCK, /MISC/EPNCK. 
* 
* 
*              THE PROCEDURE IS AS FOLLOWS:                                    .
* 
*         1)   THE SUBROUTINE *GNE* IS CALLED IN ORDER TO FETCH THE 
*              KEYWORD (VERB) OF THE CARD.  A TABLE OF POSSIBLE 
*              KEYWORDS IS SEARCHED.
* 
  
  
 CARD     PS                 ENTRY/EXIT 
          SA1    CARDCT      ADVANCE CARD COUNT 
          SX7    X1+B1
          SA7    A1 
          SA6    CCWA        SAVE FWA OF CARD IMAGE FOR *GNE* 
          SA6    A6+B1
          MX6    0
          SA6    A6+B1       CLEAR CHARS USED IN CURRENT WORD 
          SA6    A6+B1       CLEAR LITERAL FLAG 
          SA6    A6+B1       CLEAR 1ST-TIME FLAG
          SA6    A6+B1       CLEAR CHAR SAVED FLAG
 SCAN     IFEQ   SCAN',0
 IN       IFNOS 
          RJ     SNC         SEE NEXT CHAR (CHECK 1ST CHAR FOR *) 
          SX6    X6-1R* 
          ZR     X6,CARD     SKIP STATEMENT IF COLUMN ONE = * 
 CARD0T   RJ     SNC         SEE NEXT CHARACTER 
          SB7    X6-1R
          ZR     B7,CARD0U   IF A BLANK 
          SX1    B7+1R -1R$ 
          ZR     X1,CARD0U   IF A $ 
          SX1    B7+1R -1R/ 
          ZR     X1,CARD0U   IF */* 
          SX1    X6-1R0 
          MI     X1,CARD0V   IF NOT KCL LABEL 
          RJ     GNE         SKIP KCL LABEL 
          EQ     CARD0T      SKIP MORE * * OR */* OR *$*
  
 CARD0U   RJ     GNC         GET NEXT CHARACTER AND SKIP IT 
          ZR     B7,CARD0T   LOOP IF CHARACTER WAS A BLANK
 CARD0V   BSS    0
 IN       ENDIF 
 SCAN     ENDIF 
          SA1    A0+B1       SAVE CURRENT REQUEST TABLE ORDINAL 
          BX7    X1 
          SA7    KEY1 
          SA7    KEY2 
          RJ     GNE         GET VERB FROM CARD IMAGE 
 SCAN     IFEQ   SCAN',0
          IFNOS  2
          SX6    B6          SET DELIMITER FLAG IF ANY DELIMITERS WERE
          SA6    VHD          PRESENT 
          SA1    //LASTCARD 
          NZ     X1,CARD0A   IF LOAD SEQUENCE ALREADY TERMINATED
          RJ     CLF         CHECK IF VERB IS NAME OF LOCAL FILE
 CARD0A   BSS    0
 SCAN     ENDIF 
          MX6    -6          INITIALIZE FOR TABLE SEARCH
          MX0    42 
          SB6    B0 
          MX4    -9 
 SCAN     IFEQ   SCAN',0
          SA1    //LASTCARD 
          NZ     X1,CARD0B   IF LOAD SEQUENCE ALREADY TERMINATED
          SA1    //LOCFILE   CHECK LOCAL FILE FLAG
          NZ     X1,CARD3    IF LOCAL FILE FOUND
 CARD0B   BSS    0
 SCAN     ENDIF 
 CARD1    SA1    B6+TABLE    NEXT TABLE ENTRY 
          BX2    X1-X5       COMPARE NAMES
          SB6    B6+B1
          BX3    X2*X0
          ZR     X1,CARD3    IF NAME NOT IN TABLE 
          BX7    -X4*X1      (B6) = ADDRESS OFFSET FOR PROCESSOR
          NZ     X3,CARD1    IF MISS, LOOP
  
**        2)   IF THE NAME IS FOUND IN THE TABLE, THE APPROPRIATE 
*              ROUTINE IS ENTERED TO PROCESS THE CARD.  THESE ROUTINES
*              ARE LISTED BELOW.
* 
  
          LX1    48 
          BX6    -X6*X1      (X6) = REQUEST HEADER
          SB6    X7 
          LX6    48 
          PL     X1,CARD2    IF NOT THE NAME OF A REQUEST 
          ADDWRD A0,X6       PLACE TABLE HEADER IN REQUEST TABLE
 CARD2    JP     B6+BOTTOM   GO TO APPROPRIATE PROCESSOR
  
**        3)   UNLESS THIS IS THE COPY OF *CARD* WHICH PROCESSES LOADER 
*              CONTROL CARDS FOR *LOADER*, WE HAVE AN ERROR, SINCE
*              A PROGRAM CALL CARD IS NOT LEGAL ON A DIRECTIVE.  IF 
*              PROCESSING CONTROL CARDS, THE CARD IS ASSUMED TO BE
*              A PROGRAM CALL CARD.  IT IS NOW NECESSARY TO KNOW WHETHER
*              OR NOT THE KEYWORD IS THAT OF A LOCAL FILE.  IF THIS 
*              INFORMATION WAS NOT PASSED AT INITIALIZATION, IT IS NOW
*              OBTAINED BY CALLING THE PP PROGRAM *LDL* IF SCOPE OR 
*              BY CALLING THE PP PROGRAM *LFM* (STATUS 12) IF NOS. THEN 
*              INTERNAL LOADER REQUESTS ARE FORMED AS FOLLOWS 
* 
*              A)   KEYWORD IS AN LFN 
* 
*                   LOAD(KEYWORD/R)    EXCEPTION:  LOAD(INPUT/NR) 
*                   EXECUTE(, ANY PARAMETERS) 
* 
*              B)   KEYWORD IS NOT AN LFN 
* 
*                   LIBLOAD(,KEYWORD) 
*                   EXECUTE(KEYWORD, ANY PARAMETERS)
* 
  
 SCAN     IFNE   SCAN',0
 CARD3    EQ     CARDERR     DIRECTIVE NOT RECOGNIZED - ERROR 
  
 SCAN     ENDIF 
 SCAN     IFEQ   SCAN',0
 CARD3    SA1    REQTYPE     CHECK TYPE OF REQUEST BEING GENERATED
          SX6    B1 
          AX1    1           UNRECOGNIZED KEYWORD ALLOWED ONLY ON 
          NZ     X1,CARDERR  CONTROL CARD FOR RELOCATABLE LOAD
          SA6    EX          SET EXECUTE FLAG 
          BX7    X0*X5       STORE NAME IN PARAM WORD FOR *LDL* 
          SA3    LDFILE      ADD FILE NAME TO *FNT* ADDRESS 
          BX6    X3+X7
          SA6    A3 
          R=     X2,6 
          BX7    X2+X7
          SA1    PCTYPE 
          SA2    CARDCT 
          NG     X1,CARD3A   IF *1AJ* DID NOT PASS INFO 
          NZ     X2,CARD3A   IF NOT 1ST CONTROL CARD
          MX3    -12         USE FILE VS. LIBRARY INFO PASSED 
          BX0    -X3*X1      BY *1AJ* 
          EQ     CARD3B 
  
 CARD3A   SX0    B1          FILE NOT FOUND CODE
          SA1    //LOCFILE   IF =0 THEN LOCAL FILE NOT FOUND
          ZR     X1,CARD3B   IF LOCAL FILE NOT FOUND
          SX0    B0          FILE FOUND CODE
*         EQ     CARD3B 
 CARD3B   R=     X1,CLOAD 
          LX1    48 
          ZR     X0,CARD4    IF TO FORM *LOAD* REQUEST
          R=     X1,CLIBLOAD FORM *LIBLOAD* REQUEST 
          LX1    48 
 CARD4    ADDWRD A0,X1       PLACE REQUEST HEADER IN REQUEST TABLE
          NZ     X0,CARD6    IF *LIBLOAD* 
          SA2    =0LINPUT    FORM *LOAD* REQUEST
          MX0    42 
          BX3    X5-X2
          SX4    B1+B1       FLAG FOR NO REWIND 
          BX3    X0*X3
          BX1    X5*X0
          ZR     X3,CARD5    IF FILE NAME IS *INPUT*
          SX4    X4+B1       FLAG FOR REWIND
 CARD5    BX1    X1+X4       ADD REWIND INDICATOR 
          RJ     MOVEIN      PLACE LFN IN *LOAD* REQUEST
          R=     X1,CEXECUTE FORM *EXECUTE* HEADER
          LX1    48 
          ADDWRD A0,X1
          MX1    0           USE EMPTY ENTRY POINT NAME 
          EQ     CARD7
  
 CARD6    MX1    0           FORM *LIBLOAD* REQUEST 
          RJ     MOVEIN      ENTER EMPTY LIBRARY NAME 
          MX0    42          ENTER NAME AS ENTRY POINT
          BX1    X0*X5
          RJ     MOVEIN 
          R=     X1,CEXECUTE FORM *EXECUTE* HEADER
          LX1    48 
          ADDWRD A0,X1
          BX1    X0*X5       USE NAME AS ENTRY
 CARD7    BX7    X4          UPDATE CURRENT REQUEST POINTER 
          SA7    KEY2 
          RJ     MOVEIN      INSERT ENTRY NAME
          IFSCOPE  1
          EQ     EXECUTE5    PROCESS REST OF CARD AS *EXECUTE*
          IFNOS  1
          EQ     EXECUTE4    PROCESS REST OF CARD AS *EXECUTE*
  
 SCAN     ENDIF 
  
**        4)   WHEREVER A NON-FATAL FORMAT ERROR OCCURS DURING THE
*              PROCESSING OF CARD IMAGES, CONTROL RETURNS TO THE
*              LOCATION *CARDERR*.  AT THIS POINT, IT IS CHECKED FOR THE
*              CASE WHERE A SUPPRESSED BINARY WAS WRITTEN BY A COMPILER 
*              OR ASSEMBLER DUE TO ERRORS.  THE CHECK MADE IS FOR THE 
*              FIRST SEVEN CHARACTERS TO CONSIST OF *ERRORS *.  THIS
*              RESULTS IN A MORE MEANINGFUL MESSAGE THAN OTHERWISE. 
* 
*              SEE DESCRIPTION OF CARD ERRORS IN THE *LOADC* SECTION. 
  
 CARDERR  SA1    ERRORS      CHECK IF THE IMAGE BEGINS WITH 
          SB7    B0          *ERRORS*.  IF SO, IT IS ASSUMED TO 
          MX2    42          BE THE OUTPUT OF AN ASSEMBLY OR
          SA5    CFWA        COMPILATION WITH ERRORS AND IS 
          SA3    X5          HANDLED AS A FATAL ERROR.
          MX0    -12         OTHERWISE, THE ERROR IS NONFATAL 
          BX3    X1-X3
          SA5    X5 
          BX3    X2*X3
          SX6    B1 
          NZ     X3,CARDERR1 IF NOT *ERRORS * 
          SA6    ABTTYPE     SET FOR SYSTEM ABORT 
          SB7    B1 
          ERROR  200         ---- ATTEMPT TO LOAD SUPPRESSED BINARY 
          R=     B2,3 
          EQ     CARDERR2 
  
 CARDERR1 SA3    LASTCARD 
          NZ     X3,GNERR    IF DIRECTIVE ERROR 
          ERROR  4200        ---- LOADER CARD ERROR 
          R=     B2,8 
 CARDERR2 ADDWRD A2,X5       INSERT ENTIRE IMAGE IN *TERR*
          BX3    -X0*X5 
          SA5    A5+B1       NEXT WORD
          SB2    B2-B1
          NZ     B2,CARDERR3 IF LESS THAN 8 WORDS 
          MX5    0           FLAG END OF CARD 
 CARDERR3 BSS    0
          NZ     X3,CARDERR2 IF MORE TO INSERT
          NZ     B7,ABEND    IF -ERRORS- CASE, IT IS FATAL
          SA2    KEY1        RESET REQUEST TABLE TO LENGTH IT 
          SX7    X2          WAS BEFORE THIS CARD 
          SA7    A0+B1
          EQ     CARD        EXIT 
  
 KEY1     CON    0           REQUEST TABLE ORDINAL (START OF CARD)
 KEY2     CON    0           REQ. TBL. ORD. (START OF LDSET REQ.) 
          RELOC  OFF
 ERRORS   VFD    60/7LERRORS
          RELOC  ON 
 MOVEIN   SPACE  4,8
**        MOVEIN - ADD WORD TO REQUEST TABLE. 
* 
*              THIS ROUTINE IS USED BY *CARD* AND ITS ASSOCIATED
*         PROCESSORS TO INSERT A WORD IN THE REQUEST TABLE AND TO 
*         ADVANCE THE LENGTH IN THE REQUEST HEADER. 
* 
*         ENTRY  (X1) = WORD TO BE INSERTED.
*                (KEY2) = TABLE ORDINAL TO START OF REQUEST.
*         EXIT   NONE.
*         USES   X - 2, 3, 6. 
*                B - NONE.
*                A - 2, 3, 6. 
*         CALLS  ADW=.
  
  
 MOVEIN   PS                 ENTRY/EXIT 
          SA2    KEY2        (X2) = ADR OF TABLE HEADER WORD
          SA3    A0 
          IX2    X3+X2
          SX6    B1 
          SA3    X2 
          LX6    36 
          IX6    X3+X6       INCREMENT LENGTH 
          SA6    A3 
          ADDWRD A0,X1       PLACE WORD IN TABLE
          EQ     MOVEIN      EXIT 
  
 BOTTOM   BSS    0
  
 OVLY     IFNE   SCAN',2
          SPACE  4,8
**        +++ CARD PROCESSORS +++ 
* 
*              THE FOLLOWING IS A DESCRIPTION OF THE ROUTINES FOR EACH
*         KEYWORD WHICH MAY BE ENCOUNTERED ON A CONTROL CARD OR A 
*         DIRECTIVE.
          SPACE  4,8
**        OVERLAY.
* 
*              CONTROL IS PASSED TO THE *LOADG* OVERLAY TO FINISH UP ANY
*         OVERLAY GENERATION IN PROGRESS AND THEN PREPARE TO BUILD THE
*         NEXT OVERLAY. 
  
  
 OVERLAY  BSS    0
          SA1    SEGFLAG
          NZ     X1,/LOADS/FPP9  IF A SEGMENT LOAD IGNORE THIS DIRECTIVE
          SA1    OG 
          MI     X1,GPCAPOV  IF ENCAPSULATION IN PROGRESS 
          NZ     X1,/LOADG/POD     IF OVERLAY GENERATION IN PROGRESS
          SA2    PC          CHECK AMOUNT LOADED
          ZR     X2,OV1      IF NOTHING LOADED YET
 OVSGERR  ERROR  202         ---- OVERLAY OR SEGLOAD DIRECTIVE NOT 1ST
          SA5    CFWA        PLACE ENTIRE DIRECTIVE IN *TERR* 
          MX0    -12
          SA5    X5          1ST WORD 
 OV1Z     ADDWRD A2,X5       INSERT WORD
          BX2    -X0*X5 
          SA5    A5+B1       NEXT WORD
          NZ     X2,OV1Z     IF MORE TO INSERT
          EQ     ABEND
  
 OV1      SX3    /LOADG/END  NEW FWA OF BUFFERS 
          RJ     MTO=        MOVE TABLES TO MAKE ROOM FOR *LOADG* 
          OVERLAY  LOADG,1,2,LOCG,/LOADG/END
          EQ     /LOADG/POD  JUMP TO PROCESS OVERLAY DIRECTIVE
 SEGLOAD  SPACE  4,8
**        SEGLOAD.
* 
*              *SEGLOAD* MAY APPEAR AS EITHER A CONTROL CARD OR AS AN 
*         OBJECT DIRECTIVE, AND EACH HAS DIFFERENT MEANING. 
* 
*              WHEN IT APPEARS AS A CONTROL CARD, IT INDICATES THAT A 
*         SEGMENT-GENERATION LOAD IS TO BE PERFORMED BY THE ROUTINE 
*         *LOADS*.  THE FOLLOWING STEPS ARE TAKEN 
* 
*         1) THE CARD IS CRACKED SO AS TO SAVE THE I=, B=, AND/OR LO= 
*            PARAMETERS, IF THEY ARE PRESENT. 
*         2) THE REMAINDER OF THE CONTROL CARDS IN THE LOAD SEQUENCE ARE
*            PROCESSED AS USUAL.
*         3) A CALL TO *LDV* IS MADE TO LOAD AND ENTER *LOADS*. 
* 
*              WHEN IT APPEARS AS AN OBJECT DIRECTIVE, THIS INDICATES 
*         THAT THE LOAD INPUT IS THE ABSOLUTE OUTPUT FROM *SEGBILD*.
*         THE FOLLOWING IS DONE 
* 
*         1) IF ANY LOADING HAS ALREADY TAKEN PLACE, A FATAL ERROR
*            IS ISSUED. 
*         2) A *SKIPB* REQUEST IS ISSUED ON THE LOAD FILE.
*         3) A CALL TO *LDV* IS MADE TO LOAD AND ENTER *SEGRES*.
  
  
 SEGLOAD  SA1    LASTCARD 
          NZ     X1,SEG6     IF *SEGLOAD* APPEARED AS A DIRECTIVE 
          SA2    ID 
          SX6    B0 
          SA6    A2          CLEAR INTERCATIVE DEBUG ON ABS LOAD
          ZR     X2,SEG0     IF NO INTERACTIVE DEBUG
          ERROR  4110        ----INTERACTIVE DEBUG IGNORED ON THIS LOAD 
 SEG0     BSS    0
          SX7    B1          FLAG OCCURRENCE OF *SEGLOAD* CARD
          SA7    SEGFLAG
 SEG1     GT     B7,B1,CARD  IF . OR )
          NE     B7,B1,SEGERR      IF NOT , OR (
          MX0    42          FETCH I= OR B= 
          RJ     GNE
          BX1    X0*X5
          LX1    12 
          SX1    X1-2RLO
          ZR     X1,SEG7     IF LO= PARAMETER 
          NZ     B7,SEGERR   IF PUNCTUATION NOT = 
          BX0    X0*X5       ISOLATE SUBPARAMETER 
          LX0    6
          R=     X0,X0-1RI
          ZR     X0,SEG2     IF I=
          R=     X1,X0+1RI-1RB
          NZ     X1,SEGERR   IF NOT B=
 SEG2     RJ     GNE         GET LFN
          BX1    X5          CHECK LFN FORMAT 
          RJ     /MISC/LFNCK
          NG     X6,SEGERR   IF BAD FORMAT
          NZ     X0,SEG3     IF LFN FOR B= OPTION 
          SA6    SEGIII      SAVE *SEGLOAD* INPUT LFN 
          EQ     SEG1        LOOP 
  
 SEG3     SA6    SEGBBB      SAVE *SEGLOAD* BINARY LFN
          EQ     SEG1        LOOP 
  
 SEG6     SA2    PC 
          NZ     X2,/LOADS/FPP5    IF ABS INPUT DURING RELOCATLE LOAD 
          SKIPB  L,1,0,RCL   SKIP BACKWARD TO BEGINNING OF RECORD 
          SX6    B1 
          SA6    SEGFLAG
          SA6    ABS
          SA6    PC          FLAG FOR NON-EMPTY LOAD
          SA6    EX          SET ECECUTE FLAG TO START *SEGRES* 
          RJ     CPL         COMPLETE LOAD AND CALL *SEGRES*
  
 SEG7     SX6    3           USE DEFALT (LO=DT) IF = NOT PRESENT
          NZ     B7,SEG10    IF *=* NOT PRESENT 
          RJ     GNE         GET NEXT PARAMETER 
          MX0    -6 
          SX6    B0 
 SEG8     LX5    6
          BX1    -X0*X5 
          ZR     X1,SEG10    IF NO MORE LETTERS 
          SX2    X1-1RD 
          SX3    X1-1RT 
          SX7    B1 
          ZR     X2,SEG9     IF LO=D SPECIFIED
          LX7    1
          ZR     X3,SEG9     IF LO=T SPECIFIED
          SX6    X1-1R0 
          SX7    B0 
          NZ     X6,SEGERR   IF CHARACTER IS OTHER THAN 0, D OR T 
 SEG9     BX6    X6+X7       ADD BIT TO SEGMENT LOAD MAP
          EQ     SEG8 
  
 SEG10    SA6    SEGMAP      STORE SEGMENT MAP BITS 
          EQ     SEG1 
  
 CALLSEG  SX3    /LOADS/ENDS NEW FWA OF BUFFERS 
          RJ     MTO=        MOVE TABLES FOR OVERLAY
          SA1    /LOADC/OVHOLD
          SX7    B0 
          BX6    X1 
          SA7    /LOADC/BREAK-1 NEW END OF DIRECTIVE TABLE
          SA6    /LOADC/TABLE ALLOW *OVERLAY* DIRECTIVE 
          OVERLAY LOADS,1,3,BREAK,/LOADS/ENDS 
          EQ     /LOADS/SEGBILD 
  
 SEGERR   SX6    B1          SET FOR SYSTEM ABORT 
          SA6    ABTTYPE
          ERROR  CAT,SEGERRM
  
 SEGERRM  DATA   C* SEGLOAD CARD ERROR* 
  
 OVLY     ENDIF 
          SPACE  4,8
**        OVCAP.
* 
*         OVERLAY-CAPSULE OBJECT DIRECTIVE. 
* 
*              THE *OVCAP* OBJECT DIRECTIVE INDICATES THAT WE ARE TO
*         GO INTO OVERLAY-CAPSULE GENERATION MODE.  WE MUST HAVE BEEN 
*         ALREADY IN OVERLAY GENERATION MODE.  CONTROL IS PASSED TO 
*         THE *LOADG* OVERLAY TO FINISH UP ANY OVERLAY OR OVERLAY-
*         CAPSULE ALREADY IN PROGRESS AND THEN PREPARE TO BUILD THE 
*         NEXT OVERLAY-CAPSULE. 
  
 OVCAP    BSS    0
 SCAN     IFNE   SCAN',2
          SA1    OG          CHECK OVERLAY/OVCAP GEN IN PROGRESS
          SB2    X1          (B2) = (OG)
          GE     B2,B1,/LOADG/POCD  IF OVERLAY/OVCAP GEN IN PROGRESS
          ERROR  520         ---- OVCAP DIRECTIVE ILLEGAL 
          EQ     ABEND
  
 SCAN     ENDIF 
 SCAN     IFEQ   SCAN',2
          ERROR  526         ---- OVCAP DIRECTIVE ILLEGAL IN USER-CALL
          EQ     ABEND
  
 SCAN     ENDIF 
          SPACE  4,8
**        GROUP/CAPSULE.
* 
*         CONTROL CARD OR OBJECT DIRECTIVE OPTION.
* 
*         GROUP/CAPSULE NAME ADDED TO *TCPFMT*. 
  
 GPCAPBIT BSS    1           =1 IFF GROUP, =0 IFF CAPSULE 
 GROUP    SX7    B1 
          EQ     GPCAP1 
  
 CAPSULE  SX7    B0 
 GPCAP1   SA7    GPCAPBIT    SET GROUP/CAPSULE FLAG 
 SCAN     IFNE   SCAN',2
          SA1    ID 
          SX6    B0 
          SA6    A1          CLEAR INTERACTIVE DEBUG ON GROUP/CAPSULE 
          ZR     X1,GPCAP1A  IF NOT UNDER INTERACTIVE DEBUG 
          ERROR  4110        ---- INTERACTIVE DEBUG IGNORED ON THIS LOAD
 GPCAP1A  BSS    0
          SA1    OG          CHECK OVERLAY GENERATION IN PROGRESS 
          SB2    X1          (B2)=(OG)
          R=     B3,-2
          SX7    B1 
          SA7    MM          FLAG *LOADC* IN AND NEEDED 
          LE     B2,GPCAP2   IF NOT OVERLAY/OVCAP GENERATION
 GPCAPOV  MX6    0           CLEAR PROGRAM COUNT IN CASE 54 HDR NOT SET UP
          SA6    PC 
          ERROR  500         ---- OVERLAY-CAPSULE DIRECTIVES INCOMPATIBLE 
          EQ     ABEND
  
 GPCAP2   SA1    LASTCARD    CHECK CC FETCHING DONE 
          NZ     X1,GPCAP3   IF CC FETCHING DONE
          R=     X7,-2       SET (OG)=-2 (CC INIT CAP GEN)
          SA7    OG 
          EQ     GPCAPLP     PROCESS FURTHER
  
 GPCAP3   EQ     B2,B3,LOAD11  IF CC INITIATED, IGNORE OBJECT DIRECTIVE 
*                                  I.E. CC SPECS OVERRIDE OBJ DIR 
          SA1    PC          CHECK FOR OBJ DIR NOT FIRST
          ZR     X1,GPCAP5   IF APPEARS OK CHECK FURTHER
 GPCAP4   ERROR  501         ---- CAPSULE OBJ DIR NOT FIRST 
          MX6    0           CLEAR PROGRAM COUNT SINCE 54 HDR NOT SET UP
          SA6    PC 
          EQ     ABEND
  
 GPCAP5   SA1    LASCPNAM    ANOTHER CHECK FOR OBJ DIR NOT FIRST
          NZ     X1,GPCAP4   IF NOT FIRST 
          SX7    -B1         SET OG=-1 (OBJ DIR INIT CAP GEN) 
          SA7    OG 
 GPCAPLP  NE     B7,B1,CARDERR     ERROR IF NOT , OR (
          RJ     GNE         GET PROGRAM NAME 
          BX1    X5 
          RJ     /MISC/EPNCK
          NG     X6,CARDERR  IF FORMAT ERROR
          SA1    GPCAPBIT 
          BX1    X1+X6       NAME/FLAG
          ADDWRD TCPFMT,X1
          GT     B7,B1,GPCAPX      IF . OR )
          EQ     GPCAPLP     CONTINUE PROCESSING
  
 GPCAPX   SA1    OG          IF OG=-1 RETURN TO *LOAD11*
          SX1    X1+B1       ELSE RETURN TO *CARD*
          ZR     X1,LOAD11   IF OBJECT DIRECTIVE INITIATED CAP GEN
          EQ     CARD 
  
 SCAN     ENDIF 
 SCAN     IFEQ   SCAN',2
          ERROR  502         ---- CAPSULE DIR ILLEGAL IN USER-CALL
          EQ     ABEND
  
 SCAN     ENDIF 
          SPACE  4,8
**        LIB.
* 
*         *LDSET* OPTION - INTERNAL REQUEST IS BUILT. 
  
 LIB      NZ     B7,LIB2     IF CURRENT SEPARATOR NOT = 
 LIB1     RJ     GNE         GET NEXT ELEMENT 
          BX1    X5          (X1) = LIB NAME
          RJ     MOVEIN      PLACE IT IN REQUEST TABLE
          SB2    B7+B1
          ZR     B2,LIB1     IF CURRENT SEPARATOR / 
 LIB2     GT     B7,B0,LDSETR      IF CURRENT SEPARATOR , OR ( OR . OR )
          EQ     LDSETE      FORMAT ERROR, BAD SEPARATOR
          SPACE  4,10 
**        COMMON. 
* 
*         *LDSET* OPTION - INTERNAL REQUEST IS BUILT. 
  
  
 COMMON   EQU    LIB         PROCESSING IS IDENTICAL
          SPACE  4,8
**        MAP.
* 
*         *LDSET* OPTION - INTERNAL REQUEST IS BUILT. 
  
 MAP      NZ     B7,LDSETE   ERROR IF NO =
          RJ     GNE         GET 1ST MAP PARAM
          MX0    42 
          BX1    X0*X5
          ZR     X1,MAP2     IF 1ST PARAM IS EMPTY
          BX2    X1 
          LX2    12 
          R=     B2,X2-1RN*100B 
          ZR     B2,MAP1     IF *N* (MUST BE ALL ALONE) 
          SX6    B0 
          MX0    54 
 MAP01    LX1    6
          BX2    -X0*X1 
          ZR     X2,MAP03    IF NO MORE CHARACTERS
          SX7    B1+B1
          R=     X3,X2-1RS
          ZR     X3,MAP02    IF *S* 
          R=     X3,X2-1RB
          LX7    1
          ZR     X3,MAP02    IF *B* 
          LX7    1
          R=     X3,X2-1RE
          ZR     X3,MAP02    IF *E* 
          LX7    1
          R=     X3,X2-1RX
          ZR     X3,MAP02    IF *X* 
          MESSAGE (=C*  CONTROL CARD ERROR, DEFAULT MAP SET.*)
          R=     B2,2*IP.MAP
          EQ     MAP1        USE DEFAULT OPTION 
  
 MAP02    BX6    X6+X7
          EQ     MAP01
  
 MAP03    SB2    X6 
 MAP1     SX7    B2+B1       INSERT MAP TYPE INDICATOR IN 
          SA1    KEY2        REQUEST HEADER 
          SA2    A0 
          IX3    X1+X2
          SA4    X3 
          BX7    X4+X7
          SA7    A4 
 IC       IFCARD
          LX7    59-0 
          PL     X7,MAP2     IF MAP TYPE NOT SELECTED 
          LX7    0-59 
          SA7    GLOBMAP     SAVE LAST MAP SETTING
 IC       ENDIF 
 MAP2     GT     B7,B0,LDSETR      IF CURRENT SEPARATOR , OR ( OR . OR )
          SB2    B7+B1
          NZ     B2,LDSETE   MUST BE / OR IT IS AN ERROR
          RJ     GNE
          BX1    X5 
          RJ     /MISC/LFNCK
          NG     X6,LDSETE   IF LFN OF BAD FORMAT 
          IFCARD 1
          SA6    GLOBLFN     SAVE LFN FOR SEGMENT LOAD
          RJ     MOVEIN      PLACE IT IN REQUEST
          LT     B7,B1,LDSETE      ERROR IF NO , OR ( OR . OR ) 
          EQ     LDSETR      RETURN TO *LDSET* PROCESSOR
 PD       SPACE  4,10 
**        PD. 
* 
*         *LDSET* OPTION -  GLOBAL VARIABLE IS SET. 
  
  
 PD       NZ     B7,LDSETE   ERROR IF NO =
          RJ     GNE         GET PARAMETER
          RJ     CDB         CONVERT PARAMETER TO BINARY
          PL     X2,PD1      IF PARAMETER NUMERIC 
          MX2    60          ERROR BUT USE JOB DEFAULT
 PD1      BX7    X2 
          SA7    PRDEN
          GT     B7,LDSETR   RETURN IF . OR ( OR ) OR , 
          EQ     LDSETE      ERROR IF NO DELIMETER
 PS       SPACE  4,10 
**        PS. 
* 
*         *LDSET* OPTION -  GLOBAL VARIABLE IS SET. 
  
  
 PS       NZ     B7,LDSETE   ERROR IF NO =
          RJ     GNE         GET PARAMETER
          R=     X7,10D 
          RJ     CDB         CONVERT VALUE TO BINARY
          MI     X2,PS2      IF VALUE HAD NON-NUMERIC CHARS 
          IX1    X2-X7
          MI     X1,PS2      IF VALUE .LT. 10 
          R=     X1,1000D 
          IX1    X1*X1
          IX1    X1-X2
          PL     X1,PS1      IF SPECIFIED VALUE .LE. 1,000,000 (DECIMAL)
 PS2      MX2    60          ERROR BUT USE JOB DEFAULT
 PS1      BX7    X2          SET PAGE SIZE TO SPECIFIED VALUE 
          SA7    PGSIZ
          GT     B7,LDSETR   RETURN IF . OR ( OR ) OR , 
          EQ     LDSETE      ERROR IF NO DELIMETER
          SPACE  4,8
**        PRESET. 
* 
*         *LDSET* OPTION - INTERNAL REQUEST IS BUILT. 
  
 PRESET   NZ     B7,LDSETE   ERROR IF NO =
          MX0    0           INDICATE POSITIVE SIGN 
 PRESET1  RJ     SNC         SEE NEXT CHARACTER 
          R=     X1,X6-1R0
          MI     X1,PRESET2  IF ALPHABETIC
          R=     X1,X6-1R+
          MI     X1,PRESET7  IF NUMERIC 
          RJ     GNC         GET CHARACTER
          R=     X1,X6-55B
          ZR     X1,PRESET1  IF BLANK, IGNORE 
          R=     X1,X6-1R-
          MI     X1,PRESET1  IF +, IGNORE 
          NZ     X1,LDSETE   IF NOT -, ERROR
          MX0    60          SET TO CHANGE SIGN 
          EQ     PRESET1
  
 PRESET2  RJ     GNE         GET KEYWORD
          SB2    B0 
          SB3    PRSNAML
 PRESET3  SA1    PRSNAME+B2 
          BX2    X5-X1
          AX2    18 
          ZR     X2,PRESET4  IF KEYWORD MATCH 
          SB2    B2+B1
          LT     B2,B3,PRESET3  LOOP
          EQ     LDSETE      ERROR IF NO MATCH
  
 PRESET4  ZR     B2,PRESET6  IF 1ST ENTRY, NO PRESETTING
          SA1    PRSVAL+B2-1 GET PRESET VALUE 
          BX7    X1 
 PRESET5  BX1    X7-X0       SET SIGN 
          RJ     MOVEIN      PUT IN REQUEST 
 PRESET6  GT     B7,LDSETR   RETURN IF , OR ( OR . OR ) 
          EQ     LDSETE      ERROR
  
 PRESET7  RJ     GOP         GET OCTAL PARAMETER
          R=     X1,X6-1RB
          NZ     X1,PRESET9  IF *B* SUFFIX NOT PRESENT
 PRESET8  BX0    X7-X0
          RJ     GNC         SKIP IT
          SX7    B0 
          R=     X1,X6-55B
          ZR     X1,PRESET8  IF BLANK FOLLOWS *B* 
 PRESET9  LD     X1,X6-1R,
          LD     X2,X6-1R(
          SB7    B1 
          IX1    X1*X2
          ZR     X1,PRESET5  IF FOLLOWED BY , OR (
          LD     X1,X6-1R.
          LD     X2,X6-1R)
          SB7    B1+B1
          IX1    X1*X2
          ZR     X1,PRESET5  IF FOLLOWED BY . OR )
          EQ     LDSETE      ERROR
  
          RELOC  OFF
 PRSNAME  VFD    42/0LNONE,18/0 
          VFD    42/0LZERO,18/0 
          VFD    42/0LONES,18/0 
          VFD    42/0LINDEF,18/0
          VFD    42/0LINF,18/0
          VFD    42/0LNGINDEF,18/0
          VFD    42/0LNGINF,18/1
          VFD    42/0LALTZERO,18/0
          VFD    42/0LALTONES,18/0
          VFD    42/0LDEBUG,18/0
 PRSNAML  EQU    *-PRSNAME
 PRSVAL   CON    0
          CON    -0 
          CON    17770000000000000000B
          CON    37770000000000000000B
          CON    60000000000000000000B
          CON    40000000000000000000B
          CON    25252525252525252525B
          CON    52525252525252525252B
          CON    60000000000400400000B
          RELOC  ON 
          SPACE  4
**        PRESETA.
* 
*         *LDSET* OPTION - INTERNAL REQUEST IS BUILT. 
  
 PRESETA  SA1    X3          PICK UP REQUEST HEADER WORD
          SX7    B1 
          BX7    X1+X7       SET ADDRESS INSERTION FLAG 
          SA7    A1 
          EQ     PRESET      PROCESS AS *PRESET*
          SPACE  4,8
**        ERR.
* 
*         *LDSET* OPTION - INTERNAL REQUEST IS BUILT. 
  
 ERR      NZ     B7,LDSETE   ERROR IF NO =
          RJ     GNE         GET ERR OPTION 
          SB2    B0 
          MX0    42 
          SB3    B1+B1
 ERR1     SA1    B2+ERRNAME  SEARCH TABLE FOR MATCH 
          BX2    X1-X5
          BX2    X0*X2
          SX7    B2          (X7) = CODE TO PUT IN REQUEST
          ZR     X2,ERR2     IF MATCH 
          SB2    B2+B1
          LE     B2,B3,ERR1 
          EQ     LDSETE      IF NO MATCH, ERROR 
  
 ERR2     SA2    KEY2        PUT (X7) IN REQUEST HEADER 
          SA3    A0 
          IX4    X2+X3
          SA1    X4 
          BX7    X1+X7
          SA7    A1 
 ERR3     GE     B7,B1,LDSETR      IF , OR ( OR . OR )
          EQ     LDSETE      ERROR IF NOT 
  
          RELOC  OFF
 ERRNAME  VFD    42/0LALL,18/0
          VFD    42/0LFATAL,18/0
          VFD    42/0LNONE,18/0 
          RELOC  ON 
          SPACE  4,8
**        REWIND. 
* 
*         *LDSET* OPTION - INTERNAL REQUEST IS BUILT. 
  
 REWIND   SX7    B1          PLACE (X7) = 1 IN REQUEST HEADER 
          EQ     ERR2 
          SPACE  4,8
**        NOREWIN.
* 
*         *LDSET* OPTION - INTERNAL REQUEST IS BUILT. 
  
 NOREWIN  EQU    ERR3        CODE IN REQUEST HEADER WILL = 0
          SPACE  4,8
**        USEP. 
* 
*         *LDSET* OPTION - INTERNAL REQUEST IS BUILT. 
  
 USEP     NZ     B7,LDSETE   ERROR IF NO =
 USEP1    RJ     GNE         GET NEXT NAME
          BX1    X5          CHECK NAME FORMAT
          RJ     /MISC/EPNCK
          NG     X6,LDSETE   IF FORMAT BAD, ERROR 
          RJ     MOVEIN      PLACE NAME IN REQUEST TABLE
          SB2    B7+B1
          ZR     B2,USEP1    IF SEPARATOR IS /
          GE     B7,B1,LDSETR      MUST END WITH , OR ( OR . OR ) 
          EQ     LDSETE 
          SPACE  4,8
**        USE.
* 
*         *LDSET* OPTION - INTERNAL REQUEST IS BUILT. 
  
 USE      EQU    USEP        PROCESSING IS IDENTICAL
          SPACE  4,8
**        SUBST.
* 
*         *LDSET* OPTION - INTERNAL REQUEST IS BUILT. 
  
 SUBST    NZ     B7,LDSETE   ERROR IF NOT = 
          MX0    30          FLAG TO KEEP TRACK OF PAIRS
 SUBST1   RJ     GNE         GET NEXT NAME
          LX1    X5          CHECK FORMAT 
          BX0    -X0         REVERSE FLAG 
          RJ     /MISC/EPNCK
          NG     X6,LDSETE   IF NAME FORMAT BAD 
          RJ     MOVEIN      PLACE IN REQUEST TABLE 
          NG     X0,SUBST2   IF LAST NAME WAS 2ND OF PAIR 
          R=     X4,X5-6     MUST BE FOLLOWED BY A -
          ZR     X4,SUBST1
          EQ     LDSETE      ERROR IF NOT - 
  
 SUBST2   SB2    B7+B1
          ZR     B2,SUBST1   IF NAME FOLLOWED BY /
          GE     B7,B1,LDSETR      MUST END WITH , OR ( OR . OR ) 
          EQ     LDSETE 
          SPACE  4,8
**        OMIT. 
* 
*         *LDSET* OPTION - INTERNAL REQUEST IS BUILT. 
  
 OMIT     EQU    USEP        PROCESSING IS IDENTICAL
  
 IC       IFCARD
          SPACE  4,5
 SYSTEM   LT     B7,B1,LDSETE      ERROR IF NO , OR ( OR . OR ) 
          SX7    B1          SET FLAG SO PROTECT BIT WILL NOT 
          SA7    NOPRO       BE SET 
          EQ     LDSETR 
  
 IC       ENDIF 
          SPACE  4,8
**        EPT.
* 
*         *EPT* OPTION. 
* 
*         *LDSET* OPTION - INTERNAL REQUEST IS BUILT. 
  
 CGENTRY  EQU    USEP        PROCESSING IS IDENTICAL
          SPACE  4,8
**        NOEPT.
* 
*         *NOEPT* OPTION. 
* 
*         *LDSET* OPTION - INTERNAL REQUEST IS BUILT. 
  
 CGNENTRY EQU    LIB         PROCESSING IS IDENTICAL
          SPACE  4,8
**        LDSET.
* 
*              THIS ROUTINE BRANCHES TO THE APPROPRIATE PROCESSOR FOR 
*         *LDSET* TYPE REQUESTS.
  
 LDSET    EQ     B7,B1,LDSET1      MUST BE AT LEAST ONE PARAMETER 
 LDSETE   SA2    CFWA        *LDSET* FORMAT ERROR 
          EQ     CARDERR
  
 LDSET1   RJ     GNE
          MX0    42          SCAN TABLE FOR *LDSET* OPTION
          MX6    -6 
          MX1    -9 
          SB6    B0 
 LDSET2   SA4    B6+LDSETBL  NEXT TABLE ENTRY 
          BX2    X4-X5
          SB6    B6+B1
          BX3    X2*X0
          ZR     X4,LDSETE   IF NOT IN TABLE, ERROR 
          BX7    -X1*X4      (X7) = ADR OFFSET FOR PROCESSOR
          NZ     X3,LDSET2   IF MISS
          LX4    48 
          BX1    -X6*X4      (X6) = REQUEST HEADER
          LX1    48 
          SB6    X7 
          ZR     X1,LDSET3   IF THIS OPTION IS NOT A REQUEST
          ADDWRD A0,X1       INSERT HEADER WORD IN TABLE
          BX6    X4          SAVE POINTER TO CURRENT REQUEST
          SA6    KEY2 
 LDSET3   JP     B6+BOTTOM   GO TO *LDSET* PROCESSOR
  
*         RETURN HERE FROM *LDSET* REQUEST PROCESSORS.
  
 LDSETR   LE     B7,B1,LDSET1      IF MORE PARAMS ON *LDSET* CARD 
          EQ     CARD        EXIT 
  
  
*         TABLE OF *LDSET* TYPE REQUESTS. 
* 
*         VFD    42/0LNAME,6/T,3/0,9/ADR-BOTTOM 
* 
*         NAME = NAME OF REQUEST. 
*         T    = REQUEST TYPE NUMBER. 
*         ADR  = THE ADDRESS OF THE APPROPRIATE PROCESSOR RELATIVE TO 
*                THE LOCATION *BOTTOM*. 
  
          RELOC  OFF
 LDSETBL  VFD    42/0LLIB,6/CLIB,3/0,9/LIB-BOTTOM 
          VFD    42/0LMAP,6/CMAP,3/0,9/MAP-BOTTOM 
          VFD    42/0LPRESET,6/CPRESET,3/0,9/PRESET-BOTTOM
          VFD    42/0LPRESETA,6/CPRESET,3/0,9/PRESETA-BOTTOM
          VFD    42/0LERR,6/CERR,3/0,9/ERR-BOTTOM 
          VFD    42/0LREWIND,6/CREWIND,3/0,9/REWIND-BOTTOM
          VFD    42/0LNOREWIN,6/CREWIND,3/0,9/NOREWIN-BOTTOM
          VFD    42/0LUSEP,6/CUSEP,3/0,9/USEP-BOTTOM
          VFD    42/0LUSE,6/CUSE,3/0,9/USE-BOTTOM 
          VFD    42/0LSUBST,6/CSUBST,3/0,9/SUBST-BOTTOM 
          VFD    42/0LOMIT,6/COMIT,3/0,9/OMIT-BOTTOM
          VFD    42/0LEPT,6/CCGENT,3/0,9/CGENTRY-BOTTOM 
          VFD    42/0LNOEPT,6/CCGNENT,3/0,9/CGNENTRY-BOTTOM 
          IFEQ   SCAN',0,1
          VFD    42/0LSTAT,6/CSTAT,3/0,9/STAT-BOTTOM
          VFD    42/0LCOMMON,6/CCOMMON,3/0,9/COMMON-BOTTOM
          VFD    42/0LPD,6/0,3/0,9/PD-BOTTOM
          VFD    42/0LPS,6/0,3/0,9/PS-BOTTOM
  
 IC       IFCARD
  
*   LDSET(SYSTEM), WHICH PREVENTS THE SETTING OF THE SYSTEM PROTECT BIT 
*   IN THE CONTROL POINT AREA, HAS BEEN DISABLED BECAUSE ITS USE POSES
*   A THREAT TO SYSTEM SECURITY.  IT MAY BE RE-ENABLED BY DELETING THE
*   FOLLOWING *SKIP* CARD.
  
          SKIP   1           DISABLE LDSET(SYSTEM)
          VFD    42/0LSYSTEM,6/0,3/0,9/SYSTEM-BOTTOM
 IC       ENDIF 
          IFEQ   SCAN',0,1
          VFD    42/0LFILES,6/CFILES,3/0,9/FILES-BOTTOM 
          CON    0
          SPACE  4,8
**        TABLE OF CARD IMAGE KEYWORDS. 
* 
*              FOLLOWING IS A TABLE WHICH CONTAINS ENTRIES FOR ALL VERBS
*         TO BE RECOGNIZED DURING SCANNING OF CARD IMAGES BY THE LOADER.
*         IT IS OF THE FOLLOWING FORMAT - 
* 
*         VFD    42/0LNAME,6/T,1/R,2/0,9/ADR-BOTTOM 
* 
*         NAME = CARD IMAGE VERB OR REQUEST NAME. 
*         T    = REQUEST TYPE NUMBER FOR THE CASES WHERE R = 1. 
*         R    = 1 IF *NAME* IS THE NAME OF ANY LOADER REQUEST. 
*         ADR  = THE ADDRESS OF THE APPROPRIATE PROCESSOR.  NOTE THAT 
*                THESE MUST BE NO MORE THAN 777B WORDS ABOVE THE
*                FIRST (LOCATION *BOTTOM*).  HOWEVER, IF ANY OF THEM
*                ARE, THINGS ARE MUCH TOO BIG, ANYHOW.
* 
*              LOCATION *BREAK* IS THE BOUNDARY BETWEEN THE ONLY CODE 
*         NEEDED FOR SCANNING OBJECT DIRECTIVES AND THE CODE NEEDED FOR 
*         SCANNING LOADER (SCOPE) CONTROL CARDS.  THE CODE BEYOND THIS
*         POINT IS ASSEMBLED ONLY IN THE MAIN PROGRAM 
*         *LOADER* AND NOT IN *LOADC* OR *LOADUC* 
  
****
  
 TABLE    BSS    0
          IFEQ   SCAN',0,1
          VFD    42/-0,18/0  ENTRY FOR *OVERLAY* INSERTED LATER 
          IFEQ   SCAN',1,1
          VFD    42/0LOVERLAY,6/0,1/0,2/0,9/OVERLAY-BOTTOM
          IFNE   SCAN',2,1
          VFD    42/0LSEGLOAD,6/0,1/0,2/0,9/SEGLOAD-BOTTOM
          VFD    42/0LLDSET,6/0,1/0,2/0,9/LDSET-BOTTOM
          VFD    42/0LOVCAP,6/0,1/0,2/0,9/OVCAP-BOTTOM
          VFD    42/0LGROUP,6/0,1/0,2/0,9/GROUP-BOTTOM
          VFD    42/0LCAPSULE,6/0,1/0,2/0,9/CAPSULE-BOTTOM
          IFNE   SCAN',0,2
          CON    0
 BREAK    EQU    *
 SCAN     IFEQ   SCAN',0
          VFD    42/0LLOAD,6/CLOAD,1/1,2/0,9/LOAD-BOTTOM
 BREAK    EQU    *
          VFD    42/0LLIBLOAD,6/CLIBLOAD,1/1,2/0,9/LIBLOAD-BOTTOM 
          VFD    42/0LSLOAD,6/CSLOAD,1/1,2/0,9/SLOAD-BOTTOM 
          VFD    42/0LEXECUTE,6/CEXECUTE,1/1,2/0,9/EXECUTE-BOTTOM 
          VFD    42/0LNOGO,6/CNOGO,1/1,2/0,9/NOGO-BOTTOM
          VFD    42/0LSATISFY,6/CSATISFY,1/1,2/0,9/SATISFY-BOTTOM 
          VFD    42/0LDMP,6/CDMP,1/1,2/0,9/DMP-BOTTOM 
          VFD    42/0LMAP,6/0,1/0,2/0,9/MAPCARD-BOTTOM
          VFD    42/0LREDUCE,6/0,1/0,2/0,9/REDUCE-BOTTOM
          VFD    42/0LEXIT,6/0,1/0,2/0,9/EXIT-BOTTOM
          IFTEST NE,IP.LDBG,0,1 
          VFD    42/0LLDPATCH,6/0,1/0,2/0,9/PAT-BOTTOM
          CON    0
 OVHOLD   VFD    42/0LOVERLAY,6/0,1/0,2/0,9/OVERLAY-BOTTOM
  
****
          SPACE  4,8
**        LOAD. 
* 
*         CONTROL CARD OPTION ONLY - INTERNAL REQUEST IS BUILT. 
  
 LOAD     SA5    B0          (A5) = 0 TO FLAG *LOAD* REQUEST
 LOAD1    NE     B7,B1,CARDERR     ERROR IF NOT , OR (
          RJ     GNE         GET LFN
          BX1    X5 
          RJ     /MISC/LFNCK CHECK FORMAT 
          NG     X6,CARDERR  IF BAD FORMAT
          GE     B7,B1,LOAD3 IF , OR ( OR . OR )
          SB2    B7+B1
          NZ     B2,CARDERR  ERROR IF NOT / 
          BX0    X1          SAVE LFN 
          RJ     GNE         GET REWIND INDICATOR 
          SA1    =0LNR
          SX7    B1+B1       FLAG FOR NO REWIND 
          MX2    42 
          SA3    =0LR 
          BX4    X2*X5
          BX1    X4-X1
          ZR     X1,LOAD2    IF /NR 
          SX7    X7+B1       FLAG FOR REWIND
          BX3    X4-X3
          NZ     X3,CARDERR  IF NOT /R
 LOAD2    BX1    X0+X7       LFN + REWIND OPTION
 LOAD3    RJ     MOVEIN      PLACE IN REQUEST TABLE 
          SB6    A5 
          NZ     B6,LOAD4    IF *SLOAD* 
          LE     B7,B1,LOAD1 IF NOT . OR )
          EQ     CARD        EXIT 
  
 LOAD4    NE     B7,B1,CARDERR     ERROR IF NOT , OR (
          RJ     GNE         GET PROGRAM NAME 
          BX1    X5 
          RJ     /MISC/EPNCK
          NG     X6,CARDERR  IF NAME FORMAT ERROR 
          RJ     MOVEIN      PLACE IN REQUEST TABLE 
          LE     B7,B1,LOAD4 IF NOT . OR )
          EQ     CARD        EXIT 
          SPACE  4,8
**        SLOAD.
* 
*         CONTROL CARD OPTION ONLY - INTERNAL REQUEST IS BUILT. 
  
 SLOAD    SA5    B1          (A5) = 1 TO FLAG *SLOAD* REQUEST 
          EQ     LOAD1       GO SHARE *LOAD* ROUTINE
          SPACE  4,8
**        LIBLOAD.
* 
*         CONTROL CARD OPTION ONLY - INTERNAL REQUEST IS BUILT. 
  
 LIBLOAD  NE     B7,B1,CARDERR     ERROR IF NOT , OR (
          RJ     GNE         GET LIBRARY NAME 
          BX1    X5 
          RJ     /MISC/LFNCK
          NG     X6,CARDERR  IF NAME FORMAT ERROR 
          RJ     MOVEIN      PLACE IN REQUEST TABLE 
 LIBLOAD1 NE     B7,B1,CARDERR     ERROR IF NOT , OR (
          RJ     GNE         GET ENTRY NAME 
          BX1    X5 
          RJ     /MISC/EPNCK
          NG     X6,CARDERR  IF NAME FORMAT ERROR 
          RJ     MOVEIN      PLACE IN REQUEST TABLE 
          LE     B7,B1,LIBLOAD1    IF NOT . OR )
          EQ     CARD        EXIT 
          SPACE  4,8
**        EXECUTE.
* 
*         CONTROL CARD OPTION ONLY - INTERNAL REQUEST IS BUILT. 
* 
*              A FLAG IS SET TO INDICATE THAT EXECUTION IS TO TAKE
*         PLACE.
  
 EXECUTE  SX7    B1          SET FLAG FOR EXECUTE 
 K        IFNOS 
          SA7    EXPCCEX     SET EXPLICIT CONTROL CARD EXECUTE FLAG 
 K        ENDIF 
          SA7    EX 
  
 IN       IFNOS 
 EXECUTE4 SA1    COMARGCT 
          SB2    X1          (B2) = ARGUMENT COUNT
          SA1    ACEB 
          SB3    X1          (B3) = ADDRESS-1 OF FIRST PARAMETER
          ZR     B2,EXECUTE6 IF NO PARAMETERS 
 EXECUTE5 SB3    B3+B1
          SA1    B3          PICK UP PARAMETER
          RJ     MOVEIN      ADD TO REQUEST TABLE 
          SB2    B2-B1
          GT     B2,EXECUTE5 IF MORE
 IN       ELSE
          GT     B7,B1,EXECUTE6    IF . OR )
          EQ     B7,B1,EXECUTE2    IF , OR (
 EXECUTE1 SX6    B1          SET FOR SYSTEM ABORT 
          SA6    ABTTYPE
          ERROR  CAT,(=C* EXECUTE OR NOGO ARG ERROR*) 
  
 EXECUTE2 MX0    42 
          RJ     GNE         GET ENTRY NAME 
          BX7    X0*X5
          BX1    X7 
          RJ     /MISC/EPNCK
          ZR     X7,EXECUTE3 IF ENTRY POINT NOT SPECIFIED 
          MI     X6,EXECUTE1 IF FORMAT ERROR
 EXECUTE3 RJ     MOVEIN      INSERT ENTRY NAME OR ZERO
 EXECUTE4 LT     B7,B1,EXECUTE1    ERROR IF NOT , OR ( OR . OR )
 EXECUTE5 GT     B7,B1,EXECUTE6    IF . OR )
          SX6    B1          SET FLAG TO PREVENT FETCHING OF
          SA6    CEXEC       CONTINUATION CONTROL CARD
          RJ     GNE         PICK UP EXECUTION PARAMETERS 
          BX1    X5 
          RJ     MOVEIN      PLACE IN REQUEST TABLE 
          EQ     EXECUTE5    LOOP 
 IN       ENDIF 
  
 EXECUTE6 SX7    B1          SET FLAG TO INDICATE LAST CARD IN
          SA7    LASTCARD    LOAD SEQUENCE
          EQ     CARD        EXIT 
          SPACE  4,8
**        NOGO. 
* 
*         CONTROL CARD OPTION ONLY - INTERNAL REQUEST IS BUILT. 
* 
*              A FLAG IS SET TO INDICATE THAT EXECUTION HAS BEEN
*         INHIBITED AS A RESULT OF A *NOGO* REQUEST.
  
 NOGO     MX7    0           SET FLAG FOR NO EXECUTE
          SA7    EX 
          GT     B7,B1,EXECUTE6    IF . OR )
          NE     B7,B1,NOGO2 ERROR IF NOT , OR (
          RJ     GNE         GET LFN
          BX1    X5 
          RJ     /MISC/LFNCK
          MI     X6,NOGO2    IF BAD FORMAT
          SA6    OF          SAVE LFN 
          RJ     MOVEIN      INSERT LFN IN REQUEST
          GT     B7,B1,EXECUTE6    IF . OR )
          NE     B7,B1,NOGO2 ERROR IF NOT , OR (
          SA2    PO 
          SX4    B1 
          SA3    PA 
          IX6    X2-X4       DECREMENT PO AND PA (REMOVE IMPLICIT EPT)
          IX7    X3-X4
          SA6    A2 
          SA7    A3 
          SA1    BI 
          SA2    TPGM+1 
          IX6    X1-X4       DECREMENT BI 
          IX7    X2-X4       DECREMENT *TPGM* LENGTH
          SA6    A1 
          SA7    A2 
          SX6    B0 
          SA6    EPTC 
 NOGO1    RJ     GNE         GET ENTRY NAME 
          BX1    X5 
          RJ     /MISC/EPNCK
          MI     X6,NOGO2    IF BAD FORMAT
*                            PROCEED TO CHECK FOR DUPLICATE NAMES 
          SA3    TPGM        (X3) = FWA *TPGM*
          R=     X6,COMLTH+X3  (X6) = ABS FWA OF NAMES IN *TPGM*
          SA2    PO          (X2)=LWA OF NAMES IN *TPGM*
          IX2    X3+X2       (X2)=ABS LWA OF NAMES IN *TPGM*
 NOGO1A   IX3    X2-X6       CHECK IF DONE COMPARING
          ZR     X3,NOGO1B   IF NO MORE NAMES TO COMPARE
          SA3    X6          GET NEXT NAME FROM *TPGM*
          SX6    X6+B1       BUMP FETCH ADDRESS 
          BX3    X3-X1       COMPARE WITH THIS NAME 
          ZR     X3,NOGO1C   IF NAME THE SAME THEN IGNORE 
          EQ     NOGO1A      CONTINUE COMPARE 
  
 NOGO1B   BSS    0           NO DUPLICATE NAME FOUND
          RJ     MOVEIN      INSERT ENTRY NAME
          SA2    PO          ADVANCE PROGRAM ORIGIN FOR 
          SX6    X2+B1       OVERLAY HEADER 
          SA6    A2 
          SA3    PA          ADVANCE PROGRAM ADDRESS
          SX7    X3+B1
          SA7    A3 
          SA2    BI          ADVANCE BINARY INDEX 
          SX6    X2+B1
          SA6    A2 
          ADDWRD TPGM,X1     INCREASE *TPGM* BY ONE WORD
          SA1    EPTC        INCREMENT ENTRY POINT COUNT
          SX6    X1+B1
          SA6    A1 
 NOGO1C   BSS    0
          GT     B7,B1,EXECUTE6    IF . OR )
          EQ     B7,B1,NOGO1 OK IF , OR ( 
 NOGO2    SX6    B1 
          SA6    ABTTYPE
          ERROR  CAT,(=C* NOGO ARGUMENT ERROR*) 
          SPACE  4,8
**        SATISFY.
* 
*         CONTROL CARD OPTION ONLY - INTERNAL REQUEST IS BUILT. 
  
 SATISFY  GT     B7,B1,CARD  IF . OR )
          NE     B7,B1,CARDERR     ERROR IF NOT , OR (
          RJ     GNE         GET LIBRARY NAME 
          BX1    X5 
          RJ     /MISC/LFNCK
          NG     X6,CARDERR  IF FORMAT ERROR
          RJ     MOVEIN      PLACE NAME IN REQUEST
          EQ     SATISFY     LOOP 
          SPACE  4,8
**        DMP.
* 
*         CONTROL CARD OPTION ONLY - IF DEBUG VERSION OF THE
*         LOADER IS USED, THE INTERNAL REQUEST IS BUILT, OTHERWISE
*         ISSUE DAYFILE MESSAGE *SECURE MEMORY, DUMP DISABLED*. 
  
 DB       IFTEST NE,IP.LDBG,1 
 DMP      SA1    A0+B1
          R=     X6,X1-1     DECREMENT TABLE LENGTH BY ONE
          SA6    A1 
 DMP1     GT     B7,B1,DMP2  IF . OR )
          RJ     GNE         GET NEXT ELEMENT 
          EQ     DMP1        LOOP 
 DMP2     MESSAGE  (=C*  SECURE MEMORY, DUMP DISABLED. *),RECALL
          EQ     CARD 
 DB       ELSE
 DMP      GT     B7,B1,CARD  ALL DONE IF . OR ) 
          NE     B7,B1,CARDERR     ERROR IF NOT , OR (
          RJ     GNE         GET NEXT PARAM 
          MX4    -6 
          SB2    B0          (B2) = CHAR COUNT
          MX7    0           (X7) = OCTAL VALUE 
 DMP1     LX5    6           NEXT CHAR
          BX1    -X4*X5 
          R=     B3,6 
          ZR     X1,DMP2     IF NO MORE CHARS 
          R=     X1,X1-1R0   CONVERT CHAR 
          SB2    B2+B1       ADVANCE CHAR COUNT 
          LX7    3
          NG     X1,CARDERR  IF CHAR ALPHA
          R=     X2,X1-8
          PL     X2,CARDERR  IF CHAR NOT OCTAL
          IX7    X7+X1       ADD TO VALUE 
          EQ     DMP1        LOOP 
  
 DMP2     ZR     B2,CARDERR  ERROR IF EMPTY PARAM 
          GT     B2,B3,CARDERR     ERROR IF MORE THAN 6 CHARS 
          SA2    A0          FETCH REQUEST HEADER AT LAST WORD
          SA1    A0+B1       IN TABLE 
          IX1    X1+X2
          MX3    24 
          R=     A2,X1-1
          BX6    X3*X2
          BX2    -X3*X2      *DMP* ARGS INSERTED SO FAR 
          LX2    18          RIGHT-TO-LEFT
          IX7    X6+X7       HEADER + NEWEST ONE
          BX3    X3*X2       LOOK AT WHERE ONE SHOULD NOT BE
          IX7    X2+X7       HEADER WITH ALL ARGS PICKED UP SO FAR
          NZ     X3,CARDERR  IF TOO MANY ARGS 
          SA7    A2          STORE UPDATED HEADER 
          EQ     DMP         LOOP 
 DB       ENDIF 
          SPACE  4,8
**        MAP.
* 
*              THE *MAP* CONTROL CARD SPECIFIES A CHANGE TO THE DEFAULT 
*         MAP TYPE.  THE MAP TYPE FOR THIS LOAD IS SET AND THE MAP
*         BITS IN THE CONTROL POINT AREA ARE REWRITTEN. 
  
 MAPCARD  BSS    0
 IS       IFSCOPE 
          SA1    DFMFLAG
          NZ     X1,MAPCD0    IF MESSAGE ALREADY ISSUED 
          SA1    TPGM 
          SX1    X1+70B 
          MESSAGE X1,R,6     DAYFILE THE COMMAND (NOT TO TERMINAL)
          SX6    B1 
          SA6    DFMFLAG
 MAPCD0   BSS    0
 IS       ENDIF 
          GT     B7,B1,MAPCD3      IF NO PARAMETERS 
          RJ     GNE
          LE     B7,B1,MAPCD2      IF MULTIPLE PARAMETERS 
          SA1    MAPOPTS
 MAPCD1   ZR     X1,MAPCD2   IF UNRECOGNIZED OPTION 
          SX6    X1 
          BX1    X5-X1
          AX1    18 
          ZR     X1,MAPCD4   IF MATCH 
          SA1    A1+B1
          EQ     MAPCD1 
  
 MAPCD2   MESSAGE (=C*  CONTROL CARD ERROR, DEFAULT MAP SET.*)
 MAPCD3   R=     X6,IP.MAP
 MAPCD4   SA6    MAPDEF      SET DEFAULT MAP TYPE 
          SA6    MAPTYPE     SET MAP TO USE FOR THIS LOAD 
  
 IS       IFSCOPE 
          SA1    CTLPT       SET IN W.CPLDR1 LOCAL COPY 
          MX0    6
          LX6    54 
          SX7    B1          SET VALID MAP OPTIONS BIT
          LX7    48-12*C.CPLM+S.CPLV                                     LDR0153
          BX6    X6+X7       MERGE VALID BIT WITH OPTIONS 
          BX1    -X0*X1 
          BX7    X1+X6
          SA7    A1 
          EQ     REDUCE1     GO CALL LDL TO PUT IN CONTROL POINT AREA 
 IS       ENDIF 
  
 IN       IFNOS 
          SA1    CTLPT       SET MAP BITS AND THE VALID BIT IN LOADER 
          MX0    4            CONTROL WORD
          LX0    -2 
 MAPLS1   SET    1
 MAPLS2   SET    0
 DP       DUP    -1 
          IFEQ   MAPLS2,S.CPLM-1,2
          STOPDUP 
          SKIP   2
 MAPLS1   SET    2*MAPLS1 
 MAPLS2   SET    MAPLS2+1 
 DP       ENDD
          SX6    X6+MAPLS1   ADD VALID MAP OPTIONS BIT
          LX6    54 
          BX1    -X0*X1 
          BX7    X1+X6
          SA7    A1 
          EQ     REDUCE1     GO STORE IN CONTROL POINT AREA 
 IN       ENDIF 
  
 MAPOPTS  BSS    0
          CON    3LOFF       MAP(OFF) 
          CON    4LPART+3    MAP(PART)
          CON    2LON+13B    MAP(ON)
          CON    4LFULL+17B  MAP(FULL)
          CON    0
          SPACE  4,8
 SRED     IFSCOPE 
**        REDUCE. 
* 
*              THE *REDUCE* CONTROL CARD CAUSES THE JOB TO BE IN REDUCE 
*         MODE TO ALLOW AUTOMATIC CM FIELD LENGTH MANAGEMENT. 
* 
*              THE *REDUCE(ECS)* CONTROL CARD CAUSES THE JOB-S ECS
*         FIELD LENGTH TO BE AUTOMATICALLY MANAGED BY THE OPERATING 
*         SYSTEM, BUT NOT BY CYBER LOADER.
* 
*              *LDL* IS CALLED TO SET THE OPTIONS INTO THE CONTROL
*         POINT AREA. 
  
 REDUCE   SA1    DFMFLAG
          NZ     X1,REDUCE0   IF MESSAGE ALREADY ISSUED 
          SA1    TPGM 
          SX1    X1+70B 
          MESSAGE X1,R,6     DAYFILE THE COMMAND (NOT TO TERMINAL)
          SX6    B1 
          SA6    DFMFLAG
 REDUCE0  LE     B7,B1,REDUCE2  IF NOT . OR ) 
          SA1    EF          SET REDUCE FLAG FOR REDUCTION
          SA2    CTLPT       AND SET FLAG IN CONTROL POINT AREA 
          MX7    1
          BX6    -X7*X1 
          SA6    A1 
          LX7    1+48-12*C.CPLR+S.CPLR
          BX7    X2+X7
          SA7    A2 
          EQ     REDUCE1     GO TO WRITE LCW BACK INTO CONTROL PT AREA
  
 REDUCE2  NE     B7,B1,CARDERR  IF NOT , OR ( 
          RJ     GNE         GET OPTION AND CODE
          LE     B7,B1,CARDERR  IF NOT . OR ) 
          MX1    42 
          BX1    X1*X5       (X1) = OPTION
          R=     X2,3RECS 
          LX2    59-17       (X2) = EXPECTED OPTION 
          BX1    X1-X2       COMPARE
          NZ     X1,CARDERR  IF NOT AS EXPECTED (ECS) 
          SA2    CTLPT       (X2) = LOADER CONTROL WORD 
          MX7    1
 S.CPLRE  CEQU   3 ********** TEMPORARY **********
          LX7    1+48-12*C.CPLR+S.CPLRE  POSITION BIT 
          BX7    X7+X2
          SA7    A2          SET BIT IN (CTLPT) 
 REDUCE1  SX1    B1          SET WRITE FLAG 
          SX2    B1+B1       FUNCTION CODE
          SX3    CTLPT
          R=     X4,W.CPLDR1
          LX1    24 
          LX3    36 
          BX6    X1+X2
          LX4    12 
          LX1    54-24
          BX7    X3+X4
          BX6    X6+X1
          BX6    X6+X7       6/1,18/CTLPT,12/1,12/W.CPLDR1,12/2 
          SA6    T1 
          LDL    A6 
 SRED     ENDIF 
 KRED     IFNOS 
**        REDUCE. 
* 
*         IF REDUCE. SET FIELD LENGTH REDUCTION, REDUCE BIT=0.
*         IF REDUCE(-) SET NO FIELD LENGTH REDUCTION, REDUCE BIT=1. 
* 
*         *CPM* IS CALLED VIA *GETLC* AND *SETLC* TO READ AND WRITE 
*         THE NEW REDUCE OPTION INTO THE LOADER CONTROL WORD. 
  
 REDUCE   LE     B7,B1,REDUCE2     IF NOT . OR )
          SA1    EF          SET REDUCE FLAG FOR REDUCTION
          SA2    CTLPT       AND SET FLAG IN CONTROL POINT AREA 
          MX7    1
          BX6    -X7*X1 
          SA6    A1          (EF) BIT 59 RESET IF REDUCE MODE 
          LX7    1+48-12*C.CPLR+S.CPLR
          BX7    -X7*X2 
          SA7    A2          (CTLPT) REDUCE BIT RESET 
          EQ     REDUCE1     GO TO SET LOADER CONTROL WORD
  
 REDUCE2  NE     B7,B1,CARDERR     IF NOT , OR (
          RJ     GNE         GET OPTION 
  
          SX1    6
          BX1    X1-X5       CHECK NULL PARAM WITH - SEPARATOR
          NZ     X1,CARDERR  IF NOT NULL PARAM WITH - SEPARATOR 
          RJ     GNE         GET OPTION AND CODE
  
          SX1    17B
          BX1    X1-X5       CHECK NULL PARAM AND TERMINATOR
          NZ     X1,CARDERR  IF NOT NULL PARAM WITH TERMINATOR
          SA1    EF          SET REDUCE FLAG FOR NO REDUCTION 
          SA2    CTLPT       AND SET FLAG IN CONTROL POINT AREA 
          MX7    1
          BX6    X7+X1
          SA6    A1          (EF) BIT 59 SET IF NO REDUCE MODE
          LX7    1+48-12*C.CPLR+S.CPLR
          BX7    X7+X2
          SA7    A2          (CTLPT) REDUCE BIT SET 
 REDUCE1  SETLC  CTLPT       SET LOADER CONTROL WORD
 KRED     ENDIF 
  
          SA1    CARDCT      IF *MAP* OR *REDUCE* IS THE FIRST
          NZ     X1,CARD     CONTROL CARD THEN EXIT,
          RJ     SPYOFF 
          R=     X6,4RENDP/16      ELSE CONTINUE LOAD SEQUENCE
          LX6    40D
          RJ     =XSYS= 
  
          SPACE  4
 DB       IFTEST NE,IP.LDBG,0 
  
**        LDPATCH(1247=5120 000123 0312 001255) 
* 
*              THE SPECIFIED WORD IS SET TO THE INDICATED VALUE.
* 
* 
*         LDPATCH(LOADX/5472=25 55 22050104 55 1124 57) 
* 
*                WHEN OVERLAY *LOADX* IS LOADED, THE WORD IS PLUGGED. 
  
 PAT      GT     B7,B1,PAT1  IF NO ARGUMENTS
 IS       IFSCOPE 
          R=     X1,W.CPLDR1 SET UP *LDL* CALL
          R=     X2,C.CPLP
          R=     X3,S.CPLP
          R=     X4,1 
          LX1    12 
          LX2    24 
          LX3    27 
          LX4    33 
          BX6    X1+X2
          BX7    X3+X4
          BX7    X6+X7
          SA7    T1 
          LDL    T1          DISABLE SYSTEM PRIVELEGES
 IS       ENDIF 
          RJ     SNC
          R=     X6,X6-1R0
          MI     X6,PAT2     IF PATCHING OVERLAY
          RJ     GOP         GET ADDRESS
          SX6    X6-1R= 
          NZ     X6,PAT1     IF NOT FOLLOWED BY = 
          SB4    X7          (B4) = ADDRESS 
          RJ     GOP         GET NEW CONTENTS 
          SX1    X6-1R. 
          SX6    X6-1R) 
          IX6    X1*X6
          NZ     X6,PAT1     IF NOT FOLLOWED BY . OR )
          SA7    B4          SAVE CORRECTED WORD
          EQ     CARD 
  
 PAT1     ERROR  CAT,(=C/ PATCH CARD ERROR./) 
  
 PAT2     RJ     GNE         GET OVERLAY NAME 
          BX1    X5 
          RJ     /MISC/LFNCK
          MI     X6,PAT1     IF IMPOSSIBLE OVERLAY NAME 
          SB7    B7+B1
          NZ     B7,PAT1     IF NOT FOLLOWED BY / 
          RJ     GOP         GET ADDRESS
          MX0    42 
          BX5    X0*X5
          BX7    -X0*X7 
          BX5    X5+X7       COMBINE NAME AND ADDRESS 
          SX6    X6-1R= 
          NZ     X6,PAT1     IF NOT FOLLOWED BY = 
          RJ     GOP         GET NEW CONTENTS 
          SX1    X6-1R. 
          SX6    X6-1R) 
          IX6    X1*X6
          NZ     X6,PAT1     IF NOT FOLLOWED BY . OR )
          ADDWRD TPAT,X7
          ADDWRD TPAT,X5
          EQ     CARD        EXIT 
  
 DB       ENDIF 
          SPACE  4,8
**        EXIT. 
* 
*              AN *EXIT* CONTROL CARD SHOULD NOT APPEAR IN A LOAD 
*         SEQUENCE.  IF IT DOES, AN ERROR MESSAGE IS ISSUED, AND THE
*         CPU IS DROPPED, THUS CAUSING *1AJ* TO PICK UP THE NEXT
*         CONTROL CARD, IF ANY, AFTER THE *EXIT* CARD.
  
 EXIT     MESSAGE (=C*  NO TERMINATOR IN ABOVE LOAD SEQUENCE*),RCL
          RJ     SPYOFF 
          R=     X6,4RENDP/16 
          LX6    40 
          RJ     SYS=        ENDRUN (DROP CP) 
          SPACE  4,8
**        FILES.
* 
*         *LDSET* OPTION - INTERNAL REQUEST IS BUILT. 
  
 FILES    NZ     B7,LDSETE   ERROR IF NO =
 FILES1   RJ     GNE         GET NEXT NAME
          BX1    X5 
          RJ     /MISC/LFNCK
          NG     X6,LDSETE   IF FORMAT BAD, ERROR 
          RJ     MOVEIN      PLACE NAME IN REQUEST TABLE
          SB2    B7+B1
          ZR     B2,FILES1   IF SEPARATOR IS /
          GE     B7,B1,LDSETR      MUST END WITH , OR ( OR . OR ) 
          EQ     LDSETE 
          SPACE  4,8
**        STAT. 
* 
*         *LDSET* OPTION - INTERNAL REQUEST IS BUILT. 
  
 STAT     EQU    FILES       PROCESSING IS IDENTICAL
 LOADC    SPACE  4,8
**        LOADC - PROCESS LOADER CONTROL CARDS. 
* 
*              THIS IS THE MAIN ROUTINE OF THE EXTERNAL REQUEST 
*         SCANNER.  IT PROCESSES THE 1ST LOADER CONTROL CARD, WHICH IS
*         IN RA+70 THRU RA+77.  IT THEN CALLS *ACE* TO READ UP AND
*         THEN PROCESS EACH SUCCESSIVE CARD UNTIL EITHER AN *EXECUTE*,
*         *NOGO*, OR PROGRAM CALL CARD IS ENCOUNTERED.
* 
*              CARD ERRORS ARE TREATED AS NON-FATAL, EXCEPT IN THE
*         FOLLOWING CASES IN WHICH THEY ARE TREATED AS FATAL -
*                1) THE LAST PARAMETER ON THE CARD IS NOT COMPLETED ON
*                   THAT CARD (I.E., FOLLOWED BY A SEPARATOR OR 
*                   TERMINATOR).
*                2) THE ERROR IS ON AN *EXECUTE*, *NOGO*, OR PROGRAM
*                   CALL CARD.  (TO GO ON WOULD INTRUDE ON CARDS WHICH
*                   WERE TO BE PAST THIS LOAD OPERATION.) 
  
  
 LOADC1   RJ     ACE         FETCH NEXT CONTROL CARD
 LOADC2   SA3    TPGM        SAVE CARD IMAGE FOR LOADED PROGRAM 
          SA0    TREQ        (A0) = MAIN REQUEST TABLE POINTER
          MOVE   8,COMLDCC,X3+COMLDCC 
          R=     X6,COMLDCC  (X6) = FWA OF CARD IMAGE 
          RJ     CARD        GO PROCESS THIS CARD 
          SA2    LASTCARD 
          ZR     X2,LOADC1   IF MORE CARDS TO FETCH 
 SEG      IFCARD
          SA1    SEGFLAG
          NZ     X1,CALLSEG  IF THIS IS A *SEGLOAD* RUN 
 SEG      ENDIF 
 LOADC    PS                 ENTRY/EXIT 
          EQ     LOADC2      GO PROCESS 1ST CONTROL CARD
 ACE      SPACE  4,8
**        ACE - FETCH NEXT CONTROL CARD.
* 
*         ENTRY  NONE.
*         EXIT   NEXT CONTROL CARD READ TO *COMLDCC* (RA+70FF). 
*                ERROR EXIT TAKEN IF NO MORE CONTROL CARDS. 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - NONE.
*                A - 1, 2, 3, 4, 6, 7.
*         CALLS  CIO=, CPM=, RDC=, RSR=, SVR=, SYS=, UPC=, WTC=.
  
  
 IS       IFSCOPE 
 ACE      PS                 ENTRY/EXIT 
          SA1    DFMFLAG
          NZ     X1,ACE1.1   IF MESSAGE ALREADY ISSUED
          SA1    TPGM 
          SX1    X1+70B 
          MESSAGE X1,R,6     ISSUE PREVIOUS COMMAND (NOT TO TERMINAL) 
          SX6    B1 
          SA6    DFMFLAG     SET DAYFILE MESSAGE ISSUED 
 ACE1.1   BSS    0
          SA1    TTFLAG 
          PL     X1,ACE1     IF READING FROM TERMINAL 
          R=     X6,10B      SET READ CODE FOR *ACE*
          SA1    ACECALL
          SA6    X1 
          BX6    X1          MAKE CALL TO *ACE* 
          RJ     SYS= 
          SA1    X6          CHECK EOR STATUS 
          LX1    59-4 
          PL     X1,ACE      IF MORE COMMANDS 
          SA1    RA.JOP 
          MX6    -12
          LX1    -24
          BX6    -X6*X1 
          SX6    X6-3 
          NZ     X6,EXIT     IF NOT INTERACTIVE JOB 
          SA1    ACEAI       CONNECT REQUEST
          BX6    X1 
          RJ     SYS= 
          SA1    ACEAO       CONNECT REQUEST
          BX6    X1 
          RJ     SYS= 
          SX6    1
          SA6    TTFLAG      READ FURTHER DIRECTIVES FROM TERMINAL
          RJ     SVR=        SAVE ALL REGISTERS 
          CIOCALL INPUT,R,READNR  OPEN INPUT FILE 
          EQ     ACE2 
  
 ACE1     RJ     SVR=        SAVE ALL REGISTERS 
 ACE2     WRITEC OUTPUT,PROMPT  MOVE PROMPT TO CIO BUFFER 
          WRITER OUTPUT,R 
  
 IS       ELSE
 ACE      PS                 ENTRY/EXIT 
          SA4    DFMFLAG
          NZ     X4,ACE0     IF PREVIOUS COMMAND DAYFILED 
          SX7    B1 
          SA7    A4          INDICATE COMMAND DAYFILED
          MESSAGE COMLDCC,R  DAYFILE COMMAND
 ACE0     SA1    TTFLAG 
          PL     X1,ACE1     IF NOT FIRST CALL TO *ACE* 
  
*         ON FIRST CALL, DETERMINE WHETHER TO READ CONTROL STATEMENTS 
*         FROM FILE *INPUT*, RATHER THAN VIA *TCS*.  *INPUT* IS USED
*         ONLY IF JOB IS INTERACTIVE AND NOT INSIDE A PROCEDURE.
  
          MX6    0           SET FOR *TCS* READ 
          SA6    A1 
          GETJO  JOBWDS      DETERMINE JOB ORIGIN 
          SA1    JOBWDS 
          SX2    X1-IAOT
          NZ     X2,ACE2     IF NOT INTERACTIVE, USE *TCS*
          GETJCI JOBWDS      DETERMINE IF IN AN INTERACTIVE PROCEDURE 
          SA1    JOBWDS 
          MX6    -6 
          LX1    -24
          BX1    -X6*X1      PROCEDURE NESTING LEVEL
          SX7    B1 
          NZ     X1,ACE2     IF IN A PROCEDURE, USE *TCS* 
          SA7    TTFLAG      SET TO READ STATEMENTS FROM *INPUT*
          EQ     ACE4        GO READ FROM *INPUT* 
  
 ACE1     NZ     X1,ACE5     IF TO READ FROM *INPUT*
  
*         READ CONTROL STATEMENT FROM JOB STREAM USING *TCS*. 
  
 ACE2     SA4    ACEL        *TCS* CALL TO READ STMT / NOT ADVANCE/ 
          BX6    X4           NOT DAYFILE / SET LOCAL FILE BIT /
          RJ     SYS= 
          SA1    COMARGCT    GET RA+64B 
          LX1    59-17       LOCAL FILE BIT TO SIGN POSITION
          SX6    B1 
          PL     X1,ACE3     IF NOT LOCAL FILE
          SA6    //LOCFILE   SET FLAG FOR LOCAL FILE LOAD 
          ERRNZ  ACEL+1-ACEA
 ACE3     SA4    A4+B1       *TCS* CALL TO READ, DAYFILE, AND CRACK 
          BX6    X4 
          RJ     SYS= 
          MX7    0           INDICATE COMMAND HAS NOT BEEN DAYFILED 
          SA7    DFMFLAG
          SA1    COMLDCC
          NZ     X1,ACE      IF A VALID STATEMENT WAS READ, EXIT
          EQ     ACE30       ERROR EXIT 
  
*         READ CONTROL STATEMENT FROM FILE *INPUT*. 
  
 ACE4     CIOCALL INPUT,R,READNR  OPEN INPUT FILE 
          SA1    INPUT+1     GET DEVICE CODE FROM FET 
          LX1    12 
          MX2    -12
          BX2    -X2*X1 
          SX2    X2-2RTT
          NZ     X2,ACE30    IF INPUT NOT ASSIGNED *TT*, ERROR
 ACE5     RJ     SVR=        SAVE REGISTERS 
          WRITEC OUTPUT,PROMPT  MOVE PROMPT MESSAGE TO CIO BUFFER 
          SA1    PFLUSH      READ AUTO FLUSH INFO WORD
          BX6    X1 
          SA6    COMARGS     STORE AUTO FLUSH INFO IN RA+2
 IS       ENDIF 
          READ   INPUT       GET THE RESPONSE INTO THE CIO BUFFER 
*         READC  INPUT,COMLDCC,8  READ CODED LINE INTO RA+70
          SX2    INPUT       ADDRESS OF FET 
          SB6    COMLDCC     ADDRESS OF WORK AREA 
          SB7    10B         WORK AREA SIZE 
          RJ     RDC=        READ CODED LINE
          NZ     X1,ACE30    IF NO DATA TRANSFERED, ERROR 
  
*         PROCESS STATEMENT BY EXAMINING CHARACTER-BY-CHARACTER,
*         REMOVING ANY CAROT (^) CHARACTERS, AND STORING BACK.  ALSO, 
*         ADD A PERIOD (.) TO THE END OF THE STATEMENT, IF NOT ALREADY
*         TERMINATED BY EITHER A PERIOD OR A RIGHT PAREN. 
  
          SB2    COMLDCC-1   (B2) = FETCH POINTER 
          MX0    -6          (X0) = LOW-ORDER CHAR MASK FOR FETCH 
          SB3    B2          (B3) = STORE POINTER 
          SB5    60          (B5) = STORE CHAR POSITION 
          MX7    0           (X7) = INITIALIZED STORE WORD
 ACE8     SB2    B2+B1       ADVANCE FETCH POINTER
          SB4    10          (B4) = CHAR FETCH CONTROL
          EQ     B2,B6,ACE12  IF ALL WORDS PROCESSED
          SA1    B2          FETCH NEXT WORD
 ACE9     LX1    6           POSITION TO NEXT CHARACTER 
          SB4    B4-B1       ADVANCE CHAR COUNT 
          BX2    -X0*X1      GET NEXT CHAR
          SX3    X2-1R^ 
          ZR     X3,ACE11    IF ESCAPE CHAR, DO NOT STORE 
          NZ     B5,ACE10    IF CURRENT STORE WORD NOT COMPLETE 
          SB5    60 
          SB3    B3+B1       ADVANCE STORE POINTER
          SA7    B3          STORE WORD 
          MX7    0           INITIALIZE NEW STORE WORD
 ACE10    SB5    B5-6 
          LX2    X2,B5       POSITION CHAR TO STORE 
          BX7    X7+X2       PUT CHAR IN STORE WORD 
 ACE11    ZR     B4,ACE8     IF CURRENT FETCH WORD COMPLETE 
          EQ     ACE9        GO GET NEXT CHAR 
  
 ACE12    SB3    B3+B1       ADVANCE STORE POINTER
          SA1    =1L.        (X1) = PERIOD FOR INSERTION IN ANY POSITION
          BX2    -X0*X7 
          SB7    COMLDCC+7
          ZR     X2,ACE13    IF ZERO-CHAR AT BOTTOM OF PARTIAL WORD 
          SX3    X2-1R
          ZR     X3,ACE13    IF BLANK AT BOTTOM OF PARTIAL WORD 
          SA7    B3          FINAL WORD WAS ACTUALLY FULL - STORE IT
          BX6    X1          (X6) = PERIOD IN UPPER-MOST CHAR POSITION
          EQ     B3,B7,ACE18 IF 80 CHARS AND NO PERIOD, DONT STORE ONE
          SX3    X2-1R. 
          ZR     X3,ACE17    IF ALREADY A PERIOD AT END 
          SX3    X2-1R) 
          ZR     X3,ACE17    IF ALREADY A RIGHT PAREN AT END
          SA6    A7+B1       STORE PERIOD IN UPPER CHAR OF NEXT WORD
          SB3    B3+B1
          EQ     ACE17       GO FILL OUT ANY MORE WORDS WITH ZEROS
  
 ACE13    BX7    X0*X7       MAKE LOWER CHAR = 0 IF BLANK BEFORE
          BX2    X7          (X2) = WORD FOR CHECKING 
          BX5    X0          (X5) = MASK TO CLEAR NEXT-HIGHER CHAR
 ACE14    LX1    6           SCAN BACKWARD FOR THE LAST NON-ZERO, 
          LX2    -6           NON-BLANK CHAR
          LX5    6
          BX3    -X0*X2 
          ZR     X3,ACE15    IF ANOTHER ZERO-CHAR 
          SX4    X3-1R
          ZR     X4,ACE15    IF ANOTHER BLANK 
          SX4    X3-1R. 
          ZR     X4,ACE16    IF LAST CHAR IS PERIOD 
          SX4    X3-1R) 
          ZR     X4,ACE16    IF LAST CHAR IS RIGHT PAREN
          BX7    X7+X1       INSERT PERIOD
          EQ     ACE16       GO STORE PARTIAL WORD
  
 ACE15    BX7    X7*X5       MAKE SURE BLANK BECOMES ZERO 
          NZ     X7,ACE14    LOOP UNLESS ALL CHARS MADE ZERO
          SX1    B3-COMLDCC 
          ZR     X1,ACE16    IF ENTIRE STATEMENT EMPTY
          SB3    B3-2        BACK UP A WORD IN ORDER TO LOOK AT LOWER-
          SA1    B3+B1        MOST CHAR IN PREVIOUS WORD
          BX7    X1 
          EQ     ACE12
  
 ACE16    SA7    B3          STORE PARTIAL WORD 
 ACE17    EQ     B3,B7,ACE18  FILL OUT REMAINING WORDS WITH ZEROS 
          MX6    0
          SB3    B3+B1
          SA6    B3 
          EQ     ACE17
  
 ACE18    BSS    0
  
 IS       IFSCOPE 
 ACE21    SX6    COMLDCC     ADDRESS OF MESSAGE 
          SA1    ACEMSG      MESSAGE REQUEST
          LX6    30          ADDRESS OF MESSAGE 
          SA6    ACEMSGA     INDIRECT MESSAGE ADDRESS 
          BX6    X1 
          RJ     SYS=        MAKE MESSAGE REQUEST 
          SX6    B1 
          SA6    DFMFLAG     INDICATE MESSAGE ISSUED
 IS       ELSE
 ACE21    MX7    0           INDICATE COMMAND HAS NOT BEEN DAYFILED 
          SA7    DFMFLAG
 IS       ENDIF 
          RJ     UPC=        UNPACK CONTROL STATEMENT 
          NZ     X6,ACE30    IF CONTROL STATEMENT HAS ERROR(S)
          RJ     RSR=        RESTORE REGISTERS
          EQ     ACE         RETURN 
  
 ACE30    ERROR  CAT,(=C* ILLEGAL LOADER CONTROL STATEMENT*)
  
 IS       IFSCOPE 
 PROMPT   DATA   5L LDR>     INTERACTIVE PROMPT 
 BUFL     EQU    10B         INTERACTIVE BUFFER SIZE
 IS       ELSE
 JOBWDS   BSSZ   2           PARAMETER AREA FOR *GETJO*, *GETJCI* 
 PROMPT   VFD    24/4LLDR>,6/0,6/1LK,24/0    NO CARRIAGE RETURN 
 PFLUSH   VFD    42/0LOUTPUT,18/OUTPUT  AUTO FLUSH INFO 
 BUFL     EQU    10B         INTERACTIVE BUFFER SIZE
 IS       ENDIF 
 IS       IFSCOPE 
          CON    0           LAST FUNCTION CODE 
 INPUT    VFD    42/0LZZZZZIN,18/3  INTERACTIVE INPUT FET 
          VFD    12/0,24/0,6/2,18/CIOBUF
          VFD    42/0,18/CIOBUF 
          VFD    42/0,18/CIOBUF 
          VFD    42/0,18/CIOBUF+BUFL+1
          BSSZ   2
          CON    0           LAST FUNCTION CODE 
 OUTPUT   VFD    42/0LZZZZZOU,18/3  INTERACTIVE OUTPUT FET
          VFD    12/0,24/0,6/2,18/CIOBUF1 
          VFD    42/0,18/CIOBUF1
          VFD    42/0,18/CIOBUF1
          VFD    42/0,18/CIOBUF1+BUFL+1 
          BSSZ   2
 CIOBUF   BSS    BUFL        INPUT FILE BUFFER
 CIOBUF1  BSS    BUFL        OUTPUT FILE BUFFER 
 IS       ELSE
          CON    0           LAST FUNCTION CODE 
 INPUT    VFD    42/0LINPUT,18/3   INTERACTIVE *INPUT* FET
          VFD    12/0,24/0,6/2,18/CIOBUF
          VFD    42/0,18/CIOBUF 
          VFD    42/0,18/CIOBUF 
          VFD    42/0,18/CIOBUF+BUFL+1
          BSSZ   2
          CON    0           LAST FUNCTION CODE 
 OUTPUT   VFD    42/0LOUTPUT,18/3  INTERACTIVE *OUTPUT* FET 
          VFD    12/0,24/0,6/2,18/CIOBUF
          VFD    42/0,18/CIOBUF 
          VFD    42/0,18/CIOBUF 
          VFD    42/0,18/CIOBUF+BUFL+1
          BSSZ   2
 CIOBUF   BSS    BUFL 
 IS       ENDIF 
  
 IS       IFSCOPE 
 ACEAI    VFD    24/4LCONP,12/0,6/0,18/ACEAI+1
          VFD    42/0LZZZZZIN,18/0
 ACEAO    VFD    24/4LCONP,12/0,6/0,18/ACEAO+1
          VFD    42/0LZZZZZOU,18/0
 ACECALL  VFD    24/4LACEP,12/3,6/0,18/ACEFUNC  DAYFILE AND CRACK 
 ACEFUNC  CON    0           FUNCTION CODE
 ACEMSG   VFD    24/4LMSGP,12/6,6/0,18/ACEMSGA  DAYFILE MESSAGE 
 ACEMSGA  DATA   0
 IS       ELSE
 ACEL     VFD    24/4LTCSP,18/402B,18/COMLDCC 
 ACEA     VFD    24/4LTCSP,18/440B,18/COMLDCC 
 IS       ENDIF 
 ACEB     CON    COMARGS-1   ADDRESS-1 OF FIRST PARAMETER 
          SPACE  4
**        CLF - CHECK IF NAME IS A LOCAL FILE.
* 
*         ENTRY  (X5) = 42/0LNAME,18/CODE 
*                (CARDCT) =0 IFF PROCESSING FIRST CONTROL CARD
* 
*         EXIT   (LOCFILE) = NONZERO IFF LOCAL FILE FOUND 
* 
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - NONE.
* 
*         CALLS  LDL (IFF SCOPE) TO DETERMINE IF FILE IS LOCAL
* 
*         CALLS  LFM= (IFF NOT SCOPE) (STATUS CODE 12) TO DETERMINE 
*                IF WE HAVE A LOCAL FILE.  THIS IS DONE ONLY FOR THE
*                FIRST CONTROL CARD.  SUBSEQUENT CONTROL CARDS ARE
*                HANDLED BY THE *TCS* CALLS IN ROUTINE *ACE*. 
*                IF THE RUN(G) FLAG (RUNG) IS SET NEGATIVE
*                THEN WE ALREADY KNOW THAT WE HAVE A LOCAL FILE.
* 
  
 S        IFSCOPE 
 CLF      PS                 ENTRY/EXIT 
          MX6    42 
          BX6    X5*X6
          R=     X1,6 
          BX6    X6+X1       (X6)=42/0LNAME,12/0,6/6(=LDL CODE) 
          SA6    T1          (T1)=LDL PARAMETER WORD
          LDL    A6          CALL *LDL* TO CHECK IF LOCAL FILE
          SA1    T1          GET *LDL* RETURN INFO (BITS 12-17) 
          MX6    -6 
          AX1    12 
          BX6    -X6*X1      (X6)=0 IFF NAME IS LOCAL FILE
          NZ     X6,CLF      IF NOT LOCAL FILE THEN RETURN
          SX6    B1 
          SA6    //LOCFILE   IF LOCAL FILE SET (LOCFILE)=1
          EQ     CLF         RETURN 
 S        ENDIF 
 K        IFNOS 
 CLF      PS                 ENTRY/EXIT 
          SA1    TTFLAG      IF READING FROM TERMINAL, ALWAYS CHECK FOR 
          NZ     X1,ITSTT     LOCAL FILE
          SA1    CARDCT 
          NZ     X1,CLF      IF NOT FIRST CARD THEN RETURN
 ITSTT    BSS    0
          SA1    RUNG 
          MI     X1,CLF1     IF RUN(G) CALL THEN ITS A LOCAL FILE 
          MX6    42 
          BX6    X5*X6
          SX1    B1 
          BX6    X6+X1       (X6)=42/0LNAME,18/1
          SA6    T1          (T1)=LFM (STATUS 12) PARAM WORD
          STATUS T1 
          SA1    T1          GET *LFM* RETURN INFO (BITS 1-11)
          MX6    49 
          LX1    -1 
          BX6    -X6*X1      (X6)=0 IFF NOT LOCAL FILE
          ZR     X6,CLF      IF NOT LOCAL FILE THEN RETURN
 CLF1     SX6    B1 
          SA6    //LOCFILE   IF LOCAL FILE SET (LOCFILE)=1
          EQ     CLF         RETURN 
 K        ENDIF 
  
 IC       IFCARD
 SVR=     SPACE  4,10 
**        SVR= - SAVE REGISTERS.
* 
*              THIS ROUTINE SAVES THE FOLLOWING REGISTERS.  CURRENTLY,
*         NO OTHER, MORE GENERAL REGISTER-SAVING ROUTINE IS USED BY THE 
*         LOADER: 
* 
*                X - 0, 5.
*                B - 2, 3, 4, 5, 6, 7.
*                A - 0, 5.
* 
*         ENTRY  (B1) = 1.
* 
*         EXIT   (B1) = 1.
*                REGISTERS SAVED. 
  
  
 SVR=     EQ     *+1S17      ENTRY/EXIT 
          BX7    X5 
          SX6    A5-B0
          SA7    SVRAR+SVN-1 SAVE (X5)
          SA6    A7-B1       SAVE (A5)
          BX7    X0 
          SX6    A0-B0
          SA7    A6-B1       SAVE (X0)
          SA6    A7-B1       SAVE (A0)
          SX7    B7-B0
          SX6    B6-B0
          SA7    A6-B1       SAVE (B7)
          SA6    A7-B1       SAVE (B6)
          SX7    B5-B0
          SX6    B4-B0
          SA7    A6-B1       SAVE (B5)
          SA6    A7-B1       SAVE (B4)
          SX7    B3-B0
          SX6    B2-B0
          SA7    A6-B1       SAVE (B3)
          SA6    A7-B1       SAVE (B2)
          EQ     SVR=        RETURN 
  
 SVN      EQU    2+2+6       NUMBER OF REGISTERS TO SAVE (2*X+2*A+6*B)
 SVRAR    BSSZ   SVN         SAVE AREA FOR B2-7, A0, X0, A5, X5 
 RSR=     SPACE  4,10 
**        RSR= - RESTORE REGISTERS. 
* 
*              THIS ROUTINE RESTORES THE REGISTERS SAVED BY *SVR=*. 
* 
*         ENTRY  (B1) = 1.
* 
*         EXIT   (B1) = 1.
*                REGISTERS RESTORED.
  
  
 RSR=     EQ     *+1S17      ENTRY/EXIT 
          SA1    SVRAR
          SA2    A1+B1
          SA3    A2+B1
          SA4    A3+B1
          SB2    X1-0        RESTORE (B2) 
          SA1    A4+B1
          SB3    X2-0        RESTORE (B3) 
          SB4    X3-0        RESTORE (B4) 
          SB5    X4-0        RESTORE (B5) 
          SA2    A1+B1
          SA3    A2+B1
          SB6    X1-0        RESTORE (B6) 
          SB7    X2-0        RESTORE (B7) 
          SA1    A3+B1
          SA2    A1+B1
          SA0    X3-0        RESTORE (A0) 
          BX0    X1          RESTORE (X0) 
          SA3    A2+B1
          SA5    X2          RESTORE (A5) 
          BX5    X3          RESTORE (X5) 
          EQ     RSR=        RETURN 
  
 IC       ENDIF 
  
  
 SCAN     ENDIF 
  
          USE    // 
          QUAL
          IFUSER 1
          CON    0           ENTRY/EXIT FROM RELOCATOR
