IDENT CLASS,FWA,CLASS
ABS
SST
ENTRY CLASS
ENTRY SSJ=
ENTRY RFL=
SYSCOM B1
TITLE CLASS - CHANGE USER SERVICE CLASS.
*COMMENT CLASS - CHANGE USER SERVICE CLASS.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
SPACE 4,10
*** CLASS - CHANGE USER SERVICE CLASS.
*
* W. T. COLEMAN. 82/08/09.
SPACE 4,10
*** *CLASS* PERMITS THE SERVICE CLASS OF THE JOB TO BE
* CHANGED AT ANY TIME DURING A TERMINAL SESSION OR BY
* USING THE *CLASS* COMMAND WITHIN A BATCH JOB. THIS
* COMMAND ALSO ALLOWS THE SERVICE CLASS OF ANY BATCH JOB
* UNDER THE CALLING USER-S CONTROL TO BE CHANGED. THIS
* COMMAND ALLOWS INQUIRY OF AVAILABLE SERVICE CLASSES.
* IT WILL ACCEPT PARAMETERS FROM THE *CLASS* COMMAND
* INPUT FROM THE FILE *INPUT*, AND SEND OUTPUT TO THE
* USER VIA FILE *OUTPUT* OR A SPECIFIED OUTPUT FILE.
SPACE 4,10
*** *CLASS* COMMAND.
*
* CLASS,SC,OT,LFN,A.
*
* CLASS,SC=SC,OT=OT,L=LFN,OP=A.
*
* CLASS,SC,,,,JSN.
*
* CLASS,SC,JSN=JSN.
*
* CLASS,SC=SC,JSN=JSN.
*
* *CLASS* CONTROL STATEMENT PARAMETERS ARE DEFINED
* AS FOLLOWS.
*
* SC TWO CHARACTER SERVICE CLASS SYMBOL OF DESIRED
* SERVICE CLASS OR NULL. IF THIS PARAMETER IS
* NOT SPECIFIED, AND THE COMMAND HAS BEEN ISSUED
* FROM AN TIMESHARING USER WHOSE INPUT/OUTPUT
* FILES ARE ASSIGNED TO THEIR TERMINAL, AND NO
* ORIGIN (*OT* PARAMETER) HAS BEEN SPECIFIED THEN
* A TERMINAL DISPLAY IS GENERATED FOR THE USER TO
* SELECT A SERVICE CLASS. AN ALTERNATE OUTPUT
* FILE CAN BE SPECIFIED FOR THE DISPLAY IF NO
* SERVICE CLASS IS PRESENT. THIS PARAMETER HAS
* NO DEFAULT AND IS REQUIRED IF THE *JSN*
* PARAMETER IS SPECIFIED. THE SELECTED
* SERVICE CLASS MUST BE DEFINED AND VALIDATED FOR
* USE. THE DEFINED SERVICE CLASSES ARE:
* SY - SYSTEM,
* BC - BATCH,
* RB - REMOTE BATCH,
* TS - INTERACTIVE,
* DI - DETACHED INTERACTIVE,
* NS - NETWORK SUPERVISOR,
* SS - SUBSYSTEM,
* MA - MAINTENANCE,
* CT - COMMUNCATION TASK,
* I0 - INSTALLATION CLASS 0,
* I1 - INSTALLATION CLASS 1,
* I2 - INSTALLATION CLASS 2,
* I3 - INSTALLATION CLASS 3.
*
* OT ORIGIN TYPE TO INSPECT FOR ACCESSABLE SERVICE
* CLASS(S). DEFAULT TO JOBS CURRENT ORIGIN TYPE.
* THIS PARAMETER IS IGNORED IF A SERVICE CLASS
* (*SC* PARAMETER) IS SPECIFIED. THE POSSIBLE
* ORIGIN TYPES ARE:
* SY - SYSTEM ORIGIN,
* BC - BATCH ORIGIN,
* RB - REMOTE BATCH ORIGIN,
* EI - REMOTE BATCH ORIGIN,
* TX - INTERACTIVE,
* IA - INTERACTIVE.
*
* L LISTING IS PLACED ON SPECIFIED FILE. THIS
* PARAMETER IS IGNORED IF A SERVICE CLASS
* (*SC* PARAMETER) IS PRESENT. IF THE SPECIFIED
* FILE IS ASIGNED TO THE TERMINAL (TYPE *TT*)
* THEN PROMPTING WILL OCCUR. THE DEFAULT FILE
* WILL OCCUR. DEFAULT FILE IS *OUTPUT*.
*
* OP ABORT OPTION INDICATING WHETHER THE JOB SHOULD
* ABORT OR END IF AN ERROR IN PROCESSING IS
* ENCOUNTERED. THIS IS AN OPTIONAL PARAMETER.
* THE ABORT OPTION CAN BE SPECIFIED POSTIONALLY
* *A* OR ORDER INDEPENDENTLY BY *OP=A*.
*
* JSN JOB SEQUENCE NAME OF THE JOB WHOSE SERVICE
* CLASS IS TO BE CHANGED IF NOT THE CURRENT JOB.
SPACE 4,10
*** OUTPUT MESSAGES.
*
* * CANNOT CHANGE CLASS OF ON-LINE JOB.*
* THE SERVICE CLASS OF ANOTHER ON-LINE JOB CANNOT BE
* CHANGED.
*
* * CANNOT CHANGE CLASS OF SUBSYSTEM.*
* THE SERVICE CLASS OF A JOB THAT IS EXECUTING AT
* THE SUBSYSTEM SERVICE CLASS CANNOT BE CHANGED.
*
* * CLASS ARGUMENT ERROR.*
* INCORRECT *CLASS* ARGUMENT ON COMMAND.
*
* * CLASS COMPLETE.*
* THE *CLASS* CONTROL STATEMENT COMPLETED PROCESSING.
*
* * INCORRECT JSN ARGUMENT.*
* THE JSN IS EITHER NOT FOUR CHARACTERS LONG OR IT
* CONTAINS NON-ALPHANUMERIC CHARACTERS.
*
* * INCORRECT OPTION ARGUMENT.*
* INCORRECT OPTION ARGUMENT ON COMMAND.
*
* * INCORRECT OUTPUT FILENAME.*
* SPECIFIED OUTPUT FILENAME ARGUMENT IS INCORRECT.
* THE FILENAME IS EITHER TOO LONG (GREATER THAN
* SEVEN CHARATERS) OR IT CONTAINS NON-ALPHANUMERIC
* CHARACTERS.
*
* * INCORRECT SERVICE CLASS.*
* THE TWO CHARACTER SERVICE CLASS WAS NOT VALID FOR
* THE USER OR NOT VALID FOR THE CURRENT ORIGIN TYPE
* OF THE USER.
*
* * JOB ALREADY WAITING ON SERVICE CLASS.*
* THE SERVICE CLASS CHANGE CANNOT BE MADE BECAUSE THE
* JOB IS WAITING FOR A *CLASS* COMMAND IN THE JOB TO
* COMPLETE.
*
* * JSN NOT FOUND.*
* THE JSN SPECIFIED IS NOT IN THE SYSTEM OR DOES NOT
* BELONG TO THE CALLING USER.
*
* * SC ONLY PARAMTER VALID WITH JSN.*
* THE *OT*, *L* AND *OP* PARAMETERS ARE NOT ALLOWED
* WHEN THE *JSN* PARAMETER IS SPECIFIED.
*
* * SERVICE CLASS FULL.*
* INFORMATIVE MESSAGE INDICATING THE SERVICE CLASS
* CHANGE CANNOT BE MADE BECAUSE THE NUMBER OF JOBS
* WITH THAT CLASS IS ALREADY AT THE SERVICE LIMIT.
*
* * SERVICE CLASS REQUIRED WITH JSN.*
* THE *SC* PARAMETER MUST BE SPECIFIED WHEN THE *JSN*
* PARAMETER IS SPECIFIED.
*
* * UNDEFINED ORIGIN TYPE.*
* ORIGIN TYPE ARGUMENT IS NOT DEFINED.
*
* * UNDEFINED SERVICE CLASS.*
* SERVICE CLASS MNEMONIC IS NOT DEFINED.
*
* * WAITING FOR SERVICE CLASS CHANGE TO SC.*
* A BATCH JOB IS WAITING FOR AN AVAILABLE POSITION IN
* SERVICE CLASS *SC* WHICH HAS REACHED SERVICE LIMIT.
SPACE 4,10
* COMMON DECKS.
*CALL COMCCMD
*CALL COMCMAC
*CALL COMSEVT
*CALL COMSQAC
*CALL COMSSSJ
*CALL COMSTCM
SCLASS SPACE 4,15
** SCLASS - DEFINE SERVICE CLASS TABLE.
*
* SCLASS NM,MN,DF,ST,TX
*
* ENTRY *NM* = SERVICE CLASS NAME.
* *MN* = TWO CHARACTER MNEMONIC.
* *DF* = DAYFILE MESSAGE CHARACTER.
* *ST* = SHORT TEXT FOR *QFTLIST*.
* *TX* = TEXT OF SERVICE CLASS NAME FOR BANNER PAGE.
*
* NOTE - THE CALL TO *COMSSCD* MUST FOLLOW THE DEFINITION OF
* THIS MACRO.
PURGMAC SCLASS
SCLASS MACRO NM,MN,DF,ST,TX
.SCL RMT
VFD 12/0L_MN,48/NM TX
.SCL RMT
SCLASS ENDM
SCL$ EQU 0 ONLY PROCESS CLSSES WITH JCB-S
*CALL COMSSCD
TITLE DEFINITIONS.
* ASSEMBLY CONSTANTS.
IBFL EQU 3 INPUT BUFFER LENGTH
LMSG EQU 4 LENGTH OF TIMESHARING MESSAGES.
OBFL EQU 200D OUTPUT BUFFER LENGTH
SCTL EQU 37D SERVICE CLASS TABLE LENGTH
SPACE 4,10
* FETS.
ORG 110B
FWA BSS 0 SET ORIGIN ADDRESS
INPUT FILEC INBUF,IBFL INPUT FET
O BSS 0
OUTPUT FILEC OUTBUF,OBFL OUTPUT FET
SPACE 4,10
* SPECIAL ENTRY POINT.
SSJ= EQU SSJP
SPACE 4,10
* WORKING STORAGE.
ABTF CON 0 ABORT OPTION FLAG
ARGE CON 0 *CLASS* ARGUMENT ERROR FLAG
ASFG CON 0 *ASCII* CHARACTER SET FLAG
CPMB CON 0 CONTROL POINT MANAGER PARAMETER BLOCK
DOUT VFD 42/0LOUTPUT,18/1 DEFAULT OUTPUT FILENAME
JORG CON 0 JOBS CURRENT ORIGIN TYPE
JOSC CON 0 JOBS CURRENT SERVICE CLASS
JSNA CON 0 JOB TO HAVE SERVICE CLASS CHANGED
NUMA CON 0 NUMBER OF *CLASS* ARGUMENTS
NUSC CON 0 NUMBER OF VALIDATED SERVICE CLASSES
ORGN CON 0 ORIGIN JOB IS ENQUIRING UPON
POUT CON 0 PROPOSED OUTPUT FILENAME
RDMU CON 10D RANGE DETERMINATOR MULTIPLIER
ROLT VFD 48/SCFE,12/SCRT ROLLOUT EVENT AND TIME INTERVAL
SERC CON 0 SERVICE CLASS MNEMONIC
SERV CON 0 DESIRED SERVICE CLASS (CHARACTER/VALUE)
TFLG CON 0 TIMESHARING ORIGIN FLAG (IAOT)
TTFG CON 0 INPUT/OUTPUT FILE *TT* TYPE FLAG
TTST CON 0 *TSTATUS* PARAMETER BLOCK
CON 0
WRDO CON 0 NUMBER OF WORDS IN OUTBUF BUFFER
SPACE 4,10
* DAYFILE AND INTERACTIVE MESSAGES AND POSSIBLE REPLIES.
MSGA DATA C* INCORRECT SERVICE CLASS. *
MSGB DATA C* CLASS ARGUMENT ERROR.*
MSGC DATA C* SERVICE CLASS FULL. *
MSGD DATA C* UNDEFINED SERVICE CLASS. *
MSGE DATA C* WAITING FOR SERVICE CLASS CHANGE TO SC.*
MSGF DATA C* CLASS COMPLETE.*
MSGG DATA C* INCORRECT OPTION ARGUMENT.*
MSGH DATA C* UNDEFINED ORIGIN TYPE.*
MSGI DATA C* INCORRECT OUTPUT FILENAME.*
MSGJ DATA C* SC ONLY PARAMETER VALID WITH JSN.*
MSGK DATA C* SERVICE CLASS REQUIRED WITH JSN.*
MSGL DATA C* JSN NOT FOUND. *
MSGM DATA C* CANNOT CHANGE CLASS OF ON-LINE JOB.*
MSGN DATA C* INCORRECT JSN ARGUMENT.*
MSPO DATA C* JOB ALREADY WAITING ON SERVICE CLASS.*
MSPQ DATA C* CANNOT CHANGE CLASS OF SUBSYSTEM.*
TITLE TABLE DEFINITIONS.
BQAC SPACE 4,10
** BQAC - *QAC* PARAMETER BLOCK.
*
* PREFIX PORTION.
BQAC VFD 50/0,9/ALFC,1/0 *ALTER*
VFD 36/0,6/ALLB-5,18/0
VFD 60/0
VFD 60/0
VFD 60/0
* SELECTION CRITERIA PORTION.
VFD 60/0
VFD 60/0
BJSN VFD 24/0,36/JSSF JSN
VFD 12/INQQ+EXQQ,48/0
VFD 60/0
VFD 60/0
VFD 60/0
* *ALTER* FUNCTION PORTION.
VFD 30/0,6/0,12/CLAF,12/0 SERVICE CLASS FLAG
VFD 60/0
VFD 60/0
BCLS VFD 42/0,12/0,6/0 NEW SERVICE CLASS
VFD 60/0
GTDT SPACE 4,10
** GTDT - GENERATE TERMINAL DISPLAY TABLE.
*
* INTERACTIVE DISPLAY TEMPLATE.
GTDA DATA C* AVAILABLE SERVICE CLASSES*
DATA C* *
DATA C* ---RELATIVE PRIORITY---*
DATA C* CLASS INPUT FILES EXECUTING JOBS OUTPUT FILES*
GTDAL EQU *-GTDA
GTDB DATA C* *
GTDB1 DATA C* ENTER CLASS: "EB"*
GTDBL EQU *-GTDB
GTDC DATA C*CURRENT*
GTDD DATA C/ SC * * * /
GTDDL EQU *-GTDD
TORT SPACE 4,10
** TORT - TABLE OF ORIGIN TYPES.
*
*T 12/ORIGIN, 48/VLAUE
*
* ORIGIN - TWO CHARACTER ORIGIN TYPE.
* VALUE - CORRESPONDING ORIGIN TYPE VALUE.
TORT BSS 0
VFD 12/0LSY,48/SYOT+4000B SYSTEM ORIGIN TYPE
VFD 12/0LBC,48/BCOT BATCH ORIGIN TYPE
VFD 12/0LEI,48/RBOT REMOTE BATCH ORIGIN TYPE
VFD 12/0LTX,48/IAOT INTERACTIVE ORIGIN TYPE
VFD 12/0LRB,48/RBOT REMOTE BATCH ORIGIN TYPE
VFD 12/0LIA,48/IAOT INTERACTIVE ORIGIN TYPE
TORTL EQU *-TORT
TSCT SPACE 4,10
** TSCT - SERVICE CLASS TABLE.
*
*T 12/CLASS, 48/VALUE
*
* CLASS - VALID SERVICE CLASS.
* VALUE - CORRESPONDING SERVICE CLASS VALUE.
TSCT BSS 0
LIST D
.SCL HERE
LIST *
CON 0 END OF TABLE
TSCTL EQU *-TSCT-1
ERRNZ TSCTL-MXJC+1 ENSURE ALL SERVICE CLASSES PRESENT
CLASS TITLE MAIN PROGRAM.
** CLASS - MAIN PROGRAM.
CLASS BSS 0 ENTRY
RJ PRS PRESET
SA2 ARGE
SX4 X2-3
ZR X4,CLA2 IF UNDEFINED SERVICE CLASS
ZR X2,CLA1 IF NO ARGUMENT ERROR
RJ AEM ABORT AND ISSUE ERROR MESSAGE
EQ CLA5 END OF COMMAND PROCESSING
* GENERATE DISPLAY AND/OR ATTEMPT TO CHANGE SERVICE CLASS.
CLA1 SA2 ARGE
NZ X2,CLA2 IF ARGUMENT ERROR
SA2 SERV
ZR X2,CLA3 IF NO SERVICE CLASS ARGUMENT
RJ VCS VALIDATE/CHANGE SERVICE CLASS
SA2 ARGE
ZR X2,CLA4 IF SERVICE CLASS CHANGE COMPLETED
CLA2 RJ AEM ISSUE ERROR MESSAGE
WRITEW O,X3,LMSG DISPLAY ERROR MESSAGE
WRITER O,R
SA1 JSNA
NZ X1,CLA5 IF JSN SPECIFIED
CLA3 SETFET O,(BUF=OUTBUF,OBFL)
RJ GTD GENERATE TERMINAL DISPLAY
SA1 NUSC
ZR X1,CLA4 IF NO SERVICE CLASS AVAILABLE
SA1 TTFG
ZR X1,CLA4 IF FILE TYPE NOT *TT*
SA1 TFLG
ZR X1,CLA4 IF NOT *IAOT*
SA1 ORGN
NZ X1,CLA4 IF DISPLAY BUILT FOR SPECIFIED ORIGIN
WRITEW O,GTDB,GTDBL
WRITER O FLUSH BUFFER
SETFET INPUT,(BUF=INBUF,IBFL)
READ INPUT,R READ REPONSE
READC INPUT,INBUF,IBFL
NZ X1,CLA4 IF NO SERVICE CLASS ENTERED
RJ VTI VALIDATE TIMESHARING INPUT
EQ CLA1 VALIDATE NEW ARGUMENTS
* TERMINATION PROCESSING.
CLA4 MESSAGE MSGF,3,R * CLASS COMPLETE.*
CLA5 SA1 TFLG
ZR X1,CLA6 IF NOT TIMESHARING
PROMPT ON
SA1 ASFG
ZR X1,CLA6 IF NOT ASCII
CSET ASCII
CLA6 ENDRUN
SPACE 4,10
TITLE SUBROUTINES.
AEM SPACE 4,10
** AEM - ABORT AND/OR ISSUE ERROR MESSAGE.
*
* ENTRY (X3) = ADDRESS OF DAYFILE MESSAGE.
* (ABTF) = ABORT OPTION PRESENT FLAG
* (ARGE) = ARGUMENT ERROR FLAG
*
* EXIT (X3) = ADDRESS OF DAYFILE MESSAGE.
* (ARGE)= RESET TO ZERO.
*
* USES X - 1, 2, 4, 6.
* A - 1, 2, 4, 6.
*
* MACROS ABORT, CSET, MESSAGE.
AEM SUBR ENTRY/EXIT
MESSAGE X3,3 ISSUE DAYFILE MESSAGE
SA2 ARGE GET ARGUMENT ERROR FLAG
SA4 ABTF GET ABORT OPTION FLAG
SX6 B0+
SA6 A2 RESET *ARGE*
BX4 X2*X4
ZR X4,AEMX IF NOT ERROR OR NOT ABORT OPTION
SA1 TFLG
ZR X1,AEM1 IF CALLING JOB NOT TIMESHARING
SA1 ASFG
ZR X1,AEM1 IF CHARACTER SET *NORMAL*
CSET ASCII SET *ASCII* 128 CHARACTER SET MODE
AEM1 ABORT
DPM SPACE 4,10
** DPM - DETERMINE PRIORITY MULTIPLIERS.
*
* ENTRY (RDMU) = RANGE DETERMINATOR MULTIPLIER.
* (USCP) = BUFFER CONTAINS VALIDATED SERVICE CLASSES,
* LOWER BOUND INPUT, UPPER BOUND EXECUTION
* AND LOWER BOUND OUTPUT PRIORITIES.
*
* EXIT (NUSC) = NUMBER OF ENTRIES IN *USCP*.
* (USCP) = BUFFER CONTAINS VALIDATED SERVICE CLASSES,
* RELATIVE INPUT, RELATIVE EXECUTION AND
* RELATIVE OUTPUT PRIORITIES.
*
* USES X - ALL.
* A - 1, 5, 6.
* B - 3, 4, 5, 6, 7.
DPM SUBR ENTRY/EXIT
SB4 B0+
SA1 USCP
SB5 B1 SET FIELD FLAG
MX0 -12
LX1 -12 EXTRACT NUMBER OF RETURNED SERVICE CLASSES
BX6 -X0*X1
SA6 NUSC
SB6 X6
BX7 X6
* FIND HIGHEST INPUT, EXECUTION OR OUTPUT PRIORITY IN *USCP*.
DPM1 SA1 A1+B1 OBTAIN SERVICE CLASS PRIORITY
ZR X7,DPM3 IF END OF SERVICE CLASSES
SX7 X7-1 DECREMENT NUMBER OF SERVICE CLASSES
BX2 -X0*X1
EQ B5,B1,DPM2 IF PROCESSING OUTPUT PRIORITY
LX2 -12D
ZR B5,DPM2 IF PROCESSING EXECUTION PRIORITY
LX2 -12D
DPM2 SB3 X2
LE B3,B4,DPM1 IF NOT HIGHER PRIORITY
SB4 B3
EQ DPM1 PROCESS NEXT ENTRY
* CALCULATE PRIORITY MULTIPLIER (A = 10 * (P / H)) WHERE
* P IS SERVICE CLASSES PRIORITY AND H IS THE MAXIMUM P.
* THE MULTIPLIERS FOR INPUT, EXECUTION AND OUTPUT PRIORITIES
* ARE COMPUTED INDEPENDENTLY. THE RESULT IS ROUNDED.
DPM3 SX7 B6+
ZR B4,DPM7 IF HIGHEST PRIORITY IS ZERO
SA1 USCP
SX4 B4
PX4 X4
NX4 X4
SA5 RDMU GET RANGE DETERMINATOR MULTIPLIER
PX5 X5
ZX5 X5
DPM4 SA1 A1+B1
ZR X7,DPM7 IF END OF SERVICE CLASSES
SX7 X7-1 DECREMENT NUMBER OF SERVICE CLASSES
BX3 -X0*X1 OBTAIN SERVICE CLASS PRIORITY
EQ B5,B1,DPM5 IF PROCESSING OUTPUT PRIORITY
LX3 -12D
ZR B5,DPM5 IF PROCESSING EXECUTION PRIORITY
LX3 -12D
DPM5 PX3 X3
NX3 X3
RX3 X3/X4 CALCULATE RELATIVE PRIORITY
RX3 X3*X5
UX3,B7 X3 UNPACK MULTIPLIER
LX3 X3,B7
EQ B5,B1,DPM6 IF PROCESSING OUTPUT PRIORITY
LX3 12D
ZR B5,DPM6 IF PROCESSING EXECUTION PRIORITY
LX3 12D
DPM6 BX6 X0*X1 EXTRACT SERVICE CLASS
BX6 X3+X6 CREATE NEW TABLE ENTRY
SA6 A1+
EQ DPM4 CALCULATE NEXT *USCP* ENTRY
DPM7 SX7 B6
NG B5,DPMX IF ALL MULTIPLIERS COMPUTED
SB4 B0 RESET HIGHEST PRIORITY TO ZERO
SB5 B5-B1 UPDATE FIELD FLAG
LX0 12
SA1 USCP
EQ DPM1 PROCESS OUTPUT PRIORITY
GTD SPACE 4,15
** GTD - GENERATE TERMINAL DISPLAY.
*
* ENTRY (SERV) = SET TO DESIRED SERIVCE CLASS.
* (TSCT) = TABLE OF VALIDATED SERVICE CLASSES.
*
* EXIT (GTDF) = SET GENERATED DISPLAY FLAG.
* (OUTBUF) = CONTAINS SERVICE CLASSES FOR DISPLAY.
*
* USES X - ALL.
* A - 1, 2, 3, 5, 7.
* B - 3, 4, 5, 6, 7.
*
* CALLS DFM, SCB, SRT.
*
* MACROS GETUSC, WRITER, WRITEW.
GTD SUBR ENTRY/EXIT
* SETUP *GETUSC* PARAMETER BLOCK.
SX6 SCTL SET LENGTH OF *USCP*
MX0 -11
LX6 -12
SA2 JORG GET JOBS CURRENT ORIGIN TYPE
SA1 SERV
NZ X1,GTD1 IF SERVICE CLASS ARGUMENT SPECIFIED
SA2 ORGN GET SPECIFIED ORIGIN ARGUMENT
NZ X2,GTD1 IF SPECIFIED ORIGIN ARGUMENT EXISTS
SA2 JORG
GTD1 BX2 -X0*X2 CLEAR *SY* ENTRY FLAG
BX6 X6+X2 SET ORIGIN OF INQUIRY
LX6 24
SA6 USCP
GETUSC USCP OBTAIN VALIDATED SERVICE CLASS
RJ DPM DETERMINE PRIORITY MULTIPLIERS
RJ SRT SORT *USCP* IN DESCENDING ORDER
SA1 NUSC NUMBER OF *USCP* ENTRIES TO PROCESS
SX0 X1+
ZR X0,GTDX IF NO SERVICE CLASS RETURNED
SA5 USCP SET VALIDATED SERVICE CLASS TABLE
SB7 OUTBUF+GTDAL SET FWA WORKING BUFFER
GTD2 SB4 GTDDL MOVE DISPLAY LINE TO BUFFER
SB3 GTDD
GTD3 SB4 B4-B1
SA1 B3+B4
BX7 X1
SA7 B7+B4
NE B4,B0,GTD3 IF NOT END OF DISPLAY LINE
SA5 A5+B1 SET CHARACTER STRING
BX6 X5
SB3 GTDT SET ADDRESS OF LINE DESCRIPTOR ENTRY
RJ SCB SET SERVICE CLASS IN DISPLAY LINE
SA1 =10H********** SET CHARACTER STRING
BX6 X1
LX5 36
SB6 B1+
GTD4 MX1 -6 INSERT CHARACTER COUNT IN FORMAT TABLE
SA3 B6+GTDT
BX4 -X1*X5
LX1 36
BX7 X1*X3
LX4 36
SB3 A3 SET ADDRESS OF LINE DESCRIPTOR
BX7 X7+X4
SA7 A3
RJ SCB SET PRIORITY IN DISPLAY
SB6 B6+B1
SB5 4
LX5 12
NE B6,B5,GTD4 IF NOT END OF PRIORITIES
SA2 JOSC GET CURRENT SERVICE CLASS
SB5 X2-1
MX1 12
LX5 48
SA2 B5+TSCT GET DISPLAY CODE EQUIVALENT
BX4 X1*X2
BX3 X1*X5
BX1 X3-X4
NZ X1,GTD5 IF NOT CURRENT SERVICE CLASS
SA3 GTDC SET *CURRENT* IN DISPLAY
BX7 X3
SA7 B7+GTDDL-1
GTD5 SB7 B7+GTDDL
SX0 X0-1 DECREMENT SERVICE CLASS COUNT
NZ X0,GTD2 IF NOT END OF SERVICE CLASSES
SX7 B7-OUTBUF-GTDAL COMPUTE DISPLAY LENGTH
SA7 WRDO SAVE NUMBER OF WORDS WRITTEN TO *OUTBUF*
* DISPLAY AVAILABLE SERVICE CLASSES AND HISTOGRAMS.
WRITEW O,GTDA,GTDAL WRITE CLASS DISPLAY HEADER
SA1 WRDO
WRITEW O,OUTBUF+GTDAL,X1 DISPLAY AVAILABLE SERVICE CLASSES
WRITER O FLUSH BUFFER
EQ GTDX RETURN
* GTDT - SET CHARACTERS IN BUFFER FORMAT DESCRIPTION TABLE.
GTDT VFD 12/0,6/1,6/2,36/0 SC
VFD 12/0,6/8,6/0,36/0 IN
VFD 12/2,6/2,6/0,36/0 EX
VFD 12/3,6/7,6/0,36/0 OUT
SRT SPACE 4,10
** SRT - SORT TABLE INTO DESENDING ORDER USING MULTIPLIER FIELD.
*
* ENTRY (USCP) = TABLE ENTRIES UNSORTED.
*
* EXIT (USCP) = TABLE SORTED INTO DESCENDING ORDER.
*
* USES X - ALL.
* A - 1, 6, 7.
* B - 3, 5, 7.
SRT SUBR ENTRY/EXIT
SA1 NUSC GET NUMBER OF SERVICE CLASS ENTRIES
SB3 X1+
SX1 X1-1
ZR X1,SRTX IF ONLY ONE ENTRY TO SORT IN *USCP* TABLE
MX0 -12
LX0 12 SORT ON UPPER BOUND EXECUTION PRIORITY
SRT1 SB7 B0+ CLEAR CHANGE FLAG
SB5 B1+ RESET ENTRY COUNT
SA1 USCP+B1 READ FIRST SERVICE CLASS ENTRY IN *USCP*
BX6 X1 TRANSFER CONTENTS TO CURRENT
BX2 -X0*X6 EXTRACT MULTIPLIER FROM CURRENT ENTRY
* COMPARE CURRENT AND NEXT TABLE ENTRIES.
SRT2 SA1 A1+B1 READ NEXT ENTRY IN *USCP*
BX4 -X0*X1 EXTRACT MULTIPLIER FROM NEXT ENTRY
BX7 X1 TRANSFER CONTENTS TO NEXT
IX1 X2-X4
ZR X1,SRT4 IF CURRENT MULTIPLIER EQUALS NEXT
NG X1,SRT4 IF CURRENT MULTIPLIER IS LESS THAN NEXT
* SWAP CURRENT ENTRY WITH NEXT ENTRY.
SRT3 SB7 B1+ SET CHANGE FLAG
BX5 X7 TEMP IS ASSIGNED NEXT
BX3 X4
BX7 X6 NEXT IS ASSIGNED CURRENT
BX4 X2
BX6 X5 CURRENT IS ASSIGNED TEMP
BX2 X3
SA6 A1-B1 WRITE CURRENT INTO *USCP* TABLE
SA7 A1 WRITE NEXT INTO *USCP* TABLE
* CURRENT IS NOW ASSIGNED VALUE OF NEXT.
SRT4 BX6 X7 CURRENT IS ASSIGNED NEXT
BX2 X4
SB5 B5+B1 INCREMENT NUMBER OF ENTRIES PROCESSED
LT B5,B3,SRT2 IF NOT END OF *USCP* TABLE
ZR B7,SRTX IF TABLE FULLY SORTED
SB3 B3-B1 DECREMENT NUMBER OF ENTRIES TO PROCESS
EQ SRT1 START NEXT PASS ON LIST
VCS SPACE 4,15
** VCS - VALIDATE AND CHANGE SERVICE CLASS.
*
* ENTRY (SERV) = CONTAINS DESIRED SERVICE CLASS.
* (TFLG) = TIMESHARING FLAG.
*
* EXIT (X3) = ERROR MESSAGE.
* (ARGE) = ARGUMENT ERROR FLAG SET.
*
* USES X - 0, 1, 2, 3, 4, 5, 6.
* A - 1, 2, 4, 5, 6.
* B - 4, 5.
*
* CALLS COMCCPM, *QAC*.
*
* MACROS MESSAGE, ROLLOUT, SYSTEM.
VCS SUBR ENTRY/EXIT
SA4 JSNA
NZ X4,VCS3 IF JSN SPECIFIED
SA2 SERV
SB5 X2+
SA4 JOSC GET CURRENT SERVICE CLASS
SB4 X4+
EQ B4,B5,VCS7 IF SAME AS CURRENT SERVICE CLASS
BX6 X2
SA6 CPMB
VCS1 SX1 CPMB SET PARAMETER BLOCK LOCATION
SX2 124B SET FUNCTION CODE
RJ =XCPM= ATTEMPT TO CHANGE SERVICE CLASS
MX0 -6
SA1 CPMB CHECK FOR ERROR
LX1 -6
BX2 -X0*X1
ZR X2,VCS7 IF SERVICE CLASS CHANGE ACCEPTED
SX2 X2-1
SX6 B1+ SET ARGUMENT ERROR FLAG
SA6 ARGE
ZR X2,VCS6 IF UNDEFINED SERVICE CLASS
SX2 X2-1
ZR X2,VCS4 IF INVALID SERVICE CLASS
SA1 TFLG
NZ X1,VCS5 IF TIMESHARING JOB
SA1 ABTF
NZ X1,VCS5 IF ABORT OPTION
VCS2 SA5 MSGE+3 INSERT SERVICE CLASS INTO MESSAGE
MX0 -12D
LX0 6
BX5 X0*X5
SA2 TSCT+B5-1
LX2 18D
BX2 -X0*X2
BX6 X5+X2
SA6 A5+
MESSAGE MSGE,1,R ISSUE * WAITING FOR SERVICE CLASS XX.*
ROLLOUT ROLT ROLLOUT BATCH JOB
EQ VCS1 TRY TO CHANGE SERVICE CLASS AGAIN
* CALL *QAC* TO CHANGE THE SERVICE CLASS OF SPECIFIED JOB.
VCS3 SA2 SERC PUT SERVICE CLASS IN *QAC* BLOCK
LX2 18
SA1 BCLS
BX6 X1+X2
SA6 A1
SA4 JSNA PUT JSN IN *QAC* PARAMETER BLOCK
SA2 BJSN
BX6 X2+X4
SA6 A2
SYSTEM QAC,R,BQAC
SA1 BQAC CHECK FOR ERROR
MX0 -8D
AX1 10D
BX2 -X0*X1
ZR X2,VCS7 IF SERVICE CLASS CHANGE ACCEPTED
SX6 B1 SET ARGUMENT ERROR FLAG
SA6 ARGE
SX1 X2-ER24
ZR X1,VCS5 IF SERVICE CLASS FULL
SX4 X2-ER25
ZR X4,VCS8 IF ON-LINE JOB
SX1 X2-ER26
ZR X1,VCS6 IF UNDEFINED SERVICE CLASS
SX4 X2-ER27
ZR X4,VCS9 IF WAITING ON *CLASS*
SX1 X2-ER28
ZR X1,VCS10 IF SUBSYSTEM SERVICE CLASS
SX4 X2-ER07
ZR X4,VCS11 IF JSN NOT FOUND
VCS4 SX3 MSGA * INCORRECT SERVICE CLASS.*
EQ VCSX RETURN
VCS5 SX3 MSGC * SERVICE CLASS FULL.*
EQ VCSX RETURN
VCS6 SX3 MSGD * UNDEFINED SERVICE CLASS.*
EQ VCSX RETURN
VCS7 SX6 B0+
SA6 ARGE CLEAR ARGUMENT ERROR FLAG
EQ VCSX RETURN
VCS8 SX3 MSGM * CANNOT CHANGE ON-LINE JOB.*
EQ VCSX RETURN
VCS9 SX3 MSPO * JOB ALREADY WAITING ON SERVICE CLASS.*
EQ VCSX RETURN
VCS10 SX3 MSPQ * CANNOT CHANGE CLASS OF SUBSYSTEM.*
EQ VCSX RETURN
VCS11 SX3 MSGL * JSNA NOT FOUND.*
SA2 JSNA SET JSN IN MESSAGE
SA1 MSGL
MX0 24
LX0 -6
BX4 -X0*X1
LX2 -6
BX6 X2+X4
SA6 A1
EQ VCSX RETURN
VTI SPACE 4,10
** VTI - VALIDATE TIMESHARING INPUT.
*
* ENTRY (SERV) = SERVICE CLASS INPUT BY USER (CHARACTER).
*
* EXIT (ARGE) = ARGUMENT ERROR FLAG
* (SERV) = SERVICE CLASS (VALUE).
*
* USES X - 0, 1, 2, 3, 4, 6.
* A - 1, 3, 6.
VTI SUBR ENTRY/EXIT
SA3 TSCT-1
MX0 12
SA1 INBUF GET TIMESHARING USERS INPUT
BX2 X0*X1
BX3 -X0*X1
SX6 B0 RESET INPUT BUFFER
SA6 A1
ZR X3,VTI2 IF NOT MORE THAN THREE CHARACTERS
VTI1 SA1 ARGE
SX6 B1 SET ARGUMENT ERROR FLAG
SA6 A1
SX3 MSGD SET * UNDEFINED SERVICE CLASS.*
EQ VTIX RETURN
* DETERMINE IF ENTERED SERVICE CLASS IS DEFINED.
VTI2 SA3 A3+B1 GET *TSCT* TABLE ENTRY
ZR X3,VTI1 IF END OF *TSCT* TABLE
BX4 X0*X3
BX4 X4-X2 COMPARE TABLE ENTRY TO ENTERED CLASS
NZ X4,VTI2 IF NO MATCH
MX0 -12
BX6 -X0*X3 EXTRACT CORRESPONDING SERVICE CLASS VALUE
SA6 SERV SAVE DESIRED SERVICE CLASS VALUE
EQ VTIX RETURN
SPACE 4,10
* COMMON DECKS.
*CALL COMCCIO
*CALL COMCCPM
*CALL COMCRDC
*CALL COMCRDW
*CALL COMCSCB
*CALL COMCSFN
*CALL COMCSYS
*CALL COMCWTW
SPACE 4,10
* BUFFERS.
USE LITERALS
INBUF EQU * INPUT BUFFER
USCP EQU INBUF+IBFL INPUT BUFFER
OUTBUF EQU USCP+SCTL OUTPUT BUFFER
OUTBUFL EQU OUTBUF+OBFL OUTPUT BUFFER LIMIT
TITLE PRESET.
PRS SPACE 4,20
** PRS - PRESET.
*
* *PRS* DETERMINES ORIGIN, SERVICE CLASS, AND TERMINAL
* CHARACTERISTICS.
*
* EXIT (ASFG) = SET TO ONE IF *ASCII* USER.
* (DOUT) = SET TO DEFAULT OUTPUT FILENAME.
* (JORG) = SET TO CURRENT JOBS ORIGIN.
* (JOSC) = SET TO CURRENT JOBS SERVICE CLASS.
* (TFLG) = SET TO ONE IF TIMESHARING USER.
* (TTFG) = SET TO ONE IF INPUT FILE TYPE IS *TT*.
*
* USES X - 0, 1, 2, 6.
* A - 1, 6.
* B - 1.
*
* CALLS CCP, STF.
*
* MACROS CSET, GETJOSC, PROMPT, TSTATUS.
PRS SUBR ENTRY/EXIT
SB1 1 SYSTEM COMMUNICATION (B1)=1
* DETERMINE JOB ORIGIN AND SERVICE CLASS.
GETJOSC JOSC GET CURRENT SERVICE CLASS
SA1 JOSC
MX0 -6
LX1 -6
BX6 -X0*X1
SA6 A1+
LX1 6
BX6 -X0*X1
SA1 JORG GET JOB ORIGIN TYPE
SA6 A1
SX1 X6-IAOT
NZ X1,PRS2 IF NOT *IAOT*
SX6 B1+ SET TIMESHARING FLAG
SA6 TFLG
* DETERMINE TERMINAL CHARACTERISTICS.
TSTATUS TTST GET TERMINAL STATUS
SA1 B1+TTST GET CURRENT CHARACTER SET
MX0 1
LX0 3
BX1 X0*X1
ZR X1,PRS1 IF NOT 64 CHARACTER SET
BX6 X1 SET *ASCII* FLAG
SA6 ASFG
CSET NORMAL SET TERMINAL CHARACTER MODE
PRS1 PROMPT OFF SUPPRESS *IAF* PROMPTS
PRS2 RJ CCP CRACK *CLASS* PARAMETERS
SX2 INPUT
RJ STF DETERMINE IF INPUT FILE TYPE *TT*
SX2 O
RJ STF DETERMINE IF OUTPUT FILE TYPE *TT*
NZ X6,PRS3 IF FILE TYPE NOT *TT*
SX6 B1+
SA6 TTFG STORE *TT* FILE TYPE FLAG
PRS3 SA1 SERV
ZR X1,PRS5 IF NO SERVICE CLASS ARGUMENT
PRS4 SA1 DOUT RESET *L* TO OUTPUT
BX6 X1
SA6 O
SX6 B0
SA6 ORGN CLEAR SPECIFIED ORIGIN ARGUMENT
EQ PRSX RETURN
PRS5 SA1 ARGE
ZR X1,PRSX IF NO ARGUMENT ERROR
EQ PRS4 RESET *L* TO OUTPUT
TITLE PRESET SUBROUTINES.
CCP SPACE 4,20
** CCP - CRACK *CLASS* PARAMETERS.
*
* ENTRY (X3) = ADDRESS OF ERROR MESSAGE TO BE DISPLAYED.
*
* EXIT (X3) = ADDRESS OF ERROR MESSAGE TO BE DISPLAYED.
* (ABTF) = SET TO ONE IF ABORT OPTION PRESENT.
* (ARGE) = SET TO ONE IF ARGUMENT ERROR OCCURS.
* (NUMA) = SET TO NUMBER OF *CLASS* ARGUMENTS.
* (ORGN) = SET TO ORIGIN OF INQUIRY.
* (POUT) = PROPOSED OUTPUT FILENAME.
* (SERV) = SET TO DESIRED SERVICE CLASS.
*
* USES X - 1, 2, 3, 4, 6.
* A - 1, 2, 6.
* B - 2, 3, 4, 6, 7.
*
* CALLS ARM, CPA, FNB, USB, VCP.
CCP SUBR ENTRY/EXIT
SA1 ACTR
SX6 X1
SA6 NUMA STORE NUMBER OF ARGUMENTS
ZR X6,CCPX IF NO ARGUMENTS
CCP1 SB2 CCDR UNPACK CONTROL CARD
SB3 B0+ FOR NORMAL CHARACTER SET
RJ USB
SA1 A6 ASSURE TERMINATOR CHARACTER
SX6 1R.
SA6 X1+B1
SA2 CCPB SET SEPARATOR MASK
SB2 60 SET MAXIMUM NON-DELIMITER DISPLAY CODE
SB7 CCP4 SET EXIT FOR TERMINATOR CHARACTER
RJ FNB FIND NON-BLANK CHARACTER
* OBTAIN *CLASS* ARGUMENTS.
SB7 CCPX SET EXIT FOR TERMINATOR CHARACTER
CCP2 RJ FNB FIND NON-BLANK CHARACTER
SB4 B5-B2
LX4 X2,B5
PL B4,CCP3 IF SEPARATOR CHARACTER
PL X4,CCP2 IF NOT SEPARATOR CHARACTER
CCP3 SB3 TARG FWA ARGUMENT EQUIVALENCE TABLE
SB2 TARGL LENGTH ARGUMENT TABLE
SB4 CCPA ADDRESS TO PLACE DATA
RJ CPA CONVERT POSITIONAL ARGUMENTS
NG B5,CCP4 IF ARGUMENT ERROR
PL X1,CCPX IF NO ARGUMENTS PROCESSED
SX6 B5 SET LWA OF ARGUMENTS
SA6 USBC
SB6 CCPA FWA OF ARGUMENTS
RJ ARM PROCESS ARGUMENTS
NZ X1,CCP4 IF ERROR
RJ VCP VALIDATE *CLASS* PARAMETER(S)
EQ CCPX RETURN
* FLAG ARGUMENT ERROR CONDITION.
CCP4 SX6 B1+
SA6 ARGE SET ARGUMENT ERROR FLAG
SX3 MSGB SET * CLASS ARGUMENT ERROR.*
EQ CCPX RETURN
CCPA BSS 100
CCPB CON 40000000000033127777B SEPARATOR MASK
TARG SPACE 4,10
* TARG - ARGUMENT TABLE.
TARG BSS 0
SC ARG SERV,SERV,0,0 DESIRED JOB SERVICE CLASS
OT ARG ORGN,ORGN,0,0 ORIGIN OF INQUIRY
L ARG POUT,POUT,0,0 PROPOSED OUTPUT FILENAME
OP ARG ABTF,ABTF,0,0 ABORT OPTION
JSN ARG JSNA,JSNA,0,0 DESIRED JSN
ARG
TARGL EQU *-TARG-1 LENGTH OF ARGUMENT TABLE
FNB SPACE 4,15
** FNB - FIND NON-BLANK CHARACTER.
*
* ENTRY (B6) = NEXT CHARACTER ADDRESS.
* (B7) = EXIT ADDRESS, IF TERMINATOR ENCOUNTERED.
*
* EXIT (X1) = (B5) = NEXT NON-BLANK CHARACTER.
* (B6) = NEXT CHARACTER ADDRESS (UPDATED).
* EXIT IS MADE TO (B7), IF TERMINATOR ENCOUNTERED.
*
* USES X - 1, 4.
* A - 1.
* B - 5, 6.
FNB SUBR ENTRY/EXIT
FNB1 SA1 B6 GET NEXT CHARACTER
SB6 B6+B1
SX4 X1-1R
ZR X4,FNB1 IF BLANK CHARACTER
SB5 X1+
SX4 X1-1R.
ZR X4,FNB2 IF TERMINATOR CHARACTER
SX4 X1-1R)
NZ X4,FNBX IF NOT TERMINATOR CHARACTER, RETURN
FNB2 JP B7 PROCESS TERMINATOR CHARACTER
VCP SPACE 4,15
** VCP - VALIDATE *CLASS* PARAMETERS.
*
* ENTRY (X3) = ADDRESS OF ERROR MESSAGE TO BE DISPLAYED.
* (ORGN) = ORIGIN OF INQUIRY.
* (POUT) = PROPOSED OUTPUT FILENAME.
* (SERV) = SET TO DESIRED SERVICE CLASS.
*
* EXIT (X3) = ADDRESS OF ERROR MESSAGE TO BE DISPLAYED.
* (ARGE) = SET TO ONE IF ARGUMENT ERROR OCCURS.
* (SERV) = SET TO DESIRED SERVICE CLASS.
*
* USES X - 0, 1, 2, 3, 6, 7.
* A - 1, 2, 6, 7.
* B - 2, 5, 7.
VCP14 SX6 B1+ SET ARGUMENT ERROR FLAG
SA6 ARGE
VCP SUBR ENTRY/EXIT
SA1 TSCT-1
SB7 TSCTL NUMBER OF SERVICE CLASSES
MX0 12
SA2 SERV GET STORED SERVICE CLASS ARGUMENT
BX7 X2
SA7 SERC
ZR X2,VCP1 IF NO SERVICE CLASS PARAMETER PRESENT
* CHECK FOR VALID SERVICE CLASS PARAMETER.
VCP0 SA1 A1+B1
ZR B7,VCP8 IF END OF TABLE
SB7 B7-B1 DECREMENT NUMBER OF SERVICE CLASSES
BX7 X0*X1
BX7 X7-X2 COMPARE CODES
NZ X7,VCP0 IF NO MATCH WITH TABLE ENTRY
MX0 -12
BX7 -X0*X1
SA7 A2+ SAVE SERVICE CLASS ARGUMENT AS VALUE
* CHECK FOR VALID ORIGIN PARAMETER.
VCP1 SA1 TORT-1
SB7 TORTL NUMBER OF ORIGINS
MX0 12
SA2 ORGN GET STORED ORIGIN TYPE ARGUMENT
ZR X2,VCP3 IF NO ORIGIN PARAMETER PRESENT
VCP2 SA1 A1+B1
ZR B7,VCP9 IF END OF TABLE
SB7 B7-B1 DECREMENT NUMBER OF ORIGINS
BX7 X0*X1
BX7 X7-X2 COMPARE CODES
NZ X7,VCP2 IF NO MATCH WITH TABLE ENTRY
MX0 -12
BX7 -X0*X1
SA7 A2+ SAVE ORIGIN ARGUMENT AS VALUE
* CHECK FOR VALID OUTPUT FILE PARAMETER.
VCP3 SA1 POUT GET PROPOSED OUTPUT FILENAME
ZR X1,VCP5 IF NO FILE NAME SPECIFIED
MX0 -6
LX0 12
BX2 -X0*X1
NZ X2,VCP10 IF EIGHT CHARACTERS
SB5 7 SET NUMBER OF ALLOWABLE CHARACTERS
MX0 -6
VCP4 LX1 6
SB5 B5-1 DECREMENT CHARACTER COUNT
BX2 -X0*X1
SB2 X2-45B SUBTRACT MAXIMUN LEGAL CHARACTER
PL B2,VCP10 IF INCORRECT CHARACTER
NZ B5,VCP4 IF NOT LAST CHARACTER OF FILENAME
SA1 POUT
SX2 B1 SET COMPLETE BIT
BX6 X1+X2
SA6 O
* CHECK FOR VALID OPTION ARGUMENT.
VCP5 SA1 ABTF
ZR X1,VCP6 IF NO ABORT OPTION PRESENT
SX6 1RA
LX6 -6
IX1 X1-X6 COMPARE OPTION ARGUMENT TO *A*
NZ X1,VCP11 IF INCORRECT OPTION ARGUMENT
SX6 B1
SA6 ABTF SET ABORT OPTION FLAG
* CHECK FOR VALID JSN ARGUMENT.
VCP6 SA1 JSNA
ZR X1,VCPX IF NO JSN ARGUMENT
MX0 -6
LX0 30
BX2 -X0*X1
NZ X2,VCP12 IF MORE THAN FOUR CHARACTERS
LX0 6
BX2 -X0*X1
ZR X2,VCP12 IF LESS THAN FOUR CHARACTERS
MX0 -6
SB5 4 SET NUMBER OF AVAILABLE CHARACTERS
VCP7 LX1 6
SB5 B5-1 DECREMENT CHARACTER COUNT
BX2 -X0*X1
SB2 X2-1R+ CHECK CHARACTER FOR ALPHANUMERIC
PL B2,VCP12 IF NOT VALID CHARACTER
NZ B5,VCP7 IF NOT LAST CHARACTER
SA1 POUT
NZ X1,VCP13 IF OUTPUT FILENAME NOT OUTPUT
SA2 ORGN
NZ X2,VCP13 IF ORIGIN SPECIFIED
SA1 ABTF
NZ X1,VCP13 IF ABORT OPTION SPECIFIED
SA2 SERV
NZ X2,VCPX IF SERVICE CLASS ARGUMENT EXISTS
* FLAG ARGUMENT ERROR CONDITION.
SX3 MSGK * SERVICE CLASS REQUIRED WITH JSN.*
EQ VCP14 SET ARGUMENT ERROR FLAG
VCP8 SX6 3
SA6 ARGE SET ARGUMENT ERROR FLAG
SX3 MSGD SET * UNDEFINED SERVICE CLASS.*
EQ VCP1 CONTINUE TO VALIDATE NEXT PARAMETER
VCP9 SX3 MSGH * UNIDENTIFIED ORIGIN TYPE.*
EQ VCP14 SET ARGUMENT ERROR FLAG
VCP10 SX3 MSGI * INCORRECT OUTPUT FILENAME.*
EQ VCP14 SET ARGUMENT ERROR FLAG
VCP11 SX6 B0+ RESET ABORT FLAG
SA6 ABTF
SX3 MSGG * INCORRECT OPTION ARGUMENT.*
EQ VCP14 SET ARGUMENT ERROR FLAG
VCP12 SX3 MSGN * INCORRECT JSN ARGUMENT.*
EQ VCP14 SET ARGUMENT ERROR FLAG
VCP13 SX3 MSGJ * SC ONLY PARAMETER VALID WITH JSN.*
EQ VCP14 SET ARGUMENT ERROR FLAG
SPACE 4,10
* PRESET COMMON DECKS.
*CALL COMCARM
*CALL COMCCPA
*CALL COMCPOP
*CALL COMCSTF
*CALL COMCUSB
SPACE 4,10
RFL= EQU *
END