Retro1.org codex

          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