CLASS 
          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 
