Retro1.org codex

User Tools

Site Tools

Trace: • CLASS
cdc:nos2.source:opl871:class

Table of Contents

CLASS

Table Of Contents

  • [00008] CLASS - CHANGE USER SERVICE CLASS.
  • [00012] CHANGE USER SERVICE CLASS.
  • [00172] DEFINE SERVICE CLASS TABLE.
  • [00197] DEFINITIONS.
  • [00261] TABLE DEFINITIONS.
  • [00263] BQAC - *QAC* PARAMETER BLOCK.
  • [00291] GTDT - GENERATE TERMINAL DISPLAY TABLE.
  • [00310] TORT - TABLE OF ORIGIN TYPES.
  • [00326] TSCT - SERVICE CLASS TABLE.
  • [00342] MAIN PROGRAM.
  • [00398] SUBROUTINES.
  • [00400] AEM - ABORT AND/OR ISSUE ERROR MESSAGE.
  • [00430] DPM - DETERMINE PRIORITY MULTIPLIERS.
  • [00518] GTD - GENERATE TERMINAL DISPLAY.
  • [00622] SRT - SORT TABLE INTO DESENDING ORDER USING MULTIPLIER FIELD.
  • [00677] VCS - VALIDATE AND CHANGE SERVICE CLASS.
  • [00801] VTI - VALIDATE TIMESHARING INPUT.
  • [00857] PRESET.
  • [00859] PRS - PRESET.
  • [00932] PRESET SUBROUTINES.
  • [00934] CCP - CRACK *CLASS* PARAMETERS.
  • [01014] FNB - FIND NON-BLANK CHARACTER.
  • [01040] VCP - VALIDATE *CLASS* PARAMETERS.

Source Code

CLASS.txt 
  1.           IDENT  CLASS,FWA,CLASS 
  2.           ABS
  3.           SST
  4.           ENTRY  CLASS
  5.           ENTRY  SSJ=
  6.           ENTRY  RFL=
  7.           SYSCOM B1
  8.           TITLE  CLASS - CHANGE USER SERVICE CLASS.
  9. *COMMENT  CLASS - CHANGE USER SERVICE CLASS.
  10.           COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
  11.           SPACE  4,10
  12. ***       CLASS - CHANGE USER SERVICE CLASS.
  13. *
  14. *         W. T. COLEMAN.      82/08/09.
  15.           SPACE  4,10
  16. ***       *CLASS* PERMITS THE SERVICE CLASS OF THE JOB TO BE
  17. *         CHANGED AT ANY TIME DURING A TERMINAL SESSION OR BY
  18. *         USING THE *CLASS* COMMAND WITHIN A BATCH JOB.  THIS
  19. *         COMMAND ALSO ALLOWS THE SERVICE CLASS OF ANY BATCH JOB
  20. *         UNDER THE CALLING USER-S CONTROL TO BE CHANGED.  THIS
  21. *         COMMAND ALLOWS INQUIRY OF AVAILABLE SERVICE CLASSES.
  22. *         IT WILL ACCEPT PARAMETERS FROM THE *CLASS* COMMAND
  23. *         INPUT FROM THE FILE *INPUT*, AND SEND OUTPUT TO THE
  24. *         USER VIA FILE *OUTPUT* OR A SPECIFIED OUTPUT FILE.
  25.           SPACE  4,10
  26. ***       *CLASS* COMMAND.
  27. *
  28. *         CLASS,SC,OT,LFN,A.
  29. *
  30. *         CLASS,SC=SC,OT=OT,L=LFN,OP=A.
  31. *
  32. *         CLASS,SC,,,,JSN.
  33. *
  34. *         CLASS,SC,JSN=JSN.
  35. *
  36. *         CLASS,SC=SC,JSN=JSN.
  37. *
  38. *         *CLASS* CONTROL STATEMENT PARAMETERS ARE DEFINED
  39. *         AS FOLLOWS.
  40. *
  41. *         SC     TWO CHARACTER SERVICE CLASS SYMBOL OF DESIRED
  42. *                SERVICE CLASS OR NULL.  IF THIS PARAMETER IS
  43. *                NOT SPECIFIED, AND THE COMMAND HAS BEEN ISSUED
  44. *                FROM AN TIMESHARING USER WHOSE INPUT/OUTPUT
  45. *                FILES ARE ASSIGNED TO THEIR TERMINAL, AND NO
  46. *                ORIGIN (*OT* PARAMETER) HAS BEEN SPECIFIED THEN
  47. *                A TERMINAL DISPLAY IS GENERATED FOR THE USER TO
  48. *                SELECT A SERVICE CLASS.  AN ALTERNATE OUTPUT
  49. *                FILE CAN BE SPECIFIED FOR THE DISPLAY IF NO
  50. *                SERVICE CLASS IS PRESENT.  THIS PARAMETER HAS
  51. *                NO DEFAULT AND IS REQUIRED IF THE *JSN*
  52. *                PARAMETER IS SPECIFIED.  THE SELECTED
  53. *                SERVICE CLASS MUST BE DEFINED AND VALIDATED FOR
  54. *                USE.  THE DEFINED SERVICE CLASSES ARE:
  55. *                             SY - SYSTEM,
  56. *                             BC - BATCH,
  57. *                             RB - REMOTE BATCH,
  58. *                             TS - INTERACTIVE,
  59. *                             DI - DETACHED INTERACTIVE,
  60. *                             NS - NETWORK SUPERVISOR,
  61. *                             SS - SUBSYSTEM,
  62. *                             MA - MAINTENANCE,
  63. *                             CT - COMMUNCATION TASK,
  64. *                             I0 - INSTALLATION CLASS 0,
  65. *                             I1 - INSTALLATION CLASS 1,
  66. *                             I2 - INSTALLATION CLASS 2,
  67. *                             I3 - INSTALLATION CLASS 3.
  68. *
  69. *         OT     ORIGIN TYPE TO INSPECT FOR ACCESSABLE SERVICE
  70. *                CLASS(S).  DEFAULT TO JOBS CURRENT ORIGIN TYPE.
  71. *                THIS PARAMETER IS IGNORED IF A SERVICE CLASS
  72. *                (*SC* PARAMETER) IS SPECIFIED.  THE POSSIBLE
  73. *                ORIGIN TYPES ARE:
  74. *                             SY - SYSTEM ORIGIN,
  75. *                             BC - BATCH ORIGIN,
  76. *                             RB - REMOTE BATCH ORIGIN,
  77. *                             EI - REMOTE BATCH ORIGIN,
  78. *                             TX - INTERACTIVE,
  79. *                             IA - INTERACTIVE.
  80. *
  81. *         L      LISTING IS PLACED ON SPECIFIED FILE.  THIS
  82. *                PARAMETER IS IGNORED IF A SERVICE CLASS
  83. *                (*SC* PARAMETER) IS PRESENT.  IF THE SPECIFIED
  84. *                FILE IS ASIGNED TO THE TERMINAL (TYPE *TT*)
  85. *                THEN PROMPTING WILL OCCUR.  THE DEFAULT FILE
  86. *                WILL OCCUR.  DEFAULT FILE IS *OUTPUT*.
  87. *
  88. *         OP     ABORT OPTION INDICATING WHETHER THE JOB SHOULD
  89. *                ABORT OR END IF AN ERROR IN PROCESSING IS
  90. *                ENCOUNTERED.  THIS IS AN OPTIONAL PARAMETER.
  91. *                THE ABORT OPTION CAN BE SPECIFIED POSTIONALLY
  92. *                *A* OR ORDER INDEPENDENTLY BY *OP=A*.
  93. *
  94. *         JSN    JOB SEQUENCE NAME OF THE JOB WHOSE SERVICE
  95. *                CLASS IS TO BE CHANGED IF NOT THE CURRENT JOB.
  96.           SPACE  4,10
  97. ***       OUTPUT MESSAGES.
  98. *
  99. *         * CANNOT CHANGE CLASS OF ON-LINE JOB.*
  100. *                THE SERVICE CLASS OF ANOTHER ON-LINE JOB CANNOT BE
  101. *                CHANGED.
  102. *
  103. *         * CANNOT CHANGE CLASS OF SUBSYSTEM.*
  104. *                THE SERVICE CLASS OF A JOB THAT IS EXECUTING AT
  105. *                THE SUBSYSTEM SERVICE CLASS CANNOT BE CHANGED.
  106. *
  107. *         * CLASS ARGUMENT ERROR.*
  108. *                INCORRECT *CLASS* ARGUMENT ON COMMAND.
  109. *
  110. *         * CLASS COMPLETE.*
  111. *                THE *CLASS* CONTROL STATEMENT COMPLETED PROCESSING.
  112. *
  113. *         * INCORRECT JSN ARGUMENT.*
  114. *                THE JSN IS EITHER NOT FOUR CHARACTERS LONG OR IT
  115. *                CONTAINS NON-ALPHANUMERIC CHARACTERS.
  116. *
  117. *         * INCORRECT OPTION ARGUMENT.*
  118. *                INCORRECT OPTION ARGUMENT ON COMMAND.
  119. *
  120. *         * INCORRECT OUTPUT FILENAME.*
  121. *                SPECIFIED OUTPUT FILENAME ARGUMENT IS INCORRECT.
  122. *                THE FILENAME IS EITHER TOO LONG (GREATER THAN
  123. *                SEVEN CHARATERS) OR IT CONTAINS NON-ALPHANUMERIC
  124. *                CHARACTERS.
  125. *
  126. *         * INCORRECT SERVICE CLASS.*
  127. *                THE TWO CHARACTER SERVICE CLASS WAS NOT VALID FOR
  128. *                THE USER OR NOT VALID FOR THE CURRENT ORIGIN TYPE
  129. *                OF THE USER.
  130. *
  131. *         * JOB ALREADY WAITING ON SERVICE CLASS.*
  132. *                THE SERVICE CLASS CHANGE CANNOT BE MADE BECAUSE THE
  133. *                JOB IS WAITING FOR A *CLASS* COMMAND IN THE JOB TO
  134. *                COMPLETE.
  135. *
  136. *         * JSN NOT FOUND.*
  137. *                THE JSN SPECIFIED IS NOT IN THE SYSTEM OR DOES NOT
  138. *                BELONG TO THE CALLING USER.
  139. *
  140. *         * SC ONLY PARAMTER VALID WITH JSN.*
  141. *                THE *OT*, *L* AND *OP* PARAMETERS ARE NOT ALLOWED
  142. *                WHEN THE *JSN* PARAMETER IS SPECIFIED.
  143. *
  144. *         * SERVICE CLASS FULL.*
  145. *                INFORMATIVE MESSAGE INDICATING THE SERVICE CLASS
  146. *                CHANGE CANNOT BE MADE BECAUSE THE NUMBER OF JOBS
  147. *                WITH THAT CLASS IS ALREADY AT THE SERVICE LIMIT.
  148. *
  149. *         * SERVICE CLASS REQUIRED WITH JSN.*
  150. *                THE *SC* PARAMETER MUST BE SPECIFIED WHEN THE *JSN*
  151. *                PARAMETER IS SPECIFIED.
  152. *
  153. *         * UNDEFINED ORIGIN TYPE.*
  154. *                ORIGIN TYPE ARGUMENT IS NOT DEFINED.
  155. *
  156. *         * UNDEFINED SERVICE CLASS.*
  157. *                SERVICE CLASS MNEMONIC IS NOT DEFINED.
  158. *
  159. *         * WAITING FOR SERVICE CLASS CHANGE TO SC.*
  160. *                A BATCH JOB IS WAITING FOR AN AVAILABLE POSITION IN
  161. *                SERVICE CLASS *SC* WHICH HAS REACHED SERVICE LIMIT.
  162.           SPACE  4,10
  163. *         COMMON DECKS.
  164.  
  165. *CALL     COMCCMD
  166. *CALL     COMCMAC
  167. *CALL     COMSEVT
  168. *CALL     COMSQAC
  169. *CALL     COMSSSJ
  170. *CALL     COMSTCM
  171.  SCLASS   SPACE  4,15
  172. **        SCLASS - DEFINE SERVICE CLASS TABLE.
  173. *
  174. *         SCLASS NM,MN,DF,ST,TX
  175. *
  176. *         ENTRY  *NM* = SERVICE CLASS NAME.
  177. *                *MN* = TWO CHARACTER MNEMONIC.
  178. *                *DF* = DAYFILE MESSAGE CHARACTER.
  179. *                *ST* = SHORT TEXT FOR *QFTLIST*.
  180. *                *TX* = TEXT OF SERVICE CLASS NAME FOR BANNER PAGE.
  181. *
  182. *         NOTE - THE CALL TO *COMSSCD* MUST FOLLOW THE DEFINITION OF
  183. *                THIS MACRO.
  184.  
  185.  
  186.           PURGMAC  SCLASS
  187.  
  188.  SCLASS   MACRO  NM,MN,DF,ST,TX
  189.  .SCL     RMT
  190.           VFD    12/0L_MN,48/NM        TX
  191.  .SCL     RMT
  192.  SCLASS   ENDM
  193.  
  194.  
  195.  SCL$     EQU    0           ONLY PROCESS CLSSES WITH JCB-S
  196. *CALL     COMSSCD
  197.           TITLE  DEFINITIONS.
  198. *         ASSEMBLY CONSTANTS.
  199.  
  200.  IBFL     EQU    3           INPUT BUFFER LENGTH
  201.  LMSG     EQU    4           LENGTH OF TIMESHARING MESSAGES.
  202.  OBFL     EQU    200D        OUTPUT BUFFER LENGTH
  203.  SCTL     EQU    37D         SERVICE CLASS TABLE LENGTH
  204.           SPACE  4,10
  205. *         FETS.
  206.  
  207.           ORG    110B
  208.  FWA      BSS    0           SET ORIGIN ADDRESS
  209.  
  210.  INPUT    FILEC  INBUF,IBFL          INPUT FET
  211.  
  212.  O        BSS    0
  213.  OUTPUT   FILEC  OUTBUF,OBFL         OUTPUT FET
  214.           SPACE  4,10
  215. *         SPECIAL ENTRY POINT.
  216.  
  217.  SSJ=     EQU    SSJP
  218.           SPACE  4,10
  219. *         WORKING STORAGE.
  220.  
  221.  ABTF     CON    0           ABORT OPTION FLAG
  222.  ARGE     CON    0           *CLASS* ARGUMENT ERROR FLAG
  223.  ASFG     CON    0           *ASCII* CHARACTER SET FLAG
  224.  CPMB     CON    0           CONTROL POINT MANAGER PARAMETER BLOCK
  225.  DOUT     VFD    42/0LOUTPUT,18/1  DEFAULT OUTPUT FILENAME
  226.  JORG     CON    0           JOBS CURRENT ORIGIN TYPE
  227.  JOSC     CON    0           JOBS CURRENT SERVICE CLASS
  228.  JSNA     CON    0           JOB TO HAVE SERVICE CLASS CHANGED
  229.  NUMA     CON    0           NUMBER OF *CLASS* ARGUMENTS
  230.  NUSC     CON    0           NUMBER OF VALIDATED SERVICE CLASSES
  231.  ORGN     CON    0           ORIGIN JOB IS ENQUIRING UPON
  232.  POUT     CON    0           PROPOSED OUTPUT FILENAME
  233.  RDMU     CON    10D         RANGE DETERMINATOR MULTIPLIER
  234.  ROLT     VFD    48/SCFE,12/SCRT  ROLLOUT EVENT AND TIME INTERVAL
  235.  SERC     CON    0           SERVICE CLASS MNEMONIC
  236.  SERV     CON    0           DESIRED SERVICE CLASS (CHARACTER/VALUE)
  237.  TFLG     CON    0           TIMESHARING ORIGIN FLAG (IAOT)
  238.  TTFG     CON    0           INPUT/OUTPUT FILE *TT* TYPE FLAG
  239.  TTST     CON    0           *TSTATUS* PARAMETER BLOCK
  240.           CON    0
  241.  WRDO     CON    0           NUMBER OF WORDS IN OUTBUF BUFFER
  242.           SPACE  4,10
  243. *         DAYFILE AND INTERACTIVE MESSAGES AND POSSIBLE REPLIES.
  244.  
  245.  MSGA     DATA   C* INCORRECT SERVICE CLASS.      *
  246.  MSGB     DATA   C* CLASS ARGUMENT ERROR.*
  247.  MSGC     DATA   C* SERVICE CLASS FULL.           *
  248.  MSGD     DATA   C* UNDEFINED SERVICE CLASS.      *
  249.  MSGE     DATA   C* WAITING FOR SERVICE CLASS CHANGE TO SC.*
  250.  MSGF     DATA   C* CLASS COMPLETE.*
  251.  MSGG     DATA   C* INCORRECT OPTION ARGUMENT.*
  252.  MSGH     DATA   C* UNDEFINED ORIGIN TYPE.*
  253.  MSGI     DATA   C* INCORRECT OUTPUT FILENAME.*
  254.  MSGJ     DATA   C* SC ONLY PARAMETER VALID WITH JSN.*
  255.  MSGK     DATA   C* SERVICE CLASS REQUIRED WITH JSN.*
  256.  MSGL     DATA   C* JSN  NOT FOUND.               *
  257.  MSGM     DATA   C* CANNOT CHANGE CLASS OF ON-LINE JOB.*
  258.  MSGN     DATA   C* INCORRECT JSN ARGUMENT.*
  259.  MSPO     DATA   C* JOB ALREADY WAITING ON SERVICE CLASS.*
  260.  MSPQ     DATA   C* CANNOT CHANGE CLASS OF SUBSYSTEM.*
  261.           TITLE  TABLE DEFINITIONS.
  262.  BQAC     SPACE  4,10
  263. **        BQAC - *QAC* PARAMETER BLOCK.
  264. *
  265. *         PREFIX PORTION.
  266.  
  267.  BQAC     VFD    50/0,9/ALFC,1/0  *ALTER*
  268.           VFD    36/0,6/ALLB-5,18/0
  269.           VFD    60/0
  270.           VFD    60/0
  271.           VFD    60/0
  272.  
  273. *         SELECTION CRITERIA PORTION.
  274.  
  275.           VFD    60/0
  276.           VFD    60/0
  277.  BJSN     VFD    24/0,36/JSSF    JSN
  278.           VFD    12/INQQ+EXQQ,48/0
  279.           VFD    60/0
  280.           VFD    60/0
  281.           VFD    60/0
  282.  
  283. *         *ALTER* FUNCTION PORTION.
  284.  
  285.           VFD    30/0,6/0,12/CLAF,12/0  SERVICE CLASS FLAG
  286.           VFD    60/0
  287.           VFD    60/0
  288.  BCLS     VFD    42/0,12/0,6/0   NEW SERVICE CLASS
  289.           VFD    60/0
  290.  GTDT     SPACE  4,10
  291. **        GTDT - GENERATE TERMINAL DISPLAY TABLE.
  292. *
  293. *         INTERACTIVE DISPLAY TEMPLATE.
  294.  
  295.  GTDA     DATA   C*               AVAILABLE SERVICE CLASSES*
  296.           DATA   C*          *
  297.           DATA   C*                ---RELATIVE PRIORITY---*
  298.           DATA   C* CLASS INPUT FILES  EXECUTING JOBS  OUTPUT FILES*
  299.  GTDAL    EQU    *-GTDA
  300.  
  301.  GTDB     DATA   C*          *
  302.  GTDB1    DATA   C* ENTER CLASS: "EB"*
  303.  GTDBL    EQU    *-GTDB
  304.  
  305.  GTDC     DATA   C*CURRENT*
  306.  
  307.  GTDD     DATA   C/ SC    *             *              *             /
  308.  GTDDL    EQU    *-GTDD
  309.  TORT     SPACE  4,10
  310. **        TORT - TABLE OF ORIGIN TYPES.
  311. *
  312. *T        12/ORIGIN, 48/VLAUE
  313. *
  314. *         ORIGIN - TWO CHARACTER ORIGIN TYPE.
  315. *         VALUE - CORRESPONDING ORIGIN TYPE VALUE.
  316.  
  317.  TORT     BSS    0
  318.           VFD    12/0LSY,48/SYOT+4000B  SYSTEM ORIGIN TYPE
  319.           VFD    12/0LBC,48/BCOT    BATCH ORIGIN TYPE
  320.           VFD    12/0LEI,48/RBOT    REMOTE BATCH ORIGIN TYPE
  321.           VFD    12/0LTX,48/IAOT    INTERACTIVE ORIGIN TYPE
  322.           VFD    12/0LRB,48/RBOT    REMOTE BATCH ORIGIN TYPE
  323.           VFD    12/0LIA,48/IAOT    INTERACTIVE ORIGIN TYPE
  324.  TORTL    EQU    *-TORT
  325.  TSCT     SPACE  4,10
  326. **        TSCT - SERVICE CLASS TABLE.
  327. *
  328. *T        12/CLASS, 48/VALUE
  329. *
  330. *         CLASS - VALID SERVICE CLASS.
  331. *         VALUE - CORRESPONDING SERVICE CLASS VALUE.
  332.  
  333.  
  334.  TSCT     BSS    0
  335.           LIST   D
  336.  .SCL     HERE
  337.           LIST   *
  338.           CON    0           END OF TABLE
  339.  TSCTL    EQU    *-TSCT-1
  340.           ERRNZ  TSCTL-MXJC+1  ENSURE ALL SERVICE CLASSES PRESENT
  341.  CLASS    TITLE  MAIN PROGRAM.
  342. **        CLASS - MAIN PROGRAM.
  343.  
  344.  
  345.  CLASS    BSS    0           ENTRY
  346.           RJ     PRS         PRESET
  347.           SA2    ARGE
  348.           SX4    X2-3
  349.           ZR     X4,CLA2     IF UNDEFINED SERVICE CLASS
  350.           ZR     X2,CLA1     IF NO ARGUMENT ERROR
  351.           RJ     AEM         ABORT AND ISSUE ERROR MESSAGE
  352.           EQ     CLA5        END OF COMMAND PROCESSING
  353.  
  354. *         GENERATE DISPLAY AND/OR ATTEMPT TO CHANGE SERVICE CLASS.
  355.  
  356.  CLA1     SA2    ARGE
  357.           NZ     X2,CLA2     IF ARGUMENT ERROR
  358.           SA2    SERV
  359.           ZR     X2,CLA3     IF NO SERVICE CLASS ARGUMENT
  360.           RJ     VCS         VALIDATE/CHANGE SERVICE CLASS
  361.           SA2    ARGE
  362.           ZR     X2,CLA4     IF SERVICE CLASS CHANGE COMPLETED
  363.  CLA2     RJ     AEM         ISSUE ERROR MESSAGE
  364.           WRITEW  O,X3,LMSG  DISPLAY ERROR MESSAGE
  365.           WRITER  O,R
  366.           SA1    JSNA
  367.           NZ     X1,CLA5     IF JSN SPECIFIED
  368.  CLA3     SETFET  O,(BUF=OUTBUF,OBFL)
  369.           RJ     GTD         GENERATE TERMINAL DISPLAY
  370.           SA1    NUSC
  371.           ZR     X1,CLA4     IF NO SERVICE CLASS AVAILABLE
  372.           SA1    TTFG
  373.           ZR     X1,CLA4     IF FILE TYPE NOT *TT*
  374.           SA1    TFLG
  375.           ZR     X1,CLA4     IF NOT *IAOT*
  376.           SA1    ORGN
  377.           NZ     X1,CLA4     IF DISPLAY BUILT FOR SPECIFIED ORIGIN
  378.           WRITEW  O,GTDB,GTDBL
  379.           WRITER  O          FLUSH BUFFER
  380.           SETFET  INPUT,(BUF=INBUF,IBFL)
  381.           READ   INPUT,R     READ REPONSE
  382.           READC  INPUT,INBUF,IBFL
  383.           NZ     X1,CLA4     IF NO SERVICE CLASS ENTERED
  384.           RJ     VTI         VALIDATE TIMESHARING INPUT
  385.           EQ     CLA1        VALIDATE NEW ARGUMENTS
  386.  
  387. *         TERMINATION PROCESSING.
  388.  
  389.  CLA4     MESSAGE MSGF,3,R   * CLASS COMPLETE.*
  390.  CLA5     SA1    TFLG
  391.           ZR     X1,CLA6     IF NOT TIMESHARING
  392.           PROMPT ON
  393.           SA1    ASFG
  394.           ZR     X1,CLA6     IF NOT ASCII
  395.           CSET   ASCII
  396.  CLA6     ENDRUN
  397.           SPACE  4,10
  398.           TITLE  SUBROUTINES.
  399.  AEM      SPACE  4,10
  400. **        AEM - ABORT AND/OR ISSUE ERROR MESSAGE.
  401. *
  402. *         ENTRY  (X3) = ADDRESS OF DAYFILE MESSAGE.
  403. *                (ABTF) = ABORT OPTION PRESENT FLAG
  404. *                (ARGE) = ARGUMENT ERROR FLAG
  405. *
  406. *         EXIT   (X3) = ADDRESS OF DAYFILE MESSAGE.
  407. *                (ARGE)= RESET TO ZERO.
  408. *
  409. *         USES   X - 1, 2, 4, 6.
  410. *                A - 1, 2, 4, 6.
  411. *
  412. *         MACROS ABORT, CSET, MESSAGE.
  413.  
  414.  
  415.  AEM      SUBR               ENTRY/EXIT
  416.           MESSAGE  X3,3      ISSUE DAYFILE MESSAGE
  417.           SA2    ARGE        GET ARGUMENT ERROR FLAG
  418.           SA4    ABTF        GET ABORT OPTION FLAG
  419.           SX6    B0+
  420.           SA6    A2          RESET *ARGE*
  421.           BX4    X2*X4
  422.           ZR     X4,AEMX     IF NOT ERROR OR NOT ABORT OPTION
  423.           SA1    TFLG
  424.           ZR     X1,AEM1     IF CALLING JOB NOT TIMESHARING
  425.           SA1    ASFG
  426.           ZR     X1,AEM1     IF CHARACTER SET *NORMAL*
  427.           CSET   ASCII       SET *ASCII* 128 CHARACTER SET MODE
  428.  AEM1     ABORT
  429.  DPM      SPACE  4,10
  430. **        DPM - DETERMINE PRIORITY MULTIPLIERS.
  431. *
  432. *         ENTRY  (RDMU) = RANGE DETERMINATOR MULTIPLIER.
  433. *                (USCP) = BUFFER CONTAINS VALIDATED SERVICE CLASSES,
  434. *                         LOWER BOUND INPUT, UPPER BOUND EXECUTION
  435. *                         AND LOWER BOUND OUTPUT PRIORITIES.
  436. *
  437. *         EXIT   (NUSC) = NUMBER OF ENTRIES IN *USCP*.
  438. *                (USCP) = BUFFER CONTAINS VALIDATED SERVICE CLASSES,
  439. *                         RELATIVE INPUT, RELATIVE EXECUTION AND
  440. *                         RELATIVE OUTPUT PRIORITIES.
  441. *
  442. *         USES   X - ALL.
  443. *                A - 1, 5, 6.
  444. *                B - 3, 4, 5, 6, 7.
  445.  
  446.  
  447.  DPM      SUBR               ENTRY/EXIT
  448.           SB4    B0+
  449.           SA1    USCP
  450.           SB5    B1          SET FIELD FLAG
  451.           MX0    -12
  452.           LX1    -12         EXTRACT NUMBER OF RETURNED SERVICE CLASSES
  453.           BX6    -X0*X1
  454.           SA6    NUSC
  455.           SB6    X6
  456.           BX7    X6
  457.  
  458. *         FIND HIGHEST INPUT, EXECUTION OR OUTPUT PRIORITY IN *USCP*.
  459.  
  460.  DPM1     SA1    A1+B1       OBTAIN SERVICE CLASS PRIORITY
  461.           ZR     X7,DPM3     IF END OF SERVICE CLASSES
  462.           SX7    X7-1        DECREMENT NUMBER OF SERVICE CLASSES
  463.           BX2    -X0*X1
  464.           EQ     B5,B1,DPM2  IF PROCESSING OUTPUT PRIORITY
  465.           LX2    -12D
  466.           ZR     B5,DPM2     IF PROCESSING EXECUTION PRIORITY
  467.           LX2    -12D
  468.  DPM2     SB3    X2
  469.           LE     B3,B4,DPM1  IF NOT HIGHER PRIORITY
  470.           SB4    B3
  471.           EQ     DPM1        PROCESS NEXT ENTRY
  472.  
  473. *         CALCULATE PRIORITY MULTIPLIER (A = 10 * (P / H)) WHERE
  474. *         P IS SERVICE CLASSES PRIORITY AND H IS THE MAXIMUM P.
  475. *         THE MULTIPLIERS FOR INPUT, EXECUTION AND OUTPUT PRIORITIES
  476. *         ARE COMPUTED INDEPENDENTLY.  THE RESULT IS ROUNDED.
  477.  
  478.  DPM3     SX7    B6+
  479.           ZR     B4,DPM7     IF HIGHEST PRIORITY IS ZERO
  480.           SA1    USCP
  481.           SX4    B4
  482.           PX4    X4
  483.           NX4    X4
  484.           SA5    RDMU        GET RANGE DETERMINATOR MULTIPLIER
  485.           PX5    X5
  486.           ZX5    X5
  487.  DPM4     SA1    A1+B1
  488.           ZR     X7,DPM7     IF END OF SERVICE CLASSES
  489.           SX7    X7-1        DECREMENT NUMBER OF SERVICE CLASSES
  490.           BX3    -X0*X1      OBTAIN SERVICE CLASS PRIORITY
  491.           EQ     B5,B1,DPM5  IF PROCESSING OUTPUT PRIORITY
  492.           LX3    -12D
  493.           ZR     B5,DPM5     IF PROCESSING EXECUTION PRIORITY
  494.           LX3    -12D
  495.  DPM5     PX3    X3
  496.           NX3    X3
  497.           RX3    X3/X4       CALCULATE RELATIVE PRIORITY
  498.           RX3    X3*X5
  499.           UX3,B7 X3          UNPACK MULTIPLIER
  500.           LX3    X3,B7
  501.           EQ     B5,B1,DPM6  IF PROCESSING OUTPUT PRIORITY
  502.           LX3    12D
  503.           ZR     B5,DPM6     IF PROCESSING EXECUTION PRIORITY
  504.           LX3    12D
  505.  DPM6     BX6    X0*X1       EXTRACT SERVICE CLASS
  506.           BX6    X3+X6       CREATE NEW TABLE ENTRY
  507.           SA6    A1+
  508.           EQ     DPM4        CALCULATE NEXT *USCP* ENTRY
  509.  
  510.  DPM7     SX7    B6
  511.           NG     B5,DPMX     IF ALL MULTIPLIERS COMPUTED
  512.           SB4    B0          RESET HIGHEST PRIORITY TO ZERO
  513.           SB5    B5-B1       UPDATE FIELD FLAG
  514.           LX0    12
  515.           SA1    USCP
  516.           EQ     DPM1        PROCESS OUTPUT PRIORITY
  517.  GTD      SPACE  4,15
  518. **        GTD - GENERATE TERMINAL DISPLAY.
  519. *
  520. *         ENTRY  (SERV) = SET TO DESIRED SERIVCE CLASS.
  521. *                (TSCT) = TABLE OF VALIDATED SERVICE CLASSES.
  522. *
  523. *         EXIT   (GTDF) = SET GENERATED DISPLAY FLAG.
  524. *                (OUTBUF) = CONTAINS SERVICE CLASSES FOR DISPLAY.
  525. *
  526. *         USES   X - ALL.
  527. *                A - 1, 2, 3, 5, 7.
  528. *                B - 3, 4, 5, 6, 7.
  529. *
  530. *         CALLS  DFM, SCB, SRT.
  531. *
  532. *         MACROS GETUSC, WRITER, WRITEW.
  533.  
  534.  
  535.  GTD      SUBR               ENTRY/EXIT
  536.  
  537. *         SETUP *GETUSC* PARAMETER BLOCK.
  538.  
  539.           SX6    SCTL        SET LENGTH OF *USCP*
  540.           MX0    -11
  541.           LX6    -12
  542.           SA2    JORG        GET JOBS CURRENT ORIGIN TYPE
  543.           SA1    SERV
  544.           NZ     X1,GTD1     IF SERVICE CLASS ARGUMENT SPECIFIED
  545.           SA2    ORGN        GET SPECIFIED ORIGIN ARGUMENT
  546.           NZ     X2,GTD1     IF SPECIFIED ORIGIN ARGUMENT EXISTS
  547.           SA2    JORG
  548.  GTD1     BX2    -X0*X2      CLEAR *SY* ENTRY FLAG
  549.           BX6    X6+X2       SET ORIGIN OF INQUIRY
  550.           LX6    24
  551.           SA6    USCP
  552.           GETUSC USCP        OBTAIN VALIDATED SERVICE CLASS
  553.           RJ     DPM         DETERMINE PRIORITY MULTIPLIERS
  554.           RJ     SRT         SORT *USCP* IN DESCENDING ORDER
  555.           SA1    NUSC        NUMBER OF *USCP* ENTRIES TO PROCESS
  556.           SX0    X1+
  557.           ZR     X0,GTDX     IF NO SERVICE CLASS RETURNED
  558.           SA5    USCP        SET VALIDATED SERVICE CLASS TABLE
  559.           SB7    OUTBUF+GTDAL  SET FWA WORKING BUFFER
  560.  GTD2     SB4    GTDDL       MOVE DISPLAY LINE TO BUFFER
  561.           SB3    GTDD
  562.  GTD3     SB4    B4-B1
  563.           SA1    B3+B4
  564.           BX7    X1
  565.           SA7    B7+B4
  566.           NE     B4,B0,GTD3  IF NOT END OF DISPLAY LINE
  567.           SA5    A5+B1       SET CHARACTER STRING
  568.           BX6    X5
  569.           SB3    GTDT        SET ADDRESS OF LINE DESCRIPTOR ENTRY
  570.           RJ     SCB         SET SERVICE CLASS IN DISPLAY LINE
  571.           SA1    =10H**********  SET CHARACTER STRING
  572.           BX6    X1
  573.           LX5    36
  574.           SB6    B1+
  575.  GTD4     MX1    -6          INSERT CHARACTER COUNT IN FORMAT TABLE
  576.           SA3    B6+GTDT
  577.           BX4    -X1*X5
  578.           LX1    36
  579.           BX7    X1*X3
  580.           LX4    36
  581.           SB3    A3          SET ADDRESS OF LINE DESCRIPTOR
  582.           BX7    X7+X4
  583.           SA7    A3
  584.           RJ     SCB         SET PRIORITY IN DISPLAY
  585.           SB6    B6+B1
  586.           SB5    4
  587.           LX5    12
  588.           NE     B6,B5,GTD4  IF NOT END OF PRIORITIES
  589.           SA2    JOSC        GET CURRENT SERVICE CLASS
  590.           SB5    X2-1
  591.           MX1    12
  592.           LX5    48
  593.           SA2    B5+TSCT     GET DISPLAY CODE EQUIVALENT
  594.           BX4    X1*X2
  595.           BX3    X1*X5
  596.           BX1    X3-X4
  597.           NZ     X1,GTD5     IF NOT CURRENT SERVICE CLASS
  598.           SA3    GTDC        SET *CURRENT* IN DISPLAY
  599.           BX7    X3
  600.           SA7    B7+GTDDL-1
  601.  GTD5     SB7    B7+GTDDL
  602.           SX0    X0-1        DECREMENT SERVICE CLASS COUNT
  603.           NZ     X0,GTD2     IF NOT END OF SERVICE CLASSES
  604.           SX7    B7-OUTBUF-GTDAL  COMPUTE DISPLAY LENGTH
  605.           SA7    WRDO        SAVE NUMBER OF WORDS WRITTEN TO *OUTBUF*
  606.  
  607. *         DISPLAY AVAILABLE SERVICE CLASSES AND HISTOGRAMS.
  608.  
  609.           WRITEW O,GTDA,GTDAL  WRITE CLASS DISPLAY HEADER
  610.           SA1    WRDO
  611.           WRITEW O,OUTBUF+GTDAL,X1  DISPLAY AVAILABLE SERVICE CLASSES
  612.           WRITER O           FLUSH BUFFER
  613.           EQ     GTDX        RETURN
  614.  
  615. *         GTDT - SET CHARACTERS IN BUFFER FORMAT DESCRIPTION TABLE.
  616.  
  617.  GTDT     VFD    12/0,6/1,6/2,36/0  SC
  618.           VFD    12/0,6/8,6/0,36/0  IN
  619.           VFD    12/2,6/2,6/0,36/0  EX
  620.           VFD    12/3,6/7,6/0,36/0  OUT
  621.  SRT      SPACE 4,10
  622. **        SRT - SORT TABLE INTO DESENDING ORDER USING MULTIPLIER FIELD.
  623. *
  624. *         ENTRY  (USCP) = TABLE ENTRIES UNSORTED.
  625. *
  626. *         EXIT   (USCP) = TABLE SORTED INTO DESCENDING ORDER.
  627. *
  628. *         USES   X - ALL.
  629. *                A - 1, 6, 7.
  630. *                B - 3, 5, 7.
  631.  
  632.  
  633.  SRT      SUBR               ENTRY/EXIT
  634.           SA1    NUSC        GET NUMBER OF SERVICE CLASS ENTRIES
  635.           SB3    X1+
  636.           SX1    X1-1
  637.           ZR     X1,SRTX     IF ONLY ONE ENTRY TO SORT IN *USCP* TABLE
  638.           MX0    -12
  639.           LX0    12          SORT ON UPPER BOUND EXECUTION PRIORITY
  640.  SRT1     SB7    B0+         CLEAR CHANGE FLAG
  641.           SB5    B1+         RESET ENTRY COUNT
  642.           SA1    USCP+B1     READ FIRST SERVICE CLASS ENTRY IN *USCP*
  643.           BX6    X1          TRANSFER CONTENTS TO CURRENT
  644.           BX2    -X0*X6      EXTRACT MULTIPLIER FROM CURRENT ENTRY
  645.  
  646. *         COMPARE CURRENT AND NEXT TABLE ENTRIES.
  647.  
  648.  SRT2     SA1    A1+B1       READ NEXT ENTRY IN *USCP*
  649.           BX4    -X0*X1      EXTRACT MULTIPLIER FROM NEXT ENTRY
  650.           BX7    X1          TRANSFER CONTENTS TO NEXT
  651.           IX1    X2-X4
  652.           ZR     X1,SRT4     IF CURRENT MULTIPLIER EQUALS NEXT
  653.           NG     X1,SRT4     IF CURRENT MULTIPLIER IS LESS THAN NEXT
  654.  
  655. *         SWAP CURRENT ENTRY WITH NEXT ENTRY.
  656.  
  657.  SRT3     SB7    B1+         SET CHANGE FLAG
  658.           BX5    X7          TEMP IS ASSIGNED NEXT
  659.           BX3    X4
  660.           BX7    X6          NEXT IS ASSIGNED CURRENT
  661.           BX4    X2
  662.           BX6    X5          CURRENT IS ASSIGNED TEMP
  663.           BX2    X3
  664.           SA6    A1-B1       WRITE CURRENT INTO *USCP* TABLE
  665.           SA7    A1          WRITE NEXT INTO *USCP* TABLE
  666.  
  667. *         CURRENT IS NOW ASSIGNED VALUE OF NEXT.
  668.  
  669.  SRT4     BX6    X7          CURRENT IS ASSIGNED NEXT
  670.           BX2    X4
  671.           SB5    B5+B1       INCREMENT NUMBER OF ENTRIES PROCESSED
  672.           LT     B5,B3,SRT2  IF NOT END OF *USCP* TABLE
  673.           ZR     B7,SRTX     IF TABLE FULLY SORTED
  674.           SB3    B3-B1       DECREMENT NUMBER OF ENTRIES TO PROCESS
  675.           EQ     SRT1        START NEXT PASS ON LIST
  676.  VCS      SPACE  4,15
  677. **        VCS - VALIDATE AND CHANGE SERVICE CLASS.
  678. *
  679. *         ENTRY  (SERV) = CONTAINS DESIRED SERVICE CLASS.
  680. *                (TFLG) = TIMESHARING FLAG.
  681. *
  682. *         EXIT   (X3) = ERROR MESSAGE.
  683. *                (ARGE) = ARGUMENT ERROR FLAG SET.
  684. *
  685. *         USES   X - 0, 1, 2, 3, 4, 5, 6.
  686. *                A - 1, 2, 4, 5, 6.
  687. *                B - 4, 5.
  688. *
  689. *         CALLS  COMCCPM, *QAC*.
  690. *
  691. *         MACROS MESSAGE, ROLLOUT, SYSTEM.
  692.  
  693.  
  694.  VCS      SUBR               ENTRY/EXIT
  695.           SA4    JSNA
  696.           NZ     X4,VCS3     IF JSN SPECIFIED
  697.           SA2    SERV
  698.           SB5    X2+
  699.           SA4    JOSC        GET CURRENT SERVICE CLASS
  700.           SB4    X4+
  701.           EQ     B4,B5,VCS7  IF SAME AS CURRENT SERVICE CLASS
  702.           BX6    X2
  703.           SA6    CPMB
  704.  VCS1     SX1    CPMB        SET PARAMETER BLOCK LOCATION
  705.           SX2    124B        SET FUNCTION CODE
  706.           RJ     =XCPM=      ATTEMPT TO CHANGE SERVICE CLASS
  707.           MX0    -6
  708.           SA1    CPMB        CHECK FOR ERROR
  709.           LX1    -6
  710.           BX2    -X0*X1
  711.           ZR     X2,VCS7     IF SERVICE CLASS CHANGE ACCEPTED
  712.           SX2    X2-1
  713.           SX6    B1+         SET ARGUMENT ERROR FLAG
  714.           SA6    ARGE
  715.           ZR     X2,VCS6     IF UNDEFINED SERVICE CLASS
  716.           SX2    X2-1
  717.           ZR     X2,VCS4     IF INVALID SERVICE CLASS
  718.           SA1    TFLG
  719.           NZ     X1,VCS5     IF TIMESHARING JOB
  720.           SA1    ABTF
  721.           NZ     X1,VCS5     IF ABORT OPTION
  722.  VCS2     SA5    MSGE+3      INSERT SERVICE CLASS INTO MESSAGE
  723.           MX0    -12D
  724.           LX0    6
  725.           BX5    X0*X5
  726.           SA2    TSCT+B5-1
  727.           LX2    18D
  728.           BX2    -X0*X2
  729.           BX6    X5+X2
  730.           SA6    A5+
  731.           MESSAGE MSGE,1,R   ISSUE * WAITING FOR SERVICE CLASS XX.*
  732.           ROLLOUT ROLT       ROLLOUT BATCH JOB
  733.           EQ     VCS1        TRY TO CHANGE SERVICE CLASS AGAIN
  734.  
  735.  
  736. *         CALL *QAC* TO CHANGE THE SERVICE CLASS OF SPECIFIED JOB.
  737.  
  738.  VCS3     SA2    SERC        PUT SERVICE CLASS IN *QAC* BLOCK
  739.           LX2    18
  740.           SA1    BCLS
  741.           BX6    X1+X2
  742.           SA6    A1
  743.           SA4    JSNA        PUT JSN IN *QAC* PARAMETER BLOCK
  744.           SA2    BJSN
  745.           BX6    X2+X4
  746.           SA6    A2
  747.           SYSTEM QAC,R,BQAC
  748.           SA1    BQAC        CHECK FOR ERROR
  749.           MX0    -8D
  750.           AX1    10D
  751.           BX2    -X0*X1
  752.           ZR     X2,VCS7     IF SERVICE CLASS CHANGE ACCEPTED
  753.           SX6    B1          SET ARGUMENT ERROR FLAG
  754.           SA6    ARGE
  755.           SX1    X2-ER24
  756.           ZR     X1,VCS5     IF SERVICE CLASS FULL
  757.           SX4    X2-ER25
  758.           ZR     X4,VCS8     IF ON-LINE JOB
  759.           SX1    X2-ER26
  760.           ZR     X1,VCS6     IF UNDEFINED SERVICE CLASS
  761.           SX4    X2-ER27
  762.           ZR     X4,VCS9     IF WAITING ON *CLASS*
  763.           SX1    X2-ER28
  764.           ZR     X1,VCS10    IF SUBSYSTEM SERVICE CLASS
  765.           SX4    X2-ER07
  766.           ZR     X4,VCS11    IF JSN NOT FOUND
  767.  VCS4     SX3    MSGA        * INCORRECT SERVICE CLASS.*
  768.           EQ     VCSX        RETURN
  769.  
  770.  VCS5     SX3    MSGC        * SERVICE CLASS FULL.*
  771.           EQ     VCSX        RETURN
  772.  
  773.  VCS6     SX3    MSGD        * UNDEFINED SERVICE CLASS.*
  774.           EQ     VCSX        RETURN
  775.  
  776.  VCS7     SX6    B0+
  777.           SA6    ARGE        CLEAR ARGUMENT ERROR FLAG
  778.           EQ     VCSX        RETURN
  779.  
  780.  VCS8     SX3    MSGM        * CANNOT CHANGE ON-LINE JOB.*
  781.           EQ     VCSX        RETURN
  782.  
  783.  VCS9     SX3    MSPO        * JOB ALREADY WAITING ON SERVICE CLASS.*
  784.           EQ     VCSX        RETURN
  785.  
  786.  VCS10    SX3    MSPQ        * CANNOT CHANGE CLASS OF SUBSYSTEM.*
  787.           EQ     VCSX        RETURN
  788.  
  789.  VCS11    SX3    MSGL        * JSNA NOT FOUND.*
  790.           SA2    JSNA        SET JSN IN MESSAGE
  791.           SA1    MSGL
  792.           MX0    24
  793.           LX0    -6
  794.           BX4    -X0*X1
  795.           LX2    -6
  796.           BX6    X2+X4
  797.           SA6    A1
  798.           EQ     VCSX        RETURN
  799.  
  800.  VTI      SPACE  4,10
  801. **        VTI - VALIDATE TIMESHARING INPUT.
  802. *
  803. *         ENTRY  (SERV) = SERVICE CLASS INPUT BY USER (CHARACTER).
  804. *
  805. *         EXIT   (ARGE) = ARGUMENT ERROR FLAG
  806. *                (SERV) = SERVICE CLASS (VALUE).
  807. *
  808. *         USES   X - 0, 1, 2, 3, 4, 6.
  809. *                A - 1, 3, 6.
  810.  
  811.  
  812.  VTI      SUBR               ENTRY/EXIT
  813.           SA3    TSCT-1
  814.           MX0    12
  815.           SA1    INBUF       GET TIMESHARING USERS INPUT
  816.           BX2    X0*X1
  817.           BX3    -X0*X1
  818.           SX6    B0          RESET INPUT BUFFER
  819.           SA6    A1
  820.           ZR     X3,VTI2     IF NOT MORE THAN THREE CHARACTERS
  821.  VTI1     SA1    ARGE
  822.           SX6    B1          SET ARGUMENT ERROR FLAG
  823.           SA6    A1
  824.           SX3    MSGD        SET * UNDEFINED SERVICE CLASS.*
  825.           EQ     VTIX        RETURN
  826.  
  827. *         DETERMINE IF ENTERED SERVICE CLASS IS DEFINED.
  828.  
  829.  VTI2     SA3    A3+B1       GET *TSCT* TABLE ENTRY
  830.           ZR     X3,VTI1     IF END OF *TSCT* TABLE
  831.           BX4    X0*X3
  832.           BX4    X4-X2       COMPARE TABLE ENTRY TO ENTERED CLASS
  833.           NZ     X4,VTI2     IF NO MATCH
  834.           MX0    -12
  835.           BX6    -X0*X3      EXTRACT CORRESPONDING SERVICE CLASS VALUE
  836.           SA6    SERV        SAVE DESIRED SERVICE CLASS VALUE
  837.           EQ     VTIX        RETURN
  838.           SPACE 4,10
  839. *         COMMON DECKS.
  840.  
  841. *CALL     COMCCIO
  842. *CALL     COMCCPM
  843. *CALL     COMCRDC
  844. *CALL     COMCRDW
  845. *CALL     COMCSCB
  846. *CALL     COMCSFN
  847. *CALL     COMCSYS
  848. *CALL     COMCWTW
  849.           SPACE  4,10
  850. *         BUFFERS.
  851.  
  852.           USE    LITERALS
  853.  INBUF    EQU    *           INPUT BUFFER
  854.  USCP     EQU    INBUF+IBFL  INPUT BUFFER
  855.  OUTBUF   EQU    USCP+SCTL   OUTPUT BUFFER
  856.  OUTBUFL  EQU    OUTBUF+OBFL OUTPUT BUFFER LIMIT
  857.           TITLE  PRESET.
  858.  PRS      SPACE  4,20
  859. **        PRS - PRESET.
  860. *
  861. *         *PRS* DETERMINES ORIGIN, SERVICE CLASS, AND TERMINAL
  862. *         CHARACTERISTICS.
  863. *
  864. *         EXIT   (ASFG) = SET TO ONE IF *ASCII* USER.
  865. *                (DOUT) = SET TO DEFAULT OUTPUT FILENAME.
  866. *                (JORG) = SET TO CURRENT JOBS ORIGIN.
  867. *                (JOSC) = SET TO CURRENT JOBS SERVICE CLASS.
  868. *                (TFLG) = SET TO ONE IF TIMESHARING USER.
  869. *                (TTFG) = SET TO ONE IF INPUT FILE TYPE IS *TT*.
  870. *
  871. *         USES    X - 0, 1, 2, 6.
  872. *                 A - 1, 6.
  873. *                 B - 1.
  874. *
  875. *         CALLS   CCP, STF.
  876. *
  877. *         MACROS  CSET, GETJOSC, PROMPT, TSTATUS.
  878.  
  879.  
  880.  PRS      SUBR               ENTRY/EXIT
  881.           SB1    1           SYSTEM COMMUNICATION (B1)=1
  882.  
  883. *         DETERMINE JOB ORIGIN AND SERVICE CLASS.
  884.  
  885.           GETJOSC  JOSC      GET CURRENT SERVICE CLASS
  886.           SA1    JOSC
  887.           MX0    -6
  888.           LX1    -6
  889.           BX6    -X0*X1
  890.           SA6    A1+
  891.           LX1    6
  892.           BX6    -X0*X1
  893.           SA1    JORG        GET JOB ORIGIN TYPE
  894.           SA6    A1
  895.           SX1    X6-IAOT
  896.           NZ     X1,PRS2     IF NOT *IAOT*
  897.           SX6    B1+         SET TIMESHARING FLAG
  898.           SA6    TFLG
  899.  
  900. *         DETERMINE TERMINAL CHARACTERISTICS.
  901.  
  902.           TSTATUS  TTST      GET TERMINAL STATUS
  903.           SA1    B1+TTST     GET CURRENT CHARACTER SET
  904.           MX0    1
  905.           LX0    3
  906.           BX1    X0*X1
  907.           ZR     X1,PRS1     IF NOT 64 CHARACTER SET
  908.           BX6    X1          SET *ASCII* FLAG
  909.           SA6    ASFG
  910.           CSET   NORMAL      SET TERMINAL CHARACTER MODE
  911.  PRS1     PROMPT OFF         SUPPRESS *IAF* PROMPTS
  912.  PRS2     RJ     CCP         CRACK *CLASS* PARAMETERS
  913.           SX2    INPUT
  914.           RJ     STF         DETERMINE IF INPUT FILE TYPE *TT*
  915.           SX2    O
  916.           RJ     STF         DETERMINE IF OUTPUT FILE TYPE *TT*
  917.           NZ     X6,PRS3     IF FILE TYPE NOT *TT*
  918.           SX6    B1+
  919.           SA6    TTFG        STORE *TT* FILE TYPE FLAG
  920.  PRS3     SA1    SERV
  921.           ZR     X1,PRS5     IF NO SERVICE CLASS ARGUMENT
  922.  PRS4     SA1    DOUT        RESET *L* TO OUTPUT
  923.           BX6    X1
  924.           SA6    O
  925.           SX6    B0
  926.           SA6    ORGN        CLEAR SPECIFIED ORIGIN ARGUMENT
  927.           EQ     PRSX        RETURN
  928.  
  929.  PRS5     SA1    ARGE
  930.           ZR     X1,PRSX     IF NO ARGUMENT ERROR
  931.           EQ     PRS4        RESET *L* TO OUTPUT
  932.           TITLE  PRESET SUBROUTINES.
  933.  CCP      SPACE  4,20
  934. **        CCP - CRACK *CLASS* PARAMETERS.
  935. *
  936. *         ENTRY  (X3) = ADDRESS OF ERROR MESSAGE TO BE DISPLAYED.
  937. *
  938. *         EXIT   (X3) = ADDRESS OF ERROR MESSAGE TO BE DISPLAYED.
  939. *                (ABTF) = SET TO ONE IF ABORT OPTION PRESENT.
  940. *                (ARGE) = SET TO ONE IF ARGUMENT ERROR OCCURS.
  941. *                (NUMA) = SET TO NUMBER OF *CLASS* ARGUMENTS.
  942. *                (ORGN) = SET TO ORIGIN OF INQUIRY.
  943. *                (POUT) = PROPOSED OUTPUT FILENAME.
  944. *                (SERV) = SET TO DESIRED SERVICE CLASS.
  945. *
  946. *         USES    X - 1, 2, 3, 4, 6.
  947. *                 A - 1, 2, 6.
  948. *                 B - 2, 3, 4, 6, 7.
  949. *
  950. *         CALLS   ARM, CPA, FNB, USB, VCP.
  951.  
  952.  
  953.  CCP      SUBR               ENTRY/EXIT
  954.           SA1    ACTR
  955.           SX6    X1
  956.           SA6    NUMA        STORE NUMBER OF ARGUMENTS
  957.           ZR     X6,CCPX     IF NO ARGUMENTS
  958.  CCP1     SB2    CCDR        UNPACK CONTROL CARD
  959.           SB3    B0+         FOR NORMAL CHARACTER SET
  960.           RJ     USB
  961.           SA1    A6          ASSURE TERMINATOR CHARACTER
  962.           SX6    1R.
  963.           SA6    X1+B1
  964.           SA2    CCPB        SET SEPARATOR MASK
  965.           SB2    60          SET MAXIMUM NON-DELIMITER DISPLAY CODE
  966.           SB7    CCP4        SET EXIT FOR TERMINATOR CHARACTER
  967.           RJ     FNB         FIND NON-BLANK CHARACTER
  968.  
  969. *         OBTAIN *CLASS* ARGUMENTS.
  970.  
  971.           SB7    CCPX        SET EXIT FOR TERMINATOR CHARACTER
  972.  CCP2     RJ     FNB         FIND NON-BLANK CHARACTER
  973.           SB4    B5-B2
  974.           LX4    X2,B5
  975.           PL     B4,CCP3     IF SEPARATOR CHARACTER
  976.           PL     X4,CCP2     IF NOT SEPARATOR CHARACTER
  977.  CCP3     SB3    TARG        FWA ARGUMENT EQUIVALENCE TABLE
  978.           SB2    TARGL       LENGTH ARGUMENT TABLE
  979.           SB4    CCPA        ADDRESS TO PLACE DATA
  980.           RJ     CPA         CONVERT POSITIONAL ARGUMENTS
  981.           NG     B5,CCP4     IF ARGUMENT ERROR
  982.           PL     X1,CCPX     IF NO ARGUMENTS PROCESSED
  983.           SX6    B5          SET LWA OF ARGUMENTS
  984.           SA6    USBC
  985.           SB6    CCPA        FWA OF ARGUMENTS
  986.           RJ     ARM         PROCESS ARGUMENTS
  987.           NZ     X1,CCP4     IF ERROR
  988.           RJ     VCP         VALIDATE *CLASS* PARAMETER(S)
  989.           EQ     CCPX        RETURN
  990.  
  991. *         FLAG ARGUMENT ERROR CONDITION.
  992.  
  993.  CCP4     SX6    B1+
  994.           SA6    ARGE        SET ARGUMENT ERROR FLAG
  995.           SX3    MSGB        SET * CLASS ARGUMENT ERROR.*
  996.           EQ     CCPX        RETURN
  997.  
  998.  CCPA     BSS    100
  999.  
  1000.  CCPB     CON    40000000000033127777B  SEPARATOR MASK
  1001.  
  1002.  TARG     SPACE  4,10
  1003. *         TARG - ARGUMENT TABLE.
  1004.  
  1005.  TARG     BSS    0
  1006.  SC       ARG    SERV,SERV,0,0  DESIRED JOB SERVICE CLASS
  1007.  OT       ARG    ORGN,ORGN,0,0  ORIGIN OF INQUIRY
  1008.  L        ARG    POUT,POUT,0,0  PROPOSED OUTPUT FILENAME
  1009.  OP       ARG    ABTF,ABTF,0,0  ABORT OPTION
  1010.  JSN      ARG    JSNA,JSNA,0,0  DESIRED JSN
  1011.           ARG
  1012.  TARGL    EQU    *-TARG-1       LENGTH OF ARGUMENT TABLE
  1013.  FNB      SPACE  4,15
  1014. **        FNB - FIND NON-BLANK CHARACTER.
  1015. *
  1016. *         ENTRY  (B6) = NEXT CHARACTER ADDRESS.
  1017. *                (B7) = EXIT ADDRESS, IF TERMINATOR ENCOUNTERED.
  1018. *
  1019. *         EXIT   (X1) = (B5) = NEXT NON-BLANK CHARACTER.
  1020. *                (B6) = NEXT CHARACTER ADDRESS (UPDATED).
  1021. *                EXIT IS MADE TO (B7), IF TERMINATOR ENCOUNTERED.
  1022. *
  1023. *         USES   X - 1, 4.
  1024. *                A - 1.
  1025. *                B - 5, 6.
  1026.  
  1027.  
  1028.  FNB      SUBR               ENTRY/EXIT
  1029.  FNB1     SA1    B6          GET NEXT CHARACTER
  1030.           SB6    B6+B1
  1031.           SX4    X1-1R
  1032.           ZR     X4,FNB1     IF BLANK CHARACTER
  1033.           SB5    X1+
  1034.           SX4    X1-1R.
  1035.           ZR     X4,FNB2     IF TERMINATOR CHARACTER
  1036.           SX4    X1-1R)
  1037.           NZ     X4,FNBX     IF NOT TERMINATOR CHARACTER, RETURN
  1038.  FNB2     JP     B7          PROCESS TERMINATOR CHARACTER
  1039.  VCP      SPACE  4,15
  1040. **        VCP - VALIDATE *CLASS* PARAMETERS.
  1041. *
  1042. *         ENTRY  (X3) = ADDRESS OF ERROR MESSAGE TO BE DISPLAYED.
  1043. *                (ORGN) = ORIGIN OF INQUIRY.
  1044. *                (POUT) = PROPOSED OUTPUT FILENAME.
  1045. *                (SERV) = SET TO DESIRED SERVICE CLASS.
  1046. *
  1047. *         EXIT   (X3) = ADDRESS OF ERROR MESSAGE TO BE DISPLAYED.
  1048. *                (ARGE) = SET TO ONE IF ARGUMENT ERROR OCCURS.
  1049. *                (SERV) = SET TO DESIRED SERVICE CLASS.
  1050. *
  1051. *         USES    X - 0, 1, 2, 3, 6, 7.
  1052. *                 A - 1, 2, 6, 7.
  1053. *                 B - 2, 5, 7.
  1054.  
  1055.  
  1056.  VCP14    SX6    B1+         SET ARGUMENT ERROR FLAG
  1057.           SA6    ARGE
  1058.  
  1059.  VCP      SUBR               ENTRY/EXIT
  1060.           SA1    TSCT-1
  1061.           SB7    TSCTL       NUMBER OF SERVICE CLASSES
  1062.           MX0    12
  1063.           SA2    SERV        GET STORED SERVICE CLASS ARGUMENT
  1064.           BX7    X2
  1065.           SA7    SERC
  1066.           ZR     X2,VCP1     IF NO SERVICE CLASS PARAMETER PRESENT
  1067.  
  1068. *         CHECK FOR VALID SERVICE CLASS PARAMETER.
  1069.  
  1070.  VCP0     SA1    A1+B1
  1071.           ZR     B7,VCP8     IF END OF TABLE
  1072.           SB7    B7-B1       DECREMENT NUMBER OF SERVICE CLASSES
  1073.           BX7    X0*X1
  1074.           BX7    X7-X2       COMPARE CODES
  1075.           NZ     X7,VCP0     IF NO MATCH WITH TABLE ENTRY
  1076.           MX0    -12
  1077.           BX7    -X0*X1
  1078.           SA7    A2+         SAVE SERVICE CLASS ARGUMENT AS VALUE
  1079.  
  1080. *         CHECK FOR VALID ORIGIN PARAMETER.
  1081.  
  1082.  VCP1     SA1    TORT-1
  1083.           SB7    TORTL       NUMBER OF ORIGINS
  1084.           MX0    12
  1085.           SA2    ORGN        GET STORED ORIGIN TYPE ARGUMENT
  1086.           ZR     X2,VCP3     IF NO ORIGIN PARAMETER PRESENT
  1087.  VCP2     SA1    A1+B1
  1088.           ZR     B7,VCP9     IF END OF TABLE
  1089.           SB7    B7-B1       DECREMENT NUMBER OF ORIGINS
  1090.           BX7    X0*X1
  1091.           BX7    X7-X2       COMPARE CODES
  1092.           NZ     X7,VCP2     IF NO MATCH WITH TABLE ENTRY
  1093.           MX0    -12
  1094.           BX7    -X0*X1
  1095.           SA7    A2+         SAVE ORIGIN ARGUMENT AS VALUE
  1096.  
  1097. *         CHECK FOR VALID OUTPUT FILE PARAMETER.
  1098.  
  1099.  VCP3     SA1    POUT        GET PROPOSED OUTPUT FILENAME
  1100.           ZR     X1,VCP5     IF NO FILE NAME SPECIFIED
  1101.           MX0    -6
  1102.           LX0    12
  1103.           BX2    -X0*X1
  1104.           NZ     X2,VCP10    IF EIGHT CHARACTERS
  1105.           SB5    7           SET NUMBER OF ALLOWABLE CHARACTERS
  1106.           MX0    -6
  1107.  VCP4     LX1    6
  1108.           SB5    B5-1        DECREMENT CHARACTER COUNT
  1109.           BX2    -X0*X1
  1110.           SB2    X2-45B      SUBTRACT MAXIMUN LEGAL CHARACTER
  1111.           PL     B2,VCP10    IF INCORRECT CHARACTER
  1112.           NZ     B5,VCP4     IF NOT LAST CHARACTER OF FILENAME
  1113.           SA1    POUT
  1114.           SX2    B1          SET COMPLETE BIT
  1115.           BX6    X1+X2
  1116.           SA6    O
  1117.  
  1118. *         CHECK FOR VALID OPTION ARGUMENT.
  1119.  
  1120.  VCP5     SA1    ABTF
  1121.           ZR     X1,VCP6     IF NO ABORT OPTION PRESENT
  1122.           SX6    1RA
  1123.           LX6    -6
  1124.           IX1    X1-X6       COMPARE OPTION ARGUMENT TO *A*
  1125.           NZ     X1,VCP11    IF INCORRECT OPTION ARGUMENT
  1126.           SX6    B1
  1127.           SA6    ABTF        SET ABORT OPTION FLAG
  1128.  
  1129. *         CHECK FOR VALID JSN ARGUMENT.
  1130.  
  1131.  VCP6     SA1    JSNA
  1132.           ZR     X1,VCPX     IF NO JSN ARGUMENT
  1133.           MX0    -6
  1134.           LX0    30
  1135.           BX2    -X0*X1
  1136.           NZ     X2,VCP12    IF MORE THAN FOUR CHARACTERS
  1137.           LX0    6
  1138.           BX2    -X0*X1
  1139.           ZR     X2,VCP12    IF LESS THAN FOUR CHARACTERS
  1140.           MX0    -6
  1141.           SB5    4           SET NUMBER OF AVAILABLE CHARACTERS
  1142.  VCP7     LX1    6
  1143.           SB5    B5-1        DECREMENT CHARACTER COUNT
  1144.           BX2    -X0*X1
  1145.           SB2    X2-1R+      CHECK CHARACTER FOR ALPHANUMERIC
  1146.           PL     B2,VCP12    IF NOT VALID CHARACTER
  1147.           NZ     B5,VCP7     IF NOT LAST CHARACTER
  1148.           SA1    POUT
  1149.           NZ     X1,VCP13    IF OUTPUT FILENAME NOT OUTPUT
  1150.           SA2    ORGN
  1151.           NZ     X2,VCP13    IF ORIGIN SPECIFIED
  1152.           SA1    ABTF
  1153.           NZ     X1,VCP13    IF ABORT OPTION SPECIFIED
  1154.           SA2    SERV
  1155.           NZ     X2,VCPX     IF SERVICE CLASS ARGUMENT EXISTS
  1156.  
  1157. *         FLAG ARGUMENT ERROR CONDITION.
  1158.  
  1159.           SX3    MSGK        * SERVICE CLASS REQUIRED WITH JSN.*
  1160.           EQ     VCP14       SET ARGUMENT ERROR FLAG
  1161.  
  1162.  VCP8     SX6    3
  1163.           SA6    ARGE        SET ARGUMENT ERROR FLAG
  1164.           SX3    MSGD        SET * UNDEFINED SERVICE CLASS.*
  1165.           EQ     VCP1        CONTINUE TO VALIDATE NEXT PARAMETER
  1166.  
  1167.  VCP9     SX3    MSGH        * UNIDENTIFIED ORIGIN TYPE.*
  1168.           EQ     VCP14       SET ARGUMENT ERROR FLAG
  1169.  
  1170.  VCP10    SX3    MSGI        * INCORRECT OUTPUT FILENAME.*
  1171.           EQ     VCP14       SET ARGUMENT ERROR FLAG
  1172.  
  1173.  VCP11    SX6    B0+         RESET ABORT FLAG
  1174.           SA6    ABTF
  1175.           SX3    MSGG        * INCORRECT OPTION ARGUMENT.*
  1176.           EQ     VCP14       SET ARGUMENT ERROR FLAG
  1177.  
  1178.  VCP12    SX3    MSGN        * INCORRECT JSN ARGUMENT.*
  1179.           EQ     VCP14       SET ARGUMENT ERROR FLAG
  1180.  
  1181.  VCP13    SX3    MSGJ        * SC ONLY PARAMETER VALID WITH JSN.*
  1182.           EQ     VCP14       SET ARGUMENT ERROR FLAG
  1183.           SPACE  4,10
  1184. *         PRESET COMMON DECKS.
  1185.  
  1186. *CALL     COMCARM
  1187. *CALL     COMCCPA
  1188. *CALL     COMCPOP
  1189. *CALL     COMCSTF
  1190. *CALL     COMCUSB
  1191.           SPACE  4,10
  1192.  RFL=     EQU    *
  1193.           END
cdc/nos2.source/opl871/class.txt · Last modified: 2023/08/05 17:24 by Site Administrator