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