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