*DECK LDRCNTL 
          IDENT  LDRCNTL,ORIGIN 
          ABS 
          SPACE  4
          SST    RA 
          TITLE  LDRCNTL - PROCESS CYBER LOADER CONTROL CARDS 
          SPACE  4
***       LDRCNTL -  PROCESS CYBER LOADER CONTROL CARDS 
*         C. J. LABATE.      74/09/30.
* 
*         CONTROL DATA PROPRIETARY PRODUCT
*         COPYRIGHT CONTROL DATA CORP. - 1976, 1977, 1978, 1979, 1980,
*         1981, 1982. 
          SPACE  4
***       LDRCNTL PROCESSES THE CYBER LOADER CONTROL CARDS WHICH
*         DO NOT CAUSE THE CYBER LOADER TO BE LOADED AND WHICH
*         DO NOT BEGIN A LOAD SEQUENCE.  THESE ARE CURRENTLY
*         *LIBRARY*, *MAP*, AND *REDUCE*.  ALL OTHER CYBER LOADER 
*         CONTROL CARDS ARE PROCESSED BY THE CYBER LOADER PROPER
*         AND DO BEGIN A LOAD SEQUENCE. 
          SPACE  4
**        THIS ROUTINE IS AN ABSOLUTE CPU PROGRAM.  IT IS WRITTEN 
*         TO RUN ON THE SCOPE 3.4 AND KRONOS 2.1/NOS 1.0 OPERATING
*         SYSTEMS.  DUE TO OPERATING SYSTEM DIFFERENCES CONDITIONALLY 
*         ASSEMBLED CODE IS USED WHERE COMMON CODE IS NOT POSSIBLE. 
*         UNDER SCOPE 3.4 THE PPU PROGRAM *LDL* IS USED TO AFFECT 
*         CHANGES TO THE CONTROL POINT AREA.  UNDER KRONOS/NOS THE
*         PPU PROGRAM *CPM* IS USED TO AFFECT CHANGES TO THE
*         CONTROL POINT AREA.  THE *IPARAMS* MACRO IS USED TO 
*         OBTAIN *OS.NAME* WHICH WILL BE USED TO KEY CONDITIONAL
*         ASSEMBLY ACCORDING TO THE *IFSCOPE* AND *IFNOS* MACROS. 
          TITLE  IPARAMS AND MACRO DEFINITIONS
          SPACE  4
**        *LDRCOM* IS CALLED. 
          SPACE  4
*CALL LDRCOM
          SPACE  4
**        *IPARAMS* IS CALLED TO OBTAIN *OS.NAME*.
          SPACE  4
          IPARAMS 
          SPACE  4
**        *IFSCOPE* AND *IFNOS* MACROS ARE DEFINED. 
          SPACE  4
          IFMACS
          SPACE  4,8
**        *IFGLS* AND *IFNOTGLS* MACROS ARE DEFINED.
          SPACE  4,8
          IFGLSMAC
          SPACE  4
          SPACE  4
**        THE MACROS *SETLC*, *GETLC*, AND *SETGLS* ARE DEFINED.
          SPACE  4
 K        IFNOS 
**        SETLC - SET LOADER CONTROL WORD, KRONOS/NOS FORMAT
*               - COPY OF *SETLC* AS IN *COMCMAC* 
* 
*         SETLC  ADR
* 
*         ENTRY  *ADR* = ADDRESS OF NEW LOADER CONTROL WORD 
* 
*         CALLS  CPM= 
  
          PURGMAC SETLC 
 SETLC    MACRO  ADR
          SX1    ADR
          SX2    22B
          RJ     =XCPM= 
          ENDM
          SPACE  4
**        GETLC - GET LOADER CONTROL WORD, KRONOS/NOS FORMAT
*               - COPY OF *GETLC* AS IN *COMCMAC* 
* 
*         GETLC  ADR
* 
*         ENTRY  *ADR* = ADDRESS FOR RESPONSE 
* 
*         CALLS  CPM= 
  
          PURGMAC GETLC 
 GETLC    MACRO  ADR
          SX1    ADR
          SX2    45B
          RJ     =XCPM= 
          ENDM
          SPACE  4
**        SETGLS - SET GLOBAL LIBRARY SET, KRONOS/NOS FORMAT
*                - COPY OF *SETGLS* AS IN *COMCMAC* 
* 
*         SETGLS ADR
* 
*         ENTRY  *ADR* = ADDRESS OF PARAMETER WORD
*                (ADR) = 6/1,18/FWA BUFFER,36/0 
*                (BUFFER) = LIST OF NAMES, LEFT JUST, ZERO FILLED,
*                           ONE PER WORD, TERMINATED BY ZERO WORD.
* 
*         CALLS  CPM= 
  
          PURGMAC SETGLS
 SETGLS   MACRO  ADR
          SX1    ADR
          SX2    47B
          RJ     =XCPM= 
          ENDM
 K        ENDIF 
          SPACE  4
 S        IFSCOPE 
**        SETLC - SET LOADER CONTROL WORD, SCOPE FORMAT 
* 
*         SETLC  ADR
* 
*         ENTRY  *ADR* = ADDRESS OF LOADER CONTROL WORD 
* 
*         CALLS  LDL= 
  
          PURGMAC SETLC 
 SETLC    MACRO  ADR
          SA1    L2W
          SX2    ADR
          LX2    36D
          BX1    X1+X2
          RJ     =XLDL= 
          ENDM
          SPACE  4
**        GETLC - GET LOADER CONTROL WORD, SCOPE FORMAT 
* 
*         GETLC  ADR
* 
*         ENTRY  *ADR* = ADDRESS FOR RESPONSE 
* 
*         CALLS  LDL= 
  
          PURGMAC GETLC 
 GETLC    MACRO  ADR
          SA1    L2R
          SX2    ADR
          LX2    36D
          BX1    X1+X2
          RJ     =XLDL= 
          ENDM
          SPACE  4
**        SETGLS - SET GLOBAL LIBRARY SET, SCOPE FORMAT 
* 
*         SETGLS ADR
* 
*         ENTRY  *ADR* = ADDRESS OF PARAMETER WORD
*                (ADR) = 6/1,18/FWA BUFFER,36/0 
*                (BUFFER) = LIST OF NAMES, LEFT JUST, ZERO FILLED,
*                           ONE PER WORD, TERMINATED BY ZERO WORD.
* 
*         CALLS  LDL= 
  
          PURGMAC SETGLS
 SETGLS   MACRO  ADR
          SA1    ADR
          SX2    4
          BX1    X1+X2
          RJ     =XLDL= 
          ENDM
 S        ENDIF 
          SPACE  4
**        ENDRUN - END CENTRAL PROGRAM
* 
*         ENDRUN
* 
*         CALLS  SYS= 
  
          PURGMAC ENDRUN
 ENDRUN   MACRO 
          SX6    3REND*4+1   FORM *END* REQUEST 
          LX6    40D
          RJ     =XSYS= 
          ENDM
          SPACE  4
**        ABORT - ABORT CENTRAL PROGRAM.
* 
*         ABORT 
* 
*         CALLS  SYS= 
  
          PURGMAC ABORT 
 ABORT    MACRO 
          SX6    3RABT*4+1   FORM *ABT* REQUEST 
          LX6    40D
          RJ     =XSYS= 
          ENDM
          SPACE  4
**        MESSAGE - DISPLAY MESSAGE 
* 
*         MESSAGE MESSAGE,OPTION,RECALL 
* 
*         ENTRY  *MESSAGE* = ADDRESS OF MESSAGE IN *C* FORMAT.
*                *OPTION* = DISPLAY OPTION AS FOLLOWS --
* 
*                BLANK = SEND MESSAGE TO SYSTEM DAYFILE, A-DISPLAY, 
*                        LOCAL JOB DAYFILE, AND B-DISPLAY.
* 
*                *LOCAL* = SEND MESSAGE TO LOCAL DAYFILE AND B-DISPLAY. 
* 
*                OTHER = SEND MESSAGE TO B-DISPLAY ONLY.
* 
*         CALLS  MSG= 
  
          PURGMAC MESSAGE 
 MESSAGE  MACRO  M,X,L
          IFC    EQ, L  ,9D 
*                                  AUTORECALL NOT SPECIFIED 
          IFC    EQ, X  ,2
*                                  X = BLANK
          BX6    X6-X6
          SKIP   16D
*                                  X = NONBLANK 
          MX6    1
          IFC    EQ, X LOCAL ,2 
*                                  X = LOCAL
          LX6    1
          SKIP   12D
*                                  X = OTHER
          LX6    7
          SKIP   10D
*                                  AUTORECALL SPECIFIED 
          MX6    1
          IFC    NE, X  ,1
*                                  X = NONBLANK 
          BX1    X6 
*                                  X = ANY
          LX6    23D
          IFC    NE, X  ,5
          IFC    EQ, X LOCAL ,2 
*                                  X = *LOCAL*
          LX1    1
          SKIP   1
*                                  X = OTHER
          LX1    7
*                                  X = NONBLANK 
          BX6    X6+X1
*                                  SET PARAMETER ADDRESS
          SX1    M
*                                  PROCESS MESSAGE REQUEST
          RJ     =XMSG= 
          ENDM
          TITLE  CONSTANT/VARIABLE DEFINITIONS
          SPACE  4
          IFSCOPE 
 ORIGIN   EQU    103B 
          ELSE
 ORIGIN   EQU    105B 
          ENDIF 
  
          ORG    ORIGIN 
          SPACE  4
 COMNP    EQU    64B         WORD CONTAINING PARAMETER COUNT
 COMXJ    EQU    66B         WORD CONTAINING EXCHANGE JUMP FLAG 
 S        IFSCOPE 
 L2W      VFD    6/1,18/0,12/1,12/W.CPLDR1,12/2   LDL CODE 2 WRITE
 L2R      VFD    6/0,18/0,12/1,12/W.CPLDR1,12/2   LDL CODE 2 READ 
 LPW      BSSZ   1           LDL PARAMETER WORD 
 LKL      VFD    24/0LLDLP,36/LPW  LDL REQUEST WORD 
 S        ENDIF 
 LCW      BSSZ   1           LOADER CONTROL WORD
 SGS      VFD    6/1,18/2,36/0     *SETGLS* PARAM WORD IMAGE
 PW       BSSZ   1           PARAMETER WORD 
          TITLE  SUBROUTINES AS NEEDED
          SPACE  4
**        SYS -  PROCESS SYSTEM REQUEST.
* 
*         THIS ROUTINE ISSUES RA+1 REQUESTS 
* 
*         ENTRY  (X6) = SYSTEM REQUEST. 
*         EXIT   REQUEST PROCESSED. 
*         USES   X - 1,6. 
*                B - NONE 
*                A - 1,6. 
*         CALLS  NONE.
  
          BASE   D
 SYSA     SA1    A1          WAIT RA+1 CLEAR IF AUTO RECALL 
          LX1    59-40
          MI     X1,SYS1
 SYS1     EQ     SYS2        FIRST ENTRY
 SYS=     PS
 +        SA1    1           WAIT RA+1 CLEAR
          NZ     X1,* 
          SA6    A1          ENTER REQUEST
          EQ     SYS1 
*         INITIAL ENTRY TO SET TYPE OF CALL 
 SYS2     SA1    SYSA        SET FOR NO CENTRAL EXCHANGE JUMP 
          BX6    X1 
          SA1    COMXJ
          PL     X1,SYS3     IF CEJ NOT SUPPORTED 
          SX6    0130B       XJ INSTRUCTION 
          LX6    48 
 SYS3     SA6    SYS1        SET MONITOR CALL 
          SA1    1           RESTORE (A1) 
          BX6    X1 
          RJ     SYSA        CLEAR STACK
          BASE   *
          SPACE  4
**        MSG - SEND MESSAGE
* 
*         ENTRY  (X1) = ADDRESS OF MESSAGE. 
*                (X6) = MESSAGE OPTIONS.
*                       BIT 22 = AUTORECALL 
*                       BITS 17-0 = MESSAGE OPTION. 
* 
*         EXIT   RETURN WHEN OPERATION COMPLETE.
* 
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - NONE.
* 
*         CALLS  SYS= 
  
 MSG1     SX6    3RMSG*2     FORM MESSAGE REQUEST 
          BX6    X6+X1
          LX6    40-59
          RJ     =XSYS=      PROCESS REQUEST
 MSG=     PS                 ENTRY/EXIT 
          LX6    18          MERGE OPTIONS AND ADDRESS
          BX1    X6+X1
          SX6    X1 
          LX1    59-40
          PL     X1,MSG1     IF NO AUTORECALL 
          LX1    40-59
          BX1    X1-X6       REMOVE MESSAGE ADDRESS 
          LX6    30 
          SA6    MSGA        STORE STATUS WORD
          SX6    A6 
          IX1    X1+X6       SET INDIRECT ADDRESS 
          LX1    59-40
          EQ     MSG1 
  
 MSGA     VFD    30/0,30/0   STATUS WORD FOR MESSAGE AUTORECALL 
 S        IFSCOPE 
          SPACE  4
**        LDL -  CALL LDL TO AFFECT CONTROL POINT CHANGES 
* 
*         ENTRY  (X1) = LDL PARAMETER WORD
*         EXIT   CALL HAS BEEN MADE 
* 
*         USES   X - 2,6. 
*                B - NONE 
*                A - 2,6
* 
*         CALLS  SYS= 
  
 LDL=     PS                 ENTRY/EXIT 
          BX6    X1 
          SA6    LPW         SETUP PARAMETER WORD 
          SA2    LKL         *LDL* CALL WORD
          BX6    X2 
          RJ     =XSYS=      CALL *LDL* 
          EQ     LDL=        EXIT 
 S        ENDIF 
 K        IFNOS 
          SPACE  4
**        CPM -  CALLS *CPM* TO PERFORM TASKS INVOLVING CONTROL 
*                POINT ACTIVITY.
* 
*         LOCAL COPY OF *COMCCPM*.
* 
*         ENTRY  (X1) = PARAMETER 
*                (X2) = REQUEST 
* 
*         EXIT   NONE.
* 
*         USES   X - 1, 2, 6. 
*                A - NONE.
*                B - NONE.
* 
*         CALLS  SYS= 
  
 CPM1     RJ     =XSYS= 
 CPM=     PS
          MX6    -24
          BX1    -X6*X1 
          LX2    24D
          SX6    4RCPMP/16
          BX1    X2+X1
          LX6    40D
          BX6    X6+X1
          EQ     CPM1 
 K        ENDIF 
          SPACE  4
**        FMT -  SUBROUTINE *FMT* TO VALIDATE A FILE NAME.
*                NAME MUST BE 1 TO 7 ALPHANUMERIC CHARACTERS, 
*                LEFT JUSTIFIED, ZERO FILLED, FIRST CHARACTER ALPHA.
* 
*         ENTRY  (B6)=ADDRESS OF FILE NAME
*                (B1)=1 
*         EXIT   (X0)=0 IF VALID FORMAT 
*                (X0)=1 IF INVALID FORMAT 
*                (B6)=ADDRESS OF FILE NAME
* 
*         REG USED X - 0, 1, 2, 3, 5. 
*                  A - 1. 
*                  B - 2, 3.
* 
  
 IS       IFNOTGLS
  
 FMT      PS                 ENTRY/EXIT 
          SA1    B6          GET NAME 
          ZR     X1,FMTE     IF EMPTY NAME
          SX0    B0          VALID FORMAT RETURN INFO 
          MX5    -6 
          SB2    B0 
          SB3    7
 FMT1     LX1    6           SHIFT FOR NEXT CHAR
          BX2    -X5*X1      (X2)=NEXT CHAR 
          BX1    X5*X1       REMOVE THIS CHAR FROM (X1) 
          ZR     X2,FMT2     IF END OF NAME 
          SX3    X2-1R+ 
          PL     X3,FMTE     IF NOT ALPHANUMERIC
          SB2    B2+B1
          GT     B2,B3,FMTE  IF TOO MANY CHARS
          NE     B2,B1,FMT1  IF NOT FIRST CHAR
          SX3    X2-1R0 
          NG     X3,FMT1     IF FIRST CHAR ALPHA
          EQ     FMTE 
 FMT2     ZR     X1,FMT      IF ZERO FILL AFTER TERMINATOR, EXIT
 FMTE     SX0    B1          SET INVALID FORMAT 
          EQ     FMT         EXIT 
  
 IS       ENDIF 
          TITLE  PROCESS *REDUCE* CONTROL CARD
***       *REDUCE* CONTROL CARD PROCESSING. 
* 
*         FORMAT - REDUCE.
*                - VALID FOR SCOPE 3 AND KRONOS 2 / NOS 1.
*                - ENTERS FIELD LENGTH REDUCTION MODE.
* 
*         FORMAT - REDUCE(-)
*                - VALID FOR KRONOS 2 / NOS 1.
*                - ENTERS NO FIELD LENGTH REDUCTION MODE. 
* 
*         FORMAT - REDUCE(ECS)
*                - VALID FOR NOS/BE.
*                - ENTERS ECS FIELD LENGTH REDUCTION MODE.
* 
*         ERROR MESSAGES - * CONTROL CARD ERROR, NO ACTION TAKEN. * 
* 
*         *NOTE* - ABOVE ERROR CONDITION DOES NOT CAUSE THE 
*                  CONTROL POINT TO BE ABORTED. 
* 
          SPACE  4
          SPACE  4
          ENTRY  REDUCE 
 REDUCE   SB1    1
          SA1    COMNP       SET (B7) = NUMBER OF PARAMETERS
          MX2    -12
          BX2    -X2*X1 
          SB7    X2 
          SB6    B1+B1       (B6) = PARAMETER FETCH ADDRESS 
 RED1     ZR     B7,RED2     IF NO PARAMETERS (REDUCE.) 
 S        IFSCOPE 
          EQ     B7,B1,RED4  IF ONE PARAMETER (ECS) 
          EQ     CCE         IF ERROR (SCOPE FORMAT)
 S        ENDIF 
 K        IFNOS 
          EQ     B7,B6,RED3  IF 2 PARAMETERS (- IS SEPARATOR) 
          EQ     CCE         IF INCORRECT NUMBER OF PARAMETERS
 K        ENDIF 
**        REDUCE.   IF SCOPE THEN SET REDUCE BIT
*                   IF NOS THEN RESET REDUCE BIT
 RED2     BSS    0
          GETLC  LCW
          SA1    LCW         (X1) = CURRENT LOADER CONTROL WORD 
          LX1    59-48+12*C.CPLR-S.CPLR   REDUCE BIT TO SIGN POS
          MX7    1
 S        IFSCOPE 
          BX1    X7+X1       IF SCOPE SET REDUCE BIT
 S        ENDIF 
 K        IFNOS 
          BX1    -X7*X1      IF NOS RESET REDUCE BIT
 K        ENDIF 
          LX1    -59+48-12*C.CPLR+S.CPLR    RESTORE FORMAT
          BX6    X1 
          SA6    LCW         (LCW) = NEW LOADER CONTROL WORD
          SETLC  LCW
          EQ     EXT         EXIT 
**        REDUCE(-).  NOS FORMAT, SET REDUCE BIT. 
 K        IFNOS 
 RED3     BSS    0
          SA1    B6          (X1) = PARAMETER AND SEPARATOR 
          SX2    1R-         (X2) = VALID OPTION
          BX1    X1-X2
          NZ     X1,CCE      IF NOT *-* THEN ERROR
          SA1    B6+B1       (X1) = NEXT PARAM AND CODE 
          NZ     X1,CCE      IF NOT (NULL PARAM AND TERMINATOR) 
          GETLC  LCW
          SA1    LCW
          LX1    59-48+12*C.CPLR-S.CPLR   REDUCE BIT TO SIGN POSITION 
          MX7    1
          BX1    X7+X1       IF NOS THEN SET REDUCE BIT 
          LX1    -59+48-12*C.CPLR+S.CPLR   RESTORE FORMAT 
          BX6    X1 
          SA6    LCW         (LCW) = NEW LOADER CONTROL WORD
          SETLC  LCW
 K        ENDIF 
**        REDUCE(ECS).  NOS/BE FORMAT, SET ECS REDUCE BIT.
 S        IFSCOPE 
 RED4     SA1    B1+B1       GET PARAMETER WORD 
          MX2    42 
          BX1    X1*X2       MASK OUT ALL BUT THE PARAMETER 
          SX2    3RECS
          LX1    18 
          BX2    X2-X1
          NZ     X2,CCE      IF NOT *ECS* 
          GETLC  LCW         READ LOADER CONTROL WORD 
          SA1    LCW
          MX7    1
 S.CPLRE  CEQU   3 ********** TEMPORARY **********
          LX7    -59+48-12*C.CPLR+S.CPLRE  POSITION BIT 
          BX7    X7+X1       SET BIT S.CPLRE IN LOADER CONTROL WORD 
          SA7    A1 
          SETLC  LCW         WRITE LOADER CONTROL WORD
 S        ENDIF 
 EXT      ENDRUN
 +        EQ     *
 CCE      BSS    0           CONTROL CARD ERROR EXIT SEQUENCE 
          MESSAGE CCER,,RECALL
          EQ     EXT         GO TO EXIT 
 CCER     DIS    ,* CONTROL CARD ERROR, NO ACTION TAKEN. *
          TITLE  PROCESS *MAP* CONTROL CARD 
***       *MAP* CONTROL CARD PROCESSING.
* 
*         FORMAT - MAP. 
*                - VALID FOR SCOPE 3 AND KRONOS 2 / NOS 1.
*                - SETS GLOBAL MAP OPTION IN LOADER CONTROL WORDS 
*                  TO INSTALLATION DEFAULT *IP.MAP* AS IN *IPARAMS*.
* 
*         FORMAT - MAP(OFF) OR MAP(PART) OR MAP(ON) OR MAP(FULL)
*                - VALID FOR SCOPE 3 AND KRONOS 2 / NOS 1.
*                - SETS GLOBAL MAP OPTIONS IN LOADER CONTROL WORDS. 
* 
*         ERROR MESSAGES - * CONTROL CARD ERROR, DEFAULT MAP SET.*
* 
*         *NOTE* - ABOVE ERROR CONDITION DOES NOT CAUSE THE 
*                  CONTROL POINT TO BE ABORTED. 
* 
          SPACE  4
          ENTRY  MAP
 MAP      SB1    1
          SA1    COMNP       SET (B7) = NUMBER OF PARAMETERS
          MX2    -12
          BX2    -X2*X1 
          SB7    X2 
          SB6    B1+B1       (B6) = PARAMETER FETCH ADDRESS 
 MAP1     ZR     B7,MAPD     IF NO PARAMETERS, USE DEFAULT
          EQ     B7,B1,MAP2  IF ONE PARAMETER 
          EQ     MAPDE       IF ERROR (TOO MANY PARAMETERS) 
 MAP2     SA1    MAPT        FIRST TABLE ENTRY
          SA5    B6 
          MX2    42 
          BX5    X5*X2       MAP OPTION PER CONTROL CARD
 MAP3     ZR     X1,MAPDE    IF UNRECOGNIZED OPTION 
          SX6    X1 
          BX1    X5-X1
          AX1    18 
          ZR     X1,MAP4     IF MATCH 
          SA1    A1+B1
          EQ     MAP3 
 MAPDE    BSS    0           MAP OPTION ERROR, USE DEFAULT
          MESSAGE CCEM,,RECALL
 MAPD     SX6    IP.MAP      USE DEFAULT MAP OPTION 
 MAP4     SB5    X6          SAVE MAP OPTION
          GETLC  LCW
          SA2    LCW         (X2) = CURRENT LOADER CONTROL WORD 
          MX0    4
          LX2    59-48+12*C.CPLM-S.CPLM-3  LEFT ADJ MAP BITS
          BX2    -X0*X2      CLEAR MAP BITS 
          SX3    B5 
          LX3    59-3        LEFT ADJ MAP OPTION
          BX6    X2+X3       SET NEW MAP BITS 
          LX6    -59+48-12*C.CPLM+S.CPLM+3   RESTORE FORMAT 
          SX1    B1          INDICATE MAP OPTIONS VALID 
          LX1    48-12*C.CPLM+S.CPLV                                     LDR0153
          BX6    X6+X1       MERGE OPTIONS
          SA6    LCW         (LCW)=NEW LOADER CONTROL WORD
          SETLC  LCW
          EQ     EXT         EXIT 
 CCEM     DIS    ,* CONTROL CARD ERROR, DEFAULT MAP SET.* 
 MAPT     CON    3LOFF       MAP(OFF) 
          CON    4LPART+3    MAP(PART)
          CON    2LON+13B    MAP(ON)
          CON    4LFULL+17B  MAP(FULL)
          CON    0           TERMINATE TABLE
          TITLE  PROCESS *LIBRARY* CONTROL CARD 
***       *LIBRARY* CONTROL CARD PROCESSING.
* 
*         FORMAT - LIBRARY. 
*                - SETS GLOBAL LIBRARY SET IN THE LOADER CONTROL
*                  WORDS TO NULL (I.E. DECLARES NO GLOBAL LIBRARIES)
* 
*         FORMAT - LIBRARY(LIB1,LIB2,...) 
*                - SETS GLOBAL LIBRARY SET IN LOADER CONTROL
*                  WORDS TO LIB1, LIB2, ... IN THE  ORDER SPECIFIED.
* 
*         ERROR MESSAGES - * INVALID NAME ON LIBRARY CARD.* 
*                        - * TOO MANY NAMES ON LIBRARY CARD.* 
* 
*         *NOTE* - ABOVE ERROR CONDITIONS CAUSE THE 
*                  CONTROL POINT TO BE ABORTED. 
* 
*         *NOTE* - LIBRARY NAMES MUST BE VALID FILE NAMES.
* 
          SPACE  4
 IT       IFNOS 
 IS       IFNOTGLS
  
          ENTRY  LIBRARY
 LIBRARY  SB1    1
          SA1    COMNP       SET (B7) = NUMBER OF PARAMETERS
          MX2    -12
          BX2    -X2*X1 
          SB7    X2 
          SB6    B1+B1       (B6) = PARAMETER FETCH ADDRESS 
          NZ     B7,LIB1     IF PARAMETERS
          MX2    0
          SA2    B1+B1       ENSURE ZERO WORD AS FIRST WORD 
          EQ     LIB3        GO TO STORE NAMES
 LIB1     SB5    24D         (B5)=MAX NUMBER OF PARAMETERS
          GT     B7,B5,LIBO  IF TOO MANY PARAMETERS 
 LIB2     SA2    B6          GET CURRENT NAME 
          MX3    42 
          BX6    X2*X3       ENSURE ZERO FILL 
          SA6    B6          RESTORE ZERO FILLED NAME 
          RJ     FMT         CHECK VALID FORMAT 
          NZ     X0,LIBE     IF INVALID FORMAT
          SB6    B6+B1       INCREMENT PARAMETER FETCH ADDRESS
          SB7    B7-B1       DECREMENT PARAMETER COUNT
          GT     B7,B0,LIB2  IF NOT DONE
 LIB3     MX6    0
          SA6    B6          ENSURE ZERO WORD TERMINATOR
          SA1    SGS
          BX6    X1 
          SA6    PW          (PW) = *SETGLS* PARAMETER WORD 
          SETGLS PW 
          SA1    COMNP       CHECK IF ALL NAMES FIT 
          MX2    -12
          BX2    -X2*X1      (X2) = NUMBER OF PARAMS
          SB2    X2+2        + FWA OF LIST = (B2) 
          SA1    PW          (X1) = *CPM* RETURN INFO WORD
          LX1    24D
          MX3    42D
          BX1    -X3*X1      (X1) = LWA+1 OF TRANSFER 
          SB3    X1 
          EQ     B2,B3,EXT   IF ALL NAMES FIT 
 LIBO     MESSAGE LIBOV1,,RECALL
 ABT      ABORT 
 +        EQ     *
 LIBE     MESSAGE LIBINV,,RECALL
          EQ     ABT
 LIBOV1   DIS    ,* TOO MANY NAMES ON LIBRARY CARD.*
 LIBINV   DIS    ,* INVALID NAME ON LIBRARY CARD.*
  
 IS       ENDIF 
 IT       ENDIF 
          SPACE  4
 COPYRGHT DATA   C/ CONTROL DATA PROPRIETARY PRODUCT /
          DATA   C/ COPYRIGHT CONTROL DATA CORP. 1976, 1977, 1978,/ 
          DATA   C/ 1979, 1980, 1981, 1982./
          SPACE  4
 K        IFNOS 
  
          ENTRY  RFL= 
 RFL=     BSS    0           EXECUTION FIELD LENGTH 
  
          ENTRY  NPC= 
 NPC=     EQU    0           NOS PARAMETER CRACKING 
  
 K        ENDIF 
          SPACE  4
          END 
