IDENT CPM,CPM
PERIPH
BASE MIXED
SST
SYSCOM
*COMMENT CPM - CONTROL POINT MANAGER.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
TITLE CPM - CONTROL POINT MANAGER.
SPACE 4,10
*** CPM - CONTROL POINT MANAGER.
* G. R. MANSFIELD. 70/10/20.
* M. E. MADDEN. 73/04/24.
* R. A. JAPS. 76/12/03. (RESEQUENCED)
SPACE 4,10
*** *CPM* IS A GENERAL PP PROGRAM TO BE USED BY CPU
* PROGRAMS TO REFERENCE OR ALTER JOB CONTROL INFORMATION IN
* THE CONTROL POINT AREA.
SPACE 4,10
*** CALL.
*
*
*T 18/ *CPM*,6/ AR,12/ CODE,24/ PARAM
* AR AUTO RECALL
* CODE FUNCTION CODE
* PARAM PARAMETER FOR FUNCTION
*
* NOTE - *CPUMTR* WILL PROCESS THE FOLLOWING *CPM* FUNCTIONS-
* 16, 24, 25, 32, 33, 37, 43, 45, 50, 55, 61 - 72.
SPACE 4,10
*** DAYFILE MESSAGES.
*
*
* * CM NOT VALIDATED.* = AN ATTEMPT WAS MADE TO CHANGE THE JOB
* CM LIMIT OUTSIDE OF THE USER-S LEGAL BOUNDS.
*
*
* * CM RANGE EXIT MODE NOT DESELECTABLE.* = USER
* SELECTION/DESELECTION OF *CM RANGE* MODE ERRORS IS NOT
* POSSIBLE ON THE CYBER 176.
*
*
* * CPM - ACCESS LEVEL NOT VALID FOR JOB.*
* A USER ATTEMPTED TO CHANGE THE JOB ACCESS LEVEL TO A VALUE
* FOR WHICH THE JOB IS NOT VALIDATED.
*
*
* * CPM - ARGUMENT ERROR.*
* CAN INDICATE ONE OF THE FOLLOWING CONDITIONS -
* 1. ADDRESS OUT OF RANGE.
* 2. INCORRECT EXIT MODE SPECIFIED. (FUNCTION 2).
* 3. EVENT DESCRIPTOR SPECIFIED HAS EST ORDINAL GREATER THAN
* 777B, OR A MULTIPLIER GREATER THAN 77B. (FUNCTION 6).
* 4. USER INDEX IS OUT OF RANGE. (FUNCTION 21).
* 5. INCORRECT SUBSYSTEM SPECIFIED. (FUNCTION 26).
* 6. INCORRECT CPU SELECTION. (FUNCTION 31).
* 7. INCORRECT BYTE COUNT, INCORRECT BYTE POSITION OR INCORRECT
* BUFFER ADDRESS TO RECEIVE VERSION NAME. (FUNCTION 44).
* 8. CM REQUESTED WAS MORE THAN 377700B WORDS.
* (FUNCTIONS 23 AND 52).
* 9. USER JOB NAME, OUTPUT DISPOSITION OPTION, OR
* END OF JOB OPTION INCORRECT.
* 10. INCORRECT SUBFUNCTION SPECIFIED. (FUNCTION 107)
*
*
* * CPM - INCORRECT PACKNAME.*
* 1. AN INCORRECT PACKNAM HAS BEEN SPECIFIED.
* 2. AN INCORRECT DEVICE TYPE HAS BEEN ENTERED ON A *PACKNAM*.
*
*
* * CPM - INCORRECT REQUEST.*
* CAN INDICATE ONE OF THE FOLLOWING CONDITIONS -
* 1. INCORRECT SUBFUNCTION. (FUNCTION 3).
* AN *SSM=* JOB ATTEMPTED TO CLEAR THE SECURE
* SYSTEM MEMORY FLAG.
*
*
* * CPM - INCORRECT *SHELL* FILE.*
* 1. *SHELL* FILE NOT ON MASS STORAGE.
* 2. *SHELL* FILE NOT FOUND IN THE LOCAL FNT AND THE LOCAL
* FILE LOAD OPTION WAS SELECTED.
*
*
* * CPM - USER ACCESS NOT VALID.*
* CAN INDICATE ONE OF THE FOLLOWING CONDITIONS -
* 1. USER NOT VALIDATED FOR SPECIFIED SUBSYSTEM (FUNCTION 26).
* 2. USER NOT VALIDATED TO PROTECT EXTENDED MEMORY
* (FUNCTION 75).
* 3. USER NOT VALIDATED TO SET PAUSE BIT (FUNCTION 100).
* 4. USER DOES NOT HAVE SYSTEM ORIGIN PRIVILEGES - NO STATUS
* REQUESTED (FUNCTION 101).
* 5. THE *L* DISPLAY JSN FIELD IS NOT INTERLOCKED
* (FUNCTIONS 102 AND 103).
*
*
* * CPM - LIBRARY NOT FOUND = LNAME.*
* THE INDICATED LIBRARY *LNAME* WAS NOT FOUND IN THE
* SYSTEM DIRECTORY OR IN THE LOCAL FNT OF THE CALLER.
*
*
* * CPM - MASS STORAGE ERROR.*
* A MASS STORAGE ERROR WAS ENCOUNTERED WHEN PERFORMING I/O
* ON A DEVICE.
*
*
* * CPM - MISSING *SHELL* LOAD OPTION.*
* WHEN SETTING THE *SHELL* CONTROL FIELD IN NFL AT LEAST
* ONE LOAD OPTION FLAG MUST BE SET.
*
*
* * CPM - EPILOGUE AND SHELL CONFLICT.*
* AN EPILOGUE WAS PENDING AT THE TIME AN ATTEMPT WAS MADE TO
* ACTIVATE A *SHELL* PROGRAM WITH THE NO-ABORT OPTION SET.
*
*
* * CPM - SYSTEM ERROR.*
* 1. *CPM* WAS UNABLE TO READ THE JOB INPUT FILE.
* (FUNCTION 106 - SET JOB CHARACTERISTICS).
* 2. *CPM* ENCOUNTERED A PROBLEM (OTHER THAN A READ) WITH THE
* SYSTEM SECTOR.
*
*
* * EC NOT VALIDATED.* = AN ATTEMPT WAS MADE TO CHANGE THE JOB
* EC LIMIT OUTSIDE OF THE USER-S LEGAL BOUNDS.
*
*
* * ERROR ON FILE - PROFILX.* = ONE OF THE FOLLOWING OCCURRED-
* 1) BAD PROFILE FILE LEVEL-3 BLOCK RANDOM ADDRESS.
* 2) PROFILE FILE NOT FOUND.
* (THIS MESSAGE ALSO ISSUED TO ERROR LOG).
*
*
* * INCORRECT APPLICATION ACCOUNTING REQUEST.*
* CAN INDICATE ONE OF THE FOLLOWING CONDITIONS, ALL
* ARE FROM FUNCTION 77 -
* 1. NOT CALLED FROM VALID PROGRAM.
* 2. INCORRECT PARAMETER WORD.
*
*
* * INCORRECT USER COMMAND.*
* AN ATTEMPT WAS MADE TO ENTER A SECONDARY USER COMMAND
* TO A DIFFERENT FAMILY WHEN SUCH COMMANDS WERE DISABLED,
* OR AN INCORRECT OR EXPIRED PASSWORD WAS ENTERED.
*
*
* * INCORRECT END OF JOB OPTION SPECIFIED.*
* A BATCH JOB ENTERED A *SETJOB,OP=SU.*. OP=SU
* IS INCORRECT FOR NON-INTERACTIVE JOBS. THIS IS A
* NON-FATAL ERROR. NO CHANGES ARE MADE TO ANY
* ARGUMENTS (UJN, DC, OP).
*
*
* * MFL REQUEST TOO SMALL, MINIMUM USED.*
* AN ATTEMPT WAS MADE TO *SETMFL* TO A FIELD LENGTH SMALLER
* THAN *CTFL*, THE FIELD LENGTH OF *CONTROL*. *CTFL* WAS USED
* INSTEAD.
*
*
* * RFL BEYOND MFL.* = RFL REQUEST EXCEEDS MFL.
*
*
* * STACK PURGING NOT DESELECTABLE.*
* STACK PURGING IS SELECTABLE/DESELECTABLE ONLY ON CYBER
* 170-8X5 MAINFRAMES.
*
*
* * TL NOT VALIDATED.* = AN ATTEMPT WAS MADE TO CHANGE THE JOB
* TIME LIMIT OUTSIDE OF THE USER-S LEGAL BOUNDS.
*
*
* * USER SECURITY COUNT EXHAUSTED.*
* THE USER HAS EXCEEDED THE SECURITY COUNT. THE USER MUST
* CONTACT SITE PERSONNEL TO HAVE THE SECURITY COUNT RESET.
* THE USER WILL NOT BE ALLOWED ACCESS TO THE SYSTEM UNTIL
* THE SECURITY COUNT IS RESET.
SPACE 4,10
*** ACCOUNT FILE MESSAGES -
*
*
* *UDOD, 000000.000KUNS.* = OPTICAL DISK ACTIVITY (KILO-UNITS).
*
* *UDAC, 000000.000UNTS.* = APPLICATION UNIT CHARGE (UNITS).
*
* *UDMP, 000000.000KUNS.* = MAP III ACTIVITY (KILO-UNITS).
*
* *UDCO, 000000.000KCHS.* = TERMINAL CHARACTERS OUTPUT.
*
* *UDCI, 000000.000KCHS.* = TERMINAL CHARACTERS INPUT.
*
* *UDCT, 000000.000KCHS.* = TOTAL TERMINAL CHARACTERS.
*
* *UDAD, 000000.000KUNS.* = APPLICATION UNITS (KILO-UNITS).
*
* *UDPF, 000000.000KUNS.* = PERMANENT FILE ACTIVITY(KILO-UNITS)
*
* *UDMT, 000000.000KUNS.* = MAGNETIC TAPE ACTIVITY (KILO-UNITS).
*
* *UDMS, 000000.000KUNS.* = MASS STORAGE ACTIVITY (KILO-UNITS).
*
* *UDCP, 000000.000SECS.* = ACCUMULATED CP TIME (SECONDS).
*
* *ACSR, 000000.000UNTS.* = ACCUMULATED SRUS (UNITS).
*
* NOTE - THE PRECEDING MESSAGES ARE ISSUED IN THE ABOVE ORDER.
*
*
* *ABCN, CHARGENUMBER, PROJECTNUMBER.* = BEGINNING OF A
* CHARGE SEQUENCE.
*
* *ACCN, CHARGENUMBER, PROJECTNUMBER.* = CHANGE OF CHARGE.
*
* *ACSC, SC, NEWJSN, SRUUNITS.* = SERVICE CLASS CHANGE.
* NEWJSN IS PRESENT IF CHANGING FROM SUBSYSTEM SERVICE CLASS.
*
* *APPN, PACKNAM.* = DEFAULT PACK NAME ENTERED.
*
* *APPN.* = DEFAULT PACK NAME CLEARED.
*
* *AUSR, 000000.000UNTS.* = ACCUMULATED SRU-S (UNITS) NOT
* UPDATED INTO PROJECT PROFILE FILE.
*
* *MJJI, OLDLEVEL, NEWLEVEL.* = DENOTES AN INCORRECT ATTEMPT
* BY THE USER TO CHANGE THE JOB ACCESS LEVEL FROM LEVEL
* *OLDLEVEL* TO LEVEL *NEWLEVEL*.
*
* *SIUN, USERNUM.* = AN ATTEMPT WAS MADE TO ENTER A
* SECONDARY USER COMMAND WHEN DISALLOWED, OR THE
* ACCOUNT/PASSWORD WAS INCORRECT.
*
* *UBAU, XXXX.* = BEGIN APPLICATION ACCOUNTING FOR
* APPLICATION XXXX.
SPACE 4,10
*** ERROR LOG MESSAGES.
*
* *MAINTENANCE ACCESS BY UN = XXXXXXX.* = A USER HAS LOGGED IN
* WITH MAINTENANCE PRIVILEGES.
SPACE 4,10
*** OPERATOR MESSAGES.
*
*
* +REQUEST *K* DISPLAY.+ = B-DISPLAY MESSAGE INDICATING
* THAT CONTROL POINT IS REQUESTING OPERATOR TO ASSIGN THE
* K-DISPLAY TO THE CONTROL POINT.
SPACE 4,10
** ROUTINES CALLED.
*
*
* 0AU - ACCOUNTING UPDATE.
* 0AV - ACCOUNT VALIDATION.
SPACE 4,10
** COMMON DECKS.
*CALL COMPMAC
*CALL COMSACC
QUAL BIO
*CALL COMSBIO
QUAL *
*CALL COMSCPS
*CALL COMSEJT
QUAL EVENT
*CALL COMSEVT
QUAL *
*CALL COMSJCE
*CALL COMSMLS
*CALL COMSMSC
*CALL COMSMSP
*CALL COMSLFD
*CALL COMSPIM
*CALL COMSPRD
*CALL COMSPRO
*CALL COMSREM
*CALL COMSSSE
*CALL COMSSSJ
*CALL COMSVER
*CALL COMSZOL
SPACE 4,10
**** DIRECT LOCATION ASSIGNMENTS.
PA EQU T1 POT ADDRESS
T8 EQU 16 SCRATCH
T9 EQU 17 SCRATCH
CN EQU 20 - 24 CM WORD BUFFER (5 LOCATIONS)
OT EQU 25 JOB ORIGIN TYPE
SM EQU 26 SYSTEM SECURITY MODE
FN EQU 30 - 34 FAMILY NAME (5 LOCATIONS)
PP EQU FN+3 POT POINTER
TN EQU FN+4 TERMINAL NUMBER
TT EQU 35 TERMINAL TABLE ADDRESS (FOR STA)
TA EQU 36 IAF RA (FOR STA)
UN EQU 40 - 44 USER NAME (5 LOCATIONS)
EP EQU 57 ENTRY POINTS
BA EQU 60 - 64 SCRATCH
RC EQU 65 RECALL COUNT
FA EQU RC LOCAL FNT POINTER
RI EQU 66 - 67 PROFILE FILE RANDOM ADDRESS
** ASSEMBLY CONSTANTS.
MRCL EQU 5 MAXIMUM RECALL COUNT (MUST BE .LT. 100B)
****
TITLE MACRO DEFINITIONS.
ABORT SPACE 4,10
** ABORT - ERROR PROCESSING MACRO.
*
* ABORT PARAM
*
* ENTRY PARAM = 6/DFOP, 12/ADDR.
* DFOP = 0 FOR MESSAGE TO USER AND SYSTEM
* DAYFILE.
* = *ERLN* FOR MESSAGE TO ERROR LOG,
* USER, AND SYSTEM DAYFILE.
* ADDR = DAYFILE MESSAGE ADDRESS.
PURGMAC ABORT
ABORT MACRO A
MACREF ABORT
LDC A
LJM ERR
ENDM
ENTRY SPACE 4,10
** ENTRY - DEFINE OVERLAY ENTRY POINT.
*
*
* ENTRY NAME
* ENTRY *NAME* = NAME OF ENTRY ADDRESS.
PURGMAC ENTRY
MACRO ENTRY,NAME
MACREF ENTRY
IF -MIC,.M
NAME EQU *
ELSE
QUAL
NAME EQU *+1R".M"*10000
QUAL ".O"
ENDIF
ENDM
FCN SPACE 4,10
** FCN - DEFINE FUNCTION PROCESSOR.
*
*
* CODE FCN NAME,(JOB CODES),SSJ
* ENTRY *CODE* = OPTIONAL FUNCTION CODE SYMBOL TO BE DEFINED.
* *NAME* = NAME OF FUNCTION PROCESSOR.
* *JOB CODES* IF USED, FUNCTION IS ALLOWED BY ONLY
* THOSE JOB TYPES.
* *SSJ* IF USED, FUNCTION IS ALLOWED BY ONLY THOSE
* JOBS WITH *SSJ=* ENTRY POINTS OR
* SUBSYSTEM ID-S.
.3 SET 0
MACRO FCN,F,A,B,C
LOC .3/3
F CON A/10000B,A-A/10000B*10000B
.1 SET 0
IFC NE,$B$$,1
.1 BITSET (B)
IFC NE,$C$$,1
.1 SET .1+4000
CON .1
.3 SET .3+3
ENDM
OVERLAY SPACE 4,10
** OVERLAY - GENERATE OVERLAY CONSTANTS.
*
*
* OVERLAY (TEXT)
* ENTRY *TEXT* = TEXT OF SUBTITLE.
.N SET 0
OVLB MICRO 1,, 3C BASE OVERLAY NAME
PURGMAC OVERLAY
OVERLAY MACRO TEXT
QUAL
.N SET .N+1
.M MICRO .N,1, ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
.O MICRO 1,3, "OVLB"".M"
QUAL ".O"
TTL CPM/".O" - TEXT
TITLE
IDENT ".O",OVL TEXT
*COMMENT CPM - TEXT
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
ORG OVL
LJM *
UJN *-2
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
.SCL RMT
INDEX NM,2R_MN TX
.SCL RMT
.A IFC NE,$NM$SSSC$
.SCLVSP RMT
INDEX NM,MN_MK TX
.SCLVSP RMT
.A ENDIF
SCLASS ENDM
SUBSYST SPACE 4,10
** SUBSYST - GENERATE SUBSYSTEM TABLE.
*
* SUBSYST NAME,ID,PR,PP,AUTO,DEF,DCP,CP,PROC,ABT,CPU
PURGMAC SUBSYST
SUBSYST MACRO NM,ID,PT,PP,AU,DF,DC,CP,PR,AB,CPU
LOCAL C
.SUB RMT
C SET 0
IFC NE,$CPU$$,1
C SET 1
INDEX (ID-LSSI),(C)
.SUB RMT
SUBSYST ENDM
SPACE 4,10
* COMMON DECKS.
SCL$ EQU 0 ONLY PROCESS CLASSES WITH JCB-S
*CALL COMSSCD
SUB$ EQU 1 ASSEMBLE *SUBSYST* MACRO CALLS
*CALL COMSSSD
TITLE MAIN PROGRAM.
CPM SPACE 4,10
** CPM - MAIN PROGRAM.
ORG PPFW
CPM RJM PRS PRESET CONTROL POINT MANAGER
LDC 0
CPMA EQU *-1 (OVERLAY NAME)
ZJN CPM1 IF NO OVERLAY NAME
LMC 2L"OVLB" LOAD OVERLAY
RJM EXR
CPM1 LDN 0 CLEAR ADDRESS WORD COUNT
STD T1
LJM *
CPMB EQU *-1 (ENTRY ADDRESS FOR FUNCTION)
CPMX MONITOR DPPM DROP PP
LJM PPR EXIT TO PP RESIDENT
SPACE 4,10
** PROGRAMMING NOTE.
*
* (T1) = 0, ON ENTRY TO ALL FUNCTION PROCESSORS TO ASSURE
* THE ROUTINE *CKA* WILL CHECK THE PROPER CM ADDRESSES.
TITLE ERROR PROCESSOR.
ERR SPACE 4,10
** ERR - ERROR PROCESSOR.
*
* ENTRY (A) = 6/ DFOP, 12/ ADDR
*
* DFOP = DAYFILE OPTION.
* = 0 FOR MESSAGE TO USER AND SYSTEM DAYFILE.
* = *ERLN* FOR MESSAGE TO ERROR LOG, USER, AND
* SYSTEM DAYFILES.
*
* ADDR = ADDRESS OF MESSAGE.
*
* (ERRA) = RESOURCE TYPE FOR *ERNV* MESSAGE.
*
* EXIT ERROR PROCESSOR OVERLAY EXECUTED.
* (CN) = ERROR MESSAGE ADDRESS.
*
* USES CN.
ERR BSS 0 ENTRY
STD CN SET ERROR MESSAGE ADDRESS
SHN -14 SET DAYFILE OPTION
STD CN+1
LDC 0 SET RESOURCE TYPE
ERRA EQU *-1 (RESOURCE TYPE)
STD CN+2
EXECUTE 3CA
LJM /3CA/ERR PROCESS ERROR
TITLE RESIDENT ROUTINES.
CFN SPACE 4,10
** CFN - COMPARE NAMES.
*
* ENTRY (FN - FN+4) = REQUESTED NAME.
* (CN - CN+4) = LEGAL NAME.
*
* EXIT (A) = 0 IF MATCH.
CFN SUBR ENTRY/EXIT
LDD FN
LMD CN
NJN CFNX IF NO MATCH
LDD FN+1
LMD CN+1
NJN CFNX IF NO MATCH
LDD FN+2
LMD CN+2
NJN CFNX IF NO MATCH
LDD FN+3
LMD CN+3
SCN 77
UJN CFNX RETURN
CJR SPACE 4,20
** CJR - CHECK IF THE JOB IS ROLLABLE.
*
* AN I/O ERROR WAS ENCOUNTERED ON A MASS STORAGE DEVICE. THE
* JOB IS ROLLABLE IS IT IS NOT A SUBSYSTEM, THE I/O ERROR IS
* RECOVERABLE, AND THERE IS NOT AN ERROR FLAG IN THE CONTROL
* POINT AREA.
*
* ENTRY (T5) = EST ORDINAL.
* (RDCT) = RECOVERABLE ERROR STATUS (BIT 2**10 CLEAR IF
* RECOVERABLE ERROR).
*
* EXIT TO *1RJ* IF THE JOB IS ROLLABLE.
* TO *CPMX* IF ERROR FLAG SET.
* OTHERWISE, TO CALLER.
*
* USES IR+4, CM - CM+4.
*
* MACROS EXECUTE, PAUSE.
CJR SUBR ENTRY/EXIT
LDD CP CHECK IF SUBSYSTEM CALLER
ADK JCIW
CRD CM
LDD CM+2
SBK LSSI+1
PJN CJRX IF SUBSYSTEM
LDM RDCT
SHN 21-12
MJN CJRX IF ERROR NOT RECOVERABLE
PAUSE
LDD CM+1
NJP CPMX IF ERROR FLAG SET
LDD T5 SET EST ORDINAL
STD IR+4
EXECUTE 1RJ RECALL JOB
CKA SPACE 4,10
** CKA - CHECK ADDRESS.
*
* ENTRY (IR+3 - IR+4) = ADDRESS.
* (T1) = WORD COUNT MINUS ONE.
*
* EXIT (A) = ABSOLUTE ADDRESS.
CKA2 LDD IR+3 LOAD ABSOLUTE ADDRESS
SHN 6
ADD RA
SHN 6
ADD IR+4
CKA SUBR ENTRY/EXIT
LDD IR+3
SCN 37
NJN CKA1 IF OUT OF RANGE
LDD IR+3
SHN 14
LMD IR+4
ADD T1
SHN -6
SBD FL
MJN CKA2 IF < FL - WORD COUNT
CKA1 ABORT ERAE * CPM - ARGUMENT ERROR.*
RCL SPACE 4,10
** RCL - RECALL *CPM*.
*
* ENTRY (IR - IR+4) = *CPM* REQUEST.
*
* USES CM - CM+4.
*
* MACROS MONITOR.
RCL BSS 0
LDN ZERL RECALL REQUEST
CRD CM
LDD MA
CWM IR,ON
CWD CM
MONITOR RECM
LJM PPR EXIT
UFC SPACE 4,10
** UFC - UPDATE FAMILY ACTIVITY COUNTS.
*
* ENTRY (CN+3) = CURRENT FAMILY EST ORDINAL.
* (T2) = NEW FAMILY EST ORDINAL.
*
* EXIT CURRENT FAMILY ACTIVITY COUNT DECREMENTED.
* NEW FAMILY ACTIVITY COUNT INCREMENTED.
* *PUCN* CLEARED IF FAMILY CHANGED.
*
* USES CM - CM+4.
UFC SUBR ENTRY/EXIT
LDD CN+3 CHECK OLD = NEW
LMD T2
ZJN UFCX IF OLD = NEW
LDD CN+3 DECREMENT OLD FAMILY ACTIVITY COUNT
STD CM+1
LMN NEEQ CHECK FOR NULL FAMILY
ZJN UFC1 IF NULL FAMILY
LDN DFCS
STD CM+3
MONITOR SMDM
UFC1 LDD T2 INCREMENT NEW FAMILY ACTIVITY COUNT
STD CM+1
LDN IFCS
STD CM+3
MONITOR SMDM
LDN ZERL CLEAR *PUCN*
CRD CM
NFA PUCN
CWD CM
UJN UFCX RETURN
SPACE 4,10
** COMMON DECKS NOT TO BE OVERLAID.
TLI$ SET 1 SELECT TIME LIMIT INDEX CONVERSION
CLI$ SET 1 SELECT CONVERSION FROM INDEX TO COUNT
SLI$ SET 1 SELECT SRU LIMIT CONVERSION
*CALL COMPCVI
EJT$ EQU 1 DEFINE EJT PROCESSOR
FNT$ EQU 1 DEFINE SYSTEM FNT PROCESSOR
IFP$ EQU 1 DEFINE REMOTE INITIALIZATION CODE
JCB$ EQU 1 DEFINE JCB PROCESSOR
*CALL COMPGFP
*CALL COMPRJC
*CALL COMPRSS
*CALL COMPVFN
SPACE 4,10
** OVERLAY DEFINITIONS.
OVL EQU *+5 OVERLAY LOAD ADDRESS
L0AV EQU BFMS-ZAVL LOAD ADDRESS FOR *0AV*
TITLE FUNCTION PROCESSORS.
SPR SPACE 4,10
*** FUNCTION 1.
* SET CPU PRIORITY = PARAMETER.
*
* ENTRY (IR+4) = REQUESTED CPU PRIORITY IF .NE. 0.
* (IR+4) = 0 TO SET CPU PRIORITY TO SERVICE CLASS VALUE.
SPR ENTRY
LDD OT CHECK ORIGIN TYPE
LMK SYOT
ZJN SPR1 IF SYSTEM ORIGIN JOB
LDD EP CHECK FOR SSJ= JOB
SHN 21-2
PJN SPR4 IF NOT SSJ=
SPR1 LDD IR+4
ZJN SPR3 IF SET PRIORITY TO SERVICE CLASS VALUE
SBK LJCS
PJN SPR1.1 IF REQUESTED PRIORITY NOT TOO LOW
LDN LJCS SET LOWEST JOB PRIORITY
UJN SPR3 SET PRIORITY
SPR1.1 SBK LSCS-LJCS
MJN SPR2 IF REQUESTED PRIORITY NOT TOO HIGH
LDN LSCS-1 SET HIGHEST USER JOB PRIORITY
UJN SPR3 SET PRIORITY
SPR2 LDD IR+4 SET PRIORITY
SPR3 STD CM+4
LDN CPRS SELECT CPU PRIORITY
STD CM+1
MONITOR SJCM
SPR4 LJM CPMX RETURN
SEM SPACE 4,20
*** FUNCTION 2.
* SET EXIT MODE.
*
* ENTRY (IR+3) = 12/ MASK.
* (IR+4) = 12/ MODE.
* WHERE - MASK DEFINES BIT POSITIONS TO BE CHANGED
* IN WORD 3 OF THE EXCHANGE PACKAGE.
* - MODE DEFINES THE NEW VALUES.
*
* EXIT EXIT MODE CHANGED.
*
* USES CM - CM+4.
*
* CALLS DFM.
*
* MACROS ABORT.
SEM ENTRY
LDK MABL CHECK MAINFRAME TYPE
CRD CM
LDD CM+1
SHN -11
LMN 7
ZJN SEM1 IF CYBER 176 MAINFRAME
LDD IR+3 CLEAR UNDERFLOW MASK
SCN 10
UJN SEM3 PROCESS NON C176
SEM1 LDD IR+3
LPN 1
ZJN SEM2 IF CM RANGE MASK NOT SET
LDD IR+4
LPN 1
NJN SEM2 IF CM RANGE NOT DESELECTED
LDC =C* CM RANGE EXIT MODE NOT DESELECTABLE.*
RJM DFM
SEM2 LDD IR+4 REPOSITION UNDERFLOW BIT
LPN 10
SHN -3
STD T1
LDD IR+4
SCN 11
LMD T1
STD IR+4
LDD IR+3 REPOSITION UNDERFLOW MASK BIT
LPN 10
SHN -3
STD T1
LDD IR+3
SCN 11
LMD T1
SEM3 STD IR+3
LPN 20
ZJN SEM5 IF NOT CHANGING THE PURGING BIT
LDK MABL
CRD CM
LDD CM+1
SHN 21-13
PJN SEM5 IF CYBER 170-8X5 MAINFRAME
LDC =C* STACK PURGING NOT DESELECTABLE.*
RJM DFM PROCESS DAYFILE MESSAGE
LDD IR+3 CLEAR STACK PURGING MASK
SCN 20
UJN SEM6 PROCESS EXIT MODE BITS
SEM4 ABORT ERAE * CPM - ARGUMENT ERROR.*
SEM5 LDD IR+3 MASK OF BITS TO BE CHANGED
NJN SEM6 IF EXIT MODE MASK SPECIFIED
LDN 7 DEFAULT MASK
SEM6 LPN 27
RAM SEMB
LPN 27 RETRIEVE MASK
RAM SEMA
LDD IR+3 ORIGINAL MASK
LPC 750
NJN SEM4 IF NOT CHANGING LEGAL EXIT MODE BITS
LDD CP GET CURRENT EXIT MODE
ADN 3 READ MODE
CRD CM
LDD CM CURRENT MODE
SEMA SCN 0 CLEAR THOSE BITS CHANGING
STD CM
LDD IR+4 NEW VALUE FOR THOSE BITS CHANGING
SEMB LPN 0 EXTRACT THOSE BITS CHANGING
ADD CM FORM NEW EXIT MODE
LPC 0777 CLEAR HARDWARE MODE BITS
LMC 7000 FORCE HARDWARE MODE BITS ON
STD CM
LDN 0 CLEAR UNPROCESSED *PSD* ERRORS
STD CM+1
LDD CP
ADN 3
CWD CM WRITE NEW EXIT MODE
LJM CPMX EXIT
SDA SPACE 4,20
*** FUNCTION 5.
* SET *K* DISPLAY CONTROLS.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF PARAMETER WORD IF TO
* ACTIVATE *K* DISPLAY.
* = 0 IF TO DEACTIVATE *K* DISPLAY.
*
*T,ADDR 1/0,1/U,1/0,1/S,2/0,18/ KB,18/ RS,18/ LS
*
* U = 1, IF UPDATE OF STATUS WORD IS NOT REQUIRED
* S = 1, IF K-DISPLAY INPUT TO BE SUPPRESSED FROM DAYFILE
* KB KEYBOARD BUFFER ADDRESS
* RS RIGHT SCREEN BUFFER ADDRESS
* LS LEFT SCREEN BUFFER ADDRESS
*
* EXIT *K* DISPLAY CONTROLS UPDATED.
SDA ENTRY
LDD IR+3 CHECK PARAMETER
LPN 37
SHN 14
LMD IR+4
NJN SDA1 IF AN ADDRESS WAS SPECIFIED
LDK ZERL
LJM SDA6 CLEAR DISPLAY REGISTER (DBAW)
SDA1 LDK PPCP CHECK IF K-DISPLAY IS ACTIVE
CRD CN
LDD CN+4
ADN 10
CRD CN READ *DSD*-S INPUT REGISTER
LDD CN+2
SHN -6
LMN 1RK
ZJN SDA2 IF K-DISPLAY IS UP ON THE LEFT SCREEN
LDD CN+2
LPN 77
LMN 1RK
NJN SDA3 IF K-DISPLAY IS NOT UP
LDN 1
SDA2 STD T2 GET EJTO FROM *DSD*-S INPUT REGISTER
LDM CN+3,T2
ZJN SDA3 IF DISPLAY IS NOT ASSIGNED TO A JOB
STD T2
LDD CP READ THE CALLER-S EJTO
ADK TFSW
CRD CN
LDD CN
LMD T2
ZJN SDA5 IF K-DISPLAY IS ASSIGNED TO THIS JOB
SDA3 LDD OT CHECK ORIGIN TYPE
LMK SYOT
NJN SDA4 IF NOT SYSTEM ORIGIN
LDC SDAB FLASH *REQUEST *K* DISPLAY.* MESSAGE
STM SDAC
SDA4 LDD CP CONSOLE MESSAGE = * REQUEST *K* DISPLAY.*
ADN MS2W
CWM SDAA,TR
SDAC EQU *-1
SDA5 RJM CKA CHECK ADDRESS
SDA6 CRD CN READ DISPLAY REGISTER
LDD CP STORE DISPLAY REGISTER
ADC DBAW
STD T1
CRD CM PRESERVE SSM STATUS
LDD CN
LMD CM
LPC 2477
LMD CM
STD CN
LDD T1 UPDATE DBAW
CWD CN
LJM CPMX EXIT
SDAA DATA C+REQUEST *K* DISPLAY.+
SDAB DATA C+$REQUEST *K* DISPLAY.+
ROC SPACE 4,20
*** FUNCTION 6.
* ROLLOUT JOB.
* IF PARAMETER .NE 0 PERFORM TIMED/EVENT ROLLOUT WITH
* (RA + PARAMETER) OF FOLLOWING FORMAT -
*
*T 27/ 0,21/ EVENT DESCRIPTOR,12/ TIME
*
* EVENT DESCRIPTOR FORMAT -
*
* 9/ *EQ* DESCRIPTOR.
* 12/ *EVD* (EVENT CODE) DESCRIPTOR.
*
* IF THE USER ENTERS AN EVENT DESCRIPTOR, THE EVENT TIME
* MUST ALSO BE ENTERED OR A SYSTEM DEFAULT WILL BE USED.
*
* ERROR TO *ERR*.
*
* CALLS CKA.
*
* MACROS MONITOR.
ROC ENTRY
LDD IR+3 CHECK IF USER PARAMETERS SPECIFIED
LPN 77
ADD IR+4
ZJN ROC1 IF NO USER PARAMETERS SPECIFIED
* CHECK USER ROLLOUT PARAMETER WORD.
RJM CKA SET PARAMETER WORD ADDRESS
CRD CM READ PARAMETER WORD
LDD CP READ TIMED/EVENT CONTROL WORD *TERW*
ADK TERW
CRD CN
LDD CM+2 CHECK USER *EQ* DESCRIPTOR
LPC 777
NJN ROC4 IF NON-SYSTEM EVENT
LDD CM+3 CHECK *EVD* DESCRIPTOR
NJN ROC4 IF SYSTEM EVENT
LDD CM+4 CHECK IF TIME SPECIFIED
NJN ROC5 IF TIMED ROLLOUT
* PROCESS ZERO PARAMETER WORD ROLLOUT.
LDD CN+2 CHECK FOR EVENT IN *TERW*
LPN 77
ADD CN+3
ADD CN+4
ZJN ROC1 IF NO EVENT WAITING IN *TERW*
LJM ROC12 ISSUE TIMED/EVENT ROLLOUT
* ROLLOUT JOB TO JOB SCHEDULER QUEUE.
* LDK ROSR SELECT JOB SCHEDULER ROLLOUT
ERRNZ ROSR CODE DEPENDS ON VALUE
ROC1 LJM ROC13 ISSUE ROLLOUT REQUEST
* PROCESS ARGUMENT ERROR.
ROC3 LDC ERAE * CPM - ARGUMENT ERROR.*
LJM ERR PROCESS ERROR
* PROCESS EVENT ROLLOUT.
ROC4 LDD CM+2 CHECK *EQ* DESCRIPTOR
SBK /EVENT/EXTM/10000
ZJN ROC6 IF EXTENDED TIME ROLLOUT
LDN ESTP CHECK FOR INCORRECT EST ORDINAL
CRD T0
LDD CM+2
SBD T0+2
PJN ROC3 IF INCORRECT *EQ* DESCRIPTOR
ROC5 UJN ROC7 SET ROLLOUT TIME
* PROCESS EXTENDED TIME ROLLOUT.
ROC6 LDD CM+4 SAVE ADD-ON TIME
STD T0
ADD CM+3
ZJN ROC1 IF NO TIMES SPECIFIED
LDD CM+3 SET CYCLE MULTIPLIER
STD CM+4
SHN 0-6 CHECK VALUE
NJN ROC3 IF MULTIPLIER .GT. 77
LDD T0 SET ADD-ON TIME
STD CM+3
NJN ROC9 IF NONZERO
LCN 0 ADJUST ADD-ON TIME FOR *1SJ*
STD CM+3
SOD CM+4 ADJUST CYCLE MULTIPLIER FOR *1SJ*
UJN ROC10 SET TIME AND EVENT
* SELECT, VALIDATE, AND ADJUST ROLLOUT TIME VALUE.
ROC7 LDD CM+4 CHECK TIME SPECIFIED
NJN ROC8 IF NONZERO
LDD CN+2 CHECK FOR TIME IN *TERW*
SHN 21-5
SCN 77
LMD CN+3
SHN 0-11
NJN ROC11 IF TIME IN *TERW*
LDK CRT SELECT DEFAULT TIME
UJN ROC10 SET TIME AND EVENT
ROC8 SHN 0-11 VALIDATE TIME SPECIFIED
ZJN ROC9 IF .LE. 777
LDC 777 SELECT MAXIMUM ROLLOUT TIME
UJN ROC10 SET TIME AND EVENT
ROC9 LDD CM+4 SELECT TIME SPECIFIED
* UJN ROC10 SET TIME AND EVENT
* SET ROLLOUT TIME IN *TERW* IMAGE.
*
* (A) = ROLLOUT TIME.
ROC10 SHN 21-10 INSERT LOWER 3 BITS OF TIME
LMD CN+3 MERGE WITH EVENT DESCRIPTOR
LPC 777000
LMD CN+3
STD CN+3
SHN 5-21 INSERT UPPER 6 BITS OF TIME
LMD CN+2
LPN 77
LMD CN+2
STD CN+2
LDD CM+2 CHECK FOR A NEW EVENT DESCRIPTOR
ADD CM+3
ZJN ROC12 IF NO EVENT SPECIFIED
* SET ROLLOUT EVENT.
ROC11 LDD CN+3 SET *EQ* DESCRIPTOR
LPC 7000
LMD CM+2
STD CN+3
LDD CM+3 SET *EVD* DESCRIPTOR
STD CN+4
ROC12 LDD CN+2 SET UP *ROCM* PARAMETERS
LPN 77
SHN 14
LMD CN+3
SHN -11
STD CN+2
LDD CN+3
LPC 777
STD CN+3
LDD MA WRITE *ROCM* PARAMETER WORD TO MB
CWD CN
* ROLLOUT JOB TO TIMED/EVENT QUEUE.
LDK ROTE SELECT TIMED/EVENT ROLLOUT OPTION
* ISSUE MONITOR REQUEST TO ROLLOUT JOB.
*
* (A) = ROLLOUT OPTION.
ROC13 STD CM+1 SET REQUEST OPTION
MONITOR ROCM ISSUE MONITOR REQUEST
LJM CPMX EXIT
NEX SPACE 4,10
*** FUNCTION 7.
* NOEXIT.
* SUPPRESS PROCESSING OF *EXIT* COMMAND IF JOB ABORTS.
* ONEXIT.
* RESET PROCESSING OF *EXIT* COMMAND.
NEX ENTRY
LDD CP READ ENTRY/EXIT CONTROL
ADN EECW
CRD CM
LDD CM ENSURE *NOEXIT* FLAG CLEAR
LPC 3777
STD CM
LDD IR+4 CHECK INPUT PARAMETER
ZJN NEX1 IF ONEXIT
LDC 4000 SET *NOEXIT* FLAG
NEX1 RAD CM
LDD CP STORE ENTRY/EXIT CONTROL
ADN EECW
CWD CM
LJM CPMX EXIT
SSM SPACE 4,10
*** FUNCTION 10.
* SET/CLEAR SECURE SYSTEM MEMORY FLAG.
SSM ENTRY
LDD CP READ CP AREA WORD *DBAW*
ADC DBAW
STD T2
CRD CN
LDD IR+4 CHECK OPTION
NJN SSM1 IF SET REQUEST
STM SSMA
LDD EP
LPN 1
ZJN SSM1 IF NOT SSM=
ABORT ERIR * CPM - INCORRECT REQUEST.*
SSM1 LDD CN SET/CLEAR SECURE SYSTEM MEMORY BIT
LPC 3777
LMC 4000
* LMC 0
SSMA EQU *-1
STD CN WRITE *DBAW*
LDD T2
CWD CN
LJM CPMX EXIT
ONS SPACE 4,10
*** FUNCTION 11.
* TURN ON SENSE SWITCHES FOR BITS 0 - 5 IN PARAMETER.
ONS ENTRY
LDD IR+4 SET SWITCH BITS
SHN 6
STD T1
ONS1 LDD IR+4 FORM SWITCH MASK
LPN 77
SHN 6
LMC -0
STM ONSA
LDD CP READ SWITCH WORD
ADN SNSW
CRD CM
LDD CM+4 CLEAR/SET SENSE SWITCHES
LPC *
ONSA EQU *-1
LMD T1
STD CM+4
LDD CP STORE SWITCH WORD
ADN SNSW
CWD CM
LDD RA STORE SWITCHES IN (RA)
SHN 6
CRD CN READ (RA)
LDD CN+4 SET NEW SENSE SWITCHES
LMD CM+4
LPN 77
LMD CM+4
STD CN+4
LDD RA STORE (RA)
SHN 6
CWD CN
LJM CPMX EXIT
OFS SPACE 4,10
*** FUNCTION 12.
* TURN OFF SENSE SWITCHES FOR BITS 0 - 5 IN PARAMETER.
OFS ENTRY
LDN 0 CLEAR SWITCH BITS
STD T1
LJM ONS1
RJN SPACE 4,10
*** FUNCTION 13.
* READ JSN TO (PARAMETER).
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF PARAMETER WORD.
*
* EXIT JOB SEQUENCE NUMBER RETURNED IN FORMAT -
*T ADDR 24/ JSN, 36/ 0
RJN ENTRY
LDD CP GET JOB EJT ORDINAL
ADN TFSW
CRD CM
SFA EJT,CM GET JSN
ERRNZ JSNE CHECK IF WORD 0 IF EJT ENTRY
CRD CM
LDN ZERL
CRD CM+2
UJN RPR1 RETURN JSN
RPR SPACE 4,10
*** FUNCTION 15.
* READ CPU PRIORITY TO (PARAMETER).
RPR ENTRY
LDN ZERL
CRD CM
LDD CP
ADN CWQW GET CPU PRIORITY
CRD CN
LDD CN GET JOB CPU PRIORITY
SHN -3
LPC 177
STD CM+4
RPR1 RJM CKA CHECK PARAMETER ADDRESS
CWD CM STORE RESPONSE
LJM CPMX EXIT
EDI SPACE 4,10
*** FUNCTION 20.
* ENTER DEMAND FILE RANDOM INDEX.
*
* ENTRY (IR+3 - IR+4) = DEMAND FILE RANDOM INDEX.
*
* CALLER MUST HAVE SSJ= ENTRY POINT SET.
EDI ENTRY
LDD CP READ DEMAND FILE INDEX WORD
ADN RFCW
CRD CN
LDD IR+3
LMD CN+3
LPN 77
LMD CN+3
STD CN+3
LDD IR+4
STD CN+4
LDD CP UPDATE DEMAND FILE INDEX WORD
ADN RFCW
CWD CN
LJM CPMX RETURN
SLC SPACE 4,10
*** FUNCTION 22.
* SET LOADER CONTROL WORD.
SLC ENTRY
RJM CKA CHECK ADDRESS
CRD CM READ CONTROL WORD
LDD CP STORE CONTROL WORD
ADC LB1W
CWD CM
LJM CPMX EXIT
RFL SPACE 4,10
*** FUNCTION 23.
* SET LAST RFL = PARAMETER.
*
* ENTRY (IR+3, IR+4) = RFL REQUEST.
* BIT 2**11 IN IR+3 IS SET FOR EXTENDED MEMORY REQUEST
* AND ZERO FOR CM REQUEST. EXTENDED MEMORY REQUESTS
* ARE MULTIPLES OF 1000B.
RFL ENTRY
RJM PMP PROCESS ARGUMENT
STD CM+1 SET NFL
LDD CM
SBD CM+1
MJN RFL1 IF NFL .GT. MFL
LDD T7 WRITE FL CONTROL WORD
CWD CM
LJM CPMX EXIT
RFL1 ABORT ERFL * RFL BEYOND MFL.*
SSB SPACE 4,10
*** FUNCTION 26.
* SET SUBSYSTEM FLAG = PARAMETER.
SSB ENTRY
LDD IR+3 CHECK SUBSYSTEM INDEX
NJN SSB1 IF INCORRECT PARAMETER
LDD IR+4
SBN MSYS
PJN SSB1 IF INCORRECT SUBSYSTEM
ADN MSYS
RJM SSF SET SUBSYSTEM FLAG
MJN SSB2 IF NOT VALIDATED
LJM CPMX RETURN
SSB1 ABORT ERAE * CPM ARGUMENT ERROR.*
SSB2 ABORT ERIU * CPM - USER ACCESS NOT VALID.*
ROT SPACE 4,10
*** FUNCTION 27.
* READ ORIGIN TYPE TO (PARAMETER).
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF PARAMETER WORD.
*
* EXIT JOB ORIGIN TYPE (OT) RETURNED IN FORMAT -
*T ADDR 54/0, 6/OT
ROT ENTRY
ROT1 LDD CP GET JOB EJT ORDINAL
ADN TFSW
CRD CM
SFA EJT,CM SET ORIGIN TYPE
ADN SCLE
CRD CM
LDD CM
LPN 17 MASK ORIGIN TYPE
* SCN 60 USED BY FUNCTION 111
ROTA EQU *-1
STD CM+4
LDN ZERL
CRD CM-1
RJM CKA CHECK ADDRESS
CWD CM STORE ORIGIN TYPE
LJM CPMX EXIT
SCP SPACE 4,10
*** FUNCTION 31.
* SELECT CPU(S) ALLOWABLE FOR JOB TO USE.
* PARAM = 0, RUN JOB IN ANY CPU.
* PARAM = 1,RUN JOB IN CPU - 0 ONLY. (6600 CPU ON 6700)
* PARAM = 2, RUN JOB IN CPU - 1 ONLY.
* IF THE CPU SELECTED IS NOT AVAILABLE, THEN NO SELECTION
* IS PERFORMED, AND THE JOB IS ALLOWED TO CONTINUE.
*
* NOTE - ON A DUAL CPU MACHINE WITH CACHE, CERTAIN SUBSYSTEMS
* MAY ONLY RUN IN CPU 0. FOR THESE SUBSYSTEMS, THIS REQUEST
* WILL BE IGNORED.
SCP ENTRY
LDN EIBP
CRD CM
LDD CM
SHN 21-12
PJN SCP1 IF NOT A DUAL CPU MACHINE WITH CACHE
LDD CP
ADK JCIW
CRD CM
LDD CM+2
ADK -LSSI
MJN SCP1 IF NOT A SUBSYSTEM
STD T1
LDM SCPA,T1
NJN SCP2 IF JOB MUST RUN IN CPU 0, IGNORE REQUEST
SCP1 LDN CPUS SELECT CPU(S) ALLOWABLE FOR JOB EXECUTION
STD CM+1
LDD IR+4 CHECK LEGAL CPU SELECTION
STD CM+4
SBN 3
PJN SCP3 IF INCORRECT REQUEST
MONITOR SJCM
SCP2 LJM CPMX EXIT
SCP3 ABORT ERAE * CPM - ARGUMENT ERROR.*
SCPA INDEX TABLE OF SUBSYSTEMS FORCED INTO CPU 0
.SUB HERE
INDEX MXSI-LSSI
EET SPACE 4,10
*** FUNCTION 34.
* ENTER EVENT IN SYSTEM EVENT TABLE.
EET ENTRY
LDN 0
STD CM+1
LDD IR+3
STD CM+3
LDD IR+4
STD CM+4
MONITOR EATM ENTER EVENT
LDD CM+1
NJP RCL IF EVENT TABLE IS FULL
LJM CPMX RETURN
SPN SPACE 4,10
*** FUNCTION 35.
* SET PACKNAME AND PACK TYPE.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF PACKNAME PARAMETER WORD.
*
*T ADDR 42/NAME,18/TYPE
* WHERE *NAME* IS A LEFT-JUSTIFIED PACKNAME WITH ZERO FILL,
* AND *TYPE* IS A DISPLAY CODE PACK TYPE (E.G. *DI3*).
SPN ENTRY
RJM CKA CHECK ADDRESS
CRD FN READ UP PACK NAME
LDD FN+3
SCN 77
ADD FN+2
ADD FN+1
ADD FN
ZJN SPN2 IF NO PACK NAME
RJM VFN VERIFY PACK NAME
NJN SPN3 IF LEGAL PACK NAME
SPN1 ABORT ERPN * CPM - INCORRECT PACK NAME.*
SPN2 LDN ZERL CLEAR PACK TYPE
CRD FN
SPN3 LDD FN+3 VERIFY PACK TYPE
LPN 77
SHN 14
ADD FN+4
ZJN SPN4 IF PACK TYPE NOT SPECIFIED
LPN 77 CHECK NUMBER OF SPINDLES
SBN 1R0
MJN SPN1 IF LAST CHARACTER NOT NUMERIC
SBN 1R9-1R0+1
PJN SPN1 IF LAST CHARACTER NOT NUMERIC
LDD FN+4
SHN -6
ZJN SPN1 IF SECOND CHARACTER MISSING
SBN 1R0
PJN SPN1 IF SECOND CHARACTER NOT ALPHABETIC
LDD FN+3
LPN 77
ZJN SPN1 IF FIRST CHARACTER MISSING
SBN 1R0
PJN SPN1 IF FIRST CHARACTER NOT ALPHABETIC
* ENTER PACK NAME AND TYPE INTO CONTROL POINT AREA.
SPN4 LDD CP
ADC PKNW
CWD FN
* ISSUE ACCOUNT FILE MESSAGE.
LDC SPNA+2
STD T1
LDD FN
ZJN SPN5 IF PACKNAME NOT SPECIFIED
LDN 0 SET EOL ON PACKNAME
STD FN+4
LDD FN+3
SCN 77
STD FN+3
LDC =C*, * ADD COMMA TO MESSAGE
RJM ACS
LDN FN SET PACKNAME IN MESSAGE
RJM ACS
SPN5 LDC =C*.* TERMINATE MESSAGE
RJM ACS
LDC SPNA+ACFN
RJM DFM ISSUE MESSAGE TO ACCOUNT FILE
LJM CPMX EXIT
SPNA DATA C*APPN*
BSSZ 6
RPN SPACE 4,10
*** FUNCTION 36.
* RETURN PACKNAME AND PACK TYPE.
*
* ENTRY (IR+3 - IR+4) = ADDRESS TO RETURN PACKNAME TO.
*
* EXIT CURRENT CONTROL POINT VALUE RETURNED IN FORMAT -
*
*T ADDR 42/ PACK NAME,18/ PACK TYPE
RPN ENTRY
LDD CP RETURN PACKNAME AND PACK TYPE
ADC PKNW
CRD CM
RJM CKA CHECK ADDRESS
CWD CM
LJM CPMX EXIT
RVN SPACE 4,15
*** FUNCTION 44.
* RETURN VERSION NAME.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF PARAMETER WORD.
*
*T ADDR 1/ F, 11/ BC, 12/ SB, 12/ BP, 6/ 0, 18/ WADDR
*
* F = 0, TO RETURN VERSION NAME (*SVNL*) FROM SOURCE FIELD.
* = 1, TO RETURN VERSION NAME(*SVNL*) AND SYSTEM TITLE LINE
* (*SYTL*) FROM SOURCE FIELD.
*
* BC = NUMBER OF BYTES TO RETURN FROM SOURCE FIELD.
* IF F=0, 1 - 10D BYTES.
* IF F=1, 1 - 30D BYTES.
*
* SB = BYTE IN SOURCE FIELD AT WHICH TO BEGIN TRANSFER.
* IF F=0, BYTE 0 - 9D. (BC + SB .LT. 11D)
* IF F=1, BYTE 0 - 29D. (BC + SB .LT. 31D)
*
* BP = BYTE POSITION WITHIN RECEIVING FIELD (WADDR) AT
* WHICH TO BEGIN TRANSFER. (BYTE 0 - 4)
*
* WADDR = BEGINNING ADDRESS OF BLOCK TO RECEIVE DATA.
*
* EXIT IF F=0, VERSION NAME IS TRANSFERRED FROM CMR TO
* SPECIFIED ADDRESS.
* IF F=1, SYSTEM TITLE LINE AND VERSION NAME ARE BOTH
* TRANSFERRED FROM CMR TO SPECIFIED ADDRESS.
RVN ENTRY
RJM CKA READ PARAMETER WORD
CRD CM
LDN 2
STD T1 SAVE WORD COUNT
LDD CM
SHN 21-13
PJN RVN1 IF FLAG NOT SET
LDN 6
STD T1 SAVE WORD COUNT
RVN1 LDD CM+3 VALIDATE RETURN ADDRESS
LPN 77
STD CM+3
SHN 14
LMD CM+4
MJN RVN2 IF ADDRESS OUT OF RANGE
ADD T1 ADD WORD COUNT
SHN -6
SBD FL
MJN RVN3 IF .LT. FL - WORD COUNT
RVN2 ABORT ERAE * CPM - ARGUMENT ERROR.*
RVN3 LDD CM+2 VALIDATE BYTE POSITION
SBN 5
PJN RVN2 IF INCORRECT BYTE POSITION
LDD CM VALIDATE BYTE COUNT
SHN 21-13
MJN RVN4 IF FLAG SET
SHN 13-21
ZJN RVN2 IF INCORRECT BYTE COUNT
SBN 11D
PJN RVN2 IF INCORRECT BYTE COUNT
LDD CM
ADD CM+1
SBN 11D
PJN RVN2 IF INCORRECT COMBINATION
LDN SVNL
UJN RVN5 READ VERSION NAME
RVN4 SHN 13-21
LPC 3777 CLEAR FLAG
STD CM
ZJN RVN2 IF INCORRECT BYTE COUNT
SBN 31D
PJN RVN2 IF INCORRECT BYTE COUNT
LDD CM
ADD CM+1
SBN 31D
PJP RVN2 IF INCORRECT COMBINATION
LDN SYTL READ SYSTEM TITLE AND VERSION NAME
RVN5 CRM RVNA,T1
AOD T1
LDD CM+3 READ RETURN FIELD
SHN 6
ADD RA
SHN 6
ADD CM+4
CRM RVNB,T1
* MERGE VERSION NAME WITH RETURN FIELD.
RVN6 SOD CM DECREMENT BYTE COUNT
MJN RVN10 IF MERGE COMPLETE
LDM RVNA,CM+1 CHECK FOR ZERO CHARACTERS
STM RVNB,CM+2
ZJN RVN7 IF ZERO BYTE
LPN 77
NJN RVN9 IF NO ZERO CHARACTER
LDM RVNA,CM+1 BLANK FILL ZERO CHARACTERS
LMN 1R
UJN RVN8 CONTINUE
RVN7 LDC 2R BLANK FILL ZERO CHARACTERS
RVN8 STM RVNB,CM+2
RVN9 AOD CM+1 INCREMENT INDICES
AOD CM+2
UJN RVN6 CHECK NEXT BYTE
* REWRITE MERGED RETURN FIELD.
RVN10 LDD CM+3
SHN 6
ADD RA
SHN 6
ADD CM+4
CWM RVNB,T1
LJM CPMX RETURN
RAC SPACE 4,30
*** FUNCTION 51.
* RETURN JOB ACTIVITY INFORMATION.
*
* ENTRY (IR+3 - IR+4) = ADDRESS FOR RETURN OF A ONE WORD
* REPLY BLOCK.
*
* EXIT PARAMETER BLOCK RETURNED IN THE FOLLOWING FORMAT.
*
*T ADDR 12/SHORT , 1/L , 23/0 , 12/INS , 12/0
*
* SHORT SHORT TERM ACTIVITY COUNTS. INCREMENTED BY ONE
* FOR EACH OF THE FOLLOWING.
* PPU ACTIVITY, NOT INCLUDING *DIS* FLAG.
* *RECW* REQUESTS (INCLUDES PPU IN RECALL AND TAPE
* ACTIVITY).
* ROLLOUT REQUESTED.
* SCP WAIT RESPONSE INDICATORS.
* TERMINAL OUTPUT FET ADDRESS PRESENT.
* TERMINAL INPUT FET ADDRESS PRESENT.
* L LONG TERM ACTIVITY COUNTS. FIELD IS ONE IF ANY OF
* THE FOLLOWING CONDITIONS ARE MET.
* *K* OR *L* DISPLAY INTERFACE ACTIVE.
* *CFO* ENTRY ENABLED.
* SCP LONG TERM CONNECTION ESTABLISHED.
* *DIS* PACKAGE ENABLED.
* INS RESERVED FOR INSTALLATIONS.
*
* USES T1, T3 - T7, BA - BA+4, CM - CM+4,
* CN - CN+4, FN - FN+4, UN - UN+4.
*
* CALLS CKA.
RAC ENTRY
LDN ZERL PRESET REPLY WORD
CRD CN
* COMPUTE SHORT TERM ACTIVITIES.
LDD CP READ CONTROL POINT AREA WORDS
ADN STSW READ PPU AND TAPE ACTIVITY
CRD CM
ADN JCIW-STSW READ JOB CONTROL INFORMATION
CRD T3
ADN TIOW-JCIW READ TERMINAL OUTPUT FET ADDRESS
CRD UN
ADN TINW-TIOW READ TERMINAL INPUT FET ADDRESS
CRD FN
ADN SSCW-TINW READ WAIT RESPONSE INDICATORS
CRD BA
LDD T3+3 CHECK *DIS* FLAG
SHN -11 RIGHT JUSTIFY *DIS* BIT
LPN 1
STD T3
LDD CM CHECK PPU ACTIVITY
LPN 37
SBD T3 SUBTRACT OFF *DIS* ACTIVITY
SBN 1 COMPENSATE FOR THIS PPU
ZJN RAC1 IF NO PPU ACTIVITY
AOD CN INCREMENT SHORT TERM ACTIVITY COUNT
RAC1 LDD CM+4 CHECK FOR *RECW* REQUESTS
SHN -4
LPN 17
ZJN RAC2 IF NO RECALL/TAPE ACTIVITY
AOD CN INCREMENT SHORT TERM ACTIVITY COUNT
RAC2 LDD CM+2 READ ROLLOUT FLAG
LPN 1 INCREMENT SHORT TERM ACTIVITY IF SET
RAD CN
LDN 5 CHECK WAIT RESPONSE INDICATORS
STD T1
RAC3 SOD T1
MJN RAC4 IF CHECK COMPLETE
LDM BA,T1
LPN 7 CHECK WAIT RESPONSE INDICATOR
ZJN RAC3 IF NO WAIT RESPONSE SET
AOD CN INCREMENT SHORT TERM ACTIVITY COUNT
RAC4 LDD UN+3 CHECK TERMINAL OUTPUT FET ADDRESS
LPN 37
ADD UN+4
ZJN RAC5 IF NO TERMINAL OUTPUT
AOD CN INCREMENT SHORT TERM ACTIVITY COUNT
RAC5 LDD FN+3 CHECK TERMINAL INPUT FET ADDRESS
SCN 77
SHN 6
LMD FN+2
ZJN RAC6 IF NO TERMINAL INPUT
AOD CN INCREMENT SHORT TERM ACTIVITY COUNT
* COMPUTE LONG TERM ACTIVITIES.
RAC6 LDD T3 CHECK *DIS* FLAG
NJP RAC9 IF *DIS* PACKAGE ENABLED
LDD CP READ CONTROL POINT AREA WORDS
ADC DBAW READ *K* DISPLAY INTERFACE WORD
CRD CM
LDD CM CHECK FOR *K* DISPLAY ACTIVITY
LPN 77
ADD CM+1
ADD CM+2
ADD CM+3
ADD CM+4
NJN RAC8 IF *K* DISPLAY ACTIVITY
LDN 4 CHECK LONG TERM CONNECTION SET
STD T1
LDC LDSP GET FWA *L* DISPLAY BUFFER
CRD CM
LDD CM+2 GET *L* DISPLAY JOB INTERLOCK
SHN 14
ADD CM+3
CRD CM
LDD CM
ZJN RAC7 IF NO JOB ASSIGNED TO *L* DISPLAY
LDD CP GET JOB EJT ORDINAL
ADN TFSW
CRD FN
SFA EJT,FN GET JOB SEQUENCE NUMBER
ERRNZ JSNE CODE DEPENDS ON VALUE
CRD FN
LDD CM COMPARE JOB SEQUENCE NUMBERS
LMD FN
NJN RAC7 IF THIS JOB NOT ASSIGNED TO *L* DISPLAY
LDD CM+1
LMD FN+1
ZJN RAC9 IF THIS JOB IS ASSIGNED TO *L* DISPLAY
RAC7 LDM BA,T1
LPC 4210
RAC8 NJN RAC9 IF LONG TERM CONNECTION SET
SOD T1
NJN RAC7 IF CHECK NOT COMPLETE
LDD RA CHECK *CFO* ENABLED
SHN 6
* ADN 0 READ RA+0
CRD CM
LDD CM+3
SHN 21-2
PJN RAC10 IF *CFO* ENTRY NOT ENABLED
RAC9 LDC 4000 SET LONG TERM ACTIVITY INDICATION
STD CN+1
* RETURN RESPONSE TO CALLER.
RAC10 LDN 0 WORD COUNT - 1
STD T1
RJM CKA CHECK FOR VALID PARAMETER ADDRESS
CWD CN RETURN ACTIVITY INFORMATION TO CALLER
LJM CPMX EXIT
MFL SPACE 4,10
*** FUNCTION 52.
* SET MFL = PARAMETER.
*
* ENTRY (IR+3, IR+4) = RFL REQUEST.
* BIT 2**11 IN IR+3 IS SET FOR EXTENDED MEMORY REQUEST
* AND ZERO FOR CM REQUEST. EXTENDED MEMORY REQUESTS
* ARE MULTIPLES OF 1000B.
MFL ENTRY
LDC NJNI-UJNI SET ZERO CM PARAMETER CHECK
RAM PMPA
RJM PMP PROCESS ARGUMENT
NJN MFL1 IF MFL ARGUMENT NON-ZERO
LDD CM+2 SET MFL TO MAX FL
MFL1 STD CM SET MFL
LDD CM+2
SBD CM
MJN MFL4 IF MFL .GT. MAX FL
LDD IR+3
SHN 21-13
MJN MFL2 IF PROCESSING EXTENDED MEMORY MFL
LDD CM
SBN CTFL
PJN MFL2 IF MFL VALID
LDN CTFL
STD CM
AOM MFLA SET *ISSUE MESSAGE* FLAG
MFL2 LDN 0 CLEAR *RFL* VALUE
STD CM+1
LDD T7 WRITE FL CONTROL WORD
CWD CM
LDN 0
* LDN 1 (MFL .LT. *CTFL* REQUESTED)
MFLA EQU *-1
ZJN MFL3 IF NO MESSAGE TO BE ISSUED
LDC =C* MFL REQUEST TOO SMALL, MINIMUM USED.*
RJM DFM ISSUE DAYFILE MESSAGE
MFL3 LJM CPMX EXIT
MFL4 ABORT ERNV * XX NOT VALIDATED.*
CSC SPACE 4,10
*** FUNCTION 53.
* ENABLE/DISABLE SRU CALCULATION.
*
* ENTRY (IR+3 - IR+4) = 12/FLAG,12/PARAM
*
* FLAG = 0 IF DISABLE REQUESTED.
* .NE. 0 IF ENABLE REQUESTED.
*
* PARAM = UNIT CHARGE.
CSC ENTRY
LDD CP CLEAR DISABLE SRU CALCULATION
ADN MP3W
CRD CN
STD T1
LDD CN CLEAR DISABLE FLAG
LPC 3777
STD CN
LDD T1
CWD CN
LDD IR+4 CHECK INCREMENT
ZJN CSC1 IF NO INCREMENT REQUESTED
STM CSCA+4 STORE INCREMENT
LDD MA
CWM CSCA,ON
LDN 1
STD CM+1
STD CM+2
MONITOR UADM
CSC1 LDD IR+3
NJN CSC2 IF ENABLE REQUESTED
LDC 4000 SET DISABLE
RAD CN
LDD T1
CWD CN
CSC2 LJM CPMX EXIT
CSCA CON AIAD SUBFUNCTION
CON ADAW WORD TO UPDATE
CON 0D*100+20D FIELD POSITION AND WIDTH
CON 0
CON 0 INCREMENT VALUE
GPF SPACE 4,15
*** FUNCTION 57.
* GET PERMANENT FILE PARAMETERS FROM CONTROL POINT AREA.
*
* ENTRY (IR+3 - IR+4) = ADDRESS *ADDR* OF 3 WORD BLOCK FOR
* RESPONSE.
*
* EXIT CURRENT CONTROL POINT PARAMETERS RETURNED IN FORMAT -
*
*T ADDR 42/ FAMILY NAME,18/ 0
*T, 42/ PACK NAME,18/ PACK TYPE
*T, 42/ USER NAME,18/ USER INDEX
GPF ENTRY
LDD CP READ PF CONTROL WORD
ADN PFCW
CRD CM
ADN UIDW-PFCW READ USER NAME AND USER INDEX
CRD UN
ADN PKNW-UIDW READ PACKNAME AND PACK TYPE
CRD CN
* GET FAMILY NAME.
SFA EST,CM+3
ADK EQDE
CRD CM
LDD CM+4 READ FAMILY NAME
SHN 3
ADN PFGL
CRD FN
* SET UP WORDS FOR PARAMETER BLOCK.
LDN 0 CLEAR LOWER PORTION OF FAMILY NAME WORD
STD FN+4
LDD FN+3
SCN 77
STD FN+3
LDD UN+3 SET USER INDEX
SCN 40
STD UN+3
* WRITE WORDS TO PARAMETER BLOCK.
LDN 2 CHECK ADDRESS
STD T1
RJM CKA
CWD FN WRITE FAMILY NAME
ADN 1 WRITE PACKNAME AND PACK TYPE
CWD CN
ADN 1 WRITE USER NAME AND USER INDEX
CWD UN
LJM CPMX EXIT
JCI SPACE 4,30
*** FUNCTION 74.
* JOB CONTROL INFORMATION.
*
* ENTRY (IR+3 - IR+4) = 6/FN,1/0,17/ADDRESS OF PARAMETER BLOCK
* FN = 0 FOR GETJCI
* FN = 1 FOR SETJCI
*
* EXIT TWO-WORD PARAMETER BLOCK CONTAINS
*
*T, 6/EFG,18/REG,12/CCL,12/EM,6/SSW,6/0
*T, 6/EF,18/R3,18/R2,18/R1
* WHERE
* EFG = GLOBAL ERROR FLAG.
* REG = GLOBAL REGISTER.
* CCL = RESERVED FOR CCL USE.
* EM = EXIT MODE.
* SSW = SENSE SWITCHES.
* EF = LAST ERROR FLAG ENCOUNTERED.
* R3 = JOB CONTROL REGISTER 3.
* R2 = JOB CONTROL REGISTER 2.
* R1 = JOB CONTROL REGISTER 1.
*
* USES EP, IR+3, T1, BA - BA+4, CM - CM+4, CN - CN+4,
* FN - FN+4.
*
* CALLS CKA.
JCI ENTRY
LDD IR+3 SAVE SUBFUNCTION CODE
STD EP
LPN 77 CLEAR OUT SUBFUNCTION CODE
STD IR+3
LDN 2 WORD COUNT
STD T1
RJM CKA CHECK ADDRESS
CRD FN
CRD BA
ADN 1 READ SECOND WORD
CRD CN
LDD EP CHECK FOR SUBFUNCTION
SHN -6
ZJN JCI1 IF GET JOB CONTROL INFORMATION
LJM JCI2 SET JOB CONTROL INFORMATION
* GET JOB CONTROL INFORMATION TO RETURN TO USER.
JCI1 LDD CP GET JOB CONTROL INFORMATION
ADC JCDW
CRM TJCI,T1
LDD CP GET EXIT MODE FROM EXCHANGE PACKAGE
ADN 3
CRD CN
ADN SNSW-3 GET SENSE SWITCHES
CRD CM
LDD CN
STM TJCI+3
LDD CM+4
SCN 77
STM TJCI+4
* RETURN PARAMETER BLOCK TO SPECIFIED ADDRESS.
RJM CKA GET ADDRESS
CWM TJCI,T1
LJM CPMX
* RETURN JOB CONTROL INFORMATION.
JCI2 LDD CP SET SENSE SWITCHES
ADN SNSW
CRD CM
LDD CM+4
LPN 77
STD CM+4
LDD FN+4
SCN 77
RAD CM+4
LDD CP REWRITE WORD SNSW
ADN SNSW
CWD CM
ADN SEPW-SNSW GET SPECIAL ENTRY POINT WORD
CRD CM
ADN JCRW-SEPW REPLACE JOB CONTROL REGISTERS
CWD CN
SBN JCRW-JCDW GET JOB CONTROL DATA
CRD CN
LDD FN REPLACE GLOBAL ERROR FLAG
STD CN
LDD FN+1 REPLACE GLOBAL REGISTER
STD CN+1
LDD CM CHECK IF SSJ=
SHN 21-2
PJN JCI3 IF NOT *SSJ=*
LDD FN+2 SET CCL DATA
STD CN+2
JCI3 LDD CP REPLACE WORD *JCDW*
ADC JCDW
CWD CN
LJM CPMX RETURN
TJCI BSS 2*5
PRO SPACE 4,15
*** FUNCTION 75.
* *PROTECT* MACRO PROCESSOR TO SET/CLEAR JOB CONTROL FLAGS
* IN WORD *JCIW* OF THE CONTROL POINT AREA.
*
* ENTRY (IR+3 - IR+4) = 6/ , 6/OFF , 6/ , 6/ ON
* OFF = FLAGS TO CLEAR IN JOB CONTROL FIELD OF *JCIW*.
* ON = FLAGS TO SET IN JOB CONTROL FIELD OF *JCIW*.
*
* USES CM - CM+4, CN - CN+4.
*
* MACROS ABORT, MONITOR.
PRO ENTRY
LDD IR+4 CHECK FOR ECS PROTECTION REQUEST
LPN 1
ZJN PRO1 IF NOT EXTENDED MEMORY PROTECTION
LDD CP READ ACCOUNT ACCESS CONTROL WORD
ADK AACW
CRD CN
LDD CN+3 CHECK PROTECT FUNCTION VALIDATION
SHN 21-2
MJN PRO1 IF USER VALIDATED TO PROTECT ECS
ABORT ERIU * CPM - USER ACCESS NOT VALID.*
* CLEAR JOB CONTROL FLAGS IN *JCIW*.
PRO1 LDD IR+3
LPN 77
ZJN PRO2 IF NO CLEAR REQUEST
STD CM+4
LDN CCTS SELECT CLEAR JOB CONTROL FLAG(S)
STD CM+1
MONITOR SJCM
* SET JOB CONTROL FLAGS IN *JCIW*.
PRO2 LDD IR+4
LPN 77
ZJN PRO3 IF NO SET REQUEST
STD CM+4
LDN SCTS SELECT SET JOB CONTROL FLAG(S)
STD CM+1
MONITOR SJCM
PRO3 LJM CPMX DROP PP AND EXIT TO PP RESIDENT
SOV SPACE 4,10
*** FUNCTION 76.
* SET/CLEAR *OVERRIDE* REQUIRED TO DROP JOB FLAG.
* CALLER MUST HAVE SSJ= ENTRY POINT.
*
* ENTRY (IR+4) = 0, IF CLEAR *OVERRIDE* FLAG, .NE. 0, IF
* SET *0VERRIDE* FLAG.
*
* USES CN - CN+4.
SOV ENTRY
LDD CP READ *SNSW* WORD FROM CPA
ADN SNSW
CRD CN
LDD CN CLEAR *OVERRIDE* FLAG
LPC 6777
STD CN
LDD IR+4 CHECK OPTION
ZJN SOV1 IF CLEAR REQUEST
LDD TH SET *OVERRIDE* FLAG
RAD CN
SOV1 LDD CP WRITE *SNSW*
ADN SNSW
CWD CN
LJM CPMX EXIT
RNR SPACE 4,10
*** FUNCTION 107.
* SET ROLLOUT ALLOWED OR ROLLOUT INHIBITED.
*
* CALLER MUST HAVE *SSJ=* ENTRY POINT.
*
* ENTRY (IR+4) = 0 IF JOB ROLLOUT TO BE ALLOWED.
* = 1 IF JOB ROLLOUT TO BE INHIBITED.
* = 2 IF OPERATOR ROLLOUT TO BE ALLOWED.
RNR ENTRY
LDD IR+4 VALIDATE SUBFUNCTION
SBN TRNRL
MJN RNR1 IF LEGAL SUBFUNCTION
ABORT ERAE * CPM - ARGUMENT ERROR.*
RNR1 LDD CP GET SUBSYSTEM IDENTIFICATION
ADN JCIW
CRD CM
LDN TRNRL CHECK FOR CURRENT ID IN TABLE
STD T1
RNR2 SOD T1
MJN RNR3 IF END OF TABLE
LDM TRNR,T1
LMD CM+2
NJN RNR2 IF NO MATCH
LDM TRNR,IR+4 GET NEW SUBSYSTEM IDENTIFICATION
STD CM+4
LDN SSIS CHANGE SUBSYSTEM ID
STD CM+1
MONITOR SJCM
RNR3 LJM CPMX EXIT
TRNR BSS 0 TABLE OF ROLL/NO ROLL IDENTIFICATIONS
LOC 0
CON 0 ALLOW JOB ROLLOUT
CON IRSI INHIBIT JOB ROLLOUT
CON ORSI ALLOW OPERATOR ROLLOUT
LOC *O
TRNRL EQU *-TRNR TABLE LENGTH
GSI SPACE 4,10
*** FUNCTION 110.
* GET SUBSYSTEM ID.
*
* ENTRY (IR+3 - IR+4) = 7/0, 17/ ADDRESS OF PARAMETER WORD.
*
* EXIT PARAMETER WORD CONTAINS -
*T 48/0, 12/ SSID
* SSID = SUBSYSTEM ID (VALUES DEFINED IN *COMSSSD*).
GSI ENTRY
LDD CP GET SUBSYSTEM ID
ADN JCIW
CRD CM+2
LDN ZERL
CRD CM-1
LDN 1 SET WORD COUNT OF PARAMETER BLOCK
STD T1
RJM CKA GET ADDRESS OF PARAMETER WORD
CWD CM
LJM CPMX RETURN
RSO SPACE 4,15
*** FUNCTION 111.
*
* READ SERVICE CLASS AND ORIGIN TYPE TO (PARAMETER).
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF PARAMTER WORD.
*
* EXIT SERVICE CLASS (SC) AND ORIGIN TYPE (OT) RETURNED
* IN THE FORMAT -
*T ADDR 48/0, 6/SC, 6/OT
* SC JOB SERVICE CLASS.
* OT JOB ORIGIN TYPE.
RSO ENTRY
LDC SCNI+60
STM ROTA
LJM ROT1 BEGIN PROCESSING
GAL SPACE 4,20
*** FUNCTION 116.
*
* RETURN JOB ACCESS LEVEL AND ACCESS LEVEL LIMITS
* TO THE CALLING PROGRAM.
*
* ENTRY (IR+3 - IR+4) = ADDR (ADDRESS OF REPLY WORD).
*
* EXIT REPLY WORD UPDATED.
*
*T ADDR 42/ , 6/ LAL, 6/ UAL, 6/ JAL.
* LAL = JOB LOWER ACCESS LEVEL LIMIT.
* UAL = JOB ACCESS LEVEL UPPER LIMIT.
* JAL = JOB ACCESS LEVEL.
*
* USES BA - BA+4, CM - CM+4, CN - CN+4.
*
* CALLS CKA.
*
* MACROS SFA.
GAL ENTRY
LDN ZERL CLEAR REPLY WORD
CRD CM
LDD CP
ADK TERW GET EJT ORDINAL
CRD BA
ADK JSCW-TERW READ SECURITY CONTROL WORD
CRD CN
SFA EJT,BA GET JOB ACCESS LEVEL LIMITS
ADK PRFE
CRD BA
LDD BA+2 EXTRACT JOB ACCESS LEVEL UPPER LIMIT
LPN 7
SHN 6
STD CM+4
LDD BA+2 EXTRACT JOB ACCESS LEVEL LOWER LIMIT
SHN -3
LPN 7
STD CM+3
LDD CN+1 GET JOB ACCESS LEVEL
SHN -11
RAD CM+4
RJM CKA WRITE REPLY WORD
CWD CM
LJM CPMX RETURN
SAL SPACE 4,20
*** FUNCTION 117.
*
* SETS THE JOB ACCESS LEVEL TO THE VALUE REQUESTED.
*
* ENTRY (IR+3 - IR+4) = ADDR (ADDRESS OF REQUEST WORD).
*
*T ADDR 57/0, 3/AL
* AL = ACCESS LEVEL.
*
* EXIT JOB ACCESS LEVEL RESET IF VALID.
* *SVET* ERROR CODE SET IF INCORRECT AND JOB ABORTED.
*
* USES T1, CM - CM+4, CN - CN+4.
*
* CALLS ACS, CKA, DFM.
*
* MACROS ABORT, MONITOR.
SAL ENTRY
RJM CKA READ REQUEST WORD
CRD CM
LDD CM+4 GET LEVEL REQUESTED
SBN 10
MJN SAL1 IF LEVEL IN RANGE 0-7
ABORT ERAE * CPM - ARGUMENT ERROR.*
SAL1 LDD SM
NJN SAL2 IF SYSTEM IN SECURE MODE
LJM CPMX RETURN
* VALIDATE ACCESS LEVEL OF JOB.
SAL2 LDK VJAS SET SUBFUNCTION CODE
STD CM+1
MONITOR VSAM VALIDATE AND SET JOB ACCESS LEVEL
LDD CM+1
NJN SAL3 IF SECURITY VIOLATION
LJM CPMX RETURN
* SET ERROR FLAG AND ABORT.
SAL3 LDC SALA+3 SET POINTER TO END OF ERROR MESSAGE
STD T1
LDD CP READ JOB SECURITY PARAMETERS
ADC JSCW
CRD CN
LDD CN+1 GET CURRENT ACCESS LEVEL
SHN -7
LPN 34
ADC TALV FORM INDEX INTO LEVEL STRING TABLE
RJM ACS APPEND STRING TO MESSAGE
LDC =C*, * APPEND COMMA AND SPACE TO MESSAGE
RJM ACS
LDD CM+4 GET REQUESTED ACCESS LEVEL
SHN 2 FORM INDEX INTO LEVEL STRING TABLE
ADC TALV
RJM ACS APPEND STRING TO MESSAGE
LDC =C*. * APPEND PERIOD TO MESSAGE
RJM ACS
LDC SALA+ACFN ISSUE ACCOUNT FILE MESSAGE
RJM DFM
LDN SVET SET SECURITY VIOLATION ERROR FLAG
ERRPL PPET-SVET *SVET* MUST BE HIGHER PRIORITY THAN *PPET*
STD CM+1
MONITOR CEFM
ABORT ERIJ *CPM - INCORRECT JOB ACCESS LEVEL.*
SALA DATA C*MJJI, *
SALB BSSZ 9D
USV SPACE 4,20
*** FUNCTION 120.
*
* RETURNS CONTROL POINT AREA WORD *JSCW* TO THE REQUESTING
* PROGRAM. THE CALLER MUST HAVE AN SSJ= ENTRY POINT OR
* A SUBSYSTEM ID.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF REPLY WORD.
*
* EXIT (REPLY WORD) = CONTROL POINT WORD *JSCW*.
*
* USES CM - CM+4.
*
* CALLS CKA.
*
* MACROS ABORT.
USV ENTRY
LDD CP READ *JSCW*
ADC JSCW
CRD CM
RJM CKA SET ADDRESS
CWD CM WRITE REPLY WORD
LJM CPMX RETURN
IPD SPACE 4,10
*** FUNCTION 121.
*
* INCREMENT CURRENT PACKED DATE BY SPECIFIED TERM.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF PARAMETER WORD.
*T ADDR 48/0, 12/ TERM
*
* EXIT NEW PACKED DATE SET IN PARAMETER WORD.
*T ADDR 42/0, 18/ DATE
IPD ENTRY
RJM CKA
CRD CM READ PARAMETER WORD
LDN RIDS
STD CM+1
MONITOR RDCM REQUEST DATA CONVERSION
LDD MA RETURNED UPDATED DATE
CRD CN
RJM CKA
CWD CN
LJM CPMX EXIT
EPW SPACE 4,10
*** FUNCTION 122.
*
* ENCRYPT PASSWORD.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF PARAMETER WORD.
*T ADDR 60/ PASSWORD
*
* EXIT
*T ADDR 60/ ENCRYPTED PASSWORD
EPW ENTRY
RJM CKA READ PASSWORD
CRD CM
LDD MA SET *RDCM* PARAMETERS
CWD CM
LDN ZERL
CRD CM
LDN REPS
STD CM+1
MONITOR RDCM REQUEST DATA CONVERSION
LDD MA RETURN ENCRYPTED PASSWORD
CRD CM
RJM CKA
CWD CM
LJM CPMX EXIT
LOG SPACE 4,10
*** FUNCTION 132.
*
* PROCESS LOGOUT.
*
* ENTRY (IR+3 - IR+4) = PARAMETER WORD ADDRESS.
*
*T PARAM 42/ANAME, 18/
* ANAME = NEXT NAM APPLICATION NAME.
*
* EXIT LOGOUT REQUEST SENT TO *IAF* IF JOB ONLINE.
LOG ENTRY
RJM CKA READ APPLICATION NAME
CRD BA
LDD CP READ TERMINAL NUMBER
ADN TTNW
CRD CN
ADN TFSW-TTNW READ EJT ORDINAL
CRD CM
SFA EJT,CM READ CONNECTION STATUS
ADK JSNE
CRD CM
LDD CM+4
SHN -7
LPN 17
LMN OLCS
NJP CPMX IF NOT ONLINE CONNECTION STATUS
LDC VCPT*200+FLSW SET *IAF* RA
CRD FN+3
LDN ZERL
CRD CM
CRD FN
LDC VTLF SET LOGOUT REQUEST
STD FN
LDD CN+1 SET TERMINAL NUMBER
STD TN
LOG1 LDN 1 SET POTS REQUIRED COUNT
STD CM+1
MONITOR TGPM MAKE POT REQUEST
LDD CM+1
ZJP LOG5 IF *IAF* NOT ACTIVE
LMC 7777
NJN LOG3 IF POTS AVAILABLE
LDC 600 SET DELAY
STD T1
LOG2 DELAY
SOD T1
NJN LOG2 IF DELAY NOT COMPLETE
UJN LOG1 REISSUE REQUEST
LOG3 LDD CM+1 SET POT POINTER
STD PP
RJM PIR PRESET WITH IAF R-REGISTER
RJM SRR SET R-REGISTER TO IAF RA
RJM SPA SET POT ADDRESS
CWD BA
RJM RRR RESTORE R-REGISTER
LOG4 LDD MA
CWD FN
LDK ZERL
CRD CM
MONITOR TSEM ENTER *IAF* REQUEST
LDD CM+1
LOG5 ZJN LOG7 IF *IAF* NOT ACTIVE
LMC 7777
NJN LOG7 IF REQUEST ENTERED
PAUSE ST
LDC 600 SET DELAY TIME
STD T1
LOG6 DELAY
SOD T1
NJN LOG6 IF DELAY NOT COMPLETE
UJN LOG4 REISSUE REQUEST
LOG7 LJM CPMX EXIT
GLV SPACE 4,10
*** FUNCTION 133.
* GET SYSTEM PSR LEVEL.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF WORD TO RECEIVE LEVEL.
*
* EXIT SYSTEM PSR LEVEL SET IN SPECIFIED WORD
* (RIGHT JUSTIFIED, ZERO FILLED).
GLV ENTRY
LDN ZERL
CRD CM
LDC NOSLVL GET SYSTEM PSR LEVEL
STD CM+4
GLV1 RJM CKA RETURN LEVEL TO CALLER
CWD CM
LJM CPMX EXIT
SPACE 4,30
*** FUNCTION 134.
*
* RETURN REPRIEVE INFORMATION.
*
* ENTRY (IR+3 -IR+4) = PARAMETER WORD ADDRESS.
*
* EXIT THE FOLLOWING INFORMATION WILL BE RETURNED.
*
*T PARAM 5/FLAGS,19/0,12/MASK,6/0,18/ADDR
*
* FLAGS = ZERO, IF NO REPRIEVE CONDITION SET.
* = BIT 59 SET, IF *EREXIT* SET
* (*EECW* BITS 58 AND 46-36 ZERO, BITS 17-0 NONZERO).
* = BIT 58 SET, IF NORMAL REPRIEVE CONDITIONS SET
* (*EECW* BITS 58 AND 47 NOT SET, BITS 46-36 NONZERO).
* = BIT 57 SET, IF EXTENDED REPRIEVE CONDITIONS SET
* (*EECW* BIT 58 SET, BIT 57 NOT SET).
* = BIT 56 SET, IF NORMAL REPRIEVE IN PROGRESS
* (*EECW* BIT 58 NOT SET, BIT 47 SET, AND BITS 46-36
* NONZERO).
* = BIT 55 SET, IF EXTENDED REPRIEVE IN PROGRESS
* (*EECW* BITS 58 AND 57 SET).
* MASK = NORMAL REPRIEVE MASK BITS (IF NORMAL REPRIEVE
* CONDITION SET).
* = ZERO (OTHERWISE).
* ADDR = ADDRESS OF EXTENDED REPRIEVE PARAMETER BLOCK
* (IF EXTENDED REPRIEVE CONDITION SET).
* = ERROR EXIT RETURN ADDRESS (IF NORMAL REPRIEVE
* CONDITION SET OR *EREXIT* SET).
* = ZERO (OTHERWISE).
RRI ENTRY
LDD CP READ *EECW*
ADN EECW
CRD CM
LDD CM ISOLATE EXTENDED REPRIEVE FLAG
SHN 21-12
MJN RRI5 IF EXTENDED REPRIEVE SET
LDD CM+1 ISOLATE REPRIEVE MASK
SHN 21-13
MJN RRI1 IF NORMAL REPRIEVE IN PROGRESS
ZJN RRI2 IF MASK ZERO
RRI1 LJM RRI9 PROCESS NORMAL REPRIEVE CONDITION
RRI2 LDD CM+3 TEST REPRIEVE ADDRESS
LPN 37
STD CM+3 CLEAN UP REPRIEVE ADDRESS
ADD CM+4
ZJN RRI3 IF NO REPRIEVE ADDRESS
* PROCESS ERROR CONDITION SET.
LDC 4000 SET BIT 59
STD CM
UJN RRI4 RETURN INFORMATION
* PROCESS NO REPRIEVE CONDITION.
RRI3 LDN ZERL RETURN A WORD OF ZERO
CRD CM
* RETURN INFORMATION.
RRI4 RJM CKA CHECK PARAMETER ADDRESS
CWD CM WRITE WORD
LJM CPMX EXIT
* PROCESS EXTENDED REPRIEVE CONDITION SET.
RRI5 LDD CM CHECK FOR EXTENDED REPRIEVE IN PROGRESS
SHN 21-11
MJN RRI7 IF EXTENDED REPRIEVE IN PROGRESS
LDD CM+3
LPN 37
STD CM+3 CLEAN UP REPRIEVE ADDRESS
LDC 1000 SET BIT 57
STD CM
RRI6 LDN 0
STD CM+1 CLEAR CM+1 - CM+2
STD CM+2
UJN RRI4 RETURN INFORMATION
* PROCESS EXTENDED REPRIEVE IN PROGRESS.
RRI7 LDC 200 SET BIT 55
STD CM
RRI8 LDN 0
STD CM+3 CLEAR CM+3 - CM+4
STD CM+4
UJN RRI6 RETURN INFORMATION
* PROCESS NORMAL REPRIEVE CONDITION SET.
RRI9 MJN RRI10 IF NORMAL REPRIEVE IN PROGRESS
LDD CM+3
LPN 37
STD CM+3 CLEAN UP REPRIEVE ADDRESS
LDD CM+1
STD CM+2 SAVE MASK IN NEW BYTE
LDN 0
STD CM+1 CLEAR CM+1
LDC 2000 SET BIT 58
STD CM
LJM RRI4 RETURN INFORMATION
* PROCESS NORMAL REPRIEVE IN PROGRESS.
RRI10 LDC 400 SET BIT 56
STD CM
UJN RRI8 RETURN INFORMATION
RCT SPACE 4,10
*** FUNCTION 137.
* RETURN CONSOLE TYPE.
*
* ENTRY (IR+3 - IR+4) = PARAMETER WORD ADDRESS.
*
* EXIT CONSOLE TYPE RETURNED TO PARAMETER WORD ADDRESS.
RCT ENTRY
LDN DSEQ FETCH EST ENTRY FOR DISPLAY
SFA EST
ADK EQAE CONSOLE TYPE TO (CM)
CRD T6
LDN ZERL INSERT TRAILING ZERO FILL
CRD CM+1
UJP GLV1 RETURN TYPE TO CALLER
TITLE SUBROUTINES.
PMP SPACE 4,20
** PMP - PROCESS MEMORY PARAMETERS.
*
* ENTRY (IR+3 - IR+4) = RFL REQUEST.
* BIT 2**11 IN IR+3 IS SET FOR EXTENDED MEMORY REQUEST
* AND ZERO FOR CM REQUEST. EXTENDED MEMORY REQUESTS
* ARE MULTIPLES OF 1000B.
*
* EXIT (A) = FL REQUEST (CM/100B OR EM/*UEBS*).
* (CM - CM+4) = FL CONTROL WORD (FLCW OR ELCW).
* (T7) = ADDRESS OF FL CONTROL WORD TO UPDATE.
* (ERRA - ERRA+1) = REQUEST TYPE.
*
* ERROR TO *ERR*, IF ARGUMENT ERROR.
*
* USES T6, T7, CM - CM+4, CN - CN+4.
*
* MACROS ABORT.
PMP2 ABORT ERNV * XX NOT VALIDATED.*
PMP3 LDC 2REC SET *EC* RESOURCE TYPE
STM ERRA
LDD CP READ EXTENDED MEMORY FL CONTROL WORD
ADN ELCW
STD T7
CRD CM
LDN 17 ROUND BY BLOCKING FACTOR
PMPB SHN 0
* SHN UESC-4
ADD IR+4
STD T6
SHN -14
ADD IR+3
LPN 37
SHN 14
LMD T6
PMPC SHN 0
* SHN -UESC
STD T6
SHN -13
PMP4 NJN PMP2 IF .GT. 3777B BLOCKS
PMP5 LDD T6
PMP SUBR ENTRY/EXIT
LDD IR+3 CHECK IF CM OR EXTENDED MEMORY REQUEST
SHN 21-13
MJN PMP3 IF EXTENDED MEMORY REQUEST
LDC 2RCM SET *CM* RESOURCE TYPE
STM ERRA
LDD CP READ CM FL CONTROL WORD
ADN FLCW
STD T7
CRD CM
SBN FLCW-ECSW READ EXTENDED MEMORY STATUS WORD
CRD CN
LDD IR+3 ROUND CM FL REQUEST
LPN 37
SHN 14
LMD IR+4
ADN 77
MJN PMP4 IF CM FL REQUEST TOO LARGE
SHN -6
STD T6
LDD CN+4
ZJN PMP5 IF NO EXTENDED MEMORY CURRENTLY ASSIGNED
LDD T6
PMPA UJN PMP1 PROCESS *RFL* PARAMETER
* NJN PMP1 (PROCESS *MFL* NON-ZERO PARAMETER)
LDD CM+2 CHECK MAXFL
PMP1 ADC -MCMX/100
PJN PMP5 IF AT LEAST *MCMX* WORDS REQUESTED
LDC MCMX/100 SET *MCMX* WORDS
STD T6
LJM PMPX RETURN
SPACE 4,10
** COMMON DECKS.
*CALL COMPACS
VAL$ EQU 1
*CALL COMPVLC
SPACE 4,10
** BUFFER DEFINITIONS.
USE BUFFERS
RVNA EQU * VERSION NAME
RVNB EQU RVNA+6*5 RECEIVING FIELD
TITLE PRESET.
PRS SPACE 4,10
** PRS - PRESET CONTROL POINT MANAGER.
*
* EXIT (CN - CN+4) = (JCIW) = JOB CONTROL INFORMATION.
* (EP) = SPECIAL ENTRY POINT FLAGS.
* (OT) = JOB ORIGIN TYPE.
* (SM) = SYSTEM SECURITY MODE.
*
* ERROR TO *ERR*, IF INCORRECT REQUEST.
*
* MACROS ABORT.
PRS SUBR ENTRY/EXIT
LDK MEFL PRESET SHIFT INSTRUCTIONS
CRD CM
LDD CM+2
SHN -11
STD T0
ADC SHNI+77-4
STM PMPB
LDC SHNI+77
SBD T0
STM PMPC
LDD CP READ SPECIAL ENTRY POINT WORD
ADN STSW CHECK ERROR FLAG
CRD CM
ADN SEPW-STSW
CRD CN
LDD CM+1
SBN SPET
MJN PRS0 IF NOT SPECIAL ERROR FLAG
LJM CPMX EXIT *CPM*
PRS0 LDD CN SAVE ENTRY POINTS
STD EP
LDD IR+2
LMC ACPF
ZJN PRS0.1 IF ASSIGN CIO PPU FUNCTION
RJM CRS CHECK RECALL STATUS
ZJN PRS1 IF NO AUTO RECALL
PRS0.1 RJM IFP INITIALIZE MANAGED TABLE PROCESSORS
LDD CP FETCH EJT ORDINAL
ADN TFSW
CRD CM
SFA EJT,CM CALCULATE EJT ENTRY ABSOLUTE ADDRESS
ADN SCLE GET JOB ORIGIN TYPE
CRD CM
LDD CM
LPN 17
STD OT
LDD IR+2 CHECK FUNCTION CODE
SHN 1
ADD IR+2
STD T7
ADC -TFCNL
MJN PRS2 IF LEGAL CODE
PRS1 ABORT ERIR * CPM - INCORRECT REQUEST.*
PRS2 LDM TFCN+1,T7
ZJN PRS1 IF UNDEFINED FUNCTION CODE
STM CPMB SAVE THE ADDRESS OF FUNCTION
LDD CP READ JOB CONTROL INFORMATION
ADK JCIW
CRD CN
LDM TFCN+2,T7 CHECK ORIGIN CONTROL
LPC 3777
ZJN PRS3 IF NO CONTROL BITS
STD T1
LCN 0 SET BIT SHIFT
LMD OT
RAM PRSA
LDD T1 CHECK BITS
PRSA SHN 21
MJN PRS4 IF LEGAL FUNCTION FOR JOB ORIGIN TYPE
LDM TFCN+2,T7 GET FUNCTION PROCESSOR ADDRESS
SHN 21-13
MJN PRS3.1 IF *SSJ=* REQUIRED
UJN PRS1 ABORT
PRS3 LDM TFCN+2,T7 GET FUNCTION PROCESSOR ADDRESS
SHN 21-13
PJN PRS4 IF SSJ= NOT REQUIRED
PRS3.1 LDD EP CHECK *SSJ=* ENTRY POINT
SHN 21-2
MJN PRS4 IF *SSJ=*
LDD CN+2
ADK -LSSI
MJP PRS1 IF NOT SUBSYSTEM
PRS4 LDK SSML GET SYSTEM SECURITY MODE
CRD CM
LDD CM
LPN 3
STD SM
LDM TFCN,T7 SET OVERLAY NAME
STM CPMA
LJM PRSX RETURN
TFCN SPACE 4,15
** TFCN - TABLE OF FUNCTION CODE PROCESSORS.
* ENTRY = 3 WORDS.
*
*T, 12/ NAME , 12/ ADDR , 12/ BITS
*
* NAME OVERLAY NAME
* ADDR ADDRESS OF FUNCTION PROCESSOR
* BITS BITS FOR JOB ORIGIN CONTROL
* BIT MEANING
* 11 SET IF SSJ= ENTRY POINT REQUIRED.
* 10 - 0 SET IF CORRESPONDING ORIGIN TYPE REQUIRED.
TFCN BSS 0
FCN PRS1 SET QUEUE PRIORITY (SUPPORT REMOVED)
FCN SPR SET CPU PRIORITY
FCN SEM SET EXIT MODE
FCN SLL SET LIMIT
FCN SEE SET ERROR EXIT ADDRESS
FCN SDA SET *K* DISPLAY CONTROLS
FCN ROC ROLLOUT JOB
FCN NEX NOEXIT
FCN SSM SECURE SYSTEM MEMORY
FCN ONS TURN ON SENSE SWITCHES
FCN OFS TURN OFF SENSE SWITCHES
FCN RJN READ JSN
FCN PRS1 GET QUEUE PRIORITY (SUPPORT REMOVED)
FCN RPR READ CPU PRIORITY
FCN PRS1 READ EXIT MODE
FCN RLM RETRIEVE LIMIT
FCN EDI,,SSJ ENTER DEMAND INDEX
FCN SUI,(SYOT) SET USER INDEX
FCN SLC SET LOADER CONTROL WORD
FCN RFL SET LAST RFL
FCN PRS1 READ JOB CONTROL WORD
FCN PRS1 SET JOB CONTROL WORD
FCN SSB SET SUBSYSTEM FLAG
FCN ROT READ JOB ORIGIN
FCN RAI READ ACCOUNTING INFORMATION
FCN SCP SELECT CPU TO RUN IN
FCN PRS1 RETURN USER NAME
FCN PRS1 READ FL CONTROL WORD
FCN EET,(SYOT),SSJ ENTER EVENT IN SYSTEM EVENT TABLE
FCN SPN SET PACKNAME
FCN RPN RETURN PACKNAME
FCN PRS1 GET SUBSYSTEM FLAG
FCN VAN,,SSJ VALIDATE ACCOUNT NUMBER
FCN FAM,(SYOT) ENTER FAMILY NAME
FCN BAB,,SSJ BEGIN ACCOUNT BLOCK
FCN PRS1 DISABLE SSJ=
FCN RVN RETURN VERSION NAME
FCN PRS1 GET LOADER CONTROL WORD
FCN GLS GET GLOBAL LIBRARY SET
FCN SLS SET GLOBAL LIBRARY SET
FCN PRS1 RETURN MACHINE ID
FCN RAC RETURN JOB ACTIVITY INFORMATION
FCN MFL SET MAXIMUM FIELD LENGTH
FCN CSC,,SSJ TOGGLE SRU CALCULATION
FCN PRS1 RESERVED
FCN PRS1 READ EXTENDED MEMORY FL CONTROL WORD
FCN VAL VALIDATE USER
FCN GPF GET PERMANENT FILE PARAMETERS
FCN SPF,,SSJ SET PERMANENT FILE PARAMETERS
FCN CKA1 GET LIST OF FILES ADDRESS
FCN CKA1 SET LIST OF FILES ADDRESS
FCN PRS1 GET END OF JOB INFORMATION
FCN CKA1,,SSJ INCREMENT AUC ACCUMULATOR
FCN PRS1 SET/CLEAR *UTL=* ENTRY POINT
FCN PRS1 RESERVED FOR CPUMTR
FCN PRS1 RESERVED FOR CPUMTR
FCN PRS1 RESERVED FOR CPUMTR
FCN PRS1 RESERVED FOR CPUMTR
FCN PRS1 RESERVED FOR CPUMTR
FCN DFC,(SYOT) DECREMENT FAMILY USER COUNT
FCN JCI JOB CONTROL INFORMATION
FCN PRO SET/CLEAR JOB CONTROL FLAGS
FCN SOV,,SSJ SET/CLEAR *OVERRIDE* FLAG
FCN IAA INITIATE APPLICATION ACCOUNTING
FCN SPB SET PAUSE BIT
FCN SPS SYSTEM ORIGIN PRIVILEGES STATUS
FCN TDC TRANSFER *L* DISPLAY DATA TO CMR
FCN TDU TRANSFER *L* DISPLAY COMMAND TO USER-S FL
FCN SPC,,SSJ SET PROLOGUE/EPILOGUE CONTROLS
FCN PRS1 RESERVED
FCN SJB SET JOB CHARACTERISTICS
FCN RNR,,SSJ SET ROLL/NO ROLL
FCN GSI GET SUBSYSTEM ID
FCN RSO READ SERVICE CLASS AND JOB ORIGIN
FCN SOD SET OPERATOR DISPLAY MESSAGE
FCN SSC SET *SHELL* CONTROL
FCN SCC,,SSJ DECREMENT SECURITY COUNT
FCN UCS,,SSJ UPDATE USER ACCESS WORDS
FCN GAL GET JOB ACCESS LEVEL LIMITS
FCN SAL SET JOB ACCESS LEVEL
FCN USV,,SSJ GET USER SECURITY VALIDATION
FCN IPD INCREMENT PACKED DATE
FCN EPW,,SSJ ENCRYPT PASSWORD
FCN RSC RETURN SERVICE CLASS INFORMATION
FCN CSV CHANGE SERVICE CLASS
FCN PRS1 RESERVED
FCN RUA,,SSJ RETURN USER ACCOUNT BLOCK
FCN GPG GET PAGE PARAMETERS
FCN SPG SET PAGE PARAMETERS
FCN GPS,,SSJ GET PROLOGUE/EPILOGUE STATUS
FCN LOG,,SSJ PROCESS LOGOUT
FCN GLV GET SYSTEM PSR LEVEL
FCN RRI RETURN REPRIEVE INFORMATION
FCN ERM ENABLE/DISABLE TERMINAL ERROR MESSAGES
FCN GCN GET CHARGE NUMBER
FCN RCT RETURN CONSOLE TYPE
ACPF FCN ACP ASSIGN A CONCURRENT PP
FCN PAM PRIVILEGED ANALYST STATUS
FCN GSL GET SYSTEM LIBRARY STATUS
FCN GSC GET *SHELL* CONTROLS
FCN SIC SET INTER-CP COMMUNICATION CONTROLS
FCN GTD GET TAPE DEFAULTS
FCN STD SET TAPE DEFAULTS
FCN GFN,,SSJ GET FAMILY NAME AND FAMILY ORDINAL
FCN PRS1 (150) RESERVED FOR CDC
FCN PRS1 (151) RESERVED FOR INSTALLATION
FCN PRS1 (152) RESERVED FOR INSTALLATION
FCN PRS1 (153) RESERVED FOR INSTALLATION
FCN PRS1 (154) RESERVED FOR INSTALLATION
FCN PRS1 (155) RESERVED FOR INSTALLATION
FCN PRS1 (156) RESERVED FOR INSTALLATION
FCN PRS1 (157) RESERVED FOR INSTALLATION
FCN PRS1 (160) RESERVED FOR INSTALLATION
LOC *O
TFCNL EQU *-TFCN
IFP HERE GLOBAL FNT PROCESSORS INITIALIZATION CODE
SPACE 4,10
** COMMON DECKS.
PIR$ EQU 1 SELECT ASSEMBLY OF *PIR* FOR IAF R-REG
*CALL COMPSRR
*CALL COMPCRS
*CALL COMPSPA
*CALL COMPSSF
SPACE 4,10
OVERFLOW
OVERLAY (ERROR PROCESSOR.)
ERR SPACE 4,10
** ERR - PROCESS ERROR.
*
* ENTRY (CN) = ERROR MESSAGE ADDRESS.
* (CN+1) = DAYFILE OPTION.
* = 0 FOR MESSAGE TO USER AND SYSTEM
* DAYFILE.
* = *ERLN* FOR MESSAGE TO ERROR LOG,
* USER, AND SYSTEM DAYFILE.
* (CN+2) = RESOURCE TYPE FOR *ERNV* MESSAGE.
*
* EXIT TO PPR.
*
* CALLS DFM.
*
* MACROS MONITOR.
ERR BSS 0 ENTRY
LDD CN CHECK MESSAGE TYPE
LMC ERNV
NJN ERR1 IF NOT VALIDATION ERROR MESSAGE
LDD CN+2 SET RESOURCE TYPE
SHN 6
LMN 1R
STM ERNV+1
SHN 6
STM ERNV
ERR1 LDD CN ISSUE DAYFILE MESSAGE
RJM DFM
LDD CN+1 CHECK ERROR LOG OPTION
ZJN ERR2 IF NO MESSAGE TO ERROR LOG
SHN 14 ISSUE ERROR LOG MESSAGE
LMD CN
RJM DFM
ERR2 MONITOR ABTM
LJM PPR EXIT
* ERROR MESSAGES.
QUAL
ERAE DATA C* CPM - ARGUMENT ERROR.*
ERFL DATA C* RFL BEYOND MFL.*
ERIR DATA C* CPM - INCORRECT REQUEST.*
ERNV DATA C* XX NOT VALIDATED.*
ERIJ DATA C* CPM - ACCESS LEVEL NOT VALID FOR JOB.*
ERIU DATA C* CPM - USER ACCESS NOT VALID.*
ERMS DATA C* CPM - MASS STORAGE ERROR.*
ERPN DATA C* CPM - INCORRECT PACK NAME.*
ERPV DATA C* CPM - INCORRECT PAGE VALUE.*
EREF DATA C* ERROR ON FILE - "PPFN".*
ERAU DATA C* INCORRECT APPLICATION ACCOUNTING REQUEST.*
ERSY DATA C* CPM - SYSTEM ERROR.*
ERSC DATA C$ CPM - MISSING *SHELL* LOAD OPTION.$
ERSE DATA C* CPM - EPILOGUE AND SHELL CONFLICT.*
ERSF DATA C$ CPM - INCORRECT *SHELL* FILE.$
ERCI DATA C* CPM - HARDWARE DOES NOT SUPPORT CPP-S.*
QUAL *
OVERLAY (USER VALIDATION FUNCTIONS.)
SUI SPACE 4,10
*** FUNCTION 21.
* SET USER INDEX = PARAMETER.
* SYSTEM ORIGIN ONLY.
* ON A SECURED SYSTEM, MUST BE CALLED BY *SSJ=* PROGRAM.
SUI ENTRY
LDD SM
ZJN SUI1 IF SYSTEM UNSECURED
LDD EP
SHN 21-2
MJN SUI1 IF CALLER HAS *SSJ=* ENTRY POINT
LDD IR+3
SHN 14
LMD IR+4
ZJN SUI2 IF USER INDEX OF ZERO SPECIFIED
ABORT ERIR * CPM - INCORRECT REQUEST.*
SUI1 LDD IR+3 CHECK USER INDEX
SCN 37
ZJN SUI2 IF NOT OUT OF RANGE
ABORT ERAE * CPM - ARGUMENT ERROR.*
SUI2 LDN ZERL SET USER INDEX
CRD CM
CRD CN
LDD IR+3
STD CM+3
LDD IR+4
STD CM+4
LDD CP STORE USER IDENTIFICATION
ADN UIDW
CWD CM
ADN PKNW-UIDW CLEAR PACK NAME AND TYPE
CWD CN
LJM CPMX RETURN
VAN SPACE 4,60
*** FUNCTION 40.
* VALIDATE USER/ACCOUNT COMMAND.
* THE CALLER MUST HAVE AN *SSJ=* ENTRY POINT SPECIFYING A
* PARAMETER BLOCK.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF PARAMETER BLOCK.
*
*T ADDR+0 42/ USER NAME ,18/
*T,ADDR+1 42/ PASSWORD ,14/ ,1/U ,1/N ,1/ ,1/P
*T,ADDR+2 42/ FAMILY NAME ,18/
*T,ADDR+3 60/
*T,ADDR+4 60/
*T,ADDR+5 60/
*T,ADDR+6 60/
*T,ADDR+7 60/
*T,ADDR+10 60/
*T,ADDR+11 60/
*T,ADDR+12 60/
*
* WHERE -
* U=1, IF USER NAMES FOR USER INDEXES .GE. *AUIMX* ARE
* TO BE ALLOWED (FOR *SYOT* CALLERS ONLY).
* N=1, IF JOB IS NOT TO BE ABORTED.
* P=1, IF PASSWORD IS NOT TO BE VALIDATED.
*
* EXIT PARAMETER BLOCK IS RETURNED AS FOLLOWS.
*
*T ADDR+0 42/ USER NAME ,18/ USER INDEX
*T,ADDR+1 18/ ,18/ PED ,6/ ,18/ UNCHANGED
*T,ADDR+2 42/ FAMILY NAME ,6/ SC,6/ ,3/EC ,1/ ,1/C,1/S
*T,ADDR+3 60/ (ALMW)
*T,ADDR+4 60/ (ACLW)
*T,ADDR+5 60/ (AACW)
*T,ADDR+6 60/ (APRN)
*T,ADDR+7 60/ (APJN)
*T,ADDR+10 60/ (APJ1)
*T,ADDR+11 60/ (ACGN)
*T,ADDR+12 42/ TERMINAL NAME, 18/ TERMINAL NUMBER
*
* WHERE -
* USER INDEX = 0, IF USER NAME NOT VALID.
* PED = PASSWORD EXPIRATION DATE.
* FAMILY NAME = PREVIOUS FAMILY NAME.
* SC = SERVICE CLASS.
* EC = ERROR CODE IF NOT USER NAME VALIDATION ERROR.
* = 1 IF SECONDARY *USER* COMMAND AND CHARGE
* REQUIRED.
* = 2 IF SECONDARY *USER* COMMAND, SECONDARY *USER*
* COMMANDS DISABLED, AND NOT SECURE MODE.
* = 3 IF ALTERNATE FAMILY SPECIFIED ON SECONDARY
* *USER* COMMAND AND USER NOT VALIDATED FOR
* ALTERNATE FAMILY SPECIFICATION.
* = 4 IF ALTERNATE USER NAME SPECIFIED ON SECONDARY
* *USER* COMMAND AND USER NOT VALIDATED FOR
* ALTERNATE USER NAME SPECIFICATION.
* C = 1, IF SECURITY COUNT EXHAUSTED.
* S = 1, IF SECONDARY USER COMMAND.
* SEE *PPCOM* AND *COMSACC* FOR DEFINITIONS OF THE
* OTHER WORDS.
*
* THE JOB WILL BE ABORTED FOR THE FOLLOWING REASONS -
* 1) THE SPECIFIED USER NAME/PASSWORD IS NOT VALID, UNLESS
* *N* HAS BEEN SPECIFIED.
* 2) A MASS STORAGE ERROR WAS ENCOUNTERED.
VAN ENTRY
RJM GPV GET PARAMETERS
ZJN VAN3 IF NOT SECONDARY USER COMMAND
RJM CSU CHECK SECONDARY USER COMMAND
ZJN VAN3 IF NO ERROR
VAN1 LDN 1 SET ERROR TYPE
VAN2 LJM PIU PROCESS ERROR
* VALIDATE USER AND FAMILY NAMES.
VAN3 RJM SFE SET FAMILY EST ORDINAL
NJN VAN2 IF FAMILY NOT FOUND
LDD CP SET CURRENT FAMILY EST ORDINAL
ADN PFCW
CRD CN
RJM UFC UPDATE FAMILY ACTIVITY COUNT
LDD T2 SAVE FAMILY EST ORDINAL
STM VANB
RJM RUB RETURN USER BLOCK
ZJN VAN1 IF INCORRECT USER
PJN VAN3.1 IF NO MASS STORAGE ERROR ENCOUNTERED
ABORT ERMS * CPM - MASS STORAGE ERROR.*
VAN3.1 LDD T4
ZJN VAN4 IF USER INDEX .LT. *AUIMX*
VANA LDN 0
* LDN 10 (SPECIAL USER NAMES OK FOR SYOT)
ZJN VAN1 IF SPECIAL USER NAME FLAG NOT SET
LDD OT
LMK SYOT
NJN VAN2 IF NOT *SYOT*
VAN4 LDN VANE-VAND SET ADDRESS OF USER BLOCK WORDS
STD T1
VAN5 LDD T3 SET ADDRESS
RAM VAND,T1
LCN 2
RAD T1
PJN VAN5 IF MORE ADDRESSES TO SET
LDN VANK-VANJ SET ADDRESS OF USER BLOCK WORDS
STD T1
VAN5.1 LDD T3 SET ADDRESS
RAM VANJ,T1
LCN 2
RAD T1
PJN VAN5.1 IF MORE ADDRESSES TO SET
LDC ** RESTORE FAMILY EST ORDINAL
VANB EQU *-1
* LDC (EQ) (FAMILY EST ORDINAL)
STD T5
LDD BA+4 SET STATUS FLAGS
STD FN+4
LDD BA+3
LMD FN+3
LPN 77
LMD FN+3
STD FN+3
LDN 11
STD T1
RJM CKA
ADN 2 RETURN FAMILY NAME AND STATUS FLAGS
CWD FN
SBN 1 READ PASSWORD
CRD FN
* IF THE CURRENT USER NAME IS ALREADY NONZERO ON A PRIMARY
* USER COMMAND, THE PASSWORD HAS ALREADY BEEN VALIDATED BY
* *0VJ*, *NVF* OR *1TA* (AND SHOULD NOT BE VALIDATED NOW).
* HOWEVER, FOR SOME *SYOT* JOBS (SUCH AS *DIS* AND *PTFS*),
* THE PASSWORD FOR THE PRIMARY USER COMMAND MUST BE VALIDATED
* AT THIS TIME.
LDM VANC
NJN VAN6 IF NOT FIRST USER COMMAND
LDM RUIA
NJN VAN9 IF USER NONZERO (PASSWORD ALREADY CHECKED)
VAN6 LDD OT
LMK IAOT
ZJN VAN7 IF INTERACTIVE JOB
LDC APSW*5 USE BATCH PASSWORD
STM VPWA
VAN7 RJM VPW VALIDATE PASSWORD
NJN VAN8 IF INCORRECT PASSWORD
LDD CN+3 SAVE PASSWORD EXPIRATION DATE
STM PESS
LDD CN+4
STM PESS+1
LDD T6 CHECK SECURITY COUNT
NJN VAN9 IF SECURITY COUNT NOT YET EXHAUSTED
VAN8 LJM VAN2 PROCESS ERROR
VAN9 LDM AHFC*5,T3 SAVE PERMANENT FILE VALIDATIONS
STD T2
LDC 0
* LDC 1 (SECONDARY USER COMMAND)
VANC EQU *-1 (VALUE OF PRIMARY USER FLAG)
NJN VAN10 IF SECONDARY USER COMMAND
LJM VAN11 PROCESS PRIMARY USER COMMAND
* UPDATE PARAMETER BLOCK FOR SECONDARY USER COMMAND.
VAN10 LDM APRN*5+3,T3
LPN 77
SBN SSPMN
MJN VAN10.1 IF NO SECURITY SYSTEM PROLOGUE
LJM VAN1 PROCESS ERROR
VAN10.1 NFA SSJN+ALMS GET CURRENT USER LIMITS
CRM ALMT,TR
LDM AAWC*5+4,T3 SET NEW *CCNR*/*CSPF*/*CLPF*/*CPWC* VALUES
LMM AACT+4
LPC 215
LMM AACT+4
STM AACT+4
LDM AAWC*5+3,T3 SET NEW *COPR*/*CNRD* VALUES
LMM AACT+3
LPC 6000
LMM AACT+3
STM AACT+3
LDM AAWC*5+2,T3 SET NEW *CRAF*/*CRAU* VALUES
LMM AACT+2
LPC 140
LMM AACT+2
STM AACT+2
LDN 12
STD T1
RJM CKA SET PARAMETER BLOCK ADDRESS
ADN 3 RETURN *ALMW*, *ACLW*, AND UPDATED *AACW*
CWM ALMT,TR
LJM VAN12 RETURN FIELDS FROM VALIDATION BLOCK
* UPDATE NFL AND PARAMETER BLOCK FOR PRIMARY USER COMMAND.
VAN11 LDM ACGN*5,T3
ZJN VAN11.0 IF NO DEFAULT CHARGE
NFA CHGN SET DEFAULT CHARGE AND PROJECT IN NFL
CWM ACGN*5,ON
VANJ EQU *-1
CWM APJN*5,ON
CWM APJ1*5,ON
VANK EQU *-1
VAN11.0 LDM RUIA
NJN VAN11.1 IF USER NAME NONZERO (*JSCW* ALREADY SET)
RJM PSV PROCESS SECURITY VALIDATIONS
NJP VAN2 IF ERROR
VAN11.1 LDD T3
ADN AHFC*5
RJM CLI CONVERT COUNTING LIMITS
LDN 12
STD T1
RJM CKA SET ADDRESS
ADN 12 RETURN TERMINAL NAME
CWM TNSS,ON
ADK 3-13 RETURN ALMW, ACLW, AND AACW TO CALLER
CWM AHMT*5,ON
VAND EQU *-1
CWM AHDS*5,ON
CWM AAWC*5,ON
VAN12 CWM APRN*5,ON
CWM APJN*5,ON
CWM APJ1*5,ON
CWM ACGN*5,ON
VANE EQU *-1
SBN 11 SET PASSWORD EXPIRATION DATE
CRD FN
LDM PESS
STD FN+1
LDM PESS+1
STD FN+2
RJM CKA RETURN PASSWORD EXPIRATION DATE
ADN 1
CWD FN
SBN 1 RETURN USER NAME AND USER INDEX
CWD UN
ADN 3 READ *ALMW*, *ACLW*, AND *AACW*
CRM ALMT,TR
* SET VALIDATION PARAMETERS.
LDD CP READ *AALW*
ADK AALW
CRD CM
STD CN SAVE ADDRESS
LDD CM+4 CLEAR OLD APPLICATION ACCESS LEVEL
SCN 77
STD CM+4
LDM APRN*5+4,T3 GET NEW APPLICATION ACCESS LEVEL
SHN -6
RAD CM+4
LDD CN UPDATE *AALW*
CWD CM
LDD CP READ PERMANENT FILE CONTROLS
ADN PFCW
CRD CN
ADN CSPW-PFCW READ PRIMARY USER COMMAND FLAG
CRD CM
LDD T5 SET FAMILY EST ORDINAL
STD CN+3
LDD T2 SET PERMANENT FILE CONTROLS
STD CN+4
LDM AAWC*5+4,T3 GET *CCNR* ACCESS PRIVILEGE FLAG
SHN 2-7
LPN 4
LMN 6 SET PRIMARY USER AND CHARGE REQUIRED FLAGS
LMD CM
LPN 6
LMD CM
STD CM
LDD CP WRITE PERMANENT FILE CONTROLS
ADN PFCW
CWD CN
ADN CSPW-PFCW WRITE USER AND CHARGE COMMAND FLAGS
CWD CM
NFA SSJN+UIDS SET VALIDATION WORDS IN SSJ= BLOCK
CWD UN
ADN ALMS-UIDS
CWM ALMT,TR
* SET SERVICE CLASS VALIDATION MASK.
LDM VANC
NJN VAN12.1 IF SECONDARY USER COMMAND
LDD T3 SET ADDRESS OF VALIDATION MASK
ADK ASCV*5
STM VANI
NFA SCVN
CWM **,ON
VANI EQU *-1 (ADDRESS OF VALIDATION MASK)
* CHECK FOR *SHELL* CONTROL.
VAN12.1 LDM ASHN*5,T3
ZJN VAN14 IF NO *SHELL* CONTROL
LDM AAWC*5+3,T3
SHN 21-7
PJN VAN13 IF NOT *CMNT* ACCESS
LDN SSTL
CRD CM
LDD CM+3
SHN 21-7
PJN VAN14 IF PRIVILEGED *RDF* ENABLED
VAN13 LDD T3 SET *SHELL* CONTROL
ADN ASHN*5
STM VANF
NFA SHCN
CWM **,ON
VANF EQU *-1
* CHECK *CMNT* ACCESS.
VAN14 LDM AAWC*5+3,T3
SHN 21-7
PJN VAN15 IF NOT *CMNT* ACCESS
LDN UN SPACE FILL USER NAME
RJM SFN
LDD UN+3
LMN 1R.&1R
STD UN+3
LDN 0
STD UN+4
LDD MA SET USER NAME IN MESSAGE
CWD UN
CRM VANH,ON
LDC VANG+MDON ISSUE MESSAGE TO SYSTEM DAYFILE ONLY
RJM DFM
VAN15 LJM CPMX EXIT
VANG DATA H*MAINTENANCE ACCESS BY UN = *
VANH BSS 5
FAM SPACE 4,15
*** FUNCTION 41.
* ENTER FAMILY.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF FAMILY NAME.
* IF FAMILY NAME = 0, THE DEFAULT WILL BE USED.
*
* EXIT ((IR+3 - IR+4)) = 48/OLD FAMILY NAME,12/FLAG.
* FLAG .EQ. 0 IF DEFAULT FAMILY NOT USED.
* .LT. 0 IF FAMILY NOT FOUND.
* .GT. 0 IF SAME AS SYSTEM DEFAULT FAMILY.
*
* MUST BE CALLED BY SYSTEM ORIGIN JOB.
* ON A SECURED SYSTEM, MUST BE CALLED BY *SSJ=* PROGRAM.
FAM ENTRY
LDD SM
ZJN FAM0 IF SYSTEM UNSECURED
LDD EP
SHN 21-2
MJN FAM0 IF CALLER HAS *SSJ=* ENTRY POINT
ABORT ERIR * CPM - INCORRECT REQUEST.*
FAM0 RJM CKA READ FAMILY NAME
CRD FN
LDC PFNL READ DEFAULT FAMILY NAME
CRD CN
LDD CN+3
STD T5
LDD FN CHECK ENTERED FAMILY
NJN FAM1 IF FAMILY SPECIFIED
LDD T5 SET SYSTEM DEFAULT FAMILY
STD T2
STD FN+3
UJN FAM3
FAM1 RJM SFE SET FAMILY EST ORDINAL
SBN 2
MJN FAM2 IF FAMILY FOUND
LCN 0 SET FAMILY NOT FOUND STATUS
STD FN+4
LJM FAM5 RETURN STATUS
FAM2 LDN 0 SET FAMILY FOUND STATUS
STD FN+4
LDD T2 CHECK DEFAULT FAMILY
SBD T5
NJN FAM4 IF NOT DEFAULT FAMILY
FAM3 LDN 1 SET DEFAULT FAMILY STATUS
STD FN+4
FAM4 LDD CP
ADN PFCW SET FAMILY EST ORDINAL AND RETURN
CRD CN
RJM UFC UPDATE FAMILY COUNT
LDD CN+3
STD T3 SAVE OLD FAMILY EST ORDINAL
LDD T2 INSERT NEW FAMILY EST ORDINAL
STD CN+3
LDD CP
ADN PFCW
CWD CN
LDD FN+4
STD T4
SFA EST,T3 READ OLD FAMILY EST ENTRY
ADK EQDE
CRD CN
LDD CN+4
SHN 3
ADN PFGL
CRD FN READ OLD FAMILY NAME
LDD T4
STD FN+4 RESET STATUS
FAM5 LDN 0 SET RETURN ADDRESS
STD T1
RJM CKA
CWD FN
LJM CPMX RETURN
VAL SPACE 4,50
*** FUNCTION 56.
* VALIDATE USER.
* MUST BE CALLED FROM SYSTEM ORIGIN OR *SSJ=* JOB.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF CALL BLOCK *ADDR*.
*
*T ADDR 42/ FAMILY NAME, 15/ 0, 1/R, 1/E, 1/D
*T, 42/ PASSWORD, 15/ , 1/ B, 1/ I, 1/ P
*T, 42/ USER NAME, 17/ ,1/ U
*T, 42/ APPLICATION NAME, 18/ 0
*T, 60/
*T, 60/
*T, 60/
*T, 60/
*T, 60/
*T, 60/
*T, 60/
*T, 60/
*T, 60/
*
* FAMILY NAME = FAMILY NAME OR 0, THE SYSTEM DEFAULT FAMILY
* WILL BE RETURNED IF NO FAMILY NAME IS SUPPLIED.
* R = 1, IF JOB SHOULD NOT BE ROLLED ON A MASS STORAGE ERROR.
* E = 1, IF THE PED FIELD TO BE RETURNED.
* D = 1, IF THE PID FIELD TO BE RETURNED.
* PASSWORD = OPTIONAL PASSWORD FOR VALIDATION.
* B = 1, IF PASSWORD IS TO BE VALIDATED FOR BATCH ACCESS.
* I = 1, IF INCREMENT OF FAMILY ACTIVITY COUNT IS REQUIRED.
* P = 1, IF PASSWORD NOT TO BE VALIDATED.
* USER NAME = USER NAME TO VALIDATE.
* U = 1, IF USER NAME FOR USER INDEXES .GE. *AUIMX* ARE
* TO BE ALLOWED.
* APPLICATION NAME = 0 OR DESIRED APPLICATION NAME.
*
* EXIT THE PARAMETER BLOCK IS RETURNED AS FOLLOWS.
*
*T ADDR 42/FAMILY NAME, 3/, 9/FO, 5/ST, 1/C
*T, 42/ PASSWORD, 16/ 0, 1/ I, 1/ P
*T, 42/ USER NAME, 18/ USER INDEX
*T, 42/ APPLICATION NAME, 18/ 0
*T, 54/ 0, 6/ AL
*T, 60/ *AHMT*
*T, 60/ *AHDS*
*T, 60/ *AAWC*
*T, 60/ *ATPA*
*T, 60/ *AAVW*
*T, 60/ *ACGN*
*T, 60/ *APJN*
*T, 60/ *APJ1*
*T, 60/ PERSONAL IDENTIFICATION PART 1 (*APID*)
*T, 60/ PERSONAL IDENTIFICATION PART 2 (*API2*)
*T, 42/ 0, 18/ PASSWORD EXPIRATION DATE
*
* FO = EST ORDINAL OF FAMILY.
* ST = STATUS-
* BIT 0 = 0 VALID FAMILY, USER NAME, PASSWORD
* BIT 0 = 1 INCORRECT LOGIN (OTHER BITS UNDEFINED)
* BIT 1 = 0 SECURITY COUNT OK
* BIT 1 = 1 SECURITY COUNT EXHAUSTED
* BIT 2 = 0 NO MASS STORAGE ERROR ENCOUNTERED
* BIT 2 = 1 MASS STORAGE ERROR ENCOUNTERED
* C = COMPLETION BIT.
* USER INDEX = RETURNED USER INDEX ON VALID LOGIN.
* AL = APPLICATION ACCESS LEVEL.
* PERSONAL IDENTIFICATION = RETURNED IF VALID LOGIN AND D = 1.
* PASSWORD EXPIRATION DATE = EXPIRATION DATE OF THE PASSWORD
* BEING VALIDATED, RETURNED IF VALID PASSWORD AND E = 1.
*
* IF A NON-SUBSYSTEM JOB ENCOUNTERED A RECOVERABLE READ/WRITE
* ERROR ON THE DEVICE, THE JOB IS ROLLED OUT TO WAIT FOR THE
* DEVICE TO BECOME ACCESSIBLE.
*
*
* THE FAMILY ACTIVITY COUNT IS NOT INCREMENTED (EVEN
* IF *I* IS ONE) IF VALIDATION IS NOT SUCCESSFUL OR THE
* SECURITY COUNT IS EXHAUSTED.
VAL ENTRY
LDD OT
LMK SYOT
ZJN VAL1 IF SYSTEM ORIGIN
LDD EP
SHN 21-2
MJN VAL1 IF *SSJ=* JOB
ABORT ERIR * CPM - INCORRECT REQUEST.*
VAL1 LDN 10 CHECK PARAMETER ADDRESS
STD T1
RJM CKA
CRD FN READ FAMILY NAME
CRD BA
ADN 2
CRD UN READ USER NAME
LDD UN+4 SAVE SPECIAL USER NAMES ALLOWED FLAG
LPN 1
RAM VALA
LDD FN+4 SAVE ROLL/PID/PED FLAGS
LPN 77
RAM VALH
* VALIDATE USER AND FAMILY.
LDN 0 SET VALIDATE USER FUNCTION FOR *0AV* CALL
STD UN+4
STD BA+4
LDD UN+3
SCN 77
STD UN+3
EXECUTE 0AV,L0AV VALIDATE USER
PJN VAL2 IF NO MASS STORAGE ERROR ENCOUNTERED
LDM VALH CHECK ROLLOUT INHIBIT FLAG
LPN 4
NJN VAL1.1 IF NOT TO ROLL JOB ON MASS STORAGE ERROR
RJM CJR CHECK IF JOB IS ROLLABLE
VAL1.1 LDN 10-2
RAM VALG
UJN VAL4 RETURN ERROR TO CALLER
VAL2 LDD T4
ZJN VAL3 IF USER INDEX .LT. *AUIMX*
VALA LDN 0
* LDN 1 (SPECIAL USER NAMES ALLOWED)
ZJN VAL4 IF SPECIAL USER NAMES NOT ALLOWED
VAL3 LDD T1
SHN 14
LMD T2
NJN VAL5 IF LEGAL USER NAME
VAL4 LJM VAL11 TERMINATE REQUEST
VAL5 STD UN+4 ENTER USER INDEX IN PARAMETER BLOCK
SHN -14
RAD UN+3
LDD T3 SAVE ADDRESS OF ACCOUNT BLOCK
STM VALD
RAM VALI
LDN VALC-VALB SET ADDRESSES OF USER BLOCK WORDS
STD T1
VAL6 LDD T3 SET ADDRESS
RAM VALB,T1
LCN 2
RAD T1
PJN VAL6 IF MORE ADDRESSES TO SET
RJM SFE SET FAMILY EST ORDINAL
NJP VAL4 IF FAMILY NOT FOUND
* RETURN USER RECORD PARAMETERS.
LDD MA TRANSFER (FN - FN+4) TO (BA - BA+4)
CWD FN RETURN FAMILY NAME
CRD BA
LDD FN+4 SET FAMILY EST ORDINAL FOR *STBM*
STM VALF
SHN 6
STD BA+4
SHN -14 INSERT REMAINING BITS IN (BA+3)
RAD BA+3
LDN 14 SET WORD COUNT
STD T1
RJM CKA
ADN 1
CRD FN
ADN 5-1
CWM AHMT*5,ON
VALB EQU *-1
CWM AHDS*5,ON
CWM AAWC*5,ON
CWM ATPA*5,ON
CWM AAVW*5,ON
CWM ACGN*5,ON
CWM APJN*5,ON
CWM APJ1*5,ON
VALC EQU *-1
LDD FN+4 SAVE PARAMETER FLAGS
STM VALE
* EXPANDED BLOCK PERSONAL IDENTIFICATION.
VALH LDN ** EXPANDED BLOCK FLAGS
LPN 1
ZJN VAL6.1 IF PERSONAL ID BIT NOT SET
LDN 2
STD T2
RAD T1
RJM CKA SET PARAMETER ADDRESS
ADN 15
CWM APID*5,T2 RETURN PERSONAL IDENTIFICATION
VALI EQU *-1 (ADDR. OF PERSONAL ID IN VALIDATION BLOCK)
* VALIDATE PASSWORD.
VAL6.1 LDC ** SET ACCOUNT BLOCK ADDRESS
VALD EQU *-1 (ADDRESS OF ACCOUNT BLOCK)
STD T3
LDD FN+4
SHN 21-2
PJN VAL7 IF NOT TO USE BATCH PASSWORD
LDC APSW*5 USE BATCH PASSWORD
STM VPWA
STM RPEA
VAL7 RJM VPW VALIDATE PASSWORD
NJP VAL11 IF PASSWORD NOT VALID
* EXPANDED BLOCK PASSWORD EXPIRATION DATE.
LDM VALH EXPANDED BLOCK FLAGS
LPN 2
ZJN VAL8 IF PASSWORD EXPIRATION BIT NOT SET
AOD T1
RJM RPE RETURN PASSWORD EXPIRATION DATE
RJM CKA SET PARAMETER ADDRESS
ADD T1
CWD CM SET PASSWORD EXPIRATION DATE
* CHECK SECURITY COUNT.
VAL8 LDD T6 CHECK SECURITY COUNT
NJN VAL9 IF SECURITY COUNT NOT EXHAUSTED
LDN 4
RAD BA+4 SET SECURITY EXHAUSTION FLAG
UJN VAL10 TERMINATE REQUEST
* INCREMENT FAMILY ACTIVITY COUNT.
VAL9 LDC * CHECK FAMILY COUNT INCREMENT FLAG
VALE EQU *-1
LPN 2
ZJN VAL10 IF NO FAMILY COUNT INCREMENT
LDN IFCS INCREMENT FAMILY ACTIVITY COUNT
STD CM+3
LDC * SET FAMILY EST ORDINAL
VALF EQU *-1 (EST ORDINAL OF FAMILY)
STD CM+1
MONITOR SMDM
* TERMINATE REQUEST.
VAL10 AOD BA+4 SET COMPLETION BIT
RJM CKA
ADN 4
CRD FN
LDM VASS+APRN*5+4 APPLICATION ACCESS LEVEL
SCN 77
STD FN+4
RJM CKA CHECK CENTRAL ADDRESS
CWD BA
ADN 2
CWD UN
ADN 2
CWD FN
LJM CPMX RETURN
VAL11 LDN 0 CLEAR USER INDEX
STD UN+4
LDD UN+3
SCN 77
STD UN+3
LDN 2 SET INCORRECT LOGIN FLAG
* LDN 10 (MASS STORAGE ERROR)
VALG EQU *-1
RAD BA+4
UJN VAL10 RETURN ERROR TO CALLER
SPF SPACE 4,25
*** FUNCTION 60.
* SET PERMANENT FILE PARAMETERS IN CONTROL POINT AREA.
* MUST BE CALLED BY SYSTEM ORIGIN JOB.
*
* ENTRY (IR+3 - IR+4) = ADDRESS *ADDR* OF PARAMETER BLOCK
* WHICH HAS THE FOLLOWING FORMAT -
*
*T ADDR 42/ FAMILY NAME,14/ ,4/ FG
*T, 42/ PACK NAME,18/ PACK TYPE
*T, 42/ USER NAME,1/ ,17/ USER INDEX
* FG = FLAG BITS DENOTING WHICH FIELDS TO SET.
* BIT 3 - FAMILY NAME.
* BIT 2 - PACKNAME.
* BIT 1 - USER NAME.
* BIT 0 - USER INDEX.
*
* EXIT PARAMETERS SET IN CONTROL POINT AREA IF FLAGGED.
* STATUS OF SPECIFIED FAMILY RETURNED AS FOLLOWS -
*
*T ADDR 42/ FAMILY NAME,6/ ST,8/ 0,4/ FG
* ST = 0 IF FAMILY NAME SET IN CONTROL POINT AREA.
* = 1 IF SPECIFIED FAMILY WAS NOT FOUND (CURRENT FAMILY
* REMAINS UNCHANGED).
SPF ENTRY
LDN 2 CHECK PARAMETER BLOCK ADDRESS
STD T1
RJM CKA
CRD FN READ FAMILY NAME
LDD CP READ PF CONTROL WORD
ADN PFCW
CRD UN
LDD FN+4 CHECK FAMILY NAME BIT
STD T7
SHN 21-3
PJN SPF2 IF NO FAMILY NAME CHANGE
* FIND EST ORDINAL OF SPECIFIED FAMILY.
RJM SFE SET FAMILY EST ORDINAL
ZJN SPF0 IF FAMILY FOUND
LDN 1 SET FAMILY NOT FOUND STATUS
SPF0 STD T3
NJN SPF1 IF FAMILY NOT FOUND
* SET FAMILY ORDINAL IN CONTROL POINT AREA.
LDD UN+3 SET OLD FAMILY EST ORDINAL FOR *UFC*
STD CN+3
LDD T2
STD UN+3
RJM UFC UPDATE FAMILY COUNTS
LDD CP UPDATE FAMILY ORDINAL IN CPA
ADN PFCW
CWD UN
* SET STATUS OF SPECIFIED FAMILY NAME.
SPF1 LDD FN+3 ADD STATUS TO NAME
SCN 77
LMD T3
STD FN+3
LDD T7 RESET FLAG BITS
STD FN+4
LDN 2 SET STATUS IN BLOCK
STD T1
RJM CKA
CWD FN
* CHANGE PACKNAME.
SPF2 LDD T7 CHECK PACK NAME FLAG
SHN 21-2
PJN SPF3 IF NO PACK NAME CHANGE
RJM CKA READ PACKNAME AND PACK TYPE
ADN 1
CRD FN
LDD CP UPDATE PACK NAME AND TYPE IN CPA
ADC PKNW
CWD FN
* READ USER NAME AND USER INDEX.
SPF3 RJM CKA READ USER NAME AND USER INDEX
ADN 2
CRD UN
CRD CM
LDD CP READ CONTROL POINT AREA PARAMETERS
ADN UIDW
CRD FN
* CHANGE USER NAME.
LDD T7 CHECK USER NAME FLAG
SHN 21-1
PJN SPF4 IF USER NAME FLAG NOT SET
LDD CM+3 SET NEW USER NAME
SCN 77
STD CM+3
LDD FN+3
LPN 77
LMD CM+3
STD CM+3
LDD FN+4
STD CM+4
LDD MA RESET CONTROL POINT AREA WORD
CWD CM
CRD FN
* CHANGE USER INDEX.
SPF4 LDD T7 CHECK USER INDEX FLAG
SHN 21-0
PJN SPF5 IF USER INDEX FLAG NOT SET
LDD FN+3 SET NEW USER INDEX
SCN 37
STD FN+3
LDD UN+3
LPN 37
LMD FN+3
STD FN+3
LDD UN+4
STD FN+4
* SET NEW USER NAME AND USER INDEX.
SPF5 LDD CP WRITE NEW PARAMETERS
ADN UIDW
CWD FN
LJM CPMX EXIT
DFC SPACE 4,10
*** FUNCTION 73.
* DECREMENT FAMILY USER COUNT (*SYOT* ONLY).
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF FAMILY DESCRIPTOR WORD.
*
*T, 42/ FAMILY NAME, 17/ 0, 1/ 0
*
* EXIT FAMILY DESCRIPTOR WORD UPDATED.
*T, 42/ , 6/ RES, 11/ STATUS, 1/ C
*
* STATUS = NON-ZERO IF FAMILY NOT FOUND.
* C = COMPLETION BIT. (ZERO ON REQUEST, ONE ON REPLY)
* RES = RESERVED FOR CDC.
DFC ENTRY
RJM CKA CHECK PARAMETER ADDRESS
CRD FN READ FAMILY NAME
LDN 20 SET RETURN STATUS FOR FAMILY NOT FOUND
STD FN+4
RJM SFE SET FAMILY EST ORDINAL
SBN 2
PJN DFC1 IF FAMILY NOT FOUND
LDN 0 SET RETURN STATUS FOR FAMILY FOUND
STD FN+4
LDD T2
STD CM+1 SET FAMILY EST ORDINAL
LDN DFCS DECREMENT FAMILY USER COUNT
STD CM+3
MONITOR SMDM
DFC1 LDD FN+3 CLEAR RESERVED BITS
SCN 77
STD FN+3
AOD FN+4 SET COMPLETE BIT
LDN 0
STD T1
RJM CKA
CWD FN WRITE STATUS
LJM CPMX RETURN
SPC SPACE 4,20
*** FUNCTION 104.
* SET PROLOGUE/EPILOGUE CONTROLS.
* CALLER MUST HAVE *SSJ=* ENTRY POINT.
*
* ENTRY (IR+3 - IR+4) = ADDRESS *ADDR* OF PARAMETER BLOCK.
*
*T ADDR 32/ , 1/E, 3/TO, 18/ FL
*
* E = EPILOGUE PENDING FLAG. THE CHARGE REQUIRED FLAG
* IS CLEARED IF CLEARING EPILOGUE PENDING FLAG.
* TO = SYSTEM/PROJECT PROLOGUE/EPILOGUE TERMINATION OPTION
* (SEE *COMSJCE*).
* FL = OPTIONAL PROCESSING FLAGS.
* BIT 1 = SET/CLEAR EPILOGUE PENDING FLAG.
* BIT 0 = SET/CLEAR PROLOGUE/EPILOGUE TERMINATION OPTION.
SPC ENTRY
RJM CKA READ PARAMETER WORD
CRD BA
LDD CP READ PROLOGUE/EPILOGUE CONTROL
ADN EOJW
CRD CM
ADN CSPW-EOJW READ EPILOGUE PENDING AND CHARGE REQUIRED
CRD FN
ADN JCDW-CSPW READ PROCEDURE NESTING LEVEL
CRD UN
LDD BA+4
SHN 21-0
PJN SPC1 IF NOT TO SET/CLEAR TERMINATION OPTION
LDD CM+2 SAVE CURRENT OPTION
LPC 700
STD T1
LDD BA+3 SET TERMINATION OPTION
LPC 700
LMD CM+2
LMD T1
STD CM+2
LPC 700
ZJN SPC0.1 IF CLEARING OPTION, CLEAR NESTING LEVEL
* IF A TERMINATION OPTION IS SET ON ENTRY AND IS NOT BEING
* CLEARED, A PROJECT PROLOGUE IS TO BE EXECUTED FOLLOWING A
* SYSTEM PROLOGUE IN THE PROLOGUE SEQUNCING PROCEDURE. IN THIS
* CASE, THE NESTING LEVEL CONTROL WILL NOT BE CHANGED.
LDD T1
NJN SPC1 IF ALREADY SEQUENCING PROLOGUES
LDD UN+2 SET NESTING LEVEL CONTROL
SPC0.1 LMD CM+2
LPN 77
LMD CM+2
STD CM+2
SPC1 LDD BA+4
SHN 21-1
PJN SPC2 IF NOT PROCESS EPILOGUE PENDING
LDD BA+3
SHN -6
LPN 10
LMD FN
LPN 10
LMD FN
STD FN
LPN 10
NJN SPC2 IF SET EPILOGUE PENDING
LDD FN
SCN 4 CLEAR CHARGE REQUIRED
STD FN
SPC2 LDD CP WRITE PROLOGUE/EPILOGUE CONTROL
ADN EOJW
CWD CM
ADN CSPW-EOJW WRITE EPILOGUE PENDING AND CHARGE REQUIRED
CWD FN
LJM CPMX RETURN
SCC SPACE 4,40
*** FUNCTION 114.
*
* DECREMENT SECURITY COUNT (MUST BE CALLED FROM AN *SSJ=*
* PROGRAM). IF THE SECURITY COUNT IS UNLIMITED OR IF A MASS
* STORAGE ERROR IS ENCOUNTERED, THE SECURITY COUNT WILL NOT BE
* DECREMENTED.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF THE 3-WORD BLOCK *ADDR*.
*
*T ADDR 42/ USER NAME, 18/
*T, 42/, 14/, 1/D, 3/
*T, 42/ FAMILY NAME, 18/
*
* USER NAME IS SUPPLIED BY THE CALLER, IF D=0.
* FAMILY NAME = 0, IF DEFAULT FAMILY USED.
* D = 0, IF PARAMETER BLOCK PROVIDED BY CALLER.
* D = 1, IF PARAMETER BLOCK MUST BE BUILT FROM
* THE CONTROL POINT AREA.
*
* EXIT THE PARAMETER BLOCK IS RETURNED AS FOLLOWS.
*
*T ADDR 42/ USER NAME, 18/
*T, 42/, 14/, 1/, 1/S, 2/
*T, 42/ FAMILY NAME, 18/
*
* S = 1, IF SECURITY COUNT EXHAUSTED.
*
* THE JOB IS ROLLED OUT TO WAIT FOR THE DEVICE TO BECOME
* ACCESSIBLE IF A NON-SUBSYSTEM JOB ENCOUNTERED A
* RECOVERABLE READ/WRITE ERROR ON THE DEVICE.
SCC ENTRY
LDN 2 CHECK PARAMETER ADDRESS
STD T1
RJM CKA
CRD UN READ USER NAME
ADN 1
CRD CM READ SECOND WORD
ADN 1
CRD FN READ FAMILY NAME
LDD CM+4
SHN 21-3
PJN SCC1 IF NOT TO USE CONTROL POINT AREA
LDN 0 SET DEFAULT FAMILY NAME
STD FN
LDD CP READ USER NAME
ADN UIDW
CRD UN
* DECREMENT SECURITY COUNT.
SCC1 LDN 1 SET REQUEST TO DECREMENT SECURITY COUNT
STD UN+4
EXECUTE 0AV,L0AV DECREMENT SECURITY COUNT
PJN SCC1.1 IF NO MASS STORAGE ERROR ENCOUNTERED
RJM CJR CHECK IF THE JOB IS ROLLABLE
UJN SCC2 IGNORE CALL
SCC1.1 RJM SFE SET FAMILY EST ORDINAL
ZJN SCC3 IF FAMILY FOUND
SCC2 LJM CPMX IGNORE CALL
* CHECK SECURITY COUNT.
SCC3 LDN ZERL
CRD CM
LDD T6 CHECK SECURITY COUNT
NJN SCC4 IF SECURITY COUNT NOT EXHAUSTED
LDN 4 SET COUNT EXHAUSTED FLAG
STD CM+4
SCC4 LDN 2
STD T1
RJM CKA SET PARAMETER ADDRESS
CWD UN RETURN USER NAME
ADN 1
CWD CM RETURN STATUS
ADN 1
CWD FN RETURN FAMILY NAME
UJN SCC2 RETURN
UCS SPACE 4,15
*** FUNCTION 115.
*
* UPDATE USER ACCESS WORDS IN CONTROL POINT AREA
* AND THE SSJ= BLOCK IN NFL.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF 3-WORD PARAMETER
* BLOCK *ADDR*.
*
*T ADDR 60/ NEW *ALMW*
*T, 60/ NEW *ACLW*
*T, 60/ NEW *AACW*
*
* EXIT (ALMW) = *ALMW* FROM PARAMETER BLOCK.
* (ACLW) = *ACLW* FROM PARAMETER BLOCK.
* (AACW) = *AACW* FROM PARAMETER BLOCK.
UCS ENTRY
LDN 2 SET LENGTH OF BLOCK
STD T1
RJM CKA CHECK ADDRESS
ERRNZ ACLW-ALMW-1 CODE REQUIRES CONTIGUOUS WORDS
ERRNZ AACW-ACLW-1
CRM ALMT,TR
LDD CP SET WORDS IN CONTROL POINT AREA
ADN ALMW
CWM ALMT,TR
NFA SSJN+ALMS SET WORDS IN NFL
CWM ALMT,TR
LJM CPMX RETURN
RUA SPACE 4,15
*** FUNCTION 126.
* RETURN USER ACCOUNT BLOCK.
*
* ENTRY (IR+3 - IR+4) = FWA OF PARAMETER REPLY BLOCK.
*
* EXIT IF THERE ARE NO ERRORS, THE USER ACCOUNT BLOCK IS
* WRITTEN TO THE PARAMETER REPLY BLOCK.
*
* IF THE SPECIFIED USER NAME IS NOT FOUND, THE PARAMETER
* BLOCK IS CLEARED.
*
* IF A NON-SUBSYSTEM JOB ENCOUNTERED A RECOVERABLE
* READ/WRITE ERROR ON THE DEVICE, THE JOB IS ROLLED TO
* WAIT FOR THE DEVICE TO BECOME ACCESSIBLE. OTHERWISE,
* THE PARAMETER BLOCK IS CLEARED.
RUA ENTRY ENTRY/EXIT
LDK ARBS
STD T1
RJM CKA VALIDATE PARAMETER BLOCK ADDRESS
RJM RUI GET USER NAME
NJN RUA1 IF USER COMMAND FOUND
LJM RUA3 CLEAR PARAMETER BLOCK
RUA1 LDK ZERL SET FAMILY NAME
CRD FN
LDD MA SET USER NAME
CWD CM
CRD UN
LDD UN+3
SCN 77
STD UN+3
LDN 0 VALIDATE USER NAME FUNCTION
STD UN+4
EXECUTE 0AV,L0AV
PJN RUA1.1 IF NO MASS STORAGE ERROR ENCOUNTERED
RJM CJR CHECK IF THE JOB IS ROLLABLE
UJN RUA3 CLEAR THE PARAMETER BLOCK
RUA1.1 LDD T1
LPN 37
SHN 14
LMD T2
ZJN RUA3 IF USER NAME NOT FOUND
* WRITE DATA TO PARAMETER BLOCK.
LDD T3 FWA OF USER ACCOUNT BLOCK
STM RUAA
LDK ARBS NUMBER OF CM WORDS TO WRITE
STD T1
RJM CKA GET PARAMETER BLOCK ADDRESS
CWM **,T1 WRITE USER ACCOUNT BLOCK
RUAA EQU *-1
RUA2 LJM CPMX RETURN
* CLEAR PARAMETER BLOCK.
RUA3 LDK ZERL
CRD CM
LDK ARBS-1 LWA OF PARAMETER BLOCK
STD T1
RUA4 RJM CKA GET PARAMETER BLOCK ADDRESS
ADD T1
CWD CM
SOD T1
PJN RUA4 IF MORE WORDS TO CLEAR
UJN RUA2 RETURN
GPS SPACE 4,20
*** FUNCTION 131.
* GET PROLOGUE/EPILOGUE STATUS.
* CALLER MUST HAVE *SSJ=* ENTRY POINT.
*
* ENTRY (IR+3 - IR+4) = ADDRESS *ADDR* OF PARAMETER BLOCK.
*
*T ADDR 60/
*
* EXIT
*
*T ADDR 2/PR, 1/S, 32/0, 1/I, 24/RI
*
* PR = 0 IF NO SYSTEM/PROJECT PROLOGUE OR EPILOGUE
* ACTIVE.
* = 1 IF IN SYSTEM/PROJECT PROLOGUE OR EPILOGUE
* SEQUENCING PROCEDURE.
* = 2 IF IN SYSTEM/PROJECT PROLOGUE OR EPILOGUE.
* S = 1 IF SHELL PROGRAM LOAD CANNOT BE SUSPENDED IN
* PROLOGUE OR EPILOGUE.
* I = ENTRY INDEX IN PROFILE LEVEL-3 BLOCK IF PROJECT
* EPILOGUE PENDING.
* RI = RANDOM INDEX OF PROFILE LEVEL-3 BLOCK IF PROJECT
* EPILOGUE PENDING.
GPS ENTRY
RJM CKA READ PARAMETER WORD
CRD BA
LDN ZERL
CRD CN
LDD CP READ PROLOGUE/EPILOGUE CONTROL
ADN EOJW
CRD CM
ADN CSPW-EOJW READ EPILOGUE PENDING AND CHARGE REQUIRED
CRD FN
ADN JCDW-CSPW READ PROCEDURE NESTING LEVEL
CRD UN
LDD CM+2
LPC 777
ZJN GPS2 IF NO PROLOGUE OR EPILOGUE ACTIVITY
ADN 1
LMD UN+2
LPN 77
ZJN GPS1 IF IN SEQUENCING PROCEDURE
LDC 6000 SET NOT IN SEQUENCING PROCEDURE
GPS1 LMC 2000 SET SEQUENCING FLAGS
STD CN
GPS2 NFA SHCN READ SHELL CONTROL
CRD CM
LDD CM
ZJN GPS3 IF NO SHELL PROGRAM ACTIVE
LDD CM+4
SHN 21-6
MJN GPS3 IF SHELL CONTROLS SUSPENDABLE (*A* OPTION)
LDC 1000 SET NON-SUSPENDABLE SHELL CONTROLS
RAD CN
GPS3 LDD FN
SHN 21-3
PJN GPS4 IF NO EPILOGUE REQUIRED
LDD CP
ADN FPFW READ PROFILE FILE POINTERS
CRD T3
LDD T3 RETURN ENTRY INDEX
SHN 0-12
LPN 1
STD CN+2
SFA FNT,T5 GET PROFILE FILE FST INFORMATION
ADN FSTG
CRD CM
LDD CM EQUIPMENT NUMBER
STD T5
LDD CM+1
RJM SRA SET RANDOM ADDRESS
NJN GPS6 IF TRACK/SECTOR NOT ON TRACK CHAIN
STD T1 SET *CKA* WORD COUNT
LDD RI RETURN RANDOM ADDRESS
STD CN+3
LDD RI+1
STD CN+4
GPS4 RJM CKA CHECK PARAMETER ADDRESS
CWD CN
GPS5 LJM CPMX RETURN
GPS6 LDK SWET SET ERROR FLAG
STD CM+2
LDC * SET ADDRESS WHERE ERROR DETECTED
STD CM+1
MONITOR CHGM CONDITIONAL HANG
UJN GPS5 RETURN
TITLE SUBROUTINES.
CSU SPACE 4,20
** CSU - CHECK SECONDARY USER COMMAND.
*
* ENTRY (SM) = SECURITY MODE.
* (CN - CN+4) = *CSPW*.
* (UN - UN+4) = WORD 0 OF PARAMETER BLOCK.
* (BA - BA+4) = WORD 2 OF PARAMETER BLOCK WITH STATUS
* FLAGS SET BY *GVP*.
*
* EXIT (A) = 0 IF SECONDARY USER COMMAND ALLOWED.
* (A) .NE. 0 IF NOT SYSTEM ORIGIN JOB AND SYSTEM IS
* OPERATING IN SECURED MODE.
* TO *CPMX* WITH ERROR CODE SET IN CALL BLOCK IF
* SECONDARY USER COMMAND DISALLOWED AND SYSTEM IS NOT
* OPERATING IN SECURED MODE.
*
* USES BA+4, CM - CM+4, CN - CN+4, T4 - T7.
*
* CALLS CKA, CFN, RUI, SFE.
*
* MACROS NFA.
CSU SUBR
LDD CN
SHN 3-2
LPN 10
NJN CSU1 IF CHARGE REQUIRED SET
LDD OT CHECK ORIGIN TYPE
LMK SYOT
ZJN CSUX IF SYSTEM ORIGIN JOB
LDD SM
NJN CSUX IF SYSTEM OPERATING IN SECURE MODE
LDN SSTL CHECK IF SECONDARY USER COMMANDS ENABLED
CRD CM
LDD CM+1
LPN 20
CSU1 NJN CSU2 IF SECONDARY USER COMMANDS DISABLED
NFA SSJN+AACS READ USER ACCESS WORD
CRD T4
* CHECK ALTERNATE FAMILY.
LDD T4+3
SHN 21-11
MJN CSU3 IF VALIDATED FOR ALTERNATE FAMILY
RJM SFE SET (FN - FN+3) IF FAMILY DEFAULTED
LDD CP READ FAMILY EST POINTER
ADN PFCW
CRD CM
SFA EST,CM+3 GET MST ADDRESS
ADK EQDE
CRD CM
LDD CM+4 SET FAMILY ADDRESS
SHN 3
ADN PFGL
CRD CN
RJM CFN COMPARE FAMILIES
ZJN CSU3 IF ALTERNATE FAMILY NOT SPECIFIED
LDN 30 SET ALTERNATE FAMILY NOT ALLOWED ERROR
CSU2 UJN CSU6 SET ERROR CODE
* CHECK ALTERNATE USER NAME.
CSU3 LDD T4+2
LPN 20 *CSAU* BIT
LMN 20
CSU4 ZJP CSUX IF VALIDATED FOR ALTERNATE USER NAME
RJM RUI GET CURRENT USER NAME
LMD UN
NJN CSU5 IF NOT SAME USER NAME
LDD CM+1
LMD UN+1
NJN CSU5 IF NOT SAME USER NAME
LDD CM+2
LMD UN+2
NJN CSU5 IF NOT SAME USER NAME
LDD CM+3
LMD UN+3
SCN 77
ZJN CSU4 IF SAME USER NAME
CSU5 LDN 40 SET ALTERNATE USER NAME NOT ALLOWED ERROR
* RETURN ERROR CODE AND EXIT.
CSU6 RAD BA+4 SET ERROR CODE
RJM CKA WRITE ERROR STATUS
ADN 2
CWD BA
LJM CPMX EXIT
GPV SPACE 4,20
** GPV - GET PARAMETERS FOR VALIDATE USER COMMAND FUNCTION.
*
* ENTRY (OT) = ORIGIN TYPE.
*
* EXIT (A) = 0 IF NOT SECONDARY USER COMMAND.
* (CN - CN+4) = *CSPW*.
* (UN - UN+4) = WORD 0 OF PARAMETER BLOCK.
* (FN - FN+4) = WORD 2 OF PARAMETER BLOCK.
* (BA - BA+4) = WORD 2 OF PARAMETER BLOCK WITH STATUS
* FLAGS SET.
* (PIUE) RESET IF *NO ABORT* FLAG SET.
* (VANA) RESET IF *SPECIAL USER NAMES OK* FLAG SET.
* (VANC) = 1 IF PRIMARY USER COMMAND ALREADY PROCESSED.
* TO *ERR* IF NO *SSJ=* PARAMETER BLOCK DEFINED.
*
* USES T1, BA - BA+4, CM - CM+4, CN - CN+4, FN - FN+4,
* UN - UN+4.
*
* CALLS CKA.
*
* MACROS ABORT, SFA.
GPV SUBR ENTRY/EXIT
LDD CP
ADK SEPW
CRD CM
LDD CM+3
LPN 77
ADD CM+4
NJN GPV1 IF *SSJ=* BLOCK DEFINED
ABORT ERIR * CPM - INCORRECT REQUEST.*
GPV1 LDN 12 CHECK PARAMETER ADDRESS
STD T1
RJM CKA
CRD UN READ USER NAME
CRM PIUB,ON SET ERROR MESSAGE
CRD CM READ OPTIONS
ADN 1
CRD FN READ FAMILY NAME
CRD BA
LDD CM+4 SAVE SPECIAL USER NAMES OK FOR SYOT FLAG
LPN 10
RAM VANA
LDD CM+4 SAVE NO-ABORT OPTION
LPN 4
RAM PIUE
LDD CP READ EJT POINTER
ADN TFSW
CRD CM
ADN CSPW-TFSW READ PRIMARY USER FLAG
CRD CN
SFA EJT,CM
ADN SCLE
CRD CM
LDD CM SET SERVICE CLASS
SHN -6
RAD BA+3
LDD CN
SHN -1
LPN 1
STM VANC SAVE PRIMARY USER FLAG
STD BA+4
LJM GPVX EXIT WITH SECONDARY USER COMMAND STATUS
PIU SPACE 4,20
** PIU - PROCESS INCORRECT USER COMMAND.
*
* ENTRY (A) = 0 IF SECURITY COUNT EXHAUSTED.
* (BA - BA+4) = STATUS WORD.
* (UN - UN+4) = USER NAME AND USER INDEX.
* (VANB) = FAMILY EST ORDINAL.
*
* EXIT TO *CPMX*.
* USER INDEX CLEARED IN PARAMETER BLOCK IF NO ABORT
* OPTION.
*
* USES BA+4, CN+3, T1, T2, T6, FN - FN+4, UN+3 - UN+4.
*
* CALLS CKA, DFM, UFC.
*
* MACROS MONITOR.
PIU BSS 0 ENTRY
STD T6 SAVE (A)
NJN PIU0.1 IF SECURITY COUNT NOT EXHAUSTED
LDN 2 SET SECURITY COUNT EXHAUSTED
RAD BA+4
PIU0.1 LDM VANB RESET FAMILY EST ORDINAL
ZJN PIU1 IF NOT SET
STD CN+3
LDD CP
ADN PFCW
CRD FN
LDD FN+3 SET NEW FAMILY EST ORDINAL FOR *UFC*
STD T2
RJM UFC UPDATE FAMILY COUNT
PIU1 LDD T6
ZJN PIU4 IF USER SECURITY COUNT EXHAUSTED
LDN 0 TERMINATE ACCOUNT FILE MESSAGE
STM PIUB+4
LDM PIUB+3
SCN 77
STM PIUB+3
LDC PIUB-1 SET INDEX
STD T6
PIU2 AOD T6 FIND END OF MESSAGE
LDI T6
ZJN PIU3 IF END ON WORD BOUNDARY
LPN 77
NJN PIU2 IF NOT END OF MESSAGE
LDC 1R.&2R.
PIU3 LMC 2R. SET PERIOD
RAI T6
LDC ACFN+PIUA WRITE MESSAGE TO ACCOUNT FILE
RJM DFM
LDC PIUD&PIUC * INCORRECT USER COMMAND.*
PIU4 LMC PIUC * USER SECURITY COUNT EXHAUSTED.*
RJM DFM
PIUE LDN 0
* LDN 4 (IF JOB IS NOT TO BE ABORTED)
NJN PIU6 IF JOB IS NOT TO BE ABORTED
LDN SVET SET ERROR FLAG
STD CM+1
MONITOR CEFM
PIU5 LJM CPMX EXIT
PIU6 LDN 0 CLEAR USER INDEX
STD UN+4
LDD UN+3
SCN 77
STD UN+3
LDN 12 RETURN ERROR STATUS TO CALLER
STD T1
RJM CKA
CWD UN
ADN 2
CWD BA
UJN PIU5 TERMINATE PROGRAM
PIUA DATA H*SIUN, * ACCOUNT FILE MESSAGE
PIUB BSSZ 5
PIUC DATA C* USER SECURITY COUNT EXHAUSTED.*
PIUD DATA C* INCORRECT USER COMMAND.*
PSV SPACE 4,15
** PSV - PROCESS SECURITY VALIDATIONS.
*
* DETERMINE IF THE PRIMARY USER COMMAND CAN BE PROCESSED,
* GIVEN THE USER-S VALIDATIONS AND THE APPLICABLE ACCESS
* LEVEL LIMITS. THIS SUBROUTINE IS ONLY NEEDED FOR *SYOT*
* JOBS (SUCH AS *DIS* AND *PTFS*) WHICH HAVE NOT HAD
* A *USER* COMMAND VALIDATED BY *0VJ*.
*
* ENTRY (T3) = FWA OF VALIDATION BLOCK.
*
* EXIT (A) = 0 IF NO ERROR.
* *JSCW* UPDATED.
* NEW ACCESS LEVEL LIMITS SET IN EJT.
*
* USES CM - CM+4, CN - CN+4.
*
* CALLS RUI.
*
* MACROS MONITOR, SFA.
PSV SUBR ENTRY/EXIT
LDD T3 SET VALIDATION BLOCK ADDRESS
RAM PSVA
LDD MA SET UP *VSAM* PARAMETERS
CWM 5*ASVW,ON
PSVA EQU *-1 (FWA OF *ASVW* IN VALIDATION BLOCK)
LDD OT
STD CM+2
LDD CP SET JOB ACCESS LEVEL LIMITS
ADN TFSW
CRD CN
SFA EJT,CN
ADK PRFE
CRD CN
LDD CN+2 SET UPPER ACCESS LEVEL LIMIT
LPN 7
STD CM+3
LDD CN+2 SET LOWER ACCESS LEVEL LIMIT
LPN 70
SHN -3
STD CM+4
LDN VJCS VALIDATE JOB CREATION PARAMETERS
STD CM+1
MONITOR VSAM
LDD CM+1
NJP PSVX IF JOB MAY NOT BE CREATED
* UPDATE *JSCW* IN CONTROL POINT AREA.
LDD CP GET CURRENT JOB ACCESS LEVEL
ADK JSCW
CRD CN
LDD CN+1
SHN -11
SBD CM+4
MJN PSV1 IF CURRENT LEVEL .LT. NEW LOWER LIMIT
ADD CM+4 KEEP CURRENT VALUE FOR JOB ACCESS LEVEL
STD CM+4
PSV1 LDD MA SET UP *JSCW* WORD
CRD CN
LDD CM+4 RESET JOB ACCESS LEVEL
SHN 11
LMD CN+1
LPC 7000
LMD CN+1
STD CN+1
LDD CM+3 RESET UPPER ACCESS LEVEL LIMIT
SHN 11
LMD CN+2
LPC 7000
LMD CN+2
STD CN+2
LDD CP RESET *JSCW*
ADK JSCW
CWD CN
* SET NEW JOB ACCESS LEVEL LIMITS IN EJT ENTRY.
LDN ZERL
CRD CN
LDD CM+3 SET UPPER ACCESS LEVEL LIMIT
STD CN+4
LDD CM+4 SET LOWER ACCESS LEVEL LIMIT
SHN 3
RAD CN+4
LDC 24D*100 SET FIELD POSITION
STD CN+1
LDN 6 SET LENGTH OF ACCESS LEVEL FIELD
STD CN
LDD CP GET ADDRESS OF EJT ENTRY
ADK TFSW
CRD CM
SFA EJT,CM
ADN PRFE
STD CM+4 SET UP *UTEM* PARAMETERS
SHN -14
STD CM+3
LDN 0
STD CM+2
LDN 1
STD CM+1
LDD MA
CWD CN
MONITOR UTEM UPDATE EJT ENTRY
LDN 0 RETURN NORMAL STATUS
LJM PSVX RETURN
RPE SPACE 4,15
** RPE - RETURN PASSWORD EXPIRATION DATE.
*
* ENTRY (T3) = FWA OF ACCOUNT BLOCK RECORD.
*
* EXIT (CM - CM+4) = 42/0, 18/PASSWORD EXPIRATION DATE.
*
* USES T0, CM - CM+4.
RPE SUBR ENTRY/EXIT
LDN ZERL CLEAR REPLY WORD
CRD CM
LDD T3 SET ADDRESSES
ADN 3
ADC APWI*5 INTERACTIVE PASSWORD
* ADC APSW*5 (BATCH PASSWORD)
RPEA EQU *-1 (ADDRESS OF PASSWORD IN VALIDATION BLOCK)
STD T0
LDI T0 STORE PASSWORD EXPIRATION
LPN 77
STD CM+3
AOD T0
LDI T0
STD CM+4
UJN RPEX RETURN
RUB SPACE 4,30
** RUB - RETURN USER BLOCK.
*
* RETURN USER BLOCK BY EITHER READING THE SYSTEM SECTOR
* OR CALLING *0AV*.
*
* ENTRY (UN - UN+3) = USER NAME.
* (FN - FN+3) = FAMILY NAME.
*
* EXIT (A) = 0 IF INCORRECT USER NAME.
* .LT. 0, IF MASS STORAGE ERROR ENCOUNTERED.
* (T1 - T2) = USER INDEX.
* (T3) = FWA OF ACCOUNT RECORD BLOCK.
* (T4) = 0 IF USER INDEX .LT. *AUIMX*.
* (T5) = FAMILY EST ORDINAL.
* (T6) = SECURITY COUNT.
* (TNSS) = 0, IF SYSTEM SECTOR NOT READ.
*
* THE JOB IS ROLLED OUT TO WAIT FOR THE DEVICE TO BECOME
* ACCESSIBLE IF A NON-SUBSYSTEM JOB ENCOUNTERED A
* RECOVERABLE READ/WRITE ERROR ON THE DEVICE.
*
* USES CM - CM+4, T1 - T7, UN+3 - UN+4.
*
* CALLS CJR, RUI, RSS, *0AV*.
*
* MACROS ENDMS, EXECUTE, NFA, SETMS.
RUB SUBR ENTRY/EXIT
LDN ZERL CLEAR *TNSS*
CRM TNSS,ON
LDM VANC
NJN RUB1 IF SECONDARY USER COMMAND
RJM RUI READ USER ID WORD
NJN RUB2 IF FIRST USER COMMAND VALIDATED BY *0VJ*
RUB1 LJM RUB5 CALL *0AV* TO READ VALIDATION FILE
* USE VALIDATION BLOCK FROM JOB INPUT FILE SYSTEM SECTOR.
* SET DIRECT CELLS TO MATCH *0AV* EXIT CONDITIONS.
RUB2 NFA FNTN+FSTL READ INPUT FILE FST WORD
CRD T5
SETMS IO READ JOB INPUT FILE SYSTEM SECTOR
LDN 0
RJM RSS
ZJN RUB2.2 IF SUCCESSFUL READ
PJN RUB2.1 IF SYSTEM SECTOR ERROR OTHER THAN READ
RJM CJR CHECK IF THE JOB IS ROLLABLE
RUB2.1 LCN 0 INDICATE MASS STORAGE ERROR
LJM RUBX RETURN
RUB2.2 ENDMS
LDC VASS SET FWA OF USER ACCOUNT BLOCK
STD T3
LDM AUIN*5+4,T3 USER INDEX
STD T2
LDM AUIN*5+3,T3
LPN 77
STD T1
LDM AHSC*5+1,T3 SECURITY COUNT
SHN -6
STD T6
LDI T3
ZJN RUB5 IF NO ACCOUNT RECORD BLOCK
LDD T1
SHN 14
LMD T2
ADC -AUIMX
PJN RUB3 IF UI .GE. AUIMX
LDN 0
UJN RUB4 SET UI .LT. AUIMX
RUB3 LDN 1
RUB4 STD T4
UJN RUB6 CONTINUE
* READ USER BLOCK FROM VALIDATION FILE BY CALLING *0AV*.
RUB5 LDN 0 SET NORMAL *0AV* CALL
STD UN+4
LDD UN+3
SCN 77
STD UN+3
EXECUTE 0AV,L0AV
PJN RUB6 IF NO MASS STORAGE ERROR ENCOUNTERED
RJM CJR CHECK IF THE JOB IS ROLLABLE
LCN 0 INDICATE MASS STORAGE ERROR
UJN RUB7 RETURN
RUB6 LDD T1 ENTER USER INDEX
RAD UN+3
LPN 37
SHN 14
LMD T2
ZJN RUB7 IF INCORRECT USER NAME
STD UN+4
RUB7 LJM RUBX RETURN
RUI SPACE 4,10
** RUI - READ USER IDENTIFICATION WORD.
*
* EXIT (A) = (RUIA) = FIRST BYTE OF CURRENT USER NAME.
* (CM - CM+4) = CURRENT USER NAME FROM *SSJ=* BLOCK
* OR FROM CPA.
*
* USES CM - CM+4.
*
* MACROS NFA.
RUI1 LDD CP GET *UIDW* FROM CONTROL POINT AREA
ADN UIDW
RUI2 CRD CM READ *UIDW*
LDD CM
STM RUIA
RUI SUBR ENTRY/EXIT
LDD CP
ADK SEPW
CRD CM
LDD CM+3
LPN 77
ADD CM+4
ZJN RUI1 IF NO *SSJ=* BLOCK
NFA SSJN+UIDS GET *UIDW* FROM *SSJ=* BLOCK
UJN RUI2 READ *UIDW*
RUIA CON 0 FIRST BYTE OF CURRENT USER NAME
VPW SPACE 4,15
** VPW - VALIDATE PASSWORD.
*
* ENTRY (T3) = FWA OF ACCOUNT BLOCK RECORD.
* (FN - FN+4) = WORD 1 OF PARAMETER BLOCK.
*
* EXIT (A) = 0 IF LEGAL PASSWORD.
* (CN+3 - CN+4) = PASSWORD EXPIRATION DATE.
*
* USES CM - CM+4, CN - CN+4, FN - FN+4.
*
* CALLS CFN.
*
* MACROS MONITOR.
VPW3 LDN 0 INDICATE LEGAL PASSWORD
VPW SUBR ENTRY/EXIT
LDK ZERL CLEAR PASSWORD EXPIRATION DATE
CRD CN
LDD FN+4
LPN 1
NJN VPW3 IF PASSWORD NOT REQUIRED
LDD T3 SET ADDRESSES
ADC APWI*5 VALIDATE INTERACTIVE PASSWORD
* ADC APSW*5 (VALIDATE BATCH PASSWORD)
VPWA EQU *-1 (ADDRESS OF PASSWORD IN VALIDATION BLOCK)
STM VPWD
ADN 3
STM VPWB
ADN 1
STM VPWC
* PROCESS PASSWORD EXPIRATION DATE.
LDM * CHECK PASSWORD EXPIRATION DATE
VPWB EQU *-1 (FWA OF PASSWORD EXPIRATION DATE)
LPN 77
STD CM+3
SHN 14
LMM *
VPWC EQU *-1 (FWA+1 OF PASSWORD EXPIRATION DATE)
ZJN VPW2 IF NONEXPIRING PASSWORD
STD CM+4
LDN VEDS VALIDATE EXPIRATION DATE
STD CM+1
MONITOR VSAM
LDD CM+1
ZJN VPW2 IF PASSWORD NOT EXPIRED
VPW1 LJM VPWX RETURN
VPW2 LDN REPS ENCRYPT SUPPLIED PASSWORD
STD CM+1
LDD MA
CWD FN
MONITOR RDCM
LDD MA
CRD FN
CWM *,ON COPY LEGAL PASSWORD
VPWD EQU *-1 (FWA OF PASSWORD)
SBN 1
CRD CN READ LEGAL PASSWORD
RJM CFN COMPARE PASSWORDS
UJN VPW1 RETURN
SPACE 4,10
** COMMON DECKS.
*CALL COMPSFE
*CALL COMPSFN
*CALL COMPSRA
*CALL COMPSRU
SPACE 4,10
** BUFFERS.
ALMT EQU * *ALMW*
ACLT EQU ALMT+5 *ACLW*
AACT EQU ACLT+5 *AACW*
BUFL EQU AACT+5 LWA+1 OF OVERLAY
ERRNG L0AV-5-BUFL OVERFLOW INTO *0AV*
SPACE 4,10
OVERFLOW OVL,EPFW
OVERLAY (USER ACCOUNTING FUNCTIONS.)
SLL SPACE 4,15
*** FUNCTION 3.
* SET TIME AND SRU LIMITS
*
* ENTRY (IR+3 - IR+4) = 6/FN,18/PARAM
* FN = 0 FOR TIME LIMIT
* FN = 1 FOR SRU JOB STEP LIMIT
* FN = 2 FOR SRU ACCOUNT BLOCK LIMIT
* PARAM = SECONDS FOR TIME, UNITS FOR SRU.
* IF PARAM IS ANY OF THE FOLLOWING:
* 1. GREATER THAN THE MAXIMUM FOR WHICH
* THE USER IS VALIDATED,
* 2. BETWEEN 77770B AND 777777B (TIME
* LIMIT),
* 3. GREATER THAN OR EQUAL TO 655400B (SRU
* LIMIT),
* THE TIME OR SRU LIMIT WILL BE SET TO THE
* MAXIMUM FOR WHICH THE USER IS VALIDATED
* (INFINITE IF UNLIMITED VALIDATION).
*
* IF FN=1 AND PARAM IS GREATER THAN THE CURRENT ACCOUNT BLOCK
* SRU LIMIT, BOTH THE JOB STEP AND ACCOUNT BLOCK SRU LIMITS ARE
* SET TO PARAM. IF FN=2 AND PARAM IS LESS THAN THE CURRENT JOB
* STEP SRU LIMIT, BOTH THE ACCOUNT BLOCK AND JOB STEP SRU
* LIMITS ARE SET TO PARAM.
SLL ENTRY
LDD IR+3
SHN -6
STD T1
SBN NOP
MJN SLL2 IF LEGAL SUB FUNCTION
ABORT ERIR * CPM - INCORRECT REQUEST.*
SLL1 ABORT ERNV * XX NOT VALIDATED.*
SLL2 LDD T1
ZJN SLL3 IF TIME LIMIT REQUEST
LDC SHNI+74 *SHN -3*
STM SLLA
LDC -5540B *ADC -65540*
STM SLLD+1
AOM SLLD
LDC 2RSL&2RTL SET *SL* RESOURCE TYPE
SLL3 LMC 2RTL SET RESOURCE TYPE
STM ERRA
LDN 0
STD T2
STD CM+2
LDD IR+3 CHECK REQUESTED LIMIT
LPN 77
STD CM+3
SHN 14
LMD IR+4
STD CM+4
ZJN SLL1 IF ZERO LIMIT
SLLA PSN PASS
* SHN -3 IF SRU LIMIT PROCESSING
ADC -77770
SLLD EQU *-2
* ADC -65540 (SRU LIMIT PROCESSING)
MJN SLL5 IF NOT REQUEST FOR VALIDATED MAXIMUM
SLL4 LCN 0
STD CM+4
LPN 77
STD CM+3
LDC STDI+CM+4 SET UP TO SAVE VALIDATION LIMIT
STM STLA
SBN 1
STM STLB
* CHECK AGAINST VALIDATION LIMIT.
SLL5 LDD CP READ VALIDATION PARAMETERS
ADN ALMW
CRD CN
LDM TOPN,T1 JUMP TO PROCESSOR
STM SLLB
LJM *
SLLB EQU *-1
* SET TIME LIMIT.
STL LDC STL4 SET RETURN ADDRESS
STM SLLC
LDD CN+2
RJM TLI CONVERT INDEX TO VALUE
STL1 MJN STL3 IF UNLIMITED
SHN 3 MULTIPLY BY 10B
STD T2 SAVE BOTTOM HALF
SHN -14
STD T1 SAVE TOP HALF
LDD T2
STLA SBD CM+4
* STD CM+4 (REQUEST FOR VALIDATED MAXIMUM)
MJN STL2 IF BORROW NEEDED
AOD T1
STL2 SOD T1
STLB SBD CM+3
* STD CM+3 (REQUEST FOR VALIDATED MAXIMUM)
PJN STL3 IF NOT ABOVE USER MAXIMUM
LDD IR+3 RESTORE RESOURCE TYPE
SHN -6
STD T1
LJM SLL4 PROCESS AS REQUEST FOR VALIDATED MAXIMUM
STL3 LJM * RETURN TO PROCESSOR
SLLC EQU *-1
STL4 LDN RLTL SET TIME LIMIT SUBFUNCTION
STD CM+1
MONITOR RLMM
LJM CPMX EXIT
* SET JOB STEP LIMIT.
SJS LDC SJS2
STM SLLC
SJS1 LDD CN+2 CHECK VALIDATION LIMIT
RJM SLI
UJP STL1 CHECK LIMIT WITHIN ALLOWED RANGE
SJS2 LDD CP GET LIMIT WORD FROM CONTROL POINT
ADN STLW
CRD CN
LDD CN+1 GET ACCOUNT BLOCK LIMIT IN USABLE FORMAT
SCN 77
SHN 6
LMD CN
SHN 6
STD CN
SHN -14
SBD CM+3
MJN SJS3 IF GREATER THAN ACCOUNT BLOCK LIMIT
NJN SJS4 IF LESS THAN ACCOUNT BLOCK LIMIT
LDD CN
SBD CM+4
PJN SJS4 IF NOT GREATER THAN ACCOUNT BLOCK LIMIT
SJS3 RJM SAL SET ASL TO REQUESTED JSL FIRST
SJS4 LDN RLSL SET SRU LIMIT SUBFUNCTION
STD CM+1
MONITOR RLMM SET SRU LIMIT
LJM CPMX
* SET ACCOUNT BLOCK LIMIT.
SAB LDC SAB1 SET RETURN ADDRESS
STM SLLC
LJM SJS1
SAB1 LDD CP GET LIMIT WORD FROM CONTROL POINT
ADN STLW
CRD CN
ADN SRJW-STLW
CRD T1
LDD T1+2 COMPARE REQUEST TO CURRENT JOB STEP LIMIT
SCN 77
SHN 6
LMD T1+1
SHN 6
STD T1+1
SHN -14
STD T1
LDD CM+3 REQUESTED ACCOUNT BLOCK - JOB STEP LIMIT
SBD T1
MJN SAB2 IF JOB STEP GREATER THAN REQUEST
NJN SAB3 IF REQUESTED GREATER THAN JOB STEP
LDD CM+4
SBD T1+1
PJN SAB3 IF REQUESTED GREATER THAN JOB STEP
SAB2 LDD MA SAVE REQUESTED ACCOUNT BLOCK LIMIT
CWD CM
CRD BA
LDN RLSL SET JSL TO REQUESTED ASL FIRST
STD CM+1
MONITOR RLMM
LDD MA RESTORE REQUESTED ACCOUNT BLOCK LIMIT
CWD BA
CRD CM
SAB3 RJM SAL SET ACCOUNT BLOCK LIMIT
LJM CPMX RETURN
TOPN BSS 0 TABLE OF SUB-FUNCTION CODE PROCESSORS
LOC 0
CON STL SET TIME LIMIT
CON SJS SET JOB STEP LIMIT
CON SAB SET ACCOUNT BLOCK LIMIT
LOC *O
NOP EQU *-TOPN
RLM SPACE 4,10
*** FUNCTION 17.
* RETRIEVE LIMIT TO (PARAMETER).
*
* ENTRY (IR+3 - IR+4) = 6/FN,18/PARAM
* FN = 0 FOR TIME LIMIT
* FN = 1 FOR SRU JOB STEP LIMIT
* FN = 2 FOR SRU ACCOUNT BLOCK LIMIT
* PARAM = SECONDS FOR TIME
* UNITS FOR SRU
RLM ENTRY
LDN ZERL
CRD CM
LDD IR+3 SET OPTION CODE
SHN -6
NJN RLM1 IF NOT TIME
LDD CP RETURN TIME LIMIT VALUE
ADN CPJW
UJN RLM2
RLM1 SHN -1
NJN RLM4 IF NOT JOB STEP SRU
LDD CP RETURN JOB STEP SRU LIMIT
ADN SRJW
RLM2 CRD CN
LDD CN+2
SCN 77
SHN 6
LMD CN+1
RLM3 SHN 6
STD CM+4
SHN -14
STD CM+3
LDD IR+3 MAKE ADDRESS LEGAL FOR CKA ROUTINE
LPN 37
STD IR+3
RJM CKA CHECK RETURN ADDRESS
CWD CM
LJM CPMX EXIT
RLM4 LDD CP RETURN ACCOUNT BLOCK LIMIT
ADN STLW
CRD CN
LDD CN+1
SCN 77
SHN 6
LMD CN
UJN RLM3
RAI SPACE 4,15
*** FUNCTION 30.
* PROVIDE ACCOUNTING INFORMATION.
*
* EXIT JOB ACCOUNTING INFORMATION RETURNED TO USER.
*
* PARAMETER BLOCK FORMAT -
*
*T ADDR 18/ 0,42/ SRU ACCUMULATOR (MICRO UNITS * 10)
*T, 60/ CP ACCUMULATOR (QUARTER NANOUNITS)
*T, 20/ MS,20/ MT,20/ PF
*T, 20/ OD,20/ MP,20/ AA
*T, 31/ 0, 29/ AC
* WHERE
* AA = ACCUMULATED ADDER ACTIVITY.
* MP = ACCUMULATED MAP ACTIVITY.
* MS = ACCUMULATED MASS STORAGE ACTIVITY.
* MT = ACCUMULATED MAGNETIC TAPE ACTIVITY.
* OD = ACCUMULATED OPTICAL DISK ACTIVITY.
* PF = ACCUMULATED PERMANENT FILE ACTIVITY.
* AC = ACCUMULATED APPLICATION UNIT CHARGE ACTIVITY.
RAI ENTRY
LDN ACTWL PICK NO OF ACCOUNTING WORDS
STD T1 NUMBER OF WORDS TO READ
LDD CP
ADN ACTW ACCOUNTING INFORMATION
CRM STMT,T1
LDD CP READ SECOND ACCOUNTING BLOCK
ADK AC1W
CRM STMT+ACTWL*5,ON
LDN 0 CLEAR ALL BUT ACCUMULATORS
STM SRUW*5-ACTW*5+STMT LIMIT FLAGS
LDM ADAW*5-ACTW*5+STMT+3
LPC 377
STM ADAW*5-ACTW*5+STMT+3
LDM SRUW*5-ACTW*5+STMT+1 OVERFLOW FLAGS
LPN 37
STM SRUW*5-ACTW*5+STMT+1
LDN 2 GET MAP AND OPTICAL ACCUMULATORS
STD T5
RAI1 LDM MPAW*5-AC1W*5+STMT+ACTWL*5+2,T5
SHN 21-3
STM ADAW*5-ACTW*5+STMT,T5
SHN 13-21
LPC 7400
RAM ADAW*5-ACTW*5+STMT+1,T5
SOD T5
PJN RAI1 IF NOT LAST MAP/OPTICAL BYTE
LDM MPAW*5-AC1W*5+STMT+ACTWL*5+1 MOVE FINAL 4 BITS
SHN 13-3
LPC 7400
RAM ADAW*5-ACTW*5+STMT
LDD CP READ AUC ACCUMULATOR
ADK AUCW
CRM STMT+ACTWL*5,ON
LDN 0 CLEAR ALL BUT ACCUMULATOR
STM AUCW*5-AC1W*5+STMT+ACTWL*5
STM AUCW*5-AC1W*5+STMT+ACTWL*5+1
LDM AUCW*5-AC1W*5+STMT+ACTWL*5+2
LPN 5
STM AUCW*5-AC1W*5+STMT+ACTWL*5+2
AOD T1 SET NUMBER OF WORDS TO WRITE
RJM CKA
CWM STMT,T1 WRITE TO CENTRAL
LJM CPMX
SCF SPACE 4,40
*** FUNCTION 42.
* BEGIN ACCOUNT BLOCK.
*
* ENTRY (IR+3 - IR+4) = 6/A, 18/B
* WHERE
* A = CPM RECALL COUNT.
* B = PARAMETER BLOCK ADDRESS.
*
* PARAMETER BLOCK FORMAT -
*
*T STMT 12/ M1,12/ M2,12/ M3,12/ M4,12/ AD
*T, 6/ISV, 30/0, 6/A, 18/B
*T, 60/ CHARGE NUMBER
*T, 60/ PROJECT NUMBER
*T, 60/ PROJECT NUMBER
*T, 60/ ACCOUNT FILE MESSAGE
*T, 60/ ACCOUNT FILE MESSAGE
*T, 60/ ACCOUNT FILE MESSAGE
*T, 60/ ACCOUNT FILE MESSAGE
*T, 60/ ACCOUNT FILE MESSAGE
* WHERE
* M1, M2, M3, M4, AD ARE SRU MULTIPLIERS.
* ISV = INDEX OF SRU VALIDATION LIMIT.
* A = 0, IF PROJECT IS FIRST ENTRY IN LEVEL-3 BLOCK.
* .NE. 0, IF PROJECT IS SECOND ENTRY IN LEVEL-3 BLOCK.
* B = PROFILE FILE LEVEL-3 BLOCK RANDOM ADDRESS.
*
* EXIT ACCOUNT BLOCK BEGUN OR CHANGED.
* ACCUMULATORS DISPLAYED IN USERS DAYFILE AND ACCOUNT
* FILE UNLESS FIRST CHARGE COMMAND.
* CHARGE-PROJECT MESSAGE DISPLAYED IN ACCOUNT FILE.
* CHARGE REQUIRED CLEARED.
* ORIGINAL AND CURRENT SRU VALIDATION LIMIT RESET IF
* NECESSARY.
* DAF USER COUNT OF OLD PROFILE FAMILY IS DECREMENTED.
* DAF USER COUNT OF NEW PROFILE FAMILY IS INCREMENTED.
BAB ENTRY
LDD IR+3 RECALL COUNT
STD RC
LPN 77
STD IR+3 CREATE VALID ADDRESS FIELD
LDN 10D
STD T1
RJM CKA
CRM STMT,T1 GET SRU PARAMS AND CHARGE-PROJECT MESSAGE
* SET VALIDATION PARAMETERS IN CONTROL POINT AREA AND NFL.
NFA SSJN+ALMS GET SRU VALIDATION LIMIT
CRD CN
LDD CN
SHN -6
NJN BAB1 IF ORIGINAL SRU VALIDATION LIMIT SET
LDD CN+2 SET ORIGINAL SRU VALIDATION LIMIT
LPN 77
SHN 6
RAD CN
BAB1 LDM STMT+1*5 SET SRU VALIDATION LIMIT
SHN -6
LMD CN+2
LPN 77
LMD CN+2
STD CN+2
NFA SSJN+ALMS
CWD CN
ADK SSJN-ALMS-CHGN WRITE CHARGE AND PROJECT NUMBER
CWM STMT+2*5,TR
LDD CP READ PROFILE PARAMETERS
ADN FPFW
CRM L0AU,ON
ADN CSPW-FPFW-1 CLEAR CHARGE REQUIRED
CRD BA
LDD BA
SCN 4
STD BA
LDD CP
ADN CSPW
CWD BA
LDM L0AU+2 SAVE PROFILE FNT ORDINAL
STM SPPA
LDM L0AU CHECK IF FIRST CHARGE VALIDATED
SHN 21-13
MJN BAB2 IF NOT FIRST CHARGE NUMBER
* BEGIN ACCOUNT BLOCK.
LDD MA SET SRU PARAMETERS
CWM STMT,ON
LDN ABBF
STD CM+1 SET *ACTM* SUB-FUNCTION (ABBF)
MONITOR ACTM BEGIN ACCOUNT BLOCK
LDC 2RAB
STM STMT+5*5 CHANGE MESSAGE FROM *ACCN* TO *ABCN*
UJN BAB3 SET PROFILE PARAMETERS
* UPDATE PROJECT PROFILE FILE.
BAB2 RJM UPF UPDATE PROJECT PROFILE FILE
LDC STMT ADDRESS OF NEW MULTIPLIER INDICES
RJM IAM ISSUE ACCOUNTING MESSAGES
STD T1
RJM CUF CHECK FOR PROFILE FILE UPDATE FAILURE
* SET PROFILE PARAMETERS AND DISPLAY CHARGE-PROJECT MESSAGE.
BAB3 RJM SPP SET PROFILE PARAMETERS
LDC ACFN+STMT+5*5
RJM DFM ISSUE MESSAGE TO ACCOUNT FILE
LJM CPMX RETURN
IAA SPACE 4,25
*** FUNCTION 77.
* INITIATE APPLICATION ACCOUNTING.
*
* ENTRY (IR+3 - IR+4) = 24/ADDR
* WHERE
* ADDR = PARAMETER BLOCK ADDRESS.
*
* PARAMETER BLOCK FORMAT -
*
*T,ADDR 24/SC, 36/0
* WHERE
* SC = 4-CHARACTER ALPHANUMERIC DISPLAY CODE SOFTWARE
* CODE.
*
* EXIT ACCOUNT DAYFILE MESSAGE ISSUED.
* APPLICATION ACCOUNTING IN PROCESS BIT SET IN CONTROL
* POINT AREA WORD.
*
* USES BA - BA+4, CM - CM+4.
*
* CALLS CKA, DFM.
*
* MACROS ABORT.
IAA ENTRY
LDD CP READ APPLICATION ACCOUNTING CONTROL WORD
ADN FPFW
CRD BA
LDD BA CHECK IF PROGRAM VALIDATED FOR FUNCTIONS
SHN 21-11
MJN IAA1 IF APPLICATION ACCOUNTING IN PROCESS
SHN 11-10
MJN IAA2 IF PROGRAM VALIDATED FOR FUNCTION
IAA1 ABORT ERAU * INCORRECT APPLICATION ACCOUNTING CALL.*
IAA2 RJM CKA CHECK ADDRESS
CRD CM READ USER PARAMETER WORD
LDD CM+2 CHECK CONTENTS OF PARAMETER WORD
ADD CM+3
ADD CM+4
NJN IAA1 IF INCORRECT PARAMETER WORD
LDD CM
STM IAAA+3 SAVE FOR POSSIBLE MESSAGE
SHN -6
ZJN IAA1 IF INCORRECT CHARACTER
SBN 1R9+1
PJN IAA1 IF INCORRECT CHARACTER
LDD CM
LPN 77
ZJN IAA1 IF INCORRECT CHARACTER
SBN 1R9+1
PJN IAA1 IF INCORRECT CHARACTER
LDD CM+1
STM IAAA+4 SAVE FOR POSSIBLE MESSAGE
SHN -6
IAA3 ZJN IAA1 IF INCORRECT CHARACTER
SBN 1R9+1
IAA4 PJN IAA1 IF INCORRECT CHARACTER
LDD CM+1
LPN 77
ZJN IAA3 IF INCORRECT CHARACTER
SBN 1R9+1
PJN IAA4 IF INCORRECT CHARACTER
LDC ACFN+IAAA ISSUE ACCOUNT FILE MESSAGE
RJM DFM
LDD BA SET ACCOUNTING IN PROCESS
ADC 1000
STD BA
LDD CP REWRITE ACCOUNTING CONTROL WORD
ADN FPFW
CWD BA
LJM CPMX EXIT
* ACCOUNT FILE MESSAGE.
IAAA DATA C*UBAU, .*
SJB SPACE 4,20
*** FUNCTION 106.
* SET JOB CHARACTERISTICS.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF 2 WORD PARAMETER BLOCK.
*T 42/ UJN,18/0
*T, 36/0,12/ OP,12/ DC
* UJN USER JOB NAME, 1 TO 7 ALPHANUMERIC OR ASTERISK (*)
* CHARACTERS, LEFT JUSTIFIED WITH BINARY ZERO FILL.
* IF UJN = 0, NO CHANGE OF USER JOB NAME.
* OP END OF JOB OPTIONS, SPECIFIED BY 2 DISPLAY
* CODE CHARACTERS.
* *SU* = SUSPEND JOB (VALID ONLY FOR TXOT JOBS).
* *TJ* = TERMINATE JOB.
* 0 = NO CHANGE TO END OF JOB OPTION.
* DC DISPOSITION OF OUTPUT AT END OF JOB TIME, SPECIFIED
* BY 2 DISPLAY CODE CHARACTERS.
* *TO* = QUEUE OUTPUT TO TXOT QUEUE.
* *NO* = DO NOT QUEUE OUTPUT FILES.
* *DF* = QUEUE OUTPUT TO JOB DEFAULT QUEUE.
* 0 = NO CHANGE TO OUTPUT DISPOSITION OPTION.
*
* EXIT THE JOB IS ROLLED OUT TO WAIT FOR THE DEVICE TO BECOME
* ACCESSIBLE IF A NON-SUBSYSTEM JOB ENCOUNTERED A
* RECOVERABLE READ/WRITE ERROR ON THE DEVICE.
SJB ENTRY
LDN 2 SET WORD COUNT
STD T1
RJM CKA CHECK PARAMETER BLOCK ADDRESS
CRD FN
ADN 1
CRD BA
LDD CP GET END OF JOB OPTIONS
ADK EOJW
CRD CM
LDD BA+3 GET END OF JOB OPTION
ZJN SJB1 IF NO CHANGE TO END OF JOB OPTION
LDD CM
LPC 777
STD CM
LDD BA+3
LMC 2RTJ
ZJN SJB1 IF TERMINATE JOB OPTION SELECTED
ERRNZ TJJT CODE DEPENDS ON VALUE
LMC 2RSU&2RTJ
NJN SJB3 IF INCORRECT JOB OPTION CODE
LDD OT
LMK IAOT
NJP SJB8 IF NOT INTERACTIVE JOB
LDC SUJT*1000 SET SUSPEND JOB OPTION
RAD CM
SJB1 LDD BA+4
ZJN SJB5 IF NO CHANGE TO OUTPUT DISPOSITION OPTION
LDN TODOL
STD T1
SJB2 SOD T1
PJN SJB4 IF NOT END OF TABLE
SJB3 ABORT ERAE * CPM - ARGUMENT ERROR.*
SJB4 LDM TODO,T1 CHECK FOR MATCH ON DISPOSITION OPTION
LMD BA+4
NJN SJB2 IF NO MATCH
LDD CM SET NEW QUEUE FILE DISPOSITION
SHN 0-6+22
SCN 7
ADD T1
SHN 6-0
STD CM
SJB5 LDD CP WRITE END OF JOB OPTIONS
ADK EOJW
CWD CM
LDD FN
ZJN SJB7 IF NO USER JOB NAME CHANGE
RJM VFN VERIFY USER JOB NAME
ZJN SJB3 IF INCORRECT USER JOB NAME
RJM RIS READ INPUT FILE SYSTEM SECTOR
STD FN+4 WRITE USER JOB NAME TO INPUT SYSTEM SECTOR
LDD FN+3
SCN 77
STD FN+3
LDD MA
CWD FN
CRM JNSS,ON
SETMS IO,RW UPDATE INPUT FILE SYSTEM SECTOR
RJM WSS
PJN SJB6 IF NO MASS STORAGE ERRORS ENCOUNTERED
RJM CJR CHECK IF THE JOB IS ROLLABLE
UJN SJB9 EXIT
SJB6 ENDMS
SJB7 UJN SJB9 EXIT
SJB8 LDC =C* INCORRECT END OF JOB OPTION SPECIFIED.*
RJM DFM ISSUE DAYFILE MESSAGE
SJB9 LJM CPMX EXIT
TODO SPACE 4,10
** TODO - TABLE OF OUTPUT DISPOSITION OPTIONS.
*
* ONE WORD PER ENTRY, INDEXED BY OUTPUT DISPOSITION CODE.
.TODOL MAX QOJT,NOJT,TTJT
TODOL EQU .TODOL+1 LENGTH OF TABLE
TODO INDEX
INDEX QOJT,2RDF
INDEX NOJT,2RNO
INDEX TTJT,2RTO
INDEX TODOL
CSV SPACE 4,35
*** FUNCTION 124.
* CHANGE SERVICE CLASS.
*
* ENTRY (IR+3 - IR+4) = PARAMETER BLOCK ADDRESS.
*
* PARAMETER BLOCK FORMAT.
*
*T ADDR 48/ 0, 6/ ER, 6/ SC
*
* SC = NEW SERVICE CLASS.
* ER = ERROR STATUS RETURNED ON A SERVICE CLASS CHANGE.
* = 0 IF NO ERROR.
* = 1 IF *SC* IS NOT A DEFINED SERVICE CLASS.
* = 2 IF SERVICE CLASS INCORRECT FOR THE USER.
* = 3 IF SERVICE CLASS FULL.
* = 4 IF MASS STORAGE ERROR ENCOUNTERED.
*
* EXIT SERVICE CLASS UPDATED IN EJT ENTRY OF JOB AND
* IN THE INPUT FILE SYSTEM SECTOR.
*
* IF A NON-SUBSYSTEM JOB ENCOUNTERED A RECOVERABLE
* READ/WRITE ERROR ON THE DEVICE, THE JOB IS ROLLED OUT
* TO WAIT FOR THE DEVICE TO BECOME ACCESSIBLE.
*
* USES BA, T1, T3, CM - CM+4, CN - CN+4, FN - FN+4.
*
* CALLS CJR, CKA, CSC, RIS, VSP, WSS.
*
* MACROS ENDMS, NFA, SETMS, SFA.
CSV ENTRY ENTRY/EXIT
CSV0 LDN 0 SET WORD COUNT
STD T1
RJM CKA CHECK ADDRESS
CRM STMT,ON GET PARAMETER WORD
LDD CP CHECK IF SUBSYSTEM OR SSJ= JOB
ADN JCIW
CRD CM
ADN SEPW-JCIW
CRD CN
LDD CM+2
NJN CSV1 IF SUBSYSTEM
LDD CN
LPN 4 SET IF SSJ= JOB
CSV1 STD T3
NFA SCVN GET SERVICE CLASS VALIDATION MASK
CRD CN
LDM STMT+4
LPN 77
STD T7
RJM VSP VALIDATE SERVICE CLASS
CSV1.1 STD BA RETURN ERROR STATUS
SHN 6
STD T3
LDD OT
LMN IAOT
ZJN CSV1.2 IF INTERACTIVE JOB
LDD BA
LMN 3
NJN CSV1.2 IF NOT SERVICE CLASS FULL ERROR
SFA JCB,T7
ADK JCTT
CRD FN
LDC SCRT/2 SET JOBS WAITING INDICATOR
STD FN+1
SFA JCB,T7
ADK JCTT
CWD FN
CSV1.2 LDM STMT+4
LPN 77
LMD T3
STM STMT+4
RJM CKA GET ADDRESS OF PARAMETER BLOCK
CWM STMT,ON RETURN PARAMETER WORD
LDD BA
ZJN CSV2 IF NO ERROR
LJM CPMX RETURN
CSV2 SFA JCB,T7 GET JCB ADDRESS
STD CM+4
SHN -14
STD CM+3
LDN 2 SET NUMBER OF REQUESTS
STD CM+1
LDD CN SET CURRENT JOB COUNT
STM CSVA+4
ADN 1 INCREMENT COUNT
STM CSVB+4
LDD MA
CWM CSVA,CM+1
MONITOR UTEM
LDD CM+1
NJP CSV0 IF FUNCTION NOT COMPLETED
LDN 1
STD T6
LDM STMT+4
LPN 77
RJM CSC CHANGE SERVICE CLASS
RJM RIS READ INPUT FILE SYSTEM SECTOR
LDD CP UPDATE INFORMATION IN SYSTEM SECTOR
ADN TFSW
CRD CM
SFA EJT,CM
ADK JSNE
CRD CM
ADK SCLE-JSNE
CRD CN
LDD CM SET JSN
STM IOSS
LDD CM+1
STM IOSS+1
LDM IOSS+SCLE*5 SET SERVICE CLASS
LPN 17
LMD CN
LPN 17
LMD CN
STM IOSS+SCLE*5
SETMS IO,RW
RJM WSS WRITE INPUT FILE SYSTEM SECTOR
PJN CSV3 IF NO MASS STORAGE ERROR ENCOUNTERED
RJM CJR CHECK IF THE JOB IS ROLLABLE
LDN 4 INDICATE MASS STORAGE ERROR ENCOUNTERED
LJM CSV1.1 RETURN ERROR STATUS
CSV3 ENDMS
LJM CPMX RETURN
CSVA VFD 1/1,5/JCTT,6/12D,6/48D,42/0 VERIFY OLD JOB COUNT
CSVB VFD 6/JCTT,6/12D,6/48D,42/0 SET NEW JOB COUNT
GCN SPACE 4,15
*** FUNCTION 136.
* GET CHARGE NUMBER INFORMATION.
*
* ENTRY (IR+3 - IR+4) = PARAMETER BLOCK ADDRESS *ADDR*.
*
* EXIT CURRENT CHARGE AND PROJECT NUMBER INFORMATION
* RETURNED TO CALLER.
*
*T ADDR+0 60/CHARGE NUMBER
*T, 60/PROJECT NUMBER
*T, 60/PROJECT NUMBER
*T, 1/V,59/0
* WHERE
* V = VALIDATED CHARGE FLAG.
* = 0 IF CHARGE AND PROJECT NUMBER NOT VALIDATED.
* = 1 IF CHARGE AND PROJECT NUMBER VALIDATED.
GCN ENTRY
NFA CHGN READ CHARGE AND PROJECT NUMBER
CRM STMT,TR
LDD CP READ CHARGE COMMAND PROCESSED FLAG
ADN FPFW
CRD CN
LDN ZERL SET VALIDATED CHARGE FLAG
CRD CM
LDD CN
LPC 4000
STD CM
LDN 3 SET WORD COUNT
STD T1
RJM CKA VALIDATE PARAMETER BLOCK ADDRESS
CWM STMT,TR WRITE PARAMETER BLOCK
CWD CM
LJM CPMX RETURN
TITLE SUBROUTINES.
CUF SPACE 4,15
** CUF - CHECK FOR PROFILE FILE UPDATE FAILURE.
*
* IF *CPM* COULD NOT MAKE A SUCCESSFUL *0AU* CALL, ANY CONTROL
* POINT AREA ACCUMULATOR OVERFLOW FLAGS ARE CLEARED (IN
* ADDITION, IF SRU ACCUMULATOR OVERFLOW, OVERFLOW VALUE
* MESSAGE ISSUED), AND SRU ACCUMULATOR VALUE MESSAGE ISSUED.
*
* ENTRY (CUFA) = *LDN 0*, IF PROFILE FILE UPDATE FAILURE.
* (T1) = ADDRESS OF *ACSR* ACCOUNT FILE MESSAGE.
*
* CALLS DFM.
CUF SUBR ENTRY/EXIT
LDN 1
CUFA EQU *-1
* LDN 0 (PROFILE FILE UPDATE FAILURE)
NJN CUFX IF NO UPDATE FAILURE
LDN 1RU-1RC CHANGE MESSAGE PREFIX TO *AUSR*
RAI T1
LDD T1
ADC ACFN
RJM DFM ISSUE MESSAGE TO ACCOUNT FILE
UJN CUFX RETURN
DAM SPACE 4,10
** DAM - DISPLAY ACCOUNT MESSAGES.
*
* ENTRY (A) = MESSAGE ADDRESS.
* (T4) = NUMBER OF MESSAGES TO DISPLAY.
*
* USES T4, T5.
*
* CALLS DFM.
DAM SUBR ENTRY/EXIT
STM DAMA SAVE ADDRESS OF MESSAGE
DAM1 LDM **,T4 GET MESSAGE ADDRESS
DAMA EQU *-1
STD T5
LDM 3,T5
ZJN DAM2 IF QUANITY ZERO (NO MESSAGE DISPLAYED)
LDD T5
LMC CPON
RJM DFM DISPLAY IN USERS DAYFILE
LDD T5
LMC ACFN
RJM DFM DISPLAY IN ACCOUNT FILE
DAM2 SOD T4 DECREMENT MESSAGE COUNT
PJN DAM1 IF MORE MESSAGES
UJN DAMX RETURN
IAM SPACE 4,15
** IAM - ISSUE ACCOUNT FILE MESSAGES FOR END OF ACCOUNT BLOCK.
*
* ENTRY (A) = ADDRESS OF WORD IN PP CONTAINING NEW SRU
* MULTIPLIERS IF MULTIPLIERS ARE TO BE CHANGED.
*T 12/ M1,12/ M2,12/ M3,12/ M4,12/ AD
* (A) = 0 IF SRU MULTIPLIERS ARE NOT TO BE CHANGED.
*
* EXIT (A) = ADDRESS OF *ACSR* SRU MESSAGE DENOTING END OF
* ACCOUNT BLOCK.
*
* USES TN, T3, T4, T5, CM - CM+4, CN - CN+4.
*
* CALLS DAM, PIR, RRR, SCM, SRR, STA.
*
* MACROS MONITOR, NFA, SFA.
IAM SUBR ENTRY/EXIT
ZJN IAM1 IF NO CHANGE TO SRU MULTIPLIERS
STM IAMA
LDD MA MOVE SRU MULTIPLIERS TO MESSAGE BUFFER
CWM **,ON
IAMA EQU *-1
LDN ABCF&ABCS SET CHANGE ACCOUNT BLOCK SUBFUNCTION
IAM1 LMN ABCS SET CLEAR SRU ACCUMULATORS SUBFUNCTION
STD CM+1
LDN AC1WL
STD T4
LDD CP
ADK AC1W
CRM IAMU,T4
LDN ACTWL
STD T4
LDD CP SAVE CPA ACCUMULATORS FOR CONVERSION
ADN ACTW
CRM IAMC,T4
MONITOR ACTM CHANGE ACCOUNT BLOCK/CLEAR ACCUMULATORS
* CONVERT CPA ACCUMULATORS.
LDD MA MOVE CPA ACCUMULATORS TO CPA
CWM IAMC,T4
LDN ABVF SET CONVERT ACCUMULATORS SUBFUNCTION
STD CM+1
MONITOR ACTM
LDN ABNA-1 SET NUMBER OF CONVERTED ACCUMULATORS
STD T4
LDN ABNA-1+2
STD T5
IAM2 LDC IAME SET MESSAGE ADDRESS
RJM SCM
LDM SCMB
STD T3
LDI T3
NJN IAM3 IF SRU ACCUMULATOR NOT ZERO
LDD MA
CWM IAMD,ON
LDN 0
STD T4
UJN IAM2 STORE DISPLAY ZERO IN SRU MESSAGE
IAM3 LDD CP GET JOB EJT ORDINAL
ADN TFSW
CRD CM
SFA EJT,CM GET FWA EJT ENTRY
CRD CM
LDD CM+4 CHECK JOB CONNECTION STATUS
SHN -7
LPN 17
LMN OLCS
ZJN IAM4 IF ONLINE INTERACTIVE JOB
NFA RC2N READ CHARACTER COUNTS FROM NFL
CRD CM
UJN IAM5 SET COUNTS
IAM4 LDD CP GET TERMINAL NUMBER
ADN TTNW
CRD CM
LDD CM+1
STD TN
RJM PIR PRESET WITH IAF R-REGISTER
RJM SRR SET R-REGISTER TO IAF RA
RJM STA SET TERMINAL TABLE ADDRESS
ADN VFST READ CHARACTER COUNTS FROM TERMINAL TABLE
CRD CN
ADN VCHT-VFST
CRD CM
RJM RRR RESTORE R-REGISTER
LDD CN+2
STD CM+2
IAM5 LDD CM+4 SET OUTPUT COUNT
STM IAMN+7
LDD CM+3 SET INPUT COUNT
STM IAMM+7
ADD CM+4 SET COMBINED COUNT
STM IAML+7
SHN -14
ADD CM+2
STM IAML+6
LDD MA SET COUNTS FOR CONVERSION
CWM IAML+3,ON
CWM IAMM+3,ON
CWM IAMN+3,ON
LDN RCIS+3 SET F10.3 FORMAT AND REQUEST COUNT
STD CM+1
LDN 0 CLEAR SRU FLAG
STD CM+2
MONITOR RDCM CONVERT ACCUMULATORS
LDD MA
CRM IAML+3,ON READ CONVERSIONS TO MESSAGES
CRM IAMM+3,ON
CRM IAMN+3,ON
LDN AC1WL
STD T4
LDD MA
CWM IAMU,T4
LDN ABOF
STD CM+1
MONITOR ACTM CONVERT OTHER ACCUMULATORS
LDN ABNB-1
STD T4
LDC IAMO SET MESSAGE ADDRESS
RJM SCM STORE CONVERTED MESSAGES
* ISSUE END OF ACCOUNT BLOCK MESSAGES TO USER
* DAYFILE AND ACCOUNT FILE.
LDN ABNB-1
STD T4
LDC IAMO
RJM DAM DISPLAY ACCOUNTING MESSAGES
LDN ABNA+3-1
STD T4
LDC IAME
RJM DAM DISPLAY ACCOUNTING MESSAGES
LDM IAME+ABSR RETURN ADDRESS OF SRU MESSAGE
LJM IAMX RETURN
IAMC BSS ACTWL*5 BUFFER FOR CPA ACCUMULATOR WORDS
IAMD DATA C* 0.000* DISPLAY ZERO
* THE MESSAGE ADDRESSES IN THE FOLLOWING TABLE AND THE
* ACCUMULATORS RETURNED BY *ACTM* SUBFUNCTION *ABVF* ARE
* MAINTAINED IN THE SAME ORDER TO INSURE THAT THE CORRECT
* QUANTITY IS STORED IN THE APPROPRIATE MESSAGE. THE MESSAGES
* ARE DISPLAYED IN THE REVERSE ORDER SO THAT SRUS ARE ALWAYS
* THE LAST TO BE DISPLAYED TO INDICATE END OF ACCOUNT BLOCK.
IAME INDEX
INDEX ABSR,IAMF SRUS
ERRNZ ABSR SRUS MUST BE DISPLAYED LAST
INDEX ABCP,IAMG CPU TIME
INDEX ABMS,IAMH MASS STORAGE ACTIVITY
INDEX ABMT,IAMI MAGNETIC TAPE ACTIVITY
INDEX ABPF,IAMJ PERMANENT FILE ACTIVITY
INDEX ABAD,IAMK SRU ADDER
INDEX ABNA+0,IAML TOTAL CHARACTERS
INDEX ABNA+1,IAMM CHARACTERS IN
INDEX ABNA+2,IAMN CHARACTERS OUT
INDEX ABNA+3
IAMF DATA C*ACSR, 000000.000UNTS.*
IAMG DATA C*UDCP, 000000.000SECS.*
IAMH DATA C*UDMS, 000000.000KUNS.*
IAMI DATA C*UDMT, 000000.000KUNS.*
IAMJ DATA C*UDPF, 000000.000KUNS.*
IAMK DATA C*UDAD, 000000.000KUNS.*
IAML DATA 6HUDCT, ,0,0,0,0,0,6HKCHS. ,0
IAMM DATA 6HUDCI, ,0,0,0,0,0,6HKCHS. ,0
IAMN DATA 6HUDCO, ,0,0,0,0,0,6HKCHS. ,0
IAMO INDEX
INDEX ABMP,IAMP MAP
INDEX ABAC,IAMQ AUC ACTIVITY
INDEX ABOD,IAMR OPTICAL DISK ACTIVITY
INDEX ABNB
IAMP DATA C*UDMP, 000000.000KUNS.*
IAMQ DATA C*UDAC, 000000.000UNTS.*
IAMR DATA C*UDOD, 000000.000KUNS.*
IAMU BSS AC1WL*5 BUFFER FOR CPA ACCUMULATOR WORDS
RIS SPACE 4,20
** RIS - READ INPUT FILE SYSTEM SECTOR.
*
* EXIT (A) = 0.
* (BFMS) = INPUT FILE SYSTEM SECTOR.
* (FA) = 0.
*
* IF A NON-SUBSYSTEM JOB ENCOUNTERED A RECOVERABLE
* READ/WRITE ERROR ON THE DEVICE, THE JOB IS ROLLED OUT
* TO WAIT FOR THE DEVICE TO BECOME ACCESSIBLE.
*
* ERROR TO *ERR* IF SYSTEM SECTOR ERROR OTHER THAN READ.
*
* USES T5 - T5+4.
*
* CALLS CJR, RSS.
*
* MACROS ABORT, NFA, SETMS.
RIS SUBR ENTRY/EXIT
NFA FNTN+FSTL FETCH INPUT FILE FST
CRD T5
SETMS IO
LDN 0 SET NO FILE NAME VERIFY
RJM RSS READ SYSTEM SECTOR
STD FA
ZJN RISX IF NO ERROR
PJN RIS1 IF SYSTEM SECTOR ERROR OTHER THAN READ
RJM CJR CHECK IF THE JOB IS ROLLABLE
RIS1 ABORT ERSY * CPM - SYSTEM ERROR.*
SAL SPACE 4,10
** SAL - SET ACCOUNT BLOCK LIMIT.
*
* ENTRY (CM+3 - CM+4) = ACCOUNT BLOCK SRU LIMIT TO SET.
*
* EXIT *STLW* UPDATED.
*
* USES CN - CN+4.
SAL SUBR ENTRY/EXIT
LDD CP GET CURRENT ACCOUNT BLOCK SRU LIMIT
ADN STLW
CRD CN
LDD CN+1
LPN 77
STD CN+1
LDD CM+3
SHN 14
LMD CM+4
SHN 14
STD CN
SHN -6
SCN 77
RAD CN+1
LDD CP STORE NEW LIMIT
ADN STLW
CWD CN
UJN SALX RETURN
SCM SPACE 4,10
** SCM - STORE CONVERSIONS IN MESSAGE.
*
* ENTRY (T4) = MESSAGE COUNT.
* (A) = LOCATION OF MESSAGE.
*
* USES T4.
SCM SUBR ENTRY/EXIT
STM SCMA SAVE MESSAGE ADDRESS
SCM1 LDM **,T4 GET MESSAGE ADDRESS
SCMA EQU *-1
ADN 3
STM SCMB
LDD MA
ADD T4
CRM **,ON READ CONVERSIONS
SCMB EQU *-1
SOD T4 DECREMENT MESSAGE COUNT
PJN SCM1 IF MORE ACCUMULATORS
UJN SCMX RETURN
SPP SPACE 4,10
** SPP - SET PROFILE PARAMETERS.
*
* CONTROL POINT AREA *FPFW* WORD IS UPDATED.
*
* EXIT TO *ERR1*, IF SYSTEM ERROR.
*
* USES T1 - T7, CM - CM+4, CN - CN+4, RI - RI+1.
*
* CALLS CRA, DFM, FAT, SLI, SRU.
*
* MACROS ABORT, MONITOR, SFA.
SPP SUBR ENTRY/EXIT
LDD MA PROFILE FILE NAME
CWM SPPC,ON
SBN 1
CRD CM
LDD CP FAMILY NAME
ADN PFCW
CRD T1
SFA EST,T4
ADK EQDE
CRD CN
LDD CN+4
SHN 3
ADN PFGL
CRD CN
RJM FAT SEARCH FOR FAST-ATTACH FILE
ZJN SPP2 IF PROFILE FILE FOUND
SPP1 ABORT EREF+ERLN *ERROR ON FILE - "PPFN".*
SPP2 LDD T1 SET SYSTEM FNT ORDINAL OF *PROFILE* FILE
STD CN+2
SFA FNT
ADN FSTG
CRD T5
LDM STMT+10 RANDOM ADDRESS
LPN 77
STD RI
SHN 14
LMM STMT+11
STD RI+1
ZJN SPP3 IF NO RANDOM ADDRESS
RJM CRA CONVERT RANDOM ADDRESS
MJN SPP1 IF INCORRECT RANDOM ADDRESS
LDD T7 SET SECTOR
STD CN+4
LDD T6 TRACK
SPP3 STD CN+3
LDM STMT+10
SCN 77
ZJN SPP4 IF FIRST ENTRY IN LEVEL-3 BLOCK
LDN 1
SPP4 ADN 2 SET NOT FIRST CHARGE BIT
SHN 12
STD CN
LDC ** CHECK FOR PROFILE FILE SWITCH
SPPA EQU *-1 (PROFILE FNT ORDINAL)
ZJN SPP5 IF NO OLD *CHARGE* COMMAND
LMD CN+2
ZJN SPP6 IF SAME FAMILY
LMD CN+2
SFA FNT
ADN FSTG
CRD CM
LDD CM SET OLD FAMILY EST ORDINAL
STM SPPB
SPP5 LDD T5 INCREMENT DAF COUNT FOR NEW FAMILY
STD CM+1
LDN IUCS
STD CM+3
MONITOR SMDM
SPP6 LDD CP
ADN FPFW
CWD CN
LDC 0
SPPB EQU *-1
ZJN SPP7 IF NOT DECREMENTING OLD FAMILY DAF COUNT
STD CM+1
LDN DUCS DECREMENT DAF COUNT FOR OLD FAMILY
STD CM+3
MONITOR SMDM
SPP7 LDM STMT+5 CONVERT VALIDATION INDEX
SHN -6
RJM SLI
RJM SRU SET VALIDATION LIMITS
LJM SPPX
SPPC VFD 42/0L"PPFN" PROFILE FILE NAME
UPF SPACE 4,25
** UPF - UPDATE PROJECT PROFILE FILE USING OVERLAY *0AU*.
*
* ENTRY (OVL0 - OVL0+4) = CONTROL POINT AREA *FPFW* WORD.
* (RC, BITS 6-11) = RECALL COUNT.
*
* EXIT TO CALLING ROUTINE, IF ONE OF THE FOLLOWING-
* 1) SUCCESSFUL *0AU* CALL.
* 2) PROFILE FILE UPDATE FAILURE AND MAXIMUM
* RECALL COUNT REACHED.
* ALSO, (CUFA) = *LDN 0*.
* 3) ERROR DETECTED BY *0AU*.
* TO CPMX, IF PROFILE FILE INTERLOCKED IN ROLLABLE MODIFY
* MODE AND MAXIMUM RECALL COUNT NOT REACHED.
* RECALL COUNT IS INCREMENTED AND ANOTHER
* SYSTEM REQUEST ISSUED.
* IF A NON-SUBSYSTEM JOB ENCOUNTERED A RECOVERABLE
* READ/WRITE ERROR ON THE DEVICE, THE JOB IS ROLLED OUT
* TO WAIT FOR THE DEVICE TO BECOME ACCESSIBLE.
*
*
* USES CM - CM+4.
*
* CALLS CJR, DFM, *0AU*.
*
* MACROS EXECUTE, MONITOR, SFA.
UPF SUBR ENTRY/EXIT
LDD CP GET JOB EJT ORDINAL
ADN TFSW
CRD CM
SFA EJT,CM GET JSN
ERRNZ JSNE CHECK IF WORD 0 OF EJT ENTRY
CRM AUPB,ON
ADN SCLE-JSNE-1 GET JOB SERVICE CLASS
CRM AUPB+4,ON
LDD CP GET SRU ACCUMULATOR
ADN SRUW
CRM AUPB+5,ON
LDC AUPB
STM L0AU+1
EXECUTE 0AU,L0AU+5
PJN UPF0 IF NO MASS STORAGE ERROR ENCOUNTERED
RJM CJR CHECK IF THE JOB IS ROLLABLE
LJM UPF2 SET UPDATE FAILURE FLAG
UPF0 SBN 2
NJP UPFX IF NOT ROLLABLE MODIFY INTERLOCK
LDD RC INCREMENT AND CHECK RECALL COUNT
ADD HN
STD IR+3
SHN -6
LMN MRCL+1
ZJN UPF1 IF MAXIMUM RECALL COUNT REACHED
LDN ZERL ENTER DEFAULT TIMED RECALL
CRD CM
LDN PIRR SET PF INTERLOCK REJECT REASON
STD CM
LDD MA ENTER PP CALL INTO RECALL STACK
CWD IR
ADN 1 STORE RECALL STACK REASON CODE
CWD CM
MONITOR RECM
LJM PPR EXIT TO PP RESIDENT
UPF1 STM L0AU+3 CLEAR PROFILE FILE PRESENT
EXECUTE 0AU,L0AU+5
PJN UPF1.1 IF NO MASS STORAGE ERROR ENCOUNTERED
RJM CJR CHECK IF THE JOB IS ROLLABLE
UJN UPF2 SET UPDATE FAILURE FLAG
UPF1.1 LDM L0AU+4
SHN 21-0
PJN UPF2 IF NOT SRU ACCUMULATOR OVERFLOW
LDC ACFN+UPFA SRU OVERFLOW MESSAGE
RJM DFM
UPF2 SOM CUFA SET UPDATE FAILURE FLAG
LJM UPFX EXIT
UPFA DATA C*AUSR, 219902.325UNTS.*
SPACE 4,10
** COMMON DECKS.
QUAL
AST$ SET 1 ASSEMBLE *SSCT/SSAT* UPDATE CODE
*CALL COMPAST
QUAL *
*CALL COMPCRA
*CALL COMPCSC
*CALL COMPFAT
QUAL
*CALL COMPSTA
QUAL *
QUAL$ EQU 1 SET TO NOT QUALIFY COMMON DECKS
PIR$ EQU 1 SELECT ASSEMBLY OF *PIR* FOR IAF R-REG
*CALL COMPSRR
*CALL COMPSRU
VFN$ EQU 1 ALLOW ASTERISK (*) IN FILE NAME
*CALL COMPVFN
CJL$ EQU 1 CHECK SERVICE CLASS AT JOB LIMIT
CUV$ EQU 1 CHECK USER VALIDATED FOR SERVICE CLASS
*CALL COMPVSP
*CALL COMPWSS
SPACE 4,10
USE LITERALS
SPACE 4,10
** BUFFER DEFINITIONS.
STMT EQU * COMMAND BUFFER
AUPB EQU STMT+10D*5 *0AU* PARAMETER BLOCK
L0AU EQU AUPB+2*5 LOAD ADDRESS FOR *0AU*
ERRNG EPFW-L0AU-ZAUL CHECK LENGTH OF *0AU*
SPACE 4,10
OVERFLOW OVL
OVERLAY (LOADER/MISCELLANEOUS FUNCTIONS.)
SEE SPACE 4,10
** FUNCTION 4.
* SET ERROR EXIT ADDRESS = PARAMETER.
*
* ENTRY (IR+3 - IR+4) = ERROR EXIT ADDRESS.
*
* EXIT (EECW) UPDATED TO NEW ERROR EXIT ADDRESS.
* *OVERRIDE* REQUIRED FLAG CLEARED IN (SNSW).
SEE ENTRY
RJM CKA CHECK ERROR EXIT ADDRESS WITHIN FL
LDD CP READ (SNSW) AND (EECW)
ADN SNSW
CRD CN
ADN EECW-SNSW
CRD CM
LDD CM CHECK EXTENDED RPV SET
SHN 21-12
PJN SEE1 IF EXTENDED RPV NOT SET
ABORT ERIR * CPM - INCORRECT REQUEST.*
SEE1 LDN 0 CLEAR REPRIEVE OPTION
STD CM+1
LDD CM+3 SET ERROR EXIT ADDRESS
LMD IR+3
SCN 77
LMD IR+3
STD CM+3
LDD IR+4
STD CM+4
LDD CN CLEAR *OVERRIDE* REQUIRED BIT
LPC 6777
STD CN
LDD CP
ADN SNSW
CWD CN
ADN EECW-SNSW
CWD CM
LJM CPMX EXIT
GLS SPACE 4,15
*** FUNCTION 46.
* GET GLOBAL LIBRARY SET.
*
* GET THE LIST OF LIBRARY NAMES FROM THE GLOBAL
* LIBRARY SET INDICATORS IN *LB1W* THRU *LB3W*.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF PARAMETER WORD.
*T ADDR 6/ ,18/ LIST ,36/0
* LIST RETURN ADDRESS FOR LIBRARY NAMES.
*
* EXIT RETURNS GLOBAL LIBRARY SET NAMES, LEFT JUSTIFIED,
* ZERO FILLED, STARTING AT *LIST* ADDRESS.
* EXITS TO LSR.
GLS ENTRY
RJM CKA READ PARAMETER WORD
CRD BA
LDD CP READ GLOBAL LIBRARY SET
ADC LB1W
CRM TLBD,TR
LDK LBDP READ LBD POINTER
CRD T0
LDN 0
STD T1 CLEAR *TLBD* INDEX
STD T5 SET BYTE INDICATOR TO UPPER 6 BITS
UJN GLS2 ENTER LOOP
GLS1 AOD T5 ADVANCE *TLBD* INDEX
SHN -1
STD T1
GLSA LMN TLBDL-3 CHECK FOR END OF *TLBD*
* LMN TLBDL-3-5 IF 1 USER LIBRARY
* LMN TLDBL-3-5-5 IF 2 USER LIBRARIES
ZJN GLS3 IF END OF LIBRARY INDICATORS
LDM GLSB SET UP SHN INSTRUCTION
LMN 71
STM GLSB
GLS2 LDM TLBD+3,T1 GET LIBRARY INDEX
GLSB SHN -6
* SHN 0 IF LIBRARY INDEX IN LOWER 6 BITS OF BYTE
LPN 77
GLS3 ZJN LSR IF END OF LIBRARY INDICATORS
SBN 77
ZJN GLS5 IF LOCAL USER LIBRARY INDICATOR
ADN 76 RESET INDICATOR MINUS 1
SHN 1 READ LIBRARY FROM LBD
ADD T3
SHN 6
ADD T2
SHN 14
GLS4 CRD FN
RJM RLN RETURN LIBRARY NAME
UJN GLS1 LOOP FOR NEXT INDICATOR
* PROCESS LOCAL USER LIBRARY.
GLS5 SOM GLSC
LCN 5 UPDATE END CHECK FOR *TLBD*
RAM GLSA
LDD CP READ USER LIBRARY NAME
ADC LB3W+1
GLSC EQU *-1
* ADC LB3W IF FIRST USER LIBRARY
* ADC LB2W IF SECOND USER LIBRARY
UJN GLS4 RETURN LIBRARY NAME
LSR SPACE 4,10
** LSR - LIBRARY SET RETURN.
*
* ENTRY LIBRARY FUNCTION COMPLETED.
*
* EXIT PARAMETER WORD RETURNED.
LSR LDD IR+3 RETURN PARAMETER WORD
SHN 6
ADD RA
SHN 6
ADD IR+4
CWD BA
LJM CPMX EXIT
SLS SPACE 4,35
*** FUNCTION 47.
* SET GLOBAL LIBRARY SET.
*
* SET THE GLOBAL LIBRARY SET INDICATORS FROM A LIST
* OF LIBRARY NAMES.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF PARAMETER WORD.
*T ADDR 6/ 0,18/ LIST ,36/ 0
* LIST FWA OF LIBRARY NAMES.
*
*T LIST 42/LIBRARY NAME 1,18/
*T LIST+1 42/LIBRARY NAME 2,18/
* . . .
*T LIST+N-1 42/LIBRARY NAME N,18/
*T LIST+N 60/0
*
* EXIT TO *LSR*.
* (LIST) ADVANCED TO END OF TABLE + 1.
*
*LB1W 36/NOT CHANGED , 24/GLI
*LB2W 60/ULN
*LB3W 60/ULN
* GLI = GLOBAL LIBRARY SET INDICATORS (6-BIT FIELDS) -
* 00 END OF LIBRARY SET.
* 01-76 ORDINAL OF SYSTEM LIBRARY.
* 77 USER LIBRARY. LOGICAL FILE NAME OF FIRST
* USER LIBRARY IN *LB3W*, LOGICAL FILE NAME
* OF SECOND USER LIBRARY IN *LB2W*.
* ULN = EITHER LOGICAL FILE NAME OF SECOND (*LB2W*) OR
* FIRST (*LB3W*) USER LIBRARY, OR A COLLECTION OF
* 6-BIT GLOBAL LIBRARY SET INDICATORS.
*
* ERROR (LIST) = ADDRESS OF TABLE ENTRY WHERE ERROR WAS
* FOUND.
SLS ENTRY
RJM CKA READ PARAMETER WORD
CRD BA
LDD CP READ FIRST LIBRARY CONTROL WORD
ADC LB1W
CRM TLBD,ON
LDN 2 MAXIMUM NUMBER OF LOCAL USER LIBRARIES
STD T7
LDN 3 NUMBER OF LIBRARY WORDS TO WRITE
STD T3
LDN 0 CLEAR COUNTER NUMBER OF GLOBAL LIBRARIES
STD T6
LDN ZERL CLEAR GLOBAL LIBRARIES
CRM TLBD+3,ON
LDN ZERL
CRM TLBD+3+5,ON
LDN ZERL
CRM TLBD+3+12,ON
LDN 24D MAXIMUM NUMBER OF GLOBAL LIBRARIES
STD T5
SLS1 RJM RLW READ LIBRARY WORD
NJN SLS5 IF NAME FOUND
LDD CP UPDATE GLOBAL LIBRARY SET
ADC LB1W
CWM TLBD,T3
SOD T3
ZJN SLS2 IF TWO USER LIBRARIES
SOD T3
NJN SLS3 IF NO USER LIBRARIES
LDD CP STORE ONE USER LIBRARY NAME
ADC LB3W
CWM LB2T+5,ON
UJN SLS3 RETURN
SLS2 LDN 2 STORE TWO USER LIBRARY NAMES
STD T5
LDD CP
ADC LB2W
CWM LB2T,T5
SLS3 LJM LSR RETURN
* ERROR EXIT, DECREMENT INDEX TO INDICATE BAD LIBRARY NAME.
SLS4 SOD BA+1
PJN SLS3 IF NO UNDERFLOW
AOD BA+1 CORRECT UNDERFLOW CONDITION
SOD BA
UJN SLS3 RETURN
SLS5 SOD T5
MJN SLS4 IF TOO MANY SYSTEM LIBRARIES
RJM LBD SEARCH FOR MATCH IN LBD
NJP SLS7 IF MATCH FOUND
SOD T7
MJN SLS4 IF TOO MANY LOCAL USER LIBRARIES
RJM SAF CHECK LOCAL FILE PRESENT
NJN SLS5.1 IF FILE FOUND
STM SLSD,T4 CLEAR ASSEMBLY AREA START
LDD T4
ADC SLSD SET ASSEMBLY ADDRESS
STD T1
LDN FN ADD FILE NAME
RJM ACS
LDC SLSE ADD PERIOD
RJM ACS
LDD T8
ADC SLSC+CPON ISSUE MESSAGE TO CALLER
RJM DFM
LJM SLS1 CHECK NEXT ENTRY
* PROCESS LOCAL USER LIBRARY ENTRY.
SLS5.1 LCN 10D UPDATE MAXIMUM LIBRARIES ALLOWED
RAD T5
MJP SLS4 IF TOO MANY LIBRARIES
LDN 4
STD T1
SLS6 LDM FN,T1
STM LB2T+5,T1 SAVE *LB3W* WORD
SLSA EQU *-1
* STM LB2T,T1 (*LB2W*)
SOD T1
PJN SLS6 IF NOT 5 BYTES TRANSFERRED
LCN 5
RAM SLSA
LDN 77 USER LIBRARY INDICATOR
STD T4
SOD T3
* PROCESS SYSTEM USER LIBRARY.
SLS7 LDD T6 SET UP INDEX IN *TLBD*
SHN -1
STD T1
AOD T6
LDD T4 ENTER GLOBAL LIBRARY SET INDICATOR
SLSB SHN 6
* SHN 0 IF IN BITS 0-5 OF BYTE
RAM TLBD+3,T1
LDM SLSB SET UP SHN INSTRUCTION
LMN 6
STM SLSB
LJM SLS1 LOOP TO END OF LIBRARY SET
SLSC DATA H* CPM - LIBRARY NOT FOUND = *
SLSD BSS 5 SPACE FOR NAME
SLSE DATA C*.*
SLSF DATA H* CPM - LIBRARY INACCESSIBLE = *
SLSG BSS 7 SPACE FOR NAME, PERIOD
SPB SPACE 4,10
*** FUNCTION 100.
* SET/CLEAR PAUSE BIT.
*
* ENTRY (IR+4) = 0, IF TO SET BIT.
* = 1, IF TO CLEAR BIT.
*
* USES CM - CM+4.
*
* CALLS CUA.
*
* MACROS ABORT.
SPB ENTRY
LDD EP CHECK FOR *SSJ=* ENTRY POINT
SHN 21-2
MJN SPB1 IF *SSJ=* PROGRAM
RJM CUA CHECK FOR *SYOT* OR *CSOJ*/*DEBUG*
ZJN SPB1 IF ACCESS ALLOWED
RJM VPA VERIFY PRIVILEGED ANALYST
ZJN SPB1 IF ACCESS ALLOWED
ABORT ERIU * CPM - USER ACCESS NOT VALID.*
SPB1 LDD IR+4
SBN 2
MJN SPB2 IF LEGAL SUBFUNCTION
ABORT ERIR *CPM - INCORRECT REQUEST.*
SPB2 LDD CP READ PAUSE WORD
ADN SNSW
CRD CM
LDD CM+3 SET/CLEAR PAUSE BIT
SCN 1
LMN 1
LMD IR+4
STD CM+3
LDD CP
ADN SNSW
CWD CM
LJM CPMX EXIT
SPS SPACE 4,15
*** FUNCTION 101.
* RETURN SYSTEM ORIGIN PRIVILEGES STATUS.
*
* ENTRY (IR+3 - IR+4) = STATUS RETURN ADDRESS.
*
* EXIT IF STATUS RETURN ADDRESS SPECIFIED -
* (ADDR) = 48/0, 12/STATUS
* WHERE STATUS = 0 IF USER HAS PRIVILEGES.
* .NE. 0 IF USER DOES NOT HAVE PRIVILEGES.
*
* IF STATUS RETURN ADDRESS NOT SPECIFIED -
* TO *CPMX* IF USER HAS PRIVILEGES.
* ABORT, IF USER DOES NOT HAVE PRIVILEGES.
SPS ENTRY
LDN ZERL CLEAR REPLY
CRD CN
RJM CUA CHECK USER ACCESS
STD CN+4 SAVE STATUS
LDD IR+3
LPN 37
SHN 14
LMD IR+4
ZJN SPS2 IF NO ADDRESS SPECIFIED
RJM CKA CHECK ADDRESS
CWD CN RETURN STATUS
SPS1 LJM CPMX EXIT
SPS2 LDD CN+4
ZJN SPS1 IF USER HAS PRIVILEGES
ABORT ERIU * CPM - USER ACCESS NOT VALID.*
GPG SPACE 4,25
*** FUNCTION 127.
* GET PAGESIZE INFORMATION.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF 2 WORD BLOCK.
*
* EXIT PARAMETER BLOCK RETURNED AS FOLLOWS.
*
*T,ADDR 28/RES,4/JPD,8/JPL,8/JPW,11/RES,1/C
*T 28/RES,4/SPD,8/SPL,8/SPW,12/RES
*
* JPD JOB PRINT DENSITY (6 OR 8)
* JPL JOB PAGE LENGTH
* JPW JOB PAGE WIDTH
* C COMPLETE BIT
* SPD SYSTEM PRINT DENSITY
* SPL SYSTEM PAGE LENGTH
* SPW SYSTEM PAGE WIDTH
* RES RESERVED FIELD
GPG ENTRY
NFA JPPN GET JOB PAGE PARAMETERS
CRD T3
LDD T7
SCN 1
ADN 1 SET COMPLETION BIT
STD T7
LDN IPPL GET SYSTEM PAGE PARAMETERS
CRD CM
LDN 0
STD CM CLEAR UNRELATED BYTES
STD CM+1
LDN 2 NUMBER OF WORDS TO TRANSFER
STD T1
RJM CKA COPY PAGE PARAMETERS
CWM T3,T1
LJM CPMX RETURN
SPG SPACE 4,25
*** FUNCTION 130.
* SET PAGESIZE INFORMATION.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF PARAMETER BLOCK.
*
*T,ADDR 28/RES,4/JPD,8/JPL,8/JPW,11/RES,1/C
*
* JPD JOB PRINT DENSITY (6 OR 8)
* JPL JOB PAGE LENGTH
* JPW JOB PAGE WIDTH
* C COMPLETE BIT
* RES RESERVED FIELD
*
* EXIT PAGE SIZE PARAMETERS SET IN NFL.
SPG ENTRY
LDN 1 READ USER DEFINITIONS ONLY
STD T1
RJM CKA
CRD CM READ PAGE SIZE PARAMETERS
LDD CM+4
SCN 1
ADN 1 SET COMPLETE BIT
STD CM+4
RJM CKA
CWD CM SET COMPLETE BIT IN PARAMETER WORD
* VALIDATE PARAMETERS.
NFA JPPN
CRD CN
LDD CN+2 CLEAR PAGE PARAMETERS
LPC -377
STD CN+2
LDD CM+2 CHECK PRINT DENSITY
LPC 377
RAD CN+2
SHN -4
LPN 17 CHECK REMAINDER OF BYTE FOR *PD* ONLY
LMN 6
ZJN SPG2 IF *PD* IS 6 LPI
LMN 6&10
ZJN SPG2 IF *PD* IS 8 LPI
SPG1 ABORT ERPV * CPM - INCORRECT PAGE VALUES.*
SPG2 LDD CM+3 CHECK *PW*
STD CN+3
LPC 377
SBN /BIO/PWLL
MJN SPG1 IF BELOW LOWER LIMIT OF *PW*
LDD CM+2
LPN 17 UPPER PORTION OF *PS*
SHN 14
LMD CM+3
SHN -10
SBN /BIO/PSLL
MJN SPG1 IF BELOW LOWER LIMIT OF *PS*
NFA JPPN STORE JOB PAGE PARAMETERS
CWD CN
LJM CPMX RETURN
SOD SPACE 4,10
*** FUNCTION 112.
* SET OPERATOR DISPLAY DATA.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF BUFFER CONTAINING
* DISPLAY DATA.
*
* EXIT TO *CPMX* IF FUNCTION ALLOWED AND COMPLETED.
* TO *RCL* IF *CPM* RECALLED.
*
* ERROR TO *ABORT* IF USER NOT VALIDATED FOR FUNCTION.
SOD ENTRY
RJM CUA CHECK USER ACCESS
ZJN SOD1 IF SYSTEM ORIGIN PRIVILEGES
LDD CM
ZJN SOD1 IF *CMNT* ACCESS
LDD CP
ADK AACW
CRD CM
LDD CM+4
SHN 21-4
MJN SOD1 IF *CSOJ* PRIVILEGES
ABORT ERIU * CPM - USER ACCESS NOT VALID.*
SOD1 LDC LDSP SET BUFFER ADDRESS
CRD CM+1
LDD CM+3
SHN 14
LMD CM+4
SBN LODS
STD CM+4
STM SODA+1
STM SODB+1
SHN -14
STD CM+3
RAM SODA
STM SODB
LDN 0
STD CM+2
STD CM+1
LDD CP SET JSN
ADN TFSW
CRD FN
SFA EJT,FN
ERRNZ JSNE IF NOT WORD 0 OF EJT ENTRY
CRD FN
MONITOR UTEM INTERLOCK OPERATOR DISPLAY BUFFER
LDD CM+1
ZJN SOD2 IF BUFFER INTERLOCKED
LJM RCL RECALL REQUEST
SOD2 STD FN+2 SET JSN IN BUFFER
STD FN+3
LDN 1
STD FN+4
SODA LDC *
CWD FN
LDN 7 COPY MESSAGE TO BUFFER
STD T1
RJM CKA
CRM BFMS,T1
SODB LDC **
ADN 1
CWM BFMS,T1
LDD RA SET *CFO* FLAG IN RA+0
SHN 6
CRD CM
LDD CM+3
SCN 4
LMN 4
STD CM+3
LDD RA
SHN 6
CWD CM
LDN 1 SET OPERATOR DISPLAY FLAG
STD CM+1
LDC OPRL
STD CM+4
LDN 0
STD CM+2
STD CM+3
LDD MA
CWM SODC,ON
MONITOR UTEM
LJM CPMX EXIT
SODC VFD 6/0,6/1,6/59D,42/1 *UTEM* PARAMETER WORD
SSC SPACE 4,10
*** FUNCTION 113.
* SET *SHELL* PROCESSING CONTROLS.
*
* THIS FUNCTION SETS THE *SHELL* PROCESSING CONTROLS IN
* THE USER-S NFL AND RETURNS THE PREVIOUS CONTROLS FROM
* NFL TO THE USER-S PARAMETER WORD.
*
*T,ADDR 42/NAME,6/,1/X,3/,1/E,1/A,1/L,1/G,1/S,1/C,1/O,1/I
*
* NAME = 1-7 CHARACTER NAME OF SHELL PROGRAM.
* X = CURRENTLY EXECUTING UNDER SHELL CONTROL.
* (IGNORED FOR SETTING NEW CONTROL INFORMATION)
* E = CLEAR CONTROLS ON SHELL LOAD ERROR.
* A = CLEAR CONTROLS IF SHELL PROGRAM ABORTS.
* L = ALLOW SHELL PROGRAM LOAD FROM LOCAL FILE.
* G = ALLOW SHELL PROGRAM LOAD FROM GLOBAL LIBRARY.
* S = ALLOW SHELL PROGRAM LOAD FROM SYSTEM LIBRARY.
* C = CALL SHELL IF NO MORE COMMANDS (INTERACTIVE).
* O = CALL SHELL FOR COMMANDS OUTSIDE PROCEDURES.
* I = CALL SHELL FOR COMMANDS INSIDE A PROCEDURE.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF *SHELL* CONTROL.
SSC6 ABORT ERSC * CPM - MISSING *SHELL* LOAD OPTION.*
SSC7 ABORT ERSE * EPILOGUE AND SHELL CONFLICT.*
SSC8 ABORT ERSF * CPM - INCORRECT *SHELL* FILE.*
SSC ENTRY
RJM CKA
CRD FN
LDD FN
ZJN SSC3 IF CLEARING CONTROL
SSC1 LDD FN+4
LPN 70
ZJN SSC6 IF LOAD OPTION NOT SPECIFIED
LDD CP CHECK PROJECT EPILOGUE REQUIRED
ADN CSPW
CRD CN
LDD CN
SHN 21-3
PJN SSC2 IF PROJECT EPILOGUE NOT REQUIRED
LDD FN+4
SHN 21-6
PJN SSC7 IF NO ABORT SHELL REQUESTED
SSC2 LDD FN+4
LPN 40
SSC3 ZJN SSC5 IF LOCAL FILE LOAD OPTION NOT SELECTED
RJM SAF
SSC4 ZJN SSC8 IF FILE NOT FOUND
NFA FA,R CHECK FOR FILE ON MASS STORAGE
ADN FSTL
CRD CM
LDD CM
SFA EST
ADK EQDE
CRD CM
LDD CM
SHN 0-13
ZJN SSC4 IF FILE NOT ON MASS STORAGE
LDD FS+4
SCN NDST
LMN NDST
STD FS+4
LDD FS+3 SET WRITE LOCKOUT
SCN 1
LMN 1
STD FS+3
NFA FA,R UPDATE THE FNT ENTRY
CWD FS
SSC5 NFA SHCN COPY *SHELL* CONTROL TO NFL
CRD CN
CWD FN
RJM CKA COPY OLD DATA TO USER
CWD CN
LJM CPMX EXIT
RSC SPACE 4,20
*** FUNCTION 123.
* RETURN SERVICE CLASS INFORMATION.
*
* THIS FUNCTION RETURNS A LIST OF SERVICE CLASSES AND
* ASSOCIATED PRIORITIES WHICH ARE VALID
* FOR THE CALLER AND THE SPECIFIED ORIGIN TYPE.
*
* ENTRY (IR+3 - IR+4) = PARAMETER BLOCK ADDRESS.
*
* PARAMETER BLOCK FORMAT.
*
*T ADDR 24/ 0, 12/ OT, 12/ LEN, 11/ STAT, 1/C
*T,ADDR+1 12/ SC, 12/ 0, 12/ IN, 12/ EX, 12/ OUT
*T, 60/ .
*T, 60/ .
*T, 60/ .
*T,ADDR+N 12/ SC, 12/ 0, 12/ IN, 12/ EX, 12/ OUT
*
* *ADDR* MUST BE SET UP BY THE CALLER. *CPM* WILL UPDATE
* *ADDR* AND ALSO RETURN *ADDR+1* TO *ADDR+N*.
*
* *OT* = ORIGIN TYPE FOR WHICH A LIST OF VALID SERVICE
* CLASSES IS TO BE RETURNED. *OT* IS REQUIRED.
* *LEN* = MAXIMUM NUMBER OF SERVICE CLASSES TO RETURN.
* *CPM* WILL UPDATE THIS FIELD TO THE ACTUAL NUMBER
* OF SERVICE CLASSES RETURNED.
* *STAT* = ERROR STATUS. THIS MUST BE ZERO ON THE
* CALL. VALUES RETURNED BY *CPM* ARE -
* 0 = NO ERROR.
* 1 = INCORRECT LENGTH. (LENGTH = 0)
* 2 = INCORRECT ORIGIN TYPE.
* 3 = COMPLETE BIT SET.
* *C* = COMPLETE BIT. MUST BE ZERO ON CALL. *CPM* WILL
* SET TO ONE ON COMPLETION OF PROCESSING.
* *SC* = TWO CHARACTER DISPLAY CODE SERVICE CLASS MNEMONIC.
* *IN* = LOWER BOUND PRIORITY FOR INPUT FILES IN THIS
* SERVICE CLASS.
* *EX* = UPPER BOUND PRIORITY FOR EXECUTING JOBS IN THIS
* SERVICE CLASS.
* *OUT* = LOWER BOUND PRIOTITY FOR OUTPUT FILES IN THIS
* SERVICE CLASS.
*
* EXIT INFORMATION RETURNED TO PARAMETER BLOCK.
*
* USES T3, T4, T5, T6, T7, BA - BA+4, CM - CM+4, CN - CN+4,
* FN - FN+4.
*
* CALLS CKA.
*
* MACROS NFA, SFA.
RSC ENTRY
LDN 0 GET FIRST WORD OF PARAMETER BLOCK
STD T1
RJM CKA CHECK ADDRESS
CRD CM
LDD CM+4
SHN 21-0
PJN RSC3 IF COMPLETE BIT NOT SET
LDN 3 SET ERROR STATUS
RSC1 SHN 1
ADN 1 SET COMPLETE BIT
STD CM+4
RJM CKA UPDATE FIRST WORD OF BLOCK
CWD CM
LJM CPMX RETURN
RSC2 LDN 1 INCORRECT BUFFER LENGTH
UJN RSC1 SET ERROR STATUS
RSC3 LDD CM+3 CHECK LENGTH PARAMETER
ZJN RSC2 IF NO BUFFER SPACE ALLOCATED
STD T1
STD T2
RJM CKA CHECK ADDRESS
LDD CM+2 CHECK ORIGIN TYPE
STD T3
SBN PLSC
MJN RSC5 IF VALID ORIGIN TYPE
RSC4 LDN 2
UJN RSC1 SET ERROR STATUS
RSC5 LDK JBCP GET *SCT* ENTRY
CRD CM
LDD CM
SHN 14
ADD CM+1
ADD T3
CRD CN
LDN MXJC SET MAXIMUM NUMBER OF CLASSES TO RETURN
SBD T2
PJN RSC6 IF LESS THAN MAXIMUM TO BE RETURNED
LDN MXJC RESET NUMBER OF SERVICE CLASSES TO RETURN
STD T2
RSC6 LDN 0
STD T3 INITIALIZE SERVICE CLASS INDEX
STD T6
LDN 1
STD T4 INITIALIZE BUFFER INDEX
LDN 2+1 SET BYTE INDEX FOR VALIDATION MASK
STD T5
LCN 12D
RSC7 ADN 12D RESET SERVICE CLASS INDEX
RAD T6
STD T3
SOD T5
MJP RSC10 IF END OF MASK
NFA SCVN GET VALIDATION MASK
CRD CM
LDM CN+2,T5 GET BITS FOR VALID SERVICE CLASSES
STM RSCA
LDM CM+2,T5
LPC 0
RSCA EQU *-1 (*SCT* VALIDATION BITS)
STD CN
RSC8 LDD CN
ZJN RSC7 IF END OF SERVICE CLASSES
SHN 21
STD CN
PJN RSC9 IF SERVICE CLASS NOT ALLOWED
SFA JCB,T3 GET PRIORITIES
ADK INQT
CRD BA
ADK EXQT-INQT
CRD FN
ADN OTQT-EXQT
CRD UN
LDN ZERL
CRD CM
LDM TSCM,T3 SET SERVICE CLASS
STD CM
LDD UN+1 SET OUTPUT FILE PRIORITY
STD CM+4
LDD FN+2 SET EXECUTING JOB PRIORITY
STD CM+3
LDD BA+1 SET INPUT FILE PRIORITY
STD CM+2
RJM CKA ENTER INTO BUFFER
ADD T4
CWD CM
AOD T4 INCREMENT BUFFER INDEX
LDD T2
SBD T4
MJN RSC10 IF BUFFER FULL
RSC9 AOD T3 INCREMENT SERVICE CLASS INDEX
SBN MXJC
MJP RSC8 IF MORE SERVICE CLASSES TO PROCESS
* COMPLETE PROCESSING.
RSC10 LDN 0 GET FIRST WORD OF BLOCK
STD T1
RJM CKA
CRD CM
SOD T4 SET NUMBER OF CLASSES RETURNED
STD CM+3
LDN 1 SET COMPLETE BIT / CLEAR ERROR STATUS
STD CM+4
RJM CKA
CWD CM
LJM CPMX RETURN
TSCM SPACE 4
** TSCM - TABLE OF SERVICE CLASS MNEMONICS.
TSCM INDEX
LIST D
.SCL HERE
LIST *
INDEX MXSC
ERRMSG SPACE 4,20
*** FUNCTION 135.
*
* ENABLE/DISABLE TERMINAL ERROR MESSAGES.
*
* ENABLE OR DISABLE THE ECHOING OF *MS1W*/*MS2W*
* ERROR MESSAGES TO THE TERMINAL BY *1RO*. ERROR MESSAGE
* ECHOING CAN ONLY BE DISABLED FOR THE DURATION OF A
* *CCL* PROCEDURE. ERROR MESSAGE PROCESSING REVERTS TO
* NORMAL AFTER THE *CCL* PROCEDURE IS COMPLETED AND THE
* USER RETURNS TO INTERACTIVE COMMAND MODE.
*
* ENTRY (IR+3 - IR+4) = ADDR.
*T ADDR 59/0,1/F
* F=0, IF TERMINAL ERROR MESSAGES TO BE ENABLED.
* F=1, IF TERMINAL ERROR MESSAGES TO BE DISABLED.
*
* EXIT TERMINAL ERROR MESSAGES ENABLED/DISABLED.
*
* USES CM - CM+4, CN - CN+4.
*
* CALLS CKA.
ERM ENTRY
RJM CKA GET ADDRESS OF VALUE
CRD CM
LDD CP CLEAR OLD VALUE OF ERROR MESSAGE FLAG
ADK CSPW
CRD CN
LDD CN
SCN 40
STD CN
LDD CM+4 SET NEW VALUE OF ERROR MESSAGE FLAG
LPN 1
SHN 5-0
RAD CN
LDD CP
ADK CSPW
CWD CN
LJM CPMX RETURN
ACP SPACE 4,20
*** FUNCTION 140.
*
* ASSIGN A CONCURRENT PP TO THE CONTROL POINT.
*
* ENTRY (IR+3 - IR+4) = PARAMETER BLOCK ADDRESS.
*
* PARAMETER BLOCK FORMAT.
*
*T ADDR 36/ 0, 12/ CCH, 11/ STAT, 1/C
*T,ADDR+1 60/ RA+1 CALL
*
* CCH = CONCURRENT CHANNEL REQUIRED BY THE CPP.
* STAT = STATUS REPLY,
* 0, IF CPP ASSIGNED.
* 1, IF CPP NOT ASSIGNED.
* C = COMPLETION BIT.
* RA+1 CALL = CPP *IR* REGISTER IMAGE.
*
* USES T1, CM - CM+4, CN - CN+4, FN - FN+4.
*
* CALLS CKA.
ACP4 ABORT ERCI * CPM - HARDWARE DOES NOT SUPPORT CPP-S.*
ACP ENTRY
LDK CPPL CHECK FOR CPP-S DEFINED
CRD CM
LDD CM+3
LPN 77
ZJN ACP4 IF NO CPP-S DEFINED
LDN 0 READ PARAMETER BLOCK
STD T1
RJM CKA
CRM CN,ON
CRD FN
LDD FN+1
LPN 20
ZJN ACP1 IF RECALL BIT NOT SET
LDD FN+1 MOVE RECALL BIT
SCN 60
LMN 40
STD FN+1
LDD IR+1 CLEAR RECALL BIT FOR *CPM* CALL
SCN 40
STD IR+1
ACP1 LDD MA SET UP CPP CALL
CWD FN
LDN 1 SELECT NO QUEUEING
STD CM+1
LDD CN+3
SCN 40
STD CM+4
LDN 4 COMPUTE CPP BARREL SELECT
SBD CM+4
SHN 0-21
ADN 2
STD CM+4
MONITOR CPRM REQUEST A CONCURRENT PP
LDD CM+1
NJN ACP2 IF CPP ASSIGNED
LDN 2
RAD CN+4
UJN ACP3 RETURN ERROR STATUS
ACP2 LDD IA REWRITE INPUT REGISTER
CWD IR
ACP3 AOD CN+4 SET COMPLETE BIT
RJM CKA RETURN RESPONSE
CWD CN
LJM CPMX EXIT
PAM SPACE 4,20
*** FUNCTION 141.
* RETURN PRIVILEGED ANALYST STATUS.
*
* ENTRY (IR+3 - IR+4) = STATUS RETURN ADDRESS.
*
* EXIT IF STATUS RETURN ADDRESS SPECIFIED -
* (ADDR) = 48/0, 12/STATUS
* STATUS = 0, IF USER HAS *CPAM* VALIDATION
* AND IF *PRIVILEGED ANALYST MODE*
* IS ENABLED.
* STATUS .NE. 0 OTHERWISE.
*
* IF STATUS RETURN ADDRESS NOT SPECIFIED -
* USER JOB ABORTED, IF USER DOES NOT HAVE *CPAM*
* VALIDATION OR IF *PRIVILEGED ANALYST MODE*
* IS DISABLED.
PAM ENTRY
LDN ZERL CLEAR REPLY
CRD CN
RJM VPA VALIDATE PRIVILEGED ANALYST
STD CN+4 SAVE STATUS
LDD IR+3
LPN 37
SHN 14
LMD IR+4
ZJN PAM2 IF NO ADDRESS SPECIFIED
RJM CKA CHECK ADDRESS
CWD CN RETURN STATUS
PAM1 LJM CPMX EXIT
PAM2 LDD CN+4
ZJN PAM1 IF PRIVILEGED ACCESS ALLOWED
ABORT ERIU * CPM - USER ACCESS NOT VALID.*
GSL SPACE 4,20
*** FUNCTION 142.
* GET SYSTEM LIBRARY STATUS.
*
* ENTRY (IR+3 - IR+4) = PARAMETER WORD ADDRESS.
* (ADDR) = 42/LIBRARY NAME, 18/0
*
* EXIT (ADDR) = 42/LIBRARY NAME, 17/, 1/STATUS
* STATUS = 1, IF *LIBRARY NAME* IS PRESENT IN
* SYSTEM LIBRARY DIRECTORY, AND
* LIBRARY ORDINAL IS IN RANGE.
* STATUS = 0, OTHERWISE.
GSL ENTRY
RJM CKA CHECK ADDRESS
CRD FN READ LIBRARY NAME
RJM LBD SEARCH LIBRARY DIRECTORY
ZJN GSL1 IF NOT VALID LIBRARY
LDN 1 SET *LIBRARY FOUND* STATUS
GSL1 STD FN+4 SET STATUS
RJM CKA CHECK ADDRESS
CWD FN RETURN STATUS
LJM CPMX EXIT
GSC SPACE 4,10
*** FUNCTION 143.
* GET *SHELL* PROCESSING CONTROLS.
*
* THIS FUNCTION GETS THE *SHELL* PROCESSING CONTROLS FROM
* THE USER-S NFL AND RETURNS THEM TO THE USER. SEE FUNCTION
* 113 (*SSC*) FOR THE FORMAT OF *SHELL* PROCESSING CONTROLS.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF WORD TO RECEIVE
* *SHELL* PROCESSING CONTROLS.
GSC ENTRY
NFA SHCN GET *SHELL* CONTROL FROM NFL
CRD CN
RJM CKA COPY CONTROLS TO USER
CWD CN
LJM CPMX EXIT
SIC SPACE 4,30
*** FUNCTION 144.
* SET INTER-CONTROL POINT COMMUNCIATION CONTROLS.
*
* ENTRY (IR+3 - IR+4) = PARAMETER WORD ADDRESS.
*
* EXIT INTER-CONTROL POINT COMMUNICATION CONTROLS UPDATED.
*
* PARAMETER WORD FORMAT.
*
*T ADDR 1/T,11/ RES,6/ LEN0,18/ ADD0,6/ LEN1,12/ ADD1
*
* T *TDAM* FUNCTION WRITE CONTROL.
* 0 = DISABLE *TDAM* WRITES TO SUBSYSTEM.
* 1 = ENABLE *TDAM* WRITES TO SUBSYSTEM.
* RES RESERVED FOR CDC.
* LEN0 LENGTH - 1 OF BUFFER 0.
* ADD0 ADDRESS OF BUFER 0.
* LEN1 LENGTH - 1 OF BUFFER 1.
* ADD1 ADDRESS OF BUFER 1.
SIC ENTRY
LDD CP CHECK IF CALLER IS A SUBSYSTEM
ADK JCIW
CRD CM
LDC LSSI
SBD CM+2
MJN SIC1 IF SUBSYSTEM
ABORT ERAE * CPM - ARGUMENT ERROR.*
SIC1 RJM CKA READ PARAMETER WORD
CRD CM
LDN CM+1 SET BUFFER 0
RJM CBA CHECK BUFFER ADDRESS
LDN CM+3 SET BUFFER 1
RJM CBA CHECK BUFFER ADDRESS
LDD CM
LPC 4000 SET *TDAM* WRITE CONTROL
STD CM
NFA ICAN WRITE INTER-CP CONTROLS TO NFL
CWD CM
LJM CPMX EXIT
GTD SPACE 4,55
*** FUNCTION 145.
* GET TAPE DEFAULTS.
*
* ENTRY (IR+3 - IR+4) = PARAMETER BLOCK ADDRESS.
*
* EXIT TAPE DEFAULT VALUES RETURNED TO PARAMETER BLOCK.
*
* PARAMETER BLOCK ON EXIT.
*
*T ADDR 30/ RES,3/JCV,2/JD,1/R,3/JMD,3/JND,18/ RES
*T, 30/ RES,3/SCV,2/SD,1/R,3/SMD,3/SND,18/ RES
*
* RES RESERVED FOR CDC.
* JCV JOB DEFAULT CONVERSION MODE FOR 9 TRACK AND CARTRIDGE
* TAPE.
* 2 = ASCII.
* 3 = EBCDIC.
* JD JOB DEFAULT TAPE DEVICE TYPE.
* 0 = MT.
* 1 = CT.
* 2 = NT.
* 3 = AT.
* JMD JOB DEFAULT MT TAPE DENSITY.
* 1 = 556 BPI.
* 2 = 200 BPI.
* 3 = 800 BPI.
* RES RESERVED FOR CDC.
*
* RES RESERVED FOR CDC.
* JND JOB DEFAULT NT TAPE DENSITY.
* 3 = 800 BPI.
* 4 = 1600 BPI.
* 5 = 6250 CPI.
* SCV SYSTEM DEFAULT CONVERSION MODE FOR 9 TRACK AND
* CARTRIDGE TAPE.
* 2 = ASCII.
* 3 = EBCDIC.
* SD SYSTEM DEFAULT TAPE DEVICE TYPE.
* 0 = 7 TRACK.
* 1 = CARTRIDGE.
* 2 = 9 TRACK.
* 3 = ACS CARTRIDGE.
* SMD SYSTEM DEFAULT MT TAPE DENSITY.
* 1 = 556 BPI.
* 2 = 200 BPI.
* 3 = 800 BPI.
* SND SYSTEM DEFAULT NT TAPE DENSITY.
* 3 = 800 BPI.
* 4 = 1600 BPI.
* 5 = 6250 CPI.
* RES RESERVED FOR CDC.
GTD ENTRY
NFA TDFN GET JOB TAPE DEFAULTS
CRD CM
LDK IPRL GET SYSTEM TAPE DEFAULTS
CRD BA
LDN ZERL CLEAR ASSEMBLY
CRD CN
LDD BA+3
LPN 7
SHN 3
STD CN+2 SET SYSTEM DEFAULT CONVERSION MODE
LDD BA+4
LPN 60
SHN -3
RAD CN+2 SET SYSTEM DEFAULT DEVICE TYPE
LDD BA+4
LPN 3
SHN 11
STD CN+3 SET MT TAPE DEFAULT DENSITY
LDD BA+4
LPC 700
RAD CN+3 SET NT TAPE DEFAULT DENSITY
LDN 1 SET WORD COUNT
STD T1
RJM CKA SET PARAMETER BLOCK ADDRESS
CWD CM WRITE JOB TAPE DEFAULTS
ADN 1 WRITE SYSTEM TAPE DEFAULTS
CWD CN
LJM CPMX EXIT
STD SPACE 4,30
*** FUNCTION 146.
* SET TAPE DEFAULTS FOR JOB.
*
* ENTRY (IR+3 - IR+4) = PARAMETER BLOCK ADDRESS.
*
* EXIT JOB TAPE DEFAULTS SET.
*
* PARAMETER BLOCK FORMAT.
*
*T ADDR 30/ RES,3/CVM,2/DT,1/R,3/MTD,3/NTD,18/ RES
*
* RES RESERVED FOR CDC.
* CVM CONVERSION MODE FOR 9 TRACK AND CARTRIDGE TAPE.
* 2 = ASCII.
* 3 = EBCDIC.
* DT TAPE DEVICE TYPE.
* 0 = 7 TRACK.
* 1 = CARTRIDGE.
* 2 = 9 TRACK.
* 3 = ACS CARTRIDGE.
* MTD MT TAPE DENSITY.
* 1 = 556 BPI.
* 2 = 200 BPI.
* 3 = 800 BPI.
* NTD NT TAPE DENSITY.
* 3 = 800 BPI.
* 4 = 1600 BPI.
* 5 = 6250 CPI.
* RES RESERVED FOR CDC.
STD ENTRY
RJM CKA GET PARAMETERS
CRD CM
LDN ZERL CLEAR ASSEMBLY
CRD CN
LDD CM+2
LPN 76
STD CN+2 SET CONVERSION MODE AND DEVICE TYPE
SHN -3
SBN 2
MJN STD1 IF INCORRECT CONVERSION MODE
SBN 4-2
PJN STD1 IF INCORRECT CONVERSION MODE
LDD CM+3
LPC 7700
STD CN+3 SET 7 AND 9 TRACK DENSITY
SHN -11
ZJN STD1 IF INCORRECT 7 TRACK DENSITY
SBN 4
PJN STD1 IF INCORRECT 7 TRACK DENSITY
LDD CM+3
SHN -6
LPN 7
SBN 3
MJN STD1 IF INCORRECT 9 TRACK DENSITY
SBN 6-3
PJN STD1 IF INCORRECT 9 TRACK DENSITY
NFA TDFN UPDATE JOB TAPE DEFAULTS
CWD CN
LJM CPMX EXIT
STD1 ABORT ERAE * CPM - ARGUMENT ERROR.*
GFN SPACE 4,15
*** FUNCTION 147.
* GET FAMILY ORDINAL AND FAMILY NAME.
*
* ENTRY (IR+3 - IR+4) = STATUS WORD ADDRESS.
*
* EXIT FAMILY ORDINAL AND FAMILY NAME RETURNED TO STATUS
* WORD.
*
* STATUS WORD FORMAT.
*
*T ADDR 42/ FAMN,6/ 0,12/ FAMO
*
* FAMN FAMILY NAME (0 IF NO FAMILY).
* FAMO FAMILY ORDINAL (0 IF NO FAMILY).
GFN ENTRY
LDN ZERL CLEAR FAMILY NAME AND ORDINAL
CRD FN
LDD CP
ADK PFCW GET FAMILY EST ORDINAL
CRD CM
LDD CM+3
ZJN GFN1 IF NO FAMILY
SFA EST
ADK EQDE GET MST ADDRESS
CRD CM
LDD CM+4
SHN 3
ADK PFGL GET FAMILY NAME
CRD FN
RJM GFO GET FAMILY ORDINAL
GFN1 LDN 0 SET WORD COUNT - 1
STD T1
RJM CKA CHECK ADDRESS
CWD FN RETURN FAMILY NAME AND FAMILY ORDINAL
LJM CPMX EXIT
TITLE SUBROUTINES.
CBA SPACE 4,10
** CBA - CHECK INTER-CONTROL POINT BUFFER ADDRESS.
*
* ENTRY (A) = ADDRESS OF BUFFER POINTERS.
*
* EXIT TO CALLER IF NO ERROR.
* TO *ABT* IF BUFFER POINTER ERROR.
*
* USES T1, T2.
*
* MACROS ABORT.
CBA SUBR ENTRY/EXIT
STD T1 SET BUFFER POINTERS ADDRESS
LDI T1
SHN -6
STD T2 SET BUFFER LENGTH - 1
LDI T1 SET BUFFER ADDRESS
LPN 77
SHN 14
LMM 1,T1
ZJN CBA1 IF NO BUFFER DEFINED
MJN CBA2 IF BUFFER ADDRESS ERROR
ADD T2
SHN -6
SBD FL
MJN CBAX IF BUFFER WITHIN FL
UJN CBA2 ABORT
CBA1 LDD T2
ZJN CBAX IF NO BUFFER LENGTH DEFINED
CBA2 ABORT ERAE * CPM - ARGUMENT ERROR.*
LBD SPACE 4,15
** LBD - SEARCHES THE LIBRARY DIRECTORY FOR A SPECIAL ENTRY.
*
* ENTRY (FN - FN+4) = LIBRARY NAME LEFT JUSTIFIED.
*
* EXIT (A) = NONZERO - MATCH FOUND.
* (T4) = INDEX + 1 IN LBD.
* (T4) = 0 - IF NO MATCH.
* (T4) AND (T8) = ERROR MESSAGE BIAS IF MATCH FOUND BUT
* ORDINAL OUT OF RANGE.
*
* USES T4, T8, CM - CM+4, CN - CN+4.
*
* CALLS CFN.
LBD3 STD T4 CLEAR ENTRY COUNT, ERROR MESSAGE BIAS
STD T8
LBD SUBR ENTRY/EXIT
LDN 1 INITIAL ENTRY COUNT IN *TLBD*
STD T4
LDK LBDP READ LBD POINTER
CRD CM
LDD CM+2
UJN LBD2 ENTER LOOP
LBD1 AOD T4 INCREMENT ENTRY NUMBER
LDN 2 ADVANCE LBD ADDRESS
RAD CM+2+1
SHN -14
RAD CM+2
LBD2 SHN 14 READ LBD ENTRY
ADD CM+2+1
CRD CN
LDD CN CHECK FOR MATCH
ZJN LBD3 IF END OF LBD
RJM CFN COMPARE FILE NAMES
NJN LBD1 IF NO MATCH
LDD T4
SBN 77
MJN LBDX IF ORDINAL IN RANGE
LDN SLSG-SLSD SET ERROR MESSAGE BIAS
STD T4
LDN SLSF-SLSC
STD T8
LDN 0 SET NO MATCH
UJN LBDX RETURN
RLN SPACE 4,10
** RLN - RETURN LIBRARY NAME TO USER PROGRAM.
*
* ENTRY (BA - BA+1) = RETURN ADDRESS PARAMETER.
* (FN - FN+4) = LIBRARY NAME.
*
* EXIT (BA - BA+1) ADVANCED.
*
* MACROS ABORT.
RLN1 LDD BA RETURN LIBRARY NAME
LPN 77
SHN 6
ADD RA
SHN 6
ADD BA+1
CWD FN
AOD BA+1 INCREMENT RETURN ADDRESS
SHN -14
RAD BA
RLN SUBR ENTRY/EXIT
LDD BA VERIFY RETURN ADDRESS
LPN 77
SHN 14
LMD BA+1
SHN -6
SBD FL
MJN RLN1 IF .LT. FL
ABORT ERAE * CPM - ARGUMENT ERROR.*
RLW SPACE 4,10
** RLW - READ LIBRARY NAME FROM USER PROGRAM.
*
* ENTRY (BA - BA+1) = ADDRESS OF NEXT LIBRARY NAME.
*
* EXIT (A) = ZERO IF END OF LIBRARY LIST.
* (BA - BA+1) ADVANCED IF NOT END OF LIST.
* (FN - FN+4) = LIBRARY NAME.
*
* MACROS ABORT.
RLW1 LDD BA READ LIBRARY NAME
LPN 77
SHN 6
ADD RA
SHN 6
ADD BA+1
CRD FN
LDD FN
ZJN RLWX IF END OF LIBRARY LIST
LDD FN+3 CLEAR UNUSED FIELDS
SCN 77
STD FN+3
LDN 0
STD FN+4
AOD BA+1 INCREMENT RETURN ADDRESS
SHN -14
RAD BA
LDD FN
RLW SUBR ENTRY/EXIT
LDD BA VERIFY PARAMETER ADDRESS
LPN 77
SHN 14
LMD BA+1
SHN -6
SBD FL
MJN RLW1 IF .LT. FL
ABORT ERAE * CPM - ARGUMENT ERROR.*
SPACE 4,10
** COMMON DECKS.
SSJ$ EQU 1 SET *SSJ* CHECKING FOR *COMPCUA*
QUAL$ EQU 1 SET TO NOT QUALIFY COMMON DECKS
*CALL COMPACS
*CALL COMPCUA
FS EQU UN DEFINE VALUE FOR *COMPSAF*
*CALL COMPSAF
GFO$ EQU 1 ASSEMBLE *GFO*
DFF$ EQU 1 DO NOT ASSEMBLE FOT UPDATE CODE
*CALL COMPUFT
*CALL COMPVPA
SPACE 4,10
** BUFFER DEFINITIONS.
TLBD EQU * LOADER CONTROL/LIBRARY NAMES
TLBDL EQU 3*5
LB2T EQU TLBD+TLBDL *LB2W* (SECOND USER LIBRARY)
LB3T EQU LB2T+5 *LB3W* (FIRST USER LIBRARY)
BUFL EQU LB3T+5 LWA+1 OF BUFFERS
ERRNG 7777-BUFL BYTES LEFT IN OVERLAY
SPACE 4,10
OVERFLOW OVL
OVERLAY (*L* DISPLAY FUNCTIONS.)
SPACE 4,10
* *DSDOUT*/*DSDINP* STATUS SYMBOLS.
* (THESE SYMBOLS ARE PROCESSED BY *CPM* FUNCTIONS *TDC* AND
* *TDU*.)
NERR EQU 0 NO ERROR
NBUF EQU 1 NO *L* DISPLAY BUFFER DEFINED IN CMR
NINL EQU 2 *L* DISPLAY NOT INTERLOCKED
NDBF EQU 3 DISPLAY BUFFER IN FL TOO LARGE
NCMD EQU 4 NO COMMAND ENTERED
NCBF EQU 5 COMMAND BUFFER IN FL TOO SMALL
SPACE 4,10
** DIRECT LOCATION ASSIGNMENTS.
*CM+5 EQU CM+4+1 SCRATCH
TDC SPACE 4,30
*** FUNCTION 102.
* TRANSFER DATA FROM UTILITY FL TO BUFFER IN CMR.
*
* ENTRY (IR+3 - IR+4) = FWA OF DISPLAY BUFFER IN FL OF
* UTILITY.
*
* CALLS CKA, CKR, DJI.
*
* THE FORMAT OF THE DISPLAY BUFFER IN THE USER-S FL
* IS AS FOLLOWS:
*
*T 12/N,1/S,1/F,1/A,45/0
*T, 60/DATA
*T, 60/DATA
*T, 60/0
*
* CONTROL WORD OPTIONS ARE DEFINED AS FOLLOWS.
*
* *N* NUMBER OF WORDS IN THE BUFFER. BUFFER
* IS TERMINATED WHEN EITHER *N* WORDS ARE
* TRANSFERRED OR THE ZERO TERMINATOR IS REACHED.
* *S* CHARACTER SIZE.
* 0 = SMALL CHARACTER SIZE.
* 1 = MEDIUM CHARACTER SIZE.
* *F* DATA FORMAT.
* 0 = PROGRAM FORMAT.
* 1 = CODED FORMAT.
* *A* LINE SPACING.
* 0 = SINGLE SPACING (10D OR 20D POSITIONS/LINE).
* 1 = WIDE SPACING (15D OR 30D POSITIONS/LINE).
TDC ENTRY ENTRY
RJM CKR CHECK ADDRESS
LDSY IFEQ LDSY,0
LDN 2*NBUF+1 SET BUFFER UNDEFINED STATUS
STD T5
LDSY ELSE
TDC1 RJM DJI DETERMINE IF *L* DISPLAY INTERLOCKED
* TRANSFER DATA FROM USER-S FL.
LDN 2*NERR+1 SET COMPLETE STATUS
STD T5
LDD T1 STORE NUMBER OF WORDS TO TRANSFER
STD CM
ZJN TDC3 IF NO WORDS TO TRANSFER
ADC -LDSY-1
MJN TDC2 IF DISPLAY BUFFER .GE. WORDS TO TRANSFER
LDC LDSY
STD CM
LDN 2*NDBF+1 SET BUFFER TOO LARGE STATUS
STD T5
TDC2 RJM CKA READ BUFFER TO BE DISPLAYED
ADN 1
CRM TDCB,CM
LDD CM SAVE NUMBER OF BYTES TO TRANSFER
SHN 2
ADD CM
TDC3 STD T7
ADN 2*5 ADD TWO WORDS OF ZEROS
STD T0
TDC4 LDN 0
STM TDCB,T7
AOD T7
LMD T0
NJN TDC4 IF BUFFER NOT ZERO FILLED
* DETERMINE FWA DISPLAY BUFFER AND WRITE DATA TO CMR.
LDN 2
RAD CM ADJUST WORD COUNT FOR TERMINATOR
LDD CM+3 WRITE DATA TO CMR BUFFER
SHN 14
LMD CM+4
CRD FN SAVE *L* DISPLAY BUFFER CONTROL WORD
ADN LCOM+1
CWM TDCB,CM
* DETERMINE TITLE AND WRITE IT TO CMR.
RJM CKA GET FWA OF DISPLAY BUFFER
CRD BA
LDN 2
STD T7
LDD RA GET COMMAND NAME
SHN 6
ADK PGNR
CRM TDCB,ON
LDM TDCB+3
SCN 77
STM TDCB+3
LDN 0
STM TDCB+4
LDD BA+2 CHECK FOR PROGRAM-SUPPLIED TITLE
LPN 77
SHN 14
LMD BA+3
ZJN TDC4.1 IF NO TITLE
MJN TDC4.1 IF TITLE ADDRESS IS OUT OF RANGE
ADN 1
SHN -6
SBD FL
PJN TDC4.1 IF TITLE ADDRESS IS OUT OF RANGE
LDD BA+2 READ TITLE FROM PROGRAM
LPN 77
SHN 6
ADD RA
SHN 6
ADD BA+3
CRM TDCB,T7
TDC4.1 LDD CM+3 WRITE TITLE TO CMR BUFFER
SHN 14
LMD CM+4
ADK 1+LCOM+LDSY+2
CWM TDCB,T7
* UPDATE *L* DISPLAY CONTROL WORD BITS.
LDD BA+1 STORE CHARACTER SIZE AND FORMAT
SHN -12
STM TDCA+4
LDD BA+1 STORE LINE SPACING OPTION
SHN -11
LPN 1
STM TDCAA+4
LDN 4 STORE NUMBER OF OPTIONS TO PROCESS
STD CM+1
LDN 0
STD CM+2
LDD FN+4 DETERMINE IF *L* DISPLAY DATA AVAILABLE
SHN 21-3
PJN TDC5 IF *L* DISPLAY DATA NOT AVAILABLE
SOD CM+1 STORE NUMBER OF OPTIONS TO PROCESS
TDC5 LDD MA
CWM TDCA,CM+1
MONITOR UTEM UPDATE CONTROL BITS
LDSY ENDIF
* STORE STATUS IN USER-S FL.
RJM CKA
CWD T1
LJM CPMX RETURN
SPACE 4,10
* *UTEM* BUFFER.
TDCA VFD 1/0,5/0,6/2,6/1,6/0 SET CHARACTER SIZE AND FORMAT
CON 0,0,0
TDCAA VFD 1/0,5/0,6/1,6/6,6/0 SET WIDE LINE SPACING
CON 0,0,0
VFD 1/0,5/0,6/1,6/3,6/0 SET DATA AVAILABLE
CON 0,0,1
VFD 1/0,5/0,6/1,6/0,6/0 SET *L* DISPLAY REQUESTED
CON 0,0,1
SPACE 4,10
* USE OF THIS BUFFER DESTROYS THE REMAINDER OF THE
* OVERLAY INCLUDING SOME COMMONLY USED SUBROUTINES.
SPACE 4,10
TDCB EQU * *L* DISPLAY DATA TRANSFER BUFFER
ERRPL TDCB+5*LDSY-7777-5-5 BUFFER OVERFLOW
TDU SPACE 4,25
*** FUNCTION 103.
* TRANSFER DATA FROM CMR BUFFER TO USER-S FL.
*
* ENTRY (IR+3 - IR+4) = FWA OF DISPLAY BUFFER IN
* FL OF UTILITY. IF BIT 11 OF IR+3 IS SET,
* THEN JSN WILL BE CLEARED.
*
* CALLS CKA, CKR, DJI.
*
* THE FORMAT OF THE COMMAND BUFFER IN THE USER-S FL
* IS AS FOLLOWS.
*
*T 12/N,48/0
*T, 60/0
*T, 60/0
*T, 60/0
*
* CONTROL WORD OPTION IS DEFINED AS FOLLOWS.
*
* *N* NUMBER OF WORDS IN THE BUFFER. BUFFER LENGTH
* MUST BE AT LEAST HALF THE SIZE OF THE CMR COMMAND
* BUFFER.
TDU ENTRY ENTRY
LDD IR+3 STORE CLEAR INTERLOCK FLAG
STD T6
LPN 77
STD IR+3
RJM CKR CHECK IF ADDRESS IS WITHIN RANGE
RJM DJI DETERMINE IF *L* DISPLAY INTERLOCKED
LCOM IFEQ LCOM,0
LDN 2*NBUF+1 SET BUFFER UNDEFINED STATUS
LCOM ELSE
LDD T6 CHECK CLEAR INTERLOCK FLAG
SHN 21-6
PJN TDU2 IF NOT CLEARING INTERLOCK
* CLEAR JSN FIELD, INPUT REQUESTED, AND COMMAND ENTERED BITS.
LDN 0
STD CM+2
LDN 2 STORE NUMBER OF OPTIONS TO PROCESS
STD CM+1
LDD MA
CWM TDUA,CM+1
MONITOR UTEM
LDN 2*NERR+1 SET COMPLETE STATUS
UJN TDU4 RETURN STATUS
* IF COMMAND NOT ENTERED SET PROGRAM REQUEST INPUT BIT.
TDU2 LDD BA+4 CHECK IF COMMAND HAS BEEN ENTERED
SHN 21-5
MJN TDU3 IF COMMAND ENTERED
LDN 0 SET COMMAND REQUESTED
STD CM+2
LDN 2 STORE NUMBER OF OPTIONS TO PROCESS
STD CM+1
LDD MA
CWM TDUC,CM+1
MONITOR UTEM
LDN 2*NCMD+1 SET NO COMMAND STATUS
UJN TDU4 RETURN STATUS
* DETERMINE IF USER-S COMMAND BUFFER .GE. *LCOM*/2
TDU3 LDD T1
SHN 1
SBN LCOM
PJN TDU5 IF USER-S COMMAND BUFFER .GE. *LCOM*/2
LDN 2*NCBF+1 SET BUFFER TOO SMALL STATUS
TDU4 LJM TDU8 RETURN STATUS
* TRANSFER COMMAND BUFFER TO *CPM* BUFFER.
TDU5 LDN LCOM SET CMR COMMAND BUFFER LENGTH IN BYTES
STD BA
LDK LCOM*5
STD T6
LDD CM+3 READ UNPACKED DATA FROM CMR BUFFER
SHN 14
LMD CM+4
ADN 1
CRM CBUF,BA
LDN ZERL WRITE ZERO TERMINATOR
CRM CBUF+LCOM*5,ON
* PACK COMMAND BUFFER.
LDC CBUF SET ORIGIN ADDRESS
STD BA
STD FN SET DESTINATION ADDRESS
TDU6 LDI BA PACK CHARACTERS
SHN 6
LMM 1,BA
STI FN
ZJN TDU7 IF END OF DATA
LDN 2
RAD BA INCREMENT ORIGIN ADDRESS
TDU7 AOD FN INCREMENT DESTINATION ADDRESS
SOD T6
NJN TDU6 IF MORE DATA TO PACK
* TRANSFER DATA TO USER-S COMMAND BUFFER.
LDN LCOM+1
SHN -1
STD BA
RJM CKA WRITE COMMAND TO USER-S FL
ADN 1
CWM CBUF,BA
* CLEAR COMMAND AVAILABLE IN *L* DISPLAY BUFFER CONTROL WORD.
LDN 0
STD CM+2
LDN 1 STORE NUMBER OF OPTIONS TO PROCESS
STD CM+1
LDD MA
CWM TDUD,CM+1
MONITOR UTEM
* SEND MESSAGE TO SYSTEM DAYFILE.
* LDN 0
STM BUF+30B ASSURE A ZERO BYTE TERMINATOR
LDC 2RDS PLACE HEADER ON MESSAGE
STM BUF
LDC 2R,
STM BUF+1
LDC 2RL.
STM BUF+2
LDC BUF+NMSN
RJM DFM SEND MESSAGE TO SYSTEM DAYFILE
* SET STATUS TO CALLER.
LDN 2*NERR+1 SET COMPLETE STATUS
LCOM ENDIF
TDU8 STD T5
RJM CKA GET ABSOLUTE ADDRESS
CWD T1
LJM CPMX RETURN
SPACE 4,10
* *UTEM* BUFFER.
TDUA VFD 1/0,5/0,6/24D,6/36D,6/0 CLEAR JSN
CON 0,0,0
TDUB VFD 1/0,5/0,6/2,6/4,6/0 INPUT REQUEST/COMMAND ENTERED
CON 0,0,0
TDUC VFD 1/1,5/0,6/1,6/4,6/0 VERIFY INPUT NOT REQUESTED
CON 0,0,0
VFD 1/0,5/0,6/1,6/4,6/0 SET INPUT REQUESTED
CON 0,0,1
TDUD VFD 1/0,5/0,6/1,6/5,6/0 SET COMMAND ENTERED
CON 0,0,0
CKR SPACE 4,10
** CKR - CHECK IF BUFFER IN USER-S FL WITHIN RANGE.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF DISPLAY BUFFER.
*
* EXIT (T1 - T5) = FIRST WORD OF USER-S BUFFER.
*
* USES T1 - T5.
*
* CALLS CKA.
CKR SUBR ENTRY/EXIT
LDN 0
STD T1
RJM CKA CHECK ADDRESS
CRD T1
RJM CKA CHECK ADDRESS
UJN CKRX RETURN
DJI SPACE 4,20
** DJI - DETERMINE IF CALLING JOB HAS *L* DISPLAY INTERLOCKED.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF DISPLAY BUFFER.
* (T1 - T5) = FIRST WORD OF USER-S BUFFER.
*
* EXIT (BA - BA+4) = FIRST WORD OF CMR BUFFER.
* (CM+1 - CM+5) = *LDSP* WORD FROM CMR.
*
* ERROR TO *ABORT* IF THE USER PROGRAM DOES NOT HAVE THE
* JSN INTERLOCKED.
* (T5) = ERROR STATUS IF ERROR.
*
* USES T5, BA - BA+4, CM+1 - CM+5, FN - FN+4.
*
* CALLS CKA.
*
* MACROS ABORT, SFA.
DJI SUBR ENTRY/EXIT
LDC LDSP READ POINTER TO *L* DISPLAY BUFFER
CRD CM+1
LDD CM+3 READ *L* DISPLAY BUFFER CONTROL WORD
SHN 14
LMD CM+4
CRD BA
LDD CP READ JSN OF CALLING JOB
ADN TFSW
CRD FN
SFA EJT,FN GET JSN
ERRNZ JSNE CHECK IF WORD 0 OF EJT ENTRY
CRD FN
LDD FN COMPARE JSN
LMD BA
NJN DJI1 IF NO MATCH
LDD FN+1
LMD BA+1
ZJN DJIX IF JSN-S MATCH
DJI1 LDN 2*NINL+1 SET NOT INTERLOCKED STATUS
STD T5
RJM CKA
CWD T1
ABORT ERIU * CPM - USER ACCESS NOT VALID.*
SPACE 4,10
BUF DATA 0,0,0 HEAD ON MESSAGE
CBUF EQU * INPUT ASSEMBLY BUFFER
ERRPL CBUF+5*LCOM-7777-5 BUFFER OVERFLOW
SPACE 4,10
OVERFLOW OVL
TTL CPM - CONTROL POINT MANAGER.
SPACE 4,10
END