0VJ 
          IDENT  0VJ,/REL/RVJX
          PERIPH J
          BASE   MIXED
          SST 
 QUAL$    EQU    1
*COMMENT  0VJ - VERIFY JOB/USER COMMANDS. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          TITLE  0VJ - VERIFY JOB/USER COMMANDS.
          SPACE  4,10 
***       0VJ - VERIFY JOB AND USER COMMANDS. 
*         R. A. JAPS.        75/06/24.
*         P. C. SMITH.       83/02/11.
          SPACE  4,10 
***       *0VJ* PROCESSES JOB AND USER COMMANDS FOR AN INPUT PROCESSOR. 
* 
*         THE JOB COMMAND MAY HAVE TWO FORMATS. 
* 
*         THE FIRST FORMAT IS ORDER DEPENDENT.  IT IS - 
*         UJN,SVC,TL,CMFL,ECFL,LID,AL.
*                UJN  = USER JOB NAME.
*                SVC  = SERVICE CLASS.
*                TL   = TIME LIMIT. 
*                CMFL = CENTRAL MEMORY FIELD LENGTH.
*                ECFL = EXTENDED MEMORY FIELD LENGTH. 
*                LID  = LOGICAL ID OF THE MF THE JOB IS TO RUN ON.
*                AL   = MAXIMUM ACCESS LEVEL THAT JOB MAY RUN WITH. 
* 
*         THE SECOND FORMAT IS NOT ORDER DEPENDENT EXCEPT THAT THE
*         JOBNAME MUST APPEAR FIRST.  SERVICE CLASS IS DENOTED BY 
*         *SC* OR *P*, TIME LIMIT BY *T*, CM FIELD LENGTH BY *CM*,
*         EM FIELD LENGTH BY *EC*, LID BY *ST*, AND ACCESS LEVEL
*         BY *AL*.  THESE SYMBOLS MUST PRECEDE THE VALUE. 
*         FOR CLARITY, IT IS RECOMMENDED THAT THE SYMBOL AND
*         THE VALUE BE SEPARATED BY AN EQUAL SIGN (ALTHOUGH 
*         THIS IS NOT REQUIRED).
* 
*         THE FORMATS OF THE ARGUMENTS ARE AS FOLLOWS - 
* 
*         JOB NAME - 1 TO 7 ALPHA-NUMERIC CHARACTERS, BEGINNING WITH
*                A LETTER.
* 
*         SERVICE CLASS - TWO ALPHANUMERIC CHARACTERS OR A PRIORITY 
*                LEVEL NUMBER IN THE RANGE 0 - 7.  SERVICE CLASS IS 
*                DENOTED BY *SC* OR *P*.  IF *SC* IS USED, THE
*                FOLLOWING VALUES ARE ALLOWED.
*                SY    SYSTEM 
*                BC    BATCH
*                RB    REMOTE BATCH 
*                TS    INTERACTIVE
*                DI    DETACHED INTERACTIVE 
*                NS    NETWORK SUPERVISOR 
*                MA    MAINTENANCE
*                CT    COMMUNICATION TASK 
*                I0    INSTALLATION CLASS 0 
*                I1    INSTALLATION CLASS 1 
*                I2    INSTALLATION CLASS 2 
*                I3    INSTALLATION CLASS 3 
*                IF *P* IS SPECIFIED, THE SERVICE CLASS DEFINED FOR 
*                THAT PRIORITY LEVEL BY THE SITE (VIA THE *PCLASS*
*                COMMAND OR IPRDECK ENTRY) WILL BE USED.
* 
*         TIME LIMIT - A NUMBER FROM 1 - 262143D (777777B). 
*                VALUES FROM 32,767D TO 262,143D ARE FORCED 
*                TO AN UNLIMITED AMOUNT.
* 
*         FIELD LENGTH - A NUMBER FROM 1 - MAXIMUM SIZE ALLOWED.
*                THIS VALUE DEPENDS ON THE ACTUAL SIZE OF CENTRAL 
*                MEMORY OR THE AMOUNT OF EM AVAILABLE.  THE VALUE OF
*                CENTRAL MEMORY WILL BE ROUNDED TO THE NEXT HIGHER
*                MULTIPLE OF 100B.  THE EM MEMORY VALUE IS 5 DIGITS 
*                OR LESS AND REPRESENTS THE NUMBER OF 1000B WORD BLOCKS.
* 
*         LID  - A 3 CHARACTER LID THAT IDENTIFIES WHAT MAINFRAME 
*                THIS JOB SHOULD RUN ON.
* 
*         ACCESS LEVEL - A 1- TO 7-CHARACTER NAME (AS DEFINED IN
*                *COMSMLS*) FOR THE MAXIMUM ACCESS LEVEL THE JOB
*                WILL BE ALLOWED TO RUN AT.  THE USER MUST BE 
*                VALIDATED TO RUN AT THE SPECIFIED ACCESS LEVEL,
*                AND THAT LEVEL MUST BE VALID FOR THE SYSTEM
*                AND FOR THE JOB ORIGIN TYPE.  IF NO ACCESS LEVEL 
*                IS SPECIFIED, THE JOB WILL ONLY BE ALLOWED TO
*                RUN AT ONE ACCESS LEVEL, AND THAT LEVEL WILL BE
*                THE USER-S LOWEST VALIDATED ACCESS LEVEL THAT
*                IS ALSO VALID FOR THE SYSTEM AND FOR THE JOB 
*                ORIGIN TYPE. 
* 
*         THE DEFAULT BASE FOR THE TIME ARGUMENT IS DECIMAL,
*         FOR THE FIELD LENGTHS IT IS OCTAL.  A 
*         POST-RADIX OF *B* OR *D* MUST BE SPECIFIED TO ENTER 
*         A NUMBER WHICH IS NOT IN THE DEFAULT BASE.  PRESENCE OF AN
*         8 OR 9 WILL DEFAULT TO DECIMAL.  PRESENCE OF AN 8 OR 9
*         ALONG WITH A POST-RADIX OF *B* WILL RESULT IN AN ERROR. 
*         ALL FIELDS MUST BE SEPARATED BY ONE OF THE FOLLOWING
*         CHARACTERS: 
*                +-*/=,($ 
*         THE JOB COMMAND TERMINATES WITH *)* OR *.*
*         EMBEDDED SPACES ARE ALLOWED, AND ANY CHARACTER MAY APPEAR 
*         IN THE COMMENTS FIELD AFTER THE TERMINATOR. 
* 
*         ASSEMBLY CONSTANTS ARE PROVIDED FOR DEFAULT ARGUMENTS.
*         THESE VALUES ARE TL=64D, CM=377700B, EC=7777000B. 
*         THEY ARE DEFINED IN COMMON DECK *COMSJCE*.
* 
*         THE USER DEFAULT SERVICE CLASS FOR THE ORIGIN TYPE OF THE 
*         JOB IS USED IF NO *SC* OR *P* ARGUMENT IS SELECTED. 
          SPACE  4,10 
***       ENTRY CONDITIONS. 
* 
* 
*         (CN) = FWA OF STATEMENT BUFFER. 
*         (CN+1) = ATTRIBUTES OF DESTINATION LID. 
*         (CN+1) = 0 IF DESTINATION LID NOT ALREADY SPECIFIED.
*         (CN+2) = 1/N, 1/E, 1/S, 1/D, 5/, 3/AL 
*                  N  = NO PASSWORD VALIDATION REQUIRED.
*                  E  = VALIDATE ENCRYPTED PASSWORD (FROM *EPSS*).
*                  S  = JOB WILL BE SYSTEM ORIGIN.
*                  D  = DO NOT DELETE PASSWORD FROM BUFFER. 
*                  AL = ACCESS LEVEL OF LOCAL FILE TO BECOME JOB. 
*         (OT) = ORIGIN TYPE. 
          SPACE  4,10 
***       EXIT CONDITIONS.
* 
* 
*         (A) .LT. 0 IF VALIDATION FILE DEVICE INACCESSIBLE.
*         (T5) = EST ORDINAL OF VALIDATION FILE DEVICE IF INACCESSIBLE. 
* 
*         JOB COMMAND ARGUMENTS SET IN SYSTEM SECTOR BUFFER.
*         JOB COMMAND ERROR IS SET IN SYSTEM SECTOR BUFFER (JASS).
*                IDIE = ILLEGAL LID SPECIFIED VIA *ST*. 
*                JCIE = JOB COMMAND ERROR.
*                SCIE = INVALID SERVICE CLASS.
*                STIE = *ST* SPECIFIED AND USER NOT VALIDATED.
*                UCIE = USER SECURITY COUNT EXHAUSTED.
*                UNIE = USER NAME/PASSWORD NOT VALID. 
*                USIE = UNDEFINED SERVICE CLASS.
*         (CN) = ATTRIBUTES OF DESTINATION LID, IF SPECIFIED. 
*         (CN+1) = USER DEFAULT SERVICE CLASS FOR ORIGIN TYPE 
*                  OF INPUT FILE. 
*         (CN+2 - CN+4) = SERVICE CLASS VALIDATION MASK FOR USER. 
*         USER/ACCOUNT COMMAND INFORMATION SET IN SYSTEM SECTOR.
*         SERVICE CLASS SET IN QFT ENTRY IN SYSTEM SECTOR.
*         (JF) = INITIAL JOB FIELD LENGTH.
*         (JE) = INITIAL EM JOB FIELD LENGTH/*UEBS*.
*         (ER) = ERROR STATUS.
*                0 = NO ERROR ENCOUNTERED.
*                1 = JOB COMMAND ERROR. 
*                3 = USER COMMAND ERROR.
* 
*         NOTES  *JOB COMMAND ERROR* STATUS WILL NEVER BE RETURNED
*                IF THE JOB IS DESTINED FOR A NON-HOST LID. 
* 
*                IF BOTH A USER COMMAND ERROR AND A JOB COMMAND ERROR 
*                ARE ENCOUNTERED, *USER COMMAND ERROR* STATUS WILL BE 
*                RETURNED UNLESS THE JOB COMMAND ERROR CODE IS
*                *INVALID LID*. 
* 
*                WHEN VALIDATING THE USER COMMAND, THE PASSWORD ON THE
*                USER COMMAND WILL BE VALIDATED EXCEPT IN THE FOLLOWING 
*                CASES -
* 
*                1) IF THE *DO NOT VALIDATE PASSWORD* BIT IS SET, THE 
*                   PASSWORD WILL NOT BE VALIDATED. 
* 
*                2) IF THE *VALIDATE ENCRYPTED PASSWORD* BIT IS SET,
*                   THE PASSWORD ON THE USER COMMAND WILL BE VALIDATED
*                   IF IT EXISTS; OTHERWISE THE ENCRYPTED PASSWORD
*                   WILL BE VALIDATED.
          SPACE  4,10 
**        CALLS.
* 
*         0AV - ACCOUNT VALIDATION. 
*         0VU - VALIDATE USER AND JOB.
          TITLE  MACRO DEFINITIONS. 
 JCARG    SPACE  4,15 
**        JCARG - JOB COMMAND ARGUMENT TABLE ENTRY MACRO. 
* 
*         JCARG  A,B,C,D,E
* 
*         ENTRY  A = JOB COMMAND ARGUMENT.
*                B = PROCESSOR ADDRESS. 
*                C = MAXIMUM NUMBER OF DIGITS PLUS ONE. 
*                D = MAXIMUM DECIMAL VALUE ALLOWED. 
*                E = DEFAULT BASE.
*                    *DECIMAL* = DECIMAL BASE.
*                    OTHER = OCTAL BASE.
  
  
          PURGMAC JCARG 
 JCARG    MACRO  A,B,C,D,E
 .1       MICRO  1,2,$A$
 .2       MICCNT .1 
 .3       DECMIC .2,1 
          CON    ".3"_R_A 
          CON    B
          CON    C
          VFD    24/D 
 .A       IFC    EQ,$E$DECIMAL$ 
          CON    1
 .A       ELSE
          CON    0
 .A       ENDIF 
 .A       IFEQ   .2,2 
 .1       MICRO  1,1,$A$
 .3       MICRO  2,1,$A$
 .1       MICRO  1,2,$".3"".1"$ 
 .2       MICCNT NMSC 
          DUP    .2/2 
 .2       SET    .2-2 
 .3       MICRO  .2+1,2,$"NMSC"$
 .B       IFC    EQ,$".1"$".3"$ 
          ERR    JOB COMMAND KEYWORD/SERVICE CLASS CONFLICT (*".1"*). 
          STOPDUP 
 .B       ENDIF 
          ENDD
 .A       ENDIF 
          ENDM
 PARAM    SPACE  4,10 
**        PARAM - DEFINE *0VJ*/*0VU* INTERFACE PARAMETER. 
* 
* TAG     PARAM  NUM,VAL
* 
*         ENTRY  TAG = SYMBOLIC NAME FOR LOCATION(S). 
*                NUM = NUMBER OF LOCATIONS TO RESERVE.
*                      (IF NUM = *FIRST*, INITIALIZE BLOCK; 
*                       IF NUM = *LAST*, TERMINATE BLOCK.)
*                VAL = VALUE TO PRESET LOCATION(S) WITH.
  
  
          PURGMAC  PARAM
  
          MACRO  PARAM,TAG,NUM,VAL
 .A       IFC    EQ,$VAL$$
 .B       IFC    EQ,$NUM$FIRST$ 
 TAG      BSS    0
 .1       SET    *
 .B       ELSE
 .C       IFC    EQ,$NUM$LAST$
 TAG      BSS    0
          ERRNZ  OVL0-5-*    PARAMETER BLOCK LOCATION ERROR 
          ERRNZ  .1+ZVPL-*   PARAMETER BLOCK LENGTH ERROR 
 .C       ELSE
          ERR                MISSING PARAMETER
 .C       ENDIF 
 .B       ENDIF 
 .A       ELSE
 TAG      BSS    0
 .D       DUP    NUM
          CON    VAL
 .D       ENDD
 .A       ENDIF 
          ENDM
 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 
 .A       IFC    NE,$NM$SSSC$ 
 .SCL     RMT 
          INDEX  NM,2R_MN    TX 
 .SCL     RMT 
 .A       ENDIF 
 SCLASS   ENDM
 UCARG    SPACE  4,10 
**        UCARG - USER COMMAND ARGUMENT TABLE ENTRY MACRO.
* 
*         UCARG  A,B,C. 
* 
*         ENTRY  A = ARGUMENT KEYWORD.
*                B = ADDRESS TO ASSEMBLE ARGUMENT.
*                C = * IF ASTERISK ALLOWED IN ARGUMENT. 
  
  
          PURGMAC  UCARG
 UCARG    MACRO  A,B,C
          LOCAL  D
          VFD    12/0L_A
          CON    B
 D        SET    0
          IFC    EQ,$C$*$,1 
 D        SET    1R*
          VFD    12/D 
 UCARG    ENDM
          SPACE  4,10 
*         COMMON DECKS. 
  
  
*CALL     COMPMAC 
*CALL     COMPRLI 
*CALL     COMSACC 
*CALL     COMSCPS 
*CALL     COMSDSP 
*CALL     COMSJCE 
*CALL     COMSMLS 
*CALL     COMSPIM 
          QUAL   REM
*CALL     COMSREM 
          QUAL   *
 SCL$     EQU    0           ONLY PROCESS CLASSES WITH JCB-S
*CALL     COMSSCD 
*CALL     COMSSSD 
*CALL     COMSSSE 
*CALL     COMSZOL 
          SPACE  4,20 
****      DIRECT LOCATION ASSIGNMENTS.
  
 T8       EQU    16          TEMPORARY STORAGE
 T9       EQU    17          TEMPORARY / ARGUMENT TABLE INDEX 
 CA       EQU    25          CHARACTER ADDRESS
 CN       EQU    30 - 34     ASSEMBLE BUFFER (5 LOCATIONS)
 JF       EQU    35          JOB FIELD LENGTH 
 CB       EQU    37          ADDRESS OF NEXT COMMAND IN BUFFER
 UN       EQU    40 - 44     USER NUMBER (USED BY 0AV)
 JE       EQU    45          JOB EM FIELD LENGTH/*UEBS* 
 OT       EQU    46          ORIGIN TYPE
 ER       EQU    47          ERROR STATUS 
  
****
          TITLE  MAIN ROUTINE.
 RVJ      SPACE  4,10 
**        RVJ - MAIN ROUTINE. 
  
          ORG    5B 
  
 RVJ      SUBR               ENTRY/EXIT 
          LJM    PRS         PRESET 
 VUN      SPACE  4,15 
**        VUN - VALIDATE USER NAME. 
* 
*         ENTRY  (UN - UN+4) = USER NAME. 
*                (CN - CN+4) = FAMILY NAME. 
* 
*         EXIT   TO *EVU* IF VALIDATION FILE ACCESSIBLE.
*                TO *RVJX* IF VALIDATION FILE INACCESSIBLE. 
* 
*         USES   LA, T6, UN+4.
* 
*         CALLS  EVU. 
* 
*         MACROS EXECUTE. 
  
  
 VUN      BSS    0           ENTRY
  
*         GET USER ACCOUNT BLOCK FOR SPECIFIED USER/FAMILY. 
  
          LDN    0           VALIDATE USER NAME 
          STD    UN+4 
          LDC    OVL0        SET LOAD ADDRESS 
          RAD    LA 
          EXECUTE  0AV,*
          RJM.   EXR
          MJN    RVJX        IF VALIDATION FILE INACCESSIBLE
          LDD    T1          SET *0VU* PARAMETERS 
          STM    UIDX-OVL0
          LDD    T2 
          STM    UIDX+1-OVL0
          LDD    T4 
          STM    SPUI-OVL0
          LDD    T6 
          STM    USCT-OVL0
          LDD    T3          SET USER BLOCK ADDRESS 
          STM    VUNA-OVL0
          LDC    5*ARBS-1    COPY USER BLOCK TO BUFFER
          STD    T6 
 VUN1     LDM.   *,T6 
 VUNA     EQU    *-1
          STM    UBUF,T6
          SOD    T6 
          PJN    VUN1        IF MORE BYTES TO MOVE
*         UJN    EVU         EXIT TO *0VU*
 EVU      SPACE  4,10 
**        EVU - EXECUTE *0VU*.
* 
*         EXIT   TO *0VU*.
  
  
 EVU      BSS    0           ENTRY
          EXECUTE  0VU,*     VALIDATE USER AND JOB
          RJM.   EXR
*         LJM    RVJX        RETURN TO CALLER DIRECTLY FROM *0VU* 
          SPACE  4,10 
          LIST   X
*CALL     COMS0VU 
          LIST   *
          SPACE  4,10 
*         OVERLAY/BUFFER ADDRESS ALLOCATION.
  
  
 OVL0     EQU    *+5         *0AV*/*0VU* LOAD ADDRESS 
 UBUF     EQU    ZVJL-ARBS*5 USER BLOCK BUFFER FOR *0AV*/*0VU*
  
          ERRNG  UBUF-OVL0-ZAVL  *0AV* OVERFLOWS INTO *UBUF*
          ERRNG  UBUF-OVL0-ZVUL  *0VU* OVERFLOWS INTO *UBUF*
          TITLE  VALIDATE JOB COMMAND.
 VJC      SPACE  4,10 
**        VJC - VALIDATE JOB COMMAND. 
* 
*         EXIT   TO *VUN* IF NO ERROR IN *USER* COMMAND.
*                TO *EVU* IF ERROR IN *USER* COMMAND. 
* 
*         USES   CB.
* 
*         CALLS  DPW, EVU, ISS, JCP, UCP, UCS, VUN. 
  
  
 VJC      BSS    0           ENTRY
  
*         UNPACK JOB COMMAND. 
  
          LDD    CN 
          STD    CB 
          RJM    UCS         UNPACK JOB COMMAND 
          NJN    VJC1        IF NO ERROR
          AOM    JCEF        FLAG ERROR 
  
*         PROCESS JOB COMMAND.
  
 VJC1     RJM    JCP         PROCESS JOB COMMAND ARGUMENTS
  
*         INITIALIZE SYSTEM SECTOR. 
  
          RJM    ISS         INITIALIZE SYSTEM SECTOR 
  
*         UNPACK AND CRACK USER COMMAND.
  
          RJM    UCS         UNPACK USER COMMAND
          ZJN    VJC4        IF ERROR IN USER COMMAND 
          RJM    UCP         PROCESS USER COMMAND 
          ZJN    VJC4        IF ERROR 
          RJM    DPW         DELETE PASSWORD FROM INPUT FILE
 VJC3     LJM    VUN         VALIDATE USER NAME 
  
*         PROCESS ERROR IN *USER* COMMAND.
  
 VJC4     AOM    UCNV        SET *USER* NOT VALID 
          LDC    OVL0        SET *0VU* LOAD ADDRESS 
          RAD    LA 
          LJM    EVU-OVL0    EXIT TO CALL *0VU* 
          TITLE  JOB COMMAND PROCESSOR. 
 JCP      SPACE  4,20 
**        JCP - JOB COMMAND PROCESSOR.
* 
*         ENTRY  (CA) = FWA OF CHARACTER STRING.
*                (JF) = JOB FIELD LENGTH. 
*                (JE) = JOB EM FIELD LENGTH.
* 
*         EXIT   (JF) = JOB FIELD LENGTH
*                (JE) = JOB EM FIELD LENGTH.
* 
*         USES   LA, T9, CM - CM+4. 
* 
*         CALLS  AEF, AFL, AJN, AST, ASV, ATL, CTS, CVS, ERR, GNC.
  
  
 JCP      SUBR               ENTRY/EXIT 
          LDN    ZERL        CLEAR JOBNAME BUFFER 
          CRM.   JNSS,ON
          RJM    AJN         ASSEMBLE JOB NAME
          RJM    CTS         CHECK FOR TERMINATOR 
          MJN    JCPX        IF TERMINATOR
          LDN    0           PRESET TABLE INDEX 
          STD    T9 
          RJM    GNC         GET FIRST ARGUMENT CHARACTER 
          MJN    JCPX        IF TERMINATOR
          ZJN    JCP5        IF SEPARATOR 
          SBN    1R0
          PJN    JCP5        IF NUMBER (ORDER DEPENDENT JOB COMMAND)
          LDD    CA          SAVE ARGUMENT FWA
          STD    CM+4 
          LDI    CA          CHECK FOR POSSIBLE SERVICE CLASS 
          SHN    6
          STD    CM 
          RJM    GNC         GET NEXT CHARACTER 
          MJN    JCP2        IF TERMINATOR (NOT SERVICE CLASS)
          ZJN    JCP2        IF SEPARATOR (NOT SERVICE CLASS) 
          RAD    CM 
          RJM    GNC         GET NEXT CHARACTER 
          MJN    JCP1        IF TERMINATOR (POSSIBLE SERVICE CLASS) 
          NJN    JCP2        IF NOT SEPARATOR (NOT SERVICE CLASS) 
 JCP1     RJM    CVS         CHECK FOR VALID SERVICE CLASS
          ZJN    JCP4        IF ORDER DEPENDENT (VALID SERVICE CLASS) 
 JCP2     LDD    CM+4        RESET ARGUMENT ADDRESS 
          STD    CA 
          LJM    JCP9        PROCESS ORDER INDEPENDENT
  
*         PROCESS ORDER DEPENDENT ARGUMENTS.
  
 JCP3     RJM    ERR         SET ERROR STATUS 
          UJP    JCPX        RETURN 
  
 JCP4     LDD    CM+4        RESET ARGUMENT ADDRESS 
          STD    CA 
 JCP5     LDM    TJCP+1,T9
          ZJN    JCP3        IF END OF TABLE (TOO MANY ARGUMENTS) 
          STM    JCPB        SET PROCESSOR ADDRESS
          RJM    CTS         CHECK FOR SEPARATOR
          ZJN    JCP6        IF SEPARATOR (NULL ARGUMENT) 
          LDC.   TJCP+2      SET LIMITS 
          ADD    T9 
          STM    JCPA 
          LDD    MA 
          CWM    TJCP+2,ON
 JCPA     EQU    *-1
          SBN    1
          CRD    CM 
          RJM    *           PROCESS ARGUMENT 
 JCPB     EQU    *-1
          RJM    CTS         CHECK FOR TERMINATOR 
          MJP    JCPX        IF TERMINATOR
 JCP6     RJM    GNC         SKIP SEPARATOR 
          LDN    TJCPE       INCREMENT INDEX
          RAD    T9 
          UJN    JCP5        PROCESS NEXT ARGUMENT
  
*         PROCESS ORDER INDEPENDENT ARGUMENTS.
  
 JCP7     RJM    ERR         SET ERROR / SKIP TO END OF ARGUMENT
 JCP8     LDN    0           PROCESS NEXT ARGUMENT
          STD    T9 
          RJM    CTS         CHECK FOR TERMINATOR 
          MJP    JCPX        IF TERMINATOR
          RJM    GNC         SKIP SEPARATOR 
 JCP9     LDI    CA          ASSEMBLE ARGUMENT MNEMONIC 
          STD    CM 
          RJM    GNC
          MJN    JCP7        IF TERMINATOR
          SHN    6
          RAD    CM 
 JCP10    LDM    TJCP,T9
          ZJN    JCP12       IF ARGUMENT NOT FOUND IN TABLE 
          LMD    CM 
          ZJN    JCP13       IF TWO-CHARACTER ARGUMENT FOUND
          LDD    CM 
          LPN    77 
          LMM    TJCP,T9
          ZJN    JCP14       IF ONE-CHARACTER ARGUMENT FOUND
          LDN    TJCPE       INCREMENT INDEX
          RAD    T9 
          UJN    JCP10       CHECK NEXT ARGUMENT IN TABLE 
  
 JCP11    UJP    JCP7        PROCESS ERROR
  
 JCP12    LDC    2RCS        CHECK FOR *SC* IF UNKNOWN ARGUMENT FOUND 
          LMD    CM 
          NJN    JCP11       IF UNKNOWN ARGUMENT NOT *SC* 
          STD    T9          SET TABLE INDEX FOR *P* ARGUMENT 
          LDM    TJCP,T9
          LMC    7777 
          ZJN    JCP11       IF *P* OR *SC* ALREADY SPECIFIED 
 JCP13    RJM    GNC         GET FIRST CHARACTER OF ARGUMENT VALUE
 JCP14    RJM    CTS         CHECK FOR EQUIVALENCED ARGUMENT
          MJN    JCP11       IF TERMINATOR
          NJN    JCP15       IF NOT SEPARATOR 
          LDI    CA 
          LMN    1R=
          NJN    JCP11       IF SEPARATOR OTHER THAN EQUAL SIGN 
          RJM    GNC         SKIP EQUAL SIGN
 JCP15    LDM    TJCP+1,T9
          STM    JCPD 
          LDC.   TJCP+2      SET LIMITS 
          ADD    T9 
          STM    JCPC 
          LDD    MA 
          CWM    TJCP+2,ON
 JCPC     EQU    *-1
          SBN    1
          CRD    CM 
          LCN    0           SET ARGUMENT PROCESSED 
          STM    TJCP,T9
          RJM    *           PROCESS ARGUMENT 
 JCPD     EQU    *-1
          LJM    JCP8        PROCESS NEXT ARGUMENT
 TJCP     SPACE  4,30 
**        TJCP - TABLE OF JOB COMMAND ARGUMENT PROCESSORS.
* 
*T        12/MN 
*T,       12/ADDR 
*T,       12/DIGITS 
*T,       24/VALUE
*T,       12/BASE 
* 
*         MN = MNEMONIC.
*         ADDR = ADDRESS. 
*         DIGITS = MAXIMUM NUMBER OF DIGITS PLUS ONE. 
*         VALUE = MAXIMUM DECIMAL VALUE.
*         BASE = BASE FOR CONVERSION. 
*                0 = OCTAL. 
*                1 = DECIMAL. 
  
  
 TJCP     BSS    0
          JCARG  P,ASV,3,7              SERVICE CLASS 
 TJCPE    EQU    *-TJCP                 LENGTH OF ENTRY 
          JCARG  T,ATL,6,32760D,DECIMAL JOB TIME LIMIT PROCESSOR
          JCARG  MC,AFL,7,131008D       JOB FL PROCESSOR
          JCARG  CE,AEF,6,32760D        JOB EM FL PROCESSOR 
          JCARG  TS,AST,4,0             LID PROCESSOR 
          JCARG  LA,AAL,10B,0           ACCESS LEVEL PROCESSOR
          CON    0,0         END OF TABLE 
          TITLE  JOB COMMAND ARGUMENT PROCESSORS. 
 AAL      SPACE  4,15 
**        AAL - ASSEMBLE ACCESS LEVEL.
* 
*         ENTRY  (CA) = CHARACTER ADDRESS.
* 
*         EXIT   (SCAL - SCAL+4) = ACCESS LEVEL STRING.  VALIDATION 
*                                  WILL BE DONE IN *0VU*. 
* 
*         USES   T1, CM - CM+4. 
* 
*         CALLS  ERR, PAC.
  
  
 AAL1     RJM    ERR         SET ERROR STATUS 
  
 AAL      SUBR               ENTRY/EXIT 
          LDN    1R*         ALLOW ASTERISK IN ACCESS LEVEL 
          STD    T1 
          LDN    ZERL        CLEAR BUFFER 
          CRD    CM 
          LDN    CM          GET ACCESS LEVEL STRING
          RJM    PAC
          ZJN    AAL1        IF INCORRECT ACCESS LEVEL STRING 
          LDD    MA          SAVE ACCESS LEVEL
          CWD    CM 
          CRM    SCAL,ON
          UJN    AALX        RETURN 
 AEF      SPACE  4,20 
**        AEF - ASSEMBLE EXTENDED MEMORY FIELD LENGTH.
* 
*         ENTRY  (CA) = CHARACTER ADDRESS.
*                (CM) = MAXIMUM NUMBER OF DIGITS PLUS ONE.
*                (CM+1 - CM+2) = MAXIMUM DECIMAL VALUE. 
*                (CM+3) = BASE FOR CONVERSION.
*                (AEFC) = MAXIMUM EM FL/*UEBS*. 
* 
*         EXIT   (JE) = EM FIELD LENGTH/*UEBS*. 
* 
*         USES   JE.
* 
*         CALLS  ASD, ERR.
  
  
 AEF      SUBR               ENTRY/EXIT 
          RJM    ASD         ASSEMBLE DIGITS
          MJN    AEFX        IF ERROR IN ASSEMBLY 
 AEFA     ADN    0
*         ADN    17          (ROUND UP TO BLOCKING FACTOR)
 AEFB     SHN    0
*         SHN    -UESC
          STD    JE 
          LDC    *           GET MAXIMUM EM FIELD LENGTH
 AEFC     EQU    *-1         (MAXIMUM EM FL)
          SBD    JE 
          MJN    AEF1        IF INSUFFICIENT ROOM 
          LDC    3777 
          SBD    JE 
          PJN    AEFX        IF FLE .LT. 3777B *UEBS* BLOCKS
 AEF1     RJM    ERR         SET ERROR STATUS 
          UJN    AEFX        RETURN 
 AFL      SPACE  4,15 
**        AFL - ASSEMBLE CM FIELD LENGTH. 
* 
*         ENTRY  (CA) = CHARACTER ADDRESS.
*                (CM) = MAXIMUM NUMBER OF DIGITS PLUS ONE.
*                (CM+1 - CM+2) = MAXIMUM DECIMAL VALUE. 
*                (CM+3) = BASE FOR CONVERSION.
*                (AFLA) = MAXIMUM CM FL / 100B. 
* 
*         EXIT   (JF) = FIELD LENGTH ROUNDED UP TO NEXT MULTIPLE OF 100.
*                (CA) = CHARACTER ADDRESS.
* 
*         USES   JF.
* 
*         CALLS  ASD, ERR.
  
  
 AFL      SUBR               ENTRY/EXIT 
          RJM    ASD         ASSEMBLE DIGITS
          MJN    AFLX        IF ERROR IN ASSEMBLY 
          ZJN    AFL1        IF ZERO
          ADN    77          ROUND TO NEXT 100
          SHN    -6          SET FIELD LENGTH 
          STD    JF 
          LDC    *           GET MAXIMUM FIELD LENGTH 
 AFLA     EQU    *-1         (MAXIMUM CM FL)
          SBD    JF 
          MJN    AFL1        IF INSUFFICIENT ROOM 
          LDC    3777-MNFL
          SBD    JF 
          PJN    AFLX        IF FL .LT. 377700
 AFL1     RJM    ERR         SET ERROR STATUS 
          UJN    AFLX        RETURN 
 AJN      SPACE  4,10 
**        AJN - ASSEMBLE JOB NAME.
* 
*         ENTRY  (CA) = CHARACTER ADDRESS.
* 
*         EXIT   (JNSS - JNSS+3) = JOB COMMAND NAME (USER JOB NAME).
*                (CA) = CHARACTER ADDRESS.
* 
*         CALLS  ERR, PAC.
  
  
*         PROCESS BAD UJN.
  
 AJN3     LDN    ZERL        SET SPECIAL UJN
          CRM.   JNSS,ON
          LDC    2RXX 
          STM.   JNSS 
          STM.   JNSS+1 
          RJM    ERR         SET ERROR STATUS 
  
 AJN      SUBR               ENTRY/EXIT 
          LDN    0
          STD    T1 
          LDC    JNSS        ASSEMBLE JOB COMMAND NAME
          RJM    PAC
          ZJN    AJN3        IF TOO MANY CHARACTERS 
 AJN2     LDM.   JNSS        CHECK FIRST CHARACTER
          SHN    -6 
          ZJN    AJN3        IF NO CHARACTER
          SBN    1R+
          MJN    AJNX        IF ALPHANUMERIC
          UJN    AJN3        PROCESS BAD UJN
 AST      SPACE  4,15 
**        AST - ASSEMBLE ST (DESTINATION LID).
* 
*         ENTRY  (CA) = CHARACTER ADDRESS.
* 
*         EXIT   (DLID - DLID+1) = LID. 
* 
*         USES   T1, CM - CM+4. 
* 
*         CALLS  ERR, PAC.
  
  
 AST2     LDN    10-3        LID MUST BE 3 CHARACTERS LONG
          SBD    T3 
          NJN    AST1        IF ILLEGAL LENGTH
          LDD    CM+1        STORE LID
          SCN    77 
          STM    DLID+1 
          LDD    CM 
          STM    DLID 
  
 AST      SUBR
          LDN    0           DO NOT ALLOW ASTERISK IN LID 
          STD    T1 
          LDN    ZERL        CLEAR BUFFER 
          CRD    CM 
          LDN    CM 
          RJM    PAC         PACK LOGICAL ID
          NJN    AST2        IF OK
 AST1     LDN    IDIE        SET *ILLEGAL LID* ERROR CODE 
          STM    JCEC 
          RJM    ERR         SET ERROR STATUS 
          UJN    ASTX        RETURN 
 ASV      SPACE  4,15 
**        ASV - ASSEMBLE SERVICE CLASS. 
* 
*         ENTRY  (CA) = CHARACTER ADDRESS.
* 
*         EXIT   (JCSC) = SERVICE CLASS SELECTED ON JOB COMMAND.
*                (JCSC) = 0, IF NO SERVICE CLASS SPECIFIED. 
* 
*         USES   T1, T2, CM - CM+4. 
* 
*         CALLS  CVS, ERR, PAC. 
  
  
 ASV4     RJM    ERR         SET ERROR STATUS 
          LDK    USIE        SET UNDEFINED SERVICE CLASS ERROR CODE 
          STM    JCEC 
  
 ASV      SUBR               ENTRY/EXIT 
          LDN    ZERL        CLEAR BUFFER 
          CRD    CM 
          LDN    0           DO NOT ALLOW ASTERISK IN SERVICE CLASS 
          STD    T1 
          LDN    CM 
          RJM    PAC         PACK CHARACTER STRING
          ZJN    ASV4        IF ERROR 
          LDN    10-2 
          SBD    T3 
          ZJN    ASV3        IF SERVICE CLASS SPECIFIED 
          ADN    1
          NJN    ASV4        IF NOT PRIORITY LEVEL SERVICE CLASS
          LDD    CM 
          SHN    -6 
          SBN    1R0
 ASV1     MJN    ASV4        IF ALPHABETIC CHARACTER
          STD    T1 
          SBN    10 
          PJN    ASV4        IF INVALID PRIORITY LEVEL
          LDN    2
          STD    T2 
          LDK    JBCP        GET ADDRESS OF *SCT* 
          CRD    CM 
          LDD    CM          GET PRIORITY LEVEL SERVICE CLASS 
          SHN    14 
          ADD    CM+1 
          ADN    PLSC 
          CRM    SBUF,T2
          LDM    SBUF,T1
          STD    CM 
          NJN    ASV3        IF SERVICE CLASS SPECIFIED 
 ASV2     STM    JCSC        SELECT USER DEFAULT
          UJP    ASVX        RETURN 
  
 ASV3     RJM    CVS         CHECK FOR VALID SERVICE CLASS
          MJN    ASV1        IF NOT VALID 
          LDD    T2          SET SERVICE CLASS
          UJN    ASV2        SET SERVICE CLASS
 ATL      SPACE  4,10 
**        ATL - ASSEMBLE TIME LIMIT.
* 
*         ENTRY  (CA) = CHARACTER ADDRESS.
*                (CM) = MAXIMUM NUMBER OF DIGITS PLUS ONE.
*                (CM+1 - CM+2) = MAXIMUM DECIMAL VALUE. 
*                (CM+3) = BASE FOR CONVERSION.
* 
*         EXIT   (JTSS - JTSS+1) = JOB STEP TIME LIMIT. 
* 
*         CALLS  ASD, ERR.
  
  
 ATL1     RJM    ERR         SET ERROR STATUS 
  
 ATL      SUBR               ENTRY/EXIT 
          RJM    ASD         ASSEMBLE DIGITS
          MJN    ATLX        IF ERROR IN ASSEMBLY 
          ZJN    ATL1        IF ZERO TIME LIMIT SPECIFIED 
          STM.   JTSS+1      SET JOB STEP TIME LIMIT
          SHN    -14
          STM.   JTSS 
          UJN    ATLX        RETURN 
          TITLE  USER COMMAND PROCESSOR.
 UCP      SPACE  4,20 
**        UCP - USER COMMAND PROCESSOR. 
* 
*         ENTRY  USER COMMAND IN STRING BUFFER. 
*                (CA) = FWA OF STRING BUFFER. 
* 
*         EXIT   (A) = 0, IF ERROR IN USER COMMAND. 
*                (CN - CN+4) = FAMILY NAME. 
*                (UN - UN+4) = USER NAME. 
*                (PSWD - PSWD+3) = PASSWORD.
*                (FWPW) = FWA OF PASSWORD IN STRING BUFFER. 
*                (LWPW) = LWA+1 OF PASSWORD IN STRING BUFFER. 
*                FAMILY NAME AND USER NAME SET IN SYSTEM SECTOR.
* 
*         USES   CA, T1, T3, CN - CN+4, UN - UN+4.
* 
*         CALLS  CCS, CTS, GNC, PAC.
  
  
 UCP10    LDN    0           SET ERROR STATUS 
  
 UCP      SUBR               ENTRY/EXIT 
          LDN    ZERL        CLEAR ASSEMBLY BUFFERS 
          CRD    CM 
          CRD    UN 
          CRD    CN 
          CRM    PSWD,ON
  
*         VALIDATE KEYWORD. 
  
          LDI    CA 
          LMN    1R$
          ZJN    UCP1        IF $ PRESENT 
          LMN    1R$&1R/
          NJN    UCP2        IF / NOT PRESENT 
 UCP1     AOD    CA          SKIP $ OR /
 UCP2     LDN    0
          STD    T1 
          LDN    CM          ASSEMBLE COMMAND KEYWORD 
          RJM    PAC
 UCP3     ZJN    UCPX        IF KEYWORD TOO LONG
          MJN    UCP10       IF TERMINATOR
          LDD    CM          CHECK KEYWORD
          LMC    2RUS 
          NJN    UCP5        IF NOT *USER*
          LDD    CM+1 
          LMC    2RER 
 UCP4     NJN    UCP10       IF NOT *USER*
          LDD    CM+2 
          ZJN    UCP6        IF *USER*
          UJN    UCP4        PROCESS KEYWORD ERROR
  
 UCP5     LMC    2RAC&2RUS
          NJN    UCP4        IF NOT *ACCOUNT* 
          LDD    CM+1 
          LMC    2RCO 
          NJN    UCP4        IF NOT *ACCOUNT* 
          LDD    CM+2 
          LMC    2RUN 
          NJN    UCP4        IF NOT *ACCOUNT* 
          LDD    CM+3 
          LMC    1RT*100
          NJN    UCP4        IF NOT *ACCOUNT* 
 UCP6     RJM    AUA         ASSEMBLE USER COMMAND ARGUMENTS
 UCP7     ZJN    UCP3        IF ERROR IN ARGUMENTS
  
*         PROCESS USER AND FAMILY NAME. 
  
          LDD    UN 
          ZJN    UCP7        IF NO USER NAME
          LDD    MA          SET USER NAME IN SYSTEM SECTOR 
          CWD    UN 
          CRM.   ACSS,ON
          LDD    CN 
          ZJN    UCP8        IF NO FAMILY NAME
          LMC    1R0*100
          ZJN    UCP8        IF DEFAULT FAMILY PARAMETER
          LDD    MA          SET FAMILY NAME IN SYSTEM SECTOR 
          CWD    CN 
          CRM.   FMSS,ON
          UJN    UCP9        EXIT 
  
 UCP8     LDD    MA          SET DEFAULT FAMILY NAME
          CWM.   FMSS,ON
          SBN    1
          CRD    CN 
 UCP9     LJM    UCPX        EXIT WITH NO ERROR 
 TUCP     SPACE  4,25 
**        TUCP - TABLE OF USER COMMAND PARAMETERS.
* 
*         FORMAT BEFORE PARAMETER PROCESSING -
* 
*T        12/ KW
*T,       12/ ADDR
*T,       12/ AST 
* 
*         KW = PARAMETER KEYWORD IF EQUIVALENCED. 
*         ADDR = ASSEMBLY ADDRESS.
*         AST = * IF ASTERISK ALLOWED IN PARAMETER. 
*         SECURE = *S* IF PARAMETER TO BE REMOVED FROM COMMAND. 
* 
*         FORMAT AFTER PARAMETER PROCESSING - 
* 
*T        12/0
*T,       12/FWA
*T,       12/LWA+1
* 
*         FWA = FWA OF PARAMETER IN STRING BUFFER.
*         LWA+1 = LWA+1 OF PARAMETER IN STRING BUFFER.
  
  
 TUCP     BSS    0
          UCARG  UN,UN,*     USER NAME
 TUCPE    EQU    *-TUCP      LENGTH OF ENTRY
 TUCPA    UCARG  PW,PSWD     PASSWORD 
          UCARG  FM,CN       FAMILY NAME
 TUCPL    EQU    *-TUCP      LENGTH OF TABLE
          TITLE  SUBROUTINES. 
 AUA      SPACE  4,10 
**        AUA - ASSEMBLE *USER* COMMAND ARGUMENTS.
* 
*         EXIT   (A) = 0 IF ERROR IN *USER* COMMAND.
* 
*         USES   CA, T1, T4, T5, T6, CM - CM+4. 
* 
*         CALLS  CTS, PAC.
  
  
 AUA7     LDN    0           SET *USER* COMMAND ERROR 
  
 AUA      SUBR               ENTRY/EXIT 
          LDN    0           INITIALIZE PARAMETER INDEX 
          STD    T4 
 AUA1     AOD    CA          SKIP SEPARATOR 
          STD    T5          SAVE PARAMETER ADDRESS 
          LDN    1R*         ALLOW ASTERISK 
          STD    T1 
          LDN    ZERL        CLEAR ASSEMBLY 
          CRD    CM 
          LDN    CM          ASSEMBLE PARAMETER OR KEYWORD
          RJM    PAC
          ZJN    AUAX        IF PARAMETER TOO LONG
          LDI    CA 
          LMN    1R=
          ZJN    AUA3        IF KEYWORD OF EQUIVALENCED PARAMETER 
  
*         PROCESS POSITIONAL PARAMETER. 
  
          LDD    T4          SET PARAMETER INDEX
          STD    T6 
          LDD    T5          RESET CHARACTER ADDRESS
          STD    CA 
          LDM    TUCP,T6
 AUA2     ZJN    AUAX        IF PARAMETER ALREADY ENTERED 
          LDN    0
          UJN    AUA5        SET PARAMETER ENTERED
  
*         PROCESS EQUIVALENCED PARAMETER. 
  
 AUA3     LDD    CM+1 
          NJP    AUA7        IF NOT 2 CHARACTER KEYWORD 
          STD    T6          INITIALIZE PARAMETER INDEX 
          AOD    CA          SKIP SEPARATOR 
          STD    T5          SAVE PARAMETER ADDRESS 
 AUA4     LDM    TUCP,T6     CHECK NEXT KEYWORD ENTRY 
          LMD    CM 
          ZJN    AUA5        IF MATCH 
          LDN    TUCPE       ADVANCE TABLE INDEX
          RAD    T6 
          LMN    TUCPL
          ZJN    AUA2        IF END OF TABLE
          UJN    AUA4        CHECK NEXT ENTRY 
  
*         ASSEMBLE PARAMETER. 
  
 AUA5     STM    TUCP,T6     SET PARAMETER ENTERED
          LDM    TUCP+2,T6   SET ASTERISK ALLOWED STATUS
          LPN    77 
          STD    T1 
          LDM    TUCP+1,T6   SET ASSEMBLY ADDRESS 
          RJM    PAC         ASSEMBLE PARAMETER 
          ZJN    AUA2        IF PARAMETER TOO LONG
          LDI    CA 
          LMN    1R=
 AUA6     ZJN    AUA2        IF SEPARATOR IS *=*
          LDD    T5          SET PARAMETER FWA
          STM    TUCP+1,T6
          LDD    CA          SET PARAMETER LWA+1
          STM    TUCP+2,T6
          RJM    CTS
          MJP    AUAX        IF TERMINATOR
          LDN    TUCPE       ADVANCE PARAMETER INDEX
          RAD    T4 
          LMN    TUCPL
          ZJN    AUA6        IF MAXIMUM PARAMETERS ALREADY ENTERED
          LJM    AUA1        PROCESS NEXT PARAMETER 
 ASD      SPACE  4,25 
**        ASD - ASSEMBLE DIGITS.
* 
*         ENTRY  (CA) = CHARACTER ADDRESS.
*                (CM) = MAXIMUM NUMBER OF DIGITS PLUS ONE.
*                (CM+1 - CM+2) = MAXIMUM DECIMAL VALUE. 
*                (CM+3) = 0, IF DEFAULT BASE IS OCTAL.
*                       = 1, IF DEFAULT BASE IS DECIMAL.
* 
*         EXIT   (A) = ASSEMBLED DIGITS.
*                (A) .LT. 0 IF ERROR IN ASSEMBLY. 
*                (CA) = UPDATED CHARACTER ADDRESS.
* 
*         USES   CM, T1 - T5. 
* 
*         CALLS  CTS, ERR, GNC. 
* 
*         NOTE   *ASD* CONVERTS DISPLAY CODE DIGITS TO OCTAL
*                AND DECIMAL VALUES.
*                THE BASE IS DETERMINED AS FOLLOWS -
*                1)  POST RADIX SPECIFICATION (B=OCTAL, D=DECIMAL). 
*                2)  IF AN 8 OR 9 IS DETECTED THEN DECIMAL IS ASSUMED.
*                3)  DEFAULT AS SPECIFIED BY CALLING ROUTINE. 
  
  
 ASD      SUBR               ENTRY/EXIT 
          LDN    0           PRESET TO NO 8/9 ENCOUNTERED 
          STM    ASDA 
          LDN    ZERL        CLEAR ASSEMBLY REGISTERS 
          CRD    T1 
 ASD1     RJM    CTS         CHECK FOR TERMINATOR/SEPARATOR 
          MJN    ASD2        IF TERMINATOR
          NJN    ASD8        IF NOT TERMINATOR OR SEPARATOR 
  
*         PROCESS END OF ARGUMENT.
  
 ASD2     LDD    CM+3 
          NJN    ASD4        IF BASE IS DECIMAL 
 ASD3     LDD    T2          RETURN OCTAL DIGITS
          SHN    14 
          LMD    T3 
          UJN    ASD6        EXIT 
  
 ASD4     LDD    CM+1        CHECK FOR DECIMAL MAXIMUM
          SBD    T4 
          MJN    ASD7        IF OVER MAXIMUM
          NJN    ASD5        IF UNDER MAXIMUM 
          LDD    CM+2 
          SBD    T5 
          MJN    ASD7        IF OVER MAXIMUM
 ASD5     LDD    T4          RETURN DECIMAL DIGITS
          SHN    14 
          LMD    T5 
 ASD6     MJN    ASD9        IF NEGATIVE VALUE
          UJN    ASDX        RETURN 
  
 ASD7     LDD    CM+1        SET MAXIMUM VALUE
          SHN    14 
          LMD    CM+2 
          UJN    ASD6        EXIT 
  
*         PROCESS NEXT CHARACTER. 
  
 ASD8     LDI    CA          CHECK FOR POST RADIX 
          SBN    1R0
          PJN    ASD12       IF NOT ALPHA 
          ADN    1R0-1RD     CHECK FOR *D*
          NJN    ASD10       IF NOT *D* 
          RJM    GNC         ADVANCE CHARACTER
          MJN    ASD4        IF TERMINATOR
          ZJN    ASD4        IF SEPARATOR 
 ASD9     LJM    ASD14       PROCESS ERROR
  
 ASD10    ADN    1RD-1RB     CHECK FOR *B*
          NJN    ASD9        IF ALPHA OTHER THAN *B* OR *D* 
          LDC    **          (DECIMAL/OCTAL CONVERSION FLAG)
 ASDA     EQU    *-1
*         LDC    1           (8 OR 9 HAS BEEN ENCOUNTERED)
*         LDC    0           (NO 8 OR 9 ENCOUNTERED)
          NJN    ASD9        IF 8 OR 9 AND *B* PRESENT
          RJM    GNC         ADVANCE CHARACTER
          MJN    ASD11       IF TERMINATOR
          NJN    ASD9        IF NOT TERMINATOR OR SEPARATOR 
 ASD11    LJM    ASD3        RETURN OCTAL DIGITS
  
*         SET FLAG IF 8 0R 9 FOUND
  
 ASD12    STD    T1          SAVE DIGIT 
          SBN    1R8-1R0
          MJN    ASD13       IF NOT 8 OR 9
          LDN    1           SET FLAG FOR DECIMAL 
          STM    ASDA 
          STD    CM+3 
  
*         ASSEMBLE OCTAL DIGITS.
  
 ASD13    LDD    T2 
          SHN    14 
          ADD    T3 
          SHN    3
          ADD    T1          ADD NEW DIGIT
          STD    T3 
          SHN    -14
          STD    T2 
  
*         ASSEMBLE DECIMAL DIGITS.
  
          LDD    T4 
          SHN    14 
          ADD    T5 
          SHN    2+6         (*4) 
          ADD    T4 
          SHN    14 
          ADD    T5          (*4+1) 
          SHN    1           (*4+1)*2 
          STD    T5          ADD NEW DIGIT
          SHN    -14
          STD    T4 
          LDD    T1 
          RAD    T5 
          SHN    -14
          RAD    T4          ADD CARRY
          RJM    GNC         GET NEXT CHARACTER 
          SOD    CM 
          ZJN    ASD14       IF TOO MANY DIGITS 
          LJM    ASD1        LOOP 
  
*         PROCESS ERROR IN ASSEMBLY.
  
 ASD14    RJM    ERR         SET ERROR STATUS 
          LCN    1
          LJM    ASDX        RETURN 
 CTS      SPACE  4,15 
**        CTS - CHECK FOR TERMINATOR OR SEPARATOR.
* 
*         ENTRY  (CA) = CHARACTER ADDRESS.
*                (LWUC) = LWA+1 OF UNPACKED COMMAND.
* 
*         EXIT   (A) = 0 IF SEPARATOR (INCLUDES COLON). 
*                (A) .LT. 0 IF TERMINATOR OR END OF LINE. 
*                (A) = CHARACTER (FOR ALL OTHER CHARACTERS).
  
  
 CTS2     LDI    CA          SET NORMAL CHARACTER STATUS
  
 CTS      SUBR               ENTRY/EXIT 
          LDD    CA 
          SBM    LWUC 
          PJN    CTS1        IF END OF LINE 
          LDI    CA 
          ZJN    CTSX        IF COLON 
          LDN    1R9
          SBI    CA 
          PJN    CTS2        IF NOT SEPARATOR OR TERMINATOR 
          LDI    CA 
          LMN    1R)
          ZJN    CTS1        IF TERMINATOR
          LMN    1R.&1R)
          ZJN    CTS1        IF TERMINATOR
          LDN    0           SET SEPARATOR STATUS 
          UJN    CTSX        RETURN 
  
 CTS1     LCN    1           SET TERMINATOR STATUS
          UJN    CTSX        RETURN 
 CVS      SPACE  4,10 
**        CVS - CHECK FOR VALID SERVICE CLASS.
* 
*         ENTRY  (CM) = TWO CHARACTER MNEMONIC TO BE VALIDATED. 
* 
*         EXIT   (A) = 0, IF SERVICE CLASS IS VALID.
*                (A) .LT. 0, IF NOT VALID.
*                (T2) = SERVICE CLASS VALUE.
* 
*         USES   T2.
  
  
 CVS      SUBR               ENTRY/EXIT 
          LDN    0           INITIALIZE TABLE INDEX 
          STD    T2 
 CVS1     LDM    TCVS,T2
          LMD    CM 
          ZJN    CVSX        IF MATCH 
          AOD    T2 
          LDN    MXSC 
          SBD    T2 
          MJN    CVSX        IF END OF TABLE
          UJN    CVS1        CONTINUE SEARCH
 TCVS     SPACE  4,10 
**        TCVS - TABLE OF ALLOWED SERVICE CLASS MNEMONICS.
  
  
 TCVS     INDEX 
          LIST   D
 .SCL     HERE
          LIST   *
          INDEX  MXSC 
 DPW      SPACE  4,15 
**        DPW - DELETE PASSWORD FROM INPUT FILE.
* 
*         ENTRY  (FWPC) = FWA OF PACKED COMMAND.
*                (TUCPA+1) = FWA OF PASSWORD IN STRING BUFFER.
*                (TUCPA+2) = LWA+1 OF PASSWORD IN STRING BUFFER.
*                (CA) = ADDRESS OF TERMINATOR IN STRING BUFFER. 
*                (PSWD) = 0 IF NO PASSWORD SPECIFIED. 
* 
*         EXIT   PASSWORD (IF SPECIFIED) DELETED FROM USER COMMAND, 
*                 UNLESS THE *DO NOT DELETE PASSWORD* BIT WAS SET.
*                USER COMMAND REPACKED TO INPUT FILE BUFFER.
* 
*         USES   T1, T2.
  
  
 DPW      SUBR               ENTRY/EXIT 
          LDM    PSWD 
          ZJN    DPWX        IF NO PASSWORD SPECIFIED 
          LDM    ZVJP 
          SHN    21-10
          MJN    DPWX        IF PASSWORD NOT TO BE DELETED
          LDM    TUCPA+1     FWA OF PASSWORD
          STD    T1 
          LDM    TUCPA+2     LWA+1 OF PASSWORD
          STD    T2 
          AOD    CA          SET TO MOVE TERMINATOR 
  
*         MOVE END OF USER COMMAND DOWN (DELETING PASSWORD).
  
 DPW1     LDI    T2          MOVE CHARACTER 
          STI    T1 
          AOD    T1 
          AOD    T2 
          SBD    CA 
          MJN    DPW1        IF NOT TERMINATOR
  
*         PAD END OF COMMAND WITH BLANKS. 
  
 DPW2     LDN    1R          SET BLANK IN BUFFER
          STI    T1 
          AOD    T1 
          SBD    CA 
          MJN    DPW2        IF MORE CHARACTERS TO PAD
  
*         REPACK USER COMMAND TO INPUT FILE BUFFER. 
  
          LDC.   CHAR        FWA OF UNPACKED COMMAND
          STD    T1 
          LDM    FWPC        FWA OF PACKED COMMAND
          STD    T2 
 DPW3     LDI    T1          PACK TWO CHARACTERS
          SHN    6
          LMM    1,T1 
          STI    T2 
          AOD    T2 
          LDN    2
          RAD    T1 
          SBM    LWUC 
          MJN    DPW3        IF MORE CHARACTERS TO PACK 
          LJM    DPWX        RETURN 
 ERR      SPACE  4,10 
**        ERR - PROCESS JOB COMMAND ERROR.
* 
*         ENTRY  (CA) = CURRENT CHARACTER ADDRESS.
* 
*         EXIT   (CA) ADVANCED TO NEXT SEPARATOR OR TERMINATOR. 
*                (JCEF) INCREMENTED.
* 
*         USES   CA.
  
  
 ERR      SUBR               ENTRY/EXIT 
          AOM    JCEF        FLAG ERROR 
  
*         SKIP TO END OF CURRENT ARGUMENT.
  
 ERR1     RJM    CTS         CHECK FOR TERMINATOR/SEPARATOR 
 ERR2     MJN    ERRX        IF TERMINATOR
          NJN    ERR3        IF NOT SEPARATOR 
          LDI    CA 
          LMN    1R=
          NJN    ERRX        IF NOT EQUAL SIGN
 ERR3     RJM    GNC         GET NEXT CHARACTER 
          UJN    ERR2        CONTINUE 
 GNC      SPACE  4,15 
**        GNC - GET NEXT NONBLANK CHARACTER.
* 
*         ENTRY  (CA) = ADDRESS OF CURRENT CHARACTER. 
*                (LWUC) = LWA+1 OF UNPACKED COMMAND.
* 
*         EXIT   (A) = NEXT NONBLANK CHARACTER. 
*                (A) = 0 IF SEPARATOR.
*                (A) = -1 IF TERMINATOR OR END OF LINE. 
*                (CA) = ADDRESS OF CHARACTER. 
* 
*         USES   CA.
* 
*         CALLS  CTS. 
  
  
 GNC2     LCN    1           SET END OF LINE STATUS 
  
 GNC      SUBR               ENTRY/EXIT 
          RJM    CTS         CHECK FOR TERMINATOR 
          MJN    GNCX        IF ALREADY AT TERMINATOR 
 GNC1     AOD    CA          GET NEXT CHARACTER 
          SBM    LWUC 
          PJN    GNC2        IF END OF LINE 
          LDI    CA 
          LMN    1R 
          ZJN    GNC1        IF BLANK 
          RJM    CTS         CHECK FOR TERMINATOR/SEPARATOR 
          UJN    GNCX        RETURN 
 ISS      SPACE  4,15 
**        ISS - INITIALIZE SYSTEM SECTOR. 
* 
*         ENTRY  (JF) = JOB FIELD LENGTH. 
*                (CN) = FWA OF STATEMENT BUFFER.
*                (CB) = ADDRESS OF COMMAND AFTER JOB COMMAND. 
*                (JTSS - JTSS+1) = JOB STEP TIME LIMIT. 
* 
*         EXIT   *BFMS* CONTAINS SYSTEM SECTOR. 
* 
*         USES   CM - CM+4. 
* 
*         MACROS SFA. 
  
  
 ISS      SUBR               ENTRY/EXIT 
  
*         SET KEY PUNCH MODE. 
  
          LDD    CN          CHECK LENGTH OF JOB COMMAND
          ADN    80D/2-1
          SBD    CB 
          PJN    ISS1        IF JOB COMMAND .LT. 80 COLUMNS 
          LDM.   47,CN
          LMC    2R26 
          ZJN    ISS3        IF O26 
          LMN    2R29&2R26
          ZJN    ISS2        IF O29 
 ISS1     LDN    IPRL        GET SYSTEM DEFAULT KEYPUNCH MODE 
          CRD    CM 
          LDD    CM+2 
          SHN    -13
          ZJN    ISS3        IF O26 
 ISS2     LDN    1
 ISS3     STM.   JFSS 
          LDN    0           CLEAR VALIDATION BLOCK 
          STM.   VASS 
  
*         SET ECS AND CM FIELD LENGTHS. 
  
          LDD    JE          SET JOB COMMAND ECS FIELD LENGTH 
          STM.   JESS 
          LDD    JF          CHECK JOB FL 
          STM.   JCSS        SET JOB COMMAND FIELD LENGTH 
          LDC    PFNL        SET DEFAULT FAMILY NAME
          CRD    CM 
          SFA    EST,CM+3 
          ADK    EQDE 
          CRD    CM 
          LDD    CM+4 
          SHN    3
          ADN    PFGL 
          CRM.   FMSS,ON
          LDN    ZERL        CLEAR USER NAME
          CRM.   ACSS,ON
          LJM    ISSX        RETURN 
 PAC      SPACE  4,20 
**        PAC - PACK CHARACTER STRING.
* 
*         ENTRY  (CA) = ADDRESS OF START OF CHARACTER STRING. 
*                (A) = ADDRESS OF PACK BUFFER (10 CHAR).
*                (T1) = ASTERISK, IF ASTERISK TO BE ALLOWED IN STRING.
* 
*         EXIT   (CA) =  ADDRESS OF NEXT CHARACTER IN STRING BUFFER.
*                (A) = 0, IF TOO MANY CHARACTERS. 
*                (A) = 1. IF SEPARATOR ENCOUNTERED. 
*                (A) .LT. 0, IF TERMINATOR ENCOUNTERED. 
*                (T3) = 10 - NUMBER OF CHARACTERS.
* 
*         USES   CA, T2, T3.
* 
*         CALLS  GNC. 
  
  
 PAC5     LDN    1           SET NO ERROR 
  
 PAC      SUBR               ENTRY/EXIT 
          STD    T2 
          LDN    10          SET NUMBER OF CHARACTERS TO ASSEMBLE 
          STD    T3 
          SOD    CA 
 PAC1     RJM    GNC         GET NEXT CHARACTER 
          MJN    PACX        IF TERMINATOR
          NJN    PAC2        IF NOT SEPARATOR 
          LDD    T1 
          ZJN    PAC5        IF ASTERISK NOT ALLOWED
          LMI    CA 
          NJN    PAC5        IF SEPARATOR OTHER THAN ASTERISK 
 PAC2     SOD    T3 
          ZJN    PACX        IF TOO MANY CHARACTERS 
          LPN    1
          ZJN    PAC3        IF LOWER CHARACTER 
          LDI    CA          SET UPPER CHARACTER
          SHN    6
          STI    T2 
          UJN    PAC1        PACK NEXT CHARACTER
  
 PAC3     LDI    T2          SET LOWER CHARACTER
          SCN    77 
          ADI    CA 
          STI    T2 
          AOD    T2 
          UJN    PAC1        PACK NEXT CHARACTER
 UCS      SPACE  4,15 
**        UCS - UNPACK COMMAND TO STRING BUFFER.
* 
*         ENTRY  (CB) = FWA OF PACKED COMMAND.
* 
*         EXIT   (A) = 0, IF ERROR ENCOUNTERED. 
*                (CB) = FWA OF NEXT COMMAND IN BUFFER.
*                (CA) = FWA OF UNPACKED COMMAND.
*                (FWPC) = FWA OF PACKED COMMAND.
*                (LWUC) = LWA+1 OF UNPACKED COMMAND.
* 
*         USES   CA, T1 - T5, CB. 
  
  
 UCS7     AOD    CB 
          LDI    CB 
          ZJN    UCS7        IF NOT FWA OF NEXT COMMAND 
 UCS8     LDC.   CHAR 
          STD    CA 
          ADN    1           SAVE LWA+1 OF UNPACKED COMMAND 
          RAD    T3 
          STM    LWUC 
          LDN    0           INSURE ZERO FOLLOWS LAST CHARACTER 
          STI    T3 
          LDD    T4          RETURN ERROR IF NO TERMINATOR FOUND
  
 UCS      SUBR               ENTRY/EXIT 
          LDD    CB          SAVE FWA OF PACKED COMMAND 
          STM    FWPC 
          SOD    CB          SET INDEX ADDRESSES
          LDN    0
          STD    T5 
          STD    T4          SET TERMINATOR NOT FOUND 
          STD    T3 
          STD    T2 
 UCS1     AOD    CB          GET NEXT TWO CHARACTERS
          LDD    T5 
          SBK    CHARL+1
          PJN    UCS8        IF TOO MANY CHARACTERS 
          AOD    T2 
          LDI    CB 
 UCS2     ZJN    UCS7        IF END OF COMMAND
          SHN    -6 
 UCS3     STD    T1 
          ZJN    UCS5        IF ZERO CHARACTER
          LDD    T5          RESET *LAST NONZERO CHARACTER* ADDRESS 
          STD    T3 
          LDD    T1 
          LMN    1R.
          ZJN    UCS4        IF TERMINATOR
          LMN    1R)&1R.
          NJN    UCS5        IF NOT TERMINATOR
  
 UCS4     AOD    T4          SET *TERMINATOR ENCOUNTERED* FLAG
 UCS5     LDD    T1 
          STM    CHAR,T5     SET CHARACTER
          AOD    T5 
          LDD    T2 
          LPN    1
          ZJN    UCS1        IF BOTH CHARACTERS PROCESSED 
 UCS6     AOD    T2 
          LDI    CB 
          LPN    77 
          UJN    UCS3        CHECK FOR TERMINATOR 
 BUFFERS  SPACE  4,10 
*         BUFFERS.
  
  
 SBUFL    EQU    12          SCRATCH BUFFER LENGTH (2 CM WORDS) 
 CHARL    EQU    150D        CHARACTER BUFFER LENGTH
  
 CHAR     BSSN   CHARL+3     CHARACTER BUFFER 
 FWPC     BSSN   1           FWA OF PACKED COMMAND
 LWUC     BSSN   1           LWA+1 OF UNPACKED COMMAND
 SBUF     BSSN   SBUFL       SCRATCH BUFFER 
 LAST     BSSN   0
 END      BSSN
  
  
          ERRNG  ZVJL-LAST   *0VJ* OVERFLOW 
          TITLE  PRESET.
 PRS      SPACE  4,20 
**        PRS - PRESET. 
* 
*         EXIT   ADDRESS RELOCATION PERFORMED.
*                (AEFA) = INSTRUCTION TO ADD EM BLOCKING FACTOR.
*                (AEFB) = SHIFT INSTRUCTION FOR EM BLOCK ROUNDING.
*                (AEFC) = MAXIMUM EM FL / 1000B.
*                (AFLA) = MAXIMUM CM FL / 100B. 
*                (ASTA) = *PSN* IF DESTINATION LID ALREADY SET. 
*                (DLAT) = DESTINATION LID ATTRIBUTES. 
*                (JE)   = DEFAULT EM FL/*UEBS*. 
*                (JF)   = DEFAULT CM FL.
*                (JTSS) = DEFAULT JOB STEP TIME LIMIT.
*                (LALL) = LOWER ACCESS LEVEL LIMIT. 
*                (ZVJP) = *0VJ* INPUT PARAMETERS. 
*                (ZVJR) = *0VJ* RETURN ADDRESS. 
*                TO *VJC*.
* 
*         CALLS  CMX, ECX, REL. 
  
  
 PRS      BSS    0           ENTRY
          RJM    REL         RELOCATE ADDRESSES 
          LDD    LA          SET PASSWORD ASSEMBLY ADDRESS
          RAM    TUCPA+1
          LDD    CN+2        SAVE *0VJ* ENTRY PARAMETERS
          STM    ZVJP 
          LPN    7           SAVE LOCAL FILE ACCESS LEVEL 
          STM    LFAL 
          LDD    CN+1        SAVE DLID ATTRIBUTES 
          STM    DLAT 
          LDN    0           PRESET JOB STEP TIME LIMIT 
          STM.   JTSS 
          LDD    HN 
          ERRNZ  DFJT-100    DFJT MUST EQUAL (HN) 
          STM.   JTSS+1 
          LCN    0           PRESET CM AND EM FIELD LENGTHS 
          ERRNZ  JPNP-7777   ERROR IF VALUE CHANGES 
          STD    JF 
          STD    JE 
          LCN    0           CALCULATE MAXIMUM CM FL
          RJM    CMX
          STM    AFLA 
          LDK    MEFL        GET USER EM SHIFT COUNT (*UESC*) 
          CRD    CM 
          LDD    CM+2 
          SHN    -11
          STD    CM+2        SAVE ONLY *UESC* 
          LDC    SHNI+77
          SBD    CM+2 
          STM    AEFB 
          LDC    SHNI+73
          ADD    CM+2 
          STM    PRSA 
          LDN    17 
 PRSA     SHN    0
*         SHN    UESC-4 
          RAM    AEFA 
          LCN    0           CALCULATE MAXIMUM EM FL
          RJM    ECX
          STM    AEFC 
          LDM    RVJ         SAVE *0VJ* RETURN ADDRESS
          STM    ZVJR 
          LDC.   UBUF        SAVE USER BLOCK BUFFER ADDRESS 
          STM    UBAD 
          LJM    VJC         VALIDATE JOB COMMAND 
          SPACE  4,10 
*         PRESET COMMON DECKS.
  
*CALL     COMPCMX 
 CMI$     EQU    1           CENTRAL MEMORY CONVERSION
 ECI$     EQU    1           ECS CONVERSION 
*CALL     COMPCVI 
*CALL     COMPECX 
          SPACE  4,10 
          HERE
          SPACE  4,10 
          OVERFLOW 5,ZVJL 
  
          END 
