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