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