CONTROL 
          IDENT  CONTROL,CONTROL
          ABS 
          SYSCOM B1 
          SST    T1,MCMX
          ENTRY  CFO
          ENTRY  COMMENT
          ENTRY  ERRMSG 
          ENTRY  EXIT 
          ENTRY  FAMILY 
          ENTRY  GO 
          ENTRY  MACHINE
          ENTRY  MFL
          ENTRY  MODE 
          ENTRY  NOEXIT 
          ENTRY  NORERUN
          ENTRY  ONEXIT 
          ENTRY  ONSW 
          ENTRY  OFFSW
          ENTRY  OPMSG
          ENTRY  PAUSE
          ENTRY  PROTECT
          ENTRY  RERUN
          ENTRY  RFL
          ENTRY  ROLLOUT
          ENTRY  SETASL 
          ENTRY  SETJOB 
          ENTRY  SETJSL 
          ENTRY  SETPR
          ENTRY  SETTL
          ENTRY  SHELL
          ENTRY  SUI
          ENTRY  SWITCH 
          ENTRY  USECPU 
          ENTRY  RFL= 
*COMMENT  CONTROL - JOB CONTROL PROCESSOR.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
          TITLE  CONTROL - JOB CONTROL PROCESSOR. 
***       CONTROL - JOB CONTROL PROCESSOR.
*         G. R. MANSFIELD.  70/12/06. 
          SPACE  4,10 
***              CONTROL PROVIDES FUNCTIONS FOR JOB CONTROL AS
*         LISTED BELOW. 
          SPACE  4,10 
***              NUMERIC ARGUMENTS ARE ASSUMED OCTAL BASE,
*         EXCEPT ON SETASL, SETJSL, AND SETTL, WHERE ASSUMED
*         BASE IS DECIMAL.  NUMBERS MAY BE SUFFIXED BY A
*         POST-RADIX OF *B* OR *D*. 
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
* 
*         * ASL = XXXXXX, JSL = YYYYYY.* = INFORMATIVE MESSAGE
*                INDICATING THE CURRENT VALUES OF THE USER-S ACCOUNT
*                BLOCK SRU LIMIT (ASL) AND JOB STEP SRU LIMIT (JSL).
* 
*         * TL = XXXXXX.* = INFORMATIVE MESSAGE INDICATING THE CURRENT
*                TIME LIMIT VALUE.
* 
*         * ERROR IN CONTROL ARGUMENTS.* = AN ARGUMENT TO A CONTROL 
*                FUNCTION WAS INCORRECT.
*                NO MESSAGE WAS SPECIFIED ON A *COMMENT* COMMAND. 
*                A PARAMETER WAS SPECIFIED ON THE *OPMSG* COMMAND.
* 
*         * CM OR EC REQUEST EXCEEDS MAXIMUM.* = A RFL/MFL REQUEST
*                EXCEEDS THE MAXIMUM ALLOWABLE FIELD LENGTH.
* 
*         * USER ACCESS NOT VALID.* = THE SRU OR TIME LIMIT 
*                REQUEST IS OUT OF RANGE. 
* 
*         * MFL REQUEST TOO SMALL, MINIMUM USED.* = REQUESTED 
*                FIELD LENGTH IS LESS THAN THAT REQUIRED BY *CONTROL*.
* 
*         * NORERUN/RERUN INCORRECT FROM INTERACTIVE JOBS. * = AN 
*                INTERACTIVE ORIGIN JOB CANNOT SET OR CLEAR JOB RERUN 
*                STATUS.
* 
*         * CONTROL *QAC* ERROR NNN.* 
*                AN UNEXPECTED *QAC* ERROR STATUS OCCURRED. 
* 
*         * FILE/JOB NOT FOUND.*
*                THE SPECIFIED FILE OR JOB WAS NOT IN THE SYSTEM. 
* 
*         * NO JOB CHARACTERISTICS SPECIFIED.* = A *SETJOB* REQUEST 
*         CONTAINED NO JOB CHARACTERISTICS. 
* 
*         * INCORRECT CPU PRIORITY VALUE.*
*                THE CPU PRIORITY VALUE SPECIFIED EXCEEDS THE 
*                MAXIMUM VALUE ALLOWED. 
* 
*         *INCORRECT PARAMETER.*  = A PARAMETER OTHER THAN A, L, G, 
*                S, T, B, OR C WAS SPECIFIED ON A *SHELL* COMMAND.
* 
*         *INCORRECT PARAMETER LENGTH OR SEPARATOR.*  = A PARAMETER 
*                WAS LONGER THAN SEVEN CHARACTERS, OR USED AN INCORRECT 
*                SEPARATOR. 
* 
*         * FAMILY NOT FOUND.*
*                THE SPECIFIED FAMILY DOES NOT EXIST. 
* 
*         * DEFAULT FAMILY USED.* 
*                THE FAMILY SPECIFIED WAS THE SYSTEM DEFAULT FAMILY.
* 
*         * ONLY CORRECT PARAMETERS ARE *ON* OR *OFF*.* = AN
*                UNRECOGNIZABLE PARAMETER WAS SPECIFIED.
* 
*         * PARAMETER *ON* OR *OFF* REQUIRED.* = NO PARAMETER WAS 
*                SPECIFIED ON THE COMMAND.
* 
*         * PARAMETERS *ON* AND *OFF* ARE MUTUALLY EXCLUSIVE.* = BOTH 
*                *ON* AND *OFF* WERE SPECIFIED.  ONLY ONE PARAMETER IS
*                ALLOWED ON THE COMMAND.
          SPACE  4,10 
***       OPERATOR MESSAGES.
* 
* 
*         NONE. 
          SPACE  4,10 
*CALL     COMCMAC 
*CALL     COMCCMD 
          QUAL   EVENT
*CALL     COMSEVT 
          QUAL   *
*CALL     COMSPRD 
*CALL     COMSQAC 
*CALL     COMSZOL 
          TITLE  FUNCTION PROCESSORS. 
          TITLE  DATA LOCATIONS.
          ORG    150B 
 CONTROL  BSS    0
 QACP     SPACE  4,10 
**        *QAC* PARAMETER BLOCK.
* 
*         PREFIX PORTION. 
  
  
          LOC    0
 QFCN     VFD    42/0,8/0,9/0,1/0          FUNCTION, STATUS 
 QFIR     VFD    36/0,6/0,18/0             LENGTH, FIRST
 QINP     VFD    42/0,18/0                 IN 
 QOTP     VFD    42/0,18/0                 OUT
 QLIM     VFD    12/0,12/0,12/0,6/0,18/0   LIMIT
          SPACE  4,10 
**        SELECTION CRITERIA PORTION. 
  
  
          VFD    60/0 
          VFD    60/0 
 QJSN     VFD    24/0,36/0
 QSEL     EQU    *-1
 QQUE     VFD    12/0,48/0
          VFD    60/0 
          VFD    60/0 
          VFD    60/0 
 QSPEC    EQU    *           BEGINNING OF FUNCTION SPECIFIC WORDS 
          SPACE  4,10 
**        ALTER FUNCTION. 
  
  
 QARF     EQU    1           ALTER FUNCTION CODE
  
          LOC    QSPEC
 QSSW     VFD    6/0,24/0,30/0
 QALF     EQU    *-1
          VFD    60/0 
          VFD    60/0 
          VFD    60/0 
          VFD    60/0 
 QALTL    EQU    *-QFCN      LENGTH OF ALTER REQUEST
          SPACE  4,10 
**        PEEK FUNCTION.
  
  
 QPKF     EQU    3           PEEK FUNCTION CODE 
  
          LOC    QSPEC
 QCNT     VFD    12/0,12/0,12/0,12/0,12/0 
 QENT     VFD    36/0,12/0,12/0 
 QPIB     VFD    60/0 
          VFD    60/0 
 QPEKL    EQU    *-QFCN      LENGTH OF PEEK REQUEST 
  
          LOC    *O 
          ORG    CONTROL
 TQPW     SPACE  4,10 
**        TQPW - TABLE OF *QAC* PRESET WORDS. 
  
  
 TQPW     BSS    0
          VFD    36/0,6/QALTL-5,18/MSGA 
          VFD    42/0,18/MSGA 
          VFD    42/0,18/MSGAE
          VFD    36/0,6/QPEKL-5,18/PBUF 
          VFD    42/0,18/PBUF 
          VFD    42/0,18/PBUFE
 FETS     SPACE  4,10 
***       FETS. 
  
  
 SCR      FILEB  SBUF,1,(FET=8) 
          SPACE  4,10 
**        DATA LOCATIONS. 
  
  
 ZR       CON    0           ZERO WORD FOR ARGUMENT PROCESSING
          TITLE  COMMAND PROCESSORS.
 CFO      SPACE  4,10 
***       CFO - CFO,JSN.COMMENT 
*         ENTER COMMENT FROM OPERATOR IN JOB *JSN*. 
  
  
 CFO      BSS    0           ENTRY
          SX6    CFAF*10000B SET CFO ALTER FUNCTION 
          EQ     COM1        PROCESS COMMAND
 COMMENT  SPACE  4,10 
***       COMMENT.CCC-CCC 
*         ENTER COMMENT IN DAYFILE. 
* 
*         COMMENT,JSN.COMMENT 
*         ENTER COMMENT IN DAYFILE OF JOB *JSN*.
  
  
 COMMENT  BSS    0           ENTRY
          SX6    DYAF*10000B SET COMMENT ALTER FUNCTION 
 COM1     SB1    1
          SA6    COMA 
          SA2    ACTR        CHECK ARGUMENT COUNT 
          SX2    X2 
          AX3    X2,B1
          ZR     X2,END      IF LOCAL COMMENT 
          NZ     X3,ERR      IF INCORRECT ARGUMENT COUNT
          RJ     PQB         PRESET QAC BLOCK 
          SA1    ARGR 
          RJ     VJS         VERIFY JSN 
          NZ     X2,ERR      IF INCORRECT JSN 
          SB2    0           FLAG EXECUTION QUEUE 
          SB3    TALT 
          RJ     SSC         SET SELECTION CRITERIA 
          SB2    CCDR        GET COMMENT
          RJ     MCM         MOVE COMMENT 
          RJ     SMG         SET MESSAGE FOR *QAC*
          LT     B7,B6,ERR   IF NO MESSAGE
          SA1    COMA        GET ALTER FUNCTION 
          SA2    TALT+QALF
          BX6    X1+X2
          SA6    A2 
          SX6    QARF        CALL *QAC* 
          SB3    TALT 
          RJ     QAC
          EQ     ENL         COMPLETE COMMAND 
  
 COMA     CON    0           ALTER FUNCTION SELECTION 
 ERRMSG   SPACE  4,20 
***       ERRMSG(PARAM) 
* 
*         ENABLE OR DISABLE THE ECHOING OF *MS1W*/*MS2W*
*         ERROR MESSAGES TO THE TERMINAL BY *1RO*.  ERROR MESSAGE 
*         ECHOING CAN ONLY BE DISABLED FOR THE DURATION OF A
*         *CCL* PROCEDURE.  ERROR MESSAGE PROCESSING REVERTS TO 
*         NORMAL AFTER THE *CCL* PROCEDURE IS COMPLETED AND THE 
*         USER RETURNS TO INTERACTIVE COMMAND MODE. 
* 
*         ERRMSG(PARAM) 
* 
*         PARAM              ACTION 
* 
*         OFF                DISABLE THE ECHOING OF *MS1W*/*MS2W* 
*                            ERROR MESSAGES TO THE TERMINAL BY *1RO*
*                            FOR THE DURATION OF A *CCL* PROCEDURE. 
* 
*         ON                 ENABLE THE ECHOING OF *MS1W*/*MS2W*
*                            ERROR MESSAGES TO THE TERMINAL BY *1RO*. 
  
  
 ERRMSG   BSS    0           ENTRY
          SB1    1
          SA1    ACTR 
          SB4    X1          ARGUMENT COUNT 
          SA4    ARGR        ADDRESS OF FIRST ARGUMENT
          SB5    ERMB        ADDRESS OF ARGUMENT TABLE
          RJ     ARG         PROCESS ARGUMENTS
          ZR     X1,ERM1     IF NO ERROR
          MESSAGE ERME,,R    ONLY CORRECT PARAMETERS ARE *ON* OR *OFF*
          ABORT 
  
 ERM1     SA1    ERMC 
          SA2    ERMD 
          ZR     X1,ERM2     IF COMMAND IS *ERRMSG,ON*
          ZR     X2,ERM4     IF COMMAND IS *ERRMSG,OFF.*
          MESSAGE ERMF,,R    PARAMETER *ON* OR *OFF* REQUIRED 
          ABORT 
  
 ERM2     ZR     X2,ERM3     IF BOTH *ON* AND *OFF* SPECIFIED 
          SX6    B0+         ENABLE TERMINAL ERROR MESSAGES 
          SA6    ERMA 
          EQ     ERM5        CALL *CPM* 
  
 ERM3     MESSAGE ERMG,,R    ONLY ONE PARAMETER ALLOWED 
          ABORT 
  
 ERM4     SX6    B1+         DISABLE TERMINAL ERROR MESSAGES
          SA6    ERMA 
 ERM5     SX1    ERMA 
          SX2    135B        DISABLE/ENABLE TERMINAL ERROR MESSAGES 
          RJ     CPM= 
          ENDRUN             END
  
  
 ERMA     CON    0           *CPM* ARGUMENT WORD
  
 ERMB     BSS    0           *ERRMSG* CARD ARGUMENT TABLE 
 ON       ARG    -ZR,ERMC 
 OFF      ARG    -ZR,ERMD 
          ARG 
  
 ERMC     DATA   -1          *ON* PARAMETER 
 ERMD     DATA   -1          *OFF* PARAMETER
  
 ERME     DATA   C$ ONLY CORRECT PARAMETERS ARE *ON* OR *OFF*.$ 
 ERMF     DATA   C$ PARAMETER *ON* OR *OFF* REQUIRED.$
 ERMG     DATA   C$ PARAMETERS *ON* AND *OFF* ARE MUTUALLY EXCLUSIVE.$
 EXIT     SPACE  4,10 
***       EXIT. 
*         TERMINATE JOB.
  
  
 EXIT     BSS    0           ENTRY
          SB1    1
          RETURN SCR,R
          ENCSF  SCR
          EQ     END         COMPLETE COMMAND 
 FAMILY   SPACE  4,10 
***       FAMILY(FAMNAME).
* 
*         ALTER THE FAMILY NAME FOR THE JOB.
*         ONLY VALID FOR *SYOT* JOBS. 
*         NOT VALID ON SECURED SYSTEM.
  
  
 FAMILY   BSS    0           ENTRY
          SB1    1
          SA2    ACTR        CHECK PARAMETER COUNT
          SB2    X2 
          ZR     B2,FAM1     IF NO PARAMETERS SPECIFIED 
          GT     B2,B1,ERR   IF TOO MANY PARAMETERS SPECIFIED 
          SA1    ARGR        GET FAMILY NAME
          BX6    X1 
          SA6    FAMA 
 FAM1     ENFAM  FAMA        ENTER FAMILY NAME
          SA1    FAMA 
          MX0    -6 
          BX5    -X0*X1 
          LX1    48 
          NG     X1,ERR4     IF INCORRECT FAMILY NAME 
          ZR     X5,FAM2     IF DEFAULT NOT USED
          MESSAGE  (=C* DEFAULT FAMILY USED.*),3
 FAM2     ENDRUN
  
 FAMA     CON    0           FAMILY NAME
 GO       SPACE  4,10 
**        GO,JSN. 
*         SEND *GO* TO JOB JSN. 
  
  
 GO       BSS    0           ENTRY
          SA0    GOAF*10000B *GO* FLAG
 GO1      SB1    1
          RJ     PQB         PRESET REQUEST BLOCK 
          SA2    ACTR 
          SA1    ARGR 
          SB2    X2+
          NE     B2,B1,ERR   IF NOT ONE ARGUMENT
          RJ     VJS         VALIDATE JSN 
          SB2    0           FLAG EXECUTION QUEUE 
          NZ     X2,ERR      IF INCORRECT JSN 
          SB3    TALT 
          RJ     SSC         SET SELECTION CRITERIA 
          SA2    TALT+QALF   SET ALTER FLAG 
          SX1    A0+
          BX7    X2+X1
          SA7    A2 
          SX6    QARF        SET ALTER FUNCTION 
          SB3    TALT 
          RJ     QAC         CALL *QAC* 
          EQ     ENL         COMPLETE COMMAND 
 MACHINE  SPACE  4,10 
***       MACHINE(EP=XX)
*         XX=ON/OFF.
* 
*         SETS OR CLEARS THE STACK PURGING BIT ON THE CYBER 170-8X5 
*         MAINFRAME.  IF THE STACK PURGING BIT IS SET, ALL STORES AND 
*         CONDITIONAL BRANCHES WILL CAUSE THE STACK TO BE PURGED. 
  
  
 MACHINE  BSS    0           ENTRY
          SX6    TMAA        ARGUMENT TABLE ADDRESS 
          SX7    TMAAL
          RJ     PKP         PROCESS KEYBOARD OR POSITIONAL ARGUMENTS 
          NZ     X1,ERR      IF NO ARGUMENTS SPECIFIED
          SA1    PROA        ARGUMENT VALUE 
          SA2    =2LON
          SA3    =3LOFF 
          BX2    X1-X2
          SX4    B1          PRESET FOR PURGE BIT TO BE SET 
          ZR     X2,MAC1     IF PURGE BIT TO BE SET 
          BX6    X1-X3
          NZ     X6,ERR      IF NEITHER YES OR NO SPECIFIED 
          MX4    0
 MAC1     MODE   ,,X4 
          EQ     END         COMPLETE COMMAND 
  
  
**        TMAA - TABLE OF VALID ARGUMENTS FOR *MACHINE*.
* 
  
  
 TMAA     BSS    0
 EP       ARG    ZR,PROA
          ARG 
 TMAAL    EQU    *-TMAA-1 
 MFL      SPACE  4,10 
***       MFL(NNNNNN,MMMMM) 
*         MFL(CM=NNNNNN,EC=MMMMM) 
*         SET MAXIMUM CM FIELD LENGTH (MAXFL(CM)) = NNNNNN. 
*         SET MAXIMUM EM FIELD LENGTH (MAXFL(ECS)) = MMMMM*1000B. 
* 
*         ARGUMENTS MAY BE ENTERED WITH KEYWORDS OR POSITIONALLY OR 
*         MIXED.  IF MIXED, THOSE WITHOUT KEYWORDS WILL BE EVALUATED
*         ACCORDING TO THEIR POSITION AMONG ALL THE ARGUMENTS.
  
  
 MFL      BSS    0           ENTRY
          RJ     CMP         CONVERT PARAMETERS 
          ZR     X1,MFL2     IF NO CM CHANGE
          SX1    X1+
          ZR     X1,MFL1     IF SET MFL TO MAXFL REQUEST
          SX5    RFL=+100B   CHECK MFL REQUEST
          BX6    X1 
          AX5    6
          AX6    6
          IX2    X6-X5
          PL     X2,MFL1     IF REQUESTED MFL .GE. *CONTROL*S RFL=
          MESSAGE (=C* MFL REQUEST TOO SMALL, MINIMUM USED.*) 
          SX1    RFL=        SET MINIMUM MFL VALUE
 MFL1     SETMFL X1 
 MFL2     ZR     X3,END      IF NO EXTENDED MEMORY CHANGE 
          SX3    X3 
          SETMFL ,X3
          EQ     END         COMPLETE COMMAND 
 TMRA     SPACE  4,10 
**        TMRA - TABLE OF *MFL* AND *RFL* ARGUMENTS.
*         SEE *COMCMAC* MACRO *ARG* FOR FORMAT. 
  
  
 TMRA     BSS    0
 CM       ARG    ZR,TCKA,400B  CM FIELD LENGTH
 EC       ARG    ZR,TCKA+1,400B  EXTENDED MEMORY FIELD LENGTH 
          ARG 
 TMRAL    EQU    *-TMRA-1    ARGUMENT TABLE LENGTH
 MODE     SPACE  4,10 
***       MODE   M,N
*         M = PROGRAM ERROR EXIT MODES. 
*         N = HARDWARE ERROR EXIT MODES.
*         SET ERROR EXIT MODE = N00M. 
  
  
 MODE     BSS    0           ENTRY
          SA2    ACTR        CHECK ARGUMENT COUNT 
          SB1    1
          SX7    X2 
          SB7    B0          OCTAL BASE 
          SA5    ARGR        ARGUMENT 
          ZR     X7,ERR      ERROR IF NO ARGUMENT 
          SB6    X7          SAVE NUMBER OF PARAMETERS
          RJ     DXB         CONVERT DIGITS 
          NZ     X4,ERR      IF ERROR ENCOUNTERED 
          SX7    X6-20B 
          PL     X7,ERR      IF .GT. 20B
          BX7    X6 
          SA5    A5+B1       GET NEXT PARAMETER 
          SX6    EEMC/1000B  DEFAULT HARDWARE MODE BITS (7XXX)
          EQ     B6,B1,MOD1  IF ONLY 1 PARAMETER
          SA7    MODA        SAVE FIRST PARAMETER 
          RJ     DXB         CONVERT DIGITS 
          NZ     X4,ERR      IF ERROR 
          SX0    X6-10B 
          PL     X0,ERR      IF .GT. 7
          SA2    MODA        RESTORE FIRST PARAMETER
          BX7    X2 
 MOD1     MODE   X7,X6
          EQ     END         COMPLETE COMMAND 
  
 MODA     BSS    1           TEMPORARY SAVE 
 NOEXIT   SPACE  4,10 
***       NOEXIT. 
*         SUPPRESS PROCESSING OF *EXIT* COMMAND IF JOB ABORTS.
  
  
 NOEXIT   BSS    0           ENTRY
          SX1    1           SET NO EXIT
 NOX1     SA3    ACTR        CHECK ARGUMENT COUNT 
          SB1    1
          SX7    X3+
          NZ     X7,ERR      IF ARGUMENTS PRESENT 
          SX2    7
          RJ     =XCPM= 
          EQ     END         COMPLETE COMMAND 
 NORERUN  SPACE  4,10 
***       NORERUN.
*         SET INPUT FILE INTO NORERUN STATUS. 
  
  
 NORERUN  BSS    0           ENTRY
          RJ     VRN         VERIFY CALLER
          NORERUN            SET NO RERUN 
          EQ     END         COMPLETE COMMAND 
 ONEXIT   SPACE  4,10 
***       ONEXIT. 
*         RESET PROCESSING OF *EXIT* COMMAND. 
  
  
 ONEXIT   BSS    0           ENTRY
          SX1    B0          SET ONEXIT 
          EQ     NOX1        PROCESS COMMAND
 ONSW     SPACE  4,20 
***       ONSW (X1,X2,...XN)
*         SET SENSE SWITCHES XN.
*         IF XN = 0, ALL SWITCHES WILL BE SET.
* 
*         ONSW (X1,X2,...XN,JSN)
*         SET SENSE SWITCHES XN ON JOB JSN. 
*         IF XN = 0, ALL SWITCHES WILL BE SET.
*         JSN MAY APPEAR ONCE ANYWHERE IN THE LIST. 
* 
*         SWITCH (X1,X2,...XN)
*         SET SENSE SWITCHES XN.
*         IF XN = 0, ALL SWITCHES WILL BE SET.
* 
*         SWITCH (X1,X2,...XN,JSN)
*         SET SENSE SWITCH XN ON JOB JSN. 
*         IF XN = 0, ALL SWITCHES WILL BE SET.
*         JSN MAY APPEAR ONCE ANYWHERE IN THE LIST. 
  
  
 ONSW     BSS    0           ENTRY
 SWITCH   BSS    0           ENTRY
          SA0    SSAF+DYAF*10000B  SET *ONSW* AND DAYFILE MESSAGE FLAGS 
 ONS1     SA2    ACTR        CHECK ARGUMENT COUNT 
          SB1    1
          SB6    X2 
          SB5    B0 
          ZR     B6,ERR      ERROR IF NO ARGUMENTS
          SB7    B0          SET OCTAL BASE 
          SA5    ARGR        FIRST ARGUMENT 
 ONS2     RJ     DXB         UNPACK OCTAL DIGIT 
          NZ     X4,ONS5     IF INCORRECT NUMBER
          SX3    X6-7 
          PL     X3,ONS5     IF INCORRECT SWITCH VALUE
          SA2    ONSA 
          SX1    77B         PRESET ALL SWITCHES
          ZR     X6,ONS3     IF N = 0 
          SB2    X6          SET SWITCH BIT 
          MX0    1
          LX1    X0,B2
 ONS3     BX6    X2+X1       ACCUMULATE SWITCHES
          SA6    A2 
 ONS4     SB6    B6-B1       NEXT ARGUMENT
          SA5    A5+B1
          NZ     B6,ONS2     LOOP FOR ALL ARGUMENTS 
          SA1    ONSB        CHECK FOR LOCAL REQUEST
          SX2    A0 
          LX2    59-11
          NZ     X1,ONS7     IF NOT LOCAL 
          NG     X2,ONS6     IF LOCAL *OFFSW* COMMAND 
          ONSW   X6 
          EQ     END         COMPLETE COMMAND 
  
 ONS5     BX1    X5          VALIDATE JSN 
          RJ     VJS
          NZ     X2,ERR      IF NOT VALID JSN 
          SA3    ONSB 
          BX6    X1 
          NZ     X3,ERR      IF JSN ENCOUNTERED BEFORE
          SA6    A3 
          EQ     ONS4        PROCESS NEXT PARAMETER 
  
 ONS6     OFFSW  X6 
          EQ     END         COMPLETE COMMAND 
  
 ONS7     RJ     PQB         PRESET PARAMETER BLOCK 
          SB2    B0          FLAG EXECUTION QUEUE 
          SB7    A0 
          SB3    TALT 
          SA1    ONSB 
          RJ     SSC         SET SELECTION CRITERIA 
          GETPFP ONSC        CHECK IF CALLER IS OPERATOR
          SA1    ONSC+2 
          MX0    -18
          BX1    -X0*X1      ISOLATE USER INDEX 
          SX1    X1-377777B 
          NZ     X1,ONS8     IF CALLER IS NOT OPERATOR
          SB2    ONSD        SET *FROM OPERATOR* SUFFIX 
          EQ     ONS9        SET UP MESSAGE 
  
 ONS8     GETJN  ONSE+1      GET SENDING JOB-S JSN
          SB2    ONSE        SET *FROM JOB* SUFFIX
 ONS9     RJ     MDM         MOVE *ONSW*/*OFFSW* MESSAGE
          RJ     SMG         SET MESSAGE FOR *QAC*
          SA1    ONSA        GET SENSE SWITCHES 
          SA2    TALT+QSSW   STORE SENSE SWITCHES 
          LX1    59-5 
          BX6    X1+X2
          ERRNZ  QSSW-QALF   ENSURE ORDER OF BLOCK IS CORRECT 
          SX7    A0          SENSE SWITCH FUNCTION
          BX6    X6+X7       SET ALTER FUNCTION 
          SA6    A2+
          SX6    QARF        SET ALTER FUNCTION 
          SB3    TALT 
          RJ     QAC         CALL *QAC* 
          EQ     ENL         COMPLETE COMMAND 
  
 ONSA     CON    0           SENSE SWITCH VALUES
 ONSB     CON    0           SPECIFIED JSN
 ONSC     BSS    3           *GETPFP* INFORMATION 
  
 ONSD     DATA   C* FROM OPERATOR*  MESSAGE SUFFIX FOR OPERATOR CALL
  
 ONSE     DATA   H* FROM JOB *  MESSAGE SUFFIX FOR USER JOB CALL
          CON    0
 OFFSW    SPACE  4,10 
***       OFFSW (X1,X2,...,XN)
*         CLEAR SENSE SWITCHES XN.
*         IF XN = 0, ALL SWITCHES WILL BE CLEARED.
* 
*         OFFSW (X1,X2,...XN,JSN) 
*         CLEAR SENSE SWITCHES XN ON JOB JSN. 
*         JSN MAY APPEAR ONCE ANYWHERE IN THE LIST. 
*         IF XN = 0, ALL SWITCHES WILL BE CLEARED.
  
  
 OFFSW    BSS    0           ENTRY
          SA0    CSAF+DYAF*10000B  SET *OFFSW* AND DAYFILE MSG FLAGS
          EQ     ONS1        PROCESS COMMAND
 OPMSG    SPACE  4,10 
***       OPMSG.CCC-CCC 
*         SEND MESSAGE TO OPERATOR DISPLAY. 
*         IF NO COMMENT THEN TREAT AS A *NOP* 
*         ELSE, WAIT FOR OPERATOR REPLY.
  
  
 OPMSG    BSS    0           ENTRY
          SB2    CCDR 
          SB1    1
          SA1    ACTR        CHECK IF PARAMETERS SPECIFIED ON COMMAND 
          SX6    X1 
          NZ     X6,ERR      IF INVALID COMMAND 
          SA6    MSGA 
          RJ     MCM         UNPACK MESSAGE 
          SA1    MSGA 
          ZR     X1,END      IF NO MESSAGE
          OPMSG  MSGA        SEND MESSAGE TO OPERATOR DISPLAY 
 OPM1     SA1    B0 
          LX1    59-14       POSITION CFO BIT 
          PL     X1,END      IF REPLY 
          RECALL
          EQ     OPM1        CHECK FOR REPLY
 PAUSE    SPACE  4,10 
***       PAUSE,JSN.
*         SET *PAUSE* FLAG ON JOB JSN.
  
  
 PAUSE    BSS    0           ENTRY
          SA0    PAAF*10000B SET *PAUSE* FLAG FOR *QAC* CALL
          EQ     GO1         PROCESS COMMAND
 PROTECT  SPACE  4,10 
***       PROTECT,O1. 
*         PROTECT,EC=O1.
*         IF O1 = ON, TURN ON JOB CONTROL FOR SPECIFIED ARGUMENT. 
*         IF O1 = OFF, TURN OFF JOB CONTROL.
* 
*         ARGUMENTS MAY BE ENTERED WITH KEYWORDS OR POSITIONALLY OR 
*         MIXED.  IF MIXED, THOSE WITHOUT KEYWORDS WILL BE EVALUATED
*         ACCORDING TO THEIR POSITION AMONG ALL THE ARGUMENTS.
  
  
 PROTECT  BSS    0           ENTRY
          SX6    TPRA        ARGUMENT TABLE ADDRESS 
          SX7    TPRAL
          RJ     PKP         PROCESS KEYWORD OR POSITIONAL ARGUMENTS
          NZ     X1,ERR      IF NO ARGUMENTS SPECIFIED
  
*         FORM BIT FLAGS TO SET/CLEAR.
  
          SB7    B0+         SET POSITION IN CRACKED PARAMETER TABLE
 PRO1     SA1    TCKA+B7     GET PARAMETER VALUE
          ZR     X1,PRO4     IF NO VALUE SPECIFIED
          SA5    =3LOFF      CHECK IF VALUE = *OFF* 
          SA4    =2LON       CHECK IF VALUE = *ON*
          BX6    X1-X5
          BX7    X1-X4
          ZR     X6,PRO2     IF *OFF* 
          NZ     X7,ERR      IF NOT *ON*
          SB6    B7+1        SET SHIFT COUNT
          EQ     PRO3        POSITION *ON* FLAG 
  
 PRO2     SB6    B7+13       SET SHIFT COUNT
 PRO3     MX6    1           POSITION BIT FLAG
          LX6    X6,B6
          SA1    PROA 
          BX7    X1+X6
          SA7    A1 
 PRO4     SB7    B7+1        INCREMENT TABLE POSITION 
          SB6    B7-TPRAL 
          NZ     B6,PRO1     IF MORE ARGUMENTS TO PROCESS 
          SA1    PROA 
          ZR     X1,ERR      IF NO ARGUMENTS SPECIFIED
          PROTECT 
          EQ     END         COMPLETE COMMAND 
  
 PROA     CON    0           36/0,12/*OFF* FLAGS,12/*ON* FLAGS
 TPRA     SPACE  4,10 
**        TPRA - TABLE OF *PROTECT* ARGUMENTS.
*         SEE *COMCMAC* MACRO *ARG* FOR FORMAT. 
  
  
 TPRA     BSS    0
 EC       ARG    ZR,TCKA     PRESERVE EXTENDED MEMORY OVER JOB STEP 
          ARG 
 TPRAL    EQU    *-TPRA-1    ARGUMENT TABLE LENGTH
 RERUN    SPACE  4,10 
***       RERUN.
*         SET INPUT FILE FOR POSSIBLE RERUN.
  
  
 RERUN    BSS    0           ENTRY
          RJ     VRN         VERIFY CALLER
          RERUN              SET RERUN CAPABLITY ON INPUT FILE
          EQ     END         COMPLETE COMMAND 
 RFL      SPACE  4,10 
***       RFL(NNNNNN,MMMMM) 
*         RFL(CM=NNNNNN,EC=MMMMM) 
*         SET NOMINAL CM FIELD LENGTH (NFL(CM)) = NNNNNN. 
*         SET NOMINAL EM FIELD LENGTH (NFL(ECS)) = MMMMM*1000B. 
* 
*         ARGUMENTS MAY BE ENTERED WITH KEYWORDS OR POSITIONALLY OR 
*         MIXED.  IF MIXED, THOSE WITHOUT KEYWORDS WILL BE EVALUATED
*         ACCORDING TO THEIR POSITION AMONG ALL THE ARGUMENTS.
  
  
 RFL      BSS    0           ENTRY
          RJ     CMP         CONVERT PARAMETERS 
          ZR     X1,RFL1     IF NO CM CHANGE
          SX1    X1+
          SETRFL X1 
 RFL1     ZR     X3,END      IF NO EXTENDED MEMORY CHANGE 
          SX3    X3 
          SETRFL ,X3
          EQ     END         COMPLETE COMMAND 
 ROLLOUT  SPACE  4,10 
***       ROLLOUT.
*         ROLLOUT JOB.
* 
*         ROLLOUT(TTTTTTB)
* 
*         ROLLOUT THE JOB FOR THE SPECIFIED *TTTTTTB* SCHEDULER 
*         PERIODS.  THE DEFAULT IS DECIMAL TIME ( ASSUME 1 SECOND 
*         AS THE DEFAULT SCHEDULER INTERVAL ).
*         THE MAXIMUM TIME ALLOWED IS 777700B.
  
  
 ROLLOUT  BSS    0           ENTRY
          SA2    ACTR        CHECK ARGUMENT COUNT 
          SB1    1
          SB7    X2          ISOLATE COUNT AND SET DEFAULT FOR DXB
          NZ     B7,ROL1     IF TIME PARAMETER SPECIFIED
          ROLLOUT 
          EQ     END         COMPLETE COMMAND 
  
*         PROCESS EXTENDED ROLLOUT. 
  
 ROL1     NE     B1,B7,ERR   IF MORE THAN 1 ARGUMENT
          SA5    ARGR        CONVERT TIME ARGUMENT
          RJ     DXB         DEFAULT DECIMAL CONVERSION 
          NZ     X4,ERR      IF ARGUMENT ERROR
          SA1    ROLA 
* 
*         COMPENSATE FOR 7777B MULTIPLICATION.
*         TIME PARAMETER = XXYYYYB. 
*         XXYYYYB = XX*10000B + YYYY. 
*         XXYYYYB = XX*7777B + XX + YYYY. 
* 
          BX2    X6          COMPENSATE FOR 7777B MULTIPLY
          AX2    12 
          IX6    X6+X2
          MX0    42          VERIFY TIME ARGUMENT 
          BX2    X0*X6
          NZ     X2,ERR      IF ARGUMENT .GT. 777700B 
          BX6    X6+X1       SET EXTENDED TIME EVENT
          SA6    A1 
          ROLLOUT ROLA
          EQ     END         COMPLETE COMMAND 
  
 ROLA     VFD    30/0,18//EVENT/EXTM,12/0 
 SETPR    SPACE  4,10 
***       SETPR (NN)
*         SET CPU PRIORITY = NN.
*         IF NN = *, SET CPU PRIORITY TO SERVICE CLASS VALUE. 
  
  
 SETPR    BSS    0           ENTRY
          SA2    ACTR        CHECK ARGUMENT COUNT 
          SB1    1
          SX7    X2 
          SB7    B0          SET OCTAL BASE 
          SA5    ARGR        ARGUMENT 
          ZR     X7,ERR      ERROR IF NO ARGUMENT 
          BX6    X5 
          LX6    18 
          SX6    X6-1L* 
          ZR     X6,STP1     IF SET SERVICE CLASS PRIORITY
          RJ     DXB         CONVERT PRIORITY 
          NZ     X4,ERR      IF ERROR IN CONVERSION 
          SX7    X6-MPRS
          SX1    X6-LJCS
          PL     X7,ERR5     IF SPECIFIED PRIORITY TOO HIGH 
          NG     X1,ERR5     IF SPECIFIED PRIORITY TOO LOW
 STP1     SETPR  X6 
          EQ     END         COMPLETE COMMAND 
 SETTL    SPACE  4,10 
***       SETTL(NNNNN)
*         SET TIME LIMIT TO NNNNN SECONDS.
*         IF NNNNN = *, OR NNNNN IS GREATER THAN THE MAXIMUM FOR WHICH
*         THE USER IS VALIDATED, THEN THE TIME LIMIT IS SET TO THE
*         USER-S VALIDATED MAXIMUM. 
  
  
 SETTL    BSS    0           ENTRY
          SB6    B0          FLAG TIME LIMIT
 SETL     SA2    ACTR        CHECK ARGUMENT COUNT 
          SB1    1
          SX7    X2 
          SB7    1           SET DECIMAL BASE 
          SA5    ARGR        ARGUMENT 
          ZR     X7,ERR      ERROR IF NO ARGUMENT 
          LX5    6
          SX4    X5-1R*      CHECK FOR (*)
          ZR     X4,SETL1    IF (*) 
          LX5    54 
          RJ     DXB         CONVERT
          NZ     X4,ERR      IF INCORRECT VALUE 
          ZR     X6,ERR      IF ZERO REQUESTED
          SX7    100000B
          NZ     B6,SETL3    IF SRU LIMIT 
          IX7    X6-X7
          NG     X7,SETL2    IF ARGUMENT .LT. 77777B
 SETL1    NZ     B6,SETL4    IF SRU LIMIT 
          SX6    77777B      SET USER TO MAXIMUM
 SETL2    SETTL  X6          SET TIME LIMIT 
          GETTL  SRMA        GET CURRENT TIME LIMIT 
          SB5    SETB        SET IN MESSAGE 
          SB7    1R$
          RJ     SRM
          MESSAGE SETB
          EQ     END         COMPLETE COMMAND 
  
 SETL3    LX7    3
          IX7    X6-X7
          NG     X7,SETL5    IF ARGUMENT .LT. 777777B 
 SETL4    MX6    18          SET USER TO MAXIMUM
          LX6    18 
 SETL5    BX1    X6 
          EQ     B1,B6,SETL6 IF JOB STEP SRU LIMIT
          SETASL X1          SET ACCOUNT BLOCK SRU LIMIT
          EQ     SETL7       OUTPUT LIMITS
  
 SETL6    SETJSL X1          SET JOB STEP SRU LIMIT 
 SETL7    GETASL SRMA        GET CURRENT ACCOUNT BLOCK SRU LIMIT
          SB5    SETA 
          SB7    1R$
          RJ     SRM         SET IN MESSAGE 
          GETJSL SRMA        GET CURRENT JOB STEP SRU LIMIT 
          SB7    1R+
          RJ     SRM         SET IN MESSAGE 
          MESSAGE SETA
          EQ     END         ENDRUN 
  
  
 SETA     DATA   C* ASL = $$$$$$$$$, JSL = +++++++++.*
 SETB     DATA   C* TL = $$$$$$$$$.*
 SETASL   SPACE  4,10 
***       SETASL(NNNNNN)
*         SET ACCOUNT BLOCK SRU LIMIT TO NNNNNN UNITS.
*         IF NNNNNN = *, OR NNNNNN IS GREATER THAN THE MAXIMUM FOR
*         WHICH THE USER IS VALIDATED, THEN THE ACCOUNT BLOCK LIMIT 
*         IS SET TO THE USER-S VALIDATED MAXIMUM.  IF NNNNNN IS LOWER 
*         THAN THE CURRENT JOB STEP SRU LIMIT, BOTH THE ACCOUNT BLOCK 
*         AND JOB STEP SRU LIMITS ARE SET TO NNNNNN.
  
  
 SETASL   BSS    0           ENTRY
          SB6    2           SET ACCOUNT BLOCK SRU LIMIT
          EQ     SETL        SET LIMIT
  
 SETJOB   SPACE  4,15 
***       SETJOB(UJN,DC,OP) 
*         SETJOB(UJN=UJN,DC=DC,OP=OP) 
*         SET JOB CHARACTERISTICS.
* 
*         UJN = USER JOB NAME.
*         DC = DISPOSITION OF IMPLICIT OUTPUT AT END OF JOB.
*                TO = QUEUE TO *TXOT* QUEUE.
*                NO = DO NOT QUEUE OUTPUT.
*                DF = USE DEFAULT VALUE (DEPENDS ON JOB ORIGIN TYPE). 
*         OP = END OF JOB OPTIONS.
*                SU = SUSPEND JOB (*TXOT* ONLY).
*                TJ = TERMINATE JOB.
  
  
 SETJOB   BSS    0           ENTRY
          SX6    TSTJ        ARGUMENT TABLE ADDRESS 
          SX7    TSTJL
          RJ     PKP         PROCESS PARAMETERS 
          NZ     X1,ERR1     IF NO ARGUMENTS
          SA1    TCKA        PROCESS *DC* 
          ZR     X1,STJ2     IF *DC* NOT SPECIFIED
          SA2    TSDC 
 STJ1     BX3    X1-X2       CHECK NEXT VALID OPTION
          ZR     X3,STJ2     IF MATCH 
          SA2    A2+B1
          NZ     X2,STJ1     IF MORE VALID OPTIONS
          EQ     ERR         PROCESS INCORRECT *DC* 
  
 STJ2     LX1    -48         PROCESS *OP* 
          BX6    X1 
          SA1    A1+B1
          ZR     X1,STJ4     IF *OP* NOT SPECIFIED
          SA2    TSOP 
 STJ3     BX3    X1-X2       CHECK NEXT VALID OPTION
          ZR     X3,STJ4     IF MATCH 
          SA2    A2+B1
          NZ     X2,STJ3     IF MORE VALID OPTIONS
          EQ     ERR         PROCESS INCORRECT *OP* 
  
 STJ4     LX1    -36         COMBINE *DC* AND *OP*
          BX6    X1+X6
          SA1    STJA 
          BX3    X6+X1
          ZR     X3,ERR1     IF NO PARAMETER VALUES SPECIFIED 
          SA6    A1+B1
          SETJOB STJA 
          EQ     END         COMPLETE COMMAND 
  
 STJA     BSS    0           SETJOB PARAMETER BLOCK 
          CON    0           *UJN*
          CON    0           *OP* /*DC* 
 TSTJ     SPACE  4,10 
**        TSTJ - TABLE OF SETJOB ARGUMENTS. 
  
  
 TSTJ     BSS    0
 UJN      ARG    ZR,STJA,400B 
 DC       ARG    ZR,TCKA,400B 
 OP       ARG    ZR,TCKA+1,400B 
          ARG 
 TSTJL    EQU    *-TSTJ-1 
 TSDC     SPACE  4,10 
**        TSCD - TABLE OF SETJOB *DC* OPTIONS.
  
  
 TSDC     BSS    0
          CON    2LTO 
          CON    2LNO 
          CON    2LDF 
          CON    0
 TSOP     SPACE  4,10 
**        TSOP - TABLE OF SETJOB *OP* OPTIONS.
  
  
 TSOP     BSS    0
          CON    2LSU 
          CON    2LTJ 
          CON    0
 SETJSL   SPACE  4,10 
***       SETJSL(NNNNNN)
*         SET JOB STEP SRU LIMIT TO NNNNNN UNITS. 
*         IF NNNNNN = *, OR NNNNNN IS GREATER THAN THE MAXIMUM FOR
*         WHICH THE USER IS VALIDATED, THEN THE TIME LIMIT IS SET TO
*         THE MAXIMUM.  IF NNNNNN IS GREATER THAN THE CURRENT ACCOUNT 
*         BLOCK SRU LIMIT, BOTH THE JOB STEP AND ACCOUNT BLOCK SRU
*         LIMITS ARE SET TO NNNNNN. 
  
  
 SETJSL   BSS    0           ENTRY
          SB6    1           SET JOB STEP SRU LIMIT 
          EQ     SETL        SET LIMIT
 SHELL    SPACE  4,20 
***       SHELL(NAME,E,A,L,G,S,T,B,C) 
*         SET THE USER-S SHELL PROGRAM CONTROL WORD ACCORDING TO THE
*         PARAMETERS INPUT BY THE USER. 
*         CONTROL WORD FORMAT = 
*                42/NAME,10/0,1/E,1/A,1/L,1/G,1/S,1/T,1/B,1/C.
*         ALL PARAMETERS ARE ORDER INDEPENDENT EXCEPT FOR *NAME*
*         WHICH MUST BE THE FIRST PARAMETER.
* 
*         PARAMETERS: 
*         NAME   SHELL PROGRAM NAME.
*         E      CLEARS CONTROLS IF SHELL PROGRAM LOAD ERRORS.
*         A      CLEARS CONTROLS IF SHELL PROGRAM ABORTS. 
*         L      LOCAL FILE LOAD OF SHELL ALLOWED.
*         G      GLOBAL LIBRARY LOAD OF SHELL ALLOWED.
*         S      SYSTEM LIBRARY LOAD OF SHELL ALLOWED.
*         T      MONITOR COMMANDS DIRECTLY FROM THE TERMINAL. 
*         B      MONITOR COMMANDS OUTSIDE PROCEDURE.
*         C      MONITOR COMMANDS INSIDE PROCEDURE. 
* 
*         A, S AND B ARE SET BY DEFAULT IF NO PARAMETERS ARE SPECIFIED. 
* 
*         NOTE   TO AVOID PROBLEMS, MAKE SURE TO SPECIFY WHERE TO LOAD
*                THE PROGRAM FROM, AND HOW COMMANDS SHOULD BE MONITORED.
  
  
 SHELL    BSS    0           ENTRY
          SB1    1
          SA5    CCDR        FWA OF COMMAND 
          SB7    SHLB        FWA OF PARAMETER BLOCK 
          RJ     UPC         UNPACK COMMAND PARAMETERS
          NZ     X6,ERR3     IF ERROR DURING UNPACKING
          SB6    B6-B1       DO NOT COUNT *SHELL* AS A PARAMETER
          ZR     B6,SHL6     IF NO PARAMETERS, CLEAR CONTROL WORD 
  
*         BUILD SHELL PROGRAM CONTROL WORD FROM PARAMETERS. 
  
          SA2    SHLB+B1     SET PROGRAM NAME 
          BX6    X2 
          SB6    B6-B1       DECREMENT PARAMETER COUNT
          ZR     B6,SHL4     IF PROGRAM NAME IS ONLY PARAMETER
          SA2    A2+B1       CHECK NEXT PARAMETER 
          SB4    -B1
          SB5    SHLTL       NUMBER OF ACCEPTABLE PARAMETERS
          SX7    -B1
          MX0    42 
          SB2    SHLT 
 SHL1     SB4    B4+B1       CHECK NEXT VALID PARAMETER 
          EQ     B4,B5,SHL3  IF NO MATCH ON PARAMETER 
          SA3    B2+B4       NEXT VALID PARAMETER IN LIST 
          BX4    X0*X3
          BX4    X2-X4       COMPARE PARAMETERS 
          NZ     X4,SHL1     IF NO MATCH
          BX4    -X0*X3      SET PARAMETER BIT IN CONTROL WORD
          BX6    X6+X4
          SA7    A3          PREVENT DUPLICATE ENTRIES
 SHL2     SB4    -B1         RESET LIST POSITION
          SB6    B6-B1       DECREMENT PARAMETER COUNTER
          ZR     B6,SHL5     IF ALL PARAMETERS PROCESSED
          SA2    A2+B1
          EQ     SHL1        CHECK NEXT PARAMETER 
  
 SHL3     ZR     X2,SHL2     IF ZERO OR NULL PARAMETER
          EQ     ERR2        * INCORRECT PARAMETER.*
  
*         SET SHELL CONTROL WORD. 
  
 SHL4     SX3    112B        SET DEFAULT PARAMETERS (A,S,B) 
          BX6    X3+X6
 SHL5     SA6    SHLA 
 SHL6     SHELL  SHLA 
          EQ     END         COMPLETE COMMAND 
  
 SHLA     DATA   0           SHELL PROGRAM CONTROL WORD 
 SHLB     BSSZ   10          PARAMETER BLOCK
 SHLT     BSS    0           TABLE OF VALID *SHELL* PARAMETERS
          VFD    42/1LE,18/200B 
          VFD    42/1LA,18/100B 
          VFD    42/1LL,18/40B
          VFD    42/1LG,18/20B
          VFD    42/1LS,18/10B
          VFD    42/1LT,18/4
          VFD    42/1LB,18/2
          VFD    42/1LC,18/1
 SHLTL    EQU    *-SHLT      TABLE LENGTH 
          CON    0           END OF TABLE 
 SUI      SPACE  4,10 
***       SUI (NNNNNN)
*         SET USER INDEX = NNNNNNN. 
*         NOTE - THIS FUNCTION IS LEGAL ONLY FOR SYSTEM JOBS. 
  
  
 SUI      BSS    0           ENTRY
          SA2    ACTR        CHECK ARGUMENT COUNT 
          SB1    1
          SX7    X2 
          SB7    B0          SET OCTAL BASE 
          SA5    ARGR        ARGUMENT 
          ZR     X7,ERR      ERROR IF NO ARGUMENT 
          RJ     DXB         CONVERT
          NZ     X4,ERR 
          MX2    43          CHECK ARGUMENT 
          BX7    X2*X6
          NZ     X7,ERR      ERROR IF TOO LARGE 
          SETUI  X6          REQUEST SET USER INDEX 
          EQ     END         COMPLETE COMMAND 
 USECPU   SPACE  4,10 
***       USECPU(N) 
*         SELECT CPU FOR JOB TO RUN IN. 
*         N = 0, USE ANY CPU. 
*         N = 1, USE ONLY CPU - 0.  (6600 CPU ON 6700)
*         N = 2, USE ONLY CPU - 1,  (6400 CPU ON 6700)
  
  
 USECPU   BSS    0           ENTRY
          SA2    ACTR        CHECK ARGUMENT COUNT 
          SB1    1
          SB2    X2 
          NE     B2,B1,ERR   IF NOT ONE ARGUMENT
          SA5    ARGR        GET ARGUMENT 
          RJ     DXB         CONVERT DIGITS 
          NZ     X4,ERR 
          SX7    X6-3 
          PL     X7,ERR      ERROR IF > 2 
          USECPU X6 
          EQ     END         COMPLETE COMMAND 
          TITLE  SUBROUTINES. 
 CMP      SPACE  4,20 
**        CMP - CONVERT MEMORY PARAMETERS.
* 
*         EXIT   (X1) = 0 IF NO CM PARAMETER. 
*                     .LT. 0 IF CM PARAMETER IS ZERO. 
*                     = CM PARAMETER, OTHERWISE.
*                (X3) = 0 IF NO EXTENDED MEMORY PARAMETER.
*                     .LT. 0 IF EXTENDED MEMORY PARAMETER IS ZERO.
*                     = EXTENDED MEMORY PARAMETER, OTHERWISE. 
* 
*         USES   A - 1, 3, 5, 6.
*                X - 0, 1, 3, 4, 5, 6, 7. 
*                B - 7. 
* 
*         CALLS  DXB, PKP.
  
  
 CMP      SUBR               ENTRY/EXIT 
          SX6    TMRA        ARGUMENT TABLE ADDRESS 
          SX7    TMRAL
          RJ     PKP         PROCESS KEYWORD OR POSITIONAL ARGUMENTS
          NZ     X1,ERR      IF NO ARGUMENTS SPECIFIED
          SB7    B0+         CONVERT ARGUMENTS TO BINARY
          SA5    TCKA 
          ZR     X5,CMP1     IF NO CM VALUE SPECIFIED 
          RJ     DXB
          NZ     X4,ERR      IF CONVERSION ERROR
          MX7    1           SAVE VALUE 
          BX6    X6+X7
          SA6    A5+
 CMP1     SA5    TCKA+1 
          ZR     X5,CMP2     IF NO EXTENDED MEMORY VALUE SPECIFIED
          RJ     DXB
          NZ     X4,ERR      IF CONVERSION ERROR
          MX7    1           SAVE VALUE 
          BX6    X6+X7
          SA6    A5+
 CMP2     SA1    TCKA        CHECK FOR LEGAL VALUES 
          SA3    A1+B1
          MX0    -59
          BX6    -X0*X1 
          BX7    -X0*X3 
          SX4    77B         CHECK CM FL ROUNDED TO NEAREST 100B
          IX6    X6+X4
          AX7    15 
          AX6    17 
          IX6    X6+X7
          ZR     X6,CMP      IF CM .LE. 377700B AND EC .LE. 77777B
          MESSAGE (=C* CM OR EC REQUEST EXCEEDS MAXIMUM.*)
          ABORT 
          EQ     CMPX        RETURN 
 END      SPACE  4,10 
**        END - END RUN.
  
  
 END      BSS    0           ENTRY
          ENDRUN
 ENL      SPACE  4,10 
*         ENL - END NON-LOCAL REQUEST.
* 
*         ENTER  (X1) = *QAC* REQUEST STATUS. 
  
  
 ENL      BSS    0           ENTRY
          ZR     X1,END      IF NORMAL STATUS 
          SX3    X1-7 
          NZ     X3,ENL1     IF NOT JOB NOT FOUND 
          MESSAGE (=C* FILE/JOB NOT FOUND.*)
          EQ     END         COMPLETE COMMAND 
  
 ENL1     SX2    070007B
          BX6    X2*X1       LOW ORDER DIGIT
          LX1    6
          BX3    X2*X1       HIGH ORDER DIGIT 
          AX2    6
          AX1    3
          BX6    X6+X3
          SA4    ENLB 
          BX3    X2*X1       MIDDLE DIGIT 
          BX6    X6+X3
          LX6    53-17
          IX6    X6+X4
          SA6    A4+
          MESSAGE ENLA
          ABORT 
  
 ENLA     DATA   20H CONTROL *QAC* ERROR
 ENLB     DATA   5C 000.
 ERR      SPACE  4,10 
**        ERR - PROCESS ARGUMENT ERROR. 
  
  
 ERR      MESSAGE (=C* ERROR IN CONTROL ARGUMENTS.*)
          ABORT 
  
 ERR1     MESSAGE  (=C* NO JOB CHARACTERISTICS SPECIFIED.*) 
          ABORT 
  
 ERR2     MESSAGE (=C* INCORRECT PARAMETER.*) 
          ABORT 
  
 ERR3     MESSAGE (=C* INCORRECT PARAMETER LENGTH OR SEPARATOR.*) 
          ABORT 
  
 ERR4     MESSAGE  (=C* FAMILY NOT FOUND.*) 
          ABORT 
  
 ERR5     MESSAGE (=C* INCORRECT CPU PRIORITY VALUE.*)
          ABORT 
 MCM      SPACE  4,15 
**        MCM - MOVE COMMENT MESSAGE. 
* 
*         ENTER  (B2) = FWA OF THE COMMAND. 
* 
*         EXIT   COMMENT FIELD MOVED TO *MSGA*. 
* 
*         USES   A - 1,6. 
*                X - 1, 2, 3, 6.
*                B - 2, 6.
* 
*         CALLS  USB. 
  
  
 MCM5     SA6    B2+         STORE LAST WORD
  
 MCM      SUBR               ENTRY/EXIT 
          RJ     USB         UNPACK COMMAND 
          SX2    41B         FIND COMMAND TERMINATOR
          LX2    12 
 MCM1     SA1    B6          GET NEXT CHARACTER 
          SB2    X1 
          LX3    X2,B2
          SB6    B6+B1
          GT     B6,B7,MCMX  IF END OF COMMAND
          PL     X3,MCM1     IF NOT TERMINATOR
  
*         PACK COMMENT IN *MSGA*. 
  
          SB2    MSGA 
 MCM2     BX6    X6-X6       CLEAR ASSEMBLY REGISTER
          MX2    10          SET CHARACTER COUNT
 MCM3     SA1    B6          GET NEXT CHARACTER 
          LX6    6
          LX2    1
          BX6    X6+X1       MERGE CHARACTER
          SB6    B6+1 
          ZR     X1,MCM4     IF TERMINATOR
          NG     X2,MCM3     IF WORD NOT FILLED 
          SA6    B2          STORE WORD 
          SB2    B2+B1
          EQ     MCM2        START NEXT WORD
  
 MCM4     PL     X2,MCM5     IF WORD FULL 
          LX6    6
          LX2    1
          EQ     MCM4        CHECK IF WORD LEFT JUSTIFIED 
          SPACE  4,15 
**        MDM - MOVE DAYFILE MESSAGE. 
* 
*         MOVE *CCDR* MESSAGE TO BUFFER AND APPEND SPECIFIED SUFFIX.
* 
*         ENTRY  (B2) = FWA OF SUFFIX.
* 
*         EXIT   MESSAGE AND SUFFIX MOVED TO *MSGA*.
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 6, 7. 
*                B - 2, 3, 6. 
* 
*         MACROS MOVE.
* 
*         CALLS  USB. 
  
  
 MDM6     SA6    B2 
  
 MDM      SUBR               ENTRY/EXIT 
          RJ     USB         UNPACK SUFFIX
          SX7    1R.         APPEND TERMINATOR
          SA7    B7+1 
          MOVE   SBUFL,B6,SBUF  MOVE UNPACKED CONSTANT TO BUFFER
          MOVE   8,CCDR,MDMA+1
          SB2    MDMA 
          RJ     USB         UNPACK COMMAND 
 MDM1     SA1    B6 
          SB3    X1-1R. 
          ZR     B3,MDM2     IF COMMAND TERMINATOR
          SB3    X1-1R) 
          ZR     B3,MDM2     IF COMMAND TERMINATOR
          SB6    B6+1 
          EQ     MDM1        CHECK NEXT CHARACTER 
  
 MDM2     SX7    1R          ADD ONE BLANK SPACE
          SA7    B7+1 
          MOVE   SBUFL,SBUF,B7+2
  
*         PACK COMMENT IN *MSGA*. 
  
          SB2    MSGA 
          SB6    USBB+7      RETRIEVE FWA OF COMMAND
 MDM3     BX6    X6-X6       CLEAR ASSEMBLY REGISTER
          MX2    10          SET CHARACTER COUNT
 MDM4     SA1    B6          GET NEXT CHARACTER 
          LX6    6
          LX2    1
          BX6    X6+X1       MERGE CHARACTER
          SB6    B6+B1
          ZR     X1,MDM5     IF END OF MESSAGE
          NG     X2,MDM4     IF WORD NOT FILLED 
          SA6    B2 
          SB2    B2+B1
          EQ     MDM3        START NEXT WORD
  
 MDM5     PL     X2,MDM6     IF WORD FULL 
          LX6    6
          LX2    1
          EQ     MDM5        CHECK IF WORD LEFT JUSTIFIED 
  
  
 MDMA     DATA   A/*  /      ASSEMBLY BUFFER FOR MESSAGE
          BSSZ   8
 PKP      SPACE  4,15 
**        PKP - PROCESS KEYWORD OR POSITIONAL ARGUMENTS.
* 
*         ENTRY  (X6) = ARGUMENT TABLE ADDRESS. 
*                (X7) = ARGUMENT TABLE LENGTH.
* 
*         EXIT   (B1) = 1.
*                (X1) .NE. 0 IF NO ARGUMENTS SPECIFIED. 
*                TO *ERR* IF ARGUMENT ERROR.
* 
*         USES   A - 1, 2, 6, 7.
*                B - 1, 2, 3, 4, 6. 
*                X - 1, 2, 6, 7.
* 
*         CALLS  ARM, CPA, USB. 
  
  
 PKP      SUBR               ENTRY/EXIT 
          SB1    1
          SA6    PKPA        SAVE ADDRESS AND LENGTH
          SA7    A6+1 
          SB2    CCDR        UNPACK COMMAND 
          RJ     USB
          SA1    A6          ASSURE TERMINATION 
          SX6    1R.
          SA6    X1+B1
  
*         SKIP TO FIRST ARGUMENT. 
  
 PKP1     SA1    B6          SKIP OVER COMMAND NAME 
          SB6    B6+B1       ADVANCE CHARACTER ADDRESS
          SB2    X1-1R9-1 
          NG     B2,PKP1     IF NOT END OF NAME 
          SB2    X1-1R
          ZR     B2,PKP1     IF A BLANK 
          SB3    X1-1R. 
          SB4    X1-1R) 
          ZR     B3,PKPX     IF NO ARGUMENTS
          ZR     B4,PKPX     IF NO ARGUMENTS
  
*         PROCESS ARGUMENTS.
  
          SA1    PKPA        RETRIEVE ADDRESS AND LENGTH
          SA2    A1+B1
          SB3    X1          ARGUMENT TABLE ADDRESS 
          SB2    X2+
          SB4    ABUF        CONVERT POSITIONAL ARGUMENTS 
          RJ     CPA
          NG     B5,ERR      IF ARGUMENT ERROR
          SX6    B5+         SET LWA OF ARGUMENTS 
          SB6    ABUF        SET FWA OF ARGUMENTS 
          SA6    USBC 
          RJ     ARM         PROCESS ARGUMENTS
          NZ     X1,ERR      IF ARGUMENT ERROR
          EQ     PKPX        RETURN 
  
 PKPA     CON    0           ARGUMENT TABLE ADDRESS 
          CON    0           ARGUMENT TABLE LENGTH
 ERL      SPACE  4,10 
**        ERL - PROCESS RESOURCE LIMIT ERROR. 
  
  
 ERL      BSS    0           ENTRY
          MESSAGE (=C* USER ACCESS NOT VALID.*) 
          ABORT 
 PQB      SPACE  4,10 
**        PQB - PRESET *QAC* REQUEST BLOCK. 
* 
*         EXIT   PARAMETER BLOCKS *TALT* AND *TPEK* 
*                ARE PRESET.
* 
*         USES   A - 1, 2, 3, 6, 7. 
*                X - 1, 2, 3, 6, 7. 
*                B - 2. 
  
  
 PQB      SUBR               ENTRY/EXIT 
          SB2    MSGAE-TALT  CLEAR REQUEST SPACE
          SX7    0
 PQB1     SA7    TALT+B2
          SB2    B2-1 
          PL     B2,PQB1     IF NOT ALL CLEARED 
          SA1    TQPW        FILL PRESET WORDS
          SA2    A1+B1
          BX7    X1 
          SA3    A2+B1
          BX6    X2 
          SA7    TALT+QFIR   *FIRST*
          SA6    A7+B1       *IN* 
          BX7    X3 
          SA6    A6+B1       *OUT*
          SA7    A6+B1       *LIMIT*
          SA1    A3+B1
          SA2    A1+B1
          BX7    X1 
          SA3    A2+B1
          SA7    TPEK+QFIR   *FIRST*
          BX6    X2 
          SA6    A7+B1       *IN* 
          BX7    X3 
          SA6    A6+B1       *OUT*
          SA7    A6+B1       *LIMIT*
          EQ     PQBX        RETURN 
 QAC      SPACE  4,15 
**        QAC - CALL *QAC*. 
*         SETS THE REQUESTED FUNCTION CODE IN (B3) AND
*         CALLS *QAC*.
* 
*         ENTER  (X6) = FUNCTION CODE.
*                (B3) = REQUEST BLOCK ADDRESS.
* 
*         EXIT   (X1) = ERROR STATUS. 
* 
*         USES   A - 1, 7.
*                X - 1, 7.
* 
*         MACROS SYSTEM.
  
  
 QAC      SUBR               ENTRY/EXIT 
          SA1    QFCN+B3
          MX7    42          ENTER FUNCTION CODE
          LX6    1
          BX7    X7*X1
          BX7    X7+X6
          SA7    A1+
          SYSTEM QAC,R,A7 
          MX7    -8 
          SA1    QFCN+B3     GET RESPONSE STATUS
          AX1    10 
          BX1    -X7*X1 
          EQ     QACX        RETURN 
 SMG      SPACE  4,10 
**        SMG - SET MESSAGE IN *TALT*.
* 
*         ENTER  MESSAGE STORED IN *MSGA*.
* 
*         EXIT   MESSAGE POINTERS SET IN *TALT*.
*                (B7) .LT. (B6), IF NO MESSAGE. 
* 
*         USES   A - 1, 7.
*                X - 1, 7.
*                B - 6, 7.
  
  
 SMG      SUBR               ENTRY/EXIT 
          SB7    MSGAE       FIND END OF MESSAGE
          SB6    MSGA 
 SMG1     SB7    B7-B1
          LT     B7,B6,SMGX  IF NO MESSAGE
          SA1    B7 
          ZR     X1,SMG1     IF EMPTY WORD
          MX7    -12
          BX7    -X7*X1 
          ZR     X7,SMG2     IF MESSAGE TERMINATOR
          SB7    B7+1        FORCE TERMINATOR 
 SMG2     SX7    B7+1        ADJUST *IN* POINTER
          SA7    TALT+QINP
          EQ     SMGX        RETURN 
 SRM      SPACE  4,15 
**        SRM - SET RESOURCE LIMIT MESSAGE. 
* 
*         ENTRY  (B5) = MESSAGE FWA.
*                (B7) = REPLACEMENT CHARACTER.
*                (SRMA) = ACCOUNT BLOCK, JOB STEP SRU, OR TIME LIMIT. 
* 
*         EXIT   RESOURCE LIMIT OR *UNLIMITED* PLACED IN MESSAGE. 
* 
*         USES   X - 0, 1.
*                A - 1. 
*                B - 2. 
* 
*         CALLS  CDD, SNM.
  
  
 SRM1     RJ     CDD         CONVERT TO DECIMAL 
          SB2    B2-B1       MASK OFF DIGITS
          MX6    1
          AX6    B2 
          BX1    X6*X4
 SRM2     SB2    B7 
          RJ     SNM         SET IN MESSAGE 
  
 SRM      SUBR               ENTRY/EXIT 
          SA1    SRMA        GET LIMIT
          MX0    -18
          BX0    -X0-X1 
          NZ     X0,SRM1     IF NOT UNLIMITED 
          SA1    SRMB        *UNLIMITED*
          EQ     SRM2        SET IN MESSAGE 
  
  
 SRMA     CON    0           RESOURCE LIMIT 
 SRMB     DATA   0LUNLIMITED
 SSC      SPACE  4,15 
**        SSC - SET SELECTION CRITERIA. 
* 
*         ENTER  (X1) = JSN IN BITS 59 - 36.
*                (X1) = 0 IF NO JSN PROVIDED. 
*                (B2) .LT. 0 IF ALL QUEUES SELECTED.
*                (B2) .EQ. 0 IF FOR EXECUTION QUEUE ONLY. 
*                (B2) .GT. 0 IF SPECIFIC QUEUE SELECTION. 
*                (B3) = REQUEST BLOCK ADDRESS.
* 
*         EXIT   SELECTION CRITERIA SET IN BLOCK. 
* 
*         USES   A - 2, 7.
*                X - 2, 6, 7. 
  
  
 SSC      SUBR               ENTRY/EXIT 
          SA2    QQUE+B3     SET QUEUE SELECTION
          SX7    0037B       SELECT ALL QUEUES
          MX6    12 
          BX2    -X6*X2 
          NG     B2,SSC1     IF ALL QUEUES
          SX7    0002B       SET EXECTUION QUEUE
          ZR     B2,SSC1     IF EXECUTION QUEUE 
          SX7    B2+         SPECIAL QUEUE
 SSC1     LX7    59-11
          BX7    X2+X7
          SA7    A2+
          ERRNZ  QJSN-QSEL   ENSURE ORDER OF BLOCK IS CORRECT 
          SX7    1S6+1S2     SET SELECTION FLAGS
          NZ     X1,SSC2     IF JSN SUPPLIED
          SX7    1S2         NO JSN SELECTION 
 SSC2     BX7    X7+X1
          SA7    QJSN+B3
          EQ     SSCX        RETURN 
 VJS      SPACE  4,10 
**        VJS - VALIDATE JSN. 
* 
*         ENTRY  (X1) = JSN PARAMETER WORD. 
* 
*         EXIT   (X2) = 0 IF PARAMETER IS VALID.
*                (X1) = JSN IN BITS 59 - 36 IF (X2) = 0.
* 
*         USES   X - 1, 2, 3. 
  
  
 VJS1     SX2    B1          SET INCORRECT PARAMETER
  
 VJS      SUBR               ENTRY/EXIT 
          MX2    42 
          MX3    24 
          BX1    X2*X1
          BX2    -X3*X1 
          NZ     X2,VJSX     IF JSN .GT. 4 CHARACTERS 
          LX3    -18
          BX3    X3*X1
          NZ     X3,VJSX     IF FOUR CHARACTER JSN
          MX3    -48
          BX3    -X3*X1 
          ZR     X3,VJS1     IF JSN .LT. 3 CHARACTERS 
          SX3    1R          SET FOURTH CHARACTER TO BLANK
          LX3    36 
          BX1    X1+X3
          EQ     VJSX        RETURN 
 VRN      SPACE  4,15 
**        VRN    VERIFY RERUN/NORERUN CALL. 
* 
*         ENTRY  DIRECT FROM RERUN/NORERUN COMMAND. 
* 
*         EXIT   NORMAL IF VALID CALLER-ELSE ENDRUN.
*                (B1) = 1 
* 
*         CALLS  NONE.
* 
*         USES   A - 2. 
*                X - 2, 3, 4, 6.
*                B - 1, 2.
  
  
 VRN      SUBR
          SA2    ACTR 
          SB1    1
          SB2    X2          NUMBER OF ARGUMENTS
          NE     B2,ERR      IF ANY ARGUMENTS 
          SA2    FWPR        VERIFY ORIGIN
          MX3    -6 
          AX2    24D
          BX4    -X3*X2      ONLY ORIGIN
          SX6    X4-TXOT
          NZ     X6,VRNX     IF VALID ORIGIN
          MESSAGE (=C* NORERUN/RERUN INCORRECT FROM INTERACTIVE JOBS.*) 
          EQ     END         COMPLETE COMMAND 
 TCKA     TITLE  TABLE OF CRACKED ARGUMENT VALUES.
**        TCKA - TABLE OF CRACKED ARGUMENT VALUES.
* 
*         THE ORDER OF THE ARGUMENT VALUES IN THIS TABLE IS DETERMINED
*         BY THE ORDER OF THE ARGUMENTS IN THE INDIVIDUAL ARGUMENT
*         TABLES.  THE NUMBER OF VALUES USED IS DETERMINED BY THE 
*         LENGTH OF THE ARGUMENT TABLE. 
* 
*         THE FOLLOWING ARGUMENT TABLES APPLY - 
*         *TMRA*, LENGTH *TMRAL*  *MFL* AND *RFL* ARGUMENTS 
*         *TPRA*, LENGTH *TPRAL*  *PROTECT* ARGUMENTS 
*         *TSTJ*, LENGTH *TSTJL*  *SETJOB* ARGUMENTS
  
  
 TCKAL    MAX    TMRAL,TPRAL,TSTJL
 TCKA     BSSZ   TCKAL       CRACKED ARGUMENT VALUES
          TITLE  COMMON DECKS.
*         COMMON DECKS. 
  
  
*CALL     COMCARG 
*CALL     COMCARM 
*CALL     COMCCPA 
*CALL     COMCCDD 
*CALL     COMCCIO 
*CALL     COMCCPM 
*CALL     COMCDXB 
*CALL     COMCLFM 
*CALL     COMCMVE 
*CALL     COMCPOP 
*CALL     COMCSNM 
*CALL     COMCSYS 
*CALL     COMCUPC 
*CALL     COMCUSB 
          SPACE  4,10 
          USE    // 
          SPACE  4,10 
**        BUFFERS.
  
  
 SBUFL    EQU    15          SCRATCH BUFFER LENGTH
  
 ABUF     EQU    *           ARGUMENT STRING BUFFER 
 SBUF     EQU    ABUF+200    SCRATCH BUFFER 
 RFL=     EQU    SBUF+SBUFL+8  ALLOW FOR READ AHEAD IN COMMON DECKS 
          SPACE  4,10 
**        QAC PARAMETER BLOCK STORAGE.
  
  
 TALT     EQU    *           *QAC* ALTER REQUEST BLOCK
 TPEK     EQU    TALT+QALTL  *QAC* PEEK REQUEST BLOCK 
 MSGA     EQU    TPEK+QPEKL  MESSAGE BUFER
 MSGAE    EQU    MSGA+9 
 PBUF     EQU    MSGAE       PEEK BUFFER
 PBUFE    EQU    SBUF 
  
          ERRNG  CTFL*100B-RFL=  CHANGE *CTFL* DEFINITION IN *COMSZOL*
          SPACE  4
          END 
