Retro1.org codex

          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