IDENT PFM,PFM
PERIPH
BASE MIXED
SST
EOR$ SET 0 UNCONDITIONAL POSITIONING IN *COMPRNS*
EQV$ SET 0 DON-T VERIFY EST ORDINAL IN SYSTEM SECTOR
QUAL$ SET 0 DEFINE UNQUALIFIED COMMON DECKS
MSR$ SET 0 ERROR PROCESSING RNS MASS STORAGE READS
IRA$ SET 0 EXTERNAL PRESET OF RANDOM ADDRESSING DECKS
SCA$ SET 0 SET NO REJECT ON *UNLOAD*
*COMMENT PFM - PERMANENT FILE MANAGER.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
TITLE PFM - PERMANENT FILE MANAGER.
SPACE 4,10
*** PFM - PERMANENT FILE MANAGER.
* R. A. LARSEN. 71/01/19.
* J. L. WARDELL. 72/07/14.
* S. L. BETH. 74/10/25.
* S. L. KSANDER. 75/02/20.
* W. B. CHAPIN. 79/04/27.
* P. C. SMITH. 79/04/27.
* M. D. LEMBCKE. 83/01/12.
* P. C. SMITH. 83/12/07.
* B. J. SALCEDO. 85/01/22.
SPACE 4,15
*** *PFM* IS A PERMANENT FILE DRIVER CAPABLE OF CREATING
* PERMANENT FILES ON ANY SYSTEM MASS STORAGE DEVICE. FILES
* MAY BE OF ANY LENGTH AND ARE ALLOCATED ON THE DEVICE
* ACCORDING TO THEIR LENGTH.
*
* *PFM* WILL PERFORM ALL THE NECESSARY TASKS TO COMPLETE THE
* PERMANENT FILE REQUEST. THESE TASKS ARE SEARCH, CREATE OR
* MODIFY USERS FILE CATALOG AND TRANSFER FILE FROM MASS
* STORAGE TO MASS STORAGE IF REQUIRED.
*
* *PFM* MAY BE CALLED BY ANY ROUTINE THAT SETS UP THE PROPER
* CALL BLOCK IN CENTRAL MEMORY.
QUAL SPACE 4,10
* DEFINE QUAL BLOCK ORDER.
QUAL PRS
QUAL 3PA
QUAL 3PB
QUAL 3PC
QUAL 3PD
QUAL 3PE
QUAL 3PF
QUAL 3PG
QUAL 3PH
QUAL 3PI
QUAL 3PJ
QUAL 3PK
QUAL 3PL
QUAL 3PM
QUAL 3PN
QUAL 3PO
QUAL 3PP
QUAL 3PQ
QUAL 3PR
QUAL 3PS
QUAL 3PT
QUAL 3PU
QUAL
SPFM SPACE 4,10
LIST F,X
*CALL COMSPFM
LIST *
SPACE 4,10
** ROUTINES USED.
*
* 0AV - ACCOUNT VERIFICATION.
* 0BF - BEGIN FILE.
* 0DF - DROP FILES.
* 0RF - UPDATE RESOURCE FILE.
TITLE MACRO DEFINITIONS.
SPACE 4,10
** MACROS.
COMPARE SPACE 4,15
** COMPARE - COMPARE TWO 36 BIT FIELDS.
*
* COMPARE X,Y
*
* ENTRY X = FIELD TO BE COMPARED WITH *PFC* ENTRY FIELD Y.
* Y = FIELD IN *PFC* ENTRY TO BE COMPARED WITH X.
* (CI) = *PFC* ENTRY BASE ADDRESS.
*
* EXIT (A) = ZERO IF FIELDS ARE IDENTICAL.
*
* CALLS COF.
*
* USES T1, T2, T3.
COMPARE MACRO X,Y
MACREF COMPARE
LDC X
STD T1
LDC Y
RJM COF
COMPARE ENDM
ERROR SPACE 4,25
** ERROR - CALL ERROR PROCESSOR.
*
* ERROR MNE,CH,IW,EQ,EXC,EI
*
* ENTRY MNE = ERROR MESSAGE MNEMONIC.
* CH = IF SET DO NOT RELEASE CHANNEL.
* IW = IF SET DO NOT CLEAR CATALOG INTERLOCK
* (DUMMY PARAMETER).
* EQ = IF SET, (EQ) = EST ORDINAL OF DEVICE FOR ERROR
* PROCESSING.
* IF CLEAR, (A) = EST ORDINAL.
* EXC = EXIT CASE FOR COMPLETION PROCESSING:
* 0 NORMAL ERROR PROCESSING (EP CONTROLLED).
* 1 TIME-DEPENDENT ROLLOUT (EP AND UP CONTROLLED).
* 2 PF-STAGE ROLLOUT (UP OR RT CONTROLLED).
* 3 UNCONDITIONAL ABORT.
* 4 TIME-DEPENDENT RECALL (EP AND UP CONTROLLED).
* 5 SECURITY VIOLATION ERROR PROCESSING.
* 6 TIME-DEPENDENT ROLLOUT (RT CONTROLLED).
* 7 ISSUE ERRLOG MESSAGE BUT DO NOT ABORT JOB.
* EI = IF SET, SET ERROR IDLE ON DEVICE GIVEN IN *EQ*.
*
* NOTES IF MODIFYING THIS MACRO, CHECK ALL CALLS TO IT.
ERROR MACRO MNE,CH,IW,EQ,EXC,EI
MACREF ERROR
.A IFC NE,$EQ$$
LDD EQ
.A ENDIF
RJM ERR
VFD 3/EXC,7//ERRMSG/MNE,1/EI,1/CH
ERROR ENDM
ERRMSG SPACE 4,10
** ERRMSG - SETUP ERROR MESSAGE CONSTANTS.
*
*NUM ERRMSG CLASS,MSG
*
* ENTRY *NUM* = ERROR CODE MNEMONIC.
* *CLASS* = ERROR TYPE FOR MESSAGE PROCESSING.
* *MSG* = ERROR MESSAGE INCLOSED IN PARENTHESIS.
NOREF .LEN
MACRO ERRMSG,NUM,CLASS,MSG
MACREF ERRMSG
INDEX /ERRMSG/NUM,CLASS
ERRMT RMT
INDEX /ERRMSG/NUM,(=C*MSG*)
ERRMT RMT
.MSGM MICRO 1,,*MSG*
.LEN MICCNT .MSGM
.A IFEQ CLASS,0
ERRNG 29D-.LEN MESSAGE TOO LONG
.A ELSE
ERRNG 38D-.LEN MESSAGE TOO LONG
.A ENDIF
ENDM
EXIT SPACE 4,15
** EXIT - CALL ERROR PROCESSING FOR SPECIAL (NON-ABORT) EXIT.
*
* EXIT MNE,CH,IW,EQ,EXC,EI
*
* SEE *ERROR* MACRO FOR EXPLANATION OF PARAMETERS.
EXIT MACRO MNE,CH,IW,EQ,EXC,EI
MACREF EXIT
.A IFC NE,$EQ$$
LDD EQ
.A ENDIF
RJM ERR
VFD 3/EXC,7//ERRMSG/MNE,1/EI,1/CH
EXIT ENDM
OVERLAY SPACE 4,10
** OVERLAY CONTROL.
.N SET 0
OVLB MICRO 1,, 3P BASE OVERLAY NAME
OVERLAY SPACE 4,10
** OVERLAY - GENERATE OVERLAY CONSTANTS.
*
*
* OVERLAY (TEXT),LOAD,NQ
* ENTRY *TEXT* = TEXT OF SUBTITLE.
* *LOAD* = IF DEFINED SPECIFIES ORGIN ADDRESS.
* *NQ* IF SPECIFIED OVERLAY IS NOT QUALIFIED.
PURGMAC OVERLAY
OVERLAY MACRO TEXT,LOAD,NQ
QUAL
NOREF .N
.N SET .N+1
.M MICRO .N,1, ABCDEFGHIJKLMNOPQRSTUVWXYZ
.O MICRO 1,3, "OVLB"".M"
.P MICRO 2,2, ".O"
.Q MICRO 1,3, O".P"
IFC EQ,*NQ**,1
QUAL ".O"
TTL PFM/".O" - TEXT
TITLE
IDENT ".O",".Q"X TEXT
*COMMENT PFM - TEXT
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
ORG LOAD OVLC
".Q" SUBR
MACREF OVERLAY
ENDM
CSR SPACE 4,10
** CSR - DEFINE 24 BIT QUANTITY FROM 18 BIT EQUATE.
*
* CSR R
* *R* = VALUE TO BE EXPANDED TO 24 BITS.
CSR MACRO R
LOCAL N,O,P,Q
MACREF CSR
N SET R
O SET R/100B
P SET O*100B
Q SET R-P
CON O,Q*100B
ENDM
TITLE COMMON DECKS.
SPACE 4,10
*CALL COMPMAC
*CALL COMSACC
*CALL COMSCPS
*CALL COMSEVT
*CALL COMSLFD
*CALL COMSLSD
*CALL COMSMMF
*CALL COMSMLS
MSP$ EQU 1
*CALL COMSMSP
*CALL COMSMST
QUAL MTX
*CALL COMSMTX
QUAL *
*CALL COMSPIM
*CALL COMSREM
QUAL RSX
*CALL COMSRSX
QUAL *
*CALL COMSSCD
*CALL COMSSRU
*CALL COMSSSD
*CALL COMSSSJ
*CALL COMSWEI
*CALL COMSZOL
SPACE 4,10
TITLE STORAGE ASSIGNMENTS AND ASSEMBLY CONSTANTS.
**** DIRECT LOCATION ASSIGNMENTS.
FS EQU 20 - 24 FST ENTRY
UI EQU 25 - 26 USER INDEX
LF EQU 27 - 30 LENGTH OF FILE
CN EQU 30 - 34 SCRATCH
P0 EQU 31 TEMPORARY LOCATIONS
P1 EQU 32
P2 EQU 33
P3 EQU 34
EB EQU 35 END BUFFER
PI EQU 36 - 37 PERMITTED USER INDEX
FN EQU 40 - 44 FILE NAME
PB EQU 45 POINTER TO PERMIT BUFFER
PP EQU 46 INDEX IN PERMIT BUFFER
NF EQU 45 - 46 NUMBER OF FILES IN CATALOG
SA EQU 45 - 46 SPACE AVAILABLE
HL EQU 47 LENGTH OF HOLE
FA EQU 57 LOCAL FNT ENTRY OFFSET
EQ EQU 60 PERMANENT FILE EST ORDINAL
RI EQU 61 - 62 PERMIT RANDOM INDEX
CS EQU 61 - 62 CUMULATIVE SIZE OF FILES IN CATALOG
BB EQU 63 BUFFER BASE ADDRESS
* THE NEXT FIVE CELLS MUST BE CONTIGUOUS.
HB EQU 63 POINTER TO HOLE BUFFER
HP EQU 64 INDEX IN HOLE BUFFER
CB EQU 65 POINTER TO FILE CATALOG BUFFER
RT EQU CB *RT* BOOLEAN (1 = SET)
CI EQU 66 INDEX IN FILE CATALOG BUFFER
UP EQU CI *UP* BOOLEAN (1 = SET)
EP EQU 67 END BUFFER POINTER
*EP EQU EP *EP* BOOLEAN (1 = SET)
CC EQU IR+2 COMMAND CODE
****
SPACE 4,10
* ASSEMBLY CONSTANTS.
BUF1 EQU BFMS-505 CATALOG BUFFER + TRACK AND SECTOR POINTERS
BUF2 EQU BUF1-505 CATALOG BUFFER + TRACK AND SECTOR POINTERS
MXRL EQU 7 MAXIMUM TDAM RETRY COUNT
SSLE EQU 10 LENGTH OF SYSTEM SECTOR DATA (CM WORDS)
UIRT EQU 300 UTILITY INTERLOCK ROLLOUT TIME
SPACE 4,10
* *ERROR*/*EXIT* MACRO PARAMETER VALUES.
EC0 EQU 0 NORMAL ERROR PROCESSING (EP CONTROLLED)
EC1 EQU 1 TIME-DEPENDENT ROLLOUT (EP/UP CONTROLLED)
EC2 EQU 2 PF-STAGE ROLLOUT (UP OR RT CONTROLLED)
EC3 EQU 3 UNCONDITIONAL ABORT
EC4 EQU 4 TIME-DEPENDENT RECALL (EP/UP CONTROLLED)
EC5 EQU 5 SECURITY VIOLATION
SVE EQU EC5 SECURITY VIOLATION
EC6 EQU 6 TIME-DEPENDENT ROLLOUT (RT CONTROLLED)
EC7 EQU 7 ISSUE ERRLOG MESSAGE BUT DO NOT ABORT JOB
CH EQU 1 CHANNEL NOT INTERLOCKED
EI EQU 1 SET ERROR IDLE
TITLE MEMORY ASSIGNMENTS.
PFM SPACE 4,10
** PFM - PERMANENT FILE MANAGER RESIDENT MEMORY LOCATIONS.
ORG PPFW
PFM LJM /PRS/PRS
PFAC EQU *-2 ACCOUNTING WORD OF USER
BSSZ 3
PFSN BSSZ 5 SYSTEM FILE NAME
* THE NEXT 5 BYTES MUST BE CONTIGUOUS.
SVAL CON 0 SECURITY VALIDATION BITS
PFAL CON 0 JOB ACCESS LEVEL
PFFC BSSZ 3 JOB ACCESS CATEGORIES
* THE NEXT 8 CM WORDS MUST REMAIN IN THE SAME ORDER AS THE
* CALL BLOCK (FET).
TFET EQU *
PFFN BSSZ 5 PERMANENT FILE NAME
PFSR EQU PFFN+3 SPECIAL REQUESTS
MODE EQU PFFN+4 MODE OF FILE PERMISSION
PFOU BSSZ 5 USER NAME
CTDN EQU PFOU+3 DEVICE NUMBER FOR CATALOG LIST
PRU EQU PFOU+3 PRUS DESIRED FOR DEFINE
PFPW BSSZ 3 PASSWORD
EMRA BSSZ 2 ERROR MESSAGE RETURN ADDRESS
PUCW BSSZ 5 USER CONTROL WORD
PFPN BSSZ 5 PF CONTROL WORD (42/ PN, 6/, 12/ FAM EQ)
* PN = PACK NAME.
PFNF BSSZ 5 NEW FILE NAME
PFXT EQU PFNF+3 ACCESS EXPIRATION DATE/TERM
BSSZ 5
PFRS EQU * PREFERRED RESIDENCE *PR*
PFBR EQU * BACKUP REQUIREMENT *BR*
PFSS CON 0 SUBSYSTEM *SS* (3/PR,3/BR,6/SS)
PFAP BSSZ 1 ALTERNATE CATLIST PERMISSION
BSSZ 1 RESERVED
PFRB BSSZ 2 (6/0,18/RB)
* RB = SPECIAL REQUEST BLOCK POINTER
TFETL EQU *-TFET LENGTH OF FET PARAMETERS
* THE NEXT 4 CM WORDS MUST REMAIN IN THE SAME ORDER AS THE
* SPECIAL REQUEST BLOCK.
PFSB BSSZ 2 RESERVED
PFID BSSZ 3 PERMANENT FILE CATALOG ADDRESS
PFES BSSZ 1 ALTERNATE STORAGE ERROR STATUS
PFAT BSSZ 1 CARTRIDGE ALTERNATE STORAGE TYPE
PFTS EQU PFAT TAPE ALTERNATE STORAGE TAPE SEQUENCE NUMBER
PFAA BSSZ 3 CARTRIDGE ALTERNATE STORAGE ADDRESS
PFTV EQU PFAA+1 TAPE ALTERNATE STORAGE TAPE VSN
PFOA BSSZ 2 OPTICAL DISK ADDRESS
PFCD BSSZ 3 CREATION DATE
PFFM BSSZ 3 FAMILY AND USER INDEX
PFSU BSSZ 2 USER INDEX
* THE FOLLOWING THREE BYTES ARE USED FOR ONE PURPOSE
* FOR DIRECT ACCESS FUNCTIONS, AND FOR A DIFFERENT PURPOSE
* FOR INDIRECT ACCESS FUNCTIONS.
FRSM BSS 0 DEVICE ACCESS MASK FOR FILE RESIDENCY
* 1/A,1/B,2/,8/DEVICE MASK
* A = SPECIAL USER INDEX PRESENT
* B = *LIFT* FILES ALLOWED.
MXFS CON 0 MAXIMUM INDIRECT FILE SIZE ALLOWED
MXDS BSS 0 MAXIMUM DIRECT ACCESS FILE SIZE (2 WORDS)
MXCS CON 0,0 MAXIMUM CUMULATIVE INDIRECT FILE
* ALLOWED
MXNF CON 0 MAXIMUM NUMBER OF FILES ALLOWED
* THE NEXT TWO TERMS MUST BE CONTIGUOUS.
ACNF CON 0,0 ACTUAL NUMBER OF FILES
CIFS CON 0,0 ACTUAL CUMULATIVE INDIRECT FILE SIZE
* DEVICE TO DEVICE TRANSFER POINTERS
* (CATALOG SEARCH POINTERS).
SDAA CON 0 EST ORDINAL
SDAB CON 0 TRACK
SDAC CON 0 SECTOR
* *PFM* INTERNAL STATUS BITS.
STAT CON 0 *PFM* INTERNAL STATUS BITS
STXD EQU 1 PASSWORD EXPIRATION DATE SPECIFIED
STRX EQU 2 RESEX INITIATED ON THIS REQUEST
STAB EQU 4 ABORT AFTER PERMIT CHECK (*APPEND*)
STTA EQU 10 TAPE ALTERNATE STORAGE REQUEST
STPR EQU 20 PERMITS HAVE BEEN READ
STBR EQU 40 *BFMS* (*END* BUFFER) HAS BEEN REUSED
STAC EQU 100 STATISTICAL ACCUMULATION ENABLED
STPD EQU 200 PRIVATE DEVICE
STEC EQU 400 APPEND TO END OF CHAIN
STBD EQU 1000 MASTER DEVICE IS BUFFERED DEVICE
STNS EQU 2000 NO JOB SUSPENSION WHEN DEVICE INACCESSIBLE
STXC EQU 4000 EXTENDING INDIRECT CHAIN
STAU CON 0 *PFM* INTERNAL STATUS BITS (PART 2)
STAJ BITSET 0 ABORT JOB
STDP BITSET 1 DROP PP
STDS BITSET 2 DROP PP WITH ERROR STATUS IN FET
STRP BITSET 3 RECALL *PFM*
* *PFM* RESTART FLAGS FOR RECALL.
PWRF BSS 1 RESTART FLAGS
RFAM BITSET 0 ACCOUNTING MESSAGES ISSUED FLAG
RFAC BITSET 1 ACCESS COUNTS UPDATED FLAG
RFPC BITSET 2 PERMIT COUNTS UPDATED FLAG
RFRR BITSET 3 RETRY REQUEST FLAG
* MISCELLANEOUS MEMORY LOCATIONS.
ACCM CON 0 ACTUAL ACCESS MODE (ON *GET*/*OLD*)
AILK CON 0 TRACK FOR ALLOCATION INTERLOCK
AIPF CON 0,0 ACCUMULATOR INCREMENT FOR PF ACCESS
AIPR CON 0,0 ACCUMULATOR INCREMENT FOR PRU COUNT
APDK BSSZ 5 DEFERRED DELINK REQUEST (*APPEND*)
* (SECOND BYTE NONZERO IF DELINK REQUESTED)
APLF CON 0,0 LENGTH OF APPENDAGE
APSC CON 0 FIRST SECTOR OF *APPEND* ORIGINAL FILE
APTK CON 0 FIRST TRACK OF *APPEND* ORIGINAL FILE
CPTF CON 0 CPU TRANSFER FLAG
DAHP CON 0 DIRECT ACCESS HOLE TRACK
CON 0 DIRECT ACCESS HOLE SECTOR
CON 0 DIRECT ACCESS HOLE OFFSET
DAIF CON 0 DIRECT ACCESS FILE INTERLOCK FLAG
DTMD CON EPRW DEVICE TRANSFER MODE (NONZERO = REWRITE)
DVLW BSSZ 5 DEVICE LAYOUT WORD
EBSC CON 0 END BUFFER SECTOR, IF END BUFFER IN *BFMS*
EBTK CON 0 END BUFFER TRACK, IF END BUFFER IN *BFMS*
EPFA CON 0 EST ORDINAL IF PF ACTIVITY COUNT SET
EPOP CON 0 ERROR OPTIONS (7/,1/SA,1/UP,1/EP,1/RT,1/IP)
EXPC CON 0 EXPLICIT PERMIT COUNT
FERT CON 0 NON-ZERO IF REAL-TIME BIT SET IN FET
FETL CON TFETL/5+10B MAXIMUM POSITION OF FET PF PARAMETERS
FNMD CON 0 *FNT* STATUS MODE EQUIVALENCE
FNTA CON 0 FNT ADDRESS FOR LOCAL FILE
FNTB CON 0 FNT ADDRESS FOR /PFM*PFN/
FNTC CON 0 FNT ADDRESS FOR /PFM*ILK/
FNTD CON 0 FNT ADDRESS FOR /PFM*APF/
IACP CON 100 INCREMENT ACCESS COUNT IN PERMIT
IAIF CON 0 INDIRECT ALLOCATION INTERLOCK FLAG
JORG CON 0 JOB ORIGIN TYPE
LFAL CON 0 LOCAL FILE ACCESS LEVEL
LFEF CON 0 LOCAL FILE EMPTY FLAG
MSTA CON 0 ADDRESS OF MASTER DEVICE MST/10
NPHA CON 0 NEXT PERMIT HOLE ADDRESS (FROM *SPI*)
PFCA CON 0 ADDRESS OF PFC ENTRY (*SAVE*/*REPLACE*)
PFDN CON 0 DEVICE NUMBER OF EXISTING FILE
PFEQ CON 0 DIRECT ACCESS PERMANENT FILE EST ORDINAL
PFFT CON 0 DIRECT ACCESS PERMANENT FILE FIRST TRACK
PFPT CON 0077 MULTI-LEVEL PERMISSION FLAG
PFSP CON 0 SECURITY PROCESSING BIT
PFUC BSSZ 1 USER CONTROLS
PTKT CON 0 PRESERVED TRACK
PWCC CON 0 *PFM* COMMAND CODE FROM *RPFSTAT* REQUEST
PXDT BSSZ 2 PASSWORD EXPIRATION DATE
RQDT VFD 5/0,1/0,18/DFPT REQUESTED DEVICE TYPE
* (BIT 18 SET IF DEVICE TYPE SPECIFIED IN FET)
* (THE ACTUAL VALUE OF *DFPT* IS READ FROM *PFNL*)
RTKE CON 0 RESERVED TRACK EST ORDINAL
RTKT CON 0 RESERVED TRACK
SAPF CON 20 SET ACCOUNTING PERMIT FLAG
SSID CON 0 SUBSYSTEM ID
SSJS CON 0 NONZERO IF CALLER IS *SSJ=* PROGRAM
SSOM CON 0 OPERATING SYSTEM SECURITY MODE
SSYS CON 0 NON-ZERO IF CALLER IS SUBSYSTEM
TITLE RESIDENT SUBROUTINES.
SFA SPACE 4,10
** SFA - SET FET ADDRESS.
*
* ENTRY (SFAA - SFAA+1) PRESET TO FET ADDRESS BY *PRS*.
*
* EXIT (A) = ABSOLUTE FET ADDRESS.
SFA SUBR ENTRY/EXIT
SFAB LDN 0
* LDD RA (FET ADDRESS VALIDATED)
SHN 6
SFAA ADC 0 PRESET FET ADDRESS
UJN SFAX RETURN
CCI SPACE 4,10
** CCI - CLEAR CATALOG INTERLOCK.
*
* ENTRY (EQ) = MASTER DEVICE EST ORDINAL.
* (CCIA) = CATALOG TRACK.
* (CCIB) = NONZERO IF CATALOG TRACK INTERLOCK SET.
*
* USES CM - CM+4.
*
* MACROS MONITOR.
CCI SUBR ENTRY
CCIB LDN 0 (NONZERO IF INTERLOCK SET)
ZJN CCIX IF CATALOG TRACK INTERLOCK NOT SET
LDD EQ
STD CM+1
LDC ** (CATALOG TRACK)
CCIA EQU *-1
STD CM+2
LDN CTIS CLEAR TRACK INTERLOCK
STD CM+3
MONITOR STBM
SOM CCIB CLEAR *INTERLOCK SET* FLAG
UJN CCIX RETURN
CTA SPACE 4,10
** CTA - CALCULATE TRT ADDRESS.
*
* ENTRY (A) = ADDRESS OF *TRLL* IN MST.
*
* EXIT (A) = FWA OF TRT.
*
* USES CM - CM+4.
CTA SUBR ENTRY/EXIT
CRD CM GET FWA OF TRT
LDD CM+3
LPN 77
SHN 14
LMD CM+4
UJN CTAX RETURN
ERR SPACE 4,25
** ERR - PROCESS ERROR.
*
* ENTRY (A) = EST ORDINAL IF REQUIRED FOR THE ERROR.
* (T4) = CHANNEL TO BE RELEASED.
* ((ERR)) = VFD 3/EXC,7/MNE,1/EIF,1/CIF.
* (EXC) = EXIT CASE.
* (MNE) = MESSAGE MNEUMONIC ERROR CODE VALUE.
* (EIF) = ERROR IDLE FLAG.
* (CIF) = CHANNEL NOT INTERLOCKED FLAG.
* (CSWD - CSWD+4) = CATALOG STATUS INTERLOCK WORD.
* (ERRB) = 0 IF PFM CREATED FNT/FST ENTRY.
* (ERRC) = FOLDED EVENT FOR ROLLOUT.
* (ERRD) = ROLLOUT TIME.
* (ERRE) = EST ORDINAL FOR EVENT.
*
* EXIT (P1) = (ERR+0).
* (P2) = EST ORDINAL.
*
* USES P1, P2, T1.
*
* CALLS CCI.
*
* MACROS ENDMS, EXECUTE.
ERR CON 0 ENTRY, PARAMETER ADDRESS
STD P2 SAVE EST ORDINAL
LDM ERR SAVE PARAMETERS *EXC*, *MNE*, *ERC*
STD T1
LDI T1
STD P1
LPN 1
NJN ERR1 IF CHANNEL NOT INTERLOCKED
ENDMS RELEASE CHANNEL IF RESERVED
ERR1 RJM CCI CLEAR CATALOG INTERLOCK IF SET
EXECUTE 3PT PROCESS ERROR
ERRB CON 0 FILE PRESENT BOOLEAN
ERRC CON 0 FOLDED EVENT FOR ROLLOUT
* (TRACK FOR BAD CATALOG/PERMIT SECTOR)
ERRD CON 0 ROLLOUT TIME
* (SECTOR FOR BAD CATALOG/PERMIT SECTOR)
ERRE CON 0 EST ORDINAL FOR EVENT
HNG SPACE 4,10
** HNG - HANG PP.
*
* MACROS MONITOR.
HNG CON 0 ENTRY (RETURN ADDRESS)
HNG1 MONITOR HNGM HANG
UJN HNG1 CONTINUE TO HANG
PDA SPACE 4,20
** PDA - PROCESS DEVICE AVAILABILITY.
*
* ENTRY (A) = 0 IF DEVICE AVAILABLE.
* (A) .NE. 0 IF DEVICE INACCESSIBLE.
* (T4) = CHANNEL FOR DEVICE, IF RESERVED.
* (T5) = EST ORDINAL OF DEVICE.
* (FERT) = REAL-TIME PROCESSING FLAG.
* (STAT) = *STNS* BIT SET FOR NO JOB SUSPENSION.
* (SSYS) = SUBSYSTEM FLAG.
* DRIVER SOFTWARE IS LOADED.
*
* EXIT RETURN IF PROCESSING IS TO CONTINUE.
*
* TO *ERR* IF DEVICE IS INACCESSIBLE AND CALLER HAS
* REAL-TIME PROCESSING SET IN FET OR IS NOT A SUBSYSTEM.
*
* MACROS ERROR.
PDA SUBR ENTRY/EXIT
ZJN PDAX IF DEVICE AVAILABLE, RETURN
LDM STAT
LPK STNS
NJN PDAX IF PROCESSING TO CONTINUE, RETURN
LDM FERT
NJN PDA1 IF REAL-TIME PROCESSING SELECTED
LDM SSYS
NJN PDAX IF SUBSYSTEM, RETURN
PDA1 ERROR WID,,,T5,EC6 * WAITING - INACCESSIBLE DEVICE.*
PDV SPACE 4,20
** PDV - PROCESS DEVICE STATUS.
*
* ENTRY (T4) = CHANNEL FOR DEVICE, IF RESERVED.
* (T5) = EST ORDINAL OF DEVICE.
* (FERT) = REAL-TIME PROCESSING FLAG.
* (STAT) = *STNS* BIT SET FOR NO JOB SUSPENSION.
* (SSYS) = SUBSYSTEM FLAG.
* DRIVER SOFTWARE IS LOADED.
*
* EXIT RETURN IF PROCESSING IS TO CONTINUE.
*
* CALLS PDA.
PDV SUBR ENTRY/EXIT
LDM MSD GET DEVICE STATUS
LPC 100
RJM PDA PROCESS DEVICE AVAILABILITY
UJN PDVX IF PROCESSING TO CONTINUE, RETURN
PES SPACE 4,15
** PES - PROCESS I/O ERROR STATUS.
*
* ENTRY (T4) = CHANNEL FOR DEVICE.
* (T5) = EST ORDINAL OF DEVICE.
* (RDCT) = DRIVER STATUS.
* A MASS STORAGE DRIVER HAS ENCOUNTERED AN I/O ERROR.
*
* EXIT ERROR IS UNRECOVERABLE.
* DEVICE IS INACCESSIBLE BUT CALLER IS ALLOWED
* TO PROCEED.
*
* CALLS PDA.
PES SUBR ENTRY/EXIT
LDM RDCT CHECK DRIVER STATUS
SHN 21-12
MJN PESX IF UNRECOVERABLE ERROR, RETURN
* LDN 1 DEVICE INACCESSIBLE
RJM PDA PROCESS DEVICE STATUS
UJN PESX RETURN
SFN SPACE 4,10
** SFN - SET FILE NAME.
*
* ENTRY (A) = ADDRESS OF FILE NAME TO BE MOVED.
*
* EXIT (FN - FN+3) = FILE NAME.
* (FN+4) = FNT STATUS FIELD.
*
* USES FN - FN+4.
SFN SUBR ENTRY/EXIT
STM SFNA
LDD MA
CWM *,ON
SFNA EQU *-1
SBN 1
CRD FN
LDD FN+3
SCN 77
STD FN+3
SFNB LDN 0 SET FILE STATUS
* LDN ST (FILE STATUS FIELD FOR FNT)
STD FN+4
UJN SFNX
SPACE 4,10
* RESIDENT COMMON DECKS.
*CALL COMPSEI
SPACE 4,10
OVLA EQU *+5 OVERLAY LOAD ADDRESS
SPN SPACE 4,15
** SPN - SET PERMANENT FILE NAME.
*
* SETS PERMANENT FILE NAME INTO (FN - FN+4).
*
* ENTRY (PFFN - PFFN+4) = PERMANENT FILE NAME.
* (PFSN - PFSN+4)= LOCAL FILE NAME.
*
* EXIT (FN - FN+4) = PERMANENT FILE NAME.
*
* CALLS SFN.
SPN SUBR ENTRY/EXIT
LDM PFFN
ZJN SPN1 IF PF NAME NOT SPECIFIED
LDN PFFN-PFSN
SPN1 ADC PFSN
RJM SFN
UJN SPNX
SPACE 4,15
OVLD EQU *+5 LOCAL FILE PROCESSING LOAD ADDRESS
TITLE PRESET.
QUAL PRS
*** PFM PRESET PROCESSING INCLUDES -
*
* VERIFICATION OF FET PARAMETERS.
* VERIFICATION OF USER VALIDATION ALLOWANCES.
* PLACING REQUEST IN RECALL IF CATALOG REQUIRED IS INTERLOCKED.
* ISSUING ACCOUNTING MESSAGES.
* LOADING OF PROPER FUNCTION PROCESSOR OVERLAY.
SPACE 4,10
*** DAYFILE MESSAGES.
*
* FOR DESCRIPTIONS OF ERROR MESSAGES CONSULT DOCUMENTATION OF
* ERROR PROCESSING OVERLAY (3PT).
SPACE 4,15
*** ACCOUNT FILE MESSAGES.
*
* ACCOUNTING MESSAGES ARE ISSUED EVEN IF OPERATION IS
* NOT SUCCESSFUL. I.E. FILE NOT FOUND, ETC....
* MESSAGE IS OF FOLLOWING FORMAT.
*
* GPFC, FILENAME, USERNAME, PACKNAME.
*
* GPFC - G=GROUP (S=STATISTICS, A=ACCOUNTING,
* M=MULTI LEVEL SECURITY).
* P=PERMANENT FILE RELATED MESSAGE.
* FC=PF FUNCTION CODE MNEMONIC.
*
* COMMA SEPARATORS WILL BE PRESENT EVEN IF DATA FIELD IS
* EMPTY. (E.G. GPFC, FILENAME, ,PACKNAME.)
*
*
* *SPAC, FILENAME, USERNAME, PACKNAME.*
* *SETPFAC* OPERATION.
*
* *SPAL, FILENAME, USERNAME, PACKNAME.*
* *SETPFAL* OPERATION.
*
* *SPAP, FILENAME, USERNAME, PACKNAME.*
* *APPEND* OPERATION.
*
* *SPAS, FILENAME, USERNAME, PACKNAME.*
* *ASSIGNPF* OPERATION.
*
* *SPCG, FILENAME, USERNAME, PACKNAME.*
* *CHANGE* OPERATION.
*
* *SPCT, FILENAME, USERNAME, PACKNAME.*
* *CATLIST* OPERATION.
*
* *SPDD, FILENAME, USERNAME, PACKNAME.*
* *DROPDS* OPERATION.
*
* *SPDF, FILENAME, USERNAME, PACKNAME.*
* *DEFINE* OPERATION.
*
* *SPDI, FILENAME, USERNAME, PACKNAME.*
* *DROPIDS* OPERATION.
*
* *SPDP, FILENAME, USERNAME, PACKNAME.*
* *DELPFC* OPERATION.
*
* *SPGT, FILENAME, USERNAME, PACKNAME.*
* *GET* OR *OLD* OPERATION.
*
* *SPPG, FILENAME, USERNAME, PACKNAME.*
* *PURGE* OPERATION.
*
* *SPPM, FILENAME, USERNAME, PACKNAME.*
* *PERMIT* OPERATION.
*
* *SPRP, FILENAME, USERNAME, PACKNAME.*
* *REPLACE* OPERATION.
*
* *SPRS, FILENAME, USERNAME, PACKNAME.*
* *RPFSTAT* OPERATION.
*
* *SPSA, FILENAME, USERNAME, PACKNAME.*
* *SETASA* OPERATION.
*
* *SPSD, FILENAME, USERNAME, PACKNAME.*
* *SETDA* OPERATION.
*
* *SPSF, FILENAME, USERNAME, PACKNAME.*
* *SETAF* OPERATION.
*
* *SPSP, FILENAME, USERNAME, PACKNAME.*
* *STAGEPF* OPERATION.
*
* *SPSV, FILENAME, USERNAME, PACKNAME.*
* *SAVE* OPERATION.
*
* *SPUA, FILENAME, USERNAME, PACKNAME.*
* *UATTACH* OPERATION.
*
* *SPUG, FILENAME, USERNAME, PACKNAME.*
* *UGET* OPERATION.
*
* *SPUR, FILENAME, USERNAME, PACKNAME.*
* *UREPLACE* OPERATION.
*
*
* *MFFI, FILENAME, LEVELNAME.*
* AN INVALID ATTEMPT WAS MADE TO CHANGE THE ACCESS
* LEVEL ON FILE FILENAME TO LEVEL LEVELNAME.
*
* *MPNF, FILENAME, USERNAME, PACKNAME.*
* AN UNSUCCESSFUL ATTEMPT WAS MADE TO ACCESS FILE
* FILENAME UNDER ALTERNATE USER USERNAME ON PACK
* PACKNAME.
*
*
* *STRS, FILENAME, USERINDEX, FAMPACK.*
* A REQUEST HAS BEEN SENT TO *MAGNET* TO STAGE FILE
* FILENAME, OF USER INDEX USERINDEX ON FAMILY/PACK
* FAMPACK, TO DISK FROM TAPE ALTERNATE STORAGE.
PRS SPACE 4,35
** PRS - PRESET ROUTINE.
* CHECK INPUT PARAMETERS.
*
* ENTRY (IR - IR+4) = CALL.
* (MP - MP+4) = PARAMETER WORD FROM MESSAGE BUFFER.
*
* EXIT (UI - UI+1) = CALLING USER INDEX.
* (PFUI - PFUI+1) = CALLING USER INDEX.
* (PI - PI+1) = OPTIONAL USER INDEX.
* (PFPI - PFPI+1) = OPTIONAL USER INDEX.
* (SFAA - SFAA+1) = RELATIVE FET ADDRESS.
* (PCPD) = CURRENT PACKED DATE.
* (PFAL) = JOB ACCESS LEVEL.
* (PFFC - PFFC+2) = JOB ACCESS CATEGORY SET.
* (PFFN - PFFN+3) = PERMANENT FILE NAME.
* (PFSN - PFSN+3) = SYSTEM FILE NAME.
* (PFAC - PFAC+4) = USER NAME OF CALLING JOB.
* (PFOU - PFOU+4) = ALTERNATE USER NAME IN CALL BLOCK.
* (PFPW - PFPW+3) = FILE PASSWORD.
* (PUCW - PUCW+4) = USER CONTROL WORD.
* (PFPN - PFPN+3) = PACKNAME + FAMILY EST ORDINAL.
* (PFUC) = USER CONTROLS.
* (PFNF - PFNF+3) = NEW FILE NAME.
* (PWCC) = COMMAND CODE FROM *RPFSTAT* REQUEST.
* (PWRF) = RESTART FLAGS FOR *PFM* RECALL.
* (PXDT - PXDT+1) = VALIDATED EXPIRATION DATE.
* (PXDT - PXDT+1) = 0 IF NONEXPIRING PASSWORD/PERMIT.
* (SSID) = SUBSYSTEM ID.
* (SSOM) = OPERATING SYSTEM SECURITY MODE.
* (SSYS) = SUBSYSTEM FLAG.
* (SVAL) = SECURITY VALIDATION BITS.
* ACCOUNTING MESSAGE ISSUED.
* USER CONTROLS SET (SEE *SUC* EXIT CONDITIONS.)
PRS BSS 0 ENTRY
LDD MP SAVE RESTART FLAGS FOR *PFM* RECALL
STM PWRF
LDD MP+2 SAVE COMMAND CODE FROM *RPFSTAT* REQUEST
STM PWCC
LDD MP+3 SET EST ORDINAL FROM *RPFSTAT* REQUEST
STD EQ
LDN ZERL CLEAR *MS2W*
CRD CM
LDD CP
ADK MS2W
CWD CM
LDN 0 CLEAR FST POINTER
STD FA
LDD CP FETCH EJT ORDINAL
ADN TFSW
CRD CM
SFA EJT,CM READ EJT
ADN SCLE
CRD CM
LDD CM SET SERVICE CLASS
SHN 14
RAM SUCA
SHN -14 SET JOB ORIGIN TYPE
LPN 17
STM JORG
RJM VFA VERIFY FET ADDRESS
MJN PRS1 IF ADDRESS OUT OF RANGE
RJM SEP SET ERROR PROCESSING OPTIONS
LDD CP
ADN STSW
CRD CM
ADN JCIW-STSW
CRD CN
LDD CN+2 SAVE SUBSYSTEM ID
STM SSID
SBK LSSI+1
MJN PRS0.1 IF NOT A SUBSYSTEM
LDN 1 SET SUBSYSTEM FLAG
STM SSYS
PRS0.1 LDD CC CHECK FUNCTION CODE
LPN 77
ZJN PRS1 IF ZERO FUNCTION CODE
STD CC
SBN CCRS
ZJN PRS3 IF *RPFSTAT* COMMAND
LDD CM+1
NJN PRS2 IF ERROR AT CONTROL POINT
LDD CC
SBN CCLM
MJN PRS3 IF LEGAL COMMAND CODE
PRS1 ERROR PAE,CH,IW * PFM ARGUMENT ERROR.*
PRS2 EXECUTE 3PU TERMINATE PROGRAM
PRS3 RJM VUA VALIDATE USER ACCESS
LDK SSML SAVE SYSTEM SECURITY MODE
CRD CM
LDD CM
LPN 7
STM SSOM
PRS4 RJM PFP PROCESS FET PARAMETERS
* CHECK FOR VALID USER INDEX.
LDD CN+3 SET USER INDEX OF CALLING USER
LPN 37
STM PRSJ
STD UI
SHN 14
ADD CN+4
STM PRSJ+1
STD UI+1
ZJN PRS5 IF USER INDEX NOT SPECIFIED
LMC IFUI
NJN PRS6 IF NOT INDIRECT FLAW USER INDEX
PRS5 ERROR PFN,CH,IW * DEVICE UNAVAILABLE.*
* DETERMINE USERS PERMISSION TO CREATE PERMANENT FILES.
PRS6 LDM TCTL,CC
SHN 21-3
PJN PRS8 IF COMMAND NOT CREATING INDIRECT FILES
LDD FN+4 COMPARE ACCESS CONTROL BITS
SHN 21-3
MJN PRS9 IF USER ALLOWED TO CREATE INDIRECT FILES
PRS7 ERROR IUA,CH,IW *USER ACCESS NOT VALID.*
PRS8 SHN 21-2-21+3
PJN PRS10 IF USER NOT CREATING DIRECT FILE
LDD FN+4
SHN 21-2
PJN PRS7 IF USER NOT ALLOWED TO CREATE DIRECT FILES
PRS9 LDM PFPN
ZJN PRS10 IF NOT REMOVABLE PACK REQUEST
LDD FN+4
SHN 21-10
PJN PRS7 IF USER NOT ALLOWED TO CREATE FILES ON RP
* VERIFY FILE NAMES.
PRS10 LDD CC
LMN CCCG CHECK FOR CHANGE COMMAND
NJN PRS11 IF NOT CHANGE
LDM PFNF
ZJN PRS11 IF NEW NAME NOT SPECIFIED
LDC PFNF
RJM SFN
RJM VFN
ZJN PRS12 IF ERROR IN NAME
PRS11 RJM SFA READ SYSTEM FILE NAME
CRM PFSN,ON
LDM PFSN+3
SCN 77
STM PFSN+3
LDC PFSN VERIFY SYSTEM FILE NAME
RJM SFN
RJM VFN
NJN PRS13 IF NAME OK
PRS12 ERROR FNE,CH,IW *FILE NAME ERROR.*
PRS13 LDM PFFN
ZJN PRS14 IF NO PF NAME SPECIFIED
LDC PFFN VERIFY PF NAME
RJM SFN
RJM VFN
ZJN PRS12 IF ERROR IN NAME
* CHECK RANGE ON SPECIAL REQUEST SUBFUNCTION.
PRS14 LDM PFSR GET SPECIAL REQUEST
LPN 77
SBN SRLM
PJN PRS16 IF INVALID SPECIAL REQUEST VALUE
* CHECK PARAMETER RANGE.
LDM PFFN+4 CHECK MODE RANGE
STD T0
LPN 37
SBN PTLM
MJN PRS17 IF MODE IN RANGE
PRS16 ERROR ILR,CH,IW *PFM INCORRECT REQUEST.*
PRS17 LDD T0 CHECK CATALOG TYPE
SHN -6
LPN 37
SBN FCPB+1
PJN PRS16 IF CATALOG TYPE OUT OF RANGE
RJM CRX CHECK FOR *RESEX*/*CPUPFM* ERROR STATUS
LDD CC
LMN CCRS
NJN PRS18 IF NOT *RPFSTAT* REQUEST
LDM PWCC ORIGINAL COMMAND CODE
ZJP PRS7 IF *CPUPFM* HAS NOT JUST BEEN CALLED
LDD CM+2 ERROR REPLY
RJM PER PROCESS ERROR REPLY
RAM PRSK SET PARAMETER WORD FOR *ERROR* MACRO
RJM FIF FIND INTERLOCK FILES
LJM PRS41 SKIP *RESEX* PROCESSING
* DETERMINE CATALOG TO ACCESS AND SET ADDRESS.
PRS18 RJM POA PROCESS OPTIONAL USER NAME
MJN PRS16 IF INCORRECT REQUEST
LDC PFPN SET CATALOG ADDRESS
RJM GCA
STM MSTA MST ADDRESS/10B
MJN PRS22 IF CATALOG NOT AVAILABLE
SHN 3
ADN PUGL READ MST USER NAME WORD
CRD FS
ADN STLL-PUGL READ DEVICE STATUS WORD
CRD CM
LDD CM
LPN MLUNL
ZJN PRS19 IF UNLOAD NOT REQUESTED
RJM CRR CHECK FOR CURRENT ATTACHMENT TO PACK
ZJN PRS22 IF FIRST ACCESS TO PACK
PRS19 LJM PRS25 CHECK FOR AUXILIARY DEVICE
* CATALOG NOT AVAILABLE.
PRS20 LDD MA SET PACK NAME FOR *0RF*
CWM PFPN,ON
SBN 1
CRD FN
LDN 0 CLEAR EST ORDINAL
STD EQ
RJM CRF *UNLOAD* REMOVABLE PACK RESOURCE
PRS21 ERROR PFN,CH,IW * PERMANENT FILES NOT AVAILABLE.*
PRS22 LDM PFPN
ZJN PRS21 IF NOT AUXILIARY DEVICE REQUEST
LDM EPOP CHECK ERROR PROCESSING STATUS
SHN 21-2
PJN PRS20 IF ERROR PROCESSING NOT SELECTED
SHN 21-3-21+2+22 CHECK USER ERROR PROCESSING SELECTED
MJN PRS20 IF USER ERROR PROCESSING SELECTED
RJM CRX CHECK RESEX STATUS
NJN PRS24 IF RESEX HAS BEEN ACTIVATED
PRS23 LJM RSX ACTIVATE RESEX
PRS24 LPN /STATUS/MV CHECK RESEX STATUS
ZJN PRS23 IF PACK AVAILABLE
ERROR RSE,CH,IW * RESEX FAILURE.*
* NON-FATAL ERROR DETECTED WITH
* NO PACK AVAILABLE AND ERROR
* PROCESSING SET.
* CATALOG AVAILABLE - DETERMINE IF REQUEST CAN BE CONTINUED.
PRS25 LDM PFPN CHECK AUXILIARY DEVICE REQUEST
NJN PRS26 IF AUXILIARY DEVICE REQUEST
LJM PRS39 CHECK CATALOG ACCESSABILITY
* PROCESS AUXILIARY DEVICE REQUEST.
* DETERMINE IF DEVICE FOUND IS PROPER TYPE.
PRS26 LDM RQDT+1 PRESET REQUESTED DEVICE TYPE
STM PRSA+1
LDM RQDT
LPN 77
LMC LMCI
STM PRSA
SFA EST,T5 READ EST
ADK EQDE
CRD T7
LDD T7
SHN 21-10
PJN PRS27 IF NOT REMOVABLE
LDD T7+4 GET UNIT COUNT
SHN 3
ADN DDLL
CRD CM+3
LDD CM+3
LPN 7
ADN 1R1
SHN 14
LMD T7+3 DEVICE TYPE
SHN 6
PRSA LMC * CHECK DEVICE TYPE
* LMC (RQDT) PRESET TO REQUESTED TYPE
NJN PRS26.1 IF NOT PROPER TYPE
LDD T7
LPN 2
ZJN PRS27 IF DEVICE *ON* OR *IDLE*
PRS26.1 ERROR IDR,CH,IW *INCORRECT DEVICE REQUEST.*
* DETERMINE IF ALTERNATE ACCESS TO PRIVATE DEVICE.
PRS27 LDD FS
NJN PRS28 IF PRIVATE DEVICE
LJM PRS36 CHECK EST OF DEVICE
PRS28 LDM PFUC DISABLE ALL BUT INDIRECT FILE SIZE LIMITS
LPN 7
LMC 7770
STM PFUC
LDK STPD SET *PRIVATE DEVICE* FLAG
RAM STAT
LDM TCTL,CC CHECK FUNCTION TYPE
LPN 2
NJN PRS29 IF NOT ALTERNATE CATALOG ACCESS
LDM PFOU SET CATALOG FOR ACCESS
ZJN PRS29 IF NO OPTIONAL USER
LDC PFOU
UJN PRS30 SET UP OPTIONAL USER
PRS29 LDC PFAC GET USER NAME OF CALLER
PRS30 RJM SFN
LDN 3
STD T1
LDD FS+3 CLEAR LOWER CHARACTER OF USER NAME
SCN 77
STD FS+3
PRS31 LDM FN,T1 COMPARE NEXT BYTE OF USER NAMES
LMM FS,T1
NJN PRS31.1 IF NOT CORRECT USER
SOD T1
PJN PRS31 IF MORE BYTES TO COMPARE
UJN PRS34 PROCESS ACCESS BY/SPECIFYING DEVICE OWNER
PRS31.1 LDM TCTL,CC CHECK FUNCTION TYPE
LPN 14
ZJN PRS32 IF NOT FILE CREATION REQUEST
LJM PRS21 *DEVICE UNAVAILABLE.*
* ALTERNATE ACCESS TO PRIVATE DEVICE.
PRS32 LDM TCTL,CC CHECK FUNCTION TYPE
LPN 2
NJN PRS35 IF NOT ALTERNATE CATALOG ACCESS
LDM PFOU CHECK USER NAME
NJN PRS35 IF OPTIONAL USER CALL
LDD MA SET DEVICE OWNER AS OPTIONAL USER
CWD FS COPY ALTERNATE USER NAME
CRM PFOU,ON
RJM POA PROCESS OPTIONAL USER NAME
PJN PRS33 IF USER NAME VALID
ERROR ILR,CH,IW *PFM INCORRECT REQUEST*
PRS33 LDM TCTL,CC CHECK FUNCTION TYPE
LPN 2
NJN PRS35 IF NOT ALTERNATE CATALOG ACCESS
* CHECK IF RESOURCE CONTROL NEEDED.
PRS34 LDC PFPN RESET CATALOG POINTER
RJM GCA GET CATALOG ADDRESS
STM MSTA MST ADDRESS/10B
PJN PRS36 IF CATALOG FOUND
LJM PRS22 TREAT AS IF CATALOG NOT FOUND
PRS35 RJM SPN SET PERMANENT FILE NAME
ERROR FNF,CH,IW * (FILENAM) NOT FOUND.*
PRS36 SFA EST,T5 READ EST ENTRY
ADK EQDE
CRD CM
LDD CM
SHN 21-10
PJN PRS39 IF NOT REMOVABLE
RJM CRX CHECK RESEX RETURN STATUS
NJN PRS38 IF *RESEX* HAS BEEN ACTIVATED
LDM TCTL,CC
SHN 21-5
PJN PRS39 IF NOT DA REQUEST
RJM CRR CHECK IF FIRST AUXILIARY REQUEST ON DEVICE
NJN PRS39 IF NOT 1ST DA FILE ON THIS PACK
RJM CCA CHECK FOR ERROR IDLE OR PF UTILITY ACTIVE
LJM RSX ACTIVATE *RESEX*
PRS37 EXIT PFN,CH,IW * DEVICE UNAVAILABLE.*
PRS38 LPN /STATUS/MV CHECK RESEX STATUS
NJN PRS37 IF PACK NOT AVAILABLE
LDD CM+2
LPN /STATUS/OK
NJN PRS39 IF REQUEST COMPLETE
ERROR RSE,CH,IW * RESEX FAILURE.*
* REQUEST CAN BE PROCESSED DETERMINE IF CATALOG CAN BE ACCESSED
PRS39 RJM CCA CHECK CATALOG ACCESSABILITY
* CATALOG CAN BE ACCESSED - PROCEED WITH REQUEST.
LDM TCTL,CC CHECK COMMAND
SHN 21-4
PJN PRS40 IF USER CONTROLS NOT NEEDED
RJM SUC SET USER CONTROLS
PRS40 RJM SRF SET RESERVE FNT
* SET UP APPROPRIATE ACCOUNTING MESSAGE.
PRS41 LDM PWRF RESTART FLAGS
LPK RFAM
NJN PRS43 IF ACCOUNTING MESSAGES ISSUED
LDK RFAM SET ACCOUNTING MESSAGES ISSUED FLAG
RAM PWRF
LDD CC
LMN CCPM
ZJN PRS42 IF PERMIT FUNCTION
LDN PFOU&PFAC SPECIFY USER NAME
PRS42 LMC PFAC SPECIFY REQUESTING USER NAME
RJM SAM SET UP ACCOUNTING MESSAGE
* ISSUE DAYFILE MESSAGE(S).
LDC PRSF+ACFN ISSUE *S* TYPE ACCOUNT LOG MESSAGE
RJM DFM
LDM TCTL,CC CHECK IF *A* TYPE MESSAGE NEEDED
SHN 21-6
PJN PRS43 IF *A* TYPE MESSAGE NOT NEEDED
LDC 2RAP PRESET MESSAGE CODE
STM PRSF
LDC PRSF+ACFN ISSUE *A* TYPE ACCOUNT LOG MESSAGE
RJM DFM
* INCREMENT ACCOUNTING INFORMATION.
PRS43 LDM TPFI,CC PF INCREMENT FOR REQUESTED FUNCTION
RAM AIPF+1
LDM PFPN CHECK AUXILIARY PACK REQUEST
ZJN PRS44 IF NOT AUXILIARY PACK REQUEST
LDN IPAD PF INCREMENT FOR AUXILIARY DEVICE
RAM AIPF+1
PRS44 LDM PFOU CHECK FOR OPTIONAL USER
ZJN PRS45 IF NO OPTIONAL USER
LDN IPVA PF INCREMENT FOR *VALIDUS* ACCESS
RAM AIPF+1
PRS45 LDM PRSJ
STD UI
LDM PRSJ+1
STD UI+1
LDM STAT CHECK *CPUPFM*/*RESEX* STATUS
LPK STRX
ZJN PRS46 IF *CPUPFM*/*RESEX* NOT ACTIVATED
LDN ZERL CLEAR SPCW STATUS
CRD CM
LDD CP
ADC SPCW
CWD CM
LDD CC
LMN CCRS
NJN PRS46 IF NOT *RPFSTAT* REQUEST
LDN CAPS CLEAR *CPUPFM* ACTIVE STATUS
STD CM+1
MONITOR SJCM
EXIT NEC,CH,IW,EQ PROCESS ERROR CODE FROM *CPUPFM*, IF ANY
PRSK EQU *-1 (ERROR CODE)
* PROCESS RESOURCE FILE CLEAN UP.
PRS46 LDM TCTL,CC CHECK ACCESS TYPE
SHN 21-5
PJN PRS47 IF NOT DIRECT ACCESS OPERATION
SHN 21-7-21+5+22
PJN PRS47 IF NO FNT CREATED
NFA FNTA,R SET EST ORDINAL IN FST
ADK FNTL
CRD CN
ADN FSTL-FNTL
CRD CM
LDD EQ
STD CM
LDD CN+4
LPN 77
LMC PMFT*100B
STD CN+4
NFA FNTA,R
ADK FNTL
CWD CN
ADN FSTL-FNTL
CWD CM
UJN PRS48 PROCESS REQUEST
PRS47 RJM CRF *UNLOAD* REMOVABLE PACK RESOURCE
PRS48 LDN ZERL
CRD FS
LDD CC CHECK COMMAND CODE
LMN CCCT
NJN PRS49 IF NOT CATLIST COMMAND
EXECUTE 3PJ EXIT TO CATLIST PROCESSOR
PRS49 LMN CCPM&CCCT CHECK COMMAND CODE
ZJN PRS51 IF *PERMIT* COMMAND
LDM PFOU CHECK USER NAME
ZJN PRS51 IF NO USER NAME
* PROCESS USER NAME.
RJM CUN COMPARE USER NAME
NJN PRS50 IF NOT A MATCH
STM PFPT SET MATCH OF MULTI LEVEL USER DETECTED
PRS50 RJM SWI SWAP INDICES
* DETERMINE CATALOG ADDRESS AND ACCESSABILITY.
PRS51 LDC PFPN SET CATALOG ADDRESS
RJM GCA
MJP PRS21 IF DEVICE NOT FOUND
* PRESERVE CATALOG ADDRESS PARAMETERS.
STM MSTA MST ADDRESS/10B
SHN 3
ADK DILL CHECK FOR BUFFERED DEVICE
CRD T0
LDD T0+3
SHN 21-12
PJN PRS52 IF NOT BUFFERED DEVICE
LDC STBD SET *BUFFERED DEVICE* FLAG
RAM STAT
PRS52 LDD T5 SAVE EST ORDINAL OF MASTER DEVICE
STD EQ
STM SDAA
LDD T6 SAVE CATALOG TRACK
STM CCIA
* PROCESS LOCAL FILE AS REQUIRED IN *TCTL*.
LDM TCTL,CC
SHN 21-11
MJN PRS53 IF LOCAL FILE PROCESSING REQUIRED
RJM SPN SET PERMANENT FILE NAME
EXECUTE 3PC EXIT TO COMMAND PROCESSOR
PRS53 EXECUTE 3PA EXIT TO LOCAL FILE PROCESSOR
SPACE 4,10
PRSB DATA 2H, MESSAGE SEPARATOR
CON 0 END OF STRING
PRSC DATA 1L. MESSAGE TERMINATOR
* ACCOUNTING MESSAGE ASSEMBLY AREA.
PRSF DATA 6HSPXX, MESSAGE CODE
* ACCOUNTING CODES.
PRSH CON 0 (ZERO WORD REQUIRED FOR *COMPACS* CALL)
LOC 1
DATA 2HSV SAVE
DATA 2HGT GET
DATA 2HPG PURGE
DATA 2HCT CATLIST
DATA 2HPM PERMIT
DATA 2HRP REPLACE
DATA 2HAP APPEND
DATA 2HDF DEFINE
DATA 2HAT ATTACH
DATA 2HCG CHANGE
DATA 2HUA UATTACH
DATA 2HSA SETASA
DATA 2HSF SETAF
DATA 2HSD SETDA
DATA 2HDD DROPDS
DATA 2HAS ASSIGNPF
DATA 2HGT OLD
DATA 2HAC SETPFAC
DATA 2HAL SETPFAL
DATA 2HUG UGET
DATA 2HUR UREPLACE
DATA 2HDI DROPIDS
DATA 2HDP DELPFC
DATA 2HRS RPFSTAT
DATA 2HSP STAGEPF
LOC *O
.1 MAX *,PRSF+20 DAYFILE MESSAGE AREA
ORG .1
PRSJ CON 0,0 USER INDEX
TCTL SPACE 4,30
** TCTL - TABLE OF COMMAND CODE CONTROLS.
*
*T 1/L,1/K,1/J,1/I,1/H,1/G,1/F,1/E,1/D,1/C,1/B,1/A
*
* A PREVENT ALTERNATE CATALOG ACCESS.
* B PREVENT SET OF UI FOR ALTERNATE CATALOG
* C CREATE DA FILE
* D CREATE IDA FILE
* E SET USER CONTROLS
* F DA REQUEST
* G ISSUE *A* TYPE ACCOUNTING MESSAGE
* H FNT POTENTIALLY REQUIRED
* I ALLOW EXPIRATION DATE
* J LOCAL FILE PROCESSING REQUIRED
* K SPECIAL REQUEST BLOCK FUNCTIONS.
* L CALL WITHOUT AUTO RECALL (EP/UP REQUEST)
TCTL EQU *-1 FWA OF COMMAND CODE CONTROLS
LOC 1
CON 1431 SAVE
CON 1200 GET
CON 2000 PURGE
CON 0000 CATLIST
CON 0402 PERMIT
CON 1420 REPLACE
CON 1020 APPEND
CON 1665 DEFINE
CON 1260 ATTACH
CON 0401 CHANGE
CON 3261 UATTACH
CON 3000 SETASA
CON 2000 SETAF
CON 3060 SETDA
CON 2001 DROPDS
CON 3265 ASSIGNPF
CON 1200 OLD
CON 0001 SETPFAC
CON 0001 SETPFAL
CON 7201 UGET
CON 7020 UREPLACE
CON 2001 DROPIDS
CON 3000 DELPFC
CON 0000 RPFSTAT
CON 2000 STAGEPF
LOC *O
TPFI SPACE 4,20
** TPFI - TABLE OF PF INCREMENT VALUES BY FUNCTION.
TPFI EQU *-1 FWA OF PF INCREMENT VALUES BY FUNCTION
LOC 1
CON IPSV SAVE
CON IPGT GET
CON IPPG PURGE
CON IPCT CATLIST
CON IPPM PERMIT
CON IPRP REPLACE
CON IPAP APPEND
CON IPDF DEFINE
CON IPAT ATTACH
CON IPCG CHANGE
CON IPUA UATTACH
CON IPSA SETASA
CON IPAF SETAF
CON IPSD SETDA
CON IPDD DROPDS
CON IPAN ASSIGNPF
CON IPGT OLD
CON IPAC SETPFAC
CON IPAL SETPFAL
CON IPUG UGET
CON IPUR UREPLACE
CON IPDI DROPIDS
CON IPDP DELPFC
CON IPRS RPFSTAT
CON IPSP STAGEPF
LOC *O
TITLE PRESET SUBROUTINES.
CCA SPACE 4,60
** CCA - CHECK CATALOG ACCESSABILITY.
*
* CHECK CATALOG TRACK INTERLOCK, PF UTILITY INTERLOCK AND
* ERROR IDLE STATUS; INCREMENT PF ACTIVITY COUNT. NONE OF
* THIS IS DONE FOR *ATTACH* WITH *FA* SPECIAL REQUEST. FOR
* *ATTACH* WITH *MA* SPECIAL REQUEST, OR FOR ANY REQUEST FROM
* A SUBSYSTEM WITH EP/UP SET, OR FOR ANY REQUEST FROM ANYONE
* WITH EP/IP SET, CATALOG TRACK INTERLOCK STATUS IS NOT
* CHECKED. FOR *ASSIGNPF*, *CATLIST*, AND *DELPFC*, CATALOG
* TRACK INTERLOCK STATUS AND PF UTILITY INTERLOCK STATUS ARE
* NOT CHECKED AND PF ACTIVITY COUNT IS NOT INCREMENTED.
* ERROR IDLE IS IGNORED FOR *UATTACH*/*UGET*, AND FOR ANY
* REQUEST WITH THE *IE* SPECIAL REQUEST SPECIFIED.
*
* ENTRY (CC) = COMMAND CODE.
* (EPOP) = ERROR PROCESSING OPTIONS.
* (MSTA) = MST ADDRESS/10B.
* (PFSR) = SPECIAL REQUEST FROM *FET*.
* (SSJS) = *SSJ=* STATUS.
* (T5) = MASTER DEVICE EST ORDINAL.
*
* EXIT (EPFA) = EST ORDINAL IF PF ACTIVITY COUNT SET.
* (EQ) = MASTER DEVICE EST ORDINAL.
*
* TO *ERR* IF ERROR IDLE SET ON THE DEVICE.
* TO *ERR* IF PF UTILITY ACTIVE.
* TO *RCL* IF CATALOG TRACK INTERLOCK NOT AVAILABLE
* (UNLESS CALLER HAS *EP* AND *IP* SET, OR UNLESS
* CALLER IS SUBSYSTEM, WITH *EP* AND *UP* SET).
*
* THE FOLLOWING CELLS ARE SETUP FOR EXITS WHICH MAY
* CAUSE THE JOB TO BE ROLLED.
* (ERRC) = SET FOR ROLLOUT EVENT.
* (ERRD) = SET FOR EVENT TIME.
* (ERRE) = SET FOR EVENT TYPE.
*
* USES EQ, CM - CM+4.
*
* CALLS DTS.
*
* MACROS MONITOR, ERROR, EXIT, SFA.
CCA SUBR ENTRY/EXIT
LDD T5 SET EST ORDINAL
STD EQ
STD CM+1
* CHECK FOR *ATTACH* WITH *FA* OR *MA* SPECIAL REQUEST.
LDD CC CHECK COMMAND CODE
LMN CCAT
NJN CCA1 IF NOT *ATTACH* REQUEST
LDM PFSR CHECK FOR SPECIAL REQUEST
LPN 77
LMN SRFA
ZJN CCAX IF *FA* SPECIAL REQUEST
LMN SRMA&SRFA
ZJN CCA2.1 IF *MA* SPECIAL REQUEST
* CHECK CATALOG TRACK INTERLOCK AVAILABILITY.
CCA1 LDD CC CHECK FOR *ASSIGNPF*
LMN CCAN
ZJN CCA2 IF INTERLOCK NOT NEEDED
LMN CCCT&CCAN CHECK FOR *CATLIST*
ZJN CCA2 IF INTERLOCK NOT NEEDED
LMN CCDP&CCCT CHECK FOR *DELPFC*
ZJN CCA2 IF INTERLOCK NOT NEEDED
LMN CCSP&CCDP CHECK FOR *STAGEPF*
CCA2 ZJP CCA6 IF INTERLOCK NOT NEEDED
RJM DTS DETERMINE TRACK INTERLOCK STATUS
PJN CCA3.1 IF CATALOG TRACK NOT ALREADY INTERLOCKED
* PROCESS CATALOG TRACK ALREADY INTERLOCKED. IF THE CALLER
* HAS EP/IP SET, OR IF CALLER IS A SUBSYSTEM WITH EP/UP SET,
* CONTINUE TO PROCESS REQUEST. OTHERWISE, RECALL *PFM*
* IMMEDIATELY.
LDM EPOP CHECK ERROR PROCESSING OPTIONS
LPN 5
LMN 5
CCA2.1 ZJN CCA4 IF *EP* AND *IP* SET
LDM EPOP CHECK ERROR PROCESSING OPTION
LPN 14
LMN 14
NJN CCA3 IF EITHER *EP* OR *UP* IS NOT SET
LDM SSID
NJN CCA4 IF SUBSYSTEM
CCA3 LDK /ERRMSG/INA * INTERLOCK NOT AVAILABLE*
LJM RCL RECALL PFM
* CHECK DEVICE ACCESSIBILITY.
CCA3.1 NJN CCA4 IF NOT INACCESSIBLE DEVICE
ERROR WID,CH,IW,T5,EC6
* INCREMENT PF ACTIVITY.
CCA4 LDD T5 EST ORDINAL
STD CM+1
LDN IPAS INCREMENT PF ACTIVITY
STD CM+3
MONITOR STBM
LDD CM+1
ZJN CCA5 IF ACTIVITY INCREMENTED
LDM MSTA CHECK MST
SHN 3
ADK TDGL
CRD CM
LDD CM+1
SHN 21-6
MJN CCA4.1 IF PF UTILITY INTERLOCK SET
EXIT PEA,CH,IW,,EC4 * PFM EXCESS ACTIVITY.*
* PROCESS PF UTILITY INTERLOCK SET.
CCA4.1 LDN PFUE SET EVENT FOR ROLLOUT
STM ERRC
LDC UIRT SET USER INTERLOCK ROLLOUT TIME
STM ERRD
EXIT PFA,CH,IW,,EC2 * PF UTILITY ACTIVE.*
CCA5 LDD T5 SET EST ORDINAL FOR PF ACTIVITY INCREMENT
STM EPFA
* CHECK FOR ERROR IDLE.
CCA6 SFA EST,T5
ADK EQDE
CRD CM
LDD CC
LMN CCUA
ZJN CCA7 IF *UATTACH*, IGNORE ERROR IDLE
LMN CCUG&CCUA
ZJN CCA7 IF *UGET*, IGNORE ERROR IDLE
LDD CM+4 CHECK FOR ERROR IDLE
SHN 3
ADN ACGL
CRD CM
LDD CM+4
LPN 20
NJN CCA8 IF ERROR IDLE
CCA7 LJM CCAX RETURN
CCA8 LDM SSJS
ZJN CCA9 IF NOT *SSJ=* JOB
LDM PFSR
LPN 77
LMN SRIE
ZJN CCA7 IF *IGNORE ERROR IDLE* SPECIAL REQUEST
LDN VSNE/10000 SET EVENT TYPE
CCA9 ERROR PFN,CH,IW * DEVICE UNAVAILABLE.*
CRF SPACE 4,15
** CRF - CALL *0RF*.
*
* ENTRY (EQ) = REMOVABLE DEVICE EST ORDINAL.
* = 0, IF DEVICE UNAVAILABLE.
* (FN - FN+4) = PACK NAME, IF DEVICE UNAVAILABLE.
*
* EXIT (FA) = 0.
*
* USES FS - FS+4.
*
* CALLS PES, *0RF*.
*
* MACROS EXECUTE, NFA.
CRF SUBR ENTRY/EXIT
LDM STAT CHECK *RESEX* STATUS
LPN STRX
ZJN CRF2 IF *RESEX* NOT ACTIVATED
LDK RFCN+FSTL
STD FA SET FNT POINTER
NFA FA,R
ADN FSTL FETCH RESOURCE FILE STATUS
CRD FS
LDD FS+1 CHECK ERROR ON PREVIOUS UPDATE
SCN 1
NJN CRF1 IF PROCESSING ERROR
LDD EQ
STD FS SET EST ORDINAL
LDN 5
STD FS+1 SET *0RF* OPTION
CRF1 LDN 1
STM LOCF-1 SET RESOURCE UPDATE CONTROL
EXECUTE 0RF,LOCF
LPC 1S17 CLEAR FNT POINTER
CRF2 STD FA
PJN CRF3 IF RESOURCE FILE UPDATED
RJM PES PROCESS ERROR STATUS
CRF3 LJM CRFX RETURN
CRR SPACE 4,10
** CRR - CHECK AUXILIARY DEVICE REQUEST.
*
* ENTRY (T5) = EST ORDINAL OF DEVICE TO BE ACCESSED.
*
* EXIT (A) = 0 IF FIRST ACCESS TO PACK.
*
* USES T1, T2, CM - CM+4, FN - FN+4.
CRR3 LCN 1 INDICATE EQUIPMENT ASSIGNED
CRR SUBR ENTRY/EXIT
* SEARCH FNT FOR ANOTHER FILE ASSIGNED TO DEVICE.
LDD CP SET NFL SIZE
ADN FLSW
CRD FN
LDD FN
SHN 6
ADN 1
STD T1
LDC FNTN SET FIRST FNT ENTRY ADDRESS
STD T2
CRR1 NFA T2,R
ADK FNTL
CRD FN
ADN FSTL-FNTL
CRD CM
LDD CM CHECK EQUIPMENT ASSIGNMENT
LMD T5
NJN CRR2 IF NO MATCH ON EST ORDINAL
LDD FN+4 CHECK FILE TYPE
SHN -6
LMN PMFT
ZJN CRR3 IF *PMFT* FILE ON CORRECT EQUIPMENT
CRR2 LDN LENF ADVANCE FNT ADDRESS
RAD T2
SBD T1
MJN CRR1 IF NOT END OF NFL
LDN 0
UJN CRRX
CRX SPACE 4,30
** CRX - CHECK *CPUPFM*/*RESEX* RETURN STATUS.
*
* ENTRY (CP) = CP ADDRESS.
*
* EXIT (A) = (CM+2) = RETURN STATUS.
*T, 3/ PI,9/ RS
* PI = PROCESSOR INDEX (0 = *RESEX*, 1 = *CPUPFM*).
* RS = RETURN STATUS.
* (CM - CM+4) = CP WORD *SPCW*.
*
* *RESEX* RETURN STATUS -
*T, 3/ 0,3/ ST,2/ 0,1/ P,1/ O,1/ E,1/ C
* ST = ERROR CODE.
* 0 = *RESEX* FAILURE - SYSTEM ERROR.
* 1 = INCORRECT DEVICE REQUEST.
* 2 = UNRECOGNIZED EQUIPMENT TYPE.
* 3 = INCORRECT USER REQUEST.
*
* P = 0 IF PACK AVAILABLE.
* E = 1 IF ERROR.
* O = 1 IF ASSIGNMENT WILL OVERCOMMIT.
* C = 1 IF OPERATION ALLOWED.
*
* TO *ERR* IF *RESEX* ERROR STATUS DETECTED.
*
* *CPUPFM* RETURN STATUS -
*T, 3/ 1,9/ EC
* EC = *PFM* ERROR CODE.
* EC = 0 IF NORMAL COMPLETION.
CRX2 LDN 0 SET *CPUPFM*/*RESEX* NOT ACTIVATED
CRX SUBR
LDD CP READ RETURN STATUS
ADC SPCW
CRD CM
LDD CM
NJN CRX2 IF *DMP=* PROGRAM IN PROGRESS
LDD CM+2 CHECK RETURN STATUS
ZJN CRX2 IF *DMP=* PROGRAM NOT ACTIVATED
SHN -11
NJN CRX1 IF NOT *RESEX*
LDD CM+2
LPN /STATUS/FE CHECK RESEX STATUS
ZJN CRX1 IF NOT FATAL ERROR
ERROR NEM,CH,IW ABORT WITH NO MESSAGE
CRX1 LDM STAT SET *CPUPFM*/*RESEX* ACTIVATED STATUS
SCN STRX
LMN STRX
STM STAT
LDD CM+2 SET RETURN STATUS
UJN CRXX RETURN
CUN SPACE 4,15
** CUN - COMPARE USER NAMES.
*
* ENTRY (PFOU) = USER NAME SPECIFIED IN FET.
* (PFAC) = USER NAME OF CALLING JOB.
*
* EXIT (A) = 0 IF USER NAMES MATCH.
* (A) .NE. 0 IF USER NAMES DO NOT MATCH.
*
* USES T1, T2, CM - CM+4.
*
* CALLS SFN.
CUN SUBR ENTRY/EXIT
LDC PFOU SET USER NAME
RJM SFN
LDD MA TRANSFER USER NAME
CWM PFAC,ON
SBN 1
CRD CM
LDD CM+3 CLEAR LOWER CHARACTER OF USER NAME
SCN 77
STD CM+3
LDN 0 INITIALIZE COUNT
STD T1
* COMPARE USER NAMES ALLOWING A (*) IN (CM) TO MATCH ANY
* CORRESPONDING CHARACTER IN THE USER NAME IN (FN).
CUN1 AOD T1 TEST FOR END OF LOOP
LMN 5
ZJN CUNX IF USER NAMES MATCH
LDM CM-1,T1 USER NAME OF THE REQUESTOR JOB
STD T2
LMC 2R**
ZJN CUN1 IF (**), SKIP CHARACTER COMPARE
SCN 77
ZJN CUN3 IF UPPER CHARACTER = (*)
LDD T2 COMPARE UPPER CHARACTER
LMM FN-1,T1
SCN 77
CUN2 NJN CUNX IF USER NAME DOES NOT MATCH
LDD T2 CHECK LOWER CHARACTER FOR (*)
LMN 1R*
LPN 77
ZJN CUN1 IF LOWER CHARACTER = (*)
CUN3 LDD T2 COMPARE LOWER CHARACTER
LMM FN-1,T1
LPN 77
ZJN CUN1 IF LOWER CHARACTER MATCHES
UJN CUN2 RETURN, USER NAMES DO NOT MATCH
FIF SPACE 4,10
** FIF - FIND INTERLOCK FILES.
*
* EXIT (FNTB, FNTC, FNTD) = FNT ADDRESSES, IF FILES PRESENT.
*
* CALLS SAF, SFN.
FIF SUBR ENTRY/EXIT
LDC FIFA SEARCH FOR /PFM*ILK/
RJM SFN
RJM SAF
ZJN FIF2 IF NOT FOUND
LDD FA SAVE FNT ADDRESS
STM FNTC
FIF2 LDC FIFB SEARCH FOR /PFM*PFN/
RJM SFN
RJM SAF
ZJN FIF3 IF NOT FOUND
LDD FA SAVE FNT ADDRESS
STM FNTB
FIF3 LDC FIFC SEARCH FOR /PFM*APF/
RJM SFN
RJM SAF
ZJN FIF4 IF NOT FOUND
LDD FA SAVE FNT ADDRESS
STM FNTD
FIF4 UJP FIFX RETURN
FIFA VFD 60/7L"ILK"
FIFB VFD 60/7L"PFN"
FIFC VFD 60/7L"APF"
FMS SPACE 4,15
** FMS - FORM MASK FOR FILE RESIDENCE CHECK.
*
* ENTRY (UI - UI+1) = USER INDEX.
* (JORG) = JOB ORIGIN.
*
* EXIT (FRSM) = MASK FOR FILE RESIDENCE CHECK.
FMS SUBR ENTRY/EXIT
LDD UI+1 FORM MASK FOR ACCESS CHECK
LPN 7
LMC SHNI
STM FMSA
LDN 1 POSITION MASK
FMSA PSN 0
* SHN N N = SHIFT COUNT TO POSITION MASK
STM FRSM SAVE MASK
LDD UI CHECK FOR SPECIAL USER INDEX
SHN 14
LMD UI+1
ADC -AUIMX
MJN FMS1 IF NOT SPECIAL USER INDEX
LDC 4000 SET SPECIAL USER INDEX
RAM FRSM
FMS1 LDM JORG CHECK JOB ORIGIN
LMK SYOT
NJN FMS2 IF NOT SYSTEM ORIGIN
LDM SSJS
ZJN FMS2 IF NOT SSJ= PROCESS
LDC 2000 SET *LIFT* FILE ALLOWED FOR DEFINE
RAM FRSM
FMS2 LJM FMSX RETURN
GCA SPACE 4,20
** GCA - GET CATALOG ADDRESS.
*
* ENTRY (A) = ADDRESS OF PERMANENT FILE DEVICE DESCRIPTION.
* (UI - UI+1) = USER INDEX.
* (FERT) = REAL-TIME PROCESSING FLAG.
* (SSYS) = SUBSYSTEM FLAG.
*
* EXIT (A) = ADDRESS OF MST/10B IF DEVICE FOUND.
* (A) .LT. 0 IF CATALOG NOT AVAILABLE.
* (T5) = EST ORDINAL.
* (T6) = CATALOG TRACK.
*
* TO *ERR* IF CATALOG NOT AVAILABLE AT THIS TIME
* AND CALLER HAS REAL-TIME PROCESSING SET IN FET
* OR IS NOT A SUBSYSTEM.
*
* CALLS SCA.
*
* MACROS ERROR.
GCA2 LCN 0 RETURN WITH (A) .LT. 0
GCA SUBR ENTRY/EXIT
RJM SCA SET CATALOG ADDRESS
PJN GCAX IF DEVICE AVAILABLE
ADN 1
NJN GCA2 IF DEVICE NOT FOUND
LDM FERT
NJN GCA1 IF REAL-TIME PROCESSING SELECTED
LDM SSYS
NJN GCA2 IF SUBSYSTEM
GCA1 ERROR WID,CH,IW,T5,EC6 * WAITING - INACCESSIBLE DEVICE.*
POA SPACE 4,25
** POA - PROCESS OPTIONAL USER NAME.
*
* ENTRY (CC) = COMMAND CODE
* (UI - UI+1) = CALLING USER INDEX.
* (FERT) = REAL-TIME PROCESSING FLAG.
* (RDCT) = DRIVER STATUS.
* (SSYS) = SUBSYSTEM FLAG.
*
* EXIT (A) .LT. 0 IF INCORRECT REQUEST.
* (UI - UI+1) = USER INDEX OF CATALOG TO BE ACCESSED.
* (PI - PI+1) = USER INDEX OF OPTIONAL USER.
* (PFUC) = USER CONTROLS.
*
* ERROR (STAU) = *STDP* BIT SET TO DROP PP.
* TO *3PU* IF USER NAME NOT VALID ON *CATLIST* REQUEST
* AND NO FILE NAME WAS SPECIFIED.
*
* TO *ERR* IF UNRECOVERABLE ERROR ON VALIDUS FILE
* OR DEVICE INACCESSIBLE.
*
* USES FN+3, FN+4, T4, T6, T7, CM - CM+4, CN - CN+4.
*
* CALLS CPN, SFA, SFN, SLT, SPN, *0AV*.
*
* MACROS ERROR, EXECUTE, NFA, SFA.
POA14 LCN 1 SET INCORRECT REQUEST
POA SUBR ENTRY/EXIT
LDN 0
STD PI CLEAR OPTIONAL USER INDEX
STD PI+1
LDD CC
LMN CCPM
ZJN POAX IF *PERMIT* REQUEST
LDM PFOU OPTIONAL USER
POA0 ZJN POAX IF NO OPTIONAL USER NAME
LMM PFAC JOB USER NAME
NJN POA2 IF USER NAMES DO NOT MATCH
LDM PFOU+1
LMM PFAC+1
NJN POA2 IF USER NAMES DO NOT MATCH
LDM PFOU+2
LMM PFAC+2
NJN POA2 IF USER NAMES DO NOT MATCH
LDM PFOU+3
LMM PFAC+3
SHN -6
NJN POA2 IF USER NAMES DO NOT MATCH
STM PFOU CLEAR OPTIONAL USER NAME
POA1 UJN POA0 RETURN
POA2 LDM PFRB CHECK FOR SPECIAL REQUEST BLOCK
LPN 37
ADM PFRB+1
ZJN POA3 IF NO SPECIAL REQUEST BLOCK
POA2.1 LDN 0 IGNORE OPTIONAL USER NAME
UJN POA1 RETURN
POA3 LDM TCTL,CC CHECK ALTERNATE CATALOG ACCESS LEGAL
SHN 21-0
PJN POA3.1 IF ALTERNATE CATALOG ACCESS VALID
SHN 21-12-21+0+22
MJN POA2.1 IF SRB-TYPE FUNCTION WITH NO SRB
AOM POAC INDICATE NONVALID ALTERNATE CATALOG ACCESS
POA3.1 LDM SSJS
ZJN POA4 IF NOT *SSJ=*
LDM JORG CHECK JOB ORIGIN
LMK SYOT
ZJN POA6 IF SYSTEM ORIGIN
POA4 LDN 0
* LDN 1 (ALTERNATE CATALOG ACCESS NOT VALID)
POAC EQU *-1
NJN POA4.1 IF ALTERNATE CATALOG ACCESS NOT ALLOWED
LDD CC
LMN CCCT
NJN POA6 IF NOT *CATLIST* REQUEST
LDM PFFN+4
ZJN POA6 IF NOT PERMIT LIST
LDM PFFN
NJN POA5 IF FILE NAME SPECIFIED
POA4.1 LJM POA14 RETURN INCORRECT REQUEST STATUS
POA5 LDN 2 SET TO BYPASS PRESET OF USER INDEX
RAM TCTL,CC
* CHECK USER NAME CACHE IN NFL/CPA.
POA6 LDC PFOU SET USER NAME
RJM SFN
LDD CP CHECK USER NAME CACHE IN CPA
ADK PFCW
CRD CN
NFA PUCN
CRD CM
LDN FN
RJM CPN COMPARE USER NAMES
NJN POA6.0 IF NO MATCH
LDD CM+4 SET USER INDEX
STD T2
LDD CM+3
LPN 37
STD T1
LDD CN+2 SET VALIDATIONS
STM PFUC
LJM POA7 CONTINUE
* CHECK COMMON LIBRARY TABLE IN CMR.
POA6.0 SFA EST,PFPN+4 SET FAMILY NAME
ADK EQDE
CRD CM
LDD CM+4 READ FAMILY NAME
SHN 3
ADN PFGL
CRD CN
RJM SLT CHECK COMMON LIBRARY TABLE
STM POAA SAVE SEARCH RESULT
ZJP POA7 IF VALIDATION NOT REQUIRED
* CALL *0AV* TO VALIDATE USER.
LDN 0 SET VALIDATION FUNCTION
STD FN+4
EXECUTE 0AV,LOCF VALIDATE USER NAME
PJN POA6.3 IF NO ERROR
LDM RDCT DRIVER STATUS
SHN 21-12
MJN POA6.2 IF UNRECOVERABLE ERROR
LDM SSYS
ZJN POA6.1 IF NOT A SUBSYSTEM
LDM FERT
ZJN POA6.2 IF REAL-TIME PROCESSING NOT SELECTED
POA6.1 ERROR WID,CH,IW,T5,EC6 * WAITING - INACCESSIBLE DEVICE.*
POA6.2 ERROR MSE,CH,IW,T5 *EQXXX,DNYY, MASS STORAGE ERROR.*
* CHECK FOR VALID USER NAME.
POA6.3 LDM AHFC*5,T3 SAVE USER LIMIT INDICES
STM PFUC
POA7 LDD T1
STD PI
RAD FN+3
LPN 77 SAVE ONLY USER INDEX PORTION OF BYTE
SHN 14
ADD T2
STD PI+1
STD FN+4
ZJN POA8 IF USER NAME NOT VALID
LMC IFUI
ZJN POA8 IF INDIRECT FLAW USER INDEX SPECIFIED
LJM POA10 PROCESS VALID USER NAME
* PROCESS NON-VALID USER NAME.
POA8 LDD CC CHECK COMMAND CODE
LMN CCCT
NJN POA9 IF NOT *CATLIST* REQUEST
LDM PFFN+4
NJN POA10 IF PERMIT CATLIST
LDM PFFN
NJN POA9 IF FILE NAME SPECIFIED
RJM SFA SET EOI STATUS TO INDICATE EMPTY CATALOG
CRD CM
LDD CM+3
SCN 77
STD CM+3
LDD CM+4
LPN 2
ADC 1031
STD CM+4
RJM SFA
CWD CM
LDK STDP SET *DROP PP* STATUS BIT
RAM STAU
EXECUTE 3PU DROP PP
POA9 RJM SPN SET PERMANENT FILE NAME
ERROR FNF,CH,IW *(FILENAME) NOT FOUND.*
* PROCESS VALID USER NAME.
POA10 LDM TCTL,CC
LPN 2
NJN POA11 IF NOT ALTERNATE USER ACCESS
LDD PI SET CATALOG TO BE ACCESSED
STD UI
LDD PI+1
STD UI+1
POA11 LDC 7776
* LDC 7776 (NORMAL USER NAME - NOT IN CLT)
* LDC 0 (USER NAME AND VALIDATION INFO IN CLT)
* LDC 1 (USER NAME BUT NOT VALIDATION INFO IN CLT)
POAA EQU *-1
ZJN POA12 IF ALL INFORMATION IN CLT
SBN 1
ZJN POA13 IF VALIDATION INFORMATION NEEDED IN CLT
* UPDATE USER NAME CACHE IN NFL/CPA.
LDD CP
ADK PFCW
CRD CN
LDM PFUC UPDATE USER VALIDATION INFORMATION
STM CN+2
LDD CP
ADK PFCW
CWD CN
NFA PUCN SAVE USER NAME AND USER INDEX
CWD FN
LDN 0 SET RETURN STATUS
POA12 LJM POAX RETURN
* UPDATE COMMON LIBRARY TABLE ENTRY.
POA13 LDD CN+3 CLEAR DEVICE NUMBER FROM FAMILY NAME
SCN 77
STD CN+3
LDD T5 SAVE NEW EST ORDINAL
STD CN+4 MERGE EST ORDINAL WITH FAMILY NAME
STM PFPN+4 CHANGE EST ORDINAL
LDC 0 GET ENTRY ORDINAL
POAB EQU *-1
STD T4
SFA CLT
ADK CLTU
CWD FN WRITE USER INDEX IN TABLE
ADN CLTF-CLTU
CWD CN WRITE FAMILY NAME AND EST ORDINAL IN TABLE
ADN CLTV-CLTF SET PERMANENT FILE VALIDATION INFORMATION
CRD CM
LDM PFUC
STD CM+4
SFA CLT,T4
ADN CLTV
CWD CM
LJM POAX RETURN
RCL SPACE 4,15
** RCL - RECALL PFM.
*
* ENTRY (A) = ERROR CODE.
* (PWRF) = RESTART FLAGS.
*
* EXIT (CN - CN+4) = INPUT REGISTER FOR *PFM* RECALL.
* (FN - FN+4) = RECALL REQUEST FOR MONITOR.
* (MP - MP+4) = PARAMETER WORD FOR *PFM* RECALL.
* (AIPF, AIPF+1) = 0.
* (STAU) = *STRP* BIT SET TO RECALL *PFM*.
* TO *3PU* TO RECALL *PFM*.
*
* USES P1, CN - CN+4, FN - FN+4, MP - MP+4.
*
* MACROS EXECUTE.
RCL BSS 0 ENTRY
STD P1 SAVE ERROR CODE
LDN 0 CLEAR PF ACCUMULATOR INCREMENT
STM AIPF
STM AIPF+1
LDN ZERL
CRD FN SET RECALL REQUEST
CRD MP
LDM PWRF SET RESTART FLAGS FOR RECALL
STD MP
LDD P1 SET ERROR CODE
STD MP+1
LDD IA READ INPUT REQUEST REGISTER
CRD CN
LDC PTMF SET TIMED RECALL
STD FN+1
LDC 250D SET DELAY TO 250D MILLISECONDS
STD FN+4
LDK STRP SET *RECALL PFM* STATUS BIT
RAM STAU
EXECUTE 3PU RECALL *PFM*
RSX SPACE 4,10
** RSX - REQUEST RESOURCE VALIDATION.
*
* CALL *RESEX* AS A *DMP=* PROGRAM.
*
* EXIT TO *RCL*.
*
* USES CM - CM+4, FN - FN+4.
*
* MACROS ERROR, MONITOR.
RSX BSS 0 ENTRY
LDD CP CHECK FOR *DMP=* IN PROGRESS
ADC SPCW
CRD CM
LDD CM+1
SHN -6
ADD CM
ZJN RSX1 IF NOT *DMP=* IN PROGRESS
ERROR ILR,CH,IW * PFM INCORRECT REQUEST.*
RSX1 LDD MA SET INPUT REGISTER
CWD IR
CRD FN
LDD FN+1
SCN 77
LMN 20 SET STATUS TO LEAVE RA+1 SET WITH PFM CALL
STD FN+1
LDN 0 CLEAR RETURN STATUS
STD FN+2
LDD CP WRITE CP REQUEST
ADC SPCW
CWD FN
LDN ROSR REQUEST SCHEDULER ROLLOUT
STD CM+1
MONITOR ROCM
* LDN 0 (NO ERROR CODE)
LJM RCL RECALL PFM
SAM SPACE 4,15
** SAM - SET UP ACCOUNTING MESSAGE.
*
* ENTRY (A) = ADDRESS OF USER NAME.
* (PFPN) = OPTIONAL PACK NAME.
* (CC) = COMMAND CODE.
*
* EXIT (PRSF) - (PRSH+PRSHL-1) = MESSAGE AREA SET UP.
*
* CALLS ACS, SFN, SPN.
*
* USES P0, T1, FN - FN+4.
SAM SUBR ENTRY/EXIT
STD P0 SAVE ADDRESS OF USER NAME
LDM PRSH,CC SET PFM FUNCTION IN MESSAGE BUFFER
STM PRSF+1
RJM SPN SET PERMANENT FILE NAME
LDC PRSH INITIALIZE MESSAGE POINTER FOR ACS CALLS
STD T1
LDN FN INSERT FILE NAME IN MESSAGE BUFFER
RJM ACS
LDC PRSB APPEND COMMA SEPARATOR
RJM ACS
LDI P0 CHECK USER NAME
ZJN SAM1 IF NULL USER NAME
LDD P0 CLEAR LOWER 3 CHARACTERS OF USER NAME
RJM SFN
LDN FN APPEND USER NAME IN MESSAGE BUFFER
RJM ACS
SAM1 LDC PRSB APPEND COMMA SEPARATOR
RJM ACS
LDM PFPN CHECK FOR OPTIONAL PACK NAME
ZJN SAM2 IF NO PACK NAME
LDC PFPN CLEAR LOWER 3 CHARACTERS OF PACK NAME
RJM SFN
LDN FN APPEND OPTIONAL PACK NAME
RJM ACS
SAM2 LDC PRSC APPEND MESSAGE TERMINATOR
RJM ACS
LJM SAMX RETURN
SRF SPACE 4,15
** SRF - SET UP RESERVE FNT.
*
* RESERVE AN FNT ENTRY IF STATUS *H* IS SET IN *TCTL*.
*
* ENTRY (CC) = COMMAND CODE.
*
* EXIT (FNTA) = ADDRESS OF RESERVE FNT ENTRY.
* (PRSF) = EXIT PROCESSING STATUS.
*
* CALLS SFN, *0BF*.
*
* USES T4, CM - CM+4, FS - FS+4.
*
* MACROS EXECUTE, EXIT.
SRF SUBR ENTRY/EXIT
LDM TCTL,CC CHECK FOR FNT NEEDED
SHN 21-7
SRF1 PJN SRFX IF FNT NOT NEEDED
LDC SRFB SET RESERVED FNT NAME
RJM SFN
LDN NEEQ ASSIGN NULL EQUIPMENT
STD FS
LDN 5 RETURN ON NFL INCREASE, LOCAL FILE LIMIT
STM LOCF-1
EXECUTE 0BF,LOCF CREATE PFM*** FILE
NJN SRF2 IF FILE NOT CREATED
* USE EXISTING FNT ENTRY (ADVANCE EXIT FROM *0BF*).
LDD FA SAVE RESERVE FNT POINTER
STM FNTA
LDD FN+4 SAVE FILE STATUS
LPN 77
RAM SFNB
LDN 0 CLEAR FST POINTER
STD FA
LDD FS CHECK FOR RESERVED SPACE
NJN SRF1 IF SPACE RESERVED
EXIT PFN,CH,IW,,EC4 * DEVICE UNAVAILABLE.*
SRF2 MJN SRF5 IF REJECT ON NFL INCREASE
LMN 4
NJN SRF6 IF NOT LOCAL FILE LIMIT
ERROR LFL,CH,IW * LOCAL FILE LIMIT.*
SRF5 LDN 0 SET SCHEDULER ROLLOUT
STM ERRC
STM ERRD
EXIT WNF,CH,IW,,EC1 * WAITING FOR NFL.*
SRF6 EXIT WNF,CH,IW,,EC4 * WAITING FOR NFL.*
SRFB VFD 60/6LPFM***
SUC SPACE 4,30
** SUC - SET USER CONTROLS.
* IF INDIVIDUAL CONTROL NOT SET USE
* SERVICE CLASS SPECIFIED LIMITS.
*
* ENTRY (PFUC) = USER CONTROL.
*T PFUC 3/ DS, 3/ FC, 3/ CS, 3/ FS
* DS = INDEX FOR DIRECT ACCESS FILE SIZE.
* FC = INDEX FOR NUMBER OF FILES IN CATALOG.
* CS = INDEX FOR CUMULATIVE SIZE OF INDIRECT FILES.
* FS = INDEX FOR INDIRECT FILE SIZE.
* (JORG) = JOB ORIGIN.
*
*
* EXIT (MXFS) = MAXIMUM INDIRECT FILE SIZE/10B.
* (IMSK) SET TO DEVICE ACCESS MASK FOR *DEFINE*.
* (MXNF) = MAXIMUM NUMBER OF FILES/100B.
* (MXCS - MXCS+1) = MAXIMUM CUMULATIVE SIZE FOR IAPF-S.
* (MXDS - MXDS+1) = MAXIMUM SIZE OF DIRECT ACCESS FILE.
*
* CALLS FMS, RJC.
*
* USES FS - FS+4, T1.
SUC SUBR ENTRY/EXIT
* SET PERMANENT FILE CONTROLS.
SUCA LDN 0 (SERVICE CLASS SET IN *PRS*)
LMN DSSC
NJN SUC1 IF NOT DEADSTART SEQUENCING
LDN SSSC&DSSC USE SUBSYSTEM SERVICE CLASS
SUC1 LMN DSSC READ JOB CONTROL PARAMETERS
RJM RJC
ZJN SUCX IF SERVICE CLASS UNDEFINED
ADN PFCT
CRD FS
* SET LIMIT FOR INDIVIDUAL FILE SIZE.
LDD FS SET SERVICE CLASS CONTROL AS DEFAULT
LPN 7
STD T1
LDM PFUC CHECK INDIVIDUAL *FS* VALUE
LPN 7
ZJN SUC2 IF NOT INDIVIDUAL CONTROL SET
STD T1
SUC2 LDM TMFS,T1 SET CONTROL VALUE
STM MXFS
* SET LIMIT FOR NUMBER OF FILES.
LDD FS SET SERVICE CLASS CONTROL AS DEFAULT
SHN -6
LPN 7
STD T1
LDM PFUC CHECK INDIVIDUAL *FC* VALUE
SHN -6
LPN 7
ZJN SUC3 IF NO INDIVIDUAL CONTROL SET
STD T1
SUC3 LDM TMNF,T1 SET CONTROL VALUE
STM MXNF
* SET LIMIT FOR CUMULATIVE SIZE OF INDIRECT ACCESS FILES.
LDD FS SET SERVICE CLASS CONTROL AS DEFAULT
SHN -3
LPN 7
SHN 1
STD T1
LDM PFUC CHECK INDIVIDUAL *CS* VALUE
SHN -3
LPN 7
ZJN SUC4 IF NO INDIVIDUAL CONTROL SET
SHN 1
STD T1
SUC4 LDM TMCS,T1 SET CONTROL VALUE
STM MXCS
LDM TMCS+1,T1
STM MXCS+1
* SET DIRECT ACCESS FILE SIZE CONTROLS.
LDM TCTL,CC
SHN 21-5
PJN SUC6 IF NOT DIRECT ACCESS REQUEST
RJM FMS FORM MASK FOR FILE RESIDENCE CHECK
LDD FS SET SERVICE CLASS CONTROL AS DEFAULT
SHN -11
LPN 7
SHN 1
STD T1
LDM PFUC CHECK INDIVIDUAL *DS* VALUE
SHN -11
LPN 7
ZJN SUC5 IF NO INDIVIDUAL CONTROL SET
SHN 1
STD T1
SUC5 LDM TMDS,T1 SET INDIVIDUAL CONTROL
STM MXDS
LDM TMDS+1,T1
STM MXDS+1
SUC6 LJM SUCX EXIT
SWI SPACE 4,15
** SWI - SWAP USER INDICES.
*
* ENTRY (UI - UI+1) = USER INDEX.
* (PI - PI+1) = PERMIT INDEX.
*
* EXIT (UI - UI+1) = PERMIT INDEX.
* (PI - PI+1) = USER INDEX.
SWI SUBR ENTRY/EXIT
LDD UI SWAP USER AND PERMIT INDICES
STD T1
LDD PI
STD UI
LDD T1
STD PI
LDD UI+1
STD T1
LDD PI+1
STD UI+1
LDD T1
STD PI+1
UJN SWIX RETURN
TMFS SPACE 4,15
** TABLE OF INDIVIDUAL FILE SIZE LIMITS.
TMFS BSS 0
LOC 0
CON 0
CON FSRNG1
CON FSRNG2
CON FSRNG3
CON FSRNG4
CON FSRNG5
CON FSRNG6
CON FSRNG7
LOC *O
TMNF SPACE 4,15
** TABLE OF NUMBER OF FILE LIMITS.
TMNF BSS 0
LOC 0
CON 0
CON NFRNG1
CON NFRNG2
CON NFRNG3
CON NFRNG4
CON NFRNG5
CON NFRNG6
CON NFRNG7
LOC *O
TMCS SPACE 4,15
** TABLE OF CUMULATIVE FILE SIZE LIMITS.
TMCS BSS 0
LOC 0
CON 0,0
CSR CSRNG1
CSR CSRNG2
CSR CSRNG3
CSR CSRNG4
CSR CSRNG5
CSR CSRNG6
CSR CSRNG7
LOC *O
TMDS SPACE 4,15
** TABLE OF DIRECT ACCESS FILE SIZE LIMITS.
TMDS BSS 0
LOC 0
CON 0,0
CSR DSRNG1
CSR DSRNG2
CSR DSRNG3
CSR DSRNG4
CSR DSRNG5
CSR DSRNG6
CSR DSRNG7
LOC *O
SPACE 4,10
* COMMON DECKS.
*CALL COMPACS
DTS$ EQU 0 CHECK FOR INACCESSIBLE DEVICE
*CALL COMPDTS
CLT$ EQU 0 DEFINE *COMPGFP* ACCESS TO CLT
EJT$ EQU 0 DEFINE *COMPGFP* ACCESS TO EJT
*CALL COMPGFP
*CALL COMPRJC
*CALL COMPSAF
*CALL COMPSCA
SPACE 4,10
LOCF EQU *+5 OVERLAY ADDRESS FOR ZERO-LEVEL OVERLAYS
ERRNG EPFW-LOCF-ZAVL CHECK LENGTH OF *0AV*
ERRNG EPFW-LOCF-ZBFL CHECK LENGTH OF *0BF*
ERRNG BFMS-LOCF-ZRFL CHECK LENGTH OF *0RF*
* THE FOLLOWING CODE MAY BE OVERLAID BY ZERO-LEVEL OVERLAYS.
TITLE OVERLAYABLE PRESET SUBROUTINES.
CPN SPACE 4,10
** CPN - COMPARE NAMES.
*
* ENTRY (CM - CM+3) = NAME FROM COMMON LIBRARIES TABLE.
* (A) = ADDRESS OF SECOND NAME.
*
* EXIT (A) = 0 IF MATCH.
*
* USES T7.
CPN SUBR ENTRY/EXIT
STD T7 SAVE ADDRESS
LDI T7
LMD CM
NJN CPNX IF NO MATCH
LDM 1,T7
LMD CM+1
NJN CPNX IF NO MATCH
LDM 2,T7
LMD CM+2
NJN CPNX IF NO MATCH
LDM 3,T7
LMD CM+3
SCN 77
UJN CPNX RETURN
PER SPACE 4,15
** PER - PROCESS ERROR REPLY FROM *CPUPFM*.
*
* ENTRY (A) = ERROR REPLY FROM *CPUPFM*.
* (CM - CM+4) = CP WORD *SPCW*.
* (PWRF) = *PFM* RESTART FLAGS.
*
* EXIT (A) = PARAMETER WORD FOR *ERROR* MACRO.
* (P1) = ERROR CODE.
* (PWRF) = *RFRR* BIT SET IF REQUEST TO BE RETRIED.
* TO *3PS* TO REDO *DMP=* CALL IF *CPUPFM* DID NOT
* COMPLETE.
*
* USES T0.
*
* MACROS EXECUTE.
PER SUBR ENTRY/EXIT
STD T0
SHN 21-11
PJN PER3 IF *CPUPFM* DID NOT COMPLETE
LDD T0
LPC 177
STD P1 ERROR CODE
ZJN PERX IF NO ERROR
LMK /ERRMSG/RTR
NJN PER2 IF NOT *RETRY REQUEST*
LDM PWRF RESTART FLAGS
LPK RFRR
NJN PER1 IF REQUEST ALREADY RETRIED
LDK RFRR SET *RETRY REQUEST* FLAG
RAM PWRF
UJN PER2 FORM PARAMETER WORD FOR *ERROR* MACRO
PER1 LDK /ERRMSG/MSE SET ERROR CODE TO *MASS STORAGE ERROR*
STD P1
PER2 LDD T0 FORM PARAMETER WORD FOR *ERROR* MACRO
SHN 1-10
LPN 2 ERROR IDLE FLAG
STD T0
LDD P1
SHN 2 ERROR CODE
ADD T0
UJN PERX RETURN
* REDO *DMP=* CALL.
PER3 LDD CM
EXECUTE 3PS REDO *DMP=* CALL
PFP SPACE 4,20
** PFP - PROCESS FET PARAMETERS.
*
* ENTRY (IR+3 - IR+4) = FET ADDRESS.
*
* EXIT (CN - CN+4) = USER NAME/USER INDEX.
* (FN - FN+4) = ACCESS WORD (*AACW*).
* (FERT) = REAL-TIME PROCESSING FLAG.
* (PFUC) = USER CONTROLS.
* (FETL) = LENGTH OF PF PARAMETERS IN FET.
* (PRSA - PRSA+1) = AUXILIARY DEVICE TYPE REQUESTED.
* (RQDT - RQDT+1) = REQUESTED DEVICE TYPE.
* PARAMETERS FROM FET SET IN PFM PARAMETER BLOCK AREA.
*
* USES T1, CM - CM+4, CN - CN+4, FN - FN+4.
*
* CALLS CRS, PSR, PXT, SAP, SFA, VRP.
*
* MACROS ERROR.
PFP SUBR ENTRY/EXIT
RJM SFA READ FET+1
ADN 1
CRD CM
LDD CM SET DEVICE TYPE FOR AUX PACK PROCESSING
STM PFPB
LDD CM+1 SAVE RT STATUS
SHN 0-7
LPN 1
STM FERT
LDD CM+1 SAVE SECURITY PROCESSING BIT
LPN 10
STM PFSP
LDD CM+3
SHN -6
ADN 5 COMPUTE FULL LENGTH
STD T1
* CHECK RECALL STATUS.
LDM TCTL,CC
SHN 21-13
MJN PFP1.1 IF REQUEST MAY BE MADE WITHOUT AUTO-RECALL
RJM CRS CHECK RECALL STATUS
NJN PFP2 IF CALLED WITH AUTO RECALL
PFP1 ERROR PAE,CH,IW * PFM ARGUMENT ERROR.*
PFP1.1 LDD CM+1 CHECK ERROR PROCESSING OPTIONS
SHN 0-10
LPN 3
LMN 3
NJN PFP1 IF EITHER *EP* OR *UP* NOT SPECIFIED
* SET FET PARAMETERS.
PFP2 LDD CC
LMN CCCT
NJN PFP2.1 IF NOT *CATLIST* COMMAND
LDD T1
SBN CFCN+1
MJN PFP1 IF FET NOT LONG ENOUGH
PFP2.1 LDD T1 DETERMINE IF FET WILL FIT IN BUFFER AREA
SBM FETL
PJN PFP3 IF FET LONGER THAN PF PARAMETERS
RAM FETL SET FET LENGTH
PFP3 LDM FETL READ FET PARAMETERS
SBN CFPN
STD T1
MJN PFP4 IF NONE TO READ
ZJN PFP4 IF NONE TO READ
RJM SFA
ADN CFPN
CRM PFFN,T1
LDM EMRA CHECK ERROR MESSAGE RETURN ADDRESS
LPN 37
SHN 14
ADM EMRA+1
ADN 3 CHECK ADDRESS
SHN -6
SBD FL
MJN PFP4 IF ADDRESS IN RANGE
LDN 0 CLEAR ERROR MESSAGE RETURN ADDRESS
STM EMRA
STM EMRA+1
LJM PFP1 ISSUE ERROR MESSAGE
PFP4 RJM SAP SAVE ACCESS PARAMETERS
RJM PXT PROCESS EXPIRATION TERM
LDD CP READ USER CONTROL FROM CONTROL POINT
ADN PFCW
CRD FS
ADN UIDW-PFCW READ USER INDEX
CRD CN
CRM PFAC,ON READ USER NAME
ADN AACW-UIDW-1
CRD FN READ USER VALIDATIONS
LDM SSJS
ZJN PFP4.1 IF NOT *SSJ=*
LDD CN+3 CHECK USER INDEX
LPN 37
SHN 14
LMD CN+4
LMC SYUI
NJN PFP4.1 IF NOT *SYSTEMX*
LCN 0 SET UNLIMITED VALIDATIONS
STD FS+4
PFP4.1 LDD FS+4 SAVE PF USER CONTROL VALIDATIONS
STM PFUC
RJM PSR PROCESS SPECIAL REQUEST BLOCK
NJN PFP5 IF NOT SPECIAL REQUEST
LJM PFPX RETURN
* DETERMINE AUXILIARY PACKNAME AND DEVICE TYPE.
PFP5 RJM VRP VERIFY PARAMETERS
LDK PFNL PRESET SYSTEM DEFAULT PACK TYPE
CRD CM
LDD CM+1
SCN 77
SHN 6
LMD CM
SHN 6
STM RQDT+1
SHN -14
STM RQDT
LDM PFPN+4 SAVE UNIT COUNT
STM PFPA
LDD IA READ INPUT REGISTER
CRD CM
LDD CM+2
SCN 77
NJN PFP6 IF *IP* OR *DF* SPECIFIED
LDM PFPN
ZJN PFP8 IF PACKNAME NOT SPECIFIED IN FET
LMC 1R0*100
NJP PFP9 IF NOT *PN.EQ.0*
* CLEAR PACKNAME.
PFP6 LDN 0 CLEAR PACKNAME
STM PFPN
LDD CM+2
SHN 21-11
PJN PFP7 IF NOT *DF* (FORCE SYSTEM DEFAULT FAMILY)
LDM SSJS
ZJP PFP1 IF NOT *SSJ=* PROGRAM
LDC PFNL
CRD FS
PFP7 UJN PFP9.1 SET FAMILY EQUIPMENT
* NO PACKNAME IN FET - SET PACKNAME AND DEVICE TYPE FROM CPA.
PFP8 LDD CP SET PACKNAME AND DEVICE TYPE FROM CPA
ADC PKNW
CRM PFPN,ON
LDM PFPN+4
ZJN PFP9 IF DEVICE TYPE NOT SPECIFIED IN CPA
STM RQDT+1 SET DEVICE TYPE
LDM PFPN+3
LPN 37
UJN PFP10.1 SET USER REQUESTED AND FAMILY EQUIPMENT
* SET DEVICE TYPE FROM FET.
PFP9 LDN CFPK CHECK FET LENGTH
SBM FETL
PFP9.1 PJN PFP11 IF FET TOO SHORT FOR UNIT COUNT
LDC *
PFPA EQU *-1 (UNIT COUNT SPECIFIED IN FET)
NJN PFP10 IF UNIT COUNT SPECIFIED
LDN 1 SET DEFAULT COUNT
PFP10 ADN 1R0 CONVERT TO DISPLAY CODE
STD T1
LDC *
PFPB EQU *-1 (DEVICE TYPE SPECIFIED IN FET)
ZJN PFP11 IF NO DEVICE TYPE SPECIFIED
LPC 3777 SET REQUESTED DEVICE TYPE
SHN 6
LMD T1
STM RQDT+1
SHN -14
PFP10.1 LMD HN SET *USER REQUESTED DEVICE* FLAG
STM RQDT
* SET FAMILY EQUIPMENT.
PFP11 LDD FS+3
STM PFPN+4
LJM PFPX RETURN
PSR SPACE 4,15
** PSR - PROCESS SPECIAL REQUEST BLOCK.
*
* ENTRY (CC) = COMMAND CODE.
* (FS - FS+4) = (PFCW) FROM CONTROL POINT AREA.
* (PFRB - PFRB+1) = SPECIAL REQUEST BLOCK ADDRESS.
* (SSJS) .NE. 0 IF CALLED BY *SSJ=* PROGRAM.
*
* EXIT (A) = 0 IF SPECIAL REQUEST.
* (CN+3 - CN+4) = USER INDEX.
* (PFPN - PFPN+4) = 42/ NAME, 6/, 12/ FAMILY EQ.
* (PFUC) = USER CONTROLS.
* (PFSB - PFFN) = SPECIAL REQUEST BLOCK SETUP.
* *STTA* SET IN *STAT* IF TAPE ALTERNATE STORAGE REQUEST.
*
* USES T5, T6, CM - CM+4, CN - CN+4, T0 - T0+4, T7 - T7+4.
*
* CALLS VCA.
*
* MACROS ERROR, SFA.
PSR12 LDN 1 INDICATE NO SRB
PSR SUBR ENTRY/EXIT
LDM TCTL,CC
SHN 21-12
PSR1 PJN PSR12 IF NO SPECIAL REQUEST BLOCK ALLOWED
* READ SPECIAL REQUEST BLOCK (SRB).
PSR2 LDM PFRB CHECK LOCATION OF SPECIAL REQUEST BLOCK
LPN 37
SHN 14
ADM PFRB+1
NJN PSR3 IF ADDRESS SPECIFIED
* NO SRB SPECIFIED ON FUNCTION WHICH ALLOWS SRB. FOR *DROPDS*,
* *DROPIDS* AND *PURGE* - ALLOW EVEN WITH NO *SSJ=*.
* FOR *ASSIGNPF*, *UATTACH* AND *UGET* - ALLOW WITH *SSJ=*.
* FOR ALL OTHER SRB-TYPE FUNCTIONS - DO NOT ALLOW.
LDD CC
LMN CCPG
ZJN PSR1 IF *PURGE*
LMN CCDD&CCPG
ZJN PSR1 IF *DROPDS*
LMN CCDI&CCDD
ZJN PSR1 IF *DROPIDS*
LMN CCUA&CCDI
ZJN PSR2.1 IF *UATTACH*
LMN CCUG&CCUA
ZJN PSR2.1 IF *UGET*
LMN CCAN&CCUG
NJN PSR4 IF NOT *ASSIGNPF*
PSR2.1 LDM SSJS
NJN PSR1 IF *SSJ=*
PSR2.2 ERROR ILR,CH,IW * PFM INCORRECT REQUEST.*
PSR3 ADN SFBL-1
SHN -6
SBD FL
MJN PSR5 IF IN RANGE OF FIELD LENGTH
PSR4 ERROR PAE,CH,IW * PFM ARGUMENT ERROR.*
PSR5 LDM SSJS ALWAYS REQUIRE *SSJ=* IF SRB SPECIFIED
ZJN PSR2.2 IF NOT *SSJ=*
LDN SFBL READ SPECIAL REQUEST BLOCK
STD T1
LDM PFRB
LPN 37
SHN 6
ADD RA
SHN 6
ADM PFRB+1
CRM PFSB,T1
LDM PFSB+5+1
SHN 21-6
PJN PSR5.1 IF NOT TAPE ALTERNATE STORAGE REQUEST
LDN STTA SET TAPE FLAG
RAM STAT
PSR5.1 LDN ZERL INITIALIZE FOR USER INDEX
CRD CN
LDM PFSU SET USER INDEX
LPN 77
STD CN+3
LDM PFSU+1
STD CN+4
* FIND THE FAMILY EST ORDINAL BASED ON THE FAMILY NAME AND
* DEVICE NUMBER.
LDN ESTP READ EST SEARCH POINTERS
CRD T0
LDN NOPE-1 INITIALIZE EST ORDINAL FOR SEARCH
STD T5
LDD T0+3 SAVE LAST MASS STORAGE ORDINAL + 1
STD T6
PSR6 AOD T5 ADVANCE EST ORDINAL
LMD T6
NJN PSR7 IF NOT END OF MASS STORAGE DEVICES
ERROR IPA,CH,IW * INCORRECT PFC ADDRESS.*
PSR7 SFA EST,T5
ADK EQDE
CRD CM
LDD CM CHECK FOR MASS STORAGE DEVICE
SHN -6
LPN 41
LMN 40
NJN PSR6 IF UNAVAILABLE OR NON-MS DEVICE
LDD CM+3 SAVE DEVICE TYPE
STM PSRB
LDD CM+4 READ MST
STM PSRA SAVE MST ADDRESS
SHN 3
ADN STLL
CRD T0
LDD T0
LPC MLFPR+MLIAL+MLIHD+MLIFD+MLIPF+MLUNL+MLDUL
PSR7.1 NJN PSR6 IF INITIALIZE PENDING OR UNLOADED
LDM PSRA
SHN 3
ADN PFGL
CRD T0
LDM PFFM COMPARE FAMILY NAME
LMD T0
PSR8 NJN PSR7.1 IF FAMILY NAME DOES NOT MATCH
LDM PFFM+1
LMD T0+1
NJN PSR8 IF FAMILY NAME DOES NOT MATCH
LDM PFFM+2
LMD T0+2
NJN PSR8 IF FAMILY NAME DOES NOT MATCH
LDM PFFM+3
LMD T0+3
SCN 77
NJN PSR8 IF FAMILY NAME DOES NOT MATCH
LDD CC CHECK COMMAND CODE
LMN CCAN
ZJN PSR9 IF *ASSIGNPF* COMMAND
LDM PFID COMPARE DEVICE NUMBER
LMD T0+3
LPN 77
NJN PSR8 IF DEVICE NUMBER DOES NOT MATCH
* THE EST ORDINAL HAS BEEN IDENTIFIED.
RJM VCA VERIFY THE CATALOG ADDRESS *PFID*
PSR9 LDD FS+4 SET USER CONTROL BIT
STM PFUC
LDM PFPN CHECK FET FIELDS
ADM PFOU
NJP PSR4 IF *PN* OR *UN* SPECIFIED
LDC * CHECK IF DEVICE IS AUXILIARY PACK
PSRA EQU *-1 (MST ADDRESS/10)
SHN 3
ADN MDGL
CRD T0
ADN DDLL-MDGL
CRD T7
LDD T0+0
SHN 21-12
MJN PSR10 IF AUXILIARY PACK
LDD T5 SET EST ORDINAL OF SPECIFIED DEVICE
UJN PSR11 SET FAMILY EST ORDINAL
PSR10 LDD MA SET PACKNAME INTO *PFPN*
CWM PFFM,ON
SBN 1
CRM PFPN,ON
LDD T7+0 GET UNIT COUNT
LPN 7
ADN 1R1
SHN 14
LMC *
PSRB EQU *-1 (DEVICE TYPE)
SHN 6
STM RQDT+1 SET REQUESTED DEVICE TYPE
SHN -14
STM RQDT
LDD FS+3 SET FAMILY EST ORDINAL FROM CPA
PSR11 STM PFPN+4 SET FAMILY EST ORDINAL
LDN 0 INDICATE SPECIAL REQUEST BLOCK PRESENT
LJM PSRX RETURN
PXT SPACE 4,20
** PXT - PROCESS EXPIRATION TERM.
*
* CONVERT EXPIRATION TERM INTO PACKED DATE, AND CHECK AGAINST
* MAXIMUM ALLOWED BY SYSTEM.
*
* ENTRY (PFXT - PFXT+1) = USER SPECIFIED EXPIRATION DATE/TERM.
* (CC) = COMMAND CODE.
* (SVAL) = SECURITY VALIDATION BITS.
*
* EXIT (PXDT - PXDT+1) = VALIDATED EXPIRATION DATE.
* (PXDT - PXDT+1) = 0 IF NONEXPIRING PASSWORD/PERMIT.
*
* USES T1, T2, CM - CM+4, CN - CN+4.
*
* MACROS ERROR, MONITOR.
PXT SUBR ENTRY/EXIT
LDM TCTL,CC
SHN 21-10
PJN PXTX IF COMMAND DOES NOT ALLOW *XT*
LDN ZERL
CRD CM
LDN RIDS SET UP *RDCM* PARAMETERS
STD CM+1
LDM PFXT CHECK *XD/XT*
LPN 77
STD T1
SHN 14
LMM PFXT+1
STD T2
NJN PXT1 IF *XD/XT* SPECIFIED
LDK FPXT USE SYSTEM DEFAULT *XT*
STD T2
LJM PXT8 SET DEFAULT *XT*
PXT1 LDN STXD INDICATE THAT DATE WAS SPECIFIED
RAM STAT
LDM SVAL CHECK PASSWORD EXPIRATION VALIDATION
SHN 21-10
MJN PXT2 IF USER VALIDATED TO SET EXPIRATION DATE
ERROR NVX,CH,IW *NOT VALIDATED TO SET XD/XT.*
PXT2 LDD T1
ZJP PXT7 IF *XT* SPECIFIED RATHER THAN *XD*
* VALIDATE SPECIFIED EXPIRATION DATE.
PXT3 LDK FPXL READ MAXIMUM *XT* ALLOWED
LMC 7777
ZJN PXT4 IF MAXIMUM IS UNLIMITED
LDK FPXL CONVERT MAXIMUM *XT* TO *XD*
STD CM+4
MONITOR RDCM
LDD MA
CRD CN COMPARE *XD* SPECIFIED WITH MAXIMUM *XD*
LDD CN+3
SBD T1
MJN PXT6 IF DATE BEYOND MAXIMUM
SHN 14
ADD CN+4
SBD T2
MJN PXT6 IF DATE BEYOND MAXIMUM
* SAVE PASSWORD/PERMIT EXPIRATION DATE.
PXT4 LDD T1
SHN 14
LMD T2
PXT5 STM PXDT+1
SHN -14
STM PXDT
LJM PXTX RETURN
PXT6 ERROR DEM,CH,IW *XD/XT EXCEEDS MAXIMUM.*
* PROCESS EXPIRATION TERM.
PXT7 LDK FPXL COMPARE TO MAXIMUM *XT*
SBD T2
MJN PXT6 IF MAXIMUM *XT* EXCEEDED
PXT8 LDD T2
LMC 7777
ZJN PXT5 IF NON-EXPIRING TERM SPECIFIED
LDD T2 CONVERT *XT* INTO *XD*
STD CM+4
MONITOR RDCM
LDD MA READ RESULT
CRD CN
LDD CN+3
SHN 14
LMD CN+4
UJN PXT5 STORE DATE
SAP SPACE 4,15
** SAP - SAVE ACCESS PARAMETERS.
*
* ENTRY (CC) = COMMAND CODE.
*
* EXIT (PFFC - PFFC+2) = SPECIFIED ACCESS CATEGORY SET.
* (PFAL) = JOB ACCESS LEVEL.
* (LFAL) = SPECIFIED ACCESS LEVEL(IF ANY),DEFAULT PFAL.
* (SVAL) = SECURITY VALIDATION BITS.
*
* USES CN - CN+4, CM - CM+4, T0 - T4.
*
* MACROS ERROR, MONITOR.
SAP SUBR ENTRY/EXIT
LDD CP GET JOB DEFAULT VALUES AND VALIDATION
ADK JSCW
CRM SVAL,ON
LDM SVAL+1 SAVE JOB ACCESS LEVEL
SHN -11
STM PFAL
STM LFAL
LDM SVAL+2 SAVE JOB ACCESS CATEGORY SET
LPC 377
STM PFFC
ERRNZ SVAL+2-PFFC CODE DEPENDS ON VALUE
LDN ZERL SET UP FOR *VSAM*
CRD CN
CRD CM
LDN VAJS
STD CM+1
LDD CC
LMN CCAC
ZJP SAP4 IF *SETPFAC* REQUEST
LMN CCAL&CCAC
ZJN SAP2 IF *SETPFAL* REQUEST
* PROCESS ACCESS LEVEL FROM FET FOR *SAVE*, *DEFINE*, AND
* *ASSIGNPF*, IF *SP* BIT SET.
LMN CCSV&CCAL
ZJN SAP1 IF *SAVE* REQUEST
LMN CCDF&CCSV
ZJN SAP1 IF *DEFINE* REQUEST
LMN CCAN&CCDF
NJP SAPX IF NOT *ASSIGNPF* REQUEST
SAP1 LDM PFSP
ZJP SAPX IF SECURITY PROCESSING BIT NOT SET
* VALIDATE SPECIFIED ACCESS LEVEL.
SAP2 RJM SFA GET SPECIFIED ACCESS LEVEL
ADN CFAL
CRD T0
LDD T0+1 SAVE ACCESS LEVEL
LPN 7
STM LFAL
STD CN+1
LDN 1 VALIDATE ACCESS LEVEL ONLY
STD CM+4
LDD MA
CWD CN
MONITOR VSAM
LDD CM+1
ZJP SAPX IF SPECIFIED ACCESSES VALID
ERROR LNJ,CH,IW,,SVE * ACCESS LEVEL NOT VALID FOR JOB.*
* VALIDATE SPECIFIED ACCESS CATEGORY SET.
SAP4 LDN CFFC
SBM FETL
MJN SAP5 IF FET LONG ENOUGH FOR FUNCTION
ERROR ILR,CH,IW * PFM INCORRECT REQUEST.*
SAP5 RJM SFA GET SPECIFIED ACCESS CATEGORY SET
ADN CFFC
CRD CN
LDD CN+2
LPC 377
STD CN+2
STM PFFC SAVE ACCESS CATEGORY SET
LDD CN+3
STM PFFC+1
LDD CN+4
STM PFFC+2
LDN 2 VALIDATE ACCESS CATEGORY SET ONLY
STD CM+4
LDD MA
CWD CN
MONITOR VSAM
LDD CM+1
ZJP SAPX IF SPECIFIED ACCESS CATEGORY SET VALID
ERROR CNJ,CH,IW,,SVE * ACCESS CATEGORIES NOT VALID FOR JOB*
SEP SPACE 4,10
** SEP - SET ERROR PROCESSING OPTIONS.
*
* EXIT (EPOP) = ERROR PROCESSING OPTIONS.
*
* USES CM - CM+4.
*
* CALLS SFA.
SEP SUBR ENTRY/EXIT
RJM SFA READ FET+1
ADN 1
CRD CM
LDD CM+1 SAVE ERROR PROCESSING OPTIONS
SHN 0-6
LPN 37
STM EPOP
UJN SEPX RETURN
SLT SPACE 4,20
** SLT - SEARCH COMMON LIBRARY TABLE FOR ALTERNATE USER NAME.
*
* ENTRY (FN - FN+3) = USER NAME FOR ALTERNATE ACCESS.
*
* EXIT (A) = -1 IF USER NAME NOT FOUND.
* (A) = 0 IF MATCH AND USER INDEX AND EQ AVAILABLE.
* (A) = 1 IF MATCH BUT VALIDATION NEEDED.
* (CN - CN+3) = FAMILY IF USER NAME FOUND.
* (T1 - T2) = USER INDEX IF FOUND IN THE TABLE.
* (POAB) = TABLE OFFSET IF ENTRY FOUND.
* (PFPN+4) = (T5) = EST ORDINAL IF TAKEN FROM THE TABLE.
* (PFUC) = PERMANENT FILE VALIDATION.
*
* USES T1 - T7, CM - CM+4.
*
* CALLS CPN.
*
* MACROS SFA.
SLT6 LCN 1 VALUE
SLT SUBR ENTRY/EXIT
LDC CLTP PICK UP COMMON LIBRARIES POINTER
CRD T3
LDD T5
ZJN SLT6 IF NO CLT
LDN 0 INITIALIZE CLT OFFSET
STD T4
SLT1 AOD T4 CHECK NEXT CLT ENTRY
LMD T5
ZJN SLT6 IF END OF CLT
SFA CLT,T4
CRD CM READ COMMON LIBRARIES USER NAME
LDN FN PASS ALTERNATE USER NAME ADDRESS
RJM CPN COMPARE USER NAMES
NJN SLT1 IF NO MATCH
SLT2 LDD T4
STM POAB SAVE TABLE OFFSET FOR ENTRY
LDD CM+3 PICK UP USER INDEX
LPN 37
STD T1
LDD CM+4
STD T2
SFA CLT,T4 CHECK FOR EST ORDINAL
ADN CLTF-CLTU
CRD CN PICK UP FAMILY NAME AND EST ORDINAL
LDD CN+4
NJN SLT5 IF EST ORDINAL IN THE TABLE
SLT3 LDN 1 SET VALIDATION REQUIRED
SLT4 LJM SLTX RETURN
SLT5 STD T5 SAVE EST ORDINAL
SFA EST
ADK EQDE
CRD CM READ EST ENTRY
LDD CM+4 GET MST ADDRESS
SHN 3
ADN PFGL
CRD CM READ FAMILY OR PACK NAME
LDN CN
RJM CPN COMPARE FAMILY NAMES
NJN SLT3 IF NO MATCH
LDD T5 CHANGE EST ORDINAL
STM PFPN+4
SFA CLT,T4 GET PF VALIDATION
ADN CLTV-CLTU
CRD CM
LDD CM+4
STM PFUC
LDN 0 USER NAME AND INDEX FOUND
UJN SLT4 RETURN
VCA SPACE 4,15
** VCA - VERIFY CATALOG ADDRESS.
*
* ENTRY (CM - CM+4) = EST ENTRY OF THE FAMILY AND DEVICE.
* (T5) = EST ORDINAL FOR THE FAMILY AND DEVICE NUMBER.
* (PFID - PFID+2) = 4/,2/PEO,6/DN,12/TRACK,12/SECTOR.
*
* EXIT THE CATALOG ADDRESS IS VERIFIED TO DEFINE A LEGAL
* PERMANENT FILE CATALOG ADDRESS.
*
* USES CM - CM+4, T0 - T0+4, T6 - T6+4.
*
* CALLS CTA.
*
* MACROS ERROR.
VCA SUBR ENTRY/EXIT
LDD CM+4 DETERMINE MST ADDRESS
SHN 3
ADN ALGL READ THE DEVICE ALLOCATION WORD
CRD T6
ADN PUGL-ALGL READ DEVICE MASK
CRD T0
ADN TRLL-PUGL
RJM CTA CALCULATE FWA OF TRT
SBD TH BIAS FOR LINK INDICATOR BIT
STM VCAA+1
SHN -14
LMC ADCI
STM VCAA
LDD T6+1 SET FIRST TRACK IN CATALOG CHAIN (LABEL)
STD T6
LDM PFSU+1 CHECK USER INDEX AGAINST DEVICE MASK
LPN 7
RAM VCAB
LDN 1
VCAB SHN ** (LAST DIGIT OF USER INDEX)
STM VCAC
LDD T0+4
LPC 377
LPC * (MASK FOR SPECIFIED USER INDEX)
VCAC EQU *-1
ZJN VCA2 IF USER INDEX NOT LEGAL FOR DEVICE
* LOOP THROUGH THE CHAIN OF CATALOG TRACKS AND VERIFY THAT
* THE SPECIFIED TRACK IS IN THE CHAIN.
VCA1 LDD T6 CHECK TRACK LINKAGE
SHN 21-13
PJN VCA2 IF NOT A VALID LINKAGE
ZJN VCA2 IF END OF CHAIN
SHN 13-21-2 CALCULATE NEXT TRT WORD OFFSET
VCAA ADC TRTS
CRD CM READ THE LINKED TO WORD
LDD T6 BIAS INTO THIS TRT WORD
LPN 3
STD CM+4
LDM CM,CM+4
STD T6 SET THE NEXT TRACK
LMM PFID+1
ZJN VCA3 IF THE SPECIFIED TRACK IS IN THE CHAIN
UJN VCA1 CONTINUE EXAMINING CATALOG TRACKS
VCA2 ERROR IPA,CH,IW * INCORRECT PFC ADDRESS.*
* THE TRACK IS A MEMBER OF THE CATALOG CHAIN.
VCA3 SETMS STATUS VERIFY THE SECTOR SPECIFIED
LDM PFID+2
SBM SLM
PJN VCA2 IF SECTOR OUT OF RANGE
LJM VCAX RETURN
VFA SPACE 4,15
** VFA - VERIFY FET ADDRESS.
*
* EXIT (A) .LT. 0, IF FET NOT WITHIN CALLER-S FIELD LENGTH.
* (SFAB) = *LDD RA*, IF FET IN RANGE.
* (SFAA - SFAA+1) = FET ADDRESS, IF IN RANGE.
*
* USES T1, CN - CN+4.
*
* CALLS SFA.
*
* MACROS ISTORE.
VFA SUBR ENTRY/EXIT
LDD IR+3
LPN 77
SHN 14
MJN VFA1 IF ADDRESS OUT OF RANGE
LMD IR+4
ADN 1
SHN -6
SBD FL
MJN VFA2 IF ADDRESS IN RANGE
VFA1 LCN 0 SET ERROR RETURN
UJN VFAX RETURN
VFA2 LDD IR+3 SAVE FET ADDRESS
LPN 37
LMC ADCI
STM SFAA
LDD IR+4
STM SFAA+1
ISTORE SFAB,(LDD RA) FLAG FET ADDRESS VALID
RJM SFA READ FET LENGTH/RANDOM BIT
ADN 1
CRD CN
LDD CN+3 SAVE FET LENGTH
SHN -6
ADN 4
STD T1
LDD CN+1
SHN 21-13
PJN VFA4 IF NOT RANDOM FET
LDD T1
SBN CFCN
PJN VFA4 IF FET NOT TOO SHORT
VFA3 UJN VFA1 SET ERROR RETURN
VFA4 LDD IR+3 CHECK FET WITHIN FIELD LENGTH
LPN 77
SHN 14
LMD IR+4
ADD T1
SHN -6
SBD FL
PJN VFA3 IF FET OUT OF RANGE
LDN 0 SET NO ERROR
UJP VFAX RETURN
VRP SPACE 4,15
** VRP - VERIFY PARAMETERS.
*
* ENTRY (CC) = COMMAND CODE.
* (FN - FN+4) = ACCESS WORD.
* (PFBR) = BACKUP REQUIREMENT VALUE.
* (PFRS) = PREFERRED RESIDENCE VALUE.
* (PFSS) = SUBSYSTEM VALUE.
* (PFAP) = ALTERNATE CATLIST PERMISSION VALUE.
*
* EXIT PARAMETERS VERIFIED TO BE IN RANGE.
* DEFAULT VALUES SET IF NEEDED (FILE CREATION).
*
* MACROS ERROR.
VRP SUBR ENTRY/EXIT
LDD CC CHECK FOR *CHANGE* REQUEST
LMN CCCG
ZJN VRP3 IF *CHANGE* REQUEST
* SET DEFAULT VALUES ON FILE CREATION.
LDM PFSS CLEAR *CHANGE* FLAG ON FILE CREATION
SCN 40
STM PFSS
LDM PFBR INSURE VALID *BR* VALUE
LPC 0700
NJN VRP1 IF *BR* PARAMETER SPECIFIED
LDC BRDE*100 SET DEFAULT *BR* VALUE
RAM PFBR
VRP1 LDM PFRS INSURE VALID *PR* VALUE
SHN 0-11
NJN VRP2 IF *PR* PARAMETER SPECIFIED
LDC RSDE*1000 SET DEFAULT *PR* VALUE
RAM PFRS
VRP2 LDM PFAP CHECK FOR NULL *AC* VALUE
SHN -12
NJN VRP3 IF *AC* PARAMETER SPECIFIED
LDC ACDF*2000 SET DEFAULT *AC* VALUE
RAM PFAP
* ENSURE VALID PARAMETER VALUES.
VRP3 LDM PFBR VERIFY RANGE OF *BR* VALUE
SHN 0-6
LPN 7
SBN BRMX+1
PJN VRP4 IF *BR* NOT IN RANGE
LDM PFRS VERIFY RANGE OF *PR* VALUE
SHN 0-11
SBN RSMX+1
PJN VRP4 IF *PR* OUT OF RANGE
ADN RSMX+1-RSLK
NJN VRP5 IF *DISK LOCKED* NOT REQUESTED
LDD FN+2 CHECK FOR *CLTD* VALIDATION
SHN 21-0
MJN VRP5 IF USER VALIDATED TO SPECIFY DISK LOCKED
VRP4 ERROR ILR,CH,IW * PFM INCORRECT REQUEST.*
VRP5 LDM PFSS VERIFY SUBSYSTEM VALUE
LPN 37
SBN MSYS+1
PJN VRP4 IF *SS* NOT VALID
LDM PFAP VERIFY *AC* PARAMETER
SHN -12
SBN ACMX+1
PJN VRP4 IF *AC* NOT VALID
LJM VRPX RETURN
VUA SPACE 4,15
** VUA - VALIDATE USER ACCESS.
*
* EXIT (SSJS) = 1 IF *SSJ=* JOB.
*
* USES CM - CM+4.
VUA SUBR ENTRY/EXIT
LDD CP CHECK FOR SSJ= JOB
ADC SEPW
CRD CM
LDD CM
SHN 0-2
LPN 1
STM SSJS SAVE *SSJ=* STATUS
UJN VUAX RETURN
SPACE 4,10
* COMMON DECKS.
*CALL COMPCRS
*CALL COMPVFN
SPACE 4,10
* CHECK FOR OVERFLOW.
OVERFLOW PPFW,EPFW OVERFLOW INTO DISK ERROR PROCESSING AREA
OVERLAY (LOCAL FILE PROCESSING.),OVLD
SPACE 4,15
** THIS OVERLAY PERFORMS INITIAL LOCAL FILE PROCESSING FOR
* REQUESTS WHICH ARE SENSITIVE TO THE EXISTENCE OF LOCAL FILES.
OVL BSS 0 ENTRY
* LJM PLF PROCESS LOCAL FILE
PLF SPACE 4,15
** PLF - PROCESS LOCAL FILE.
*
* ENTRY (CC) = COMMAND CODE.
*
* EXIT (FN - FN+4) = PERMANENT FILE NAME.
PLF BSS 0 ENTRY
LDM PLFT,CC
STM PLFA
PLFT LJM PLF7 *SAVE*
PLFA EQU *-1 (LOCAL FILE PROCESSOR ADDRESS)
CON PLF4 *GET*
CON 0 *PURGE* (NO LOCAL FILE PROCESSING)
CON 0 *CATLIST* (NO LOCAL FILE PROCESSING)
CON 0 *PERMIT* (NO LOCAL FILE PROCESSING)
CON PLF7 *REPLACE*
CON PLF8 *APPEND*
CON PLF1 *DEFINE*
CON PLF5 *ATTACH*
CON 0 *CHANGE* (NO LOCAL FILE PROCESSING)
CON PLF11 *UATTACH*
CON PLF12 *SETASA*
CON 0 *SETAF* (NO LOCAL FILE PROCESSING)
CON PLF3 *SETDA*
CON 0 *DROPDS* (NO LOCAL FILE PROCESSING)
CON PLF1 *ASSIGNPF*
CON PLF4 *OLD*
CON 0 *SETPFAC* (NO LOCAL FILE PROCESSING)
CON 0 *SETPFAL* (NO LOCAL FILE PROCESSING)
CON PLF4 *UGET*
CON PLF7 *UREPLACE*
CON 0 *DROPIDS* (NO LOCAL FILE PROCESSING)
CON PLF13 *DELPFC*
CON 0 *RPFSTAT* (NO LOCAL FILE PROCESSING)
CON 0 *STAGEPF* (NO LOCAL FILE PROCESSING)
* *ASSIGNPF*/*DEFINE* PROCESSING.
PLF1 RJM PEF PROCESS EXISTING FILE
LDM MXNF
ZJN PLF2 IF NO FILE LIMIT SPECIFIED
LDK STAC TURN ON STATISTICAL ACCUMULATION
RAM STAT
PLF2 EXECUTE 3PB FILE RESIDENCE PROCESSOR
* *SETDA* PROCESSING.
PLF3 RJM SSF SEARCH FOR SYSTEM FILE
UJN PLF2 PROCESS FILE RESIDENCE
* *GET*/*OLD*/*UGET* PROCESSING.
PLF4 RJM PEF PROCESS EXISTING FILE
* EXIT TO COMMAND PREPROCESSING OVERLAY.
PLFX RJM SPN SET PERMANENT FILE NAME
EXECUTE 3PC EXIT TO COMMAND PROCESSING OVERLAY
* *ATTACH* PROCESSING.
PLF5 RJM PEF PROCESS EXISTING FILE
LDM MODE SET UP FNT STATUS MODE EQUIVALENCE
LPN 37
STD T1
LDM TFNS,T1
STM FNMD
RJM CFA CHECK FAST ATTACH FILE
PJN PLF6 IF NOT FAST ATTACH FILE
RJM EFN ESTABLISH *FNT/FST* FOR *FA* FILE
EXECUTE 3PU TERMINATE PROGRAM
PLF6 RJM CAA CHECK FOR APPLICATION ACCOUNTING
UJN PLF10 EXIT
* *SAVE*/*REPLACE*/*APPEND*/*UREPLAC* PROCESSING.
PLF7 LDM MXNF
NJN PLF8 IF FILE LIMIT SPECIFIED
LDM MXCS
NJN PLF8 IF SIZE LIMIT SPECIFIED
LDM MXCS+1
ZJN PLF9 IF NO SIZE LIMIT SPECIFIED
PLF8 LDK STAC TURN ON STATISTICAL ACCUMULATION
RAM STAT
PLF9 RJM SSF SEARCH FOR SYSTEM FILE
RJM CFS CHECK FILE SIZE
PLF10 LJM PLFX COMPLETE
* *UATTACH* PROCESSING.
PLF11 RJM PEF
LDM MODE SET UP FNT STATUS MODE EQUIVALENCE
LPN 37
STD T1
LDM TFNS,T1
STM FNMD
UJN PLF10 EXIT
* *SETASA* PROCESSING.
PLF12 LDM STAT
LPK STTA
NJN PLF10 IF SETTING TAPE ASA
LDM PFAT
LPN 77
LMN ATOD
ZJN PLF10 IF SETTING OPTICAL DISK ASA
RJM SSF SEARCH FOR SYSTEM FILE
UJN PLF10 EXIT
* *DELPFC* PROCESSING.
PLF13 RJM PIF PROCESS INTERLOCK FILES
UJN PLF10 EXIT
TFNS SPACE 4,15
** FNT STATUS VALUES FOR SPECIFIED ACCESS MODE.
TFNS BSS 0
LOC 0
CON 2 WRITE
CON 1 READ
CON 22 APPEND/EXTEND
CON 5 EXECUTE
CON 0 NULL
CON 32 MODIFY
CON 31 READ AND ALLOW MODIFY
CON 21 READ AND ALLOW APPEND
CON 12 UPDATE
CON 11 READ AND ALLOW UPDATE
LOC *O
TFNSL EQU *-TFNS
TITLE SUBROUTINES.
CAA SPACE 4,15
** CAA - CHECK FOR APPLICATION ACCOUNTING.
*
* ENTRY (FNTA) = *FST* ADDRESS OF FILE.
*
* EXIT IF THE FILE IS FROM THE APPLICATION LIBRARY
* AND THE MODE OF ACCESS IS EXECUTE, THE
* APPLICATION ACCOUNTING FILE STATUS IS SET.
CAA SUBR ENTRY/EXIT
LDD UI CHECK FOR APPLICATION LIBRARY
SHN 14
ADD UI+1
LMC AAUI
NJN CAAX IF NOT FROM APPLICATION LIBRARY
LDM FNMD CHECK FOR MODE OF ATTACH FUNCTION
LMN 5
NJN CAAX IF NOT EXECUTE-ONLY FILE
LDM SFNB SET APPLICATION ACCOUNTING FILE STATUS
SCN 77
LMN AAST
STM SFNB
UJN CAAX EXIT
CFA SPACE 4,25
** CFA - CHECK FOR FAST ATTACH FILE.
*
* IF THE *FA* OR *MA* SPECIAL REQUEST WAS SPECIFIED AND THE
* CALLER IS *SSJ=*, CHECK THE SYSTEM FNT FOR THE SPECIFIED
* FAST ATTACH FILE, AND ATTACH THE FILE IF IT EXISTS AND IS
* NOT BUSY. IF THE FILE DOES NOT EXIST AND THE *FA* (FORCED
* FAST ATTACH) SPECIAL REQUEST WAS SPECIFIED, RETURN AN
* ERROR. IF THE FILE DOES NOT EXIST AND THE *MA* (MIXED
* FAST ATTACH) SPECIAL REQUEST WAS SPECIFIED, EXIT AND ALLOW
* NORMAL ATTACH PROCESSING TO PROCEED.
*
* ENTRY (PFSR) = SPECIAL REQUEST SUBFUNCTION.
* (SSJS) = SPECIAL SYSTEM JOB STATUS.
*
* EXIT (A) .LT. 0 IF FAST ATTACH FILE FOUND.
*
* USES T5, T6, CM - CM+4, CN - CN+4, FN - FN+4, FS - FS+4.
*
* CALLS FAT, SFN, SPN.
*
* MACROS ERROR, MONITOR, SFA.
CFA6 LDM PFSR CHECK FOR SPECIAL REQUEST
LPN 77
LMN SRMA
ZJN CFAX IF MIXED FAST ATTACH SPECIAL REQUEST
ERROR FNF,CH,IW * (FILE NAME) NOT FOUND.*
CFA7 ERROR IUA,CH,IW * USER ACCESS NOT VALID.*
CFA SUBR ENTRY/EXIT
LDM PFSR CHECK FOR SPECIAL REQUEST
LPN 77
LMN SRFA
ZJN CFA0 IF FORCED FAST ATTACH SPECIAL REQUEST
LMN SRMA&SRFA
NJN CFAX IF NOT MIXED FAST ATTACH SPECIAL REQUEST
CFA0 LDM SSJS
ZJN CFA7 IF CALLER IS NOT *SSJ=*
RJM SPN SET FILE NAME
SFA EST,PFPN+4 SET FAMILY EST ORDINAL
ADK EQDE
CRD CN READ EST ENTRY
LDD CN+4
SHN 3
ADN PFGL READ FAMILY NAME
CRD CN
LDD MA
CWD FN
CRD CM SET FILE NAME
RJM FAT CHECK IF FAST ATTACH
ZJN CFA1 IF FAST ATTACH FILE FOUND
LJM CFA6 PROCESS FILE NOT FOUND
* FAST ATTACH FILE FOUND.
CFA1 SFA FNT,T1 READ FNT/FST ENTRY
CRD FN
ADN FSTL
CRD FS
LDD FS SET FILE TRACK AND EST ORDINAL
STD T5
STM PFEQ
STM ERRE SET EST ORDINAL FOR EVENT
LDD FS+1
STD T6
STM ERRC SET TRACK FOR EVENT
STM PFFT
LDM MODE CHECK FOR LEGAL MODE
LPN 37
STD CM+2 SET MODE IN MONITOR REQUEST
LDM TFNS,CM+2
STM CFAA
NJN CFA2 IF LEGAL MODE
ERROR ILR,CH,IW,FS *PFM INCORRECT REQUEST.*
CFA2 LDN AFAS SET REQUEST FOR FAFT FILE
STD CM+3
LDD T1
STD CM+4
LDD FN+3
LPN 77
ZJN CFA3 IF LOCAL FAST ATTACH FILE
LDD T5 SET EST ORDINAL IF GLOBAL FILE
CFA3 STD CM+1
MONITOR AFAM
LDD CM+1 CHECK RETURN STATUS
ZJN CFA4 IF NO ERROR
LDN FRT SET TIME FOR EVENT
STM ERRD
ERROR FBS,CH,IW,FS *(FILE NAME) BUSY.*
CFA4 LDC *
CFAA EQU *-1 (*TFNS* TABLE ENTRY FOR SPECIFIED MODE)
SHN 21-4
MJN CFA5 IF M, RM, A OR RA MODE
LDD T5 REQUEST TRT UPDATE
STD CM+1
LDN UTRS
STD CM+3
MONITOR STBM
CFA5 LDC PFSN SET FILE NAME
RJM SFN
LCN 1 SET FAST ATTACH FILE FOUND
LJM CFAX EXIT
CSA SPACE 4,10
** CSA - CHECK SPECIFIED ACCESS LEVEL.
*
* ENTRY (FA) = FNT ADDRESS IN NFL.
* (LFAL) = REQESTED ACCESS LEVEL, IF *PFSP* NONZERO.
*
* EXIT ACCESS LEVEL SET IN FNT ENTRY BY *CPUMTR*, IF VALID.
* *MFFI* ACCOUNT MESSAGE ISSUED.
*
* CALLS IAM.
*
* USES CM - CM+4.
*
* MACROS ERROR, MONITOR.
CSA SUBR ENTRY/EXIT
LDM PFSP
ZJN CSAX IF SECURITY PROCESSING BIT NOT SET IN FET
LDN VSFS VALIDATE AND SET ACCESS LEVEL FOR FILE
STD CM+1
LDD FA
STD CM+3
LDM LFAL
STD CM+4
MONITOR VSAM
LDD CM+1
ZJN CSAX IF ACCESS LEVEL VALID
RJM IAM ISSUE ACCOUNT FILE MESSAGE
ERROR LNF,CH,IW,,SVE * ACCESS LEVEL NOT VALID FOR FILE.*
CFS SPACE 4,10
** CFS - CHECK FILE SIZE FOR THE CATALOG SEARCH.
*
* ENTRY (MXFS) = MAXIMUM FILE SIZE ALLOWED FOR INDIRECT
* ACCESS FILES/ 10B.
* (LF - LF+1) = LENGTH OF LOCAL FILE.
*
* EXIT (LF - LF+1) CHECKED FOR SIZE LIMITS.
*
* MACROS ERROR.
CFS3 ERROR EFL,CH,IW *(FILE NAME) EMPTY.*
CFS SUBR ENTRY/EXIT
LDD LF
SHN -5
ZJN CFS2 IF FILE LENGTH .LT. 131072D SECTORS
CFS1 ERROR FTL,CH,IW *FILE TOO LONG.*
CFS2 LDD LF CHECK FOR EMPTY FILE
SHN 14
ADD LF+1
ZJN CFS3 IF FILE EMPTY
ADN 2 ADD SYSTEM AND EOI SECTORS
MJN CFS1 IF FILE .GT. 131069D SECTORS
LDM MXFS
ZJN CFSX IF NO FILE SIZE LIMITS
LDD LF
SHN -3
NJN CFS1 IF FILE SIZE .GT. MAXIMUM FILE SIZE LIMIT
LDD LF
SHN 14
ADD LF+1
ADN 7
SHN -3
SBM MXFS
MJN CFSX IF LIMIT NOT EXCEEDED
NJN CFS1 IF FILE LIMIT EXCEEDED
UJN CFSX RETURN
EFN SPACE 4,20
** EFN - ESTABLISH FNT ENTRY FOR FAST ATTACH FILE.
*
* ENTRY (FN - FN+4) = LOCAL FILE NAME.
* (FNTA) = FNT ADDRESS OF LOCAL FILE.
* (PFEQ) = EST ORDINAL FOR FILE.
* (PFFT) = FIRST TRACK FOR FILE.
* (PFSN) = LOCAL FILE NAME.
* (FNMD) = FNT STATUS MODE EQUIVALENCE.
*
* EXIT FNT ENTRY ESTABLISHED IN CENTRAL MEMORY.
* (FA) = FNT ADDRESS.
* (FN - FN+4) = FNT.
* (FS - FS+4) = FST.
* PERMANENT FILE USER COUNT INCREMENTED.
*
* USES T1, CM - CM+4.
*
* MACROS MONITOR.
EFN SUBR ENTRY/EXIT
LDM FNTA SET FNT/FST
STD FA
LDM PFEQ SET EST ORDINAL
STD FS
LDM PFFT SET FIRST TRACK
STD FS+1
STD FS+2
LDN FSMS SET SECTOR
STD FS+3
LDC 2004 SET FST STATUS
STD FS+4
LDC PMFT*100 SET FILE TYPE
RAD FN+4
STM PFSN+4
LDM FNMD SET FNT STATUS MODE
SCN 2 CLEAR WRITEABLE MODE BIT
RAM PFSN+3
STD FN+3
LDN ZERL SET FILE SIZE LIMIT TO INFINITE
CRD CM
LDC 700
STD CM+2
NFA FA,R RESTORE FNT ENTRY
ADK FNTL
CWD FN
ADN FSTL-FNTL
CWD FS
ADN FUTL-FSTL
CWD CM
LDM PFEQ INCREMENT PF USER COUNT
STD CM+1
LDN IUCS
STD CM+3
MONITOR SMDM
LJM EFNX RETURN
IAM SPACE 4,10
** IAM - ISSUE ACCOUNT FILE MESSAGE.
*
* ISSUES AN *MFFI* ACCOUNT FILE MESSAGE TO INDICATE THAT THE
* LOCAL FILE ACCESS LEVEL CHANGE ATTEMPT WAS INVALID.
*
* ENTRY (LFAL) = LOCAL FILES NEW ACCESS LEVEL.
*
* EXIT ACCOUNT FILE MESSAGE ISSUED.
*
* USES T1.
*
* CALLS ACS, DFM.
IAM SUBR ENTRY/EXIT
LDC IAMB+3 INITIALIZE POINTER FOR *ACS* CALLS
STD T1
LDN FN INSERT FILE NAME IN BUFFER
RJM ACS
LDC IAMC APPEND COMMA
RJM ACS
LDM LFAL DETERMINE MNEMONIC OF ACCESS LEVEL
SHN 2
ADC TALV APPEND NEW ACCESS LEVEL
RJM ACS
LDC IAMD APPEND TERMINATOR
RJM ACS
LDC IAMB+ACFN ISSUE DAYFILE MESSAGE
RJM DFM
UJN IAMX RETURN
* ACCOUNT FILE MESSAGE BUFFER.
IAMB DATA C*MFFI, *
BSSZ 12
IAMC DATA 2H, MESSAGE SEPARATOR
CON 0 END OF STRING
IAMD DATA 2H. MESSAGE TERMINATOR
CON 0
PDS SPACE 4,15
** PDS - PROCESS DEVICE STATUS.
*
* ENTRY (A) = 0 IF DEVICE AVAILABLE.
* (A) .NE. 0 IF DEVICE INACCESSIBLE.
* (T5) = EST ORDINAL OF DEVICE.
* (FERT) = REAL-TIME PROCESSING FLAG.
* (SSYS) = SUBSYSTEM FLAG.
*
* EXIT RETURN IF PROCESSING IS TO CONTINUE.
*
* TO *ERR* IF DEVICE IS INACCESSIBLE AND CALLER HAS
* REAL-TIME PROCESSING SET IN FET OR IS NOT A SUBSYSTEM.
*
* MACROS ERROR.
PDS SUBR ENTRY/EXIT
ZJN PDSX IF DEVICE AVAILABLE, RETURN
LDM SSYS
ZJN PDS1 IF NOT A SUBSYSTEM
LDM FERT
ZJN PDSX IF NO REAL-TIME PROCESSING, RETURN
PDS1 ERROR WID,CH,IW,T5,EC6 * WAITING - INACCESSIBLE DEVICE.*
PEF SPACE 4,25
** PEF - PROCESS EXISTING FILE.
*
* DETERMINE IF A LOCAL FILE WITH THE SPECIFIED NAME IS ALREADY
* ASSIGNED TO THE JOB. FOR ALL REQUESTS EXCEPT *DEFINE*,
* RETURN THE EXISTING LOCAL FILE. FOR *DEFINE*, RETURN THE
* RESERVED FNT ENTRY AND KEEP THE EXISTING LOCAL FILE.
*
* ENTRY (CC) = COMMAND CODE.
* (PFSN) = LOCAL FILE NAME.
*
* EXIT (FA) = (FNTA) = FNT ADDRESS OF THE LOCAL FILE.
* (FA) = 0 IF THE FILE WAS RETURNED OR DID NOT EXIST.
* (FN - FN+4) = FNT ENTRY FOR FILE (*DEFINE*).
* (FS - FS+4) = FST ENTRY FOR FILE (ZERO IF NOT FOUND).
* (ERRB) = NONZERO IF LOCAL FILE EXISTS.
* (LFAL) = LOCAL FILE ACCESS LEVEL.
*
* USES FA, T1, CM - CM+4, FN - FN+4.
*
* CALLS CSA, PDS, SAF, SFB, SFN, *0DF*.
*
* MACROS ERROR, EXECUTE, NFA, SETMS, SFA.
PEF10 LDC ** RESTORE DIRECT CELL
PEFA EQU *-1
STD UI+1
PEF11 LDN ZERL CLEAR FS - FS+4
CRD FS
PEF SUBR ENTRY/EXIT
LDC PFSN SET SYSTEM FILE NAME
RJM SFN
RJM SAF SEARCH FOR ASSIGNED FILE
ZJN PEF11 IF FILE NOT FOUND
RJM SFB SET FILE BUSY
ZJN PEF1 IF NO REJECT ON FILE INTERLOCK
ERROR IOE,CH,IW *I/O SEQUENCE ERROR.*
PEF1 LDD CC
LMN CCDF
ZJN PEF6 IF A *DEFINE* REQUEST
* *UNLOAD* OR *RETURN* THE EXISTING FILE.
PEF2 LDN 1 *UNLOAD* PREVIOUS FILE
PEF3 STM LOCF-1
LDD UI+1 SAVE DIRECT CELL USED BY *0DQ*
STM PEFA
EXECUTE 0DF,LOCF
PJP PEF10 IF FILE PROCESSED
LDD FS SET EST ORDINAL OF INACCESSIBLE DEVICE
STD T5
LDD FA SET FNT ADDRESS
STM FNTA
AOM ERRB SET FILE NOT CREATED BY *PFM*
RJM PDS PROCESS DEVICE STATUS
ERROR PFN,CH,IW * DEVICE UNAVAILABLE.*
* PROCESS *DEFINE* REQUEST (USE EXISTING FILE IF POSSIBLE).
PEF6 LDD FS
ZJN PEF3 IF EQUIPMENT NOT ASSIGNED
LDD FS+1
ZJN PEF2 IF FILE EMPTY
* *DEFINE* - RETURN RESERVED FNT ENTRY (NOT NEEDED).
LDM FNTA SWITCH FNT ADDRESSES
STD T1
LDD FA
STM FNTA
LDD T1
STD FA
LDN 1 *UNLOAD FILE*
STM LOCF-1
EXECUTE 0DF,LOCF
LDM FNTA RESET FNT ADDRESS
STD FA
AOM ERRB SET FILE NOT CREATED BY *PFM*
* CHECK IF EXISTING LOCAL FILE CAN BE USED.
RJM CSA CHECK SPECIFIED ACCESS LEVEL
NFA FA,R
ADK FNTL
CRD FN
ADK FSTL-FNTL
CRD FS
ADK FUTL-FSTL GET LOCAL FILE ACCESS LEVEL
CRD CM
LDD CM+2 SAVE LOCAL FILE ACCESS LEVEL
LPN 7
STM LFAL
SBM PFAL
PJN PEF7 IF LOCAL FILE HAS VALID ACCESS LEVEL
LDM SVAL CHECK FOR WRITE DOWN VALIDATION
SHN 21-5
MJN PEF7 IF WRITE DOWN ALLOWED
LDM SSID CHECK SUBSYSTEM ID
SBK LSSI+1
PJN PEF7 IF SUBSYSTEM
ERROR WDP,CH,IW,,SVE * WRITE-DOWN OF DATA PROHIBITED.*
PEF7 LDD FN+3
LPN 4
ZJN PEF8 IF NOT EXECUTE ONLY FILE
ERROR FEO,CH,IW * FILE IS EXECUTE ONLY.*
PEF8 SFA EST,FS READ EST ENTRY
ADK EQDE
CRD CM
LDD CM
SHN 21-13
MJN PEF9 IF MASS STORAGE EQUIPMENT
ERROR NMS,CH,IW *(FILE NAME) NOT MASS STORAGE.*
PEF9 LDD FS
STD T5
SETMS STATUS
LDM MSD
LPC 100
RJM PDS PROCESS DEVICE STATUS
LJM PEFX RETURN
PIF SPACE 4,15
** PIF - PROCESS INTERLOCK FILES.
*
* EXIT (FNTA) = 0.
* (CCIB) UPDATED IF /PFM*ILK/ INTERLOCK BIT WAS SET.
* (IAIF) = NONZERO IF /PFM*PFN/ INTERLOCK BIT WAS SET.
* INTERLOCK BITS CLEARED IN /PFM*ILK/ AND /PFM*PFN/.
* TO *ERR* IF FILES DO NOT MATCH FAMILY/USER INDEX.
*
* USES FS+4.
*
* CALLS SSF.
*
* MACROS ERROR.
PIF SUBR ENTRY/EXIT
* PROCESS CATALOG TRACK INTERLOCK (FILE /PFM*ILK/).
LDC =C/"ILK"/
STM SSFA+1
RJM SSF SEARCH FOR LOCAL FILE /PFM*ILK/
LDD FS
LMD EQ
NJN PIF1 IF INCORRECT EST ORDINAL
LDD FS+1
LMM CCIA
ZJN PIF2 IF CORRECT CATALOG TRACK
PIF1 ERROR FNF,CH,IW * FILE NOT FOUND.*
PIF2 LDD FS+4 CHECK CATALOG TRACK INTERLOCK BIT
SHN 21-11
PJN PIF2.1 IF INTERLOCK BIT NOT SET
AOM CCIB SET CATALOG TRACK INTERLOCK FLAG
PIF2.1 LDD FS+4 CLEAR CATALOG TRACK INTERLOCK BIT
LPC 6776
LMN 1 SET COMPLETE BIT
STD FS+4
NFA FA,R REWRITE FST
ADK FSTL
CWD FS
* CHECK FOR ALLOCATION INTERLOCK (FILE /PFM*PFN/).
LDC =C/"PFN"/
STM SSFA+1
RJM SSF SEARCH FOR LOCAL FILE /PFM*PFN/
LDD FS
LMD EQ
ZJN PIF3 IF CORRECT EST ORDINAL
ERROR FNF,CH * FILE NOT FOUND.*
PIF3 LDD FS+4
SHN 21-11
PJN PIF4 IF ALLOCATION INTERLOCK NOT SET
AOM IAIF SET *INDIRECT ALLOCATION INTERLOCK* FLAG
PIF4 LDD FS+4 CLEAR ALLOCATION INTERLOCK BIT
LPC 6776
LMN 1 SET COMPLETE BIT
STD FS+4
NFA FA,R REWRITE FST
ADK FSTL
CWD FS
LDN 0 CLEAR LOCAL FILE FNT ADDRESS
STM FNTA
UJP PIFX RETURN
SSF SPACE 4,20
** SSF - SEARCH FOR SYSTEM FILE.
*
* ENTRY (PFSN) = LOCAL FILE NAME.
*
* EXIT (LF - LF+1) = LENGTH OF LOCAL FILE.
* (FS - FS+4) = FST ENTRY FOR FILE (REWOUND).
* (ERRB) = NON ZERO IF FILE PRESENT AND SET BUSY.
* (FNTA) = FNT ADDRESS OF LOCAL FILE.
* (FNTB) = FNT ADDRESS OF /PFM*PFN/ FILE (*DELPFC*).
* (FNTC) = FNT ADDRESS OF /PFM*ILK/ FILE (*DELPFC*).
* (LFAL) = LOCAL FILE ACCESS LEVEL.
* FST REWRITTEN.
*
* USES FA, T5, T6, CM - CM+4, FN - FN+4, FS - FS+4,
* LF - LF+1.
*
* CALLS CSA, CTA, PDS, SAF, SEI, SFB, SFN.
*
* MACROS ERROR, NFA, SETMS, SFA.
SSF SUBR ENTRY/EXIT
SSFA LDC PFSN SET FILE NAME
* LDC =C/"ILK"/ (*DELPFC* REQUEST)
* LDC =C/"PFN"/ (*DELPFC* REQUEST)
RJM SFN
RJM SAF SEARCH FOR ASSIGNED FILE
ZJN SSF1 IF NOT FOUND
RJM SFB SET FILE BUSY
ZJN SSF3 IF NO REJECT ON FILE INTERLOCK
ERROR IOE,CH,IW *I/O SEQUENCE ERROR.*
SSF1 ERROR FNF,CH,IW * FILE NOT FOUND.*
SSF2 ERROR FEO,CH,IW * FILE IS EXECUTE ONLY.*
SSF2.1 ERROR IFT,CH,IW * INCORRECT FILE TYPE.*
SSF3 AOM ERRB INDICATE FILE NOT CREATED BY *PFM*
LDD FA SAVE FNT ADDRESS
STM FNTA
LDD CC
LMN CCSV
NJN SSF4 IF NOT *SAVE* REQUEST
RJM CSA CHECK SPECIFIED ACCESS LEVEL
SSF4 NFA FA,R
ADK FNTL
CRD FN
ADN FSTL-FNTL
CRD FS
ADN FUTL-FSTL READ LOCAL FILE ACCESS LEVEL
CRD CN
LDD CN+2 SAVE LOCAL FILE ACCESS LEVEL
LPN 7
STM LFAL
LDD FN+3 CHECK FILE MODE
LPN 4
NJP SSF2 IF EXECUTE ONLY FILE
LDD FN+3 CHECK FILE MODE
LPN 21 EXTEND-ONLY AND WRITE LOCKOUT
LMN 21
ZJP SSF2.1 IF READ/ALLOW MODIFY OR READ/ALLOW APPEND
LDD FS CHECK IF EQUIPMENT IS MASS STORAGE
ZJN SSF5 IF NO EQUIPMENT ASSIGNED TO FILE
STD T5
SFA EST
ADK EQDE
CRD CM READ EST ENTRY
LDD CM
SHN 21-13 MASS STORAGE BIT
MJN SSF6 IF MASS STORAGE
ERROR NMS,CH,IW *(FILENAME) NOT ON MASS STORAGE.*
SSF5 ERROR EFL,CH,IW *(FILE NAME) EMPTY.*
SSF6 LDD CC
LMN CCDP
ZJP SSFX IF *DELPFC* REQUEST
SETMS STATUS
LDM MSD
LPC 100
RJM PDS PROCESS DEVICE STATUS
LDD CM+4 SET FWA OF TRT - TRACK BIT
SHN 3
ADN TRLL
RJM CTA CALCULATE FWA OF TRT
SBD TH
STM SEIA+1
SHN -14
LMC ADCI
STM SEIA
LDD FS+2
ZJN SSF7 IF FILE NEVER WRITTEN
LDD FS+1 DETERMINE FILE LENGTH
STD T6
RJM SEI
LDD T2
STD LF
LDD T3
SBN 1 DISCOUNT EOI
STD LF+1
PJN SSF8 IF NO 12 BIT OVERFLOW
AOD LF+1
SOD LF
UJN SSF8 UPDATE FST
SSF7 LDN 0 SET FILE LENGTH FOR EMPTY FILE
STD LF
STD LF+1
LDD CC
LMN CCSD
ZJN SSF9 IF *SETDA*
LJM SSF5 * (FILE NAME) EMPTY.*
* UPDATE FST.
SSF8 LDD FS+1 SET CURRENT TRACK = FIRST TRACK
STD FS+2
LDN FSMS SET CURRENT SECTOR = FIRST SECTOR
STD FS+3
SSF9 LDD FS+4 SET STATUS
SCN 77
LMN 4
STD FS+4
NFA FA,R UPDATE FST
ADK FSTL
CWD FS
LJM SSFX RETURN
SPACE 4,10
* COMMON DECKS.
*CALL COMPACS
VAL$ SET 0
*CALL COMPVLC
*CALL COMPFAT
QUAL GFP
FNT$ EQU 0 DEFINE *COMPGFP* ACCESS TO FNT
*CALL COMPGFP
QUAL *
.FNT EQU /GFP/.FNT
*CALL COMPSAF
*CALL COMPSFB
SPACE 4,15
LOCF EQU *+5 ZERO LEVEL OVERLAY LOAD ADDRESS
SPACE 4,10
* CHECK FOR OVERFLOW.
ERRNG BFMS-LOCF-ZDFL *0DF* OVERFLOW
OVERFLOW OVLD,EPFW OVERFLOW INTO ERROR PROCESSING AREA
OVERLAY (ASSIGNPF/FILE RESIDENCE PROCESSING.),OVLD
FRP SPACE 4,30
** THIS OVERLAY DETERMINES THE PROPER RESIDENCE FOR
* DIRECT ACCESS FILES, ACCORDING TO THE FOLLOWING RULES -
*
* LOCAL FILE IN EXISTENCE
* FILE MADE PERMANENT IF LOCAL FILE ON LEGAL PF DEVICE.
* ABORTED IF FILE NOT ON PF DEVICE.
* *DT* IS IGNORED.
* IF REMOVABLE DEVICE REQUEST FILE MUST RESIDE ON THAT
* REMOVABLE DEVICE.
*
* NO LOCAL FILE.
* *DT* = 0.
* PLACE FILE ON DEVICE WITH MOST AVAILABLE SPACE, AND
* SUFFICIENT ACCESS LEVEL.
* *DT* .NE. 0.
* FILE IS PLACED ON MATCHING DEVICE TYPE WITH SUFFICIENT
* ACCESS LEVEL AND MOST AVAILABLE SPACE IN FAMILY,
* OTHERWISE REQUEST IS ABORTED.
* *PRU* .NE. 0.
* PLACE FILE ON DEVICE (TYPE *DT* IF SPECIFIED) WITH
* MOST AVAILABLE SPACE PROVIDED *PRU* SECTORS
* ARE AVAILABLE. IF THEY ARE NOT REQUEST IS ABORTED.
*
* IF THE SPECIAL REQUEST *SRMR* IS SPECIFIED, THE FILE MUST
* RESIDE ON THE MASTER DEVICE (AS DETERMINED BY THE PRIMARY
* DEVICE MASK), RATHER THAN ON THE DEVICE(S) SPECIFIED IN THE
* SECONDARY DEVICE MASK(S).
FRP BSS 0 ENTRY
LDD CC
LMN CCAN
ZJN APF IF *ASSIGNPF* REQUEST
LDM LFAL
STD CM+4
LDD EQ CHECK *LFAL* WITH MASTER DEVICE *AL*
STD CM+2
LDN VAES
STD CM+1
MONITOR VSAM
LDD CM+1
NJN FRP2 IF FILE ACCESS NOT VALID FOR DEVICE
* PROCESS *DEFINE*, *SETDA*.
RJM DFR DETERMINE FILE RESIDENCE
RJM SPN SET PERMANENT FILE NAME
EXECUTE 3PC PROCESS REQUEST
FRP2 ERROR LNP,CH,IW,,SVE * ACCESS LEVEL NOT VALID ON PF DEVICE*
APF SPACE 4,10
*** PROCESS *ASSIGNPF* REQUEST.
*
* ASSIGN LOCAL FILE TO PROPER PERMANENT FILE DEVICE.
*
* IF THE SPECIAL REQUEST *SRSY* IS SPECIFIED, WRITE
* A SYSTEM SECTOR ON THE FILE.
APF BSS 0 ENTRY
LDM PFSR CHECK SPECIAL REQUEST
LPN 77
LMN SRSY
ZJN APF2 IF SYSTEM SECTOR IS TO BE PREWRITTEN
RJM DFR DETERMINE FILE RESIDENCE
LDN 0 SET UP FST FOR SYSTEM SECTOR ACCESS
STD FS+2
STD FS+3
LDC 4004 SET FILE STATUS
STD FS+4
NFA FA,R
ADN FSTL
CWD FS
LJM APF5 TERMINATE PROGRAM
* CLEAR SYSTEM SECTOR.
APF2 LDC PMFT*100-LOFT*100 FORCE *PMFT* FILE TYPE
RAM SFTA
RJM DFR DETERMINE FILE RESIDENCE
LDC 77*5-1 SET WORD COUNT TO CLEAR
STD T1
APF3 LDN 0
STM BFMS+2,T1 CLEAR NEXT WORD
SOD T1
PJN APF3 IF MORE TO CLEAR
LDN 72 CURRENT ACCESS MODE (WRITE MODE/PURGED)
STM CASS
* WRITE SYSTEM AND EOI SECTORS.
LDD FS+1 SET TRACK AND SECTOR
STD T6
STD FS+2
LDN FSMS
STD FS+3
LDN 4 SET FILE STATUS
STD FS+4
NFA FA,R PREWRITE FST FOR *COMPWEI*
ADN FSTL
CWD FS
SETMS IO,,BFMS
RJM PDV PROCESS DEVICE STATUS
RJM WSS WRITE SYSTEM SECTOR
MJN APF3.1 IF WRITE ERROR
RJM WEI WRITE EOI SECTOR
PJN APF4 IF NO MASS STORAGE ERROR
APF3.1 ERROR MSE,CH,IW,FS *EQXXX,DNYY, MASS STORAGE ERROR.*
APF4 ENDMS
LDD FS INCREMENT USER COUNT FOR DEVICE
STD CM+1
LDN IUCS INCREMENT USER COUNT
STD CM+3
MONITOR SMDM
LDN FSMS SET EOI IN TRT
STD CM+3
LDD T6
LPC 3777
STD CM+2
LDD FS
STD CM+1
MONITOR DTKM
APF5 EXECUTE 3PU TERMINATE PROGRAM
TITLE SUBROUTINES.
CDA SPACE 4,15
** CDA - CHECK DEVICE ACCESSIBILITY.
*
* ENTRY (T2) = EST ORDINAL FOR DEVICE.
* (T3 - T3+4) = EST ENTRY FOR DEVICE.
*
* EXIT (A) = 0 IF DEVICE CAN BE ACCESSED.
* (A) = 1 IF NEW ACTIVITY RESTRICTED ON DEVICE.
* (A) = 2 IF PF UTILITY ACTIVE.
* (A) = 3 IF ACCESS DENIED BY *SETMS*.
* (A) = 4 IF *ERROR IDLE* SET FOR DEVICE.
*
* USES T5, CM - CM+4.
*
* MACROS SETMS.
CDA SUBR ENTRY/EXIT
* CHECK IF *ERROR IDLE* SET FOR DEVICE.
LDD T3+4 MST ADDRESS/10B
SHN 3
ADN ACGL
CRD CM
LDD CM+4
LPN 20
ZJN CDA2 IF NOT *ERROR IDLE*
LDM SSJS
ZJN CDA1 IF NOT *SSJ=* JOB
LDM PFSR
LPN 77
LMN SRIE
ZJN CDA2 IF *IGNORE ERROR IDLE* SPECIAL REQUEST
CDA1 LDN 4 RETURN WITH (A) = 4
UJN CDAX RETURN
* CHECK *SUSPECT*, *OFF*, AND *DOWN* STATUS.
CDA2 LDD T2 EST ORDINAL
STD T5
SETMS STATUS
LDM MSD
SHN 21-6
PJN CDA4 IF DEVICE CAN BE ACCESSED
LDN 3 RETURN WITH (A) = 3
CDA3 UJN CDAX RETURN
* CHECK IF PF UTILITY ACTIVE.
CDA4 LDD T3+4 MST ADDRESS/10B
SHN 3
ADK TDGL
CRD CM
LDD CM+1
SHN 21-6
PJN CDA5 IF DEVICE NOT INTERLOCKED
LDN 2 RETURN WITH (A) = 2
UJN CDA3 RETURN
* CHECK NEW ACTIVITY RESTRICTIONS.
CDA5 LDD T3+4 MST ADDRESS/10B
SHN 3
ADN DALL
CRD CM
LDD CM
SHN 21-6
MJN CDA6 IF *RESTRICT NEW ACTIVITY* FLAG SET
SHN 0-10-21+6+22
LPN 3
SBN 1
NJN CDA7 IF *IDLE* FLAG NOT SET
CDA6 LDN 1 RETURN WITH (A) = 1
UJN CDA3 RETURN
CDA7 LDN 0 RETURN WITH (A) = 0
UJN CDA3 RETURN
CML SPACE 4,15
** CML - CHECK MASS STORAGE LIMIT.
*
* ENTRY (CMLA - CMLA+1) = VALUE OF DECREMENT.
*
* EXIT TO ERR IF ERROR IN PRU LIMITS.
*
* USES CM - CM+4.
CML SUBR
LDD CP READ PRU VALUE FOR CONTROL POINT
ADK ACLW
CRD CM
LDD CM+3 CHECK FOR LIMIT EXCEEDED
LPN 77
SBM CMLA
MJN CML1 IF LIMIT EXCEEDED
NJN CMLX IF LIMIT NOT EXCEEDED
LDD CM+4
SBM CMLA+1
PJN CMLX IF LIMIT NOT EXCEEDED
CML1 ERROR PRL,CH,IW *PRU LIMIT.*
CMLA CON 0,0 VALUE OF PRU DECREMENT
CPF SPACE 4,10
** CPF - CHECK FOR PRESERVED FILE.
*
* ENTRY (P3) = MST ADDRESS.
*
* EXIT (A) .LT. 0 IF PRESERVED FILE BIT SET.
*
* USES T1, CM - CM+4.
*
* CALLS CTA.
CPF SUBR ENTRY/EXIT
LDD P3 SET *TRT* ADDRESS
SHN 3
ADN TRLL
RJM CTA CALCULATE FWA OF TRT
SBD TH
SHN 2
ADD FS+1
STD T1 SAVE REMAINDER FOR POSITION IN WORD
SHN -2 4 TRACK ASSIGNMENTS FOR EACH WORD
CRD CM READ *TRT* WORD FOR TRACK
LDD T1 SET PRESERVED BIT POSITION
LPN 3
ADC SHNI+6
STM CPFA SET SHIFT INSTRUCTION
LDD CM+4 CHECK FOR PRESERVED STATUS
CPFA SHN ** (21-13+TRACK INDEX)
UJN CPFX RETURN
CPR SPACE 4,20
** CPR - CHECK PROPER PERMANENT FILE RESIDENCE.
*
* ENTRY (T2) = EST ORDINAL FOR DEVICE.
* (T3 - T7) = EST ENTRY FOR DEVICE.
* (FN - FN+4) = USERS FAMILY OR PACK NAME.
* (FRSM) = MASK BITS FOR DIRECT ACCESS FILE.
* RESIDENCE ALLOWED.
*
* EXIT (A) = 0 IF PROPER DEVICE.
* (A) .GT. 0 IF INCORRECT DEVICE.
* (A) = -1 IF DEVICE UNAVAILABLE.
* (A) = -2 IF DEVICE ACCESS ERROR.
*
* USES T4, CM - CM+4.
*
* MACROS MONITOR.
CPR9 LDN 1
CPR SUBR ENTRY/EXIT
LDD T3
SHN -6
LPN 41
LMN 40
NJN CPRX IF NOT AVAILABLE MASS STORAGE
LDD T3+4 READ *MDGL*
SHN 3
ADN MDGL
CRD CM
LDM PFPN
ZJN CPR1 IF NOT AUXILIARY DEVICE REQUEST
LDD CM
SHN 21-12
PJN CPR9 IF NOT AUXILIARY DEVICE
CPR1 LDD T3+4 SET MST ADDRESS
SHN 3
ADN STLL
CRD CM
LDD CM
LPC MLFPR+MLIAL+MLIHD+MLIFD+MLIPF
ZJN CPR2 IF NO INITIALIZATION PENDING
LCN 1 FLAG *DEVICE UNAVAILABLE*
UJP CPRX RETURN
CPR2 LDD T3+4 READ PF DESCRIPTION
SHN 3
ADN PFGL
CRD CM
LDM RQDT CHECK FOR USER REQUESTED DEVICE TYPE
SHN -6
ZJN CPR5 IF NOT USER REQUESTED DEVICE TYPE
LDM RQDT+1 CHECK UNIT COUNT
LPN 77
SBN 1R0+1 CONVERT FROM DISPLAY CODE
LMD CM+4
LPN 77
ZJN CPR5 IF RIGHT UNIT COUNT AND FIRST UNIT
CPR4 LJM CPRX RETURN
CPR5 LDD CM COMPARE DEVICE NAMES
LMD FN
NJN CPR4 IF NO MATCH
LDD CM+1
LMD FN+1
NJN CPR4 IF NO MATCH
LDD CM+2
LMD FN+2
NJN CPR4 IF NO MATCH
LDD CM+3
LMD FN+3
SCN 77
NJN CPR4 IF NO MATCH
LDD T3+4 READ DEVICE MASKS
SHN 3
ADN PUGL
CRD CM
LDM SSJS
ZJN CPR6 IF NOT *SSJ=* JOB
LDM PFSR CHECK SPECIAL REQUEST
LPN 77
LMN SRMR
NJN CPR6 IF MASTER DEVICE RESIDENCE NOT REQUIRED
LDD CM+4 CHECK PRIMARY MASK
UJN CPR7 CHECK MASK
CPR6 LDD CM+3 CHECK SECONDARY MASK
SHN 14
LMD CM+4
SHN -10
CPR7 STM CPRB
LDM FRSM
LPC * (DEVICE MASK)
CPRB EQU *-1
LMM FRSM
LPC 377
NJN CPR8 IF NOT CORRECT DEVICE
LDM LFAL CHECK DEVICE ACCESS LEVEL
STD CM+4
LDD T2
STD CM+2
LDN VAES
STD CM+1
MONITOR VSAM
LDD CM+1
ZJN CPR8 IF FILE ACCESS VALID FOR DEVICE
LCN 2
CPR8 LJM CPRX RETURN
DDN SPACE 4,10
** DDN - DETERMINE DEVICE NAME.
*
* ENTRY (PFPN - PFPN+3) = PACK NAME.
* (PFPN+4) = FAMILY EST ORDINAL.
*
* EXIT (FN - FN+3) = PACK OR FAMILY NAME FOR REQUEST.
*
* USES CM - CM+4, FN - FN+4.
*
* MACROS SFA.
DDN1 LDD MA SET PACK NAME
CWM PFPN,ON
SBN 1
CRD FN
DDN SUBR ENTRY/EXIT
LDM PFPN
NJN DDN1 IF REMOVABLE DEVICE REQUEST
* SET FAMILY NAME.
SFA EST,PFPN+4 READ FAMILY EST ENTRY
ADK EQDE
CRD CM
LDD CM+4 READ FAMILY NAME
SHN 3
ADN PFGL
CRD FN
UJN DDNX RETURN
DFR SPACE 4,20
** DFR - DETERMINE FILE RESIDENCY.
*
* ENTRY (FN - FN+4) = FILE NAME SET AS LOCAL FILE.
* (FS - FS+4) = FST ENTRY FOR EXISTING FILE.
*
* EXIT (FS - FS+4) = FST ENTRY (STATUS SET BUSY).
* (ERRB) .NE. 0 IF FILE PREVIOUSLY EXISTED.
* (LFEF) = 0 IF FILE IS NOT EMPTY.
* (PFDN) = DEVICE NUMBER OF DEVICE LOCAL FILE IS ON.
* (SDAB) = FIRST TRACK OF FILE.
* (SDAC) = 4XXX WHERE XXX IS *DT* IF REQUESTED
* OTHERWISE XXX = 000.
*
* USES LF - LF+1, P0 - P3, SA - SA+1, T1 - T7.
*
* CALLS CDA, CML, CPF, CPR, DDN, DSA, PDS, SFA, SFN, SFT.
*
* MACROS ERROR, SETMS, SFA.
* FILE EXISTS OR HAS BEEN CREATED - PROCEED WITH REQUEST.
DFR20 LDC 4000 SET DA FILE INDICATION + *DT* IF REQUESTED
DFRA EQU *-1
STM SDAC
LDD FS+1 SET FIRST TRACK
STM SDAB
LDD P3 SAVE FILE MST ADDRESS
SHN 3 SET DEVICE NUMBER
ADN PFGL
CRD CM
LDD CM+3
LPN 77
STM PFDN
LDD FS
LMM SDAA
NJN DFRX IF FILE NOT ON MASTER DEVICE
STM PFDN SET DEVICE NUMBER TO ZERO
DFR SUBR ENTRY/EXIT
LDD FS+1 CHECK TRACK ASSIGNMENT
NJN DFR1 IF NOT NULL FILE
LJM DFR10 DETERMINE CORRECT DEVICE
* PROCESS EXISTING FILE.
DFR1 LDM FRSM CHECK FOR SPECIAL USER INDEX
SHN 21-13
PJN DFR2 IF NOT SPECIAL USER INDEX
SHN 13+21-20 RESTORE ORIGINAL VALUE
LPC -377 CLEAR DEVICE ACCESS MASK
STM FRSM
DFR2 LDD FS+2
NJN DFR3 IF NOT EMPTY FILE
AOM LFEF
DFR3 LDD FN+4 CHECK FILE TYPE
SHN -6
LMN PMFT
STM DFRB SAVE *PMFT* TEST
ZJN DFR6 IF *PMFT* FILE TYPE
LMN LIFT&PMFT
ZJN DFR5 IF *LIFT* FILE TYPE
LMN LOFT&LIFT
ZJN DFR6 IF *LOFT* FILE TYPE
DFR4 ERROR IFT,CH,IW *(FILE NAME) INCORRECT FILE TYPE*
DFR5 LDM FRSM CHECK IF *LIFT* FILES LEGAL
SHN 21-12
PJN DFR4 IF *LIFT* FILES INVALID
DFR6 LDD FN+3
LPN 4
NJN DFR4 IF EXECUTE ONLY FILE
* DETERMINE IF FILE IS ON PROPER DEVICE.
LDD FS READ EST ENTRY
STD T2
SFA EST
ADK EQDE
CRD T3
RJM DDN DETERMINE DEVICE NAME
RJM CPR CHECK FOR PROPER RESIDENCE
NJN DFR8 IF RESIDENCE CHECK FAILED
RJM CDA CHECK DEVICE ACCESSIBILITY
RJM PDS PROCESS DEVICE STATUS
LDD T3+4 SAVE MST ADDRESS
STD P3
LDC * CHECK IF *PMFT* FILE
DFRB EQU *-1
NJN DFR7 IF NOT *PMFT* FILE
RJM CPF CHECK FOR PRESERVED FILE
PJN DFR7 IF FILE NOT PRESERVED
NFA FA,R READ FILE NAME FOR MESSAGE
ADK FNTL
CRD FN
LJM DFR4 RETURN FILE TYPE ERROR
DFR7 LJM DFR20 COMPLETE PROCESSING
DFR8 MJN DFR8.1 IF NOT DIRECT ACCESS DEVICE ERROR
ERROR DAD,CH,IW * DIRECT ACCESS DEVICE ERROR.*
DFR8.1 ADN 1
ZJN DFR9 IF DEVICE UNAVAILABLE
ERROR LNP,CH,IW,,SVE * ACCESS LEVEL NOT VALID ON PF DEVICE*
DFR9 ERROR PFN,CH,IW * DEVICE UNAVAILABLE.*
* IF NO ACCESSIBLE DEVICE WITH SUFFICIENT SPACE IS FOUND,
* *DFRC* WILL BE THE STATUS FOR THE MOST ACCESSIBLE DEVICE
* WHICH WAS ALMOST (BUT NOT QUITE) SELECTED.
DFR9.1 LDC 77 DEVICE STATUS FOR NO DEVICE FOUND
* LDC (STATUS) (STATUS FOR DEVICE WITH NO SPACE)
DFRC EQU *-1
SBN 3
PJN DFR9 IF DEVICE INACCESSIBLE OR NO DEVICE FOUND
ERROR SPN,CH,IW *REQUESTED SPACE UNAVAILABLE.*
* FILE DOES NOT EXIST - DETERMINE PROPER DEVICE FOR FILE.
DFR10 AOM LFEF SET EMPTY FILE
RJM SFA
ADN 1
CRD CM
LDD CM SET DEVICE TYPE REQUESTED
STD P0
LPC 3777 SET TYPE REQUESTED IN CATALOG
RAM DFRA
LDM FETL CHECK FET LENGTH
SBN CFOU+1
MJN DFR10.1 IF NOT LONG ENOUGH TO REQUEST SPACE
RJM SFA
ADN CFOU
CRD CM
LDD CM+3
STD LF
ADD CM+4
ZJN DFR10.1 IF SPACE NOT SPECIFIED
AOM DFRD SET SPACE REQUIRED CHECK
LDD CM+4
STD LF+1
DFR10.1 LDN 0
STD SA
STD SA+1
STD FS
LDN 77 INITIALIZE DEVICE STATUS
STD P2
RJM DDN DETERMINE DEVICE NAME
LDN ESTP READ EST POINTER
CRD T1
LDD T1+3 SET LAST MASS STORAGE ORDINAL + 1
STD T1
LDN NOPE-1 INITIALIZE EST ORDINAL FOR SEARCH
STD T2
* CHECK NEXT DEVICE.
DFR11 AOD T2 ADVANCE EST ORDINAL
LMD T1
NJN DFR12 IF MORE DEVICES TO CHECK
LDD FS
ZJP DFR9.1 IF NO DEVICE FOUND
LDD P2
RJM PDS PROCESS DEVICE STATUS
LJM DFR14 SET UP FNT AND EXIT
DFR12 SFA EST,T2 READ EST ENTRY
ADK EQDE
CRD T3
LDD P0
ZJN DFR13 IF DEVICE TYPE NOT REQUESTED
LMD T3+3
NJN DFR11 IF NOT PROPER DEVICE TYPE
DFR13 RJM CPR CHECK FOR PROPER RESIDENCE
NJN DFR11 IF NOT PROPER DEVICE
RJM CDA CHECK DEVICE ACCESSIBILITY
STD P1 SAVE STATUS OF CURRENT DEVICE
* SELECT MOST ACCESSIBLE DEVICE WITH MOST AVAILABLE SPACE.
RJM DSA DETERMINE SPACE AVAILABLE
LDD P2 COMPARE STATUS OF DEVICES
SBD P1
ZJN DFR13.2 IF STATUS THE SAME
PJN DFR13.3 IF CURRENT DEVICE MORE ACCESSIBLE
DFR13.1 UJP DFR11 CHECK NEXT DEVICE
DFR13.2 LDD CM COMPARE SECTORS AVAILABLE
SBD SA
MJN DFR13.1 IF LESS AVAILABLE
NJN DFR13.5 IF MORE AVAILABLE
LDD SA+1
SBD CM+1
MJN DFR13.5 IF MORE AVAILABLE
UJN DFR13.1 CHECK NEXT DEVICE
DFR13.3 LDN 0 SPACE REQUIRED NOT SPECIFIED
* LDN 1 (SPACE REQUIRED SPECIFIED)
DFRD EQU *-1
ZJN DFR13.5 IF SPACE REQUIRED NOT SPECIFIED
LDD P1 COMPARE CURRENT DEVICE STATUS
SBM DFRC
PJN DFR13.4 IF SAVED STATUS BETTER
RAM DFRC
DFR13.4 LDD CM
SBD LF
MJN DFR13.1 IF NOT ENOUGH SPACE
NJN DFR13.5 IF ENOUGH SPACE
LDD CM+1
SBD LF+1
MJN DFR13.1 IF NOT ENOUGH SPACE
DFR13.5 LDD CM SELECT THIS DEVICE
STD SA
LDD CM+1
STD SA+1
LDD T2 SET EST ORDINAL
STD FS
LDD P1 SAVE DEVICE STATUS
STD P2
LDD T3+4 SAVE MST ADDRESS
STD P3
LDM PFPN
NJN DFR14 IF AUXILIARY DEVICE REQUEST
LJM DFR11 CHECK FOR MORE DEVICES
DFR14 LDD FS SET DRIVER FOR PF EQUIPMENT
STD T5
SETMS STATUS
DFR18 LDM SLM PRE-CHECK PRU LIMIT
STM CMLA+1
LDN 0 SHOW REQUEST PRESET
RJM CML
LDC PFSN
RJM SFN
RJM SFT SET FNT/FST INFORMATION
LDD FS+1
ZJN DFR19 IF NO TRACK ASSIGNED
LDM SLM DECREMENT PRU COUNT FOR TRACK ASSIGNED
STM AIPR+1
LJM DFR20 COMPLETE
DFR19 ERROR TKL,CH,IW,FS *EQXXX,DNYY, TRACK LIMIT.*
DSA SPACE 4,10
** DSA - DETERMINE SPACE AVAILABLE ON A DEVICE.
*
* ENTRY (T3+4) = MST ADDRESS/10.
*
* EXIT (CM - CM+1) = SPACE AVAILABLE.
*
* USES CM - CM+4.
DSA SUBR ENTRY/EXIT
LDD T3+4 ADDRESS OF MST
SHN 3
ADK MDGL GET SECTORS PER TRACK
CRD CM
LDD CM+4
STD T0
LDD T3+4 ADDRESS OF MST
SHN 3
ADK TDGL GET TRACKS AVAILABLE
CRD CM
LDN 0
STD CM CLEAR RESULT
STD CM+1
STD CM+3 CLEAR UPPER HALF OF MULTIPLIER
* MULTIPLY NUMBER OF TRACKS AVAILABLE BY NUMBER OF SECTORS
* PER TRACK USING SHIFTS AND ADDS.
DSA1 LDD T0 CHECK MULTIPLIER (SECTORS PER TRACK)
ZJN DSAX IF DONE
SHN 21-0 RIGHT SHIFT MULTIPLIER 1 BIT
STD T0
PJN DSA2 IF NO ADDITION
LDD CM+4 ADD SHIFTED NUMBER OF TRACKS TO RESULT
RAD CM+1
SHN -14
ADD CM+3
RAD CM
DSA2 LDD CM+3 SHIFT NUMBER OF TRACKS TO THE LEFT
RAD CM+3
LDD CM+4
RAD CM+4
SHN -14
RAD CM+3
UJN DSA1 DO NEXT ITERATION OF MULTIPLY
PDS SPACE 4,25
** PDS - PROCESS DEVICE STATUS.
*
* ENTRY (A) = 0 IF DEVICE CAN BE ACCESSED.
* (A) = 1 IF NEW ACTIVITY RESTRICTED ON DEVICE.
* (A) = 2 IF PF UTILITY ACTIVE.
* (A) = 3 IF ACCESS DENIED BY *SETMS*.
* (A) = 4 IF *ERROR IDLE* SET FOR DEVICE.
* (FS) = EST ORDINAL OF DEVICE.
* (FERT) = REAL-TIME PROCESSING FLAG.
* (SSYS) = SUBSYSTEM FLAG.
*
* EXIT RETURN IF DEVICE CAN BE ACCESSED.
*
* TO *ERR* IF PF UTILITY ACTIVE.
* TO *ERR* IF DEVICE IS INACCESSIBLE.
* TO *ERR* IF *ERROR IDLE* IS SET.
*
* THE FOLLOWING LOCATIONS ARE SET FOR ERROR EXITS WHICH
* MAY CAUSE THE JOB TO BE ROLLED OUT.
* (ERRC) = ROLLOUT EVENT.
* (ERRD) = ROLLOUT TIME.
*
* USES T0.
*
* MACROS ERROR.
PDS4 LDN 0 RETURN WITH (A) = 0
PDS SUBR ENTRY/EXIT
STD T0 SAVE DEVICE STATUS
SBN 2
MJN PDS4 IF DEVICE CAN BE ACCESSED, RETURN
NJN PDS1 IF PF UTILITY NOT ACTIVE
LDN PFUE SET ROLLOUT EVENT
STM ERRC
LDK UIRT SET ROLLOUT TIME
STM ERRD
ERROR PFA,CH,IW,,EC2 * PF UTILITY ACTIVE.*
PDS1 LDM FERT
NJN PDS2 IF REAL-TIME PROCESSING SET
LDM SSYS
NJN PDS3 IF A SUBSYSTEM
* SUSPEND THE JOB OR RETURN STATUS INDICATING DELAY TO CALLER.
PDS2 LDD T0
SBN 4
ZJN PDS3 IF *ERROR IDLE* IS SET
ERROR WID,CH,IW,FS,EC6 * WAITING - INACCESSIBLE DEVICE.*
* TERMINATE THE REQUEST.
PDS3 ERROR PFN,CH,IW * DEVICE UNAVAILABLE.*
SFT SPACE 4,20
** SFT - SET FNT/FST INFORMATION.
*
* ENTRY (FNTA) = FNT ADDRESS IN NFL.
* (LFAL) = LOCAL FILE ACCESS LEVEL.
* (FN - FN+4) = LOCAL FILE NAME.
* (FS) = FILE EST ORDINAL.
*
* EXIT (FA) = FNT ADDRESS.
* (FS - FS+4) = FST ENTRY.
* (FN - FN+4) = FNT ENTRY.
* (RTKE) = RESERVED TRACK EST ORDINAL.
* (RTKT) = RESERVED TRACK.
* FNT/FST REWRITTEN TO CENTRAL MEMORY.
*
* USES FA, CM - CM+4, FN - FN+4, FS - FS+4.
*
* MACROS MONITOR, NFA.
SFT SUBR ENTRY/EXIT
LDC LOFT*100 SET FILE TYPE
* LDC PMFT*100 (*ASSIGNPF* WITH *SRSY* SPECIAL REQUEST)
SFTA EQU *-1
RAD FN+4
LDM FNTA SET FST ADDRESS
STD FA
NFA FA,R SET FILE ACCESS LEVEL
ADN FUTL
CRD CM
LDM LFAL
STD CM+2
NFA FA,R UPDATE FNT INFORMATION
ADK FNTL
CWD FN
ADN FUTL-FNTL
CWD CM
LDN ZERL REQUEST TRACK FOR FILE
CRD CM
LDD FS SET EST ORDINAL
STD CM+1
STM RTKE SET RESERVED TRACK EST ORDINAL
MONITOR RTCM
LDD CM+4 SET FST
STM RTKT SET RESERVED TRACK
STD FS+1
STD FS+2
LDN FSMS
STD FS+3
LDN 4
STD FS+4
NFA FA,R REWRITE FNT/FST
ADK FNTL
CWD FN
ADN FSTL-FNTL
CWD FS
LJM SFTX RETURN
SPACE 4,10
WCS$ EQU 0 SELECT CONSECUTIVE SECTOR WRITE
SPACE 4,10
* COMMON DECKS.
*CALL COMPWEI
*CALL COMPWSS
SPACE 4,10
* CHECK FOR OVERFLOW.
OVERFLOW OVLD,EPFW OVERFLOW INTO ERROR PROCESSING AREA
OVERLAY (CATALOG/PERMIT SEARCH AND RESIDENT.),OVLA
SPACE 4,25
** THIS OVERLAY CONTAINS PRELIMINARY PROCESSING FOR
* MOST REQUESTS, INCLUDING CATALOG AND PERMIT SEARCH.
* IT ALSO CONTAINS RESIDENT SUBROUTINES.
*
* ENTRY (CC) = COMMAND CODE.
OVL BSS 0 ENTRY
LJM IRP INITIAL REQUEST PROCESSING
MSR SPACE 4,10
** MSR - *COMPRNS* MASS STORAGE READ ERROR PROCESSOR.
*
* ENTRY FROM *RNS*.
* (MSRA) = ADDRESS OF ERROR PROCESSOR IN CALLER
* OF *RNS*.
*
* CALLS PCC, PCE, PTE.
MSR SUBR ENTRY/EXIT
RJM PCE PROCESS CATALOG READ ERROR
* RJM PCC (CATALOG READ ERROR FOR *CHANGE* REQUEST)
* RJM PTE (READ ERROR FOR DEVICE TO DEVICE TRANSFER)
MSRA EQU *-1 ERROR PROCESSOR ADDRESS
UJN MSRX RETURN
SPACE 4,10
* RESIDENT COMMON DECKS.
*CALL COMPSNT
*CALL COMPRNS
SPACE 4,10
LOCG EQU *+5 LOAD ADDRESS FOR DEVICE/DEVICE TRANSFER
TITLE RESIDENT SUBROUTINES.
CAI SPACE 4,15
** CAI - CLEAR ALLOCATION INTERLOCK.
*
* ENTRY (T5)= PERMANENT FILE EST ORDINAL.
* (AILK) = TRACK FOR ALLOCATION INTERLOCK.
*
* EXIT ALLOCATION INTERLOCK CLEARED.
*
* USES T5.
*
* CALLS CTI.
CAI SUBR ENTRY/EXIT
LDC 4000 SET CHECKPOINT VIA *STBM*
RAD T5
LDM AILK
RJM CTI CLEAR TRACK INTERLOCK
LDD T5 RESTORE EST ORDINAL
LPC 777
STD T5
LDN 0 CLEAR INTERLOCK FLAG
STM AILK
UJN CAIX RETURN
CSA SPACE 4,15
** CSA - COMPUTE SECTOR ADDRESS.
*
* ENTRY (RI - RI+1) = RANDOM INDEX OF PERMIT SECTOR.
* (DVLW - DVLW+4) = DEVICE LAYOUT WORD OF MST.
* PROPER DRIVER LOADED.
*
* EXIT (T6) = TRACK OF RANDOM SECTOR.
* (T7) = SECTOR OF RANDOM SECTOR.
*
* USES T6 - T7, RI - RI+1.
*
* CALLS CRA.
*
* MACROS ERROR.
CSA SUBR ENTRY/EXIT
LDM DVLW+2 SET FIRST TRACK
STD T6
RJM CRA CONVERT RANDOM ADDRESS
PJN CSAX IF RANDOM ADDRESS OK
ERROR RIN,,,EQ *EQXXX,DNYY, RANDOM INDEX ERROR.*
DPR SPACE 4,15
** DPR - DELAY PRIOR TO RETRY.
*
* DELAY 100 MILLISECONDS.
*
* EXIT TO *ERR* IF *ORET* SET.
*
* USES T0.
*
* MACROS DELAY, ERROR, PAUSE.
DPR SUBR ENTRY/EXIT
LDC 1400
STD T0
DPR1 DELAY
PAUSE
LDD CM+1
LMN ORET
ZJN DPR2 IF *ORET* SET
SOD T0
PJN DPR1 IF MORE DELAY REQUIRED
UJN DPRX RETURN
DPR2 ERROR ABT,,,T5 *EQXXX,DNYY, PFM ABORTED.*
DTK SPACE 4,15
** DTK - DROP TRACKS.
*
* ENTRY (A) = LAST SECTOR WRITTEN.
* (T6) = ADDRESS OF LAST TRACK (NOT RELEASED).
* (T5) = EST ORDINAL.
*
* EXIT LAST SECTOR WRITTEN UPDATED IN TRT.
*
* USES CM - CM+4.
DTK SUBR ENTRY/EXIT
STD CM+3
LDD T6
LPC 3777
STD CM+2
LDD T5
STD CM+1
MONITOR DTKM
UJN DTKX RETURN
ITC SPACE 4,15
** ITC - INTERLOCK TRACK CHAIN.
*
* ENTRY (A) = TRACK CHAIN TO BE INTERLOCKED.
* (T5) = EST ORDINAL.
*
* EXIT (A) = 0 IF TRACK INTERLOCKED.
* (A) = 2 IF TRACK NOT RESERVED.
* (T6) = TRACK.
*
* CALLS DPR, STI.
ITC2 LMN 1 RETURN STATUS VALUE
ITC SUBR ENTRY/EXIT
STD T6
ITC1 RJM STI TRY TO INTERLOCK TRACK
LMN 1
NJN ITC2 IF INTERLOCK WORKED OR TRACK NOT RESERVED
RJM DPR DELAY PRIOR TO RETRY
UJN ITC1 TRY AGAIN
RMD SPACE 4,15
** RMD - RESET TO MASTER DEVICE.
*
* ENTRY (EQ) = MASTER DEVICE EST ORDINAL.
*
* EXIT (T5) = MASTER DEVICE EST ORDINAL.
*
* USES T5.
*
* CALLS PDV.
*
* MACROS SETMS.
RMD SUBR ENTRY/EXIT
LDD EQ
STD T5
SETMS IO,NS
RJM PDV PROCESS DEVICE STATUS
UJN RMDX RETURN
UCE SPACE 4,20
** UCE - UPDATE CATALOG ENTRY.
*
* ENTRY (CB) = POINTER TO BUFFER LOCATION.
* (CI) = POINTER TO CATALOG ENTRY IN BUFFER.
* MASTER DEVICE CHANNEL RESERVED.
* (PWRF) = *PFM* RESTART FLAGS FOR RECALL.
* (UCEA) SET WITH *STMI+CI* IF FCMD, FCUD
* ARE TO BE UPDATED.
*
* EXIT (PWRF) = FLAGS SET FOR ACCESS AND PERMIT COUNTS
* UPDATED.
* FCAC, FCAD, FCMD, FCUD UPDATED.
* CATALOG ENTRY REWRITTEN.
*
* USES CM - CM+4.
*
* CALLS WBI.
UCE SUBR ENTRY/EXIT
* UPDATE DATES.
LDN PDTL READ PACKED DATE AND TIME
CRD CM
LDN 3
STD CM
RAD CI
UCE1 LDM CM+2-1,CM
UCEA UJN UCE2 READ ACCESS - BYPASS FCMD, FCUD UPDATES
* UJN UCE3 (*UATTACH*/M=R - BYPASS DATE/TIME UPDATE)
* STM FCUD-1,CI (UPDATE UTILITY CONTROL DATE/TIME)
CON FCUD-1
UCEB STM FCMD-1,CI UPDATE MODIFICATION DATE
* UJN UCE3 (*UATTACH* - BYPASS FCMD, FCAD UPDATE)
UCE2 STM FCAD-1,CI UPDATE ACCESS DATE
UCE3 SOD CI
SOD CM
NJN UCE1 IF UPDATE NOT COMPLETE
* UPDATE ACCESS COUNT.
LDM PWRF RESTART FLAGS
LPK RFAC
NJN UCE4 IF ACCESS COUNT UPDATED
UCEC AOM FCAC+1,CI ADVANCE ACCESS COUNT
* UJN UCE4 (*UATTACH* - BYPASS ACCESS COUNT UPDATE)
SHN -14
RAM FCAC,CI
* REWRITE CATALOG ENTRY.
UCE4 LDD CB REWRITE CATALOG
RJM WBI
LDM PWRF RESTART FLAGS
SCN RFAC+RFPC
ADK RFAC+RFPC SET ACCESS AND PERMIT COUNTS UPDATED
STM PWRF
UJP UCEX RETURN
* CHECK RANGE ON GENERATED JUMPS.
ERRNG 37-UCE3+UCEB
ERRNG 37-UCE4+UCEC
WBI SPACE 4,20
** WBI - WRITE BUFFER IN PLACE.
*
* ENTRY (A) = BUFFER LOCATION.
* (T5) = MASTER DEVICE EST ORDINAL.
* (STAT) = *STNS* BIT SET IF NO JOB SUSPENSION ALLOWED.
* ADDRESS SET IN 2 LOCATIONS PRECEEDING BUFFER.
* LINKAGE SET IN BUFFER.
*
* EXIT SECTOR WRITTEN.
* TO *ERR* TO PROCESS MASS STORAGE ERROR.
*
* USES T3, T6, T7.
*
* CALLS PDV, PES, WDS.
*
* MACROS ERROR, SETMS.
WBI SUBR ENTRY/EXIT
STD T3 SAVE BUFFER ADRRESS
LDM -2,T3
STD T6
LDM -1,T3
STD T7
SETMS IO,(RW,NS)
RJM PDV PROCESS DEVICE STATUS
LDD T3
LMK WLSF WRITE LAST SECTOR
RJM WDS
PJN WBIX IF NO ERRORS
RJM PES PROCESS ERROR STATUS
LDM STAT
LPK STNS
NJN WBI1 IF JOB SUSPENSION INHIBITED
LDM RDCT DRIVER STATUS
SHN 21-13
PJN WBI1 IF DATA TRANSFERRED
ERROR MSE,CH,,T5 *EQXXX,DNYY, MASS STORAGE ERROR.*
* REQUEST ERROR IDLE BE SET WHEN CATALOG OR PERMIT FILE
* IS NOT INTACT.
WBI1 ERROR MSE,CH,,T5,,EI *EQXXX,DNYY, MASS STORAGE ERROR.*
SPACE 4,10
* RESIDENT COMMON DECKS.
*CALL COMPCRA
*CALL COMPCTI
*CALL COMPIRA
STI$ SET 0 RETURN CONTROL ON TRACK INTERLOCK REJECT
TNR$ SET 0 DO NOT HANG ON *TRACK NOT RESERVED*
*CALL COMPSTI
SPACE 4,10
OVLU EQU *+5 CATALOG/PERMIT UPDATE OVERLAY LOAD ADDRESS
SPACE 4,10
* DEFINE THE MAXIMUM LENGTH OF OVERLAYS *3PD*
* (CATALOG UPDATE ROUTINES) AND *3PE* (PERMIT
* UPDATE ROUTINES) IN SECTORS.
OVLL EQU 3*500B OVERLAY LENGTH IN SECTORS
SPACE 4,10
* DEFINE THE LOAD ADDRESS FOR THE COMMAND OVERLAYS.
OVLC EQU OVLU+OVLL-5 COMMAND CODE LOAD ADDRESS
TITLE PERMIT SEARCH ROUTINES.
CPI SPACE 4,25
** CPI - CHECK PERMISSION INFORMATION.
*
* *BFMS* IS USED TO READ PERMITS.
*
* ENTRY (A) = PERMISSION MODE REQUIRED FOR COMMAND.
* (CI) = INDEX TO CATALOG ENTRY.
* MASTER DEVICE CHANNEL RESERVED.
* (PP) = 0.
* (PB) = 0.
*
* EXIT (A) = ACCESS MODE ALLOWED.
* TO ERR IF NOT PERMITTED ACCESS.
* BUFFER LOADED WITH PERMITS.
* (PP) = POINTER TO PERMIT ENTRY.
* (PP) = 0 IF PERMIT ENTRY NOT AVAILABLE.
* (PB) = ADDRESS OF PERMIT BUFFER.
* (PB) = 0 IF NO PERMIT SEARCH POSSIBLE.
*
* USES P1, PB, PP, T0, T1, RI - RI+1.
*
* CALLS SPI.
*
* MACROS MONITOR.
CPI SUBR ENTRY/EXIT
LPN 37 SET MODE REQUIRED
STD T1
STM CPIC
LDC SHNI+21 SET SHIFT COUNT FOR MODE REQUIRED
SBD T1
STM CPID
LDD PI
ADD PI+1
ZJN CPIX IF NOT ALTERNATE CATALOG ACCESS
* READ PERMISSION INFORMATION.
LDC BFMS SET PERMIT BUFFER
STD PB
LDM FCRI,CI SET PERMIT ADDRESS
STD RI
LDM FCRI+1,CI
STD RI+1
ADD RI
ZJN CPI1 IF NO PERMISSION INFORMATION AVAILABLE
LDN IPPA PF INCREMENT OF PERMIT FILE ACCESS
RAM AIPF+1
RJM SPI SEARCH PERMISSION INFORMATION
* CHECK FILE CATEGORY.
CPI1 LDM FCAM,CI SET ACCESS MODE FOR FILE
LPN 77
STD P1
LDM FCCT,CI
SHN -6
LMK FCPR
NJN CPI3 IF NOT PRIVATE FILE
* PRIVATE FILE.
LDD PP
NJN CPI5 IF PERMIT FOUND
CPI2 LDN PTNU PROHIBIT ACCESS TO FILE
STD P1
UJN CPI8 PROCESS PERMIT NOT FOUND
* SEMI-PRIVATE OR PUBLIC FILE.
CPI3 LDM PFAC
NJN CPI4 IF CALLER HAS USER NAME IN CPA
STD PB PREVENT UPDATE OF PERMIT ENTRY
UJN CPI6 TREAT AS NONPERMITTED PUBLIC FILE
CPI4 LDC MJNI+CPI6-CPIB SET SEMI-PRIVATE OR PUBLIC FILE
STM CPIB
LDD PP CHECK PERMIT INDEX
ZJN CPI6 IF NO PERMIT FOUND
* CHECK PERMIT TYPE.
CPI5 LDM FPMD,PP CHECK PERMIT TYPE
SHN 21-4
CPIB MJN CPI2 IF ACCOUNTING PERMIT
* MJN CPI6 IF ACCOUNTING PERMIT (SEMI-PRIVATE/PUBLIC)
SHN -21+4 SET PERMIT MODE
STD P1
* CHECK ACCESS MODE.
CPI6 LDD P1 PERMITTED MODE
SBN PTLM
MJN CPI8 IF LEGAL MODE
CPI7 ERROR FNF *(FILENAME) NOT FOUND.*
* CHECK FOR MULTI-LEVEL USER NAME ACCESS.
CPI8 LDM PFPT
NJN CPI10 IF NOT MULTI-LEVEL USER
LDC * (REQUESTED MODE)
CPIC EQU *-1
LMN PTRD
ZJN CPI9 IF READ MODE REQUESTED
LMN PTEX&PTRD
NJN CPI10 IF MODE OTHER THAN EXECUTE REQUESTED
CPI9 LDN PTRD ALLOW READ MODE ACCESS
LJM CPIX RETURN
* CHECK EXPIRATION DATE.
CPI10 LDD PP
ZJN CPI12 IF NO PERMIT ENTRY
LDM FPMD,PP
SHN 21-5
PJN CPI12 IF EXPIRATION DATE NOT PRESENT
LDM FPXD,PP
LPN 77
STD CM+3
SHN 14
LMM FPXD+1,PP
ZJN CPI12 IF NONEXPIRING PERMIT
STD CM+4
LDN VEDS VALIDATE EXPIRATION DATE
STD CM+1
MONITOR VSAM
LDD CM+1
ZJN CPI12 IF PERMIT NOT EXPIRED
CPI11 LJM CPI7 *(FILENAME) NOT FOUND.*
* CHECK IF ACCESS MODE PERMITTED.
CPI12 LDM TMPE,P1
CPID SHN ** (21 - REQUESTED MODE)
PJN CPI11 IF REQUESTED MODE NOT ALLOWED
LDD P1 ALLOW PERMITTED MODE
LJM CPIX RETURN
* TEST RANGE OF GENERATED RELATIVE JUMPS.
ERRNG 37+CPIB-CPI6
TMPE BSS 0 TABLE OF MODE PERMISSION EQUIVALENCES.
LOC 0
CON MDWR WRITE
CON MDRD READ
CON MDAP APPEND
CON MDEX EXECUTE
CON MDNU NEGATE
CON MDMD MODIFY
CON MDRM READ/ALLOW MODIFY
CON MDRA READ/ALLOW EXTEND
CON MDUP UPDATE
CON MDRU READ/ALLOW UPDATE
LOC *O
SPI SPACE 4,25
** SPI - SEARCH PERMISSION INFORMATION.
*
* ENTRY (PB) = BUFFER TO BE SEARCHED.
* (PP) = 0.
* (EBTK) = END BUFFER TRACK, IF BUFFER IS IN *BFMS*.
*
* EXIT (PP) = INDEX TO PERMIT ENTRY IF FOUND.
* (PP) = 0 IF PERMIT ENTRY NOT FOUND.
* (T1) = NEXT AVAILABLE ENTRY IF NOT FOUND AND SHORT PRU.
* (EXPC) = NUMBER OF EXPLICIT PERMIT ENTRIES (IF PERMIT
* NOT FOUND).
* (RI - RI+1) = RANDOM INDEX OF PERMIT SECTOR.
* (ADVANCED IF SECTOR OVERFLOW)
* (STAT) FLAG SET IF *BFMS* REUSED.
* BUFFER LOADED WITH PERMITS.
*
* USES T1, T2, PI - PI+1, RI - RI+1.
*
* CALLS CSA, PDV, PES, RDS.
*
* MACROS ERROR, SETMS.
SPI SUBR ENTRY/EXIT
LDN STPR INDICATE THAT PERMITS WERE READ
RAM STAT
LDM EBTK CHECK IF END BUFFER IS IN *BFMS*
ZJN SPI1 IF *BFMS* IS NOT IN USE
LDN STBR INDICATE THAT *BFMS* HAS BEEN REUSED
RAM STAT
* READ NEXT SECTOR OF PERMITS.
SPI1 RJM CSA COMPUTE RANDOM ADDRESS
LDD T6 SET CURRENT SECTOR POINTERS
STM -2,PB
STM ERRC
LDD T7
STM -1,PB
STM ERRD
SETMS IO
RJM PDV PROCESS DEVICE STATUS
LDD PB
RJM RDS READ SECTOR
PJN SPI2 IF NO READ ERROR
RJM PES PROCESS ERROR STATUS
ERROR MSE,CH,,EQ *EQXXX,DNYY, MASS STORAGE ERROR.*
SPI2 LDM 1,PB WORD COUNT IN PERMIT SECTOR
SBN NWPE+NWPH
MJN SPI3 IF INCORRECT SECTOR LENGTH
LPN NWPE-1
ZJN SPI4 IF INTEGRAL NUMBER OF PERMIT ENTRIES
ERRNZ NWPH-NWPE HEADER SIZE MUST EQUAL ENTRY SIZE
SPI3 ERROR BCS,,,T5,,EI *EQXXX,DNYY, BAD CATALOG/PERMIT SECTOR.*
SPI4 LDN NWPH ADVANCE WORD COUNT PAST HEADER
STD T2
LDD PB RESET SEARCH INDEX
ADN NWPH*5+2 SKIP HEADER AND CONTROL BYTES
STD T1
UJN SPI7 CHECK FIRST ENTRY IN SECTOR
* ADVANCE TO NEXT PERMIT ENTRY.
SPI5 LDM FPMD,T1
SHN 21-4
MJN SPI6 IF ACCOUNTING PERMIT
AOM EXPC ADVANCE EXPLICIT PERMIT COUNT
SPI6 LDN NWPE*5 ADVANCE BUFFER INDEX
RAD T1
LDN NWPE INCREMENT WORD COUNT
RAD T2
LMM 1,PB
NJN SPI7 IF NOT END OF BUFFER
UJN SPI10 END OF BUFFER
SPI7 LDM PFAC
LMM FPAN,T1 COMPARE USER NAME
NJN SPI5 IF NO MATCH
LDM FPAN+1,T1
LMM PFAC+1
NJN SPI5 IF NO MATCH
LDM FPAN+2,T1
LMM PFAC+2
SPI8 NJN SPI5 IF NO MATCH
LDM FPAN+3,T1
LMM PFAC+3
SCN 77
NJN SPI8 IF NO MATCH
LDD T1 SET POINTER TO ENTRY
STD PP
SPI9 LDD T1 SET HOLE ADDRESS
STM NPHA
LJM SPIX RETURN
SPI10 LDD T2 CHECK WORD COUNT OF SECTOR
LMD HN
NJN SPI9 IF END OF PERMITS
LDM FPRI,PB CHECK FOR LINKED PERMIT BUFFERS
STD RI
LDM FPRI+1,PB
STD RI+1
ADD RI
ZJN SPI9 IF INDEX NOT SET
LJM SPI1 READ NEXT SECTOR
SPACE 4,10
OVL0 EQU *+5 ZERO-LEVEL OVERLAY LOAD ADDRESS
TITLE CATALOG SEARCH ROUTINES.
CCD SPACE 4,25
** CCD - CHECK CATALOG DATA.
*
* CHECK IF CATALOG ENTRY IS THAT OF DESIRED FILE.
* IF PASSWORD PRESENT IN CATALOG ENTRY, VERIFY THAT
* CORRECT PASSWORD WAS SPECIFIED AND THAT PASSWORD
* HAD NOT EXPIRED (ALTERNATE USER ONLY).
* THE ACCESS LEVEL AND ACCESS CATEGORY SET ARE ALSO
* VALIDATED. STATISTICS ARE ACCUMULATED FOR USER
* CONTROL CHECKS.
*
* ENTRY (T3) = INDEX TO CATALOG ENTRY.
* (FN - FN+3) = FILE NAME.
* (PFPW - PFPW+3) = FILE PASSWORD FROM CALL BLOCK
* (CCDA) = EXIT JUMP IF NO OPTIONAL USER.
*
* EXIT (A) = 0 IF FILE FOUND AND ACCESS ALLOWED.
* (NF - NF+1) INCREMENTED.
* (CS - CS+1) ADVANCED IF FILE IS INDIRECT.
* TO *ERR* IF ACCESS TO FILE NOT ALLOWED.
*
* USES T3, FN - FN+3.
*
* MACROS ERROR, MONITOR.
*
* NOTES THE USE OF THE DATA TAGS *CCDD*, *CCDF*, *CCDI*
* AND *CCDP* SHOULD BE AVOIDED, SINCE THEY CONFLICT
* WITH GLOBAL SYMBOL DEFINITIONS.
CCD SUBR ENTRY/EXIT
CCDB UJN CCD1 SET TO *PSN* IF ALLOCATION COMMAND
* I.E. SAVE, REPLACE, APPEND, DEFINE.
* ACCUMULATE STATISTICS.
AOD NF+1 ADVANCE FILE COUNT
SHN -14
RAD NF
LDM FCBS,T3
SHN 6
MJN CCD1 IF DIRECT ACCESS FILE
LDM FCLF+1,T3 ADD TO CUMULATIVE SIZE OF INDIRECT FILES
RAD CS+1
SHN -14
ADM FCLF,T3
RAD CS
* CHECK FILE FOR SEARCH.
CCD1 LDI T3 COMPARE FILE NAMES
LMD FN
NJN CCDX IF NOT EQUAL
LDM FCFN+1,T3 COMPARE BYTE 2
LMD FN+1
CCD2 NJN CCDX IF NOT EQUAL
LDM FCFN+2,T3 COMPARE BYTE 3
LMD FN+2
NJN CCDX IF NOT EQUAL
LDM FCFN+3,T3 COMPARE 7TH CHARACTER
LMD FN+3
SHN -6
NJN CCD2 IF LAST CHARACTER NOT EQUAL
* COMPARE FILE PASSWORD.
CCDA LDM FCPW,T3 COMPARE FILE PASSWORD
* UJN CCD4 (NOT ALTERNATE USER)
* UJN CCD4 (*PERMIT* REQUEST)
LMM PFPW
NJN CCD3 IF NOT EQUAL
LDM FCPW+1,T3 COMPARE BYTE 2
LMM PFPW+1
NJN CCD3 IF NOT EQUAL
LDM FCPW+2,T3 COMPARE BYTE 3
LMM PFPW+2
NJN CCD3 IF NOT EQUAL
LDM FCPW+3,T3 COMPARE 7TH CHARACTER
LMM PFPW+3
SHN -6
CCD3 NJN CCD6 IF NOT EQUAL
UJN CCD5 CHECK FOR PASSWORD EXPIRATION
CCD4 LDN 0
UJN CCD7 VALIDATE ACCESS TO FILE
* CHECK FOR PASSWORD EXPIRATION.
CCD5 LDM FCPW,T3
ZJN CCD7 IF NO PASSWORD
LDM FCXD,T3 CHECK EXPIRATION DATE
LPN 77
STD CM+3
SHN 14
LMM FCXD+1,T3
ZJN CCD7 IF NON-EXPIRING PASSWORD
STD CM+4
LDN VEDS VALIDATE EXPIRATION DATE
STD CM+1
MONITOR VSAM
LDD CM+1
ZJN CCD7 IF NOT EXPIRED
CCD6 ERROR FNF *(FILENAME) NOT FOUND.*
* VALIDATE ACCESS TO FILE.
CCD7 STD CM VALIDATE ACCESS LEVEL AND CATEGORY SET
LDM FCAL,T3 SET ACCESS LEVEL
LPN 7
STD CM+1
LDM FCFC,T3 SET ACCESS CATEGORY
LPC 377
STD CM+2
LDM FCFC+1,T3
STD CM+3
LDM FCFC+2,T3
STD CM+4
LDD MA
CWD CM
LDN ZERL
CRD CM
LDN VAJS CHECK AGAINST CURRENT JOB VALIDATIONS
STD CM+1
ERRNZ VAJS-3 VALIDATE ACCESS LEVEL AND CATEGORY SET
STD CM+4
MONITOR VSAM
LDD CM+1
CCDC NJN CCD6 IF NOT VALID ACCESS
* NJN CCD9 IF NOT VALID ACCESS (NOT ALTERNATE USER)
CCD8 LJM CCDX RETURN
* ALLOW AN *SSJ=* JOB TO PURGE ANY FILE.
CCD9 LDM SSJS
ZJN CCD10 IF NOT *SSJ=*
LDD CC
LMN CCPG
ZJN CCD8 IF *PURGE*
CCD10 ERROR JCA,,,,SVE * JOB CANNOT ACCESS FILE.*
ICT SPACE 4,15
** ICT - INTERLOCK CATALOG TRACK.
*
* ENTRY (T6) = CATALOG TRACK TO BE INTERLOCKED.
* (T5) = EST ORDINAL.
*
* EXIT TRACK INTERLOCKED.
* RECALL *PFM* IF INTERLOCK NOT AVAILABLE
* AFTER FOUR TRIES.
* TO *HNG* IF CATALOG TRACK NOT RESERVED.
*
* CALLS DPR, STI.
ICT SUBR ENTRY/EXIT
LDN 3 SET RETRY COUNT
STD T1
ICT1 RJM STI TRY TO INTERLOCK TRACK
ZJN ICTX IF INTERLOCK SUCCESSFUL
LMN 2
ZJN ICT2 IF TRACK NOT RESERVED
SOD T1
MJN ICT3 IF RETRY COUNT EXHAUSTED
RJM DPR DELAY PRIOR TO RETRY
UJN ICT1 RETRY
ICT2 RJM HNG HANG IF CATALOG TRACK NOT RESERVED
ICT3 EXIT INA,CH,,,EC4 * INTERLOCK NOT AVAILABLE.*
ISP SPACE 4,20
** ISP - INITIALIZE SEARCH OF PERMANENT FILES.
*
* ENTRY (EQ) = MASTER DEVICE EST ORDINAL.
* (CCIA) = CATALOG TRACK.
*
* EXIT (T4) = MASTER DEVICE CHANNEL.
* (T5) = MASTER DEVICE EST ORDINAL.
* (T6) = CATALOG TRACK.
* (T7) = CATALOG SECTOR.
* (DPPF) = INCREMENTED FOR CATALOG SEARCH.
* (P0 - P4) = CATALOG SEARCH POINTERS INITIALIZED.
* CATALOG TRACK INTERLOCK SET.
* *SETMS READ* PERFORMED.
*
* CALLS ICT, IRA, PDV.
*
* MACROS ERROR, SETMS.
ISP SUBR ENTRY/EXIT
LDD EQ SET MASTER DEVICE EST ORDINAL
STD T5
LDM CCIA SET CATALOG TRACK
STD T6
ISPB RJM ICT INTERLOCK CATALOG TRACK
* UJN ISP1 (*UREPLAC*/*DROPIDS*- ALREADY INTERLOCKED)
AOM CCIB SET CATALOG TRACK INTERLOCK FLAG
ISP1 LDN IPCS PF INCREMENT FOR CATALOG SEARCH
RAM AIPF+1
RJM IRA INITIALIZE RANDOM PROCESSORS
* SET SEARCH POINTERS.
LDN 0 SET STARTING CATALOG TRACK SECTOR
STD T7
LDN ZERL CONTIGUOUS STORAGE INITIALIZATION
CRD P0 TEMPORARY CATALOG SEARCH BUFFER POINTERS
LDC BUF1 SET PRIMARY BUFFER POINTER
* LDC BFMS (*UREPLAC*/*DROPIDS*)
ISPC EQU *-1
STD P2
LDC BUF2 SET SECONDARY BUFFER POINTER
ISPA EQU *-1
* LDC BFMS (*DEFINE* REQUEST)
STD P3
SETMS READSTR
RJM PDV PROCESS DEVICE STATUS
UJP ISPX RETURN
PCE SPACE 4,10
** PCE - PROCESS CATALOG READ ERROR.
*
* ENTRY READ ERROR DETECTED BY *COMPRNS*.
PCE SUBR ENTRY
RJM PES PROCESS ERROR STATUS
ERROR MSE,,,T5 *EQXXX,DNYY, MASS STORAGE ERROR.*
SCH SPACE 4,50
** SCH - SEARCH CATALOGS.
*
* THIS ROUTINE WILL SEARCH FOR A FILE AND FOR A HOLE
* (IF REQUESTED) BY READING INTO *BUF1* UNTIL A HOLE IS FOUND
* AND THEN CONTINUING IN *BUF2*. IF A LARGER HOLE IS
* FOUND (*BUF2*) THEN READ WILL REVERT BACK TO *BUF1* UNTIL
* LARGEST HOLE AND FILE ARE IN *BUF1* AND *BUF2*. *SCH*
* ALWAYS EXITS WHEN THE FILE IS FOUND.
*
* ON A *UREPLAC* OR *DROPIDS* REQUEST, *SCH* IS CALLED JUST TO
* SEARCH FOR A HOLE. READING WILL START WITH *BFMS* AND WILL
* SWITCH BACK AND FORTH BETWEEN *BFMS* AND *BUF2* UNTIL THE END
* OF CATALOGS, OR UNTIL AN EXACT FIT IS FOUND.
*
* UPON REENTRY (ON A *REPLACE* OR *APPEND* REQUEST IN WHICH
* NO EXACT FIT HOLE WAS FOUND IN THE FIRST SEARCH) IT IS
* NECESSARY TO KEEP ONE OF THE TWO BUFFERS (THE ONE WITH THE
* FILE CATALOG ENTRY IN IT) AND TO CONTINUE TO SEARCH FOR A
* LARGER HOLE BY READING INTO THE REMAINING BUFFER AND *BFMS*.
* READING WILL START IN THE REMAINING *BUF1*/*BUF2* BUFFER -
* RATHER THAN IN *BFMS* - UNLESS THERE IS ALREADY A HOLE IN
* THE *BUF1*/*BUF2* BUFFER.
*
* IF NO HOLE SEARCH IS REQUIRED ALL SECTORS ARE READ
* INTO BUF1 (*GET*, *OLD* AND *ATTACH* REQUESTS).
*
* SEE *CPI* FOR BUFFERS USED TO READ PERMITS.
*
* ENTRY (FN - FN+3) = FILE NAME.
* (UI - UI+1) = USER INDEX.
* (LF - LF+1) = LENGTH OF FILE IF HOLE SEARCH DESIRED.
* (SCHA) INCREMENTED IF REENTRANT CALL.
* (SCHB) PRESET FOR REENTRY IF CURRENT ENTRY (FILE
* FOUND) IS TO BE INCLUDED IN HOLE SEARCH.
* (SCHF) PRESET IF HOLE SEARCH ENABLED (SEARCH FOR
* LARGEST HOLE OR ONE THAT FILE EXACTLY FITS IN).
* (SCHH) PRESET IF SEARCH FOR DAPF HOLE.
* (SCHI) PRESET IF SEARCH FOR LARGEST HOLE ENABLED.
*
* EXIT (A) = 0 IF FILE FOUND.
* (CI) = CATALOG POINTER.
* (CB) = CATALOG BUFFER.
* (HP) = HOLE POINTER.
* (HB) = HOLE BUFFER.
* (EP) = END POINTER.
* (EB) = END BUFFER.
* (HL) = SIZE OF HOLE FOUND.
* (NF - NF+1) = NUMBER OF FILES IN CATALOG.
* (CS - CS+1) = CUMULATIVE SIZE OF INDIRECT FILES.
* (DAHP - DAHP+2) = DIRECT ACCESS HOLE POINTERS IF
* DA HOLE FOUND AND NOT DAPF SEARCH.
* (SDAB - SDAC) = ADDRESS OF FILE IF FOUND.
*
* USES P0 - P3, T3 - T7.
*
* CALLS CCD, ISP, RNS.
*
* MACROS ERROR.
* FILE FOUND.
SCH18 LDD T3 SET CATALOG ENTRY POINTERS
STD CI
LDM P2,P1
STD CB
LDM FCBT,CI SET ADDRESS OF FILE FOUND
STM SDAB
LDM FCBS,CI
STM SDAC
LDN 0
SCH SUBR ENTRY/EXIT
SCHA LDN 0
* LDN 1 PRESET BY CATALOG SEARCH INITIALIZATION
NJN SCH1 IF NOT INITIAL CALL
AOM SCHA CLEAR INITIAL CALL STATUS
RJM ISP INITIALIZE FOR SEARCH
LJM SCH7 READ FIRST SECTOR
* SECONDARY CALL TO CONTINUE SEARCH FOR BEST HOLE.
SCH1 LDK PSNI USE NEW BUFFER FOR REMAINDER OF SEARCH
STM SCHD
LDD HP
ZJN SCH1.1 IF NO HOLE FOUND YET
LDD HB
LMM P2,P1
NJN SCH1.2 IF HOLE NOT IN CURRENT BUFFER
SCH1.1 AOM SCHC SET BUFFER TOGGLE (DO NOT USE *BFMS* NEXT)
SCH1.2 LJM SCH10 CONTINUE SEARCH, BYPASSING CURRENT FILE
* LJM SCH11 (INCLUDE CURRENT FILE IN SEARCH)
SCHB EQU *-1
* END OF SECTOR PROCESSING.
SCH2 LDC * PARTIAL SECTOR WORD COUNT
SCHE EQU *-1
LPN 77
ZJN SCH4 IF NOT EOR
* END OF RECORD ENCOUNTERED.
LDD T3 SET END SECTOR POINTERS
STD EP
* END OF INFORMATION ENCOUNTERED (NO SHORT SECTOR).
SCH3 LDM P2,P1 SET END BUFFER
STD EB
LJM SCHX RETURN
* SELECT BUFFER FOR NEXT SECTOR.
SCH4 UJN SCH5 TOGGLE BUFFER IF NECESSARY
* PSN (NEW BUFFER REQUIRED)
SCHD EQU *-1
LDC BFMS SET *BFMS* IN PLACE OF CURRENT BUFFER
STM P2,P1
ISTORE SCHD,(UJN SCH5) RESET TO BYPASS THIS SECTION
SCH5 LDN 0
* LDN 1 (BUFFER TOGGLE REQUIRED)
SCHC EQU *-1
ZJN SCH7 IF SAME BUFFER TO BE USED
ISTORE SCHC,(LDN 0) CLEAR BUFFER TOGGLE
LDD P1 TOGGLE BUFFER
LMN 1
STD P1
* READ NEXT SECTOR.
SCH7 LDM P2,P1 SET BUFFER ADDRESS
STD T3
LDD T6 SAVE POSITION OF SECTOR
STM -2,T3
STM ERRC
LDD T7
STM -1,T3
STM ERRD
LDD T3 READ SECTOR
RJM RNS
NJN SCH8 IF NOT EOF/EOI OR ZERO LENGTH RECORD
LJM SCH3 PROCESS EOI
SCH8 STD P0 SAVE WORD COUNT
STM SCHE
LPN NWCE-1
ZJN SCH9 IF INTEGRAL NUMBER OF CATALOG ENTRIES
ERROR BCS,,,T5,,EI *EQXXX,DNYY, BAD CATALOG/PERMIT SECTOR.*
SCH9 LDN 2 SKIP CONTROL BYTES
RAD T3
UJN SCH11 CHECK FIRST CATALOG ENTRY
* ADVANCE TO NEXT CATALOG ENTRY.
SCH10 LDC NWCE*5 ADVANCE TO NEXT CATALOG ENTRY
RAD T3
LCN NWCE ADVANCE SECTOR WORD COUNT
RAD P0
ZJP SCH2 IF END OF BUFFER
* CHECK NEXT CATALOG ENTRY.
SCH11 LDM FCUI,T3
LPN 37
SHN 14
LMM FCUI+1,T3
SCHF PSN 0
* ZJN SCH12 (HOLE SEARCH ENABLED - IF HOLE)
ZJN SCH10 IF EMPTY CATALOG ENTRY
LMD UI+1
SHN 6
LMD UI
SCHG NJN SCH10 IF NOT SAME USER INDEX
* PSN (PRIVATE DEVICE ACCESS)
* UJN SCH10 (*UREPLAC*/*DROPIDS*, HOLE SEARCH ONLY)
RJM CCD CHECK CATALOG DATA
NJN SCH10 IF NOT SAME FILE
LJM SCH18 TERMINATE SEARCH
* SAVE ADDRESS OF DIRECT ACCESS HOLE FOR POSSIBLE FUTURE USE.
SCH11.1 LDM DAHP
SCH11.2 NJN SCH10 IF DIRECT ACCESS HOLE ALREADY FOUND
LDM P2,P1 GET START OF BUFFER
STD T0
LDD T3 SAVE OFFSET WITHIN BUFFER
SBD T0
STM DAHP+2
SOD T0
LDI T0 SAVE DIRECT ACCESS HOLE SECTOR
STM DAHP+1
SOD T0
LDI T0 SAVE DIRECT ACCESS HOLE TRACK
STM DAHP
UJN SCH11.2 ADVANCE TO NEXT CATALOG ENTRY
* CHECK HOLE FOR POSSIBILITY OF PLUG.
SCH12 LDM FCBS,T3
SHN 6
SCHH MJN SCH11.1 IF NOT IAPF HOLE
* UJN SCH16 (DAPF FILE SEARCH)
LDM FCLF+1,T3
STD T0
SBD LF+1
SCHI ZJN SCH17 IF EXACT FIT
* UJN SCH13 (*APPEND* - SEARCH FOR LARGEST HOLE)
SBK MNHS
MJN SCH15 IF NOT LARGE ENOUGH FOR FILE AND NEW HOLE
SCH13 LDD HL
SBD T0
PJN SCH15 IF NOT LARGER THAN PREVIOUS HOLE
LDD T0 SET THIS AS MAXIMUM HOLE
STD HL
* SET POINTER TO HOLE.
SCH14 AOM SCHC SET TO TOGGLE BUFFER
LDD T3 SAVE HOLE ADDRESS
STD HP
LDM P2,P1 SET HOLE BUFFER ADDRESS
STD HB
SCH15 LJM SCH10 ADVANCE TO NEXT CATALOG ENTRY
* LJM SCHX (*UREPLAC*/*DROPIDS*, EXACT FIT FOUND)
SCHJ EQU *-1
* CHECK FOR DIRECT ACCESS PURGED ENTRY.
SCH16 PJN SCH15 IF NOT DIRECT ACCESS FILE
* EXACT FIT. BYPASS REMAINDER OF HOLES.
SCH17 ISTORE SCHF,(PSN) BYPASS HOLE SEARCH
LDD T0 SET LENGTH OF HOLE
STD HL
SCHK UJN SCH14 SET POINTER TO HOLE
* PSN (*UREPLAC*/*DROPIDS*)
LDC SCHX
STM SCHJ SET HOLE SEARCH ONLY EXIT
UJN SCH14 SET POINTER TO HOLE
SHL SPACE 4,30
** SHL - SEARCH CATALOG FOR HOLE.
*
* THIS SUBROUTINE PRESETS *SCH* TO SEARCH FOR A HOLE ENTRY
* FOR A *UREPLAC* OR *DROPIDS* REQUEST.
*
* IT IS POSSIBLE THAT AT THE COMPLETION OF THE SEARCH, THE
* HOLE ENTRY AND/OR THE END OF CATALOGS WILL BE IN SAME SECTOR
* AS THE FILE CATALOG ENTRY. IF THIS SITUATION OCCURS, THE
* HOLE AND/OR END POINTERS WILL BE ADJUSTED TO POINT TO THE
* FILE ENTRY-S BUFFER (*BUF1*).
*
* ENTRY (CCIA) = CATALOG TRACK ADDRESS.
* (CB) = CATALOG BUFFER.
* (CI) = CATALOG POINTER.
* (LF - LF+1) = LENGTH OF FILE.
* (SDAA) = MASTER DEVICE EST ORDINAL.
*
* EXIT (A) = 0, IF HOLE NOT FOUND.
* (EB) = END BUFFER, IF END ENCOUNTERED.
* (EP) = END POINTER, IF END ENCOUNTERED.
* (HB) = HOLE BUFFER.
* (HL) = SIZE OF HOLE FOUND.
* (HP) = HOLE POINTER.
*
* CALLS SCH.
*
* USES EB, EP, HB, HP.
*
* MACROS ISTORE.
SHL SUBR ENTRY/EXIT
ISTORE ISPB,(UJN ISP1) BYPASS CATALOG TRACK INTERLOCK
ISTORE SCHA,(LDN 0) FORCE *ISP* CALL
LDC BFMS SET PRIMARY BUFFER POINTER
STM ISPC
ISTORE SCHF,(ZJN SCH12) ENABLE HOLE SEARCH
ISTORE SCHG,(UJN SCH10) SEARCH FOR HOLES ONLY
ISTORE SCHK,(PSN) ENABLE EXIT FOR HOLE ONLY SEARCH
RJM SCH SEARCH FOR HOLE
* CHECK IF HOLE IS IN THE SAME TRACK/SECTOR AS FILE ENTRY.
LDD HP
ZJN SHL1 IF HOLE NOT FOUND
LDM -1,CB
LMM -1,HB
NJN SHL1 IF SECTOR NOT THE SAME FOR HOLE AND FILE
LDM -2,CB
LMM -2,HB
NJN SHL1 IF TRACK NOT THE SAME FOR HOLE AND FILE
LDD CB ADJUST HOLE POINTERS TO FILE ENTRY BUFFER
SBD HB
RAD HP
LDD CB
STD HB
* CHECK IF END IS IN SAME TRACK/SECTOR AS FILE ENTRY.
SHL1 LDD EB
ZJN SHL3 IF END NOT REACHED (EXACT FIT HOLE FOUND)
LDM -1,CB
LMM -1,EB
NJN SHL3 IF SECTOR NOT THE SAME FOR END AND FILE
LDM -2,CB
LMM -2,EB
NJN SHL3 IF TRACK NOT THE SAME FOR END AND FILE
LDD EP ADJUST END POINTERS
ZJN SHL2 IF NO END POINTER (EOI)
SBD EB ADJUST END POINTER TO FILE ENTRY BUFFER
ADD CB
STD EP
SHL2 LDD CB ADJUST END BUFFER TO FILE ENTRY BUFFER
STD EB
* RETURN HOLE POINTER.
SHL3 LDD HP HOLE POINTER (IF FOUND)
LJM SHLX RETURN
TITLE SPECIAL REQUEST BLOCK CATALOG ACCESS ROUTINES.
ACE SPACE 4,30
** ACE - ACCESS CATALOG ENTRY.
*
* READ A CATALOG ENTRY AND CHECK THE FOLLOWING INFORMATION -
* COMPARE THE USER INDEX WITH (PFFM+3 - PFFM+4).
* COMPARE THE CREATION DATE AND TIME WITH (PFCD - PFCD+2).
*
* ENTRY (EQ) = MASTER DEVICE EST ORDINAL.
* (CCIA) = CATALOG TRACK TO INTERLOCK.
* (CCIB) UPDATED IF CATALOG TRACK INTERLOCK ALREADY SET.
* (PFAS) = 36/ ALTERNATE STORAGE ADDRESS.
* (PFCD) = 36/ CREATION DATE AND TIME.
* (PFFM) = 42/FAMILY,18/USER INDEX.
* (PFID) = 4/,2/PEO,6/DN,12/TRACK,12/SECTOR.
*
* EXIT CATALOG SECTOR READ.
* CATALOG TRACK INTERLOCKED.
* (CB) = BUFFER ADDRESS OF CATALOG SECTOR.
* (CI) = POINTER TO CATALOG ENTRY.
* (T5) = MASTER DEVICE EST ORDINAL.
* (T6) = CATALOG TRACK.
* (T7) = CATALOG SECTOR.
*
* CALLS ICT, IRA, PDV, PES, RDS.
*
* USES CB, CI, T1, T5, T6, T7.
*
* MACROS COMPARE, ERROR, EXIT, SETMS.
ACE SUBR ENTRY/EXIT
LDC BUF1 SET CATALOG BUFFER ADDRESS
STD CB
ADN 2 INITIALIZE *PFC* ENTRY POINTER
STD CI
LDD EQ SET MASTER DEVICE EST ORDINAL
STD T5
LDM CCIA BASE TRACK ADDRESS
STD T6
SETMS IO
RJM PDV PROCESS DEVICE STATUS
LDM CCIB CHECK CATALOG INTERLOCK FLAG
LPN 77
NJN ACE1 IF CATALOG ALREADY INTERLOCKED
LDD CC
LMN CCSP
ZJN ACE1 IF *STAGEPF* REQUEST
RJM ICT INTERLOCK CATALOG TRACK
AOM CCIB SET CATALOG TRACK INTERLOCK FLAG
ACE1 RJM IRA INITIALIZE RANDOM PROCESSORS
LDM PFID+1 SET TRACK ADDRESS FOR READ
STM -2,CB
STD T6
STM ERRC
LDM PFID+2 SET SECTOR ADDRESS FOR READ
STM -1,CB
STD T7
STM ERRD
LDD CB READ THE CATALOG SECTOR
RJM RDS
PJN ACE3 IF NO READ ERROR
RJM PES PROCESS ERROR STATUS
ACE2 ERROR MSE,,,T5 *EQXXX,DNYY, MASS STORAGE ERROR.*
* SETUP *PFC* ENTRY POINTER BASED ON THE *PEO* VALUE.
ACE3 LDM 1,CB CHECK SECTOR LENGTH
LPN NWCE-1
ZJN ACE4 IF LEGAL SECTOR LENGTH
ERROR BCS,,,T5,,EI *EQXXX,DNYY, BAD CATALOG/PERMIT SECTOR.*
ACE4 LDM PFID ISOLATE *PEO* VALUE
SHN -6
LPN 1S"NWCEM"-1
SHN NWCES FORM *PFC* BIAS
STD T1
SHN 2
ADD T1
RAD CI
LDD T1 CHECK *PEO* OFFSET
SBM 1,CB
PJN ACE5 IF INVALID *PEO* VALUE
* VERIFY *PFC* ENTRY INFORMATION.
LDM FCUI+1,CI COMPARE LSB OF USER INDEX
LMM PFFM+4
ZJN ACE6 IF MATCH
ACE5 ERROR PVE *PFC VERIFICATION ERROR.*
ACE6 LDM FCUI,CI COMPARE MSB OF USER INDEX
LMM PFFM+3
LPN 77
NJN ACE5 IF USER INDEX DOES NOT MATCH
COMPARE PFCD,FCCD CREATION DATE/TIME
NJN ACE5 IF CREATION DATE/TIME DOES NOT MATCH
LJM ACEX EXIT
COF SPACE 4,15
** COF - COMPARE FIELD OF 36 BITS.
*
* ENTRY (A) = PFC ENTRY OFFSET TO OBJECT FIELD.
* (CI) = PFC ENTRY ADDRESS.
* (T1) = SECONDARY FIELD FOR COMPARE.
*
* EXIT (A) = 0 IF FIELDS ARE THE SAME.
*
* USES T1, T2, T3.
COF SUBR ENTRY/EXIT
ADD CI SET PRIMARY COMPARE FIELD ADDRESS
STD T2
LDN 3 SET NUMBER OF WORDS TO COMPARE
STD T3
* LOOP COMPARING THE TWO FIELDS.
COF1 LDI T1 SECONDARY FIELD
LMI T2 PRIMARY FIELD
NJN COFX IF FIELDS DO NOT MATCH
AOD T1 ADVANCE SECONDARY FIELD POINTER
AOD T2 ADVANCE PRIMARY FIELD POINTER
SOD T3
ZJN COFX IF ALL FIELDS COMPARE
UJN COF1 CONTINUE FIELD COMPARE
RSC SPACE 4,10
** RSC - READ CATALOG ENTRY, SEARCH CATALOG IF NECESSARY.
*
* CALLS ACE, SCH.
*
* MACROS ERROR.
RSC SUBR ENTRY/EXIT
LDM PFRB
LPN 37
ADM PFRB+1
NJN RSC1 IF SPECIAL REQUEST BLOCK SPECIFIED
RJM SCH SEARCH CATALOG
ZJN RSCX IF FILE FOUND
ERROR FNF * (FILENAME) NOT FOUND. *
RSC1 RJM ACE ACCESS CATALOG ENTRY
UJN RSCX RETURN
RVC SPACE 4,10
** RVC - READ AND VERIFY CATALOG ENTRY.
*
* EXIT (CB) = CATALOG BUFFER.
* (CI) = CATALOG POINTER.
*
* CALLS ACE.
*
* MACROS COMPARE, ERROR.
RVC SUBR ENTRY/EXIT
RJM ACE ACCESS CATALOG ENTRY
LDM STAT
LPK STTA
NJN RVC2 IF TAPE ALTERNATE STORAGE REQUEST
* VERIFY CARTRIDGE ALTERNATE STORAGE ADDRESS.
COMPARE PFAA,FCAA VERIFY ALTERNATE STORAGE ADDRESS
NJN RVC1 IF NO MATCH ON ALTERNATE STORAGE ADDRESS
LDM PFAT VERIFY ALTERNATE STORAGE TYPE
LMM FCAT,CI
LPN 77
ZJN RVCX IF ALTERNATE STORAGE TYPES MATCH
RVC1 ERROR PVE * PFC VERIFICATION ERROR.*
* VERIFY TAPE ALTERNATE STORAGE ADDRESS.
RVC2 COMPARE PFTS+1,FCTS+1 VERIFY TAPE SEQUENCE NUMBER AND VSN
NJN RVC1 IF NO MATCH
LDM PFTS VERIFY TAPE SEQUENCE NUMBER
LMM FCTS,CI
LPN 77
NJN RVC1 IF TAPE SEQUENCE NUMBER DOES NOT MATCH
UJP RVCX RETURN
SPACE 4,10
* CHECK FOR ZERO-LEVEL OVERLAY OVERFLOW.
ERRNG *-OVL0-ZBFL *0BF* OVERFLOW
ERRNG *-OVL0-ZDFL *0DF* OVERFLOW
TITLE REQUEST PREPROCESSORS.
APP SPACE 4,10
*** APP - *APPEND* REQUEST.
APP BSS 0 ENTRY
* INITIALIZE FOR CATALOG SEARCH.
LDD LF CHECK FILE SIZE
NJN APP1 IF FILE TOO LARGE FOR HOLE
ISTORE SCHI,(UJN SCH13) SET FOR LARGEST HOLE SEARCH
ISTORE SCHF,(ZJN SCH12) SET FOR HOLE SEARCH
APP1 RJM SCH SEARCH CATALOG
ZJN APP2 IF FILE FOUND
ERROR FNF *(FILE NAME) NOT FOUND.*
* COMPUTE LENGTH OF NEW FILE.
APP2 LDD LF SAVE LENGTH OF APPENDAGE
STM APLF
LDD LF+1
STM APLF+1
LDM FCLF+1,CI CALCULATE TOTAL LENGTH OF NEW FILE
RAD LF+1
SHN -14
ADM FCLF,CI
RAD LF
SHN -5
NJN APP3 IF FILE LENGTH .GE. 131072D SECTORS
LDD LF CHECK FOR .GT. 131069D SECTORS
SHN 14
ADD LF+1
ADN 2 ADD SYSTEM AND EOI SECTORS
MJN APP3 IF FILE .GT. 131069D SECTORS
LDM MXFS
ZJN APP4 IF NO LIMIT ON FILE SIZE
LDD LF
SHN -3
NJN APP3 IF FILE SIZE .GT. MAXIMUM FILE SIZE LIMIT
LDD LF
SHN 14
ADD LF+1
ADN 7
SHN -3
SBM MXFS
MJN APP4 IF FILE NOT TOO LARGE
ZJN APP4 IF FILE NOT TOO LARGE
APP3 LDN STAB SET TO ABORT AFTER PERMISSION CHECK
RAM STAT
APP4 LDM FCBT,CI SAVE ADDRESS OF OLD FILE
STM APTK
LDM FCBS,CI
STM APSC
LDD LF
ZJN APP6 IF NEW FILE SHORT ENOUGH TO PLUG HOLE
ISTORE SCHF,(PSN) TURN OFF HOLE SEARCH
UJN APP7 CLEAR HOLE POINTERS
APP6 LDD HL CHECK SIZE OF HOLE FOUND
ZJN APP8 IF NO HOLE FOUND
SBD LF+1
ZJN APP9 IF EXACT FIT, BYPASS HOLE SEARCH
SBK MNHS
PJN APP8 IF HOLE LONG ENOUGH FOR FILE AND NEW HOLE
APP7 LDN 0 CLEAR HOLE POINTERS
STD HP
STD HB
STD HL
APP8 ISTORE SCHI,(ZJN SCH17) TURN ON SEARCH FOR EXACT FIT
RJM SCH CONTINUE SEARCH FOR BEST HOLE
NJN APP9 IF DUPLICATE FILE NOT FOUND
ERROR RPE,,,EQ *EQXXX,DNYY, REPLACE ERROR.*
* SEARCH PERMITS.
APP9 RJM CCT CHECK FOR CPU TRANSFER
RJM SDB SWAP DISK BUFFERS (IF NECESSARY)
RJM SSP SET STATISTICAL PARAMETERS
LDN 0 CLEAR PERMIT POINTERS
STD PB
STD PP
* READ PERMITS.
LDN PTAP CHECK FOR APPEND PERMISSION
RJM CPI
RJM VFI VERIFY THAT FILE IS INDIRECT ACCESS
RJM DSR DETERMINE IF FILE STAGING REQUIRED
LJM LCO CALL OVERLAY
ATT SPACE 4,10
*** ATT - *ATTACH* REQUEST.
ATT BSS 0 ENTRY
RJM SCH SEARCH CATALOG
ZJN ATT2 IF FILE FOUND
ERROR FNF *(FILE NAME) NOT FOUND.*
* VERIFY PERMISSIONS FOR ACCESS.
ATT2 LDM MODE
RJM CPI
LDM FCBS,CI CHECK FILE TYPE
SHN 21-13
MJN ATT3 IF DIRECT ACCESS FILE
ERROR FIA *(FILE NAME) IS INDIRECT ACCESS.*
ATT3 RJM DSR DETERMINE IF FILE STAGING IS REQUIRED
LJM LCO CALL OVERLAY
CHG SPACE 4,10
*** CHG - *CHANGE* REQUEST.
CHG BSS 0 ENTRY
LJM LCO CALL OVERLAY
DDS SPACE 4,10
*** DDS - *DROPDS* REQUEST.
DDS BSS 0 ENTRY
RJM RSC READ CATALOG ENTRY, SEARCH IF NECESSARY
LDM FCBT,CI
NJN DDS1 IF FILE DISK RESIDENT
ENDMS
EXECUTE 3PU TERMINATE *PFM*
DDS1 LDM FCBS,CI
SHN 21-13
MJN DDS2 IF DIRECT ACCESS FILE
LDN CCDI PROCESS AS *DROPIDS* REQUEST
STD CC
LDC PRDI SET REQUEST PROCESSOR ADDRESS
STM LCOA
LDC OVDI SET OVERLAY INTO *EXECUTE* MACRO
STM LCOB
LJM DIS2 PROCESS AS *DROPIDS* REQUEST
DDS2 LJM LCO LOAD OVERLAY
DIS SPACE 4,10
*** DIS - *DROPIDS* REQUEST.
DIS BSS 0 ENTRY
RJM RSC READ CATALOG ENTRY, SEARCH IF NECESSARY
LDM FCBT,CI
NJN DIS1 IF FILE DISK RESIDENT
ENDMS
EXECUTE 3PU TERMINATE *PFM*
DIS1 LDM FCBS,CI
SHN 21-13
PJN DIS2 IF INDIRECT ACCESS FILE
LDN CCDD PROCESS AS *DROPDS* REQUEST
STD CC
LDC PRDD SET REQUEST PROCESSOR ADDRESS
STM LCOA
LDC OVDD SET OVERLAY INTO *EXECUTE* MACRO
STM LCOB
UJN DDS2 PROCESS AS *DROPDS* REQUEST
DIS2 ISTORE SCHH,(UJN SCH16) SEARCH ONLY DAPF HOLES
RJM SHL SEARCH CATALOG FOR DAPF HOLE
ZJN DIS3 IF DELETED DAPF HOLE NOT FOUND
LDN 0 CLEAR DAPF HOLE INDICATOR
STM FCBS,HP
STM FCBT,HP CLEAR TRACK
DIS3 LJM LCO CALL OVERLAY
DEF SPACE 4,10
*** DEF - *DEFINE* REQUEST.
DEF BSS 0 ENTRY
ISTORE SCHF,(ZJN SCH12) SET TO SEARCH FOR HOLES
ISTORE SCHH,(UJN SCH16) SEARCH FOR DIRECT ACCESS HOLES ONLY
LDC BFMS SET ADDRESS OF CATALOG SEARCH BUFFER
STM ISPA
DEF1 LDD FS SET EST ORDINAL
STD T5
RJM IRA INITIALIZE RANDOM ACCESS PROCESSORS
LDM SDAB SET FIRST SECTOR
STD T6
RJM SEI DETERMINE FILE SECTOR SIZE
LDD T2 PRESERVE SECTOR SIZE
STD LF
LDD T3
STD LF+1
LDD CC
LMN CCSD
ZJN DEF2 IF *SETDA* REQUEST
RJM SCH SEARCH CATALOG
NJN DEF3 IF NO FILE FOUND
ERROR FAP *(FILE NAME) ALREADY PERMANENT.*
* PROCESS *SETDA* REQUEST.
DEF2 RJM RVC READ AND VERIFY CATALOG ENTRY
DEF3 LJM LCO CALL OVERLAY
DPF SPACE 4,10
*** DPF - *DELPFC* REQUEST.
DPF BSS 0 ENTRY
LDC IFUI SET *IFUI* USER INDEX INTO SRB
STM PFFM+4
LDM PFFM+3
SCN 77
LMN IFUI/10000B
STM PFFM+3
RJM ACE ACCESS CATALOG ENTRY
LJM LCO LOAD COMMAND OVERLAY
GET SPACE 4,10
*** GET - *GET* REQUEST.
GET BSS 0 ENTRY
RJM SCH SEARCH CATALOG
ZJN GET1 IF FILE FOUND
ERROR FNF *(FILENAME) NOT FOUND.*
GET1 LDM FCLF,CI SET FILE LENGTH
STD LF
LDM FCLF+1,CI
STD LF+1
RJM CCT CHECK FOR CPU TRANSFER
LDN PTEX EXECUTE MODE REQUIRED FOR *GET*
RJM CPI CHECK PERMISSION INFORMATION
STM ACCM SAVE ACTUAL ACCESS MODE
RJM VFI VERIFY THAT FILE IS INDIRECT ACCESS
RJM DSR DETERMINE IF FILE STAGING REQUIRED
LJM LCO CALL OVERLAY
OLD SPACE 4,10
*** OLD - *OLD* REQUEST.
OLD EQU GET USE *GET* PRESET FOR *OLD* REQUEST
PER SPACE 4,10
*** PER - *PERMIT* REQUEST.
PER BSS 0 ENTRY
ISTORE CCDA,(UJN CCD4) SET BYPASS OF PASSWORD CHECK
RJM SCH SEARCH CATALOG
ZJN PER2 IF FILE FOUND
ERROR FNF * (FILENAME) NOT FOUND.*
PER2 LDD MA SET USER NAME
CWM PFOU,ON
SBN 1
CRM PFAC,ON
LDN 0 CLEAR PERMIT POINTER
STD PP
LDC BFMS SET PERMIT BUFFER ADDRESS
STD PB
LDM FCRI,CI SET PERMIT RANDOM INDEX
STD RI
LDM FCRI+1,CI
STD RI+1
ADD RI
ZJN PER4 IF NO PERMIT DATA AVAILABLE
RJM SPI SEARCH PERMIT INFORMATION
PER4 LJM LCO CALL OVERLAY
PUR SPACE 4,10
*** PUR - *PURGE* REQUEST.
PUR BSS 0 ENTRY
RJM RSC READ CATALOG ENTRY, SEARCH IF NECESSARY
LDM PFRB
LPN 37
ADM PFRB+1
NJN PUR1 IF SPECIAL REQUEST BLOCK SPECIFIED
LDN PTWR WRITE PERMISSON NEEDED FOR PURGE
RJM CPI CHECK PERMISSION INFORMATION
PUR1 LJM LCO CALL OVERLAY
REP SPACE 4,10
*** REP - *REPLACE* REQUEST.
REP BSS 0 ENTRY
LDD LF
NJN REP1 IF FILE LARGER THAN HOLES
ISTORE SCHF,(ZJN SCH12) SET TO SEARCH FOR HOLES
REP1 RJM SCH SEARCH FOR CATALOG ENTRY
ZJP REP5 IF FILE IS FOUND
LDD CP CHECK USER VALIDATION
ADK AACW
CRD CM
LDD CM+4
SHN 21-3
PJN REP2 IF USER MAY NOT CREATE INDIRECT FILES
SHN 21-10-21+3+22
MJN REP3 IF USER MAY ACCESS AUXILIARY DEVICE
LDM PFPN
ZJN REP3 IF AUXILIARY DEVICE NOT SPECIFIED
REP2 ERROR IUA *USER ACCESS NOT VALID.*
REP3 LDD PI CHECK FOR ALTERNATE CATALOG ACCESS
ADD PI+1
ZJN REP4 IF NOT ALTERNATE CATALOG ACCESS
ERROR FNF *(FILE NAME) NOT FOUND.*
REP4 LDC PRSV PROCESS AS *SAVE* REQUEST
STM LCOA SET PROCESSOR ADDRESS
LDC OVSV
STM LCOB SET OVERLAY NAME FOR *SAVE* REQUEST
LJM SAV2 PROCESS REQUEST AS *SAVE*
REP5 LDN 0 SET ENTRY AS HOLE
STM FCUI,CI
STM FCUI+1,CI
LDM FCBT,CI FIRST TRACK OF FILE
ZJN REP7 IF FILE NOT DISK RESIDENT
* CHECK SIZE OF HOLE CREATED BY REPLACE.
LDM FCLF,CI
SBD LF
SHN 14
ADM FCLF+1,CI
SBD LF+1
NJN REP6 IF NOT EXACT FIT
LDD CI SET THIS ENTRY AS HOLE FOUND
STD HP
LDD CB
STD HB
LDD LF+1
STD HL
UJN REP8 BYPASS HOLE SEARCH
REP6 LDM FCLF,CI CHECK LENGTH OF FILE BEING REPLACED
NJN REP7 IF FILE TOO LONG TO BE USED AS HOLE
LDC SCH11 INCLUDE THIS FILE IN HOLE SEARCH
STM SCHB
REP7 RJM SCH CONTINUE SEARCH FOR BEST HOLE
NJN REP8 IF DUPLICATE FILE NOT FOUND
ERROR RPE,,,EQ *EQXXX,DNYY, REPLACE ERROR.*
* SEARCH PERMITS.
REP8 RJM CCT CHECK FOR CPU TRANSFER
RJM SDB SWAP DISK BUFFERS (IF NECESSARY)
RJM SSP SET STATISTICAL PARAMETERS
LDN 0 CLEAR PERMIT POINTERS
STD PB
STD PP
LDN PTWR CHECK FOR WRITE PERMISSION
RJM CPI CHECK PERMISSION INFORMATION
LJM LCO CALL OVERLAY
SAA SPACE 4,10
*** SAA - *SETASA* REQUEST.
SAA BSS 0 ENTRY
RJM ACE ACCESS CATALOG ENTRY
LJM LCO CALL OVERLAY
SAC SPACE 4,10
*** SAC - *SETPFAC* REQUEST.
SAC EQU CHG USE *CHANGE* PRESET FOR *SETPFAC* REQUEST
SAF SPACE 4,10
*** SAF - *SETAF* REQUEST.
SAF BSS 0 ENTRY
RJM RVC READ AND VERIFY CATALOG ENTRY
LJM LCO CALL OVERLAY
SAL SPACE 4,10
*** SAL - *SETPFAL* REQUEST.
SAL EQU CHG USE *CHANGE* PRESET FOR *SETPFAL* REQUEST
SAV SPACE 4,10
*** SAV - *SAVE* REQUEST.
SAV BSS 0 ENTRY
LDD LF
NJN SAV1 IF FILE LARGER THAN HOLES
ISTORE SCHF,(ZJN SCH12) SET TO SEARCH FOR HOLES
SAV1 RJM SCH SEARCH FOR CATALOG ENTRY
NJN SAV2 IF FILE NOT FOUND
ERROR FAP *FILE ALREADY PERMANENT.*
SAV2 AOD NF+1 ADVANCE FILE COUNT FOR NEW FILE
SHN -14
RAD NF
RJM SSP SET STATISTICAL PARAMETERS
SAV3 RJM CCT CHECK FOR CPU TRANSFER
LJM LCO CALL OVERLAY
SDA SPACE 4,10
*** SDA - *SETDA* REQUEST.
SDA EQU DEF1 USE *DEFINE* PRESET FOR *SETDA* REQUEST
SPF SPACE 4,10
*** SPF - *STAGEPF* REQUEST.
SPF BSS 0 ENTRY
RJM ACE ACCESS CATALOG ENTRY
LDM FCBT,CI
NJN SPF1 IF FILE ALREADY DISK RESIDENT
LJM LCO LOAD COMMAND OVERLAY
SPF1 ENDMS
EXECUTE 3PU TERMINATE *PFM*
UAT SPACE 4,10
*** UAT - *UATTACH* REQUEST.
UAT BSS 0 ENTRY
RJM RSC READ CATALOG ENTRY, SEARCH IF NECESSARY
LDM FCBS,CI
SHN 21-13
MJN UAT2 IF DIRECT ACCESS FILE
ERROR FIA *FILE IS INDIRECT ACCESS.*
UAT2 LDM FCBT,CI
NJP LCO IF FILE DISK RESIDENT
ERROR FND *FILE NOT DISK RESIDENT.*
UGT SPACE 4,10
*** UGT - *UGET* REQUEST.
UGT BSS 0 ENTRY
RJM RSC READ CATALOG ENTRY, SEARCH IF NECESSARY
UJN LCO CALL OVERLAY
URE SPACE 4,10
*** URE - *UREPLAC* REQUEST.
URE BSS 0 ENTRY
RJM RVC READ AND VERIFY CATALOG ENTRY
LDD CI SAVE PFC ADDRESS
STM PFCA
ADN FCFN SET FILE NAME TO CURRENT PFN
RJM SFN
RJM VFI VERIFY THAT FILE IS INDIRECT ACCESS
LDM FCBT,CI
ZJN URE2 IF NOT DISK RESIDENT
ERROR ICU * INVALID CATALOG UPDATE.*
URE2 LDD LF
NJN URE3 IF FILE LONGER THAN LARGEST HOLE
RJM SHL SEARCH CATALOG FOR HOLE
RJM SDB SWAP DISK BUFFERS
URE3 UJN LCO CALL OVERLAY
TITLE LOAD OVERLAY PROCESSOR.
LCO SPACE 4,10
** LCO - LOAD COMMAND OVERLAY.
*
* EXIT TO COMMAND OVERLAY.
*
* MACROS ENDMS, EXECUTE.
LCO BSS 0 ENTRY
ENDMS RELEASE MASTER DEVICE CHANNEL
LDC * SET COMMAND PROCESSING ADDRESS
LCOA EQU *-1 (PROCESSING ADDRESS WITHIN OVERLAY)
STD P0
LCOB EQU *+1 (LAST TWO CHARACTERS OF OVERLAY NAME)
EXECUTE 3PF *GET*/*OLD*/*UGET*
EXECUTE 3PG,= *SAVE*/*REPLACE*/*UREPLAC*
EXECUTE 3PH,= *APPEND*
EXECUTE 3PI,= *ATTACH*/*UATTACH*
EXECUTE 3PK,= *DEFINE*/*SETDA*
EXECUTE 3PL,= *DROPDS*/*PURGE*
EXECUTE 3PM,= *DELPFC*/*DROPIDS*/*PERMIT*
EXECUTE 3PN,= *CHANGE*/*SETPFAC*/*SETPFAL*
EXECUTE 3PO,= *SETASA*/*SETAF*
EXECUTE 3PR,= STAGE FILE FROM ALTERNATE STORAGE
TITLE INITIALIZATION SUBROUTINES.
CCT SPACE 4,15
** CCT - CHECK FOR CPU TRANSFER.
*
* ENTRY (LF - LF+1) = FILE LENGTH + 1.
*
* EXIT (CPTF) = NONZERO IF CPU SHOULD BE USED FOR TRANSFER.
* (FA) = FNT ADDRESS FOR LOCAL FILE.
* (FN - FN+4) = PERMANENT FILE NAME.
* (FS - FS+4) = FST ENTRY FOR LOCAL FILE.
*
* USES FA, CM - CM+4, FS - FS+4.
*
* CALLS CLF, RMD, SFN.
*
* MACROS ENDMS.
CCT SUBR ENTRY/EXIT
* CHECK IF CALLER IS *DMP=*, SUBSYSTEM OR UCP.
LDD CP
ADK SPCW
CRD CM
LDD CM+1
SCN 77
ADD CM
NJN CCTX IF *DMP=* PROGRAM IN PROGRESS
LDD CP
ADK JCIW
CRD CM
LDD CM+2
SBK LSSI
PJN CCTX IF CALLER IS A SUBSYSTEM
LDD CP
ADK SSCW
CRD CM
LDD CM
ADD CM+1
ADD CM+2
ADD CM+3
ADD CM+4
NJN CCTX IF CALLER IS A UCP
* CHECK IF FILE SIZE .GE. THRESHOLD.
LDK PFNL CHECK CPU TRANSFER THRESHOLD
CRD CM
LDD CM+4
ZJN CCTX IF CPU TRANSFER DISABLED
SBD LF+1
SBN 1
MJN CCT1 IF FILE LONG ENOUGH
LDD LF
ZJP CCTX IF FILE NOT LONG ENOUGH
* SET UP FOR CPU TRANSFER.
CCT1 ENDMS RELEASE CHANNEL
AOM CPTF SET *CPU TRANSFER* FLAG
LDC CCTA CREATE LOCAL FILE /PFM*PFN/
RJM CLF
STM FNTB SAVE FNT ADDRESS
LDC CCTB CREATE LOCAL FILE /PFM*ILK/
RJM CLF
STM FNTC SAVE FNT ADDRESS
LDD CC
LMN CCAP
NJN CCT2 IF NOT *APPEND* REQUEST
LDC CCTC CREATE LOCAL FILE /PFM*APF/
RJM CLF
STM FNTD SAVE FNT ADDRESS
* RESET LOCAL FILE PARAMETERS AND MASTER DEVICE DRIVER.
CCT2 LDM FNTA RESET FNT ADDRESS
STD FA
NFA FA,R REREAD FST
ADN FSTL
CRD FS
LDM PFFN RESET PERMANENT FILE NAME
ZJN CCT3 IF PFN NOT SPECIFIED, USE LFN
LDN PFFN-PFSN
CCT3 ADC PFSN
RJM SFN SET FILE NAME
RJM RMD RESET TO MASTER DEVICE
UJP CCTX RETURN
CCTA VFD 60/7L"PFN"
CCTB VFD 60/7L"ILK"
CCTC VFD 60/7L"APF"
CLF SPACE 4,20
** CLF - CREATE LOCAL FILE.
*
* CREATE AN FNT ENTRY FOR THE SPECIFIED LOCAL FILE,
* USING ONE OF THE SPECIAL RESERVED FNT ENTRIES.
* IF THE SPECIFIED LOCAL FILE IS ALREADY ASSIGNED TO
* THE JOB, RETURN THE FILE AND THEN CREATE A NEW FILE.
* IF A RESERVED FNT ENTRY WAS NOT FOUND, HANG.
*
* ENTRY (A) = ADDRESS OF FILE NAME.
*
* EXIT (A) = (FA) = FNT ADDRESS OF FILE.
* TO *HNG* IF RESERVED FNT ENTRY NOT FOUND.
*
* USES FS, FN - FN+4.
*
* CALLS *0BF*, *0DF*.
*
* MACROS EXECUTE, MONITOR.
CLF SUBR ENTRY/EXIT
STM CLFA SET FILE NAME ADDRESS
CLF1 LDD MA
CWM *,ON
CLFA EQU *-1
SBN 1
CRD FN SET FILE NAME
LDN 45 USE RESERVED FNT, RETURN ON FILE NOT MADE
STM OVL0-1
LDK NEEQ
STD FS
EXECUTE 0BF,OVL0 CREATE FILE
UJN CLF2 IF FILE NOT ALREADY ASSIGNED
* IF FILE ALREADY ASSIGNED, RETURN FILE.
LDN 1 *UNLOAD* EXISTING FILE
STM OVL0-1
EXECUTE 0DF,OVL0
UJN CLF1 CREATE NEW FILE
* CHECK FOR SUCCESSFUL FILE CREATION.
CLF2 NJN CLF3 IF FILE NOT CREATED
LDD FA
LJM CLFX RETURN
* HANG IF RESERVED FNT ENTRY NOT FOUND.
CLF3 RJM HNG HANG
DSR SPACE 4,15
** DSR - DETERMINE IF FILE STAGING REQUIRED.
*
* ENTRY (CB) = CATALOG BUFFER ADDRESS.
* (CI) = CATALOG ENTRY POINTER.
*
* EXIT (LCOB) = *3PR*, IF STAGING REQUIRED.
*
* USES CM - CM+4.
*
* CALLS MCB.
*
* MACROS EXECUTE.
DSR SUBR ENTRY/EXIT
LDK SSTL GET FILE STAGING DISABLED STATUS
CRD CM
LDD CM
SHN 21-3
MJN DSR1 IF CARTRIDGE PF STAGING DISABLED
LDM FCAF,CI CHECK PSEUDO RELEASE FLAG
SHN 21-3
PJN DSR1 IF PSEUDO RELEASE NOT SET
SHN 21-0-21+3
PJN DSR2 IF CARTRIDGE COPY NOT OBSOLETE
DSR1 LDM FCBT,CI FIRST TRACK OF FILE
NJN DSRX IF FILE DISK RESIDENT
DSR2 EXECUTE 3PR,* STAGE FILE FROM TAPE OR CARTRIDGE
STM LCOB
RJM MCB MOVE CATALOG BUFFER (IF NECESSARY)
UJN DSRX RETURN
MCB SPACE 4,15
** MCB - MOVE CATALOG BUFFER.
*
* MOVE THE CATALOG BUFFER INTO *BUF1*, IF THE CATALOG BUFFER
* IS CURRENTLY IN *BUF2*. THIS IS DONE TO ALLOW MORE SPACE
* FOR OVERLAY *3PR*. SINCE THE FILE MUST BE STAGED, NO OTHER
* BUFFERS ARE REQUIRED FOR THE CURRENT INVOCATION OF *PFM*.
*
* ENTRY (CB) = CATALOG BUFFER ADDRESS.
* (CI) = CATALOG ENTRY POINTER.
*
* EXIT CATALOG BUFFER COPIED INTO *BUF1*, IF NECESSARY.
* (CB), (CI) UPDATED.
*
* USES CB, CI, T1.
MCB SUBR ENTRY/EXIT
LDD CB CHECK CATALOG BUFFER ADDRESS
LMC BUF2
NJN MCBX IF CATALOG BUFFER IS NOT IN *BUF2*
LDC 501 SET BYTE COUNT
STD T1
MCB1 LDM BUF2-2,T1 MOVE NEXT BYTE
STM BUF1-2,T1
SOD T1
PJN MCB1 IF MORE BYTES TO MOVE
LDC BUF1-BUF2 ADJUST CATALOG ENTRY POINTER
RAD CI
LDC BUF1 RESET CATALOG BUFFER POINTER
STD CB
UJN MCBX RETURN
SDB SPACE 4,20
** SDB - SWAP DISK BUFFERS.
*
* SWAP THE *END* BUFFER WITH THE *BFMS* BUFFER, IF THE HOLE
* BUFFER IS IN *BFMS*. THIS IS DONE SO THAT *BFMS* CAN BE
* REUSED FOR PERMITS (IF NECESSARY), AND LATER REREAD IF THE
* END BUFFER IS NEEDED. THIS ALSO ALLOWS *REB* TO LATER READ
* THE DAPF HOLE ENTRY (IF PRESENT) INTO *BFMS*, AND TO THEN
* DESIGNATE *BFMS* AS THE END BUFFER. THE VARIOUS POINTERS
* AND DISK ADDRESSES ASSOCIATED WITH THE BUFFERS ARE ALSO
* SWAPPED.
*
* ENTRY (CB) = ADDRESS OF CATALOG BUFFER.
* (EB) = ADDRESS OF BUFFER CONTAINING END OF CATALOGS.
* (EP) = POINTER TO NEXT PFC SLOT AVAILABLE FOR USE.
* (HB) = ADDRESS OF HOLE BUFFER, IF ANY.
* (HP) = POINTER TO HOLE ENTRY, IF ANY.
*
* EXIT (EBSC) = END BUFFER SECTOR, IF BUFFER IS IN *BFMS*.
* (EBTK) = END BUFFER TRACK, IF BUFFER IS IN *BFMS*.
* BUFFERS SWAPPED.
* BUFFER ADDRESSES AND POINTERS RESET.
*
* USES EB, EP, HB, HP, T1, T2, T3.
SDB5 LDD EB
LMC BFMS
NJN SDBX IF END BUFFER IS NOT IN *BFMS*
LDM BFMS-2 INDICATE THAT END BUFFER IS IN *BFMS*
STM EBTK
LDM BFMS-1
STM EBSC
SDB SUBR ENTRY/EXIT
LDD HP
ZJN SDBX IF NO HOLE FOUND
LDD HB
LMC BFMS
NJN SDB5 IF HOLE NOT IN *BFMS*
* DETERMINE WHICH BUFFER TO SWAP.
LDD CB
LMC BUF1
ZJN SDB1 IF CATALOG IS IN *BUF1*
LDC BUF1-BUF2 SWAP *BFMS* WITH *BUF1*
SDB1 ADC BUF2 SWAP *BFMS* WITH *BUF2*
STD T1 SET BUFFER ADDRESSES
SBN 2
STM SDBA
STM SDBB
LDC 503B MOVE BUFFER PLUS DISK ADDRESS
STD T2
* SWAP BUFFERS.
SDB2 LDM BFMS-2,T2 SWAP ONE PAIR OF BYTES
STD T3
LDM *-2,T2
SDBA EQU *-1 (ADDRESS OF BUFFER - 2)
STM BFMS-2,T2
LDD T3
STM *-2,T2
SDBB EQU *-1 (ADDRESS OF BUFFER - 2)
SOD T2
PJN SDB2 IF MORE BYTES TO SWAP
* RESET POINTERS TO BUFFERS WHICH HAVE BEEN MOVED.
LDD T1 RESET HOLE POINTERS
SBD HB
RAD HP
LDD T1
STD HB
LDD EB
LMD T1
NJN SDB3 IF END OF CATALOGS IS IN HOLE BUFFER
LDC BFMS RESET END POINTERS TO POINT TO *BFMS*
STD T1
SDB3 LDD EP RESET END POINTERS
ZJN SDB4 IF END SECTOR IS EOI
SBD EB
ADD T1
STD EP
SDB4 LDD T1
STD EB
UJP SDB5 RETURN
SSP SPACE 4,10
** SSP - SET STATISTICAL PARAMETERS.
*
* ENTRY (NF - NF+1) = NUMBER OF FILES.
* (CS - CS+1) = CUMULATIVE SIZE OF INDIRECT FILES.
*
* EXIT (ACNF - ACNF+1) SET WITH NUMBER OF FILE.
* (CIFS - CIFS+1) SET WITH CUMULATIVE SIZE OF FILES.
SSP SUBR ENTRY/EXIT
LDD CS
STM CIFS
LDD CS+1
STM CIFS+1
LDD NF
STM ACNF
LDD NF+1
STM ACNF+1
UJN SSPX EXIT
VFI SPACE 4,10
** VFI - VERIFY THAT FILE IS INDIRECT ACCESS.
*
* EXIT TO *ERR* IF FILE IS DIRECT ACCESS.
*
* MACROS ERROR.
VFI SUBR ENTRY/EXIT
LDM FCBS,CI CHECK FILE TYPE
SHN 21-13
PJN VFIX IF INDIRECT ACCESS FILE
ERROR FDA *(FILE NAME) IS DIRECT ACCESS.*
SPACE 4,10
* CHECK FOR OVERFLOW.
USE OVERFLOW
ERRNG BUF2-2-* OVERFLOW INTO CATALOG/PERMIT BUFFER
TITLE OVERLAYABLE INITIALIZATION ROUTINES.
IRP SPACE 4,25
*** INITIAL REQUEST PROCESSING.
*
* CALL REQUEST PREPROCESSOR TO PERFORM CATALOG AND
* PERMIT SEARCH, BEFORE CALLING COMMAND OVERLAY.
*
* ENTRY (CC) = COMMAND CODE.
* (DVLW - DVLW+4) = DEVICE LAYOUT WORD OF MST.
* (MSTA) = MST ADDRESS/10B.
* (PFOU) = OPTIONAL USER NAME
* (PFPN) = OPTIONAL PACK NAME.
*
* EXIT TO COMMAND PROCESSOR AS SPECIFIED BY (CC).
* (CCDA) = CHANGED IF PASSWORD CHECKING IS NOT NEEDED.
* (CCDB) = *PSN* SET IF ACCUMULATION REQUIRED.
* (CCDC) = CHANGED IF SECURITY ACCESS VIOLATION.
* (DVLW) = DEVICE LAYOUT WORD OF MASTER DEVICE FROM MST.
* (LCOA) = COMMAND OVERLAY PROCESSOR ADDRESS.
* (LCOB) = COMMAND OVERLAY NAME.
* (SCHG) = BYPASS SET IF USER INDEX CHECK IS NOT NEEDED.
* THE FOLLOWING SEARCH POINTERS ARE INITIALIZED.
* (HL, PB, PP, CS, CS+1, HB, HP, CB, CI, EP)
*
* USES T1, CM - CM+4.
*
* CALLS RMD.
IRP BSS 0 ENTRY
* INITIALIZE CATALOG SEARCH ROUTINES.
LDM PFOU
NJN IRP1 IF ALTERNATE USER NAME SPECIFIED
ISTORE CCDA,(UJN CCD4) SET BYPASS OF PASSWORD CHECK
ISTORE CCDC,(NJN CCD9) SET SECURITY VIOLATION PROCESSING
IRP1 LDM STAT CHECK FOR SEARCH STATISTICS REQUIRED
LPK STAC
ZJN IRP2 IF ACCUMULATION NOT REQUIRED
ISTORE CCDB,(PSN) SET ACCUMULATION REQUIRED
* INITIALIZE FOR DEVICE ACCESS.
IRP2 RJM RMD SET DRIVER FOR MASTER DEVICE
LDM MSTA READ MST DEVICE LAYOUT WORD
SHN 3
ADN ALGL
CRM DVLW,ON
LDM STAT CHECK FOR PRIVATE DEVICE
LPK STPD
ZJN IRP3 IF NOT PRIVATE DEVICE
ISTORE SCHG,(PSN) SET BYPASS OF USER INDEX CHECK
* INITIALIZE SEARCH POINTERS.
IRP3 LDN 0 CLEAR DIRECT CELLS
STD HL LENGTH OF HOLE
STD PB POINTER TO PERMIT BUFFER
STD PP INDEX TO PERMIT BUFFER
STD CS CUMULATIVE SIZE OF FILES IN CATALOG
STD CS+1
LDN ZERL CLEAR CONTIGUOUS STORAGE
CRD HB
ERRNZ HP-HB-1 DIRECT CELLS NOT CONTIGUOUS
ERRNZ CB-HP-1 DIRECT CELLS NOT CONTIGUOUS
ERRNZ CI-CB-1 DIRECT CELLS NOT CONTIGUOUS
ERRNZ EP-CI-1 DIRECT CELLS NOT CONTIGUOUS
* EXIT TO REQUEST PREPROCESSOR.
LDD CC INDEX INTO *TCMD* TABLE
SHN 1
ADD CC
STD T1
LDM TCMD+2,T1 SET OVERLAY NAME INTO *EXECUTE* MACRO
STM LCOB
LDM TCMD+1,T1 SET REQUEST PROCESSOR ENTRY ADDRESS
STM LCOA
LDM TCMD,T1 SET REQUEST PREPROCESSOR ADDRESS
STD T1
LJM 0,T1 EXIT TO REQUEST PREPROCESSOR
CMD SPACE 4,15
** CMD - CREATE *TCMD* TABLE ENTRIES.
*
* *CMD* CREATES THE THREE-WORD *TCMD* ENTRIES AND DEFINES
* THE SYMBOLS *OVXX* AND *PRXX*, THE OVERLAY SUFFIX AND REQUEST
* PROCESSOR ENTRY ADDRESS, RESPECTIVELY, FOR FUNCTION XX.
* *XX* IS THE APPROPRIATE LAST TWO CHARACTERS OF THE COMMAND
* CODE SYMBOL *CCXX*.
*
* CC CMD PPR,PRO
*
* CC COMMAND CODE SUFFIX
* PPR PREPROCESSOR ADDRESS. IF OMITTED, A ZERO ENTRY IS
* CREATED.
* PRO REQUEST PROCESSOR ENTRY ADDRESS IN THE FORM /3PX/ADDR.
MACRO CMD,C,PPR,PRO
ERRNZ *-3*//CC_C TABLE ENTRY OUT OF ORDER
.A IFC EQ,$PPR$$
CON 0,0,0
.A ELSE
.1 MICRO 2,2,PRO//
CON PPR,PRO,2R".1"
OV_C EQU 2R".1"
CMD RMT
PR_C EQU PRO
RMT
.A ENDIF
ENDM
TCMD SPACE 4,10
** TCMD - TABLE OF COMMAND PROCESSOR ADDRESSES.
*
* *TCMD* IS CREATED BY THE *CMD* MACRO.
*
* FIRST BYTE IS PREPROCESSOR ADDRESS IN *3PC*.
* SECOND BYTE IS PROCESSOR ADDRESS IN COMMAND OVERLAY.
* THIRD BYTE IS SUFFIX FOR COMMAND OVERLAY NAME.
TCMD EQU *-3 COMMAND CODE ADDRESS TABLE
LOC 3
SV CMD SAV,/3PG/SAV *SAVE*
GT CMD GET,/3PF/GET *GET*
PG CMD PUR,/3PL/PUR *PURGE*
CT CMD *CATLIST*
PM CMD PER,/3PM/PER *PERMIT*
RP CMD REP,/3PG/REP *REPLACE*
AP CMD APP,/3PH/APP *APPEND*
DF CMD DEF,/3PK/DEF *DEFINE*
AT CMD ATT,/3PI/ATT *ATTACH*
CG CMD CHG,/3PN/CHG *CHANGE*
UA CMD UAT,/3PI/UAT *UATTACH*
SA CMD SAA,/3PO/SAA *SETASA*
AF CMD SAF,/3PO/SAF *SETAF*
SD CMD SDA,/3PK/SDA *SETDA*
DD CMD DDS,/3PL/DDS *DROPDS*
AN CMD *ASSIGNPF*
OD CMD OLD,/3PF/OLD *OLD*
AC CMD SAC,/3PN/CHG *SETPFAC*
AL CMD SAL,/3PN/CHG *SETPFAL*
UG CMD UGT,/3PF/UGT *UGET*
UR CMD URE,/3PG/URE *UREPLAC*
DI CMD DIS,/3PM/DIS *DROPIDS*
DP CMD DPF,/3PM/DPF *DELPFC*
RS CMD *RPFSTAT*
SP CMD SPF,/3PR/SPF *STAGEPF*
LOC *O
OVERFLOW OVLA,EPFW
EJECT
* EQUIVALENCE EXTERNALLY REFERENCED TAGS.
QUAL *
CAI EQU /".O"/CAI
CSA EQU /".O"/CSA
CTI EQU /".O"/CTI
DPR EQU /".O"/DPR
DTK EQU /".O"/DTK
IRA EQU /".O"/IRA
ITC EQU /".O"/ITC
MSRA EQU /".O"/MSRA
RMD EQU /".O"/RMD
RNS EQU /".O"/RNS
SNT EQU /".O"/SNT
SNTA EQU /".O"/SNTA
STI EQU /".O"/STI
UCE EQU /".O"/UCE
UCE3 EQU /".O"/UCE3
UCE4 EQU /".O"/UCE4
UCEA EQU /".O"/UCEA
UCEB EQU /".O"/UCEB
UCEC EQU /".O"/UCEC
WBI EQU /".O"/WBI
LOCG EQU /".O"/LOCG
OVLC EQU /".O"/OVLC
OVLU EQU /".O"/OVLU
OVERLAY (CATALOG UPDATE ROUTINES.),OVLU
OVL SPACE 4,10
*** THIS OVERLAY CONTAINS SUBROUTINES USED BY THE COMMAND
* OVERLAYS TO UPDATE THE PERMANENT FILE CATALOG.
OVL BSS 0 ENTRY
RJM RMD RESET TO MASTER DEVICE
LDM DVLW+1 PRESET FIRST TRACK FIELD IN EOI BUFFER
STM EOIFS+1
LDN PDTL PRESET DATE/TIME FIELD IN EOI BUFFER
CRM EOIDT,ON
LDM PUCW
SHN 21-13
PJN OVL1 IF NO USER CONTROL WORD SPECIFIED
LDN PSNI FORCE UPDATE OF USER CONTROL WORD
STM FCEG
OVL1 LDM PFPW
ZJN OVL2 IF PASSWORD NOT SPECIFIED
LDN PSNI FORCE UPDATE OF PASSWORD
STM FCEH
OVL2 UJN ".Q"X RETURN AFTER LOAD
TITLE ALLOCATION ROUTINES.
ACS SPACE 4,25
** ACS - ALLOCATE CATALOG SPACE.
*
* ENTRY (T5) = (EQ) = MASTER DEVICE EST ORDINAL.
* (EB) = POINTER TO END BUFFER.
* (DVLW - DVLW+4) = DEVICE LAYOUT WORD OF MST.
* (FS) = EST ORDINAL FOR FILE.
* (FS+1) = FIRST TRACK OF FILE.
* (SDAC) = FIRST SECTOR OF FILE ,(4XXX) FOR DA FILE.
*
* EXIT NEXT SECTOR ALLOCATED FOR CATALOGS.
* NEW CATALOG BUFFER CLEARED.
* ADDRESS SET IN 2 LOCATIONS PRECEEDING BUFFER.
* (EP) = ADDRESS OF NEXT AVAILABLE ENTRY IN BUFFER.
* LINKAGE SET IN BUFFER.
* OVERFLOW BIT SET IN MST IF NEW TRACK ALLOCATED.
* TO *HNG* IF LABEL TRACK NOT RESERVED.
*
* USES EP, T1, T5, T6.
*
* CALLS CAI, ITC, RTK, SEI.
*
* MACROS ENDMS, MONITOR.
ACS3 LDD EB SAVE BUFFER ADDRESS
ADN 1
STM ACSA
ADN 1 SET POINTER TO NEXT AVAILABLE ENTRY
STD EP
LDC 500
STD T1
ACS4 LDN 0 CLEAR NEW CATALOG SECTOR BUFFER
STM *,T1
ACSA EQU *-1 (ADDRESS OF BUFFER + 1)
SOD T1
PJN ACS4 IF MORE BYTES TO CLEAR
ACS SUBR ENTRY/EXIT
LDM -2,EB END BUFFER TRACK
STD T6
LDM -1,EB
ADN 1
STI EB
LMM SLM
NJN ACS3 IF NOT AT SECTOR LIMIT
ENDMS
LDM DVLW+1 INTERLOCK CATALOG ALLOCATION
RJM ITC
ZJN ACS1 IF INTERLOCK SUCCESSFUL
RJM HNG HANG IF LABEL TRACK NOT RESERVED
ACS1 LDD T6 SET ALLOCATION INTERLOCK FLAG
STM AILK
RJM SEI SEARCH FOR END OF CATALOG TRACK
LDD T5 SET CATALOG TRACK OVERFLOW
STD CM+1
LDN SGBS
STD CM+3
LDN GCTO
STD CM+2
MONITOR STBM
LDD T6
STI EB
RJM RTK REQUEST TRACK
ZJN ACS2 IF NO TRACK AVAILABLE
RJM CAI CLEAR ALLOCATION INTERLOCK
LJM ACS3 EXIT
* TRACK LIMIT ENCOUNTERED.
ACS2 ERROR TKL,,,T5 *EQXXX,DNYY, TRACK LIMIT.*
AFS SPACE 4,20
** AFS - ALLOCATE FILE SPACE.
*
* ENTRY (T5) = MASTER DEVICE EST ORDINAL.
* (LF - LF+1) = LENGTH OF FILE TO BE ALLOCATED.
* INDIRECT ALLOCATION INTERLOCK SET.
*
* EXIT SPACE ALLOCATED FOR INDIRECT FILE.
* (SDAB) = TRACK OF NEW FILE.
* (SDAC) = SECTOR OF NEW FILE.
*
* USES T2, T7, CM - CM+4.
*
* CALLS DTK, SEI.
*
* MACROS ENDMS, MONITOR.
AFS SUBR ENTRY/EXIT
ENDMS RELEASE CHANNEL
LDM IAIF
NJN AFS2 IF ALLOCATION INTERLOCK SET
RJM HNG HANG
AFS2 LDM DVLW SKIP TO END OF INDIRECT CHAIN
STD T6
RJM SEI
LDD T5 SET EST ORDINAL AND TRACK
STD CM+1
LDD T6
STM SDAB
STD CM+2
LDD T7 CALCULATE SECTORS REQUIRED
ADD LF+1
AFSB ADN 2 ALLOCATE FOR SYSTEM SECTOR AND EOI
* PSN (*APPEND* - DO NOT ALLOCATE FOR SS/EOI)
STD CM+4
STD T2
SHN -14
ADD LF
STD CM+3
AOD T7
LMM SLM
NJN AFS3 IF CURRENT EOI NOT AT END OF TRACK
STD T7 RESET FIRST TRACK AND SECTOR OF NEW FILE
STM AFSA+PSNI*0
AFS3 LDD CM+4 SUBTRACT SECTORS IN CURRENT TRACK
SBM SLM
STD CM+4
PJN AFS6 IF ADDITIONAL TRACKS REQUIRED
LDD CM+3
NJN AFS5 IF ADDITIONAL TRACKS REQUIRED
LDD T2 SET EOI IN TRT
RJM DTK
UJN AFS8 COMPLETE ALLOCATION
AFS5 AOD CM+4 ADJUST FOR UNDERFLOW
SOD CM+3
AFS6 AOD CM+4 ADJUST SECTOR COUNT FOR *RTCM*
SHN -14
RAD CM+3
MONITOR RTCM
* LDN 0 CLEAR REWRITE ON FILE COPY
STM DTMD
LDD CM+4
AFSA UJN AFS7 SKIP UPDATE OF FIRST TRACK
* PSN (CURRENT EOI AT END OF TRACK)
STM SDAB SET FIRST TRACK OF NEW FILE
AFS7 ZJN AFS9 IF NO TRACKS ASSIGNED
AFS8 LDD T7 SET FIRST SECTOR OF NEW FILE
STM SDAC
LDC STXC SET *EXTENDING INDIRECT CHAIN* FLAG
RAM STAT
LDN 0 CLEAR REWRITE ON FILE COPY
STM DTMD
LJM AFSX RETURN
AFS9 ERROR TKL,,,T5 *EQXXX,DNYY, TRACK LIMIT.*
TITLE CATALOG UPDATE ROUTINES.
CCS SPACE 4,30
** CCS - CREATE CATALOG SECTOR.
*
* ENTRY (HB) = ADDRESS OF BUFFER CONTAINING HOLE.
* (HP) = INDEX TO HOLE ENTRY.
* (EB) = POINTER TO BUFFER CONTAINING END OF CATALOGS.
* (EP) = INDEX TO FIRST AVAILABLE ENTRY IN END BUFFER.
* (CC) = COMMAND CODE.
* (DAHP) .NE. 0 IF DIRECT ACCESS HOLE BEING USED.
* (CI) = INDEX TO CATALOG ENTRY (APPEND/REPLACE/UREPLACE)
* (CCSB) = PRESET TO *PSN* FOR *DEFINE*/*DROPIDS*.
* (CCSC) = PRESET TO *PSN* FOR *DEFINE*/*DROPIDS*.
* (CCSF) = PRESET TO *PSN* FOR *DEFINE*/*DROPIDS*.
* (CCSG) = PRESET TO *PSN* FOR *DEFINE*/*DROPIDS*.
* (SDAB) = FIRST TRACK OF FILE.
* (SDAC) = FIRST SECTOR OF FILE, (4XXX) FOR DA FILE.
*
* EXIT CATALOG ENTRY CREATED.
* CATALOG ENTRY NOT WRITTEN TO DISK IF *DEFINE* REQUEST.
* SPACE FOR FILE ALLOCATED IF NECESSARY.
* (EP) = ADDRESS OF NEW CATALOG ENTRY OF FILE (IF DAPF).
* (EB) = ADDRESS OF BUFFER FOR FILE (IF DAPF).
* IF (HB) .NE. (EB), END BUFFER REWRITTEN.
*
* USES T1 - T7.
*
* CALLS ACS, AFS, FCE, FHE, REB, WBI.
*
* NOTES THE SYMBOLS *CCSA*, *CCSD* AND *CCSV* SHOULD NOT BE
* USED AS DATA TAGS IN THIS SUBROUTINE, SINCE THEY
* CONFLICT WITH GLOBAL SYMBOLS.
CCS SUBR ENTRY/EXIT
CCSE LDD HP
* LJM CCS5.1 (*UREPLACE*)
NJN CCS3 IF HOLE AVAILABLE
* CREATE NEW CATALOG ENTRY.
RJM REB REREAD END BUFFER (IF NECESSARY)
CCSB RJM AFS ALLOCATE FILE SPACE
* PSN (*DEFINE* OR *DROPIDS*)
LDD EP
NJN CCS2 IF SPACE AVAILABLE IN LAST SECTOR
RJM ACS ALLOCATE CATALOG SPACE
* FORM CATALOG ENTRY FOR FILE.
CCS2 LDD EP SET ADDRESS OF FIRST ENTRY
RJM FCE
LDM DAHP
NJN CCS2.1 IF USING DIRECT ACCESS HOLE
LDN NWCE ADVANCE SECTOR WORD COUNT
RAM 1,EB
CCS2.1 LJM CCS7 WRITE END BUFFER
* USE EXISTING CATALOG ENTRY FOR FILE.
CCS3 UJN CCS5 PROCESS INDIRECT ACCESS FILE
* PSN (*DEFINE*/*DROPIDS* REQUEST)
CCSC EQU *-1
* REUSE DELETED DIRECT ACCESS FILE ENTRY.
LDD HP FORM CATALOG ENTRY FOR DIRECT ACCESS FILE
STD EP
RJM FCE
CCS4 LDD HB REWRITE CATALOG SECTOR
STD EB
CCSF RJM WBI
* PSN (*DEFINE*/*DROPIDS* REQUEST)
UJP CCSX EXIT
* UTILIZE HOLE FOR INDIRECT ACCESS FILE.
CCS5 LDM FCBT,HP SET ADDRESS OF HOLE
STM SDAB
LDM FCBS,HP
STM SDAC
LDD HP REFORM CATALOG ENTRY FOR NEW FILE
RJM FCE FORM CATALOG ENTRY
CCS5.1 LDD HL LENGTH OF HOLE
SBD LF+1
ZJN CCS4 IF EXACT FIT
* CREATE CATALOG ENTRY FOR UNUSED PORTION OF HOLE.
*
* NOTE - CODE IN *SCH* AND *APP* GUARANTEES THAT A HOLE
* WILL NOT BE SELECTED UNLESS IT IS LARGE ENOUGH TO
* ALLOW A NEW MINIMUM-SIZED HOLE TO BE CREATED (EXCEPT
* FOR EXACT FITS).
SBN 2 SET NEW HOLE LENGTH
STD HL
RJM REB REREAD END BUFFER (IF NECESSARY)
LDD EP
NJN CCS6 IF SPACE AVAILABLE IN LAST SECTOR
RJM ACS ALLOCATE CATALOG SPACE
CCS6 RJM FHE FORM HOLE ENTRY
LDM DAHP
NJN CCS6.1 IF USING DIRECT ACCESS HOLE
LDN NWCE
RAM 1,EB
CCS6.1 LDD HB REWRITE FILE CATALOG ENTRY
RJM WBI
LDD HB CHECK BUFFERS
LMD EB
ZJN CCS8 IF NEW ENTRY IN SAME BUFFER AS HOLE
CCS7 LDD EB WRITE NEW CATALOG ENTRY
CCSG RJM WBI
* PSN (*DEFINE*/*DROPIDS* REQUEST)
* WRITE EOI SECTOR IF NEW SECTOR OF CATALOGS.
CCS8 LDD EP CHECK END BUFFER
SBD EB
SBN 2
ADM DAHP NON-ZERO IF USING DIRECT ACCESS HOLE
NJN CCS10 IF NOT NEW END BUFFER
LDI EB
SHN 6
PJN CCS9 IF NOT NEW TRACK
SHN -6
STD T6
LDN 0
CCS9 SHN -6
STD T7 SET SECTOR NUMBER
STM EOIA+1
STM EOIFS+3
LDD T6 SET TRACK NUMBER
STM EOIA
STM EOIFS+2
LDC EOIB WRITE EOI
RJM WBI
CCS10 LJM CCSX
CDA SPACE 4,15
** CDA - COMPARE DISK ADDRESSES.
*
* IF THE DISK ADDRESS FOR THE BUFFER MATCHES THE DISK ADDRESS
* FOR THE DIRECT ACCESS HOLE, SET THE END BUFFER POINTERS TO
* MATCH THE BUFFER POINTERS.
*
* ENTRY (A) = BUFFER ADDRESS.
*
* EXIT (A) = 0 IF DISK ADDRESS MATCH.
* (EB) = BUFFER ADDRESS IF DISK ADDRESSES MATCH.
* (EP) = OFFSET IF DISK ADDRESSES MATCH.
*
* USES T3.
CDA SUBR ENTRY/EXIT
STD T3 SAVE BUFFER ADDRESS
LDM DAHP
LMM -2,T3
NJN CDAX IF NOT THE SAME TRACK
LDM DAHP+1
LMM -1,T3
NJN CDAX IF NOT THE SAME SECTOR
LDD T3 SET END BUFFER ADDRESS
STD EB
ADM DAHP+2
STD EP
LDN 0 DISK ADDRESS MATCH
UJN CDAX RETURN
CIA SPACE 4,30
** CIA - CLEAR INDIRECT ALLOCATION INTERLOCK.
*
* THE INTERLOCK IS NOT CLEARED AT THIS TIME WHEN EXTENDING
* THE INDIRECT CHAIN ON A BUFFERED DEVICE; THE INTERLOCK IS
* HELD THROUGHOUT THE TRANSFER. THIS IS DONE FOR THE FOLLOWING
* REASON: SINCE ANY REQUEST TO WRITE TO NEWLY ALLOCATED SPACE
* ON A BUFFERED DEVICE MUST BE DONE BY SEQUENTIAL (NON-REWRITE)
* REQUESTS, ALL EXTENSIONS OF THE INDIRECT CHAIN ARE PERFORMED
* WITH SEQUENTIAL WRITES. HOWEVER, THIS MEANS THAT TWO OR MORE
* COPIES OF *PFM* CANNOT BE ALLOWED TO PERFORM SUCH EXTENSIONS
* AT THE SAME TIME, SINCE ONE *PFM* MIGHT THEN DO A
* SEQUENTIAL WRITE INTO A PHYSICAL SECTOR PREVIOUSLY WRITTEN
* BY ANOTHER *PFM*, WHICH MAY DESTROY THE DATA WRITTEN BY
* THAT OTHER *PFM*. NOTE THAT THE INTERLOCK MUST ALSO BE
* HELD THROUGHOUT THE TRANSFER FOR *CPUPFM* TRANSFERS, SINCE
* FOR SEQUENTIAL WRITES *1MS*/*CPUMTR* WILL CHANGE THE VALUE
* OF THE EOI IN THE TRT DURING THE TRANSFER, AND WILL NOT SET
* THE FINAL VALUE OF THE EOI UNTIL THE TRANSFER IS COMPLETE.
*
* ENTRY (EQ) = MASTER DEVICE EST ORDINAL.
* (DVLW) = FIRST TRACK OF INDIRECT CHAIN.
*
* EXIT INDIRECT ALLOCATION INTERLOCK CLEARED.
* (IAIF) CLEARED.
*
* USES T5, T6.
*
* CALLS CTI.
*
* MACROS ENDMS.
CIA SUBR ENTRY/EXIT
ENDMS
LDM STAT
LPC STBD+STXC
LMC STBD+STXC
ZJN CIAX IF EXTENDING CHAIN ON BUFFERED DEVICE
LDD EQ
STD T5
LDM STAT
LPC STXC
ZJN CIA1 IF NOT EXTENDING CHAIN
RAD T5 SET CHECKPOINT BIT
ERRNZ STXC-4000 CODE DEPENDS ON VALUE
CIA1 LDM DVLW CLEAR INTERLOCK
STD T6
RJM CTI
LDD EQ
STD T5
LDN 0 CLEAR FLAG
STM IAIF
UJN CIAX RETURN
DCE SPACE 4,30
** DCE - DELETE CATALOG ENTRY.
*
* DELETE CATALOG ENTRY FOR INDIRECT ACCESS FILE.
* DETERMINE IF SPACE CAN BE RELEASED AND RELEASE IF REQUESTED.
*
* ENTRY (CB) = BUFFER ADDRESS.
* (CI) = POINTER TO CATALOG ENTRY.
* (DCEC) = PRESET TO *PSN* FOR *APPEND* REQUEST.
* (DCED) = PRESET TO *PSN* FOR *APPEND* REQUEST.
* INDIRECT ALLOCATION INTERLOCK SET.
*
* EXIT ENTRY DELETED IN CATALOG SECTOR.
* (A) = 0 IF NO DELINK POSSIBLE.
* (A) = 1 IF DELINK POSSIBLE.
* CATALOG BUFFER REWRITTEN IF NOT *APPEND*
* REQUEST.
* (A) = 2 IF FILE AT END OF CHAIN.
* CATALOG BUFFER REWRITTEN IF NOT *APPEND*
* REQUEST.
* DELINK REQUEST SAVED AT *APDK* IF DELINK POSSIBLE FOR
* AN APPEND OPERATION.
*
* USES P0, P1, P2, P3, T1, T2, T3, T4, T6, T7, CM - CM+4.
*
* CALLS DTK, SNT, WBI.
*
* MACROS ENDMS, MONITOR.
DCE SUBR ENTRY/EXIT
LDM IAIF
NJN DCE0 IF ALLOCATION INTERLOCK SET
RJM HNG HANG
* SET CATALOG ENTRY AS HOLE.
DCE0 LDM FCLF+1,CI SET LENGTH OF HOLE
ADN 2 ACCOUNT FOR SYSTEM SECTOR AND EOI
STD P1
SHN -14
ADM FCLF,CI
STD P0
LDM FCBS,CI SET START OF HOLE
STD T7
LDN 0 CLEAR TRACK COUNT
STD T3
STM FCUI+1,CI SET ENTRY AS HOLE
LDM FCUI,CI
SCN 77
STM FCUI,CI
LDD CI SET CONTROL MODIFICATION DATE IN HOLE
RAM DCEB
LDN PDTL
CRM FCKD-2,ON
DCEB EQU *-1 (ADDRESS OF DATE WITHIN BUFFER)
LDM FCBT,CI
NJN DCE1 IF FILE IS DISK RESIDENT
LDC 4000 SET AS DAPF HOLE
STM FCBS,CI
LJM DCE15 EXIT
* CHECK FOR POSSIBILITY OF TRACK DELINK.
DCE1 STD T6 SET CURRENT TRACK
RJM SNT SET NEXT TRACK
STD T1
SHN 6
PJN DCE5 IF END OF TRACK CHAIN
LDM SLM
SBD T7
STD T2 SAVE SECTOR COUNT FOR THIS TRACK
LDD P1 DECREMENT REMAINING HOLE BY SECTOR COUNT
SBD T2
STD T0 SAVE RESULT
PJN DCE4 IF NOT END OF HOLE
SOD P0
PJN DCE3 IF NOT END OF HOLE
DCE2 LJM DCE10 PROCESS END OF HOLE
DCE3 AOD T0 RESTORE RESULT
DCE4 STD P1
AOD T3 ADVANCE TRACK COUNT
LDN 0 SET FIRST SECTOR
STD T7
LDD P2 SAVE PREVIOUS TRACK
STD P3
LDD T6 SAVE LAST TRACK
STD P2
LDD T1
UJN DCE1 LOOP FOR NEXT TRACK
* END OF CHAIN ENCOUNTERED.
DCE5 LDD P0
SHN 14
ADD P1
ADD T7
SBD T1
SBN 1
NJN DCE2 IF NOT LAST FILE ON CHAIN
LDN 2 FLAG END OF CHAIN
RAM DCEA
DCEC UJN DCE6 NOT APPEND COMMAND
* PSN (*APPEND* REQUEST)
LJM DCE15 EXIT BACK TO APPEND PROCESSING
DCE6 LDM FCBS,CI
ZJN DCE7 IF FILE STARTS AT SECTOR 0
SBN 1
STD P1
LCN 0 SET AS NULL HOLE
STM FCBS,CI SET AS NULL HOLE (DELETED DA FILE)
UJN DCE8 REWRITE CATALOG ENTRY
DCE7 STM FCLF,CI SET HOLE LENGTH
LDK MNHS-2 LEAVE MINIMUM-SIZE HOLE
STM FCLF+1,CI
ADN 1
STD P1
DCE8 LDD CB REWRITE CATALOG ENTRY
RJM WBI
ENDMS
LDM FCBT,CI SET FIRST TRACK
STD T6
LDD P1 LAST SECTOR WRITTEN
RJM DTK DROP TRACK CHAIN
LJM DCE15 EXIT
DCE9 SOD T3 DELINK ONE LESS TRACK
LDD P2 SET TRACK TO LINK TO
STD T6
LDD P3 SET LAST TRACK TO DELINK
STD P2
LDM SLM ADJUST REMAINING LENGTH OF HOLE
RAD P1
* END OF HOLE ENCOUNTERED.
DCE10 UJN DCE11 NOT *APPEND*
* PSN (*APPEND* REQUEST)
DCEE EQU *-1
LDM CPTF
ZJN DCE11 IF NOT CPU TRANSFER
LDC IFUI SET INDIRECT FLAW USER INDEX IN OLD PFC
STM FCUI+1,CI
SHN -14
RAM FCUI,CI
DCE10.1 LJM DCE15 EXIT
DCE11 LDD T3 CHECK TRACK COUNT
SBN 2
MJN DCE10.1 IF NO TRACKS TO DELINK
LDM FCBT,CI SET NEW HOLE
LPC 3777
STD CM+2
LDM SLM
SBM FCBS,CI
ADD P1
SBK MNHS
MJP DCE9 IF NEW HOLE SHORTER THAN MINIMUM LENGTH
ADK MNHS-2 SET LENGTH OF NEW HOLE
STM FCLF+1,CI
LDN 0
STM FCLF,CI
AOM DCEA SET DELINK POSSIBLE
LDD T5 SET CALL TO DELINK
ADC 4000 SET CHECKPOINT BIT
STD CM+1
LDD T6 SET NEXT TRACK IN CHAIN
STD CM+3
LDD P2 SET LAST TRACK TO RELEASE
STD CM+4
LDD MA
CWD CM
CRM APDK,ON SAVE DELINK REQUEST
DCED UJN DCE12 REWRITE CATALOG ENTRY
* PSN (*APPEND* REQUEST)
UJN DCE15 EXIT
DCE12 LDD CB REWRITE CATALOG ENTRY
RJM WBI
ENDMS
LDD MA
CWM APDK,ON
SBN 1
CRD CM
MONITOR DLKM DELINK TRACKS
DCE15 LDN 0 SET EXIT CONDITION
* LDN 1 (DELINK POSSIBLE)
* LDN 2 (FILE AT END OF CHAIN)
DCEA EQU *-1
LJM DCEX RETURN
FCE SPACE 4,15
** FCE - FORM CATALOG ENTRY.
*
* ENTRY (A) = LOCATION OF ENTRY WITHIN BUFFER.
* (FN - FN+3) = PERMANENT FILE NAME.
* (LF - LF+1) = LENGTH OF FILE IN SECTORS.
* (FCEG) = PRESET TO *PSN* FOR USER CONTROL WORD UPDATE.
* (FCEH) = PRESET TO *PSN* IF PASSWORD SPECIFIED.
* (SDAB) = STARTING TRACK ADDRESS.
* (SDAC) = STARTING SECTOR ADDRESS.
* (CI) = INDEX TO OLD CATALOG ENTRY.
*
* EXIT CATALOG ENTRY REFORMED IN BUFFER.
* WORD COUNT OF SECTOR ADVANCED IF NOT A HOLE PLUG.
* (PFCA) = ADDRESS OF NEW CATALOG ENTRY.
*
* USES EP, P0, CM - CM+4, FN - FN+3, T0 - T3, UI - UI+1,
* LF - LF+1.
*
* NOTE THE SYMBOLS *FCEC*, *FCEF* AND *FCEO* SHOULD NOT BE
* USED FOR DATA TAGS IN THIS ROUTINE, SINCE THEY
* CONFLICT WITH THE GLOBAL CATALOG SYMBOL DEFINITIONS.
FCE SUBR ENTRY/EXIT
STD T1 ADDRESS OF CATALOG ENTRY
STM PFCA
STM FCEA SET ADDRESS OF FILE NAME
STD T2 SET ADDRESS FOR CLEARING OF CATALOG ENTRY
ADC FCCW SET ADDRESS OF USER CONTROL WORD
STM FCEB
STM FCED
LDD T1
LMD CI
ZJN FCE2 IF REPLACING SAME CATALOG ENTRY
* CLEAR CATALOG ENTRY BUFFER.
LDC NWCE*5 CLEAR EXISTING CATALOG ENTRY
STD T3
FCE1 LDN 0
STI T2
AOD T2
SOD T3
NJN FCE1 IF MORE CATALOG TO CLEAR
* TRANSFER DATA INTO NEW CATALOG ENTRY.
FCE2 LDD MA SET NEW FILE NAME
CWD FN
CRM *,ON
FCEA EQU *-1
LDM FCUI,T1 SET USER INDEX IN CATALOG ENTRY
SCN 77
ADD UI USER INDEX FIRST BYTE
STM FCUI,T1
LDD UI+1
STM FCUI+1,T1
LDM SDAB SET BEGINNING TRACK AND SECTOR
STM FCBT,T1
LDM SDAC
STM FCBS,T1
LDD LF SET LENGTH OF FILE
STM FCLF,T1
LDD LF+1
STM FCLF+1,T1
LDN PDTL READ PACKED DATE AND TIME
CRD CM
LDD T1 SET TRANSFER OF OLD CATALOG
ADN FCRI
STD T2
LDD CI
ZJN FCE5 IF NO PRIOR FILE
ADN FCRI
STD T3
LMD T2
ZJN FCE4 IF SAME CATALOG ENTRY
FCE3 LDI T3 TRANSFER OLD CATALOG DATA
STI T2
AOD T3
AOD T2
ADC -NWCE*5
LMD T1
NJN FCE3 IF MORE CATALOG TO TRANSFER
FCE4 LDM FCEC,T1 CLEAR ERROR CODES FROM OLD FILE
LPN 77
STM FCEC,T1
LDC UJNI+FCE7-FCEI DO NOT UPDATE FCCD OR FCKD
STM FCEI
FCEG UJN FCE5 BYPASS USER CONTROL WORD UPDATE
* PSN (SET USER CONTROL WORD)
LDD MA TRANSFER CONTROL WORD VIA MESSAGE BUFFER
CWM PUCW,ON
SBN 1
CRM *,ON
FCEB EQU *-1
FCE5 LDN CM+2 SET TRANSFER ADDRESSES
* UJN FCE7.1 (*DROPIDS* - BYPASS DATE CHANGE)
FCEL EQU *-1
STD T2
LDD T1
STD T3
FCE6 LDI T2 TRANSFER DATES
FCEI STM FCCD,T3
* UJN FCE7 (IF EXISTING CATALOG ENTRY)
STM FCKD,T3
FCE7 STM FCUD,T3
STM FCAD,T3
STM FCMD,T3
AOD T3
AOD T2
LMN CM+5
NJN FCE6 LOOP TO END OF DATES
LDD CI
ZJN FCE8 IF NOT PREVIOUS FILE
FCE7.1 LJM FCEX RETURN
* NEW FILE CREATION.
FCE8 LDN FCPW SET PASSWORD ADDRESS
ADD T1
STM FCEJ
ADN FCXD-FCPW SAVE EXPIRATION DATE POINTER
STD T3
ADN FCCN-FCXD SET CHARGE/PROJECT ADDRESS
STM FCEK
LDD MA TRANSFER USER CONTROL WORD AND PASSWORD
CWM PUCW,ON
CWM PFPW,ON
SBN 2
CRM *,ON SET USER CONTROL WORD
FCED EQU *-1
FCEH UJN FCE9 BYPASS PASSWORD UPDATE
* PSN (SET PASSWORD)
CRM *,ON SET PASSWORD
FCEJ EQU *-1
LDI T3 SET PASSWORD EXPIRATION DATE
SCN 77
LMM PXDT
STI T3
LDM PXDT+1
STM 1,T3
FCE9 LDM LFAL SET ACCESS LEVEL AND CATEGORY SET
STM FCAL,T1
ERRNZ FCAL-FCFC+1 CODE DEPENDS ON VALUE
LDM PFFC
STM FCFC,T1
LDM PFFC+1
STM FCFC+1,T1
LDM PFFC+2
STM FCFC+2,T1
LDM MODE SET CATALOG TYPE AND FILE MODE
LPC 3737
STM FCCT,T1
LDM PFSS SET SS, BR AND PR
ERRNZ PFSS-PFBR *BR* AND *SS* MUST BE TOGETHER
ERRNZ PFRS-PFBR *BR* AND *PR* MUST BE TOGETHER
STM FCFS,T1
LDM PFAP SET ALTERNATE CATLIST PERMISSION
LPC 6000
STM FCAP,T1
LDC 0 SET DEVICE NUMBER
FCEE EQU *-1
STM FCDN,T1
NFA CHGN SET EXECUTING CHARGE/PROJECT FROM NFL
CRM *,TR
FCEK EQU *-1
ERRNZ FCP1-FCCN-5 *FCP1* MUST FOLLOW *FCCN*
ERRNZ FCP2-FCCN-12 *FCP2* MUST FOLLOW *FCCN*/*FCP1*
ERRNZ PJ1N-CHGN+1 *PJ1N* MUST BE IMMEDIATELY AFTER *CHGN*
ERRNZ PJ2N-PJ1N+1 *PJ2N* MUST BE IMMEDIATELY AFTER *PJ1N*
LJM FCEX RETURN
* TEST RANGE OF GENERATED RELATIVE JUMPS.
ERRNG 37+FCEI-FCE7
FHE SPACE 4,15
** FHE - FORM HOLE ENTRY.
*
* ENTRY (EP) = POINTER IN END BUFFER FOR NEW HOLE ENTRY.
* (HL) = SIZE OF NEW HOLE.
* (LF - LF+1) = SIZE OF NEW FILE.
* (HP) = POINTER TO NEW FILE - PLACED IN PREVIOUS HOLE.
* CATALOG ENTRY CONTAINS POINTER TO NEW FILE.
*
* EXIT NEW HOLE FORMED IN END BUFFER.
*
* CALLS *NONE*
*
* USES T1, T2, T3.
FHE SUBR ENTRY/EXIT
* DETERMINE START OF NEW HOLE.
LDM FCBS,HP FIRST SECTOR OF NEW FILE
ADN 2 ALLOW FOR SYSTEM SECTOR AND EOI
STD T7
LDD LF+1 LENGTH OF NEW FILE
STD T3
LDM FCBT,HP
FHE1 STD T6
LDD T7
ADD T3
SBM SLM
MJN FHE2 IF PAST END OF NEW FILE
STD T3 REMAINDER OF NEW FILE
LDN 0
STD T7
RJM SNT SET NEXT TRACK
UJN FHE1
FHE2 ADM SLM SET ADDRESS OF NEW FILE
STD T7
LDC NWCE*5 CLEAR NEXT CATALOG ENTRY
STD T1
LDD EP
STD T2
FHE3 LDN 0
STI T2
AOD T2
SOD T1
NJN FHE3 IF MORE CATALOG TO CLEAR
* FORM HOLE ENTRY
LDD T7
STM FCBS,EP
LDD T6
STM FCBT,EP
LDD HL
STM FCLF+1,EP
LDD EP SET CONTROL MODIFICATION DATE IN HOLE
RAM FHEA
LDN PDTL
CRM FCKD-2,ON
FHEA EQU *-1 (ADDRESS OF DATE WITHIN BUFFER)
LJM FHEX RETURN
IIA SPACE 4,20
** IIA - INTERLOCK INDIRECT ALLOCATION.
*
* ENTRY (EQ) = MASTER DEVICE EST ORDINAL.
* (DVLW) = FIRST TRACK OF INDIRECT CHAIN.
*
* EXIT INDIRECT ALLOCATION INTERLOCK SET.
* (IAIF) NONZERO.
*
* ERROR TO *ERR* IF INTERLOCK NOT OBTAINED BY FOURTH TRY.
* TO *HNG* IF TRACK NOT RESERVED.
*
* USES T1, T5, T6.
*
* CALLS DPR, STI.
*
* MACROS ENDMS.
IIA4 AOM IAIF SET INDIRECT ALLOCATION INTERLOCK FLAG
IIA SUBR ENTRY/EXIT
ENDMS
LDD EQ
STD T5
LDM DVLW
STD T6
LDN 4
STD T1
IIA1 RJM STI
ZJN IIA4 IF INTERLOCK OBTAINED
LMN 2
ZJN IIA2 IF TRACK NOT RESERVED
SOD T1
ZJN IIA3 IF RETRY COUNT EXHAUSTED
RJM DPR DELAY PRIOR TO RETRY
UJN IIA1 TRY AGAIN
IIA2 RJM HNG HANG IF TRACK NOT RESERVED
IIA3 EXIT INA,CH,,,EC4 * INTERLOCK NOT AVAILABLE.*
REB SPACE 4,15
** REB - REREAD END BUFFER.
*
* REREAD THE BUFFER CONTAINING THE END OF THE CATALOGS,
* IF THAT BUFFER WAS IN *BFMS*, AND IF *BFMS* WAS REUSED.
* IF (DAHP) IS NONZERO, READ THE SECTOR CONTAINING THE DAPF
* HOLE INTO *BFMS*, AND RESET (EB) AND (EP) TO POINT TO IT.
*
* ENTRY (EBSC) = SECTOR FOR END BUFFER.
* (EBTK) = TRACK FOR END BUFFER.
* (DAHP) = DIRECT ACCESS HOLE POINTER.
*
* EXIT END BUFFER REREAD.
*
* USES T6, T7.
*
* CALLS CDA, PDV, PES, RDS.
*
* MACROS ERROR, SETMS.
REB3 LDM STAT
LPN STBR
ZJN REBX IF *BFMS* (END BUFFER) HAS NOT BEEN REUSED
REB4 LDM EBTK RESET TRACK
STD T6
STM -2,EB
LDM EBSC RESET SECTOR
STD T7
STM -1,EB
SETMS IO,NS
RJM PDV PROCESS DEVICE STATUS
LDD EB REREAD END SECTOR
RJM RDS
PJN REBX IF NO ERROR
RJM PES PROCESS ERROR STATUS
REB SUBR ENTRY/EXIT
LDM DAHP
REB1 ZJP REB3 IF NO DIRECT ACCESS HOLES FOUND
LDD CB
RJM CDA COMPARE DISK ADDRESSES (CATALOG BUFFER)
ZJN REBX IF DIRECT ACCESS HOLE IN CATALOG BUFFER
LDD HP
ZJN REB2 IF NO HOLE BUFFER
LDD HB
RJM CDA COMPARE DISK ADDRESSES (HOLE BUFFER)
ZJN REBX IF DIRECT ACCESS HOLE IN HOLE BUFFER
REB2 LDD EB
RJM CDA COMPARE DISK ADDRESSES (END BUFFER)
ZJN REB1 IF DIRECT ACCESS HOLE IN END BUFFER
LDC BFMS FORCE END BUFFER TO BFMS
STD EB
LDM DAHP FORCE END BUFFER TO DIRECT ACCESS HOLE
STM EBTK
LDM DAHP+1
STM EBSC
LDM DAHP+2
ADD EB
STD EP
UJP REB4 READ DIRECT ACCESS HOLE
ERROR MSE,CH,,T5 *EQXXX,DNYY,MASS STORAGE ERROR.*
RTK SPACE 4,20
** RTK - REQUEST LINKED TRACK.
*
* ENTRY (T6) = ADDRESS OF LAST TRACK IN CHAIN.
* (T5) = MASTER DEVICE EST ORDINAL.
*
* EXIT (A) = 0 IF NO TRACK AVAILABLE.
* (A) = TRACK IF AVAILABLE.
* NEW TRACK PREWRITTEN WITH EOI-S.
*
* USES T6, T7, CM - CM+4.
*
* CALLS PDV, WDS.
*
* MACROS ENDMS, MONITOR, SETMS.
*
* NOTES THE DRIVER AUTOMATICALLY WRITES THE LAST SECTOR
* OF A TRACK WITH *WLSF*, EVEN IF *WCSF* IS SPECIFIED.
RTK SUBR ENTRY/EXIT
LDN ZERL
CRD CM
LDD T5 SET EST ORDINAL
STD CM+1
LDD T6 SET PRESENT LAST TRACK ADDRESS
STD CM+2
MONITOR RTCM
LDD CM+4
ZJN RTKX IF NO TRACK ASSIGNED
STD T6 PREWRITE NEW TRACK
STM EOIFS+2 SET TRACK NUMBER IN EOI BUFFER
LDN 0
STD T7
SETMS IO,NS
RJM PDV PROCESS DEVICE STATUS
RTK1 LDD T7 SET SECTOR NUMBER IN EOI BUFFER
STM EOIFS+3
LDC EOIB+WCSF WRITE SECTOR
RJM WDS
AOD T7
LMM SLM
NJN RTK1 IF NOT LAST SECTOR
ENDMS
LDD T6
UJP RTKX RETURN
EOI SPACE 4,10
** EOI - EOI SECTOR BUFFER.
EOIA CON 0,0 END OF INFORMATION DISK ADDRESS
EOIB CON 0,0 END OF INFORMATION CONTROL BYTES
VFD 60/3LPFM FNT WORD
EOIFS BSSZ 5 FST WORD
EOIDT BSSZ 5 DATE/TIME WORD
SPACE 4,10
* CHECK FOR OVERFLOW.
OVERFLOW OVLU,OVLC OVERFLOW INTO COMMAND OVERLAY AREA
SPACE 4,10
OVERFLOW OVLU,BUF2-2 OVERFLOW INTO CATALOG BUFFER
EJECT
* EQUIVALENCE EXTERNALLY REFERENCED TAGS.
QUAL *
AFS EQU /".O"/AFS
AFSB EQU /".O"/AFSB
CCS EQU /".O"/CCS
CCS5.1 EQU /".O"/CCS5.1
CCSB EQU /".O"/CCSB
CCSC EQU /".O"/CCSC
CCSE EQU /".O"/CCSE
CCSF EQU /".O"/CCSF
CCSG EQU /".O"/CCSG
CIA EQU /".O"/CIA
DCE EQU /".O"/DCE
DCEC EQU /".O"/DCEC
DCED EQU /".O"/DCED
DCEE EQU /".O"/DCEE
FCE7.1 EQU /".O"/FCE7.1
FCEE EQU /".O"/FCEE
FCEL EQU /".O"/FCEL
IIA EQU /".O"/IIA
OVERLAY (PERMIT UPDATE ROUTINES.),OVLU
OVL SPACE 4,10
*** THIS OVERLAY CONTAINS SUBROUTINES USED BY THE COMMAND
* OVERLAYS TO UPDATE THE PERMIT FILE.
OVL BSS 0 ENTRY
RJM RMD RESET TO MASTER DEVICE
LDM DVLW+2 PRESET FIRST TRACK IN EOI BUFFER
STM EOIFS+1
LDN PDTL PRESET DATE/TIME IN EOI BUFFER
CRM EOIDT,ON
UJN ".Q"X RETURN AFTER LOAD
TITLE ALLOCATION ROUTINES.
APS SPACE 4,20
** APS - ALLOCATE PERMIT SPACE.
*
* ENTRY (T5) = MASTER DEVICE EST ORDINAL.
* (PB) = ADDRESS OF PERMIT BUFFER.
* (DVLW - DVLW+4) = DEVICE LAYOUT WORD OF MST.
*
* EXIT (RI - RI+1) = RANDOM ADDRESS OF NEW PERMIT SECTOR.
* (EOIA) SET WITH ADDRESS OF NEW EOI.
* (WNPB) = LINKAGE TO NEW EOI.
* PERMIT ALLOCATION INTERLOCK SET.
* TO *HNG* IF PERMIT CHAIN NOT RESERVED.
*
* USES T6, T7, RI - RI+1.
*
* CALLS DTK, ITC, RTK, SEI.
*
* MACROS ENDMS, ERROR, MONITOR.
APS4 LDD T6 SAVE ADDRESS OF NEW EOI
STM EOIA
STM EOIFS+2
LDD T7
STM EOIA+1
STM EOIFS+3
APS SUBR ENTRY/EXIT
ENDMS RELEASE CHANNEL
LDM DVLW+2 INTERLOCK PERMIT ALLOCATION
RJM ITC
ZJN APS0 IF INTERLOCK SUCCESSFUL
RJM HNG HANG IF PERMIT CHAIN NOT RESERVED
APS0 LDD T6 SET ALLOCATION INTERLOCKED FLAG
STM AILK
RJM SEI SEARCH FOR END OF PERMIT FILE
LDD T2 SAVE RANDOM ADDRESS OF NEW PERMIT SECTOR
STD RI
LDD T3
STD RI+1
AOD T7 CHECK FOR END OF TRACK
LMM SLM
ZJN APS2 IF AT END OF TRACK
LDD T7 SAVE LINKAGE TO NEW EOI
STM WNPB
RJM DTK SET EOI IN TRT
APS1 UJP APS4 SAVE ADDRESS OF NEW EOI
APS2 RJM RTK REQUEST NEW TRACK
ZJN APS3 IF TRACK LIMIT ON ALLOCATION FILE
STD T6 SET ADDRESS OF NEW EOI
STM WNPB SAVE LINKAGE TO NEW EOI
LDN 0
STD T7
UJN APS1 SAVE ADDRESS OF NEW EOI
APS3 ERROR TKL,,,T5 *EQXXX,DNYY, TRACK LIMIT.*
TITLE PERMIT UPDATE ROUTINES.
CPE SPACE 4,15
** CPE - CREATE PERMIT ENTRY.
*
* EXIT (PWRF) = *RFPC* FLAG SET IF NEW PERMIT ENTRY WRITTEN
* TO EXISTING PERMIT SECTOR.
* NEW PERMIT ENTRY WRITTEN.
* RANDOM ADDRESS SET IN CATALOG ENTRY IF
* NEW PERMIT SECTOR CREATED.
*
* USES T5, RI - RI+1.
*
* CALLS APS, FPE, WBI, WNP.
*
* MACROS ERROR, SETMS.
CPE SUBR ENTRY/EXIT
LDM SDAA SET EST ORDINAL
STD T5
SETMS STATUS,NS
LDM FCRI,CI GET PERMIT RANDOM INDEX
STD RI
LDM FCRI+1,CI
STD RI+1
ADD RI
NJN CPE2 IF PERMIT DATA AVAILABLE
* ALLOCATE PERMITS FOR FILE WITH NO EXISTING PERMIT DATA.
RJM APS ALLOCATE PERMIT SPACE
LDD RI SET RANDOM INDEX INTO CATALOG
STM FCRI,CI
LDD RI+1
STM FCRI+1,CI
RJM WNP WRITE NEW PERMIT BUFFER
CPE1 UJN CPEX RETURN
* PROCESS FILE WITH EXISTING PERMIT DATA.
CPE2 LDM 1,PB CHECK FOR FULL SECTOR OF PERMITS
LPN 77
ZJN CPE4 IF FULL SECTOR OF PERMITS
LDM NPHA SET HOLE ADDRESS
RJM FPE FORM PERMIT ENTRY
LDD PB REWRITE PERMIT SECTOR
RJM WBI
CPE3 LDK RFPC SET PERMIT COUNT UPDATED
RAM PWRF
UJN CPE1 RETURN
* REWRITE FULL SECTOR OF PERMITS WITH LINK TO NEW SECTOR.
CPE4 RJM APS ALLOCATE PERMIT SPACE
LDD RI SET RANDOM ADDRESS OF NEW PERMIT SECTOR
STM FPRI,PB
LDD RI+1
STM FPRI+1,PB
LDD PB REWRITE EXISTING PERMIT SECTOR
RJM WBI
LDK STNS SET *NO JOB SUSPENSION* FLAG
RAM STAT
RJM WNP WRITE NEW PERMIT SECTOR
LDK -STNS CLEAR *NO JOB SUSPENSION* FLAG
RAM STAT
UJN CPE3 RETURN
FPE SPACE 4,15
** FPE - FORM PERMIT ENTRY IN BUFFER.
*
* ENTRY (A) = BUFFER LOCATION WHERE ENTRY IS TO BE FORMED.
* (PP) = IF NEW ENTRY TO BE FORMED.
* (PB) = ADDRESS OF PERMIT BUFFER.
* (PI - PI+1) = PERMITTED INDEX.
* (MODE) = PERMITTED MODE.
* (PFOU - PFOU+3) = OPTIONAL USER NAME.
* (PFXT - PFXT+1) = EXPIRATION DATE.
*
* EXIT ENTRY FORMED IN PERMIT BUFFER.
* ACCESS COUNT SET TO 1 IF IMPLICIT PERMIT ENTRY.
*
* USES T1, CM - CM+4.
FPE SUBR ENTRY/EXIT
STD T1 SAVE ADDRESS OF BUFFER
STM FPEA
ADN FPAC SET ACCESS COUNT WORD ADDRESS
STM FPEC
LDD MA SET USER NAME IN PERMIT ENTRY
CWM PFOU,ON
SBN 1
CRM *,ON
FPEA EQU *-1
LDD PB SET ADDRESS OF PERMIT HEADER
ADN FPUD
STM FPEB
LDN PDTL
CRM *,ON SET DATE/TIME IN PERMIT ENTRY
FPEB EQU *-1
SBN 1
CRM *,ON SET DATE/TIME IN PERMIT HEADER
FPEC EQU *-1
LDM MODE SET MODE/ACCESS COUNT
LPN 17
LMM SAPF SET IMPLICIT PERMIT FLAG, IF APPROPRIATE
ADM IACP INCREMENT ACCESS COUNT, IF APPROPRIATE
STM FPAC+1,T1
LDM FPXD,T1 SET EXPIRATION DATE
SCN 77
LMM PXDT
STM FPXD,T1
LDM PXDT+1
STM FPXD+1,T1
LDM SAPF
NJN FPE1 IF ACCOUNTING PERMIT
LDN 40 INDICATE EXPIRATION DATE IS PRESENT
RAM FPAC+1,T1
FPE1 LDN NWPE ADVANCE WORD COUNT
RAM 1,PB
LJM FPEX EXIT
RTK SPACE 4,20
** RTK - REQUEST LINKED TRACK.
*
* ENTRY (T6) = ADDRESS OF LAST TRACK IN CHAIN.
* (T5) = MASTER DEVICE EST ORDINAL.
*
* EXIT (A) = 0 IF NO TRACK AVAILABLE.
* (A) = TRACK IF AVAILABLE.
* NEW TRACK PREWRITTEN WITH EOI-S.
*
* USES T6, T7, CM - CM+4.
*
* CALLS PDV, WDS.
*
* MACROS ENDMS, MONITOR, SETMS.
*
* NOTES THE DRIVER AUTOMATICALLY WRITES THE LAST SECTOR
* OF A TRACK WITH *WLSF*, EVEN IF *WCSF* IS SPECIFIED.
RTK SUBR ENTRY/EXIT
LDN ZERL
CRD CM
LDD T5 SET EST ORDINAL
STD CM+1
LDD T6 SET PRESENT LAST TRACK ADDRESS
STD CM+2
MONITOR RTCM
LDD CM+4
ZJN RTKX IF NO TRACK ASSIGNED
STD T6 PREWRITE NEW TRACK
STM EOIFS+2 SET TRACK NUMBER IN EOI BUFFER
LDN 0
STD T7
SETMS IO,NS
RJM PDV PROCESS DEVICE STATUS
RTK1 LDD T7 SET SECTOR NUMBER IN EOI BUFFER
STM EOIFS+3
LDC EOIB+WCSF WRITE SECTOR
RJM WDS
AOD T7
LMM SLM
NJN RTK1 IF NOT LAST SECTOR
ENDMS
LDD T6
UJP RTKX RETURN
UPI SPACE 4,20
** UPI - UPDATE PERMIT INFORMATION.
*
* ENTRY (PP) = POINTER TO PERMIT ENTRY.
* (PP) = 0 IF NO PERMIT ENTRY PRESENT.
* (PB) = ADDRESS OF PERMIT BUFFER.
* (PB) = 0 IF NO PERMISSION UPDATE REQUIRED.
* (CI) = POINTER TO CATALOG ENTRY.
* (PWRF) = *PFM* RESTART FLAGS.
* PERMIT BUFFER LOADED IF PERMIT EXISTS.
*
* EXIT (PWRF) = *RFPC* FLAG SET IF PERMIT COUNT UPDATED.
* PERMIT ENTRY UPDATED.
* PERMIT ENTRY CREATED IF SEMIPRIVATE ACCESS.
* (FCKD) UPDATED IF PERMIT DATA CHANGED.
*
* USES T5, T6, T7, CM - CM+4.
*
* CALLS CPE, PDV, PES, RDS, WBI.
*
* MACROS ERROR, SETMS.
UPI SUBR ENTRY/EXIT
LDD PB
ZJN UPIX IF NO PERMIT BUFFER
LDM STAT
LPN STPR
ZJN UPI1 IF PERMITS HAVE NOT BEEN READ
UPIB LDN 0
* LDN 1 (*BFMS* REUSED FOR SYSTEM SECTOR ACCESS)
ZJN UPI1 IF *BFMS* HAS NOT BEEN REUSED
LDM BFMS-2 RESET PERMIT BUFFER TRACK AND SECTOR
STD T6
LDM BFMS-1
STD T7
SETMS IO,NS
RJM PDV PROCESS DEVICE STATUS
LDC BFMS REREAD PERMIT BUFFER
RJM RDS
PJN UPI1 IF NO ERROR
RJM PES PROCESS ERROR STATUS
ERROR MSE,CH,,EQ *EQXXX,DNYY, MASS STORAGE ERROR.*
UPI1 LDM FCCT,CI CHECK FILE TYPE
SHN -6
LMN FCSP
ZJN UPI3 IF SEMI-PRIVATE FILE
LDD PP
NJN UPI4 IF PERMIT FOUND (PRIVATE OR PUBLIC FILE)
UPI2 UJP UPIX RETURN
UPI3 LDD PP
ZJP UPI5 IF NO PERMIT DATA AND SEMIPRIVATE FILE
* UPDATE EXISTING PERMIT ENTRY.
UPI4 LDN PDTL READ PACKED DATE AND TIME
CRD CM
LDM PWRF
LPK RFPC
NJN UPI4.1 IF PERMIT COUNT UPDATED
LDD HN INCREMENT ACCESS COUNT
RAM FPAC+1,PP
SHN -14
RAM FPAC,PP
UPI4.1 LDD CM+2 UPDATE LAST ACCESS DATE AND TIME
STM FPAD,PP
LDD CM+3
STM FPAD+1,PP
LDD CM+4
STM FPAD+2,PP
LDD PB REWRITE PERMIT SECTOR
RJM WBI
LDM PWRF SET PERMIT COUNT UPDATED FLAG
SCN RFPC
ADK RFPC
STM PWRF
LJM UPI7 UPDATE CATALOG ENTRY
* CREATE NEW PERMIT ENTRY FOR SEMI-PRIVATE FILE.
UPI5 LDM EBTK
ZJN UPI6 IF *BFMS* WAS NOT USED FOR *END* BUFFER
LDM STAT INDICATE THAT *BFMS* HAS BEEN REUSED
SCN STBR
LMN STBR
STM STAT
UPI6 LDD MA SET USER NAME
CWM PFAC,ON
SBN 1
CRM PFOU,ON
LDM MODE SAVE REQUESTED MODE
STM UPIA
LDM FCAM,CI SET FILE MODE FOR PERMIT ENTRY
LPN 77
STM MODE
LDN 0 CLEAR EXPIRATION DATE
STM PXDT
STM PXDT+1
RJM CPE CREATE PERMIT ENTRY
LDC * RESET ORIGINAL VALUE OF *MODE*
UPIA EQU *-1
STM MODE
* UPDATE CONTROL MODIFICATION DATE IN CATALOG ENTRY.
UPI7 LDN PDTL
CRD CM
LDD CM+2
STM FCKD,CI
LDD CM+3
STM FCKD+1,CI
LDD CM+4
STM FCKD+2,CI
UJP UPIX RETURN
WNP SPACE 4,20
** WNP - WRITE NEW PERMIT BUFFER.
*
* ENTRY (PB) = ADDRESS OF PERMIT BUFFER.
* (RI - RI+1) = RANDOM ADDRESS OF NEW PERMIT SECTOR.
* (UI - UI+1) = USER INDEX OF PERMITTED FILE.
* (PI - PI+1) = USER INDEX OF PERMITTED USER.
* (EIOA) SET WITH ADDRESS OF NEW EOI SECTOR.
* (WNPB) = LINKAGE TO NEW EOI SECTOR.
* PERMIT ALLOCATION INTERLOCK SET.
*
* EXIT NEW PERMIT SECTOR FORMED AND WRITTEN.
* NEW EOI WRITTEN.
* PERMIT ALLOCATION INTERLOCK CLEARED.
*
* CALLS CAI, CSA, FPE, WBI.
*
* MACROS ENDMS.
WNP SUBR ENTRY/EXIT
LDD PB SET BUFFER ADDRESS
ADN 1
STM WNPA
LDC 500
STD T1
WNP1 LDN 0 CLEAR PERMIT BUFFER
STM *,T1
WNPA EQU *-1 (ADDRESS OF BUFFER + 1)
SOD T1
PJN WNP1 IF MORE BYTES TO CLEAR
LDC * SET LINKAGE TO EOI
WNPB EQU *-1
STI PB
LDN NWPH SET WORD COUNT FOR HEADER
STM 1,PB
RJM CSA COMPUTE ADDRESS OF NEW PERMIT SECTOR
LDD T6 SET CURRENT TRACK AND SECTOR
STM -2,PB
LDD T7
STM -1,PB
LDD UI SET USER INDEX
STM FPUI,PB
LDD UI+1
STM FPUI+1,PB
LDD PB SET INDEX FOR FIRST PERMIT ENTRY
ADN NWPH*5+2 SKIP HEADER AND CONTROL BYTES
RJM FPE FORM PERMIT ENTRY
LDD PB WRITE NEW PERMIT SECTOR
RJM WBI
LDC EOIB WRITE NEW EOI
RJM WBI
ENDMS
RJM CAI CLEAR ALLOCATION INTERLOCK
LJM WNPX RETURN
EOI SPACE 4,10
** EOI - EOI SECTOR BUFFER.
EOIA CON 0,0 END OF INFORMATION DISK ADDRESS
EOIB CON 0,0 END OF INFORMATION CONTROL BYTES
VFD 60/3LPFM FNT WORD
EOIFS BSSZ 5 FST WORD
EOIDT BSSZ 5 DATE/TIME WORD
SPACE 4,10
* CHECK FOR OVERFLOW.
OVERFLOW OVLU,OVLC OVERFLOW INTO COMMAND OVERLAY AREA
SPACE 4,10
OVERFLOW OVLU,BUF2-2 OVERFLOW INTO CATALOG BUFFER
EJECT
* EQUIVALENCE EXTERNALLY REFERENCED TAGS.
QUAL *
CPE EQU /".O"/CPE
UPI EQU /".O"/UPI
UPIB EQU /".O"/UPIB
OVERLAY (GET/OLD/UGET PROCESSING.)
SPACE 4,10
** THIS OVERLAY PROCESSES *GET*, *OLD*, AND *UGET* REQUESTS.
*
* ENTRY (P0) = PROCESSING ADDRESS.
OVL BSS 0 ENTRY
LDD EQ RESET MASTER DEVICE EST ORDINAL
STD T5
LJM 0,P0 PROCESS REQUEST
TITLE COMMAND PROCESSING.
GET SPACE 4,10
*** PROCESS *GET* REQUEST.
*
* GENERATE WORKING COPY OF INDIRECT ACCESS FILE *PF NAME*.
* THIS COPY WILL NOT BE PERMANENT UNTIL *SAVE* *REPLACE*
* OR *DEFINE* REQUEST FOR LOCAL FILE IS ISSUED.
GET BSS 0 ENTRY
LDN 0 CLEAR REWRITE ON FILE COPY
STM DTMD
LDM ACCM ACTUAL ACCESS MODE
LMN PTEX
NJN GET1 IF MORE THAN EXECUTE PERMISSION
LDN 4 RESTRICT LOCAL FILE TO EXECUTE-ONLY
RAM GETG
GET1 LDM FCEC,CI CHECK CATALOG ERROR STATUS
SHN -4
LPN 34
ZJN GET3 IF NO ERRORS
SBN 4
RAM GETL MODIFY ERROR CODE
GETL EQU *+2
ERROR EDA * ERROR IN FILE DATA.*
* ERROR EPT * ERROR IN PERMIT DATA.*
* ERROR EDP * DATA/PERMIT ERRORS.*
ERRNZ /ERRMSG/EPT-/ERRMSG/EDA-1 ERRORS MUST BE CONTIGUOUS
ERRNZ /ERRMSG/EDP-/ERRMSG/EPT-1 ERRORS MUST BE CONTIGUOUS
GET3 RJM CML CHECK MASS STORAGE LIMITS
LDD PB
ZJN GET3.1 IF NO PERMIT BUFFER
EXECUTE 3PE LOAD PERMIT UPDATE ROUTINES
RJM UPI UPDATE PERMISION INFORMATION
GET3.1 RJM UCE UPDATE CATALOG ENTRY
ENDMS
LDD CI SET CONTROL WORD POINTER FOR CATALOG
RAM GETE
LDM FCFS,CI PROCESS SUBSYSTEM INDEX
LPN 77
STM PFSS
ZJN GET4 IF NO SUBSYSTEM INDEX
LDD CC
LMN CCOD
NJN GET4 IF NOT *OLD* REQUEST
LDM PFSS
RJM SSF SET SUBSYSTEM FLAG IN CP AREA
* RETURN FIELDS TO FET.
* ENTER HERE FOR *UGET* REQUEST.
GET4 LDK STNS INHIBIT JOB SUSPENSION AFTER THIS POINT
RAM STAT
LDM PFSP CHECK FOR SECURITY PROCESSING BIT
ZJN GET5 IF SECURITY PROCESSING BIT NOT SPECIFIED
RJM SFA RETURN ACCESS LEVEL TO FET
ADN CFAL
CRD CM
LDD CM+1
SCN 7
LMM FCAL,CI
STD CM+1
RJM SFA
ADN CFAL
CWD CM
GET5 LDM MODE RETURN ACCESS MODE TO FET
SCN 77
LMM ACCM ACTUAL MODE FILE ACCESSED IN
STM MODE
LDN CFMD
SBM FETL
PJN GET6 IF FET NOT LONG ENOUGH FOR MODE
RJM SFA RETURN ACCESS MODE TO FET
ADN CFMD
CWM MODE-4,ON
LDN CFUC
SBM FETL
PJN GET6 IF FET NOT LONG ENOUGH FOR UCW
RJM SFA RETURN USER CONTROL WORD TO FET
ADN CFUC
CWM FCCW,ON
GETE EQU *-1 (ADDRESS OF *UCW* FROM *PFC*)
LDN CFSS
SBM FETL
PJN GET6 IF FET NOT LONG ENOUGH FOR SUBSYSTEM
RJM SFA RETURN SUBSYSTEM TO FET
ADN CFSS
CWM PFSS,ON
* UPDATE FNT/FST.
GET6 LDC PFSN SET SYSTEM FILE NAME
RJM SFN
GETG LDN 0 SET FILE ACCESS INFORMATION
* LDN 4 (EXECUTE-ONLY FILE)
RAD FN+3
GETH LDN LOFT SET FILE TYPE
* LDN PTFT (*OLD* PROCESSING)
SHN 6
RAD FN+4
LDM FNTA SET FST INFORMATION
STD FA
NFA FA,R
ADK FNTL
CWD FN
ADN FSTL-FNTL
CRD FS
* ALLOCATE MASS STORAGE SPACE ON LOCAL FILE DEVICE.
LDN 0
STD CM+1
LDD LF+1 ADJUST LENGTH FOR SYSTEM SECTOR AND EOI
ADN 2
STD CM+4
SHN -14
ADD LF
STD CM+3
LDM FCAL,CI SET ACCESS LEVEL IN REQUEST
ADN 40 SELECT ON ACCESS LEVEL
SHN 6
RAD CM+3
GETI LDN 0 SET TYPE OF FILE SPACE NEEDED
* LDN PRIS (*OLD* - REQUEST PRIMARY FILE SPACE)
STD CM+2
MONITOR RTCM ASSIGN MASS STORAGE SPACE
LDN ZERL
CRD FS
LDD CM+1 SET EST ORDINAL
STM RTKE
STD FS
LDD CM+4
NJN GET8 IF TRACKS ASSIGNED
LDD CM+3
SBN 2
ZJN GET7 IF NO TEMP DEVICE VALID FOR ACCESS LEVEL
ERROR TKL,CH,,FS *EQXXX,DNYY, TRACK LIMIT.*
GET7 ERROR NTD,CH *(FILE NAME) - NO TEMP DEVICE FOUND.*
GET8 STM RTKT SET FIRST TRACK
STD FS+1
LDM CPTF
NJN GET9 IF FILE TO BE TRANSFERRED VIA CPU
LDD FS+1
STD FS+2
LDN FSMS
STD FS+3
GET9 LDN 4 SET STATUS
STD FS+4
NFA FA,R WRITE FST
ADN FSTL
CWD FS
ADN FUTL-FSTL
CRD CM
LDM FCAL,CI SET ACCESS LEVEL IN FNT
LMD CM+2
LPN 7
LMD CM+2
STD CM+2
NFA FA,R
ADN FUTL
CWD CM
RJM SFA SET FNT POINTER IN FET
ADN 4
CRD CM
LDD FA
STD CM
RJM SFA
ADN 4
CWD CM
* UPDATE PRIMARY FILE FST POINTER IN CONTROL POINT AREA.
LDD CC
LMN CCOD
NJN GET10 IF NOT *OLD* REQUEST
RJM POF PROCESS OLD PRIMARY FILE
LDD CP SET NEW PRIMARY FILE FST POINTER
ADN TFSW
CRD CM
LDM FNTA RESTORE FST AND FST ADDRESS
STD FA
STD CM+1
NFA FA,R
ADN FSTL
CRD FS
LDD CP
ADN TFSW
CWD CM
* UPDATE PRIMARY FILE POINTERS IN EJT ENTRY.
EXECUTE 0PT,OVL0 CALL *0PT* TO UPDATE EJT POINTERS
GET10 LDD FS RESTORE EST ORDINAL
STD T5
SETMS STATUS,NS
LDD CM+4 SET TRT ADDRESS
SHN 3
ADN TRLL
RJM CTA CALCULATE FWA OF TRT
SBD TH
STM SNTA+1
STM SEIA+1
SHN -14
LMC ADCI
STM SNTA
STM SEIA
LDM SLM INCREMENT PRU COUNT FOR FIRST TRACK
RAM AIPR+1
SHN -14
RAM AIPR
* DETERMINE WHETHER TO USE CPU TO TRANSFER FILE.
LDM CPTF
ZJN GET11 IF FILE NOT TO BE TRANSFERRED VIA CPU
LDD EQ SET SYSTEM SECTOR EST/TRACK/SECTOR
STD T5
LDM SDAB
STD T6
LDM SDAC
STD T7
RJM VSS VERIFY SYSTEM SECTOR
ENDMS
GETA BSS 0 (OVERFLOW POINT FOR *3PS* LOAD)
EXECUTE 3PS TRANSFER FILE VIA CPU
* SET UP SYSTEM SECTOR.
ERRNG *-BUF-502 SYSTEM SECTOR BUFFER OVERFLOWS CODE
GET11 EXECUTE 3PP LOAD DEVICE TO DEVICE TRANSFER OVERLAY
AOD LF+1 ADJUST LENGTH FOR SYSTEM SECTOR
SHN -14
RAD LF
AOM /3PP/SNSA TURN ON PRU ACCUMULATION
LDC 3777 SET SYSTEM SECTOR CONTROL BYTE
STM BUF
LDN 77 SET WORD COUNT BYTE
STM BUF+1
LDD FA
STM FASS+BUF-BFMS
NFA FA,R READ FILE NAME
ADK FNTL
CRM BUF+FNSS-BFMS,ON
LDC LOFT*100 SET LOCAL FILE TYPE IN SYSTEM SECTOR
STM FNSS+4+BUF-BFMS
STM PFSN+4
LDD FS SET EST ORDINAL
STM EQSS+BUF-BFMS
STD T5
LDD FS+1 SET FIRST TRACK
STM FTSS+BUF-BFMS
STD T6
LDN PDTL ENTER PACKED DATE
CRM DTSS+BUF-BFMS,ON
AOM DTSS+BUF-BFMS SET ENHANCED EOI FLAG
LDN 0 SET SECTOR
STD T7
RJM SDP SWAP DISK PARAMETERS
RJM IBA INCREMENT BUFFER ADDRESS
RJM VSS VERIFY SYSTEM SECTOR
LJM DTD ENTER DEVICE TO DEVICE TRANSFER LOOP
TITLE SUBROUTINES.
VSS SPACE 4,10
** VSS - VERIFY SYSTEM SECTOR.
*
* ENTRY (T5 - T7) = SYSTEM SECTOR DISK ADDRESS.
*
* EXIT SYSTEM SECTOR READ.
* TO *ERR* IF BAD SYSTEM SECTOR OR READ ERROR.
* ERROR IDLE SET IF BAD SYSTEM SECTOR.
*
* CALLS PDV, PES, RSS.
*
* MACROS ERROR, SETMS.
VSS SUBR ENTRY/EXIT
SETMS READSTR,NS
RJM PDV PROCESS DEVICE STATUS
LDN 0 DO NOT VALIDATE FILE NAME
RJM RSS READ SYSTEM SECTOR
MJN VSS1 IF READ ERROR
ZJN VSSX IF VALID SYSTEM SECTOR
ERROR SSE,CH,,T5,,EI *EQXXX,DNYY, SYSTEM SECTOR ERROR.*
VSS1 RJM PES PROCESS ERROR STATUS
ERROR MSE,CH,,T5 *EQXXX,DNYY, MASS STORAGE ERROR.*
SPACE 4,10
* COMMON DECKS.
RIS$ SET 1 READ IAPF SYSTEM SECTOR
*CALL COMPRSS
SPACE 4,10
USE OVERLAY
OVL0 EQU *+1 LOAD ADDRESS FOR *0PT*
ERRNG BUF1-OVL0-ZPTL *0PT* OVERFLOW INTO *BUF1*
TITLE COMMAND PROCESSING (OVERLAYABLE).
OLD SPACE 4,10
*** PROCESS *OLD* REQUEST.
*
* GENERATE PRIMARY-TERMINAL FILE (*PTFT*) COPY OF INDIRECT
* ACCESS FILE *PF NAME*. THIS COPY WILL NOT BE PERMANENT
* UNTIL *SAVE* OR *REPLACE* REQUEST FOR LOCAL FILE
* IS ISSUED.
OLD BSS 0 ENTRY
LCN -PTFT+LOFT FORCE PRIMARY-FILE PROCESSING
RAM GETH
LDN PRIS
RAM GETI
LJM GET PROCESS REQUEST
UGT SPACE 4,15
*** PROCESS *UGET* REQUEST.
*
* THE *UGET* REQUEST OBTAINS A LOCAL FILE COPY OF AN INDIRECT
* ACCESS FILE WITHOUT CHANGING ANY DATES IN THE CATALOG ENTRY.
* A COPY OF THE CATALOG ENTRY IS RETURNED TO *FIRST*. THE
* *AFLOK* FLAG IS SET IN THE CATALOG ENTRY TO INDICATE THAT
* THE FILE IS ABOUT TO BE DESTAGED (ANY SUBSEQUENT *REPLACE*
* OR *APPEND* WILL CLEAR THIS FLAG, WHICH WILL THEN INDICATE
* THAT ANOTHER *UGET* MUST BE PERFORMED IF THE FILE IS STILL
* TO BE DESTAGED).
UGT BSS 0 ENTRY
LDN 0 CLEAR REWRITE ON FILE COPY
STM DTMD
* CHECK THE FILE RESIDENCE.
LDM FCBS,CI
STM SDAC SET SECTOR ADDRESS
SHN 21-13
PJN UGT1 IF INDIRECT ACCESS FILE
ERROR FDA *FILE IS DIRECT ACCESS.*
UGT1 LDM FCBT,CI
STM SDAB SET TRACK ADDRESS OF FILE
NJN UGT2 IF FILE DISK RESIDENT
ERROR FND *FILE NOT DISK RESIDENT.*
UGT2 LDM FCLF,CI SET FILE LENGTH
STD LF
LDM FCLF+1,CI
STD LF+1
* UPDATE CATALOG ENTRY.
LDM FCAF,CI SET *AFLOK* FLAG
LPC -AFLOKM
LMC AFLOKM
STM FCAF,CI
LDD CB REWRITE CATALOG ENTRY
RJM WBI
ENDMS
* RETURN COPY OF THE *PFC* ENTRY TO THE BUFFER.
RJM SFA READ *FIRST* POINTER
ADN 1
CRD CM
LDD CM+3 VERIFY *FIRST* POINTER
LPN 77
SHN 6
ADD RA
SHN 6
ADD CM+4
ADN NWCE
SBN 1
SHN -6
SBD RA
SBD FL
MJN UGT3 IF BUFFER WITHIN JOB FL
ERROR ILR,CH,,,EC3 * PFM INCORRECT REQUEST.*
UGT3 LDD CI COPY CATALOG ENTRY TO BUFFER
STM UGTA
RAM GETE SET CONTROL WORD POINTER FOR CATALOG
LDN NWCE NUMBER OF PFC WORDS
STD T1
LDD CM+3 FORM *CM* ADDRESS
LPN 77
SHN 6
ADD RA
SHN 6
ADD CM+4
CWM **,T1
UGTA EQU *-1 (CATALOG ENTRY ADDRESS)
LJM GET4 PROCESS FILE TRANSFER
TITLE SUBROUTINES (OVERLAYABLE).
CML SPACE 4,15
** CML - CHECK MASS STORAGE LIMIT.
*
* ENTRY (LF - LF+1) = VALUE OF DECREMENT.
* (CMLA) = UPPER 6 (OF 18 BITS) MASS STORAGE LIMIT.
* (CMLB) = LOWER 12 BITS OF MASS STORAGE LIMIT.
*
* EXIT TO *ERR* IF ERROR IN PRU LIMITS.
*
* USES T0, CM - CM+4.
CML SUBR
LDD CP READ MASS STORAGE LIMIT
ADK ACLW
CRD CM
LDD LF
LPN 77
STD T0
LDD CM+3
LPN 77
SBD T0
MJN CML1 IF LIMIT EXCEEDED
NJN CMLX IF LIMIT NOT EXCEEDED
LDD CM+4
SBD LF+1
PJN CMLX IF LIMIT NOT EXCEEDED
CML1 ERROR PRL *PRU LIMIT.*
POF SPACE 4,15
** POF - PROCESS OLD PRIMARY FILE.
*
* ENTRY FNT ADDRESS OF CURRENT PRIMARY FILE IN *TFSW*.
*
* EXIT OLD PRIMARY FILE CHANGED TO *LOFT*.
*
* USES FA, CM - CM+4, FS - FS+4.
*
* CALLS SFB.
*
* MACROS ERROR.
POF SUBR ENTRY/EXIT
LDD CP GET FNT ADDRESS OF OLD PRIMARY FILE
ADK TFSW
CRD CM
LDD CM+1
ZJN POFX IF NO OLD PRIMARY FILE
* CHANGE OLD PRIMARY FILE TO TYPE *LOFT*.
STD FA SET FILE BUSY
NFA FA,R
ADK FNTL
CRD FS
RJM SFB
NJN POF1 IF FILE NOT INTERLOCKED
LDC LOFT*100-PTFT*100 CHANGE FILE TYPE
RAD CM+4
AOD FS+4 SET FST COMPLETE
NFA FA,R
ADK FNTL
CWD CM
ADN FSTL-FNTL
CWD FS
UJN POFX RETURN
* PROCESS *I/O SEQUENCE ERROR* ON OLD PRIMARY FILE. CHANGE THE
* NEW LOCAL FILE FROM *PTFT* TO *LOFT*, SO THAT *0DF* WILL NOT
* CLEAR THE PRIMARY FILE POINTER IN THE CPA AND THE EJT WHEN
* THE NEW LOCAL FILE IS RETURNED.
POF1 LDM FNTA RESET FST AND FST POINTER
STD FA
NFA FA,R
ADK FNTL
CRD FN
LDD FN+4
LPN 77
LMC LOFT*100
STD FN+4
NFA FA,R
ADK FNTL
CWD FN
ERROR IOE * I/O SEQUENCE ERROR.*
SPACE 4,10
* OVERLAYABLE COMMON DECKS.
*CALL COMPSFB
*CALL COMPSSF
SPACE 4,10
OVERFLOW OVLC,BUF1-2 OVERFLOW INTO CATALOG BUFFER
SPACE 4,10
* EQUIVALENCE EXTERNALLY REFERENCED TAGS.
QUAL *
GETA EQU /".O"/GETA
OVERLAY (SAVE/REPLACE/UREPLAC PROCESSING.)
SPACE 4,10
** THIS OVERLAY PROCESSES *SAVE*/*REPLACE*/*UREPLAC* REQUESTS.
*
* ENTRY (P0) = PROCESSING ADDRESS.
OVL BSS 0 ENTRY
LJM 0,P0 PROCESS REQUEST
TITLE COMMAND PROCESSING.
REP SPACE 4,10
*** PROCESS *REPLACE* REQUEST.
*
* PURGE EXISTING PERMANENT FILE *PF NAME* AND GENERATE COPY
* OF FILE *FILE NAME* AS INDIRECT ACCESS FILE *PF NAME*.
REP BSS 0 ENTRY
LDM FCBS,CI
SHN 21-13
PJN REP1 IF NOT DIRECT ACCESS FILE
ERROR FDA * FILE IS DIRECT ACCESS.*
* CHECK LOCAL FILE ACCESS LEVEL AGAINST *PFC*.
REP1 LDM SSOM CHECK SYSTEM SECURITY MODE
ZJN REP2 IF SYSTEM OPERATING IN UNSECURED MODE
LDM FCAL,CI ALLOW SAVING DATA AT HIGHER LEVEL
SBM LFAL
PJN REP2 IF ACCESS LEVEL OKAY
LDM SVAL
LPN 40
NJN REP2 IF WRITE-DOWN PERMITTED
LDM SSID CHECK SUBSYSTEM ID
SBK LSSI+1
PJN REP2 IF SUBSYSTEM
ERROR WDP,,,,SVE * WRITE-DOWN OF DATA PROHIBITED.*
* UPDATE PERMITS.
REP2 RJM CUC CHECK USER CONTROLS
LDD PB
ZJN REP2.1 IF NO PERMIT BUFFER
EXECUTE 3PE LOAD PERMIT UPDATE ROUTINES
RJM UPI UPDATE PERMISSION INFORMATION
ENDMS
* UPDATE CATALOG.
REP2.1 LDD CI CLEAR ALTERNATE STORAGE INFORMATION IN PFC
RAM REPA+1
LDN ZERL
REPA CRM FCAF,ON
LDD CI CLEAR TAPE ALTERNATE STORAGE INFORMATION
RAM REPC+1
LDN ZERL
REPC CRM FCTF,ON
REP3 AOM FCAC+1,CI INCREMENT ACCESS COUNT
SHN -14
RAM FCAC,CI
EXECUTE 3PD LOAD CATALOG UPDATE ROUTINES
RJM IIA INTERLOCK INDIRECT ALLOCATION
LDK STNS SET *NO JOB SUSPENSION* AFTER THIS POINT
RAM STAT
RJM CCS CREATE NEW CATALOG SECTOR
LDD HP
LMD CI
ZJN REP4 IF HOLE IS FILE BEING REPLACED
RJM DCE DELETE CATALOG ENTRY
ZJN REP4 IF FILE WITHIN CHAIN AND NO DELINK
RJM CIA CLEAR INDIRECT ALLOCATION INTERLOCK
UJN REP6 TRANSFER FILE
* REWRITE OLD FILE-S CATALOG ENTRY.
* ENTER HERE ON *UREPLAC* REQUEST.
REP4 RJM CIA CLEAR INDIRECT ALLOCATION INTERLOCK
LDD CB REWRITE CATALOG ENTRY
RJM WBI
ENDMS
REP6 LJM SAV2 TRANSFER FILE
SAV SPACE 4,10
*** PROCESS *SAVE* REQUEST.
*
* GENERATE COPY OF FILE *FILE NAME* AS INDIRECT ACCESS FILE
* *PF NAME*. IF *PF NAME* EXISTS REQUEST IS ABORTED.
SAV BSS 0 ENTRY
LDM LFAL
STD CM+4
LDD EQ CHECK MASTER DEVICE ACCESS LEVEL
STD CM+2
LDN VAES
STD CM+1
MONITOR VSAM
LDD CM+1
ZJN SAV1 IF FILE ACCESS VALID FOR DEVICE
ERROR LNP,,,,SVE * ACCESS LEVEL NOT VALID ON PF DEVICE.*
SAV1 RJM CUC CHECK USER CONTROLS
EXECUTE 3PD LOAD CATALOG UPDATE ROUTINES
RJM IIA INTERLOCK INDIRECT ALLOCATION
LDK STNS SET *NO JOB SUSPENSION* AFTER THIS POINT
RAM STAT
RJM CCS CREATE CATALOG SECTOR
RJM CIA CLEAR INDIRECT ALLOCATION INTERLOCK
* ENTER HERE ON *REPLACE* OR *UREPLAC* REQUEST.
SAV2 LDM CPTF
ZJN SAV3 IF FILE NOT TO BE TRANSFERRED VIA CPU
SAVA BSS 0 (OVERFLOW POINT FOR *3PS* LOAD)
EXECUTE 3PS TRANSFER FILE VIA CPU
SAV3 EXECUTE 3PP LOAD DEVICE TO DEVICE TRANSFER OVERLAY
LDD FS SET EST ORDINAL
STD T5
LDD FS+1 SET FIRST TRACK
STD T6
LDN FSMS SET FIRST SECTOR
STD T7
SETMS READSTR,NS
RJM PDV PROCESS DEVICE STATUS
LDC BUF SET STARTING BUFFER ADDRESS
STD BB
AOD LF+1 ADJUST FILE LENGTH FOR SYSTEM SECTOR
SHN -14
RAD LF
ERRNG *-BUF-502 SYSTEM SECTOR BUFFER OVERFLOWS CODE
RJM CSS CREATE SYSTEM SECTOR IN BUFFER
RJM IBA INCREMENT BUFFER ADDRESS
LJM DTD ENTER DEVICE TO DEVICE TRANSFER LOOP
URE SPACE 4,20
*** PROCESS *UREPLAC* REQUEST.
*
* MAKE ALTERNATE STORAGE RESIDENT FILE DISK RESIDENT
* BY CREATING A PERMANENT COPY OF THE DATA TO BE
* ASSOCIATED WITH THE EXISTING PFC ENTRY.
*
* THE DATA WILL EITHER BE PLACED IN A PREVIOUSLY
* EXISTING IAPF HOLE OR SPACE WILL BE ALLOCATED
* AT THE END OF THE INDIRECT CHAIN. IF A HOLE IS
* FOUND THE TRACK AND SECTOR FROM THE HOLE WILL BE
* PLACED IN THE EXISTING PFC AND THE HOLE WILL BE
* CONVERTED TO A DAPF HOLE. THIS IS DONE SO THAT
* THE POSITION OF THE ORIGINAL PFC DOES NOT CHANGE,
* SINCE THE RESCAN CODE IN *PFDUMP* REQUIRES THAT
* THE POSITION OF THE PFC REMAIN CONSTANT.
URE BSS 0 ENTRY
EXECUTE 3PD LOAD CATALOG UPDATE ROUTINES
LDC LJMI BYPASS HOLE CHECK IN *CCS*
STM CCSE
LDC CCS5.1
STM CCSE+1
RJM IIA INTERLOCK INDIRECT ALLOCATION
LDK STNS SET *NO JOB SUSPENSION* AFTER THIS POINT
RAM STAT
LDD HP HOLE POINTER
NJN URE1 IF HOLE AVAILABLE
RJM AFS ALLOCATE FILE SPACE
LDD LF+1
STD HL SIMULATE EXACT FIT HOLE (FOR *CCS*)
LDD CB
STD HB
UJN URE2 SET DISK ADDRESS IN ORIGINAL PFC
* PROCESS HOLE ENTRY.
URE1 LDM FCBT,HP SAVE FIRST TRACK FROM HOLE ENTRY
STM SDAB
LDM FCBS,HP SAVE FIRST SECTOR FROM HOLE ENTRY
STM SDAC
LDC 4000 MARK HOLE AS DAPF HOLE
STM FCBS,HP
LDN 0
STM FCBT,HP CLEAR TRACK IN HOLE ENTRY
STM FCLF,HP CLEAR HOLE ENTRY LENGTH
STM FCLF+1,HP
LDD CI SET HOLE POINTER TO POINT TO PFC FOR *FHE*
STD HP
* SET NEW VALUES IN ORIGINAL PFC ENTRY.
URE2 LDM SDAB
STM FCBT,CI FIRST TRACK
LDM SDAC
STM FCBS,CI FIRST SECTOR
LDD LF SET NEW FILE LENGTH
STM FCLF,CI
LDD LF+1
STM FCLF+1,CI
LDM STAT
LPK STTA
NJN URE3 IF TAPE ALTERNATE STORAGE REQUEST
LDM FCAF,CI CLEAR *AFVER*, *AFPDR* AND *AFTMP* FLAGS
SCN AFPDRM+AFTMPM+AFVERM
STM FCAF,CI
UJN URE4 UPDATE CATALOG ENTRY
URE3 LDM FCTF,CI CLEAR *TFVER* FLAG
SCN TFVERM
STM FCTF,CI
URE4 RJM CCS CREATE CATALOG SECTOR
LJM REP4 PROCESS FILE TRANSFER
RSS SPACE 4,10
TITLE SUBROUTINES.
CSS SPACE 4,10
** CSS - CREATE SYSTEM SECTOR IN BUFFER.
*
* ENTRY (FA) = FNT OFFSET FOR LOCAL FILE.
* (PFCA) = ADDRESS OF NEW CATALOG ENTRY.
*
* EXIT (BUF - BUF+502) = INITIALIZED SYSTEM SECTOR.
*
* USES T1, T2, T3.
CSS SUBR ENTRY/EXIT
LDC 77*5-1 CLEAR SYSTEM SECTOR
STD T1
CSS1 LDN 0
STM BUF+2,T1
SOD T1
PJN CSS1 IF NOT END OF SECTOR
LDC 3777 SET CONTROL BYTES
STM BUF
LDN 77
STM BUF+1
NFA FA,R COPY FNT TO BUFFER
ADK FNTL
CRM FNSS+BUF-BFMS,ON
LDM FNSS+3+BUF-BFMS
SCN 77
STM FNSS+3+BUF-BFMS
LDC PMFT*100 SET FILE TYPE
STM FNSS+4+BUF-BFMS
LDM SDAA SET EST ORDINAL
STM EQSS+BUF-BFMS
LDM SDAA+1 SET FIRST TRACK
STM FTSS+BUF-BFMS
LDN PDTL ENTER PACKED DATE
CRM DTSS+BUF-BFMS,ON
* COPY CATALOG ENTRY INTO SYSTEM SECTOR.
LDM PFCA ADDRESS OF CATALOG ENTRY
STD T1
LDC CTSS+BUF-BFMS ADDRESS IN SYSTEM SECTOR
STD T2
ADC NWCE*5 NUMBER OF BYTES TO COPY
STD T3
CSS2 LDI T1 TRANSFER ENTRY
STI T2
AOD T1
AOD T2
LMD T3
NJN CSS2 IF MORE BYTES TO TRANSFER
LJM CSSX RETURN
CUC SPACE 4,20
** CUC - CHECK USER CONTROLS.
*
* CHECK NUMBER OF FILES.
* CHECK CUMULATIVE SIZE OF INDIRECT ACCESS FILES.
*
* ENTRY (ACNF - ACFN+1) = NUMBER OF FILES IN CATALOG.
* (CIFS - CIFS+1) = CUMULATIVE SIZE OF INDIRECT FILES.
* (MXCS - MXCS+1) = CUMULATIVE SIZE OF INDIRECTS ALLOWED.
* (MXNF) = MAXIMUM NUMBER OF FILES.
* (LF - LF+1) = LENGTH OF NEW FILE.
* (CI) = INDEX TO EXISTING CATALOG ENTRY OF FILE REPLACED
*
* USES CM - CM+4.
*
* MACROS ERROR.
CUC SUBR ENTRY/EXIT
LDD MA SET CUMULATED TOTALS
CWM ACNF,ON
SBN 1
CRD CM
* CHECK NUMBER OF FILES ALLOWED.
LDM MXNF
ZJN CUC1 IF NO LIMIT ON NUMBER OF FILES
LDD CM
SHN 14
ADD CM+1
ADN 7 ROUND UP
SHN -3
SBM MXNF
MJN CUC1 IF NUMBER OF FILES ALLOWED NOT EXCEEDED
ZJN CUC1 IF NUMBER OF FILES ALLOWED NOT EXCEEDED
ERROR COF * TOO MANY PERMANENT FILES.*
* CHECK CUMULATIVE SIZE OF INDIRECT FILES.
CUC1 LDM MXCS
NJN CUC2 IF SIZE CONTROL SET
LDM MXCS+1
ZJN CUCX IF NO SIZE CONTROL SET
* DECREMENT ACCUMULATED SIZE BY SIZE OF FILE REPLACED.
CUC2 LDD CI
ZJN CUC4 IF NO PREVIOUS FILE
LDD CM+3
SBM FCLF+1,CI
STD CM+3
PJN CUC3 IF NO 12 BIT OVERFLOW
AOD CM+3
SOD CM+2
CUC3 LDD CM+2
SBM FCLF,CI
STD CM+2
* INCREMENT CUMULATIVE SIZE FOR NEW FILE.
CUC4 LDD LF+1
RAD CM+3
SHN -14
ADD LF
RAD CM+2
SHN -14
ZJN CUC6 IF NO OVERFLOW
CUC5 ERROR COS * TOO MUCH INDIRECT ACCESS FILE SPACE.*
CUC6 LDD CM+2 CHECK SIZE AGAINST THAT ALLOWED
SBM MXCS
MJN CUC7 IF NO OVERFLOW
NJN CUC5 IF OVERFLOW
LDD CM+3
SBM MXCS+1
MJN CUC7 IF NO OVERFLOW
NJN CUC5 IF OVERFLOW
CUC7 LJM CUCX
SPACE 4,10
* CHECK FOR OVERFLOW.
OVERFLOW OVLC,BUF2-2 OVERFLOW INTO CATALOG BUFFER
SPACE 4,10
* EQUIVALENCE EXTERNALLY REFERENCED TAGS.
QUAL *
SAVA EQU /".O"/SAVA
OVERLAY (APPEND PROCESSING.)
APP SPACE 4,10
** THIS OVERLAY PROCESSES THE INDIRECT ACCESS FILE
* COMMAND *APPEND*.
OVL BSS 0 ENTRY
* LJM 0,P0 PROCESS REQUEST
TITLE COMMAND PROCESSING.
SPACE 4,10
*** PROCESS *APPEND* REQUEST.
*
* APPEND LOCAL FILE *FILE NAME* AT EOI OF INDIRECT ACCESS
* PERMANENT FILE *PF NAME*.
APP BSS 0 ENTRY
LDD CI CLEAR ALTERNATE STORAGE INFORMATION IN PFC
RAM APPA+1
LDN ZERL
APPA CRM FCAF,ON
LDD CI CLEAR TAPE ALTERNATE STORAGE INFORMATION
RAM APPI+1
LDN ZERL
APPI CRM FCTF,ON
* CHECK LOCAL FILE ACCESS LEVEL AGAINST *PFC*.
LDM SSOM CHECK SYSTEM SECURITY MODE
ZJN APP1 IF SYSTEM OPERATING IN UNSECURED MODE
LDM FCAL,CI
SBM LFAL
PJN APP1 IF ACCESS LEVEL ACCEPTABLE
LDM SVAL
LPN 40
NJN APP1 IF WRITE-DOWN ALLOWED
LDM SSID CHECK SUBSYSTEM ID
SBK LSSI+1
PJN APP1 IF SUBSYSTEM
ERROR WDP,,,,SVE * WRITE-DOWN OF DATA PROHIBITED.*
APP1 LDM FCEC,CI CHECK CATALOG ERROR STATUS
SHN -4
LPN 34
ZJN APP3 IF NO ERRORS
SBN 4
RAM APPH MODIFY ERROR CODE
APPH EQU *+2
ERROR EDA * ERROR IN FILE DATA.*
* ERROR EPT * ERROR IN PERMIT DATA.*
* ERROR EDP * DATA/PERMIT ERRORS.*
ERRNZ /ERRMSG/EPT-/ERRMSG/EDA-1 ERRORS MUST BE CONTIGUOUS
ERRNZ /ERRMSG/EDP-/ERRMSG/EPT-1 ERRORS MUST BE CONTIGUOUS
APP3 LDM STAT CHECK FOR PREVIOUS ERROR
LPN STAB
ZJN APP4 IF NO PREVIOUS ERROR
ERROR FTL *FILE TOO LONG.*
* UPDATE PERMITS.
APP4 RJM CUC CHECK USER CONTROLS
LDD PB
ZJN APP4.1 IF NO PERMIT BUFFER
EXECUTE 3PE LOAD PERMIT UPDATE ROUTINES
RJM UPI UPDATE PERMISSION INFORMATION
ENDMS
* UPDATE CATALOG.
APP4.1 EXECUTE 3PD LOAD CATALOG UPDATE ROUTINES
LDD CI SAVE CURRENT VALUE OF (FCKD)
RAM APPG
LDD MA
CWM FCKD,ON
APPG EQU *-1
SBN 1
CRM APPF,ON
LDN PSNI FORCE SPECIAL *APPEND* PROCESSING IN *DCE*
STM DCEC
STM DCED
STM DCEE
RJM IIA INTERLOCK INDIRECT ALLOCATION
LDK STNS SET *NO JOB SUSPENSION* AFTER THIS POINT
RAM STAT
RJM DCE DELETE CATALOG ENTRY
LMN 2
ZJP APP9 IF FILE AT END OF CHAIN
* PROCESS FILE WITHIN CHAIN.
AOM FCAC+1,CI INCREMENT ACCESS COUNT
SHN -14
RAM FCAC,CI
RJM CCS CREATE CATALOG SECTOR
LDM APDK+1
NJN APP4.2 IF DELAYED DELINK PENDING
RJM CIA CLEAR INDIRECT ALLOCATION INTERLOCK
* REWRITE OLD FILE-S CATALOG ENTRY.
APP4.2 LDD CB REWRITE OLD FILE-S CATALOG SECTOR
RJM WBI
ENDMS
LDM CPTF
ZJN APP7 IF FILE NOT TO BE TRANSFERRED VIA CPU
RJM VSS VERIFY SYSTEM SECTOR
ENDMS
APPB BSS 0 (OVERFLOW POINT FOR *3PS* LOAD)
EXECUTE 3PS TRANSFER FILE VIA CPU
ERRNG *-BUFA-502 SYSTEM SECTOR BUFFER OVERFLOWS CODE
APP7 EXECUTE 3PP LOAD DEVICE TO DEVICE TRANSFER OVERLAY
EXECUTE 3PQ LOAD TRANSFER ORIGINAL FILE OVERLAY
AOM DPCA DISABLE SRU ACCUMULATION
LDC BUFA SET BUFFER ADDRESS
STD BB
STM SDPA
RJM CSS CREATE SYSTEM SECTOR IN *BUFA*
RJM IBA INCREMENT BUFFER ADDRESS
AOD LF+1 ADJUST LENGTH TO ACCOUNT FOR SYSTEM SECTOR
SHN -14
RAD LF
RJM VSS VERIFY SYSTEM SECTOR
LJM ADT TRANSFER ORIGINAL FILE AND LOCAL FILE
* PROCESS APPEND TO FILE AT END OF DATA CHAIN AS A *SAVE*
* OF THE APPENDAGE.
APP9 LDC STEC SET *APPEND TO END OF CHAIN* FLAG
RAM STAT
LDD CI SAVE CATALOG ADDRESS
STM PFCA
LDD T6 SAVE CURRENT EOI OF DATA CHAIN (TRACK)
STM APPD
LDM FCBT,CI
STD T6
LDD T1 SAVE CURRENT EOI SECTOR
STM APPE
LDD LF SET LENGTH OF NEW FILE IN CATALOG
STM FCLF,CI
LDD LF+1
STM FCLF+1,CI
LDM APLF SET LENGTH OF APPENDAGE
STD LF
LDM APLF+1
STD LF+1
ISTORE AFSB,(PSN) DO NOT ALLOCATE FOR SYSTEM SECTOR OR EOI
RJM AFS ALLOCATE SPACE FOR APPENDAGE
RJM CIA CLEAR INDIRECT ALLOCATION INTERLOCK
LDD UI RESET USER INDEX IN DELETED PFC
RAM FCUI,CI
LDD UI+1
STM FCUI+1,CI
LDD CI RESTORE PREVIOUS VALUE OF *FCKD*
RAM APPC
LDD MA
CWM APPF,ON
SBN 1
CRM FCKD,ON
APPC EQU *-1
LDC STMI+CI FORCE UPDATE OF FCUD/FCMD IN *UCE*
STM UCEA
RJM UCE UPDATE CATALOG ENTRY
LDC ** SET FIRST TRACK TO PLACE APPENDAGE
APPD EQU *-1
STM SDAB
LDC **
APPE EQU *-1
STM SDAC
ENDMS
LDM CPTF
ZJN APP10 IF FILE NOT TO BE TRANSFERRED VIA CPU
EXECUTE 3PS TRANSFER FILE VIA CPU
APP10 EXECUTE 3PP LOAD DEVICE TO DEVICE TRANSFER OVERLAY
LDD FS SET LOCAL FILE EST ORDINAL
STD T5
LDD FS+1 SET FIRST TRACK
STD T6
LDN FSMS SET FIRST SECTOR
STD T7
SETMS READSTR,NS
RJM PDV PROCESS DEVICE STATUS
LDC BUF SET STARTING BUFFER ADDRESS
STD BB
LJM DTD ENTER DEVICE TO DEVICE TRANSFER LOOP
APPF BSS 5 BUFFER TO SAVE (FCKD)
TITLE SUBROUTINES.
CSS SPACE 4,10
** CSS - CREATE SYSTEM SECTOR IN BUFFER.
*
* ENTRY (PFCA) = ADDRESS OF NEW CATALOG ENTRY.
*
* EXIT (BUFA - BUFA+502) = INITIALIZED SYSTEM SECTOR.
*
* USES T1, T2, T3.
CSS SUBR ENTRY/EXIT
LDC 77*5-1 CLEAR SYSTEM SECTOR
STD T1
CSS1 LDN 0
STM BUFA+2,T1
SOD T1
PJN CSS1 IF NOT END OF SECTOR
LDC 3777 SET CONTROL BYTES
STM BUFA
LDN 77
STM BUFA+1
LDD CI+FCFN* SET PERMANENT FILE NAME
STM CSSA
LDD MA COPY FILE NAME TO BUFFER
CWM *,ON
CSSA EQU *-1
SBN 1
CRM FNSS+BUFA-BFMS,ON
LDM FNSS+3+BUFA-BFMS
SCN 77
STM FNSS+3+BUFA-BFMS
LDC PMFT*100 SET FILE TYPE
STM FNSS+4+BUFA-BFMS
LDM SDAA SET EST ORDINAL
STM EQSS+BUFA-BFMS
LDM SDAA+1 SET FIRST TRACK
STM FTSS+BUFA-BFMS
LDN PDTL ENTER PACKED DATE
CRM DTSS+BUFA-BFMS,ON
* COPY CATALOG ENTRY INTO SYSTEM SECTOR.
LDM PFCA ADDRESS OF CATALOG ENTRY
STD T1
LDC CTSS+BUFA-BFMS ADDRESS IN SYSTEM SECTOR
STD T2
ADC NWCE*5 NUMBER OF BYTES TO COPY
STD T3
CSS2 LDI T1 TRANSFER ENTRY
STI T2
AOD T1
AOD T2
LMD T3
NJN CSS2 IF MORE BYTES TO TRANSFER
LJM CSSX RETURN
CUC SPACE 4,21
** CUC - CHECK USER CONTROLS.
*
* CHECK NUMBER OF FILES.
* CHECK CUMULATIVE SIZE OF INDIRECT ACCESS FILES.
*
* ENTRY (ACNF - ACFN+1) = NUMBER OF FILES IN CATALOG.
* (MXNF) = MAXIMUM NUMBER OF FILES.
* (CIFS - CIFS+1) = CUMULATIVE SIZE OF INDIRECT FILES.
* (MXCS - MXCS+1) = CUMULATIVE SIZE OF INDIRECTS ALLOWED.
* (LF - LF+1) = LENGTH OF NEW FILE.
* (CI) = INDEX TO EXISTING CATALOG ENTRY
* OF FILE REPLACED.
*
* USES CM - CM+4.
*
* MACROS ERROR.
CUC SUBR ENTRY/EXIT
LDD MA SET CUMULATED TOTALS
CWM ACNF,ON
SBN 1
CRD CM
* CHECK NUMBER OF FILES ALLOWED.
LDM MXNF
ZJN CUC1 IF NO LIMIT ON NUMBER OF FILES
LDD CM
SHN 14
ADD CM+1
ADN 7 ROUND UP
SHN -3
SBM MXNF
MJN CUC1 IF NUMBER OF FILES ALLOWED NOT EXCEEDED
ZJN CUC1 IF NUMBER OF FILES ALLOWED NOT EXCEEDED
ERROR COF * TOO MANY PERMANENT FILES.*
* CHECK CUMULATIVE SIZE OF INDIRECT FILES.
CUC1 LDM MXCS
NJN CUC2 IF SIZE CONTROL SET
LDM MXCS+1
ZJN CUCX IF NO SIZE CONTROL SET
* DECREMENT ACCUMULATED SIZE BY SIZE OF FILE REPLACED.
CUC2 LDD CI
ZJN CUC4 IF NO PREVIOUS FILE
LDD CM+3
SBM FCLF+1,CI
STD CM+3
PJN CUC3 IF NO 12 BIT OVERFLOW
AOD CM+3
SOD CM+2
CUC3 LDD CM+2
SBM FCLF,CI
STD CM+2
* INCREMENT CUMULATIVE SIZE FOR NEW FILE.
CUC4 LDD LF+1
RAD CM+3
SHN -14
ADD LF
RAD CM+2
SHN -14
ZJN CUC6 IF NO OVERFLOW
CUC5 ERROR COS * TOO MUCH INDIRECT ACCESS FILE SPACE.*
CUC6 LDD CM+2 CHECK SIZE AGAINST THAT ALLOWED
SBM MXCS
MJN CUC7 IF NO OVERFLOW
NJN CUC5 IF OVERFLOW
LDD CM+3
SBM MXCS+1
MJN CUC7 IF NO OVERFLOW
NJN CUC5 IF OVERFLOW
CUC7 LJM CUCX EXIT
VSS SPACE 4,10
** VSS - VERIFY SYSTEM SECTOR.
*
* ENTRY (APTK - APSC) = SYSTEM SECTOR DISK ADDRESS.
*
* EXIT SYSTEM SECTOR READ.
* TO *ERR* IF BAD SYSTEM SECTOR OR READ ERROR.
* ERROR IDLE SET IF BAD SYSTEM SECTOR OR READ ERROR.
*
* CALLS PDV, PES, RSS.
*
* MACROS ERROR.
VSS SUBR ENTRY/EXIT
LDD EQ SET EST ORDINAL
STD T5
LDM APTK SET BEGINNING TRACK
STD T6
LDM APSC SET BEGINNING SECTOR
STD T7
SETMS READSTR,NS
RJM PDV PROCESS DEVICE STATUS
LDN 0 DO NOT VALIDATE FILE NAME
RJM RSS READ SYSTEM SECTOR
MJN VSS1 IF READ ERROR
ZJN VSSX IF VALID SYSTEM SECTOR
ERROR SSE,CH,,T5,,EI *EQXXX,DNYY, SYSTEM SECTOR ERROR.*
VSS1 RJM PES PROCESS ERROR STATUS
ERROR MSE,CH,,T5,,EI *EQXXX,DNYY, MASS STORAGE ERROR.*
SPACE 4,10
* COMMON DECKS.
RIS$ SET 1 READ INDIRECT-ACCESS FILE SYSTEM SECTOR
*CALL COMPRSS
SPACE 4,10
* CHECK FOR OVERFLOW.
OVERFLOW OVLC,BUF2-2 OVERFLOW INTO CATALOG BUFFER
SPACE 4,10
* EQUIVALENCE EXTERNALLY REFERENCED TAGS.
QUAL *
APPB EQU /".O"/APPB
OVERLAY (ATTACH/UATTACH PROCESSING.)
SPACE 4,10
** THIS OVERLAY PROCESSES THE DIRECT ACCESS FILE
* COMMANDS *ATTACH* AND *UATTACH*.
OVL BSS 0 ENTRY
LDD EQ RESET MASTER DEVICE EST ORDINAL
STD T5
LJM 0,P0 CALL FUNCTION PROCESSOR
TITLE COMMAND PROCESSING.
UAT SPACE 4,10
*** PROCESS *UATTACH* REQUEST.
*
* ATTACH DIRECT ACCESS FILE SPECIFIED BY *PFID* TO JOB,
* WITH LOCAL FILE NAME *FILE NAME*. DO NOT UPDATE ANY
* ACCESS COUNTS OR DATES, SINCE THIS IS NOT A USER ACCESS.
UAT BSS 0
LDM FNMD
SHN 21-1
MJN ATT IF WRITEABLE MODE ACCESS
ISTORE UCEA,(UJN UCE3) FORCE BYPASS OF DATE/TIME UPDATES
* UJN ATT ATTACH FILE
ATT SPACE 4,10
*** PROCESS *ATTACH* REQUEST.
*
* ATTACH DIRECT ACCESS FILE *PF NAME* TO JOB, WITH LOCAL
* FILE NAME *FILE NAME*.
ATT BSS 0 ENTRY
LDM FCDN,CI CHECK DEVICE NUMBER
LPN 77
ZJN ATT3 IF FILE ON MASTER DEVICE
* PROCESS ALTERNATE DEVICE ACCESS.
STD CM
LDM PFPN+4 SET FAMILY EST ORDINAL
RJM SDN SEARCH FOR DEVICE NUMBER
PJN ATT2 IF DEVICE FOUND
ADN 1
RJM PDA PROCESS DEVICE AVAILABILITY
ATT1 ERROR DAD,CH * DIRECT ACCESS DEVICE ERROR.*
ATT2 RJM IRA PRESET COMMON DECKS FOR FILE DEVICE
LDD CC
LMN CCUA
ATT3 ZJN ATT5 IF *UATTACH* REQUEST
SFA EST,T5 CHECK ERROR IDLE
ADK EQDE
CRD CM
LDD CM+4
SHN 3
ADN ACGL
CRD CM
LDD CM+4
LPN 20
ZJN ATT5 IF NO ERROR IDLE ON EQUIPMENT
LDM SSJS
ZJN ATT4 IF NOT *SSJ=* JOB
LDM PFSR
LPN 77
LMN SRIE
ZJN ATT5 IF *IGNORE ERROR IDLE* SPECIAL REQUEST
ATT4 ERROR PFN,CH * DEVICE UNAVAILABLE.*
ATT4.1 ERROR TNR,CH,,T5 * EQXXX,DNYY,TRACK NOT RESERVED.*
* INITIALIZE FOR SYSTEM SECTOR PROCESSING.
ATT5 LDM FCBT,CI SET FILE FIRST TRACK
STD P2
STD T6
STM PFFT
RJM ITC INTERLOCK TRACK CHAIN FOR FILE
NJN ATT4.1 IF TRACK NOT RESERVED
LDD T5 SAVE THE FILES EST ORDINAL
STD FS
STM PFEQ
AOM DAIF SET INTERLOCK FLAG
RJM CSL CHECK SIZE LIMITS
LDD P2 RESET FIRST TRACK
STD T6
SETMS IO
RJM PDV PROCESS DEVICE STATUS
LDN 0 DONT VERIFY FILE NAME IN SYSTEM SECTOR
RJM RSS READ SYSTEM SECTOR
ZJN ATT8 IF LEGAL SYSTEM SECTOR
MJN ATT7 IF READ ERROR
LDC /ERRMSG/DAF*4 *EQXXX,DNYY, DIRECT ACCESS FILE ERROR.*
UJN ATT9 PROCESS FILE ERROR
ATT7 RJM PES PROCESS ERROR STATUS
LDC /ERRMSG/MSE*4 *EQXXX,DNYY, MASS STORAGE ERROR.*
UJN ATT9 PROCESS FILE ERROR
* CHECK FOR AN EXISTING UTILITY ACTIVE FILE CONDITION.
ATT8 LDM CASS CHECK CURRENT ACCESS MODE
SHN 21-6
PJN ATT11 IF UTILITY MODE NOT SET
LDD CC CHECK FOR ANOTHER UTILITY ATTACH REQUEST
LMN CCUA
NJN ATT11 IF NOT UTILITY ATTACH
LDN /ERRMSG/FBS*4 * FILE BUSY.*
ATT9 LJM PFE PROCESS FILE ERROR
ATT10 LDC /ERRMSG/FSE*4 * FILE BOI/EOI/UI MISMATCH.*
UJN ATT9 PROCESS FILE ERROR
* PROCESS USER INDEX/CREATION DATE VALIDATION.
ATT11 LDM FCUI,CI COMPARE USER INDEX FIELDS
LMM CTSS+FCUI
LPN 77
NJN ATT10 IF MISMATCH ON USER INDEX
LDM FCUI+1,CI
LMM CTSS+FCUI+1
NJN ATT10 IF MISMATCH ON USER INDEX
LDN 2 SET UP CHECK ON CREATION DATE
STD P0
ATT12 LDM FCCD+2,CI
ATTA EQU *-1
LMM CTSS+FCCD,P0
NJN ATT10 IF NO MATCH ON CREATION DATE
SOM ATTA
SOD P0
PJN ATT12 IF MORE DATA TO CHECK
* PROCESS ERROR STATUS FIELDS.
LDM FCEC,CI GET ERROR STATUS FROM PFC
SHN -6
STD T1
RAM ATTC
LDM CTSS+FCEC GET ERROR STATUS FROM SYSTEM SECTOR
SHN -6
STD P0
NJN ATT12.1 IF ERROR STATUS SET IN SYSTEM SECTOR
LDD T1
NJN ATT13 IF ERROR STATUS SET IN PFC
UJN ATT14 CHECK FILE MODE
ATT12.1 SCN ** COMBINE BOTH ERROR STATUS FIELDS
* SCN (T1)
ATTC EQU *-1
LMD T1
SHN 6
STD P0
LDM FCEC,CI
LPN 77
STM CTSS+FCEC CLEAR CODE IN SYSTEM SECTOR
LMD P0
STM FCEC,CI SET ERROR CODE IN CATALOG
ENDMS
LDD EQ SET MASTER DEVICE EST ORDINAL
STD T5
LDD CB REWRITE CATALOG ENTRY
RJM WBI
ENDMS
LDD FS RESET FILE EST ORDINAL
STD T5
LDD P2
STD T6
ATT13 LJM ATT15 REWRITE SYSTEM SECTOR
* CHECK FILE MODE AND UPDATE FIELDS IN SYSTEM SECTOR.
ATT14 RJM CFM CHECK FILE MODE
* SAVE JSN, MAINFRAME ID, AND DATE/TIME FOR WRITEABLE ACCESS.
LDM FNMD CHECK MODE REQUESTED
SHN 21-1
PJN ATT14.1 IF NOT WRITEABLE MODE ACCESS
LDN PDTL SET CURRENT DATE AND TIME
CRM WDSS,ON
LDK MMFL GET MAINFRAME ID
CRD CM
LDD CM SET MAINFRAME ID
STM WDSS
LDD CP GET EJT ORDINAL
ADN TFSW
CRD CM
SFA EJT,CM SET *JSNE* WORD OF EJT
ADK JSNE
CRM WJSS,ON
* CHECK FOR BOI/EOI MISMATCH. THIS IS DONE AFTER THE CALL TO
* *CFM*, TO AVOID THE CHECK IF THE FILE IS CURRENTLY ATTACHED
* IN WRITE MODE. THE EOI MAY NOT BE VALID IN THAT CASE.
* ROUTINES RESIDENT IN *BUF2* MAY NOT BE USED AFTER THIS POINT.
ATT14.1 LDN SSTL CHECK BOI/EOI VALIDATION ENABLED
CRD CM
LDD CM
SHN 21-4
MJN ATT15 IF VALIDATION NOT ENABLED
LDD P2 SET FIRST TRACK
STD T6
RJM SEI SKIP TO END OF INFORMATION
SETMS IO
RJM PDV PROCESS DEVICE STATUS
LDC BUF2 PERFORM BOI/EOI VALIDATION
RJM RDS READ EOI SECTOR
MJP ATT7 IF READ ERROR
LDM BUF2+FTEI CHECK FIRST TRACK POINTER
LMD P2
ADM BUF2 CHECK LINKAGE BYTES
ADM BUF2+1
NJP ATT10 IF BOI/EOI MISMATCH
* REWRITE SYSTEM SECTOR.
ATT15 LDD MA SET PROPER FILE TYPE IN SYSTEM SECTOR
CWD FN
CRM FNSS,ON
LDC PMFT*100
STM FNSS+4
LDD P2 RESET FIRST TRACK
STD T6
SETMS IO,RW
RJM PDV PROCESS DEVICE STATUS
RJM WSS UPDATE SYSTEM SECTOR
PJN ATT15.1 IF NO ERROR
RJM PES PROCESS ERROR STATUS
LDC /ERRMSG/MSE*4 *EQXXX,DNYY, MASS STORAGE ERROR.*
LJM PFE PROCESS FILE ERROR
ATT15.1 ENDMS
LDD T6 RELEASE FILE INTERLOCK
RJM CTI
LDN 0 CLEAR INTERLOCK FLAG
STM DAIF
* PROCESS CATALOG ERROR STATUS.
LDM FCEC,CI CHECK CATALOG ERROR STATUS
SHN 0-4 FORM ERROR CODE
LPN 34
ZJN ATT16 IF NO ERROR
SBN 4
RAM ATTD SET ERROR CODE FOR MESSAGE
ATTD EQU *+2
ERROR EDA * ERROR IN FILE DATA.*
* ERROR EPT * ERROR IN PERMIT DATA.*
* ERROR EDP * DATA/PERMIT ERRORS.*
* ERROR FLC * EOI CHANGED BY RECOVERY.*
ERRNZ /ERRMSG/EPT-/ERRMSG/EDA-1 ERRORS MUST BE CONTIGUOUS
ERRNZ /ERRMSG/EDP-/ERRMSG/EPT-1 ERRORS MUST BE CONTIGUOUS
ERRNZ /ERRMSG/FLC-/ERRMSG/EDP-1 ERRORS MUST BE CONTIGUOUS
* CREATE FNT/FST FOR FILE ATTACHED.
ATT16 RJM CFE CREATE FNT/FST ENTRY
* RESET TO MASTER DEVICE.
LDD T5 CHECK FILE EST ORDINAL
LMD EQ
ZJN ATT17 IF FILE RESIDES ON MASTER DEVICE
LDD EQ RESET EST ORDINAL
STD T5
RJM IRA PRESET COMMON DECKS FOR MASTER DEVICE
* UPDATE PERMITS AND CATALOG ENTRY.
ATT17 LDD CC CHECK COMMAND CODE
LMN CCUA
ZJN ATT18 IF *UATTACH* REQUEST
LDD PB
ZJN ATT19 IF NO PERMIT BUFFER
EXECUTE 3PE LOAD PERMIT UPDATE ROUTINES
AOM UPIB INDICATE THAT *BFMS* WAS USED
RJM UPI UPDATE PERMISSION INFORMATION
UJN ATT19 CHECK ACCESS MODE
ATT18 ISTORE UCEB,(UJN UCE3) FORCE BYPASS OF FCMD, FCAD UPDATE
ISTORE UCEC,(UJN UCE4) FORCE BYPASS OF FCAC UPDATE
ATT19 LDM FNMD CHECK MODE REQUESTED
SHN 21-1
PJN ATT20 IF NOT WRITEABLE MODE ACCESS
LDC STMI+CI FORCE FCUD UPDATE (ALSO FCMD ON *ATTACH*)
STM UCEA
LDN 0 CLEAR FILE LENGTH
STM FCLF,CI
STM FCLF+1,CI
LDD CI CLEAR ALTERNATE STORAGE INFORMATION IN PFC
RAM ATTH+1
LDN ZERL
ATTH CRM FCAF,ON
LDD CI CLEAR TAPE ALTERNATE STORAGE INFORMATION
RAM ATTI+1
LDN ZERL
ATTI CRM FCTF,ON
UJN ATT21 UPDATE CATALOG ENTRY
ATT20 LDM MODE
LPN 37
LMN PTRD
NJN ATT21 IF NOT READ MODE ACCESS
LDD LF UPDATE FILE LENGTH IN CATALOG
STM FCLF,CI
LDD LF+1
STM FCLF+1,CI
ATT21 RJM UCE UPDATE CATALOG ENTRY
ENDMS
RJM CCI CLEAR CATALOG INTERLOCK
* UPDATE FET WITH PARAMETERS FROM CATALOG.
LDC PFSN SET FILE NAME
RJM SFN
LDM PFSP
ZJN ATT22 IF SECURITY PROCESSING BIT NOT SET
RJM SFA RETURN ACCESS LEVEL TO FET
ADN CFAL
CRD CM
LDM FCAL,CI
LMD CM+1
LPN 7
LMD CM+1
STD CM+1
RJM SFA
ADN CFAL
CWD CM
ATT22 LDD CI SET USER CONTROL WORD ADDRESS
RAM ATTE
LDN CFUC
SBM FETL
PJN ATT23 IF FET TOO SHORT
RJM SFA
ADN CFUC
CWM FCCW,ON RETURN USER CONTROL WORD TO FET
ATTE EQU *-1
* IF *UATTACH* REQUEST, WRITE COPY OF THE *PFC* ENTRY.
ATT23 LDD CC CHECK COMMAND CODE
LMN CCUA
ZJN ATT24 IF *UATTACH* COMMAND
LJM ATT26 TERMINATE PROGRAM
ATT24 RJM SFA READ FET *FIRST* POINTER
ADN 1
CRD CM
LDD CM+3 VERIFY *FIRST* POINTER
LPN 77
SHN 6
ADD RA
SHN 6
ADD CM+4
ADN NWCE
SBN 1
SHN -6
SBD RA
SBD FL
MJN ATT25 IF BUFFER WITHIN JOB FL
ERROR ILR,CH,IW,,EC3 * PFM INCORRECT REQUEST.*
ATT25 LDD CI COPY CATALOG ENTRY TO BUFFER
STM ATTF
LDN NWCE NUMBER OF PFC WORDS
STD T1
LDD CM+3 FORM *CM* ADDRESS
LPN 77
SHN 6
ADD RA
SHN 6
ADD CM+4
CWM **,T1
ATTF EQU *-1 (CATALOG ENTRY ADDRESS)
ATT26 EXECUTE 3PU TERMINATE PROGRAM
TITLE SUBROUTINES.
CFE SPACE 4,20
** CFE - CREATE FNT/FST ENTRY FOR ATTACHED FILE.
*
* ENTRY (CC) = COMMAND CODE.
* (CI) = POINTER TO CATALOG ENTRY FOR FILE.
* (FNMD) = FNT STATUS MODE.
* (FNTA) = FNT ADDRESS IN NFL.
* (PFEQ) = EST ORDINAL FOR FILE.
* (PFSN) = SYSTEM FILE NAME.
* (PFUC) = USER CONTROLS.
*
* EXIT FNT/FST WRITTEN TO CENTRAL MEMORY.
* PERMANENT FILE USER COUNT INCREMENTED.
*
* USES FA, CM - CM+4, FN - FN+4, FS - FS+4.
*
* CALLS SFN.
*
* MACROS MONITOR, NFA.
CFE SUBR ENTRY/EXIT
LDC PFSN SET FILE NAME
RJM SFN
LDC PMFT*100 SET FILE TYPE
RAD FN+4
LDM FNTA SET FNT ADDRESS
STD FA
LDM PFEQ SET EST ORDINAL FOR FILE
STD FS
LDM FCBT,CI SET FIRST TRACK FOR FILE
STD FS+1
STD FS+2
LDD CC CHECK COMMAND CODE
LMN CCUA
ZJN CFE1 IF *UATTACH* COMMAND
LDN FSMS SET SECTOR
STD FS+3
LDN 4 SET OPERATION COMPLETE
STD FS+4
LDM FNMD
LPN 35
UJN CFE2 SET STATUS MODE
CFE1 LDN 0 SET SECTOR
STD FS+3
LDC 4004 SET OPERATION COMPLETE
STD FS+4
LDM FNMD
LPN 35
LMN 2
CFE2 ADM PFSN+3 SET STATUS MODE
STD FN+3
LDN ZERL SET FILE SIZE CONTROL
CRD CM
LDM PFUC SET *FS* INDEX IN *FUTL* WORD
SHN -11
SHN 6
STD CM+2
LDM FCAL,CI SET ACCESS LEVEL IN FNT
RAD CM+2
NFA FA,R RESTORE FNT ENTRY
ADK FNTL
CWD FN
ADN FSTL-FNTL
CWD FS
ADN FUTL-FSTL
CWD CM
RJM SFA SET FNT POINTER IN FET
ADN 4
CRD CM
LDD FA
STD CM
RJM SFA
ADN 4
CWD CM
LDM PFEQ INCREMENT PERMANENT FILE USER COUNT
STD CM+1
LDN IUCS
STD CM+3
MONITOR SMDM
UJP CFEX RETURN
PFE SPACE 4,15
** PFE - PROCESS FILE ERROR CONDITION.
*
* ENTRY (A) = ERROR CODE AND EXIT CASE.
* (PFEQ) = EST ORDINAL FOR FILE.
* (PFFT) = FIRST TRACK FOR FILE.
*
* EXIT *TERW* UPDATED WITH TIMED/EVENT DATA.
*
* USES CM - CM+4.
*
*
* MACROS ENDMS, ERROR.
PFE BSS 0 ENTRY
STM PFEA SET ERROR CODE AND EXIT CASE
ENDMS
LDM PFEQ SET EVENT EST ORDINAL
STM ERRE
LDM PFFT SET EVENT TRACK
STM ERRC
LDC ART SET EVENT TIME
STM ERRD
PFEA EQU *+3
ERROR FBS,,,FS *(FILE NAME) BUSY.*
* ERROR FSE,,,FS * FILE BOI/EOI/UI MISMATCH.*
* ERROR ILR,,,FS * PFM INCORRECT REQUEST.*
* ERROR FIN,,,FS,EC2 *(FILE NAME) INTERLOCKED.*
* ERROR DAF,,,FS *EQXXX,DNYY, DIRECT ACCESS FILE ERROR.*
* ERROR MSE,,,FS *EQXXX,DNYY, MASS STORAGE ERROR.*
SPACE 4,10
* COMMON DECKS.
*CALL COMPWSS
TITLE OVERLAYABLE SUBROUTINES.
* THE FOLLOWING ROUTINES MAY BE OVERLAID BY *BUF2*.
ERRNG BUF2-* OVERFLOW INTO EOI SECTOR BUFFER
CFM SPACE 4,30
** CFM - CHECK FILE MODE.
*
* ENTRY (CASS) = CURRENT ACCESS MODE.
* (FISS) = FAST ATTACH FILE INDEX.
* (CC) = COMMAND CODE.
* (MODE) = DESIRED ACCESS MODE.
* (UCSS+1) - (UCSS+4) = USER COUNTS.
* (FS) = EST ORDINAL OF FILE.
* (T6) = FIRST TRACK OF FILE.
*
* EXIT SYSTEM SECTOR UPDATED FOR NEW ACCESS MODE.
* (T1) = REQUESTED MODE.
* TO *PFE* FOR ERROR PROCESSING IF ACCESS NOT ALLOWED.
*
* CALLS DLT.
*
* USES P0, P1, T1, T3.
*
* DEFINE (P1) = CURRENT ACCESS MODE FLAGS.
* (T3) = ADDRESS OF GLOBAL USER COUNTS.
* (T7) = ADDRESS OF LOCAL USER COUNTS.
*
* NOTES IF A WRITEABLE MODE *ATTACH* IS ATTEMPTED ON A
* FILE THAT IS ALREADY UTILITY ATTACHED, A *FILE
* INTERLOCKED* STATUS WILL BE RETURNED.
CFM SUBR ENTRY/EXIT
LDC UCSS+1 ADDRESS OF GLOBAL USER COUNTS
STD T3
LDM CASS SET CURRENT ACCESS MODE
LPC 132
STD P1
LDM MODE
LPN 37
STD T1 DESIRED ACCESS MODE
LDM FISS
NJN CFM4 IF FAST ATTACH FILE
RJM DLT DETERMINE LOCAL USER TABLE ADDRESS
LDD CC CHECK FOR *UATTACH* REQUEST
LMN CCUA
NJN CFM1 IF NOT *UATTACH* REQUEST
LDD HN SET UTILITY MODE
RAM CASS
LDN 2 SET LOCAL *UATTACH* FLAG
RAM -1,T7
CFM1 LDM CFMT,T1 SET PROCESSOR ADDRESS
STD P0
ZJN CFM2 IF INCORRECT MODE
LDD P1
LJM 0,P0
CFM2 LDN /ERRMSG/ILR*4 * PFM INCORRECT REQUEST.*
LJM PFE PROCESS FILE ACCESS ERROR
* WRITE ACCESS REQUESTED.
CFM3 ADI T3 CHECK IF ANY ACTIVE USERS ON FILE
ADM 1,T3
ADM 2,T3
ADM 3,T3
CFM4 NJN CFM9 IF ACCESS NOT ALLOWED
LDN 32 SET WRITE USER
* SET NEW FILE MODE.
CFM5 RAM CASS SET NEW FILE MODE
AOM -1,T7 SET LOCAL WRITE FLAG
LJM CFMX RETURN
* MODIFY ACCESS REQUESTED.
CFM6 ADI T3 CHECK FOR W, M, A, U, R/A, R/U OR R USERS
ADM 1,T3
ADM 2,T3
NJN CFM9 IF ACCESS NOT ALLOWED
LDN 12 SET MODIFY USER
UJN CFM5 SET NEW FILE MODE
* APPEND ACCESS REQUESTED.
CFM7 ADI T3 CHECK FOR W, M, A, U, R/U OR R USERS
ADM 1,T3
NJN CFM9 IF ACCESS NOT ALLOWED
LDN 2 SET APPEND USER
UJN CFM5 SET NEW FILE MODE
* UPDATE ACCESS REQUESTED.
CFM8 ADI T3 CHECK FOR W, M, A, U, R/A OR R USERS
ADM 2,T3
NJN CFM9 IF ACCESS NOT ALLOWED
LDN 10 SET UPDATE USER
UJN CFM5 SET NEW FILE MODE
* ACCESS NOT ALLOWED.
CFM9 LDD P1 CHECK FOR UTILITY ATTACH MODE
SHN 21-6
PJN CFM10 IF FILE NOT CURRENTLY UTILITY ATTACHED
LDC EC2*1000+/ERRMSG/FIN*4 *(FILE NAME) INTERLOCKED.*
UJN CFM11 PROCESS FILE INTERLOCKED CONDITION
CFM10 LDN /ERRMSG/FBS*4 *(FILE NAME) BUSY.*
CFM11 LJM PFE PROCESS FILE BUSY EXIT
* READ OR EXECUTE ACCESS REQUESTED.
CFM12 LPN 32 DO NOT ALLOW W, M, A OR U USERS
CFM13 NJN CFM9 IF ACCESS NOT ALLOWED
* LDN 0
* INCREMENT USER COUNTS.
CFM14 STM CFMA+1
STM CFMB+1
STM CFMC+1
CFMA LDM *,T3 CHECK GLOBAL USER COUNT
* LDM 0,T3 (READ MODE)
* LDM 1,T3 (READ/ALLOW UPDATE MODE)
* LDM 2,T3 (READ/ALLOW APPEND MODE)
* LDM 3,T3 (READ/ALLOW MODIFY MODE)
LMC 7777
ZJN CFM10 IF USER COUNT OVERFLOW
CFMB AOM *,T3 INCREMENT GLOBAL USER COUNT
* AOM 0,T3 (READ MODE)
* AOM 1,T3 (READ/ALLOW UPDATE MODE)
* AOM 2,T3 (READ/ALLOW APPEND MODE)
* AOM 3,T3 (READ/ALLOW MODIFY MODE)
CFMC AOM *,T7 INCREMENT LOCAL USER COUNT
* AOM 0,T7 (READ MODE)
* AOM 1,T7 (READ/ALLOW UPDATE MODE)
* AOM 2,T7 (READ/ALLOW APPEND MODE)
* AOM 3,T7 (READ/ALLOW MODIFY MODE)
LJM CFMX RETURN
* READ / ALLOW MODIFY ACCESS REQUESTED.
CFM15 LPN 20 DO NOT ALLOW W USERS
NJN CFM13 IF ACCESS NOT ALLOWED
LDN 3
UJN CFM14 INCREMENT USER COUNTS
* READ / ALLOW APPEND ACCESS REQUESTED.
CFM16 LPN 30 DO NOT ALLOW W, M OR U USERS
NJN CFM13 IF ACCESS NOT ALLOWED
LDN 2
UJN CFM14 INCREMENT USER COUNTS
* READ / ALLOW UPDATE ACCESS REQUESTED.
CFM17 LPN 22 DO NOT ALLOW W, M OR A USERS
NJN CFM13 IF ACCESS NOT ALLOWED
LDN 1
UJN CFM14 INCREMENT USER COUNTS
CFMT SPACE 4,15
CFMT BSS 0 FILE MODE PROCESSORS
LOC 0
CON CFM3 WRITE
CON CFM12 READ
CON CFM7 APPEND
CON CFM12 EXECUTE
CON 0 NULL
CON CFM6 MODIFY
CON CFM15 READ / ALLOW MODIFY
CON CFM16 READ / ALLOW APPEND
CON CFM8 UPDATE
CON CFM17 READ / ALLOW UPDATE
LOC *O
ERRNZ *-CFMT-PTLM
CSL SPACE 4,20
** CSL - CHECK SIZE LIMITS.
*
* ENTRY (T5) = EST ORDINAL OF FILE.
* (T6) = FIRST TRACK OF FILE.
* (P2) = FIRST TRACK OF FILE.
* (MXDS - MXDS+1) = MAXIMUM SIZE FOR DIRECT ACCESS FILE.
* (FNMD) = FNT STATUS EQUIVALENCED MODE.
*
* EXIT TO ERR IF SIZE LIMIT EXCEDED.
* (LF - LF+1) = FILE LENGTH FOR *PFC* ENTRY.
* (T6) = TRACK FOR EOI.
* (T7) = SECTOR FOR EOI.
*
* USES T2, T3.
*
* CALLS SEI.
*
* MACROS ERROR.
CSL SUBR ENTRY/EXIT
LDM FNMD
LPN 2
ZJN CSL1 IF NOT WRITE FUNCTION
AOM CSLA SET WRITEABLE MODE
LDN 0 CLEAR FILE LENGTH FOR WRITE MODE
STD LF
STD LF+1
CSL1 LDM FCLF,CI CHECK FILE LENGTH IN *PFC*
STD T2
LDM FCLF+1,CI
STD T3
ADD T2
NJN CSL2 IF FILE LENGTH DEFINED IN *PFC*
RJM SEI SKIP TO END OF INFORMATION
CSL2 LDN 0 TEST ACCESS MODE
* LDN 1 (SET IF WRITEABLE MODE)
CSLA EQU *-1
NJN CSL4 IF WRITEABLE MODE
LDD T2 SET FILE LENGTH
STD LF
LDD T3
STD LF+1
CSL3 UJN CSLX RETURN
CSL4 LDM MXDS CHECK FILE LENGTH
ADM MXDS+1
ZJN CSL3 IF UNLIMITED ACCESS
LDM MXDS
SBD T2
MJN CSL5 IF LENGTH LIMIT EXCEEDED
NJN CSL3 IF LIMIT NOT EXCEEDED
LDM MXDS+1
SBD T3
PJN CSL3 IF LIMIT NOT EXCEEDED
CSL5 ERROR FTL,CH * FILE TOO LONG.*
DLT SPACE 4,10
** DLT - DETERMINE LOCAL USER TABLE TO UPDATE.
*
* ENTRY (BFMS - BFMS+500) - SYSTEM SECTOR.
* (T5) = EST ORDINAL.
*
* EXIT (T7) - ADDRESS OF LOCAL USER COUNTS.
*
* USES T7.
*
* CALLS SMI.
DLT SUBR ENTRY/EXIT
RJM SMI COMPUTE LOCAL USER COUNT BASE ADDRESS
STD T0
SHN 2
ADD T0
ADC UCSS+1
STD T7
UJN DLTX
SPACE 4,10
* OVERLAYABLE COMMON DECKS.
EJT$ SET 0 DEFINE EJT ACCESS
*CALL COMPGFP
*CALL COMPRSS
*CALL COMPSDN
*CALL COMPSMI
SPACE 4,10
* CHECK FOR OVERFLOW.
OVERFLOW OVLC,BUF1-2 OVERFLOW INTO CATALOG BUFFER
OVERLAY (CATLIST PROCESSING.),OVLA
SPACE 4,10
** THIS OVERLAY READS PERMANENT FILE CATALOG ENTRIES
* OR PERMIT ENTRIES FOR A CENTRAL PROCESSOR PROGRAM.
OVL BSS 0 ENTRY
* LJM CAT PROCESS REQUEST
SPACE 4,10
*** PROCESS *CATLIST* REQUEST.
*
* CALL.
*
*T 18/PFM,6/P,12/CCCT,24/FET
*
*T FET 42/ *FILENAME*,18/ STATUS
*T, 60/ FIRST
*T, 60/ IN
*T, 60/ OUT
*T, 60/ LIMIT
*T, 60/
*T, 60/ RESERVED
*T, 60/
*T, 42/ *PF NAME*, 6/ SR, 12/ MODE
*T, 42/ OUAN, 6/ DN, 12/
*
* STATUS RETURNED,
* 33 BUFFER FULL.
* 1033 REQUEST COMPLETED.
* BUFFER IS FILLED FROM IN TO LIMIT - 1.
*
* FET+6 RESERVED FOR RECALL INFORMATION TO *PFM*.
*
* PF NAME = PERMANENT FILE NAME.
*
* SR = SPECIAL REQUEST.
* IF SR = SRDN, LIST ONLY FILES ON SPECIFIED DEVICE.
*
* MODE = 0 SEARCH FOR CATALOG ENTRIES.
* MODE = 1 SEARCH FOR PERMIT ENTRIES.
* MODE = 2 SEARCH FOR CATALOG ENTRIES/*PFID* ACCESS.
*
* OUAN = ALTERNATE CATALOG SEARCHED.
*
SPACE 4,10
*** EXIT.
*
* PF CATALOG ENTRIES WRITTEN TO CM.
*
* FOR NORMAL CATALOG SEARCH FULL CATALOG ENTRY
* WRITTEN TO CM (SEE COMSPFM)
*
* FOR ALTERNATE CATALOG SEARCH ENTIRE CATALOG IS
* RETURNED WITH THE FOLLOWING FIELDS CLEARED-
* USER INDEX.
* PASSWORD AND PASSWORD EXPIRATION DATE.
* ACCESS LEVEL AND ACCESS CATEGORY SET.
*
* FOR *PFID* ACCESS CATALOG SEARCH, THE FULL CATALOG
* ENTRY IS WRITTEN TO CM, WITH A WORD PRECEDING
* EACH ENTRY CONTAINING THE *PFID* (DISK ADDRESS)
* FOR THAT ENTRY.
*
* IN ALL OF THE ABOVE CASES, IF THE FILE ACCESS
* LEVEL IS ABOVE THE JOB ACCESS LEVEL, THE FOLLOWING
* FIELDS ARE ALSO CLEARED -
* PASSWORD (REPLACED BY ASTERISKS).
* PASSWORD EXPIRATION DATE.
* ACCESS CATEGORY SET.
* USER CONTROL WORD.
*
* FOR A PERMIT DATA REQUEST, THE FULL PERMIT ENTRY IS
* WRITTEN TO CM. THIS TYPE OF REQUEST IS NOT ALLOWED
* ON A FILE WITH AN ACCESS LEVEL HIGHER THAN THAT OF THE
* CALLING JOB, UNLESS THE JOB IS A SUBSYSTEM.
SPACE 4,10
**** DIRECT LOCATION ASSIGNMENTS.
CF EQU P0 CONTINUATION FLAG
DN EQU 35 DEVICE NUMBER FOR CATALOG LIST
ST EQU 45 CATALOG SEARCH TRACK
SS EQU 46 CATALOG SEARCH SECTOR
SI EQU 47 CATALOG SEARCH INDEX
EQ EQU 60 MASTER DEVICE EST ORDINAL
RI EQU 61 - 62 RANDOM INDEX
WC EQU 63 WORD COUNT
IN EQU 64 - 65 FET POINTER
LM EQU 66 - 67 FET LIMIT POINTER
****
TITLE COMMAND PROCESSING.
CAT SPACE 4,10
** CAT - CATALOG MAIN PROGRAM.
*
* ENTRY (PFUI - PFUI+1) = USER INDEX.
* (UI - UI+1) = USER INDEX OF CALLING USER
* (PI - PI+1) = USER INDEX OF ALTERNATE CATALOG.
* (PFFN - PFFN+3) = FILE NAME FOR SELECTED FILE CATALOG.
* (PFOU - PFOU+3) = CALL BLOCK USER NAME.
* (PFFN+4) = MODE OF CALL.
*
* USES T1.
*
* CALLS SBS.
*
* MACROS ENDMS, ERROR.
CAT LDM PFFN+4 SET FUNCTION TYPE
SBN CTMX
MJN CAT1 IF VALID MODE
ERROR ILR,CH,IW * PFM INCORRECT REQUEST.*
CAT1 ADN CTMX
NJN CAT2 IF NOT ALTERNATE USER
LDD PI CHECK FOR ALTERNATE USER
ADD PI+1
ZJN CAT2 IF NORMAL CATALOG SEARCH
LDN CTCA ALTERNATE CATALOG SEARCH
CAT2 STD T1
STM CATA SET ACCESS MODE
* PROCESS REQUEST.
LDM CATC,T1
STM CATC
LJM NCS NORMAL CATALOG SEARCH
CATC EQU *-1
CON PDS PERMIT DATA SEARCH
CON PAS *PFID* ACCESS SEARCH
CON ACS ALTERNATE CATALOG SEARCH
** CATX - TERMINATE PROGRAM.
CATX ENDMS
LDC 1031 SET BUFFER STATUS TO EOI
RJM SBS
UJN DPP DROP PP
CATA CON 0 FUNCTION
CATB CON 0 MASTER DEVICE NUMBER
DPP SPACE 4,10
** DPP - DROP PP.
DPP BSS 0 ENTRY
LDK STDP SET *DROP PP* STATUS BIT
RAM STAU
EXECUTE 3PU DROP PP
PAS SPACE 4,15
** PAS - *PFID* ACCESS SEARCH.
PAS BSS 0 ENTRY
LDC LDNI+NWCE+1 SET FOR SIZE OF OUTPUT
STM SHBC
* UJN NCS (PERFORM NORMAL CATALOG SEARCH)
NCS SPACE 4,10
** NCS - NORMAL CATALOG SEARCH.
NCS RJM ISP INITIALIZE FOR CATALOG SEARCH
NCS1 RJM RBS READ BUFFER FOR CATALOG SEARCH
RJM SHB SEARCH CATALOG BUFFER
ZJN NCS1 LOOP FOR NEXT SECTOR OF CATALOGS
UJN CATX EXIT
ACS SPACE 4,10
** ACS - ALTERNATE CATALOG SEARCH.
ACS RJM CSU CHECK FOR SPECIAL USER ACCESS
LDD UI SWAP USER INDEXES
STD T1
LDD PI
STD UI
LDD T1
STD PI
LDD UI+1
STD T1
LDD PI+1
STD UI+1
LDD T1
STD PI+1
RJM ISP INITIALIZE FOR CATALOG SEARCH
ACS1 RJM RBS READ BUFFER FOR SEARCH
RJM SHB SEARCH CATALOG BUFFER
ZJN ACS1 LOOP FOR NEXT SECTOR
LJM CATX EXIT
PDS SPACE 4,10
** PDS - PERMIT DATA SEARCH.
PDS LDM PFFN ENTRY
NJN PDS1 IF PERMANENT FILE NAME SPECIFIED
ERROR ILR,CH,IW * PFM INCORRECT REQUEST.*
PDS1 RJM ISP INITIALIZE FOR CATALOG SEARCH
LDD CF CHECK CONTINUATION FLAG
ZJN PDS2 IF INITIAL CALL
LJM PDS5 CONTINUE READ
PDS2 RJM RBS READ BUFFER FOR SEARCH
RJM SHB SEARCH CATALOG BUFFER
ZJN PDS2 IF FILE NOT FOUND
* A PERMIT DATA CATLIST IS NOT ALLOWED ON A FILE WITH AN
* ACCESS LEVEL ABOVE THAT OF THE JOB UNLESS THE CALLER IS
* A SUBSYSTEM.
LDM SSOM
ZJN PDS2.1 IF UNSECURED SYSTEM
LDM FCAL,P2 GET FILE ACCESS LEVEL
LPN 7
STD T1
LDM PFAL GET JOB ACCESS LEVEL
SBD T1
PJN PDS2.1 IF FILE ACCESS LEVEL NOT ABOVE JOB LEVEL
LDM SSID
SBK LSSI+1
PJN PDS2.1 IF SUBSYSTEM
ERROR IUA,,IW * USER ACCESS NOT VALID.*
PDS2.1 LDM FCRI,P2 SET PERMIT RANDOM INDEX
STD RI
LDM FCRI+1,P2
STD RI+1
ADD RI
NJN PDS4 IF PERMITS AVAILABLE
* NO PERMITS AVALABLE - SET MESSAGE.
PDS3 LDM PFOU
ZJP CATX IF NOT SPECIFIC USER REQUEST
LDD MA SET OPTIONAL USER IN FILE NAME
CWM PFOU,ON
SBN 1
CRD FN
ERROR FNF,,IW *(USER NAME) NOT FOUND.*
PDS4 LDN NWPH SET SECTOR WORD INDEX
STD SI
LDN 0
RJM CSA COMPUTE SECTOR ADDRESS
MJN PDS3 IF ERROR ON POSITION TO PERMIT SECTOR
PDS5 LDC BUFB READ SECTOR
RJM RDS
MJN PDS3 IF ERROR TREAT AS EOI
LDM BUFB
ZJN PDS3 IF EOF/EOI
LDM BUFB+1
SBN NWPH+NWPE
MJN PDS6.1 IF INCORRECT SECTOR LENGTH
LPN NWPE-1
ERRNZ NWPH-NWPE HEADER SIZE MUST EQUAL ENTRY SIZE
NJN PDS6.1 IF NOT INTEGRAL NUMBER OF PERMIT ENTRIES
LDC BUFB CHECK USER INDEX
STD T1
LDD UI
LMM FPUI,T1
NJN PDS6 IF INCORRECT UI
LDD UI+1
LMM FPUI+1,T1
ZJN PDS7 IF CORRECT UI
PDS6 LDD CF
ZJN PDS6.0 IF NOT CONTINUATION CALL
PDSA LDC 0
* LDC (NONZERO) (NOT FIRST SECTOR)
ZJN PDS6.2 IF FIRST SECTOR
PDS6.0 ERROR RIN,,IW,T5 *EQXXX,DNYY,RANDOM INDEX ERROR.*
PDS6.1 ERROR BCS,,IW,T5,,EI *EQXXX,DNYY,BAD CATALOG/PERMIT SECTOR*
PDS6.2 ERROR ECD,,IW * ERROR IN CATLIST CONTINUATION DATA.*
PDS7 LDM PFOU
NJN PDS8 IF SPECIFIC USER REQUEST
LJM PDS12 CONTINUE SEARCH OF PERMITS
* PROCESS SPECIFIC USER PERMIT REQUEST.
PDS8 LDD MA SET USER NAME FOR SEARCH
CWM PFOU,ON
SBN 1
CRD CM
RJM SPB SEARCH PERMIT BUFFER
ZJN PDS10 IF ENTRY NOT FOUND
LDN NWPE WRITE ENTRY TO CM
STD T1
LDM FPMD,T2
SHN 21-5
MJN PDS9 IF EXPIRATION DATE PRESENT
LDM FPXD,T2 CLEAR EXPIRATION DATE FIELD
SCN 77
STM FPXD,T2
LDN 0
STM FPXD+1,T2
PDS9 LDD T2 WRITE ENTRY TO CM
RJM WDB
LJM CATX EXIT
PDS10 LDM BUFB+FPRI SET ADDRESS OF NEXT BUFFER
STD RI
LDM BUFB+FPRI+1
STD RI+1
ADD RI
ZJN PDS11 IF NO MORE PERMITS
AOM PDSA+1 INDICATE NOT FIRST SECTOR
LJM PDS4 LOOP TO READ NEXT SECTOR
PDS11 LJM PDS3 EXIT
PDS12 LDN NWPE SET WORD COUNT
STD T1
PDS13 LDD SI
SHN 2
ADD SI
ADC BUFB+2
STD T2 SAVE BASE ADDRESS
LDM FPMD,T2
SHN 21-5
MJN PDS14 IF EXPIRATION DATE PRESENT
LDM FPXD,T2 CLEAR EXPIRATION DATE FIELD
SCN 77
STM FPXD,T2
LDN 0
STM FPXD+1,T2
PDS14 LDD T2 WRITE ENTRY TO CM
RJM WDB
LDN NWPE ADVANCE WORD INDEX
RAD SI
LMM BUFB+1
NJN PDS13 IF MORE ENTRIES
LJM PDS10 LOOP FOR NEXT SECTOR
TITLE SUBROUTINES.
SBS SPACE 4,15
** SBS - SET STATUS OF BUFFER.
*
* ENTRY (A) = STATUS TO BE SET.
* (IN - IN+1) = CURRENT ADDRESS IN FET.
*
* EXIT FET STATUS SET.
* (IN) UPDATED IN FET.
*
* USES T1, CM - CM+4.
*
* CALLS SFA.
SBS SUBR ENTRY/EXIT
STD T1 SAVE STATUS TO BE SET
RJM SFA SET FET ADDRESS
CRD CM
LDD CM+4 SET STATUS
LPN 2
LMD T1
STD CM+4
LDD CM+3 CLEAR UPPER BITS OF STATUS FIELD
SCN 77
STD CM+3
RJM SFA
CWD CM WRITE FET STATUS
LDN ZERL UPDATE FET IN POINTER
CRD CM
LDD IN
STD CM+3
LDD IN+1
STD CM+4
RJM SFA
ADN 2
CWD CM
UJN SBSX RETURN
RBS SPACE 4,15
** RBS - READ BUFFER FOR SEARCH.
*
* ENTRY (T6) = TRACK.
* (T7) = SECTOR.
* DEVICE POSITIONED AND CHANNEL RESERVED.
* AT RBS1 IF SEARCH TERMINATION DESIRED.
*
* EXIT (A) = WORD COUNT OF SECTOR READ.
* (T6) = NEXT TRACK.
* (T7) = NEXT SECTOR.
* (WBDB - WDBC) SET TO CURRENT POSITION
*
* CALLS DPP, RNS, SBS.
*
* MACROS ENDMS, ERROR.
RBS SUBR ENTRY/EXIT
LDC ** COUNT OF DA FILES FOUND IN BUFFER
RBSA EQU *-1
ZJN RBS1 IF NO DA FILES FOUND IN LAST PRU
LDN 0 CLEAR PRU COUNT
STM RBSA
RBS1 LDD T6 SET CURRENT POSITION FOR RECALL
STM WDBB
STM ERRC
LDD T7
STM WDBC
STM ERRD
LDC BUFA SET BUFFER FOR READ
RJM RNS READ SECTOR
ZJN RBS2 EOF/EOI SECTOR
LPN NWCE-1
NJN RBS4 IF NOT INTEGRAL NUMBER OF CATALOG ENTRIES
LDD T1
UJN RBSX RETURN
RBS2 LDD FN
ZJN RBS3 IF NOT FILE NAME SEARCH
ERROR FNF,,IW *(FILE NAME) NOT FOUND.*
RBS3 LDC 1031 SET EOI BUFFER STATUS
RJM SBS
ENDMS
LJM DPP TERMINATE PROGRAM
RBS4 ERROR BCS,,IW,T5,,EI *EQXXX,DNYY,BAD CATALOG/PERMIT SECTOR*
MSR SPACE 4,10
** MSR - MASS STORAGE READ ERROR PROCESSOR.
MSR SUBR ENTRY/EXIT
RJM PES PROCESS ERROR STATUS
ERROR MSE,CH,IW,T5 *EQXXX,DNYY, MASS STORAGE ERROR.*
SHB SPACE 4,15
** SHB - SEARCH CATALOG BUFFER.
*
* ENTRY (A) = NUMBER OF WORDS IN BUFFER.
* (SI) = SEARCH INDEX.
* (FN - FN+3) = SELECTED FILE NAME FOR SEARCH
* (UI - UI+1) = USER INDEX OF CATALOG TO SEARCH.
*
* EXIT (A) " 0 IF SPECIFIC ENTRY FOUND
* (P2) = FWA OF CATALOG ENTRY
*
* USES T1, P1, P2, RI - RI+1.
*
* CALLS WDB, CIP.
SHB SUBR ENTRY/EXIT
STD P1 SAVE WORD COUNT
LDM CATA SET CONTROL FOR SEARCH MODE
STD T1
LDM SHBF,T1
STM SHBB
LDC BUFA+2 SET BUFFER DATA BASE
STD P2
LDD SI SET SEARCH INDEX
SHN 2 MULTIPLY BY FIVE
ADD SI
RAD P2 SET DATA ADDRESS TO NEXT CATALOG ENTRY
SHB1 LDM FCUI,P2 CHECK USER INDEX
LPN 37
SHN 14
LMM FCUI+1,P2
ZJN SHB2 IF EMPTY CATALOG ENTRY
SHBA PSN
* UJN SHB4 (SET IF PRIVATE DEVICE)
LMD UI+1
SHN 6
LMD UI
ZJN SHB4 USER INDEX MATCH
* INCREMENT FOR NEXT ENTRY.
SHB2 LDC NWCE*5 ADVANCE ENTRY INDEX
RAD P2
LDN NWCE INCREMENT WORD COUNT
RAD SI ADVANCE SEARCH INDEX
ADN NWCE-1 CHECK FOR ANOTHER CATALOG ENTRY
SBD P1
MJN SHB1 IF NOT END OF BUFFER
LDN 0
STD SI CLEAR SEARCH INDEX
SHB3 LJM SHBX RETURN
SHB4 LDD FN CHECK AGAINST SELECTED FILE NAME
ZJN SHB6 IF NO SELECTED FILE REQUESTED
LMI P2
NJN SHB2 NO MATCH
LDM 1,P2
LMD FN+1
NJN SHB2 NO MATCH
LDM 2,P2
LMD FN+2
NJN SHB2 NO MATCH
LDM 3,P2
LMD FN+3
SCN 77
SHB5 NJN SHB2 IF NOT MATCH
SHB6 BSS 0
SHBE UJN SHB7
* PSN IF CATLIST OF DEVICE NUMBER SPECIFIED.
LDM FCDN,P2 CHECK DEVICE NUMBER
LPN 77
SBD DN
NJN SHB5 IF NO MATCH
SHB7 LDN 1 SET FOR *CTPM* EXIT CASE
UJN * PERFORM SEARCH DEPENDING ON MODE
SHBB EQU *-1
* UJN SHB9 (IF NORMAL CATALOG SEARCH, *CTNC*)
* UJN SHB3 (IF PERMIT DATA SEARCH, *CTPM*)
* UJN SHB9 (IF *PFID* ACCESS SEARCH, *CTID*)
* UJN SHB8 (IF ALTERNATE CATALOG SEARCH, *CTCA*)
* VALIDATE ACCESS AND PREPARE THE *PFC* ENTRY FOR OUTPUT.
SHB8 RJM CCP CHECK CATALOG PERMISSION
ZJP SHB11 IF NOT PERMITTED
SHB9 LDM SSOM
ZJN SHB9.1 IF UNSECURED SYSTEM
LDM SSJS
NJN SHB9.1 IF *SSJ=* CALLER
LDM FCAL,P2 GET FILE ACCESS LEVEL
LPN 7
STD T1
LDM PFAL GET JOB ACCESS LEVEL
SBD T1
MJN SHB9.2 IF FILE ACCESS LEVEL ABOVE JOB
SHB9.1 LJM SHB9.4 WRITE CATALOG TO CM
* IF THE FILE ACCESS LEVEL IS HIGHER THAN THE JOB ACCESS LEVEL,
* CLEAR THE FOLLOWING PFC FIELDS (UNLESS CALLER IS *SSJ=*).
* 1. PASSWORD (REPLACE WITH ASTERISKS).
* 2. PASSWORD EXPIRATION DATE.
* 3. ACCESS CATEGORY SET.
* 4. USER CONTROL WORD.
SHB9.2 LDK FCCW SET ADDRESS OF USER CONTROL WORD
ADD P2
STM SHBG
LDM FCPW,P2
ZJN SHB9.3 IF NO PASSWORD DEFINED
LDC 2R** REPLACE PASSWORD WITH ASTERISKS
STM FCPW,P2
STM FCPW+1,P2
STM FCPW+2,P2
SCN 77 CLEAR PASSWORD EXPIRATION DATE
STM FCPW+3,P2
* STM FCXD,P2
LDN 0
STM FCXD+1,P2
SHB9.3 STM FCFC+1,P2 CLEAR ACCESS CATEGORY SET
STM FCFC+2,P2
LDM FCFC,P2
LPC 7400
STM FCFC,P2
LDN ZERL CLEAR USER CONTROL WORD
CRM *,ON
SHBG EQU *-1 (ADDRESS OF USER CONTROL WORD)
* WRITE CATALOG TO CM.
SHB9.4 LDM FCBS,P2
SHN 6
PJN SHB10 IF NOT DIRECT ACCESS FILE
RJM DFS DETERMINE FILE SIZE
SHB10 LDN NWCE WRITE CATALOG TO CM
SHBC EQU *-1
* LDN NWCE+1 (IF *PFID* ACCESS SEARCH, *CTID*)
STD T1
LDD P2
RJM WDB
LDD FN
ZJN SHB11 IF NOT SELECTED FILE SEARCH
LJM SHBX RETURN FILE FOUND
SHB11 STM RBSA CLEAR DA FILE COUNT
SHB13 LJM SHB2 LOOP FOR NEXT CATALOG ENTRY
SHBF BSS 0 BRANCH TABLE
LOC SHBB
UJN SHB9 *CTNC* MODE OF SEARCH
LOC SHBB
UJN SHB3 *CTPM* MODE OF SEARCH
LOC SHBB
UJN SHB9 *CTID* MODE OF SEARCH
LOC SHBB
UJN SHB8 *CTCA* MODE OF SEARCH
LOC *O
WDB SPACE 4,20
** WDB - WRITE BUFFER TO CENTRAL.
*
* ENTRY (A) = CATALOG ENTRY ADDRESS.
* (T1) = WORD COUNT OF ENTRY TO WRITE
* (IN - IN+1) = CURRENT POSITION IN FET.
* (LM - LM+1) = FET LIMIT.
* (SI) = CURRENT SECTOR WORD INDEX.
* (T6 - T7) CURRENT PERMIT BUFFER ADDRESS IF PERMIT LIST.
* (WDBB - WDBC) SET TO CURRENT CATALOG SEARCH POS.
*
* EXIT CATALOG ENTRY WRITTEN TO BUFFER.
* (IN - IN+1) ADVANCED
* TO DPP IF BUFFER FULL (EOF STATUS SET IN FET)
*
* USES T2, CM - CM+4.
*
* CALLS PCA, SBS, SFA, SRA.
*
* MACROS ENDMS, ERROR.
WDB SUBR ENTRY/EXIT
STD T2 SET ADDRESS FOR WRITE
STM WDBA
LDD IN CHECK FOR ROOM IN BUFFER FOR NEXT ENTRY
SHN 14
ADD IN+1
ADD T1
STD CM+4
SHN -14
STD CM+3
SBD LM
SHN 14
ADD CM+4
SBD LM+1
PJN WDB1 IF BUFFER FULL
RJM PCA PROCESS CATALOG ADDRESS ACCESS MODE
LDD IN WRITE ENTRY TO BUFFER
SHN 6
ADD RA
SHN 6
ADD IN+1
CWM *,T1
WDBA EQU *-1
LDD CM+3 ADVANCE IN POINTER
STD IN
LDD CM+4
STD IN+1
LDN IPCE PF INCREMENT FOR CATALOG ENTRY RETURNED
RAM AIPF+1
LJM WDBX EXIT
* BUFFER FULL.
WDB1 ENDMS
LDM CATA
LMN CTPM
ZJN WDB2 IF PERMIT FILE POSITION TO BE SAVED
LDC * SET CURRENT POSITION
WDBB EQU *-1
STD T6
LDC *
WDBC EQU *-1
STD T7
LDM DVLW+1 SET ALLOCATOR TRACK
UJN WDB3
WDB2 LDM DVLW+2 SET PERMIT FILE
WDB3 RJM SRA SET RANDOM ADDRESS
ZJN WDB4 IF NO ERROR
ERROR RIN,CH,IW,EQ *EQXXX,DNYY, RANDOM INDEX ERROR.*
WDB4 LDN ZERL CLEAR ASSEMBLY AREA
CRD CM
LDD RI+1 REPOSITION RANDOM ADDRESS
SHN 6
STD CM+2
LPC 770000
ADD RI
SHN 6
STD CM+1
LPC 770000
ADD SI
SHN 6
STD CM
RJM SFA SET FET ADDRESS
ADN CFCN
CWD CM WRITE ADDRESS TO FET
LDN 31 SET END OF FILE STATUS
RJM SBS SET STATUS OF BUFFER
LJM DPP TERMINATE PROGRAM
CCP SPACE 4,20
** CCP - CHECK CATALOG PERMISSION.
*
* CATALOG ENTRY RETURNED IF ALTERNATE CATLIST PERMISSION HAS
* BEEN GRANTED AND USER IS VALID TO ACCESS FILE.
*
* ENTRY (P2) = ADDRESS OF CATALOG ENTRY.
*
* EXIT (A) = 0 IF USER NOT PERMITTED TO FILE.
* CATALOG ENTRY ADJUSTED IF USER PERMITTED.
*
* USES T1, T2, T6, T7, P3, ST, SS.
*
* CALLS CSA, MSR, PDV, RDS, SPB.
*
* MACROS MONITOR, SETMS.
CCP10 LDN 0 DENY ACCESS TO USER
CCP11 ZJP CCPX IF USER NOT PERMITTED
CCP12 LDM FCAM,P2 CHECK PERMISSION MODE
LPN 77
LMN PTNU
ZJN CCP11 IF *NULL* PERMISSION
* CHECK FOR EXPIRED PERMIT.
LDD P3
ZJN CCP13 IF NO PERMIT ENTRY FOUND
LDM FPMD,T2 CHECK FOR EXPIRED PERMIT
SHN 21-5
PJN CCP13 IF NO EXPIRATION DATE PRESENT
LDM FPXD,T2
LPN 77
STD CM+3
SHN 14
LMM FPXD+1,T2
ZJN CCP13 IF NON-EXPIRING PERMIT
STD CM+4
LDN VEDS VALIDATE EXPIRATION DATE
STD CM+1
MONITOR VSAM
LDD CM+1
NJN CCP10 IF EXPIRED
* VALIDATE ACCESS LEVEL/CATEGORY SET OF USER.
CCP13 LDN ZERL
CRD CM
LDM FCAL,P2 SET ACCESS LEVEL
LPN 7
STD CM+1
LDM FCFC,P2 SET ACCESS CATEGORY
LPC 377
STD CM+2
LDM FCFC+1,P2
STD CM+3
LDM FCFC+2,P2
STD CM+4
LDD MA
CWD CM
LDN ZERL
CRD CM
LDN 3 CHECK ACCESS LEVEL/ACCESS CATEGORY SET
STD CM+4
LDN VAJS CHECK AGAINST USER-S VALIDATION
STD CM+1
MONITOR VSAM
LDD CM+1
NJP CCP10 IF NOT VALID ACCESS
* CLEAR FIELDS IN CATALOG ENTRY.
LDN FCPW SET FWA OF PASSWORD
ADD P2
STM CCPC
ADN FCAL-1-FCPW SET FWA OF ACCESS LEVEL AND CATEGORY SET
STM CCPD
ADN FCCN-FCAL SET FWA OF CHARGE NUMBER
STM CCDF
ADK FCP1-FCCN SET FWA OF PROJECT NUMBER
STM CCDG
ADK FCP2-FCP1 SET FWA OF WORD 2 OF PROJECT NUMBER
STM CCDH
LDN ZERL CLEAR PASSWORD AND EXPIRATION DATE
CRM *,ON
CCPC EQU *-1 (FWA OF PASSWORD)
LDN ZERL CLEAR ACCESS LEVEL AND CATEGORIES
CRM *,ON
CCPD EQU *-1
LDN 0
STM FCUI+1,P2 CLEAR USER INDEX
LDM FCUI,P2
SCN 77
STM FCUI,P2
LDM SSJS
NJN CCP14 IF CALLER IS *SSJ=* PROGRAM
LDN ZERL CLEAR CHARGE/PROJECT FIELDS
CRM *,ON
CCDF EQU *-1
LDN ZERL
CRM *,ON
CCDG EQU *-1
LDN ZERL
CRM *,ON
CCDH EQU *-1
CCP14 LDN 1 RETURN PERMISSION FLAG
CCP SUBR ENTRY/EXIT
LDM FCAP,P2 CHECK ALTERNATE CATLIST PERMISSION
SHN 0-12
NJN CCP1 IF ALTERNATE CATLIST PERMISSION PRESENT
LDN ACEX USE DEFAULT PERMISSION FOR EXISTING FILES
CCP1 LMN ACNO
ZJN CCPX IF ALTERNATE CATLIST NOT PERMITTED
LDN 0 CLEAR PERMIT SEARCH STATUS
STD P3
* SEARCH FOR PERMIT ENTRY.
LDM FCRI,P2 SET PERMIT INDEX
STD RI
LDM FCRI+1,P2
STD RI+1
ADD RI
NJN CCP4 IF PERMIT INDEX PRESENT
LDM FCCT,P2 CHECK FILE CATEGORY
SHN -6
LMN FCPR
ZJN CCPX IF PRIVATE FILE
LJM CCP12 CHECK PERMISSION MODE IN PFC
CCP4 LDN IPPA PF INCREMENT FOR PERMIT FILE ACCESS
RAM AIPF+1
LDD T6 SAVE POSITION OF CATALOGS
STD ST
LDD T7
STD SS
LDD P2
CCP5 RJM CSA COMPUTE SECTOR ADDRESS
SETMS IO
RJM PDV PROCESS DEVICE STATUS
LDC BUFB READ PERMIT BUFFER
RJM RDS
PJN CCP6 IF NO ERROR
RJM MSR PROCESS READ ERROR
CCP6 LDM BUFB CHECK CONTROL BYTES
ZJN CCP8 IF TERMINATING SEARCH
LDM BUFB+1
SBN NWPH+NWPE
MJN CCP6.0 IF INCORRECT SECTOR LENGTH
LPN NWPE-1
ERRNZ NWPH-NWPE HEADER SIZE MUST EQUAL ENTRY SIZE
ZJN CCP6.1 IF INTEGRAL NUMBER OF PERMIT ENTRIES
CCP6.0 ERROR BCS,,IW,T5,,EI *EQXXX,DNYY,BAD CATALOG/PERMIT SECTOR*
CCP6.1 LDD CP SET USER NAME FOR SEARCH
ADN UIDW
CRD CM
RJM SPB SEARCH PERMIT BUFFER
NJN CCP8 IF PERMIT FOUND
CCP7 LDM BUFB+FPRI CHECK FOR PERMIT LINK
STD RI
LDM BUFB+FPRI+1
STD RI+1
ADD RI
NJP CCP5 IF MORE PERMITS TO CHECK
CCP8 STD P3 SAVE SEARCH STATUS
ZJN CCP9 IF TERMINATING PERMIT SEARCH
LDM FPMD,T2 CHECK PERMIT TYPE
SHN 21-4
MJN CCP7 IF ACCOUNTING PERMIT
SHN 4-4-21+4 SET PERMIT MODE
LPN 17
STD T1
LDM FCAM,P2
SCN 77
ADD T1
STM FCAM,P2
CCP9 LDD ST RESET SEARCH ADDRESS
STD T6
LDD SS
STD T7
SETMS READSTR
RJM PDV PROCESS DEVICE STATUS
LDD P3
NJN CCP9.1 IF PERMIT ENTRY FOUND
LDM FCCT,P2 CHECK FILE CATEGORY
SHN -6
LMN FCPR
ZJP CCPX IF PRIVATE FILE
CCP9.1 LJM CCP12 CHECK PERMISSION MODE IN PERMIT OR PFC
DFS SPACE 4,15
** DFS - DETERMINE FILE SIZE.
*
* ENTRY (P2) = ADDRESS OF CATALOG ENTRY.
* (EQ) = MASTER DEVICE EST ORDINAL.
*
* EXIT LENGTH OF FILE SET IN CATALOG ENTRY.
*
* USES P3, SS, ST, CM - CM+4, T1 - T7.
*
* CALLS CTA, PDV, SDN, SEI.
*
* MACROS ENDMS, SETMS.
DFS2 ADD T2
ZJN DFS3 IF ZERO LENGTH
DFS2.1 SOM FCLF+1,P2 DISCOUNT EOI
PJN DFS3 IF NO OVERFLOW
AOM FCLF+1,P2
SOM FCLF,P2
DFS3 LDD ST RESTORE CATALOG TRACK/SECTOR/EQ
STD T6
LDD SS
STD T7
LDD T5
LMD EQ
ZJN DFSX IF SAME DEVICE
LDD EQ RESET MASTER DEVICE DRIVER
STD T5
SETMS READSTR
RJM PDV PROCESS DEVICE STATUS
DFS SUBR ENTRY/EXIT
LDD T6 SAVE CATALOG TRACK
STD ST
LDD T7 SAVE CATALOG SECTOR
STD SS
LDM FCLF,P2 CHECK LENGTH IN CATALOG
ADM FCLF+1,P2
NJP DFS2.1 IF FILE LENGTH ALREADY AVAILABLE
ENDMS
LDM FCDN,P2 GET DEVICE NUMBER
LPN 77
STD P3
ZJN DFS1 IF DA FILE ON MASTER DEVICE
STD CM
LDM PFPN+4
RJM SDN SEARCH FOR DEVICE NUMBER
PJN DFS1 IF DEVICE FOUND
LJM DFS3 RETURN LENGTH OF ZERO
DFS1 AOM RBSA ADVANCE DA FILE COUNT
SETMS STATUS
LDD CM+4 SET TRT ADDRESS
SHN 3
ADN TRLL
RJM CTA CALCULATE FWA OF TRT
SBD TH
STM SEIA+1
SHN -14
LMC ADCI
STM SEIA
LDM FCBT,P2 SET FIRST TRACK OF FILE
STD T6
LDM DFSA,P3 REQUEST TRT UPDATE IF FIRST FILE ON DEVICE
RJM SEI GET FILE LENGTH
AOM DFSA,P3 PREVENT TRT UPDATE ON SUBSEQUENT FILES
LDD T2
STM FCLF,P2
LDD T3
STM FCLF+1,P2
LJM DFS2 DISCOUNT EOI
DFSA BSSZ 100B TRT UPDATE FLAGS FOR EACH DEVICE IN FAMILY
SPB SPACE 4,10
** SPB - SEARCH PERMIT BUFFER.
*
* ENTRY PERMIT BUFFER LOADED TO *BUFB*
* (CM - CM+3) = USER NAME FOR SEARCH.
*
* EXIT (A) = 0 IF PERMIT NOT FOUND.
* (T2) = INDEX TO PERMIT ENTRY, IF FOUND.
*
* USES T1, T2.
SPB SUBR ENTRY/EXIT
SPB1 LDN NWPH ADVANCE WORD COUNT PAST HEADER
STD T1
LDC BUFB+2 SET DATA ADDRESS
ADN NWPH*5
STD T2
SPB2 LDD CM
ZJN SPBX IF NO USER NAME
LMM FPAN,T2 COMPARE USER NAME
NJN SPB3 IF NO MATCH
LDM FPAN+1,T2
LMD CM+1
NJN SPB3 IF NO MATCH
LDM FPAN+2,T2
LMD CM+2
NJN SPB3 IF NO MATCH
LDM FPAN+3,T2
LMD CM+3
SCN 77
ZJN SPB5 IF USER FOUND
SPB3 LDN NWPE*5 ADVANCE TO NEXT ENTRY
RAD T2
LDN NWPE
RAD T1
LMM BUFB+1
NJN SPB2 IF NOT END OF BUFFER
UJN SPB6 EXIT
SPB5 LCN 1 SET ENTRY FOUND EXIT
SPB6 LJM SPBX RETURN
CSA SPACE 4,15
** CSA - COMPUTE SECTOR ADDRESS.
*
* ENTRY (RI - RI+1) = RANDOM INDEX OF PERMIT SECTOR.
* (DVLW - DVLW+4) = DEVICE LAYOUT WORD.
* (A) = ADDRESS OF FILE NAME IF NAME NOT
* IN FN - FN+3 OTHERWISE (A) = 0.
*
* EXIT (T6) = TRACK OF RANDOM SECTOR
* (T7) = SECTOR OF RANDOM SECTOR.
*
* USES T6, T7, RI - RI+1.
*
* CALLS CRA, PDV.
*
* MACROS ENDMS, ERROR, SETMS.
CSA2 SETMS IO
RJM PDV PROCESS DEVICE STATUS
CSA SUBR ENTRY/EXIT
STM CSAA
STM CSAB
LDM DVLW+2 SET FIRST TRACK IN PERMIT CHAIN
STD T6
ENDMS
LDN 0 SET TRT UPDATE REQUESTED
RJM CRA COVERT RANDOM ADDRESS
PJN CSA2 IF NO ERROR
* PROCESS ERROR IN RANDOM INDEX.
LDC **
CSAA EQU *-1
ZJN CSA1 IF NO NAME TO COPY
LDD MA COPY FILE NAME
CWM *,ON
CSAB EQU *-1
SBN 1
CRD FN
CSA1 ERROR RIN,,IW,EQ *EQXXX,DNYY, RANDOM INDEX ERROR.*
PCA SPACE 4,15
** PCA - PROCESS CATALOG ADDRESS ACCESS MODE.
*
* ENTRY (IN - IN+1) = CURRENT POSITION IN FET.
* (T1) = OUTPUT ENTRY LENGTH FOR CATALOG AND *PFID*.
* (T2) = *PFC* ENTRY POINTER.
* (CATA) = SEARCH MODE.
* (CATB) = MASTER DEVICE NUMBER.
* (WDBB) = CURRENT CATALOG TRACK.
* (WDBC) = CURRENT CATALOG SECTOR.
* BUFA+2 = BEGINNING OF CATALOG SECTOR BUFFER.
*
* EXIT (T1) = DECREMENTED BY ONE FOR *PFID*.
* *PFID* WRITTEN TO CENTRAL USER BUFFER.
PCA SUBR ENTRY/EXIT
LDM CATA CHECK SEARCH MODE
LMN CTID
NJN PCAX IF NOT *PFID* ACCESS
* SETUP *PFID* FOR OUTPUT.
LDM WDBC SET CATALOG SECTOR ADDRESS
STM PCAA+4
LDM WDBB SET CATALOG TRACK ADDRESS
STM PCAA+3
LDD T2 SET *PEO* VALUE
ADC -BUFA-2
SHN -NWCES CALCULATE *PEO* VALUE
LPN 1S"NWCEM"-1
SHN 6
LMM CATB SET MASTER DEVICE NUMBER
STM PCAA+2
* WRITE *PFID* TO CENTRAL BUFFER.
LDD IN FORM DESTINATION ADDRESS
SHN 6
ADD RA
SHN 6
ADD IN+1
ADN NWCE OFFSET FOR *PFC* ENTRY
CWM PCAA,ON WRITE *PFID*
SOD T1 ADJUST OUTPUT LENGTH
LJM PCAX RETURN
PCAA CON 0,0,0,0,0 *PFID* BUFFER
SPACE 4,10
* COMMON DECKS.
CRA$ SET 0 FORCE TRT UPDATE ON *CRA* CALLS
*CALL COMPCRA
*CALL COMPSRA
SEI$ SET 0 FORCE TRT UPDATE ON *SEI* CALLS
*CALL COMPSEI
*CALL COMPRNS
*CALL COMPSDN
SPACE 4,10
* BUFFERS
BUFA EQU * CATALOG BUFFER
BUFB EQU BUFA+502 PERMIT BUFFER
ERRNG EPFW-BUFB-502 BUFFER OVERFLOW
TITLE OVERLAYABLE SUBROUTINES.
CSU SPACE 4,10
** CSU - CHECK FOR SPECIAL USER.
*
* ENTRY USER NAME WORD (UIDW) SET.
* (PFOU - PFOU+3) = USER NAME FROM CALL BLOCK.
*
* EXIT (UI - UI+1) CLEARED IF SPECIAL USER.
*
* USES T1, T2, CM - CM+4.
CSU SUBR ENTRY/EXIT
LDD CP GET USER USER NAME
ADN UIDW
CRD CM
LDD CM+3 CLEAR LOWER USER NAME
SCN 77
STD CM+3
LDN 0 INITIALIZE COUNT
STD T1
CSU1 AOD T1 ADVANCE BYTE
LMN 5
ZJN CSU3 IF END OF USER NAME
LDM CM-1,T1 USER NAME BYTE
STD T2
LMC 2R**
ZJN CSU1 IF ** SKIP COMPARE OF CHARACTERS
SCN 77
ZJN CSU2 IF UPPER CHARACTER *
LDD T2 COMPARE UPPER CHARACTER
LMM PFOU-1,T1
SCN 77
NJN CSUX IF USER NAME DO NOT MATCH
LDD T2 CHECK LOWER CHARACTER
LMN 1R*
LPN 77
ZJN CSU1 IF LOWER CHARACTER = *
CSU2 LDD T2 COMPARE LOWER CHARACTER
LMM PFOU-1,T1
LPN 77
ZJN CSU1 IF LOWER CHARACTER COMPARE
UJN CSU4 USER NAMES DO NOT MATCH
CSU3 STD UI CLEAR USER INDEX
STD UI+1
LDN CTNC SET MODE TO NORMAL CATALOG SEARCH
STM CATA
CSU4 LJM CSUX EXIT
ISP SPACE 4,20
** ISP - INITIALIZE SEARCH OF PERMANENT FILES.
*
* ENTRY (SFAA - SFAA+1) = CALL BLOCK ADDRESS.
* (UI - UI+1) = USER INDEX.
*
* EXIT (T5) = (EQ) = MASTER DEVICE EST ORDINAL.
* (T6) = CATALOG TRACK.
* (T7) = CATALOG SECTOR.
* (SI) = SEARCH INDEX.
* (CF) = CONTINUATION FLAG.
* (DVLW - DVLW+4) = DEVICE LAYOUT WORD.
* (CATB) = MASTER DEVICE NUMBER.
* *SETMS IO* PERFORMED.
*
* USES T4 - T7, RI - RI+1, CM - CM+4.
*
* CALLS CRA, CTA, PDV, SCA, SFA.
*
* MACROS ERROR, SETMS.
ISP SUBR ENTRY/EXIT
* INITIALIZE CATALOG SEARCH.
LDN 0 SELECT NO INTERLOCK OF CATALOG TRACK
STD T1
LDC PFPN SET CATALOG ADDRESS
RJM SCA
PJN ISP1 IF DEVICE AVAILABLE
ERROR PFN,CH,IW *PERMANENT FILES NOT AVAILABLE.*
ISP1 SHN 3 READ DEVICE LAYOUT WORD
ADN ALGL
CRM DVLW,ON
ADN PUGL-ALGL-1 READ USER NAME
CRD CM
SBN PUGL-PFGL GET DEVICE NUMBER FOR MASTER DEVICE
CRD FN
LDD FN+3 PRESERVE DEVICE NUMBER
LPN 77
STM CATB
LDM PFSR
LPN 77
ZJN ISP3 IF NO SPECIAL REQUESTS
SBN SRDN
NJN ISP3 IF NOT DEVICE NUMBER LIST
LDD FN+3 CHECK DEVICE NUMBER
LMM CTDN
LPN 77
ZJN ISP2 IF MASTER DEVICE
LDM CTDN
LPN 77
ZJN ISP3 IF DEVICE NUMBER NOT SPECIFIED
ISP2 STD DN
LDN PSNI ENABLE DEVICE NUMBER SEARCH
STM SHBE
ISP3 LDM PFPN
ZJN ISP4 IF NOT AUXILIARY DEVICE
LDD CM
ZJN ISP4 IF NOT PRIVATE DEVICE
LDC UJNI+SHB4-SHBA SET TO BYPASS USER INDEX CHECK
STM SHBA
ISP4 LDN IPCS PF INCREMENT OF CATALOG SEARCH
RAM AIPF+1
LDD T5 SET MASTER DEVICE EST ORDINAL
STD EQ
SETMS READSTR
RJM PDV PROCESS DEVICE STATUS
LDN 0 SET SECTOR
STD T7
STD SI CLEAR SEARCH INDEX
LDD CM+4 SET FWA OF TRT
SHN 3
ADN TRLL
RJM CTA CALCULATE FWA OF TRT
SBD TH SET *ADC TRTS-(4000/2)*
STM CRAA+1 COMMON DECK -COMPCRA-
STM SRAA+1 COMMON DECK -COMPSRA-
SHN -14
LMC ADCI
STM CRAA COMMON DECK -COMPCRA-
STM SRAA COMMON DECK -COMPSRA-
LDD MA SET FILE NAME IF SPECIFIED
CWM PFFN,ON
SBN 1
CRD FN
RJM SFA SET FET ADDRESS
ADN CFCN CONTINUATION CATALOG DATA ADDRESS
CRD CM
LDD CM+2
SCN 77
ADD CM
ADD CM+1
STD CF SET CONTINUATION FLAG
NJN ISP5 IF CONTINUATION
LJM ISP10 CHECK FET REQUEST POINTERS
ISP5 LDD CM RESTORE SEARCH INDEX
SHN 14
STD SI
SCN 77
ADD CM+1 SET UPPER 12 BITS OF RANDOM INDEX
SHN 14
STD RI
LMD RI
ADD CM+2
SHN -6
STD RI+1
LDM CATA CHECK REQUEST TYPE
LMN CTPM
NJN ISP6 IF NOT PERMIT REQUEST
LDN NWPE-1 SET MASK FOR SEARCH INDEX
STM ISPB
AOM ISPC SET PERMIT SEARCH STATUS
AOM ISPD
AOM ISPE
ISP6 LDD SI VALIDATE SEARCH INDEX
LPC NWCE-1
* LPC NWPE-1 (PERMIT SEARCH)
ISPB EQU *-1
NJN ISP7 IF INCORRECT SEARCH INDEX
LDM DVLW+1 SET LABEL TRACK
* LDM DVLW+2 (SET PERMIT TRACK)
ISPC EQU *-1
STD T6
LDN 0 REQUEST TRT UPDATE
RJM CRA CALCULATE RANDOM ADDRESS
MJN ISP7 IF ERROR IN CONVERSION
LDD T6 CHECK FOR INDEX INTO LABEL/PERMITS TRACK
LMM DVLW+1
* LMM DVLW+2 (PERMIT SEARCH)
ISPD EQU *-1
NJN ISP10 IF LEGAL RANDOM INDEX
ISPE LDN 0
* LDN 1 (PERMIT SEARCH)
NJN ISP9 IF PERMIT SEARCH
ISP7 ERROR ECD,CH,IW * ERROR IN CATLIST CONTINUATION DATA.*
ISP9 LDD T7
SBN 1
MJN ISP7 IF INCORRECT INDEX ON PERMIT SEARCH
ISP10 RJM SFA CHECK FET POINTERS
ADN 4 READ LIMIT
CRD LM-3
SBN 2 READ IN
CRD IN-3
LDD IN
LPN 77
STD IN
LDD LM CHECK BUFFER LENGTH
LPN 77
STD LM
SBD IN
MJN ISP11 IF IN GREATER THAN LIMIT
SHN 14
ADD LM+1
SBD IN+1
SBN 1 MUST HAVE ROOM FOR 1 ENTRY
MJN ISP11 IF NOT LARGE ENOUGH FOR 1 ENTRY
LDD LM CHECK POINTERS WITHIN FL
SHN 14
ADD LM+1
SBN 1
SHN -6
SBD FL
PJN ISP11 IF LIMIT PAST FL
LJM ISPX RETURN
ISP11 ERROR ILR,CH,IW * PFM INCORRECT REQUEST.*
ISPA DATA C*CATALOG*
SPACE 4,10
*CALL COMPSCA
SPACE 4,10
* CHECK FOR OVERFLOW.
OVERFLOW OVLA,EPFW OVERFLOW INTO ERROR PROCESSING AREA
OVERLAY (DEFINE/SETDA PROCESSING.)
SPACE 4,10
** THIS OVERLAY PROCESSES THE DIRECT ACCESS FILE COMMANDS
* *DEFINE* AND *SETDA*. THE DEVICE OF RESIDENCE HAS
* ALREADY BEEN DETERMINED/VALIDATED BY OVERLAY *3PB*.
OVL BSS 0 ENTRY
LJM 0,P0 PROCESS COMMAND
TITLE COMMAND PROCESSING.
SDA SPACE 4,10
*** PROCESS *SETDA* REQUEST.
*
* SET THE DISK ADDRESS OF *FILE NAME* INTO THE CATALOG
* ENTRY OF THE FILE SPECIFIED BY *PFID*.
SDA BSS 0 ENTRY
LDM FCBS,CI
SHN 21-13
PJN SDA1 IF NOT DIRECT ACCESS FILE
LDM FCBT,CI
ZJN SDA2 IF NO CURRENT DISK ADDRESS IN CATALOG
SDA1 ERROR ICU *INCORRECT CATALOG UPDATE.*
SDA2 LDM PFDN SET DEVICE NUMBER
STM FCDN,CI
LDD FS+1 SET FIRST TRACK
STM FCBT,CI
LDD LF SET FILE LENGTH
STM FCLF,CI
LDD LF+1
STM FCLF+1,CI
LDM STAT
LPK STTA
NJN SDA3 IF TAPE ALTERNATE STORAGE REQUEST
LDM FCAF,CI CLEAR *AFPDR*, *AFTMP* AND *AFVER* FLAGS
SCN AFPDRM+AFTMPM+AFVERM
STM FCAF,CI
UJN SDA4 UPDATE SYSTEM SECTOR
SDA3 LDM FCTF,CI CLEAR *TFVER* FLAG
SCN TFVERM
STM FCTF,CI
* ENTER *DEFINE* PROCESSING TO UPDATE SYSTEM SECTOR.
SDA4 LCN EP-CI SET ADDRESS OF CATALOG ENTRY POINTER
RAM DEFA
LDC MMPF*5+2*5-1 CLEAR ONLY PART OF SYSTEM SECTOR
STM DEFB
LDC CASS
STM DEFC
LJM DEF2 PROCESS SYSTEM SECTOR
DEF SPACE 4,10
*** PROCESS *DEFINE* REQUEST.
*
* MAKE THE FILE *FILE NAME* A DIRECT ACCESS PERMANENT FILE
* WITH NAME *PF NAME*.
DEF BSS 0 ENTRY
EXECUTE 3PD LOAD CATALOG UPDATE ROUTINES
LDN PSNI BYPASS ALLOCATION OF IDLE SPACE
STM CCSB
STM CCSB+1
STM CCSC FORCE CATALOG ENTRY FORMATION
STM CCSF BYPASS WRITING CATALOG ENTRY TO DISK
STM CCSF+1
STM CCSG BYPASS WRITING CATALOG ENTRY TO DISK
STM CCSG+1
RJM CUC CHECK USER CONTROLS
LDM PFDN SET DEVICE NUMBER IN CATALOG ENTRY
STM FCEE
LDN 0 CLEAR FILE LENGTH
STD LF
STD LF+1
RJM CCS CREATE CATALOG SECTOR
ENDMS
* PROCESS SYSTEM SECTOR.
DEF2 LDD FS
STD T5
SETMS IO
RJM PDV PROCESS DEVICE STATUS
LDD CM+4 PRESET *COMPSEI*
SHN 3
ADN TRLL
RJM CTA CALCULATE FWA OF TRT
SBD TH
STM SEIA+1
SHN -14
LMC ADCI
STM SEIA
LDD FS+1 SET FIRST TRACK
STD T6
LDM LFEF
ZJN DEF3 IF NOT EMPTY FILE
LJM DEF7 PROCESS EMPTY FILE
* CHECK ENHANCED EOI DATA.
DEF3 LDN SSTL CHECK FILE VALIDATION ENABLED
CRD CM
LDD CM
SHN 21-4
MJN DEF4 IF VALIDATION NOT ENABLED
RJM SEI READ EOI SECTOR
SETMS IO
RJM PDV PROCESS DEVICE STATUS
LDC BFMS
RJM RDS
MJN DEF5 IF READ ERROR
LDD FS+1 RESET FIRST TRACK
STD T6
LMM BFMS+FTEI CHECK FIRST TRACK POINTER
ADM BFMS CHECK LINKAGE BYTES
ADM BFMS+1
ZJN DEF4 IF EOI SECTOR AND IF BOI POINTER MATCHES
ERROR FSE,,,FS *EQXXX,DNYY, FILE BOI/EOI/UI MISMATCH.*
DEF4 LDN 0 IGNORE FILE NAME
RJM RSS READ SYSTEM SECTOR
ZJN DEF7 IF LEGAL SYSTEM SECTOR
MJN DEF5 IF READ ERROR
ERROR DAF,,,FS *EQXXX,DNYY, DIRECT ACCESS FILE ERROR.*
DEF5 RJM PES PROCESS ERROR STATUS
ERROR MSE,CH,,FS *EQXXX,DNYY, MASS STORAGE ERROR.*
* CLEAR SYSTEM SECTOR BUFFER.
DEF7 ENDMS
LDC 77*5-1 CLEAR ENTIRE SYSTEM SECTOR
* LDC MMPF*5+2*5-1 (*SETDA* - CLEAR ONLY PART OF SECTOR)
DEFB EQU *-1
STD T1
DEF8 LDN 0
STM BFMS+2,T1
* STM CASS,T1 (*SETDA*)
DEFC EQU *-1
SOD T1
PJN DEF8 IF NOT END OF BUFFER
* ENTER CATALOG ENTRY INTO SYSTEM SECTOR.
DEFA LDD EP ADDRESS OF CATALOG ENTRY
* LDD CI (IF *SETDA* REQUEST)
STD T1
LDC CTSS ADDRESS IN SYSTEM SECTOR
STD T2
LDC NWCE*5
STD T3
DEF9 LDI T1 TRANSFER ENTRY
STI T2
AOD T1
AOD T2
SOD T3 DECREMENT BYTE COUNT
NJN DEF9 IF MORE STATUS IN SYSTEM SECTOR
* INITIALIZE SYSTEM SECTOR FIELDS.
LDN 32 SET CURRENT ACCESS TO WRITE
STM CASS
RJM SUC SET USER COUNTS IN SYSTEM SECTOR
ENDMS
LDN PDTL SET CURRENT DATE AND TIME
CRM WDSS,ON
LDK MMFL GET MAINFRAME ID
CRD CM
LDD CM SET MAINFRAME ID
STM WDSS
LDD CP GET EJT ORDINAL
ADN TFSW
CRD CM
SFA EJT,CM SET *JSNE* WORD OF EJT
ADK JSNE
CRM WJSS,ON
LDD FA SET FNT ENTRY IN SYSTEM SECTOR
STM DEFD
NFA FA,R
ADK FNTL
CRM FNSS,ON
LDN 0 CLEAR FST POINTER
STD FA
LDM FNSS+4 CHECK FILE TYPE
SHN -6
LMN PMFT
ZJN DEF10 IF FILE CREATED BY *ASSIGNPF*
LDC PMFT*100 SET PMFT
STM FNSS+4
AOM DEFE FORCE INCREMENT OF FILE COUNT
* WRITE SYSTEM SECTOR.
DEF10 SETMS IO,RW,BFMS
RJM PDV PROCESS DEVICE STATUS
LDM LFEF
ZJN DEF11 IF NOT EMPTY FILE
SETMS IO,,BFMS
RJM PDV PROCESS DEVICE STATUS
LDN WCSF/10000&WLSF/10000 WRITE CONSECUTIVE SECTORS
DEF11 LMC LDCI+WLSF/10000
STM WSSA
RJM WSS WRITE SYSTEM SECTOR
MJN DEF11.1 IF WRITE ERROR
LDM LFEF
ZJN DEF13 IF NOT EMPTY FILE
RJM WEI WRITE EOI SECTOR
PJN DEF12 IF NO MASS STORAGE ERRORS
DEF11.1 LJM WSE PROCESS WRITE ERROR
DEF12 ENDMS
LDD FS+1 SET FILE STATUS REWOUND
STD FS+2
LDN FSMS
STD FS+3
LDN 4 SET OPERATION COMPLETE - FILE BUSY
STD FS+4
LDN FSMS SET LAST SECTOR WRITTEN
RJM DTK
DEF13 ENDMS
LDN SPFS SET PRESERVED STATUS FOR DA FILE
STD CM+3
LDD T5
LMC 4000 SET CHECKPOINT
STD CM+1
LDD T6
STD CM+2
MONITOR STBM
LDD FS+1 SAVE PRESERVED TRACK
STM PTKT
* WRITE CATALOG ENTRY TO DISK.
LDD EQ SET MASTER EST ORDINAL
STD T5
LDD CC
LMN CCDF
ZJN DEF14 IF *DEFINE* REQUEST
LDD CB
UJN DEF15 WRITE CATALOG ENTRY TO DISK
DEF14 LDD EB
DEF15 RJM WBI WRITE CATALOG ENTRY TO DISK
ENDMS
* LDN 0 CLEAR PRESERVED TRACK
STM PTKT
RJM CCI CLEAR CATALOG INTERLOCK
* UPDATE FNT ENTRY.
LDC * READ FNT
DEFD EQU *-1
STD FA
NFA FA,R
ADK FNTL
CRD FN
ADN FUTL-FNTL
CRD CM
LDD FN+4 SET *PMFT* FILE TYPE
LPN 77
ADC PMFT*100
STD FN+4
LDD FN+3 CLEAR MODE BITS
SCN 77
STD FN+3
LDM PFUC SET *FS* INDEX IN *FUTL* WORD
SHN -11
SHN 6
ADM LFAL SET FILE ACCESS LEVEL
STD CM+2
NFA FA,R
ADK FNTL
CWD FN
ADN FSTL-FNTL
CWD FS
ADN FUTL-FSTL
CWD CM
* INCREMENT FILE COUNT (IF REQUIRED).
DEFE LDN 0
* LDN 1 (FILE COUNT INCREMENT REQUIRED)
ZJN DEF16 IF FILE COUNT ALREADY INCREMENTED
LDD FS INCREMENT FILE COUNT
STD CM+1
LDN IUCS
STD CM+3
MONITOR SMDM
DEF16 LDD CC
LMN CCDF
ZJN DEF17 IF *DEFINE* REQUEST
* RETURN LOCAL FILE (*SETDA*).
LDN 0 RETURN FILE
STM LOCF-1
EXECUTE 0DF,LOCF
DEF17 EXECUTE 3PU TERMINATE PROGRAM
LOCF SPACE 4,10
LOCF EQU *+5 *0DF* LOAD ADDRESS
ERRNG BFMS-LOCF-ZDFL CHECK LENGTH OF *0DF*
TITLE SUBROUTINES.
CUC SPACE 4,15
** CUC - CHECK USER CONTROLS.
*
* ENTRY (MXNF) = NUMBER OF FILES ALLOWED.
* (ACNF - ACNF+1) NUMBER OF FILES ACCUMULATED.
* (MXDS - MXDS+1) MAXIMUM DIRECT ACCESS FILE SIZE.
*
* MACROS ERROR.
CUC SUBR ENTRY/EXIT
LDM MXDS CHECK FILE SIZE LIMIT
ADM MXDS+1
ZJN CUC2 IF UNLIMITED ACCESS
LDM MXDS CHECK SIZE LIMITS
SBD LF
MJN CUC1 IF LIMIT EXCEEDED
NJN CUC2 IF LIMIT NOT EXCEEDED
LDM MXDS+1
SBD LF+1
PJN CUC2 IF LIMIT NOT EXCEEDED
CUC1 ERROR FTL * FILE TOO LONG.*
CUC2 LDM MXNF CHECK FILE NUMBER LIMIT
ZJN CUCX IF NO LIMIT SET
LDD NF
SHN 14
ADD NF+1
ADN 10 ROUND UP
SHN -3
SBM MXNF
MJN CUCX IF LIMIT NOT EXCEEDED
ZJN CUCX IF LIMIT NOT EXCEEDED
ERROR COF * TOO MANY PERMANENT FILES.*
SUC SPACE 4,10
** SUC - SET USER COUNTS IN SYSTEM SECTOR.
*
* ENTRY (BFMS - BFMS+500) - SYSTEM SECTOR.
* (T5) = EST ORDINAL.
*
* EXIT LOCAL WRITE FLAG SET.
*
* USES T7.
*
* CALLS SMI.
SUC SUBR ENTRY/EXIT
RJM SMI COMPUTE LOCAL USER COUNT BASE ADDRESS
STD T0
SHN 2
ADD T0
ADC UCSS
STD T7
AOI T7
UJN SUCX RETURN
WSE SPACE 4,20
** WSE - WRITE MASS STORAGE ERROR PROCESSOR.
*
* ENTRY (FS - FS+4) = LOCAL FILE FST.
* (LFEF) = 0 IF LOCAL FILE WRITTEN PREVIOUSLY.
* (PWRF) = *PFM* RESTART FLAGS FOR RECALL.
* (RDCT) = DRIVER STATUS.
*
* EXIT (PWRF) = *RFRR* FLAG SET IF REQUEST TO BE RETRIED
* DUE TO UNRECOVERABLE WRITE ERROR.
* (RTKT) = RESERVED TRACK TO BE RELEASED IF REQUEST
* TO BE RETRIED.
* TO *ERR* TO RETRY REQUEST OR ISSUE ERROR MESSAGE.
*
* CALLS PES.
*
* MACROS ERROR.
WSE BSS 0 ENTRY
LDM LFEF
ZJN WSE2 IF FILE WRITTEN PREVIOUSLY
LDM RDCT DRIVER STATUS
SHN 21-12
PJN WSE1 IF RECOVERABLE ERROR
LDM PWRF CHECK RESTART FLAGS
LPK RFRR
NJN WSE3 IF REQUEST ALREADY RETRIED
LDK RFRR SET RETRY REQUEST FLAG
RAM PWRF
WSE1 LDD FS+1 SET RESERVED TRACK TO BE RELEASED
STM RTKT
ERROR RTR,CH RETRY REQUEST
WSE2 RJM PES PROCESS ERROR STATUS
WSE3 ERROR MSE,CH,,FS *EQXXX,DNYY, MASS STORAGE ERROR.*
SPACE 4,10
* COMMON DECKS.
EJT$ SET 0 DEFINE EJT ACCESS
*CALL COMPGFP
*CALL COMPRSS
*CALL COMPSMI
*CALL COMPWEI
*CALL COMPWSS
SPACE 4,10
* CHECK OVERFLOW.
OVERFLOW OVLC,BUF1-2 OVERFLOW INTO CATALOG BUFFER
OVERLAY (DROPDS/PURGE PROCESSING.)
SPACE 4,10
** THIS OVERLAY PROCESSES THE COMMANDS *DROPDS* AND *PURGE*.
OVL BSS 0 ENTRY
LDD EQ RESET MASTER DEVICE EST ORDINAL
STD T5
LJM 0,P0 PROCESS COMMAND
TITLE COMMAND PROCESSING.
DDS SPACE 4,10
*** PROCESS *DROPDS* REQUEST.
*
* DROP DISK SPACE FOR DIRECT ACCESS FILE.
DDS BSS 0 ENTRY
* CHECK FOR CARTRIDGE ALTERNATE STORAGE COPY OF FILE.
LDM FCAA,CI
ADM FCAA+1,CI
ADM FCAA+2,CI
ZJN DDS1 IF NO CARTRIDGE ALTERNATE STORAGE COPY
LDM FCAF,CI
LPN AFOBSM
NJN DDS1 IF COPY OBSOLETE
LDM FCAF,CI
LPN AFPDEM+AFPSEM
ZJN DDS2 IF NO ERROR FLAGS SET
AOM DDSA SET *ERROR FLAG DETECTED* FLAG
* CHECK FOR TAPE ALTERNATE STORAGE COPY OF FILE.
DDS1 LDM FCTV,CI
ADM FCTV+1,CI
ZJN DDS1.2 IF NO TAPE ALTERNATE STORAGE COPY OF FILE
LDM FCTF,CI CHECK FOR ERRORS ON PRIMARY VSN
LPK TFPVNM+TFEPVM
ZJN DDS2 IF NO ERRORS ON PRIMARY VSN
AOM DDSA SET *ERROR FLAG DETECTED* FLAG
LDM FCTF,CI
LPK TFSVSM
ZJN DDS1.2 IF NO SECONDARY VSN COPY OF FILE
LDM FCTF,CI
LPK TFSVNM+TFESVM
ZJN DDS2 IF NO ERRORS ON SECONDARY VSN
DDS1.1 ERROR ASE * ALTERNATE STORAGE ERROR.*
DDS1.2 LDN 0 CHECK FOR ERRORS
* LDN 1 (ALTERNATE STORAGE ERROR DETECTED)
DDSA EQU *-1
NJN DDS1.1 IF ALTERNATE STORAGE ERRORS DETECTED
ERROR AIO * NO ALTERNATE STORAGE COPY OF FILE.*
* RELEASE DISK SPACE FOR FILE.
DDS2 RJM SCP SAVE CATALOG PARAMETERS
LDN 0 CLEAR DISK ADDRESS
STM FCBT,CI
LDM FCDN,CI SAVE DEVICE NUMBER
STM SDDA+1
LDC LDCI
STM SDDA
LDN 0 CLEAR DN AND DISK-RELATED ERRORS
STM FCEC,CI
ERRNZ FCDN-FCEC CODE DEPENDS ON VALUE
LDM FCLF,CI CHECK IF LENGTH IS SET IN PFC
ADM FCLF+1,CI
NJN DDS3 IF LENGTH PRESENT
AOM DDFA FORCE LENGTH CALCULATION
AOM DDFD
DDS3 RJM DDF DELETE DIRECT ACCESS FILE
LJM TRP TERMINATE PROGRAM
PUR SPACE 4,10
*** PROCESS *PURGE* REQUEST.
*
* REMOVE PERMANENT FILE *PF NAME* FROM PERMANENT FILE SYSTEM.
*
* AN INDIRECT ACCESS FILE WHICH DOES NOT HAVE A DISK RESIDENT
* COPY IS TREATED THE SAME AS A DIRECT ACCESS FILE WHICH
* DOES NOT HAVE A DISK IMAGE.
PUR BSS 0 ENTRY
LDM FCBS,CI
SHN 6
MJP PUR2 IF DIRECT ACCESS FILE
LDM FCBT,CI CHECK IF DISK RESIDENT
NJN PUR1 IF DISK RESIDENT INDIRECT ACCESS FILE
LDC 4000 MARK ENTRY AS DAPF HOLE
STM FCBS,CI
UJN PUR2 PROCESS AS IF DIRECT ACCESS FILE
PUR1 EXECUTE 3PD LOAD CATALOG UPDATE ROUTINES
RJM IIA INTERLOCK INDIRECT ALLOCATION
LDK STNS SET *NO JOB SUSPENSION* AFTER THIS POINT
RAM STAT
RJM DCE RELEASE IAPF FILE SPACE
ZJN PUR1.1 IF FILE WITHIN CHAIN AND NO DELINK
RJM CIA CLEAR INDIRECT ALLOCATION INTERLOCK
UJN TRP TERMINATE PROGRAM
PUR1.1 RJM CIA CLEAR INDIRECT ALLOCATION INTERLOCK
LDD CB REWRITE CATALOG ENTRY
RJM WBI
ENDMS
UJN TRP TERMINATE PROGRAM
PUR2 RJM SCP SAVE CATALOG PARAMETERS
LDN 0 CLEAR FILE LENGTH
STM FCLF,CI
STM FCLF+1,CI
STM FCUI+1,CI CLEAR USER INDEX
LDM FCUI,CI
SCN 77
STM FCUI,CI
RJM DDF DELETE DIRECT ACCESS FILE
UJN TRP TERMINATE PROGRAM
SPACE 4,10
** TRP - TERMINATE PROGRAM.
TRP EXECUTE 3PU TERMINATE PROGRAM
TITLE SUBROUTINES.
DDF SPACE 4,10
** DDF - DELETE DIRECT ACCESS FILE.
*
* READ SYSTEM SECTOR AND EITHER PURGE FILE OR SET PURGE
* STATUS IN SYSTEM SECTOR (IF FILE CURRENTLY ACTIVE).
* RELEASE THE CATALOG ENTRY FOR THE FILE.
*
* CALLS CTA, CTI, ITC, PDV, RDS, RSS, SDD, SEI, WCB, WSS.
*
* MACROS ENDMS, ERROR, SETMS, SFA.
DDF SUBR ENTRY/EXIT
RJM SDD SEARCH FOR DIRECT ACCESS DEVICE
ZJN DDF1 IF DEVICE FOUND
RJM WCB REWRITE CATALOG BUFFER
ERROR DAD,CH,IW * DIRECT ACCESS DEVICE ERROR.*
* PERFORM BOI/EOI VALIDATION.
DDF1 LDM PFFT FIRST TRACK
NJN DDF2 IF FILE DISK RESIDENT
RJM WCB REWRITE CATALOG BUFFER
UJN DDFX RETURN
DDF2 RJM ITC INTERLOCK TRACK CHAIN FOR FILE
ZJN DDF3 IF INTERLOCK SUCCESSFUL
RJM WCB REWRITE CATALOG BUFFER
EXIT TNR,CH,IW,T5,EC7 *EQXXX,DNYY, TRACK NOT RESERVED.*
DDF3 AOM DAIF SET INTERLOCK FLAG
SETMS IO
RJM PDV PROCESS DEVICE STATUS
LDN SSTL CHECK FILE VALIDATION ENABLED
CRD CM
LDD CM
LPN 20
LMN 20
STM DDFE+1 SAVE VALIDATION VALUE
NJN DDF3.1 IF VALIDATION ENABLED
DDFA LDN 0
* LDN 1 (LENGTH UPDATE REQUIRED)
NJN DDF3.1 IF LENGTH UPDATE REQUIRED
LJM DDF4 SKIP VALIDATION
DDF3.1 SFA EST,T5 GET EST ENTRY
ADK EQDE
CRD CM
LDD CM+4 SETUP *COMPSEI*
SHN 3
ADN TRLL
RJM CTA CALCULATE FWA OF TRT
SBD TH
STM SEIA+1
SHN -14
LMC ADCI
STM SEIA
RJM SEI POSITION TO EOI SECTOR
DDFD LDN 0
* LDN 1 (LENGTH UPDATE REQUIRED)
ZJN DDF3.2 IF LENGTH UPDATE NOT REQUIRED
LDD T2 SET LENGTH IN PFC
STM FCLF,CI
LDD T3
STM FCLF+1,CI
DDFE LDC 0
* LDC 20 (VALIDATION REQUIRED)
ZJN DDF4 IF VALIDATION NOT REQUIRED
DDF3.2 SETMS IO
RJM PDV PROCESS DEVICE STATUS
LDC BFMS
RJM RDS
MJN DDF6 IF READ ERROR
LDM PFFT RESET FIRST TRACK
STD T6
LMM BFMS+FTEI CHECK FIRST TRACK POINTER
ADM BFMS CHECK LINKAGE BYTES
ADM BFMS+1
DDF4 ZJN DDF5 IF EOI SECTOR AND IF BOI POINTER MATCHES
LJM DDF10 PROCESS BOI/EOI ERROR
* READ SYSTEM SECTOR.
DDF5 LDN 0 IGNORE FILE NAME
RJM RSS
ZJN DDF8 IF LEGAL SYSTEM SECTOR
MJN DDF6 IF READ ERROR
RJM WCB REWRITE CATALOG BUFFER
EXIT DAF,CH,IW,T5,EC7 *EQXXX,DNYY,DIRECT ACCESS FILE ERROR*
DDF6 RJM PES PROCESS ERROR STATUS
RJM WCB REWRITE CATALOG BUFFER
EXIT MSE,CH,IW,T5,EC7 *EQXXX,DNYY, MASS STORAGE ERROR.*
* VALIDATE SYSTEM SECTOR.
DDF8 LDM CTSS+FCUI COMPARE USER INDEX IN SYSTEM SECTOR
LPN 77
SHN 14
LMM CTSS+FCUI+1
DDFB LMC *
* LMC UI (USER INDEX FROM CATALOG)
NJN DDF10 IF USER INDEX MISMATCH
LDN 2
STD P0
DDF9 LDM FCCD+2,CI CHECK CREATION DATE
DDFC EQU *-1
LMM CTSS+FCCD,P0
NJN DDF10 IF MISMATCH ON CREATION DATE
SOM DDFC
SOD P0
PJN DDF9 IF NOT END OF DATE
UJN DDF11 CHECK FOR ACTIVE USERS
* PROCESS BOI/EOI/UI MISMATCH.
DDF10 RJM WCB REWRITE CATALOG BUFFER
EXIT FSE,CH,IW,T5,EC7 *EQXXX,DNYY,FILE BOI/EOI/UI MISMATCH*
* CHECK FOR ACTIVE USERS.
DDF11 LDM CASS CHECK FOR ACTIVE USERS PRESENT
LPN 32
ADM UCSS+1
ADM UCSS+2
ADM UCSS+3
ADM UCSS+4
ADM FISS CHECK FOR FAST ATTACH FILE
STD P0
ZJN DDF11.1 IF NO ACTIVE USERS
LDM PFSR
LPN 77
LMN SRNB
NJN DDF11.1 IF TO PURGE FILE WHEN BUSY
ERROR FBS *(FILE NAME) BUSY.*
* RELEASE THE CATALOG ENTRY FOR THE FILE. NO JOB SUSPENSION
* IS PERFORMED IF THE DIRECT ACCESS DEVICE BECOMES INACCESSIBLE
* AFTER THIS POINT.
*
* THE CATALOG ENTRY IS RELEASED BEFORE SETTING PURGE STATUS
* IN THE SYSTEM SECTOR OF THE FILE BECAUSE THE CATALOG AND
* DIRECT ACCESS FILES MAY RESIDE ON DIFFERENT DEVICES. THIS
* ORDER ENSURES THAT THE CATALOG DOES NOT POINT TO AN OBSOLETE
* FILE IF THE CATALOG DEVICE BECOMES INACCESSIBLE BEFORE THE
* ENTRY IS RELEASED.
DDF11.1 RJM WCB REWRITE CATALOG BUFFER
LDM PFFT RESET FIRST TRACK OF FILE
STD T6
* REWRITE SYSTEM SECTOR (FOR FILE WITH ACTIVE USERS).
LDD P0
ZJP DDF14 IF NO ACTIVE USERS
LDM CASS SET PURGE BIT
LMN 40
STM CASS
SETMS IO,RW
NJN DDF13 IF DEVICE INACCESSIBLE
RJM WSS WRITE SYSTEM SECTOR
PJN DDF12 IF NO ERROR
LDM RDCT DEVICE STATUS
SHN 21-12
PJN DDF13 IF DEVICE INACCESSIBLE
EXIT MSE,CH,IW,T5,EC7 *EQXXX,DNYY, MASS STORAGE ERROR.*
DDF12 ENDMS
DDF13 LDD T6 CLEAR TRACK INTERLOCK
RJM CTI
LDN 0 CLEAR INTERLOCK FLAG
STM DAIF
UJN DDF15 COMPLETE
* RELEASE FILE SPACE (FOR FILE WITH NO ACTIVE USERS).
DDF14 LDD T5 SET EST ORDINAL
LMC 4000 SET CHECKPOINT BIT
STD CM+1
LDD T6
STD CM+2
MONITOR DTKM
* LDN 0 CLEAR TRACK INTERLOCK FLAG
STM DAIF
* INCREMENT PRU LIMIT FIELD IN CONTROL POINT AREA.
* NUMBER OF SECTORS RETURNED BY *DTKM* IS IN (CM+3 - CM+4).
LDN CICS INCREMENT CP AREA FIELD FUNCTION CODE
STD CM
LDK ACLW ADDRESS OF MASS STORAGE PRU LIMIT
STD CM+1
LDN 0D*100+18D POSITION AND WIDTH OF LIMIT FIELD
STD CM+2
LDD MA WRITE *UADM* PARAMETERS TO MESSAGE BUFFER
CWD CM
LDN 1
STD CM+1 REQUEST COUNT
STD CM+2 DO NOT DROP PP
MONITOR UADM
DDF15 LJM DDFX RETURN
SCP SPACE 4,10
** SCP - SAVE CATALOG PARAMETERS.
*
* SAVES PARAMETERS FROM THE CATALOG ENTRY FOR LATER USE.
*
* EXIT (DDFB, DDFB+1) = USER INDEX.
* (PFFT) = FIRST TRACK.
SCP SUBR ENTRY/EXIT
LDM FCUI,CI SAVE USER INDEX
LPN 77
RAM DDFB
LDM FCUI+1,CI
STM DDFB+1
LDM FCBT,CI SAVE FIRST TRACK
STM PFFT
UJN SCPX RETURN
SDD SPACE 4,15
** SDD - SEARCH FOR DIRECT ACCESS DEVICE.
*
* ENTRY (CI) = ADDRESS OF CATALOG ENTRY.
* (EQ) = MASTER DEVICE EST ORDINAL.
* (PFPN - PFPN+4) = PERMANENT FILE DEVICE DESCRIPTION.
* (SDDA) PRESET WITH DEVICE NUMBER IF *SETDA* REQUEST.
*
* EXIT (A) = 0 IF DEVICE FOUND.
* (A) .GT. 0 IF DEVICE NOT FOUND OR INACCESSIBLE.
* (T5) = (PFEQ) = DIRECT ACCESS DEVICE EST ORDINAL.
*
* USES CM, T5.
*
* CALLS PDA, SDN.
SDD2 LDD T5 SET DIRECT ACCESS DEVICE EST ORDINAL
STM PFEQ
LDN 0 RETURN WITH (A) = 0
SDD SUBR ENTRY/EXIT
LDD EQ SET DIRECT ACCESS DEVICE EST ORDINAL
STD T5
STM PFEQ
SDDA LDM FCDN,CI GET DIRECT ACCESS DEVICE NUMBER
* LDC (FCDN) (*DROPDS*)
LPN 77
ZJN SDDX IF MASTER DEVICE, RETURN
STD CM
LDM PFPN+4 FAMILY EST ORDINAL
RJM SDN SEARCH FOR DEVICE NUMBER
PJN SDD2 IF DEVICE FOUND
ADN 1
RJM PDA PROCESS DEVICE AVAILABILITY
SDD1 LDN 1 RETURN WITH (A) .GT. 0
UJN SDDX RETURN
WCB SPACE 4,20
** WCB - REWRITE CATALOG BUFFER.
*
* ENTRY (T5) = DIRECT ACCESS DEVICE EST ORDINAL.
* (CB) = ADDRESS OF CATALOG BUFFER.
* (CC) = COMMAND CODE.
* (EQ) = MASTER DEVICE EST ORDINAL.
* (PFEQ) = DIRECT ACCESS DEVICE EST ORDINAL.
*
* EXIT (T5) = DIRECT ACCESS DEVICE EST ORDINAL.
* CATALOG BUFFER REWRITTEN.
* CATALOG INTERLOCK RELEASED.
* *ENDMS* PERFORMED.
*
* USES T5.
*
* CALLS CCI, WBI, WCE.
*
* MACROS ENDMS.
WCB SUBR ENTRY/EXIT
LDD EQ
LMD T5
ZJN WCB0 IF ALREADY ON MASTER DEVICE
ENDMS
LDD EQ SET MASTER DEVICE EST ORDINAL
STD T5
WCB0 LDD CC CHECK COMMAND CODE
LMN CCDD
ZJN WCB1 IF *DROPDS* REQUEST
RJM WCE UPDATE AND REWRITE CATALOG BUFFER
UJN WCB2 CLEAR CATALOG INTERLOCK
WCB1 LDD CB REWRITE CATALOG BUFFER
RJM WBI
ENDMS
WCB2 RJM CCI CLEAR CATALOG INTERLOCK
LDM PFEQ RESET DIRECT ACCESS DEVICE EST ORDINAL
STD T5
UJN WCBX RETURN
WCE SPACE 4,15
** WCE - REWRITE CATALOG ENTRY.
*
* ENTRY (CI) = ADDRESS OF CATALOG ENTRY.
* (CB) = ADDRESS OF CATALOG BUFFER.
*
* EXIT (FCKD) UPDATED AND CATALOG SECTOR REWRITTEN.
*
* USES CM - CM+4.
*
* CALLS WBI.
*
* MACROS ENDMS.
WCE SUBR ENTRY/EXIT
LDN PDTL UPDATE CONTROL MODIFICATION DATE
CRD CM
LDD CM+2
STM FCKD,CI
LDD CM+3
STM FCKD+1,CI
LDD CM+4
STM FCKD+2,CI
LDD CB REWRITE CATALOG BUFFER
RJM WBI
ENDMS
UJN WCEX RETURN
SPACE 4,10
* COMMON DECKS.
*CALL COMPRSS
*CALL COMPSDN
*CALL COMPWSS
SPACE 4,10
* CHECK FOR OVERFLOW.
OVERFLOW OVLC,BUF2-2 OVERFLOW INTO HOLE BUFFER
OVERLAY (DELPFC/DROPIDS/PERMIT PROCESSING.)
SPACE 4,10
** THIS OVERLAY PROCESSES THE COMMANDS *DELPFC*, *DROPIDS*
* AND *PERMIT*.
OVL BSS 0 ENTRY
LDD EQ RESET MASTER DEVICE EST ORDINAL
STD T5
LJM 0,P0 PROCESS COMMAND
TITLE COMMAND PROCESSING.
DIS SPACE 4,10
*** PROCESS *DROPIDS* REQUEST.
*
* DROP INDIRECT ACCESS FILE DISK SPACE.
*
* THE TRACK AND SECTOR POINTERS IN THE EXISTING PFC WILL BE
* CLEARED, AND A HOLE WILL BE CREATED TO POINT TO THE DISK
* SPACE. THIS HOLE WILL EITHER BE PLACED IN A PREVIOUSLY
* EXISTING DAPF HOLE OR A NEW HOLE WILL BE ALLOCATED AT THE
* END OF THE CATALOG TRACK. THIS IS DONE SO THAT THE
* POSITION OF THE ORIGINAL PFC DOES NOT CHANGE; BOTH THE
* DESTAGE DUMP CODE AND THE PURGE AFTER DUMP CODE IN *PFDUMP*
* REQUIRE THAT THE POSITION OF THE PFC REMAIN CONSTANT.
DIS BSS 0 ENTRY
LDD CI SET CURRENT PFN FOR NEW PFC ENTRY
ADN FCFN
RJM SFN
* CHECK FOR CARTRIDGE ALTERNATE STORAGE COPY OF FILE.
LDM FCAA,CI
ADM FCAA+1,CI
ADM FCAA+2,CI
ZJN DIS1 IF NO CARTRIDGE ALTERNATE STORAGE COPY
LDM FCAF,CI
LPN AFPDEM+AFPSEM
ZJN DIS4 IF NO ERROR FLAGS SET
AOM DISA SET *ERROR FLAG DETECTED* FLAG
* CHECK FOR TAPE ALTERNATE STORAGE COPY OF FILE.
DIS1 LDM FCTV,CI
ADM FCTV+1,CI
ZJN DIS2 IF NO TAPE ALTERNATE STORAGE COPY OF FILE
LDM FCTF,CI CHECK FOR ERRORS ON PRIMARY VSN
LPK TFPVNM+TFEPVM
ZJN DIS4 IF NO ERRORS ON PRIMARY VSN
AOM DISA SET *ERROR FLAG DETECTED* FLAG
LDM FCTF,CI
LPK TFSVSM
ZJN DIS2 IF NO SECONDARY VSN COPY OF FILE
LDM FCTF,CI
LPK TFSVNM+TFESVM
NJN DIS3 IF ERRORS ON SECONDARY VSN
UJN DIS4 CONTINUE
DIS2 LDN 0 CHECK IF ERROR FLAG DETECTED
* LDN 1 (ALTERNATE STORAGE ERROR FLAG DETECTED)
DISA EQU *-1
NJN DIS3 IF ALTERNATE STORAGE ERROR FLAG DETECTED
ERROR AIO * NO ALTERNATE STORAGE COPY OF FILE.*
DIS3 ERROR ASE * ALTERNATE STORAGE ERROR.*
* SET UP HOLE TO POINT TO DATA.
DIS4 LDM FCBT,CI SET DISK ADDRESS
STM SDAB
LDM FCBS,CI
STM SDAC
LDM FCLF,CI SET FILE LENGTH IN (LF - LF+1)
STD LF
LDM FCLF+1,CI
STD LF+1
STD HL SIMULATE EXACT FIT HOLE, IF HOLE FOUND
EXECUTE 3PD LOAD CATALOG UPDATE ROUTINES
LDN PSNI BYPASS SPACE ALLOCATION IN *CCS*
STM CCSB
STM CCSB+1
STM CCSC BYPASS *WBI* CALLS IN *CCS*
STM CCSF
STM CCSF+1
STM CCSG
STM CCSG+1
ISTORE FCEL,(UJN FCE7.1) BYPASS DATE/TIME UPDATES IN *FCE*
RJM IIA INTERLOCK INDIRECT ALLOCATION
LDK STNS SET *NO JOB SUSPENSION* AFTER THIS POINT
RAM STAT
RJM CCS CREATE NEW CATALOG ENTRY FOR HOLE
* UPDATE EXISTING PFC AND RELEASE FILE SPACE.
LDN 0 CLEAR DISK ADDRESS IN EXISTING PFC
STM FCBT,CI
STM FCBS,CI
LDD CB REWRITE EXISTING PFC
RJM WBI
LDD EB SET POINTERS TO PFC TO BE DELETED
STD CB
LDD EP
STD CI
RJM DCE RELEASE IAPF FILE SPACE
ZJN DIS5 IF FILE WITHIN CHAIN AND NO DELINK
RJM CIA CLEAR INDIRECT ALLOCATION INTERLOCK
UJN DIS6 TERMINATE PROGRAM
DIS5 RJM CIA CLEAR INDIRECT ALLOCATION INTERLOCK
LDD CB
RJM WBI WRITE CATALOG ENTRY
ENDMS
DIS6 EXECUTE 3PU TERMINATE PROGRAM
DPF SPACE 4,10
*** PROCESS *DELPFC* REQUEST.
*
* DELETE INDIRECT ACCESS FILE PFC ENTRY, AND DROP ASSOCIATED
* DISK SPACE. THIS REQUEST IS MADE ONLY TO DELETE THE ORIGINAL
* PFC LEFT OVER FROM AN *APPEND*, AFTER A CPU TRANSFER HAS BEEN
* PERFORMED ON THAT MACHINE.
DPF BSS 0 ENTRY
EXECUTE 3PD LOAD CATALOG UPDATE ROUTINES
RJM IIA INTERLOCK INDIRECT ALLOCATION
LDK STNS SET *NO JOB SUSPENSION* AFTER THIS POINT
RAM STAT
RJM DCE DELETE CATALOG ENTRY
ZJN DPF1 IF FILE WITHIN CHAIN AND NO DELINK
RJM CIA CLEAR INDIRECT ALLOCATION INTERLOCK
UJN DPF2 TERMINATE PROGRAM
DPF1 RJM CIA CLEAR INDIRECT ALLOCATION INTERLOCK
LDD CB REWRITE CATALOG BUFFER
RJM WBI
ENDMS
DPF2 EXECUTE 3PU TERMINATE PROGRAM
PER SPACE 4,10
*** PROCESS *PERMIT* REQUEST.
*
* CREATE PERMISSION *M* FOR USER *OUAN* TO ACCESS FILE
* *PF NAME*.
PER BSS 0 ENTRY
* *PERMIT* IS NOT ALLOWED ON A FILE WITH AN ACCESS LEVEL
* LOWER THAN THAT OF THE JOB UNLESS THE CALLER IS VALIDATED
* FOR WRITE-DOWN PRIVILEGES OR IS A SUBSYSTEM.
LDM SSOM
ZJN PER0 IF UNSECURED SYSTEM
LDM FCAL,CI
LPN 7
SBM PFAL
PJN PER0 IF FILE NOT LOWER THAN JOB
LDM SVAL
LPN 40
NJN PER0 IF USER VALIDATED FOR WRITE-DOWN
LDM SSID
SBK LSSI+1
PJN PER0 IF SUBSYSTEM
ERROR WDP,,,,SVE * WRITE-DOWN OF DATA PROHIBITED.*
PER0 LDD RI
ADD RI+1
ZJN PER1 IF NO PERMIT RANDOM INDEX
LDD PP
ZJN PER1 IF PERMIT NOT FOUND
RJM UEP UPDATE EXISTING PERMIT
UJN PER2 UPDATE CATALOG ENTRY
* CREATE PERMIT ENTRY.
PER1 LDM EXPC GET EXPLICIT PERMIT COUNT
SBK PMLM
PJP PER3 IF PERMIT LIMIT EXCEEDED
LDN 0 SET EXPLICIT PERMIT OPTION
STM SAPF
STM IACP
EXECUTE 3PE LOAD PERMIT UPDATE ROUTINES
RJM CPE CREATE PERMIT ENTRY
* UPDATE CATALOG ENTRY.
PER2 LDN PDTL UPDATE CONTROL MODIFICATION DATE
CRD CM
LDD CM+2
STM FCKD,CI
LDD CM+3
STM FCKD+1,CI
LDD CM+4
STM FCKD+2,CI
LDD CB REWRITE CATALOG BUFFER
RJM WBI
ENDMS
EXECUTE 3PU TERMINATE PROGRAM
* PROCESS PERMIT LIMIT.
PER3 ERROR PLE * PERMIT LIMIT EXCEEDED.*
TITLE SUBROUTINES.
UEP SPACE 4,10
** UEP - UPDATE EXISTING PERMIT ENTRY.
*
* ENTRY (PP) = ADDRESS OF PERMIT ENTRY TO UPDATE.
* (MODE) = MODE TO BE PERMITTED.
* (PXDT - PXDT+1) = PERMIT EXPIRATION DATE.
*
* EXIT PERMIT ENTRY UPDATED.
*
* USES CM - CM+4, T0.
*
* CALLS WBI.
UEP SUBR ENTRY/EXIT
LDD PP SET PERMIT ENTRY ADDRESS
ADN FPAC
STM UEPA
LDN PDTL SET TIME/DATE IN ENTRY
CRD CM
LDM MODE SET PERMIT MODE
LPN 17
ADN 40 SET *EXPIRATION DATE PRESENT* BIT
STD T0
LDM FPAC+1,PP UPDATE MODE/ACCESS COUNT
SCN 77
ADD T0
STD CM+1
LDM FPAC,PP
STD CM
LDD MA SET UPDATED WORD IN ENTRY
CWD CM
CRM *,ON
UEPA EQU *-1
LDM PXDT+1 SET PERMIT EXPIRATION DATE
STM FPXD+1,PP
LDM FPXD,PP
SCN 77
LMM PXDT
STM FPXD,PP
LDD PB REWRITE PERMIT SECTOR
RJM WBI
LJM UEPX EXIT
SPACE 4,10
* CHECK FOR OVERFLOW.
OVERFLOW OVLC,BUF2-2 OVERFLOW INTO HOLE BUFFER
OVERLAY (CHANGE/SETPFAC/SETPFAL PROCESSING.)
SPACE 4,10
** THIS OVERLAY PROCESSES THE PERMANENT FILE COMMANDS
* *CHANGE*, *SETPFAC* AND *SETPFAL*. THESE COMMANDS
* CHANGE FIELDS IN THE CATALOG ENTRY FOR A FILE.
* *SETPFAC* AND *SETPFAL* WILL NOT BE PERFORMED IF THE
* FILE IS CURRENTLY ATTACHED.
OVL BSS 0 ENTRY
* LJM CHG PROCESS REQUEST
TITLE COMMAND PROCESSING.
*** PROCESS CHANGE REQUEST.
*
* CHANGE CATALOG ENTRY FOR PERMANENT FILE.
*
* THE PASSWORD SPECIFIED IN THE *FET* WILL BE USED UNLESS
* IT HAS THE VALUE 7777 7777 7777 77B. THE *MODE*, *CT*,
* AND *SS* FIELDS SPECIFIED IN THE *FET* WILL ONLY BE
* USED IF THEY HAVE THE 40B-BIT SET.
*
* *CHANGE* AND *SETPFAC* ARE NOT ALLOWED IF THE ACCESS LEVEL
* OF THE FILE IS LOWER THAN THAT OF THE JOB UNLESS THE CALLER
* IS VALIDATED FOR WRITE-DOWN PRIVILEGES OR IS A SUBSYETM.
CHG BSS 0 ENTRY
LDM STAT CHECK FOR PRIVATE DEVICE
LPK STPD
ZJN CHG1 IF NOT PRIVATE DEVICE
LDN PSNI SET BYPASS OF USER INDEX CHECK
STM SCTB
CHG1 RJM SFL SET PERMANENT FILE NAMES
RJM SCT SEARCH CATALOG
ZJN CHG2 IF FILE NOT FOUND
RJM CCE CHANGE CATALOG ENTRY
LDN PDTL UPDATE CONTROL MODIFICATION DATE
CRD CM
LDD CM+2
STM FCKD,CI
LDD CM+3
STM FCKD+1,CI
LDD CM+4
STM FCKD+2,CI
LDD CB REWRITE CATALOG ENTRY
RJM WBI
ENDMS
EXECUTE 3PU TERMINATE PROGRAM
CHG2 ERROR FNF (*FILENAME) NOT FOUND.*
TITLE SUBROUTINES.
CAL SPACE 4,10
** CAL - CHECK ACCESS LEVEL.
*
* ENTRY (CI) = INDEX TO ENTRY.
* (EQ) = FAMILY EST ORDINAL.
* (CALA) = ALTERNATE DEVICE EST ORDINAL.
* (LFAL) = NEW ACCESS LEVEL.
* (SVAL) = USER-S JOB SECURITY VALIDATIONS.
*
* USES CM - CM+4.
*
* MACROS ERROR, MONITOR.
CAL3 LDM FCAL,CI CHECK FOR DOWNGRADE
LPN 7
STD CM
LDM LFAL
SBD CM
PJN CALX IF NOT DOWNGRADE
LDM SVAL CHECK FOR PF DOWNGRADE VALIDATON
SHN 21-6
MJN CALX IF USER HAS DOWNGRADE VALIDATION
LDM SSID CHECK SUBSYSTEM ID
SBK LSSI+1
PJN CALX IF SUBSYSTEM
ERROR NVD,,,,SVE * NOT VALID TO DOWNGRADE DATA.*
CAL SUBR ENTRY/EXIT
LDM SSOM
ZJN CALX IF UNSECURED SYSTEM
LDD EQ CHECK IF *LFAL* VALID FOR MASTER DEVICE
STD CM+2
LDN VAES
STD CM+1
LDM LFAL
STD CM+4
MONITOR VSAM
LDD CM+1
NJN CAL2 IF FILE ACCESS NOT VALID FOR DEVICE
LDM FCBS,CI
SHN 21-13
CAL1 PJP CAL3 IF NOT DIRECT ACCESS FILE
LDC **
CALA EQU *-1
ZJN CAL1 IF FILE ON MASTER DEVICE
STD CM+2 CHECK IF ACCESS IS VALID FOR FILE DEVICE
LDN VAES
STD CM+1
LDM LFAL
STD CM+4
MONITOR VSAM
LDD CM+1
ZJN CAL1 IF FILE ACCESS VALID FOR DEVICE
CAL2 ERROR LNP,,,,SVE * ACCESS LEVEL NOT VALID ON PF DEVICE.*
CCE SPACE 4,20
** CCE - CHANGE CATALOG ENTRY.
*
* ENTRY (CI) = INDEX TO ENTRY.
* (PI) = FILE CATEGORY.
* (PI+1) = FILE MODE.
* (FS - FS+3) = NEW FILE NAME.
* (PFPW) = PASSWORD.
* (PFCW) = USER CONTROL WORD.
* (PXDT - PXDT+1) = PASSWORD EXPIRATION DATE.
* (STAT) BIT 0=1 IF PASSWORD EXPIRATION DATE SPECIFIED.
* (PFAL) = FILE ACCESS LEVEL (*SETPFAL*).
* (PFFC - PFFC+2) = FILE CATEGORY SET (*SETPFAC*).
*
* EXIT CATALOG ENTRY CHANGED.
*
* USES CM - CM+4.
*
* CALLS CAL, CFB.
*
* MACROS ERROR, NFA.
CCE14 RJM CFB CHECK FOR FILE BUSY
RJM CAL CHECK ACCESS LEVEL
LDM LFAL *SETPFAL* CHANGE ACCESS LEVEL
STM FCAL,CI
UJN CCEX RETURN
CCE15 RJM CFB CHECK FOR FILE BUSY
LDM PFFC *SETPFAC* CHANGE ACCESS CATEGORY SET
STM FCFC,CI
LDM PFFC+1
STM FCFC+1,CI
LDM PFFC+2
STM FCFC+2,CI
CCE SUBR ENTRY/EXIT
LDD CC
LMN CCAL
ZJN CCE14 IF *SETPFAL* REQUEST
LDM SSOM
ZJN CCE0 IF UNSECURED SYSTEM
LDM FCAL,CI
LPN 7
SBM PFAL
PJN CCE0 IF FILE NOT LOWER THAN JOB
LDM SVAL
LPN 40
NJN CCE0 IF USER VALIDATED FOR WRITE-DOWN
LDM SSID
SBK LSSI+1
PJN CCE0 IF SUBSYSTEM
ERROR WDP,,,,SVE * WRITE-DOWN OF DATA PROHIBITED.*
CCE0 LDD CC
LMN CCAC
ZJP CCE15 IF *SETPFAC* REQUEST
* SET NEW FILE NAME.
LDD FS
ZJN CCE1 IF NO NEW NAME
STM FCFN,CI ENTER NEW FILE NAME
LDD FS+1
STM FCFN+1,CI
LDD FS+2
STM FCFN+2,CI
LDD FS+3
SCN 77
LMD UI
STM FCFN+3,CI
* SET NEW CHARGE AND PROJECT NUMBERS INTO PFC.
CCE1 LDM PFSR GET SPECIAL REQUEST FUNCTION
LPN 77
LMN SRCP
NJN CCE2 IF *CP* PARAMETER NOT SPECIFIED
LDD CI
RAM CCEC
NFA CHGN SET EXECUTING CHARGE/PROJECT FROM NFL
CRM FCCN,TR
CCEC EQU *-1
ERRNZ FCP1-FCCN-5 *FCP1* MUST FOLLOW *FCCN*
ERRNZ FCP2-FCCN-12 *FCP2* MUST FOLLOW *FCCN*/*FCP1*
ERRNZ PJ1N-CHGN+1 *PJ1N* MUST BE IMMEDIATELY AFTER *CHGN*
ERRNZ PJ2N-PJ1N+1 *PJ2N* MUST BE IMMEDIATELY AFTER *PJ1N*
* SET USER CONTROL WORD.
CCE2 LDM PUCW
SHN 6
PJN CCE3 IF NOT SPECIFIED
LDD CI
ADC FCCW
STM CCEA SET ADDRESS TO WRITE CONTROL WORD
LDD MA
CWM PUCW,ON
SBN 1
CRM *,ON
CCEA EQU *-1
* SET PASSWORD.
CCE3 LDN CFPW
SBM FETL
PJP CCE6 IF FET NOT LONG ENOUGH FOR PASSWORD
LDM PFPW
LMC 7777
ZJN CCE4 IF PASSWORD NOT SPECIFIED
LDD CI
ADN FCPW
STM CCEB SET ADDRESS TO WRITE PASSWORD
LDD MA
CWM PFPW,ON
SBN 1
CRM *,ON
CCEB EQU *-1
UJN CCE5 SET PASSWORD EXPIRATION DATE
* SET PASSWORD EXPIRATION DATE.
CCE4 LDM STAT CHECK EXPIRATION DATE STATUS
LPN STXD
ZJN CCE6 IF EXPIRATION DATE NOT SPECIFIED
LDM FCPW,CI
NJN CCE5 IF PASSWORD EXISTS
ERROR PAE * PFM ARGUMENT ERROR.*
CCE5 LDM FCXD,CI SET EXPIRATION DATE
SCN 77
LMM PXDT
STM FCXD,CI
LDM PXDT+1
STM FCXD+1,CI
* SET CATEGORY.
CCE6 LDD PI
SHN 21-13
PJN CCE7 IF NOT SPECIFIED
LDM FCCT,CI
LPN 37
ADD PI
LPC 3777
STM FCCT,CI
* SET FILE MODE.
CCE7 LDD PI+1
SHN 21-5
PJN CCE8 IF NOT SPECIFIED
LDM FCAM,CI
SCN 37
ADD PI+1
SCN 40
STM FCAM,CI
* SET FILE SUBSYSTEM.
CCE8 LDM PFSS
SHN 21-5
PJN CCE9 IF SUBSYSTEM NOT SPECIFIED
SHN -21+5+22
LMM FCFS,CI SAVE SUBSYSTEM IN CATALOG ENTRY
SCN 77
LMM PFSS
LMN 40
STM FCFS,CI
* CLEAR ERROR STATUS.
CCE9 LDM PFSR
LPN 77
LMN SRCE
NJN CCE10 IF NOT CLEAR ERROR STATUS REQUEST
LDM FCEC,CI CLEAR ERROR STATUS
LPC 7077
STM FCEC,CI
LDM JORG
LMK SYOT
NJN CCE10 IF NOT SYSTEM ORIGIN
LDM FCAF,CI CLEAR MSS RELATED ERROR FLAGS
SCN AFPSEM+AFPDEM+AFTMPM
STM FCAF,CI
* SET BACKUP REQUIREMENT.
CCE10 LDM PFBR CHECK FOR BR PARAMETER CHANGE REQUEST
LPC 700
ZJN CCE11 IF *BR* NOT SPECIFIED
STD CM
LDM FCBR,CI
LPC 7077
LMD CM
STM FCBR,CI
* SET PREFERRED RESIDENCE.
CCE11 LDM PFRS CHECK FOR PR PARAMETER CHANGE REQUEST
LPC 7000
ZJN CCE12 IF *PR* NOT SPECIFIED
STD CM
LDM FCRS,CI
LPC 0777
LMD CM
STM FCRS,CI
* SET ALTERNATE CATLIST PERMISSION.
CCE12 LDM PFAP
LPC 6000
ZJN CCE13 IF *AC* NOT SPECIFIED
STM FCAP,CI
CCE13 LJM CCEX RETURN
CFB SPACE 4,10
** CFB - CHECK FOR FILE BUSY.
*
* ENTRY (CI) = INDEX TO ENTRY.
* (EQ) = FAMILY EST ORDINAL.
*
* USES CM, T5, T6.
*
* CALLS CTI, ITC, PDA, PDV, RMD, RSS, SDN.
*
* MACROS ENDMS, ERROR, SETMS.
CFB SUBR ENTRY/EXIT
LDM FCBS,CI
SHN 21-13
PJN CFBX IF NOT DIRECT ACCESS FILE
ENDMS
LDD EQ SET DIRECT ACCESS DEVICE EST ORDINAL
STM PFEQ
LDM FCDN,CI DETERMINE EST ORDINAL OF DEVICE
LPN 77
ZJN CFB4 IF FILE ON MASTER DEVICE
STD CM
LDD EQ
RJM SDN SEARCH FOR DEVICE NUMBER
PJN CFB3 IF DEVICE FOUND
ADN 1
RJM PDA PROCESS DEVICE AVAILABILITY
CFB1 ERROR DAD,CH * DIRECT ACCESS DEVICE ERROR.*
CFB2 ERROR TNR,CH,,T5 *EQXXX,DNYY, TRACK NOT RESERVED.*
CFB3 LDD T5 SAVE ALTERNATE DEVICE EST ORDINAL
STM CALA
STM PFEQ
CFB4 LDM FCBT,CI
ZJP CFB8 IF FILE NOT DISK RESIDENT
STM PFFT FIRST TRACK
RJM ITC INTERLOCK TRACK CHAIN FOR FILE
NJN CFB2 IF TRACK NOT RESERVED
AOM DAIF SET INTERLOCK FLAG
SETMS IO
RJM PDV PROCESS DEVICE STATUS
LDN 0 DONT VERIFY FILE NAME IN SYSTEM SECTOR
RJM RSS READ SYSTEM SECTOR
ZJN CFB6 IF LEGAL SYSTEM SECTOR
MJN CFB5 IF READ ERROR
ERROR DAF,,,T5 *EQXXX,DNYY, DIRECT ACCESS FILE ERROR.*
CFB5 RJM PES PROCESS ERROR STATUS
ERROR MSE,CH,,T5 *EQXXX,DNYY, MASS STORAGE ERROR.*
CFB6 ENDMS
LDM CASS CHECK IF FILE BUSY
ADM FISS
ADM UCSS+1
ADM UCSS+2
ADM UCSS+3
ADM UCSS+4
ZJN CFB7 IF FILE NOT BUSY
ERROR FBS,CH * FILE BUSY*
CFB7 LDD T6
RJM CTI RELEASE FILE INTERLOCK
LDN 0 CLEAR INTERLOCK FLAG
STM DAIF
CFB8 RJM RMD RESET TO MASTER DEVICE
LJM CFBX RETURN
CFN SPACE 4,10
** CFN - CHECK FILE NAMES.
*
* ENTRY (FN - FN+3) = OLD FILE NAME.
* (FS - FS+3) = NEW FILE NAME.
* (P1) = 1 IF OLD ALREADY FOUND.
* (T3) = INDEX TO CATALOG ENTRY.
*
* EXIT (A) = 0 IF OLD NOT FOUND.
CFN SUBR ENTRY/EXIT
* CHECK OLD FILE NAME.
CFNA LDN 0
* LDN 1 (OLD FILE NAME ALREADY FOUND)
NJN CFN1 IF OLD FILE NAME ALREADY FOUND
LDI T3
LMD FN
NJN CFN1 IF NOT EQUAL
LDM FCFN+1,T3
LMD FN+1
NJN CFN1 IF NOT EQUAL
LDM FCFN+2,T3
LMD FN+2
NJN CFN1 IF NOT EQUAL
LDM FCFN+3,T3
LMD FN+3
SHN -6
CFN1 NJP CFN3 IF NOT OLD FILE
LDN ZERL CHECK IF JOB CAN ACCESS FILE
CRD CM
LDM FCAL,T3 SET ACCESS LEVEL
LPN 7
STD CM+1
LDM FCFC,T3 SET ACCESS CATEGORY
LPC 377
STD CM+2
LDM FCFC+1,T3
STD CM+3
LDM FCFC+2,T3
STD CM+4
LDD MA
CWD CM
LDN ZERL
CRD CM
LDN VAJS CHECK ACCESS LEVEL AND CATEGORY SET
STD CM+1
ERRNZ VAJS-3 CODE DEPENDS ON VALUE
STD CM+4
MONITOR VSAM
LDD CM+1
NJN CFN2 IF NOT VALID ACCESS
AOM CFNA SET TO BYPASS COMPARE OF OLD FILENAME
LJM CFNX RETURN
CFN2 ERROR JCA,,,,SVE * JOB CANNOT ACCESS FILE.*
* CHECK NEW FILE NAME.
CFN3 LDN 0
* LDN 1 (NO NEW FILE NAME)
CFNC EQU *-1
NJN CFN4 IF NO NEW FILENAME SPECIFIED
LDI T3
LMD FS
NJN CFN4 IF NOT EQUAL
LDM FCFN+1,T3
LMD FS+1
NJN CFN4 IF NOT EQUAL
LDM FCFN+2,T3
LMD FS+2
NJN CFN4 IF NOT EQUAL
LDM FCFN+3,T3
LMD FS+3
SHN -6
NJN CFN4 IF NOT EQUAL
LDD MA
CWD FS
CRD FN
ERROR FAP *(FILENAME) ALREADY PERMANENT.*
CFN4 LDN 0
LJM CFNX EXIT
ICT SPACE 4,15
** ICT - INTERLOCK CATALOG TRACK.
*
* ENTRY (T6) = CATALOG TRACK TO BE INTERLOCKED.
* (T5) = EST ORDINAL.
*
* EXIT TRACK INTERLOCKED.
* RECALL *PFM* IF INTERLOCK NOT AVAILABLE
* AFTER FOUR TRIES.
* TO *HNG* IF CATALOG TRACK NOT RESERVED.
*
* CALLS DPR, STI.
ICT SUBR ENTRY/EXIT
LDN 3 SET RETRY COUNT
STD T1
ICT1 RJM STI TRY TO INTERLOCK TRACK
ZJN ICTX IF INTERLOCK SUCCESSFUL
LMN 2
ZJN ICT2 IF TRACK NOT RESERVED
SOD T1
MJN ICT3 IF RETRY COUNT EXHAUSTED
RJM DPR DELAY PRIOR TO RETRY
UJN ICT1 RETRY
ICT2 RJM HNG HANG IF CATALOG TRACK NOT RESERVED
ICT3 EXIT INA,CH,,,EC4 * INTERLOCK NOT AVAILABLE.*
ISP SPACE 4,20
** ISP - INITIALIZE SEARCH OF PERMANENT FILES.
*
* ENTRY (SDAA) = MASTER DEVICE EST ORDINAL.
* (CCIA) = CATALOG TRACK.
*
* EXIT (T4) = MASTER DEVICE CHANNEL.
* (T5) = MASTER DEVICE EST ORDINAL.
* (T6) = CATALOG TRACK.
* (T7) = CATALOG SECTOR.
* (DPPF) = INCREMENTED FOR CATALOG SEARCH.
* (MSRA) = ERROR PROCESSOR ADDRESS FOR *RNS*.
* (P0 - P4) = INITIALIZED CATALOG SEARCH POINTERS.
* CATALOG TRACK INTERLOCK SET.
* *SETMS READ* PERFORMED.
*
* CALLS ICT, IRA, PDV.
*
* MACROS ERROR, SETMS.
ISP SUBR ENTRY/EXIT
LDM SDAA SET MASTER DEVICE EST ORDINAL
STD T5
LDM CCIA SET CATALOG TRACK
STD T6
RJM ICT INTERLOCK CATALOG TRACK
AOM CCIB SET CATALOG TRACK INTERLOCK FLAG
ISP1 LDN IPCS PF INCREMENT FOR CATALOG SEARCH
RAM AIPF+1
RJM IRA INITIALIZE RANDOM PROCESSORS
LDK PCC SET ERROR PROCESSOR ADDRESS FOR *RNS*
STM MSRA
* SET SEARCH POINTERS.
LDN 0 SET STARTING CATALOG TRACK SECTOR
STD T7
LDN ZERL CONTIGUOUS STORAGE INITIALIZATION
CRD P0 TEMPORARY CATALOG SEARCH BUFFER POINTERS
LDC BUF1 SET PRIMARY BUFFER POINTER
STD P2
LDC BUF2 SET SECONDARY BUFFER POINTER
STD P3
SETMS READSTR
RJM PDV PROCESS DEVICE STATUS
UJP ISPX RETURN
PCC SPACE 4,10
** PCC - PROCESS CATALOG READ ERROR FOR *CHANGE*.
*
* ENTRY READ ERROR DETECTED BY *COMPRNS*.
PCC SUBR ENTRY
RJM PES PROCESS ERROR STATUS
ERROR MSE,,,EQ *EQXXX,DNYY, MASS STORAGE ERROR.*
SCT SPACE 4,10
** SCT - SEARCH CATALOG.
*
* ENTRY (FN - FN+3) = PF NAME.
* (FS - FS+3) = NEW FILE NAME.
* (UI - UI+1) = USER INDEX.
*
* EXIT (CB) = CATALOG BUFFER.
* (CI) = CATALOG POINTER.
* (A) = 0 IF FILE NOT FOUND.
*
* USES CB, CI, P0, P1, T3.
*
* CALLS RNS, CFN.
SCT6 LDD P1
SCT SUBR ENTRY/EXIT
LDN IPCS PF INCREMENT FOR CATALOG SEARCH
RAM AIPF+1
UJN SCT2 READ FIRST SECTOR FOR SEARCH
* END OF SECTOR.
SCT1 LDC * SECTOR WORD COUNT
SCTA EQU *-1
LPN 77
NJN SCT6 IF EOR
* READ NEXT SECTOR FOR SEARCH.
SCT2 LDM P2,P1 SET BUFFER ADDRESS
STD T3
LDD T6 SAVE POSITION OF SECTOR
STM -2,T3
STM ERRC
LDD T7
STM -1,T3
STM ERRD
LDD T3
RJM RNS READ SECTOR
ZJN SCT6 IF EOI
STD P0 SAVE WORD COUNT
STM SCTA
LPN NWCE-1
ZJN SCT3 IF INTEGRAL NUMBER OF CATALOG ENTRIES
ERROR BCS,,,T5,,EI *EQXXX,DNYY, BAD CATALOG/PERMIT SECTOR.*
SCT3 LDN 2
RAD T3 SKIP CONTROL BYTES
UJN SCT5 CHECK CATALOG ENTRY
* ADVANCE TO NEXT ENTRY.
SCT4 LDC NWCE*5 ADVANCE POINTER
RAD T3
LCN NWCE DECREMENT WORD COUNT
RAD P0
NJN SCT5 IF NOT END OF BUFFER
LJM SCT1 PROCESS END OF BUFFER
* CHECK CATALOG ENTRY.
SCT5 LDM FCUI,T3
LPN 37
SHN 14
LMM FCUI+1,T3
ZJN SCT4 IF HOLE
LMD UI+1
SHN 6
LMD UI
NJN SCT4 IF NOT CORRECT USER INDEX
SCTB EQU *-1 PRESET TO *PSN* IF PRIVATE DEVICE
RJM CFN CHECK FILE NAME
ZJN SCT4 IF OLD NOT FOUND
* OLD FILE FOUND.
AOD P1 SET NEW BUFFER
LDD T3 SET CATALOG ENTRY POINTERS
STD CI
LDD P2
STD CB
SCTC LDN 0
* LDN 1 (NO NEW FILE NAME)
ZJN SCT4 IF NEW FILENAME SPECIFIED, CONTINUE SEARCH
LJM SCTX RETURN
SFL SPACE 4,15
** SFL - SET FILE NAMES.
*
* EXIT (FN - FN+3) = PERMANENT FILE NAME.
* (FS - FS+3) = NEW FILE NAME.
* (PI) = CATEGORY.
* (PI+1) = MODE.
*
* USES FN - FN+4, FS - FS+4, PI - PI+1.
*
* CALLS ISP.
SFL SUBR ENTRY/EXIT
LDD MA SET NEW FILE NAME
CWM PFNF,ON
SBN 1
CRD FS SET NEW FILE NAME
LDD FS
NJN SFL1 IF NEW FILE NAME
AOM CFNC SET TO BYPASS CHECK FOR NEW NAME
AOM SCTC SET TO BYPASS SEARCH FOR NEW NAME
SFL1 LDM MODE
SCN 77
STD PI SET CATEGORY
LDM MODE
LPN 77
STD PI+1 SET MODE
RJM ISP INITIALIZE FOR SEARCH OF CATALOG
UJN SFLX RETURN
SPACE 4,10
* COMMON DECKS.
*CALL COMPSDN
*CALL COMPRSS
SPACE 4,10
* EQUIVALENCE EXTERNALLY REFERENCED TAGS.
QUAL *
PCC EQU /".O"/PCC
SPACE 4,10
* CHECK FOR OVERFLOW.
ERRNG BUF1-2-* OVERFLOW INTO CATALOG SEARCH BUFFER
OVERFLOW OVLC,EPFW OVERFLOW INTO ERROR PROCESSING AREA
OVERLAY (SETASA/SETAF PROCESSING.)
SPACE 4,10
** THIS OVERLAY PROCESSES THE COMMANDS *SETASA* AND *SETAF*.
OVL BSS 0 ENTRY
RJM RMD RESET TO MASTER DEVICE
LJM 0,P0 PROCESS COMMAND
TITLE COMMAND PROCESSING.
SAA SPACE 4,10
*** PROCESS *SETASA* REQUEST.
*
* SET ALTERNATE STORAGE ADDRESS IN CATALOG ENTRY.
SAA BSS 0 ENTRY
LDM STAT
LPK STTA
NJP SAA3 IF TAPE ALTERNATE STORAGE REQUEST
* SET CARTRIDGE ALTERNATE STORAGE ADDRESS.
LDM PFAT GET ALTERNATE STORAGE TYPE
LPN 77
LMN ATOD
ZJN SAA0 IF OPTICAL DISK STORAGE
LDM FCBS,CI
SHN 21-13
MJN SAA1 IF DIRECT ACCESS FILE
SAA0 LDM FCAF,CI
LPC AFLOKM
NJN SAA2 IF *AFLOK* STILL SET
ERROR AIO * NO ALTERNATE STORAGE COPY OF FILE.*
SAA1 RJM CDA COMPARE DISK ADDRESS FOR DIRECT ACCESS
SAA2 NFA FA,R SET FST COMPLETE
ADN FSTL
CWD FS
LDN 0 CLEAR ALTERNATE STORAGE FLAGS
STM FCAF,CI
LDM PFAT SET ALTERNATE STORAGE TYPE
LMM FCAT,CI
SCN 77
LMM PFAT
STM FCAT,CI
LDM PFAA SET ALTERNATE STORAGE ADDRESS
STM FCAA,CI
LDM PFAA+1
STM FCAA+1,CI
LDM PFAA+2
STM FCAA+2,CI
LDM PFAT
LPN 77
LMN ATOD
NJN SAA2.1 IF NOT OPTICAL DISK STORAGE
LDM PFOA SET OPTICAL DISK ADDRESS
STM FCOA,CI
LDM PFOA+1
STM FCOA+1,CI
RJM UFL UPDATE FILE LENGTH
SAA2.1 LJM WCE REWRITE CATALOG ENTRY AND EXIT
* SET TAPE ALTERNATE STORAGE ADDRESS.
SAA3 LDM FCTF,CI
LPC TFLOKM
NJN SAA4 IF *TFLOK* STILL SET
ERROR AIO * NO ALTERNATE STORAGE COPY OF FILE.*
SAA4 LDM PFTS SET TAPE SEQUENCE NUMBER
LMM FCTS,CI
SCN 77
LMM PFTS
STM FCTS,CI
LDM PFTS+1
STM FCTS+1,CI
LDM PFTV SET TAPE VSN
STM FCTV,CI
LDM PFTV+1
STM FCTV+1,CI
LDM PFES CHECK TAPE FLAGS
LPC -777
NJN SAA6 IF UNDEFINED BITS SPECIFIED
LDM PFES SET TAPE ALTERNATE STORAGE FLAGS
STM FCTF,CI
RJM UFL UPDATE FILE LENGTH
SAA5 LJM WCE REWRITE CATALOG ENTRY AND EXIT
SAA6 ERROR ICU * INVALID CATALOG UPDATE.*
SAF SPACE 4,10
*** PROCESS *SETAF* REQUEST.
*
* SET/CLEAR ALTERNATE STORAGE FLAGS IN CATALOG ENTRY.
SAF BSS 0 ENTRY
LDM STAT
LPK STTA
NJN SAF1 IF TAPE ALTERNATE STORAGE REQUEST
RJM UAF UPDATE CARTRIDGE ALTERNATE STORAGE FLAGS
UJN SAF2 CONTINUE
SAF1 RJM UTF UPDATE TAPE ALTERNATE STORAGE FLAGS
SAF2 LJM WCE REWRITE CATALOG ENTRY AND EXIT
TITLE SUBROUTINES.
CDA SPACE 4,15
** CDA - COMPARE DISK ADDRESSES.
*
* ENTRY (FS - FS+4) = FST FOR LOCAL FILE.
* (CI) = ADDRESS OF CATALOG ENTRY.
*
* EXIT TO *ERR* IF DISK ADDRESSES DO NOT MATCH.
*
* CALLS PDA, RMD, SDN.
*
* MACROS ERROR.
CDA SUBR ENTRY/EXIT
LDM FCDN,CI CHECK DEVICE NUMBER
LPN 77
ZJN CDA1 IF FILE ON MASTER DEVICE
STD CM
LDM PFPN+4 SET FAMILY EST ORDINAL
RJM SDN SEARCH FOR DEVICE NUMBER
PJN CDA1 IF DEVICE FOUND
ADN 1
RJM PDA PROCESS DEVICE AVAILABILITY
CDA0.1 ERROR DAD,CH * DIRECT ACCESS DEVICE ERROR.*
CDA1 LDD T5 CHECK FILE EST ORDINAL
LMD FS
ZJN CDA3 IF FILE ON RIGHT EQUIPMENT
CDA2 ERROR PVE,CH *PFC VERIFICATION ERROR.*
CDA3 LDM FCBT,CI CHECK FIRST TRACK
LMD FS+1
NJN CDA2 IF FILE ON WRONG TRACK
RJM RMD RESET TO MASTER DEVICE
UJP CDAX RETURN
UAF SPACE 4,10
** UAF - UPDATE CARTRIDGE ALTERNATE STORAGE FLAGS.
*
* ENTRY (CI) = ADDRESS OF CATALOG ENTRY.
*
* EXIT (FCAF) UPDATED.
* (FCAF/FCAT/FCAA) CLEARED IF SET REQUEST FOR *AFOBS*,
* OR IF SET REQUEST FOR *AFFRE* ON A DISK-RESIDENT FILE.
*
* USES T1, T2.
UAF SUBR ENTRY/EXIT
LDM PFES SAVE SET/CLEAR FLAG
SCN 77
STD T2
LDM PFES GET PROCESSOR ADDRESS
LPN 77
STD T1
SBN AFMAX+1
PJN UAF1 IF INVALID FLAG NUMBER
LDM UAFA,T1
STD T1
LJM 0,T1 PROCESS FLAG
UAFA BSS 0 TABLE OF ERROR FLAG PROCESSORS
LOC 0
CON UAF2 *AFOBS* PROCESSOR
CON UAF3 *AFPSE* PROCESSOR
CON UAF5 *AFPDE* PROCESSOR
CON UAF6 *AFPDR* PROCESSOR
CON UAF1 *AFVER* PROCESSOR
CON UAF8 *AFTMP* PROCESSOR
CON UAF10 *AFFRE* PROCESSOR
LOC *O
UAF1 ERROR ICU *INVALID CATALOG UPDATE.*
* PROCESS *ALTERNATE STORAGE COPY OBSOLETE* FLAG.
UAF2 LDD T2 PROCESS *AFOBS*
ZJN UAF1 IF *CLEAR* REQUEST
LDM FCBT,CI
ZJN UAF1 IF NO DISK ADDRESS
LDM FCAF,CI
LPN AFPDRM
NJN UAF1 IF *PSEUDO-RELEASE* SET
UAF2.1 LDN FCAF CLEAR *AF*, *AT*, AND *ASA* INFO
ADD CI
STM UAFD
LDN ZERL
CRM *,ON
UAFD EQU *-1
LJM UAFX RETURN
* PROCESS *ALTERNATE STORAGE COPY PERMANENT STATUS ERROR* FLAG
UAF3 LDD T2 PROCESS *AFPSE*
ZJN UAF1 IF *CLEAR* REQUEST
LDM FCAF,CI SET *AFPSE* FLAG
SCN AFPSEM
LMN AFPSEM
UAF4 STM FCAF,CI UPDATE FLAGS IN CATALOG
LJM UAFX RETURN
* PROCESS *ALTERNATE STORAGE COPY PERMANENT DATA ERROR* FLAG.
UAF5 LDD T2 PROCESS *AFPDE*
ZJP UAF1 IF CLEAR REQUEST
LDM FCAF,CI SET *AFPDE* FLAG
SCN AFPDEM
LMN AFPDEM
UJN UAF4 RETURN
* PROCESS *ALTERNATE STORAGE COPY PSEUDO-RELEASED* FLAG.
UAF6 LDD T2 PROCESS *AFPDR*
NJN UAF7 IF *SET* REQUEST
STM UAFB
UAF7 LDM FCAF,CI SET/CLEAR *AFPDR* FLAG
SCN AFPDRM
UAFB LMN AFPDRM
* PSN (*CLEAR* REQUEST)
UJN UAF4 RETURN
* PROCESS *TEMPORARY ERROR* FLAG.
UAF8 LDD T2
NJN UAF9 IF *SET* REQUEST
STM UAFC
UAF9 LDM FCAF,CI SET/CLEAR *AFTMP* FLAG
SCN AFTMPM
UAFC LMN AFTMPM
* PSN (*CLEAR* REQUEST)
UJN UAF4 RETURN
* PROCESS *FREE CARTRIDGE* FLAG.
UAF10 LDD T2 PROCESS *AFFRE* FLAG
ZJN UAF11 IF *CLEAR* REQUEST
LDM FCBT,CI
NJP UAF2.1 IF FILE CURRENTLY DISK RESIDENT
LDN PSNI ENABLE SET OF FLAG
STM UAFE
UAF11 LDM FCAF,CI ALTERNATE STORAGE FLAGS
LPC -AFFREM CLEAR *AFFRE* FLAG
UAFE UJN UAF12 DO NOT RESET FLAG
* PSN (*SET* REQUEST)
LMC AFFREM SET *AFFRE* FLAG
UAF12 LJM UAF4 STORE ALTERNATE STORAGE FLAGS
UFL SPACE 4,20
** UFL - UPDATE FILE LENGTH.
*
* ENTRY (CI) = ADDRESS OF PFC ENTRY IN BUFFER.
*
* EXIT FILE LENGTH UPDATED IN PFC.
*
* USES CM, T6.
*
* CALLS CTA, PDA, RMD, SDN, SEI.
*
* MACROS ERROR, SETMS.
*
* NOTES THIS SUBROUTINE ASSUMES THAT THE FILE IS NOT
* CURRENTLY ATTACHED IN A WRITEABLE MODE; THE
* CORRECTNESS OF THAT ASSUMPTION DEPENDS ON LOGIC IN
* *PFDUMP* AND *PFU*. THIS SUBROUTINE WILL ONLY BE
* CALLED IF *TFLOK* IS STILL SET, AND *PFDUMP* DOES
* NOT SET *TFLOK* UNTIL AFTER *PFU* HAS DETERMINED
* THAT THE FILE IS NOT BUSY.
UFL SUBR ENTRY/EXIT
LDM FCBS,CI
SHN 21-13
PJN UFLX IF INDIRECT ACCESS FILE
LDM FCLF,CI
ADM FCLF+1,CI
NJN UFLX IF FILE LENGTH NONZERO
LDM FCDN,CI CHECK DEVICE NUMBER
LPN 77
ZJN UFL2 IF FILE ON MASTER DEVICE
* PROCESS ALTERNATE DEVICE ACCESS.
STD CM
LDM PFPN+4 SET FAMILY EST ORDINAL
RJM SDN SEARCH FOR DEVICE NUMBER
PJN UFL2 IF DEVICE FOUND
ADN 1
RJM PDA PROCESS DEVICE AVAILABILITY
UFL1 ERROR DAD,CH * DIRECT ACCESS DEVICE ERROR.*
* DETERMINE FILE LENGTH.
UFL2 LDM FCBT,CI SET FILE FIRST TRACK
STD T6
SETMS STATUS
LDD CM+4 SET TRT ADDRESS FOR *SEI*
SHN 3
ADN TRLL
RJM CTA CALCULATE FWA OF TRT
SBD TH
STM SEIA+1
SHN -14
LMC ADCI
STM SEIA
LDN 0 FORCE CURRENT TRT
RJM SEI SKIP TO EOI
LDD T2 SET FILE LENGTH
STM FCLF,CI
LDD T3
STM FCLF+1,CI
RJM RMD RESET TO MASTER DEVICE
UJP UFLX RETURN
UTF SPACE 4,20
** UTF - UPDATE TAPE ALTERNATE STORAGE FLAGS.
*
* ENTRY (CI) = ADDRESS OF CATALOG ENTRY.
*
* EXIT (FCTF) UPDATED.
*
* USES T1, T2.
*
* NOTE - CODE TO SET AND CLEAR SOME OF THESE FLAGS ARE INCLUDED
* IN THIS FUNCTION ONLY FOR TESTING PURPOSES. DURING
* NORMAL SYSTEM OPERATION, THE FLAGS ARE SET BY OTHER
* MEANS. FOR EXAMPLE, *PFDUMP* SETS THE FLAG *TFLOK*
* BY CALLING THE *PFU* FUNCTION *CTSL*, AND SETS THE
* FLAGS *TFSVS*, *TFLIF*, *TFCTS* AND *TFACS* BY
* SPECIFYING THESE BITS ON THE CALL TO *SETASA*.
UTF SUBR ENTRY/EXIT
LDM PFES SAVE SET/CLEAR FLAG
SCN 77
STD T2
LDM PFES GET PROCESSOR ADDRESS
LPN 77
STD T1
SBN TFMAX+1
PJN UTF1 IF INVALID FLAG NUMBER
LDM UTFA,T1
STD T1
LJM 0,T1 PROCESS FLAG
UTFA BSS 0 TABLE OF ERROR FLAG PROCESSORS
LOC 0
CON UTF1 *TFVER* PROCESSOR
CON UTF2 *TFSVS* PROCESSOR
CON UTF5 *TFPVN* PROCESSOR
CON UTF7 *TFSVN* PROCESSOR
CON UTF9 *TFEPV* PROCESSOR
CON UTF11 *TFESV* PROCESSOR
CON UTF13 *TFLIF* PROCESSOR
CON UTF15 *TFCTS* PROCESSOR
CON UTF17 *TFACS* PROCESSOR
CON UTF1 RESERVED
CON UTF1 RESERVED
CON UTF19 *TFLOK* PROCESSOR
LOC *O
UTF1 ERROR ICU * INVALID CATALOG UPDATE.*
* PROCESS *SECONDARY VSN EXISTS* FLAG.
UTF2 LDD T2 PROCESS *TFSVS*
NJN UTF3 IF *SET* REQUEST
STM UTFB
UTF3 LDM FCTF,CI SET/CLEAR *TFSVS* FLAG
SCN TFSVSM
UTFB LMN TFSVSM
* PSN (*CLEAR* REQUEST)
UTF4 STM FCTF,CI UPDATE FLAG FIELD IN CATALOG
UJP UTFX RETURN
* PROCESS *PRIMARY VSN NOT AVAILABLE* FLAG.
UTF5 LDD T2 PROCESS *TFPVN*
NJN UTF6 IF *SET* REQUEST
STM UTFC
UTF6 LDM FCTF,CI SET/CLEAR *TFPVN* FLAG
SCN TFPVNM
UTFC LMN TFPVNM
* PSN (*CLEAR* REQUEST)
UJN UTF4 RETURN
* PROCESS *SECONDARY VSN NOT AVAILABLE* FLAG.
UTF7 LDM FCTF,CI CHECK IF SECONDARY VSN EXISTS
LPK TFSVSM
ZJP UTF1 IF SECONDARY VSN NOT DEFINED
LDD T2
NJN UTF8 IF *SET* REQUEST
STM UTFD
UTF8 LDM FCTF,CI SET/CLEAR *TFSVN* FLAG
SCN TFSVNM
UTFD LMN TFSVNM
* PSN (*CLEAR* REQUEST)
UJN UTF4 RETURN
* PROCESS *DATA ERROR ON PRIMARY VSN* FLAG.
UTF9 LDD T2
NJN UTF10 IF *SET* REQUEST
STM UTFE
UTF10 LDM FCTF,CI SET/CLEAR *TFEPV* FLAG
SCN TFEPVM
UTFE LMN TFEPVM
* PSN (*CLEAR* REQUEST)
UJP UTF4 RETURN
* PROCESS *DATA ERROR ON SECONDARY VSN* FLAG.
UTF11 LDM FCTF,CI CHECK IF SECONDARY VSN EXISTS
LPK TFSVSM
ZJP UTF1 IF SECONDARY VSN NOT DEFINED
LDD T2
NJN UTF12 IF *SET* REQUEST
STM UTFF
UTF12 LDM FCTF,CI SET/CLEAR *TFESV* FLAG
SCN TFESVM
UTFF LMN TFESVM
* PSN (*CLEAR* REQUEST)
UJP UTF4 RETURN
* PROCESS *FILE ON LI FORMAT TAPE* FLAG.
UTF13 LDD T2 PROCESS *TFLIF*
NJN UTF14 IF *SET* REQUEST
STM UTFG
STM UTFG+1
UTF14 LDM FCTF,CI SET/CLEAR *TFLIF* FLAG
LPC -TFLIFM
UTFG LMC TFLIFM
* PSN (*CLEAR* REQUEST)
UJP UTF4 RETURN
* PROCESS *FILE ON CARTRIDGE (CT/AT) TAPE* FLAG.
UTF15 LDD T2 PROCESS *TFCTS*
NJN UTF15 IF *SET* REQUEST
STM UTFH
STM UTFH+1
UTF16 LDM FCTF,CI SET/CLEAR *TFCTS* FLAG
LPC -TFCTSM
UTFH LMC TFCTSM
* PSN (*CLEAR* REQUEST)
UJP UTF4 RETURN
* PROCESS *FILE ON ACS CARTRIDGE (AT) TAPE* FLAG.
UTF17 LDD T2 PROCESS *TFACS*
NJN UTF18 IF *SET* REQUEST
STM UTFI
STM UTFI+1
UTF18 LDM FCTF,CI SET/CLEAR *TFACS* FLAG
LPC -TFACSM
UTFI LMC TFACSM
* PSN (*CLEAR* REQUEST)
UJP UTF4 RETURN
* PROCESS *TFLOK* FLAG.
UTF19 LDD T2
ZJP UTF1 IF *CLEAR* REQUEST
LDM FCTF,CI SET *TFLOK* FLAG
LPC -TFLOKM
LMC TFLOKM
UJP UTF4 RETURN
WCE SPACE 4,15
** WCE - REWRITE CATALOG ENTRY.
*
* ENTRY (CI) = ADDRESS OF CATALOG ENTRY.
* (CB) = ADDRESS OF CATALOG BUFFER.
*
* EXIT TO *3PU*.
* (FCKD) UPDATED AND CATALOG SECTOR REWRITTEN.
*
* USES CM - CM+4.
*
* CALLS WBI.
*
* MACROS ENDMS.
WCE BSS 0 ENTRY
LDN PDTL UPDATE CONTROL MODIFICATION DATE
CRD CM
LDD CM+2
STM FCKD,CI
LDD CM+3
STM FCKD+1,CI
LDD CM+4
STM FCKD+2,CI
LDD CB REWRITE CATALOG BUFFER
RJM WBI
ENDMS
EXECUTE 3PU TERMINATE PROGRAM
SPACE 4,10
* COMMON DECKS.
*CALL COMPSDN
SEI$ SET 0 FORCE TRT UPDATE ON *SEI* CALLS
*CALL COMPSEI
SPACE 4,10
* CHECK FOR OVERFLOW.
OVERFLOW OVLC,BUF1-2 OVERFLOW INTO CATALOG BUFFER
OVERLAY (DEVICE TO DEVICE TRANSFER.),LOCG
SPACE 4,10
** THIS OVERLAY PROCESSES DEVICE-TO-DEVICE TRANSFER FOR
* THE INDIRECT ACCESS FILE COMMANDS *GET*, *OLD*, *SAVE*,
* *REPLACE*, AND *APPEND*.
OVL BSS 0 ENTRY
RJM CES CREATE EOI SECTOR
UJN ".Q"X RETURN
TITLE DEVICE-TO-DEVICE TRANSFER MAIN LOOP.
** DTD - DEVICE TO DEVICE TRANSFER.
*
* ENTRY (T4 - T7) = MASS STORAGE PARMETERS TO START READ AT.
* (SDAA - SDAC) = MASS STORAGE PARAMETERS FOR 1ST WRITE
* (BB) = ADDRESS TO START READING IN AT.
* (FA) = FST ADDRESS.
* (LF - LF+1) = FILE LENGTH.
*
* CALLS IBA, PDV, RNS, SDP, WES, WNS.
*
* MACROS ERROR, SETMS.
DTD BSS 0 ENTRY
LDK PTE SET ERROR PROCESSOR ADDRESS FOR *RNS*
STM MSRA
DTD0 LDD BB
RJM RNS
LDI BB
ADM 1,BB
ZJN DTD1 IF EOI
RJM IBA INCREMENT BUFFER ADDRESSES
MJN DTD0 IF BUFFER NOT FULL
DTD1 RJM SDP SWAP DISK PARAMETERS
DTD2 LDI BB
ADM 1,BB
ZJP DTD4 IF EOI SECTOR
SOD LF+1 DECREMENT LENGTH
PJN DTD3 IF NO UNDERFLOW
AOD LF+1
SOD LF
MJP DTD7 IF LENGTH ERROR
DTD3 RJM WNS WRITE NEXT SECTOR
RJM IBA INCREMENT BUFFER ADDRESSES
MJN DTD2 IF STILL ANOTHER SECTOR IN BUFFER
RJM SDP SWAP DISK PARAMETERS
SETMS READSTR,NS
RJM PDV PROCESS DEVICE STATUS
LJM DTD0 LOOP
* EOI SECTOR ENCOUNTERED.
DTD4 LDD LF CHECK FILE LENGTH
ADD LF+1
ZJN DTD8 IF NO LENGTH ERROR
LDD CC
LMN CCGT
ZJN DTD7 IF *GET*
LMN CCOD&CCGT
ZJN DTD7 IF *OLD*
LMN CCUG&CCOD
ZJN DTD7 IF *UGET*
* IF EOI ENCOUNTERED ON *SAVE*/*REPLACE*/*APPEND* BEFORE
* FILE LENGTH EXHAUSTED, FILL TO END OF FILE WITH EOF-S.
DTD5 SOD LF+1 DECREMENT LENGTH
PJN DTD6 IF STILL MORE SECTORS
AOD LF+1
SOD LF
MJN DTD7 IF END OF SPACE
DTD6 RJM WNS WRITE EOF
UJN DTD5 CHECK IF MORE EOF-S NEEDED
DTD7 LJM PLE PROCESS LENGTH ERROR
DTD8 RJM WES WRITE EOI SECTOR
LDD FA
ZJN DTD9 IF NOT FST
NFA FA,R
ADN FSTL
CWD FS
DTD9 LDC 0
DTDA EQU *-1 (TRANSFER ERROR FLAG)
ZJN DTD10 IF NO TRANSFER ERRORS
LDM SDAA SET SOURCE EST ORDINAL
ERROR DTE,CH *DATA TRANSFER ERROR.*
DTD10 LDM IAIF CHECK FOR INDIRECT ALLOCATION INTERLOCK
ZJN DTD11 IF INDIRECT ALLOCATION INTERLOCK NOT SET
LDD EQ CLEAR INTERLOCK (SET CHECKPOINT BIT)
ADC 4000
STD CM+1
LDM DVLW
STD CM+2
LDN CTIS
STD CM+3
MONITOR STBM
* LDN 0 CLEAR INDIRECT ALLOCATION INTERLOCK FLAG
STM IAIF
DTD11 EXECUTE 3PU TERMINATE PROGRAM
TITLE SUBROUTINES.
DPC SPACE 4,10
** DPC - DECREMENT PRU COUNTER.
*
* ENTRY (DPCA) PRESET FOR SRU ACCUMULATION OPTION.
* .EQ. 0 TO ACCUMULATE SRUS.
* .NE. 0 TO NOT ACCUMULATE SRUS.
*
* EXIT (IAPF) UPDATED IF SPECIFIED NUMBER OF PRUS TRANSFERRED
* AND SRU ACCUMULATION OPTION ON.
DPC SUBR ENTRY/EXIT
SOM DPCB DECREMENT PRUS TRANSFERRED
NJN DPCX IF INCREMENT NOT EXHAUSTED
DPCA LDN 0 CHECK SRU ACCUMULATION OPTION
* LDN 1 (NO SRU ACCUMULATION)
NJN DPCX IF NO SRU ACCUMULATION
LDN IPPR INCREMENT SRUS FOR TRANSFER
RAM AIPF+1
SHN -14
RAM AIPF
LDN IPPN RESET PRU TRANSFER INCREMENT
STM DPCB
UJN DPCX RETURN
DPCB CON IPPN PRU TRANSFER INCREMENT
IBA SPACE 4,10
** IBA - INCREMENT BUFFER ADDRESS.
*
* EXIT (A) .LT. 0, IF BUFFER NOT FULL.
IBA2 LDC 502 FULL BUFFER NEEDED FOR WRITE ERROR
RAD BB
LCN 1
IBA SUBR ENTRY/EXIT
LDD BB
LMM SDPA
ZJN IBA2 IF FIRST SECTOR IN BUFFER
LDI BB
ZJN IBA1 IF EOF
LDM 1,BB GET LENGTH
SHN 2
ADM 1,BB
IBA1 ADN 2
RAD BB
ADC -BFMS
UJN IBAX RETURN
PLE SPACE 4,10
** PLE - PROCESS LENGTH ERROR.
*
* CALLS WES.
*
* MACROS ERROR.
PLE BSS 0 ENTRY
RJM WES WRITE EOI SECTOR
LDM PLEA
NJN PLE1 IF LENGTH ERROR DUE TO HARDWARE FAILURE
LDM SDAA SET SOURCE EST ORDINAL
ERROR FLE,CH,,,,EI *EQXXX,DNYY, FILE LENGTH ERROR.*
PLE1 LDM SDAA SET SOURCE EST ORDINAL
ERROR FLE,CH *EQXXX,DNYY, FILE LENGTH ERROR.*
PLEA CON 0 LINKAGE ERROR DUE TO HARDWARE FAILURE
PTE SPACE 4,10
** PTE - PROCESS TRANSFER ERROR.
*
* ENTRY READ ERROR DETECTED BY *COMPRNS*.
*
* EXIT (DTDA) .NE. 0 IF DATA TRANSFER ERROR OCCURRED.
* (PLEA) .NE. 0 IF LINKAGE ERROR OCCURRED.
*
* CALLS PES.
PTE SUBR ENTRY/EXIT
RJM PES PROCESS ERROR STATUS
LDM RDCT CHECK TYPE OF ERROR
SHN 21-13
PJN PTE1 IF VALID SECTOR READ
AOM PLEA INDICATE LINKAGE ERROR
LDN 0 SET EOI LINKAGE TO TERMINATE TRANSFER
STM 1,BB
STI BB
UJN PTEX RETURN
PTE1 AOM DTDA INDICATE TRANSFER ERROR
UJN PTEX RETURN
SDP SPACE 4,15
** SDP - SWAP DISK PARAMETERS.
*
* ENTRY (SDAA - SDAC) = NEXT DEVICE PARAMETERS.
* (T5 - T7) = CURRENT DEVICE PARAMETERS.
*
* EXIT (T4 - T7) = DISK INFORMATION FOR NEXT DEVICE.
* (BB) = STARTING BUFFER ADDRESS.
* *SETMS* WRITE PERFORMED.
*
* USES T0 - T7.
*
* CALLS PDV.
*
* MACROS ENDMS, SETMS.
SDP SUBR ENTRY/EXIT
ENDMS
LDN T5 SWAP DEVICE PARAMETERS
STD T1
SDP1 LDI T1
STD T0
LDM SDAA-T5,T1
STI T1
LDD T0
STM SDAA-T5,T1
AOD T1
LMN T7+1
NJN SDP1 IF NOT ALL PARAMETERS SWAPPGD
SETMS IO,NS
RJM PDV PROCESS DEVICE STATUS
LDM UERR SET TRANSFER MODE (REWRITE OR NON-REWRITE)
LPC -EPRW
LMM DTMD
STM UERR
LDC BUF SET BUFFER ADDRESS
SDPA EQU *-1
STD BB
STM WDSE SET WRITE ERROR BUFFER ADDRESS
LJM SDPX RETURN
SNS SPACE 4,15
** SNS - SET NEXT SECTOR.
*
* ENTRY (T7) = CURRENT SECTOR.
* (SNSA) PRESET IF ACCUMULATION DESIRED.
*
* EXIT (T3) = NEXT SECTOR/TRACK.
*
* USES T3.
*
* CALLS SNT.
SNS SUBR ENTRY/EXIT
LDD T7 SET NEXT SECTOR
ADN 1
STD T3
LMM SLM
NJN SNSX IF NOT SECTOR LIMIT
* SET NEXT TRACK.
SNSA LDN 0
* LDN 1 (IF PRU ACCUMULATION DESIRED)
ZJN SNS1 IF NO PRU ACCUMULATION
LDM SLM INCREMENT PRU COUNT FOR NEXT TRACK
RAM AIPR+1
SHN -14
RAM AIPR
SNS1 RJM SNT SET NEXT TRACK
STD T3
UJN SNSX RETURN
WES SPACE 4,20
** WES - WRITE EOI SECTOR.
*
* ENTRY (T4) = CHANNEL (RESERVED).
* (T5) = EST ORDINAL.
* (T6) = EOI TRACK.
* (T7) = EOI SECTOR.
* (CC) = COMMAND CODE.
*
* EXIT CHANNEL RELEASED.
* EOI SET IN TRT IF *GET*, *OLD*, OR *UGET* REQUEST.
* TO *WSE* TO PROCESS WRITE ERRORS.
*
* USES CM - CM+4.
*
* CALLS WEI.
*
* MACROS ENDMS, ERROR, MONITOR.
WES SUBR ENTRY/EXIT
LDN 0 CLEAR FST ADDRESS
STD FA
RJM WEI WRITE EOI
MJP WSE IF WRITE ERROR
ENDMS
LDC * RESTORE FST ADDRESS
WESA EQU *-1
STD FA
LDD CC CHECK REQUEST
LMN CCGT
ZJN WES1 IF *GET*
LMN CCOD&CCGT
ZJN WES1 IF *OLD*
LMN CCUG&CCOD
NJN WESX IF NOT *UGET*
WES1 LDD T5 SET EST ORDINAL
STD CM+1
LDD T6 SET TRACK
LPC 3777
STD CM+2
LDD T7 SET SECTOR
STD CM+3
MONITOR DTKM SET EOI IN TRT
UJP WESX RETURN
WEIA BSSZ WCEI*5+2 EOI BUFFER
WNS SPACE 4,15
** WNS - WRITE NEXT SECTOR.
*
* WRITE SECTOR WITH NEW LINKAGE. USES OLD WORD COUNT AND
* EOF FLAGS. SYSTEM SECTORS ARE HANDLED PROPERLY ALSO.
* PRU INCREMENTS AND PF INCREMENTS ARE UPDATED.
*
* ENTRY (BB) = ADDRESS OF SECTOR BUFFER.
*
* EXIT TO *WSE* TO PROCESS WRITE ERRORS.
*
* USES T1, T3 - T7.
*
* CALLS SNT, WDS.
WNS SUBR ENTRY/EXIT
RJM SNS SET NEXT SECTOR
LDI BB
NJN WNS1 IF NOT EOF
* PROCESS EOF.
LDD T3 SET NEXT SECTOR ADDRESS
STM 1,BB
UJN WNS3 WRITE SECTOR
* PROCESS SYSTEM SECTOR.
WNS1 LMC 3777
NJN WNS2 IF NOT SYSTEM SECTOR
LDD T3 SET NEXT SECTOR ADDRESS
STM NSSS-BFMS,BB
UJN WNS3 WRITE SECTOR
* PROCESS DATA SECTOR.
WNS2 LDD T3 SET NEXT SECTOR ADDRESS
STI BB
* WRITE SECTOR.
WNS3 LDD BB
STD T1
RJM IBA INCREMENT BUFFER ADDRESS
SHN -21
ZJN WNS4 IF END OF BUFFER
LDC WCSF&WLSF WRITE CONSECUTIVE SECTOR
WNS4 LMD T1+WLSF WRITE LAST SECTOR
STD BB RESET BUFFER ADDRESS
RJM WDS
MJN WSE IF WRITE ERROR
RJM DPC DECREMENT PRU COUNT
* SET NEXT SECTOR.
LDD T3 SET NEXT SECTOR
STD T7
SHN 21-13
PJN WNS5 IF NOT TRACK POINTER
SHN -21+13 SET NEXT TRACK
STD T6
LDN 0
STD T7
WNS5 LJM WNSX RETURN
WSE SPACE 4,15
** WSE - WRITE MASS STORAGE ERROR PROCESSOR.
*
* ENTRY (PWRF) = *PFM* RESTART FLAGS FOR RECALL.
* (RDCT) = DRIVER STATUS.
* (STAT) = *STNS* BIT SET IF JOB SUSPENSION NOT ALLOWED.
*
* EXIT (PWRF) = *RFRR* FLAG SET IF REQUEST TO BE RETRIED
* DUE TO UNRECOVERABLE WRITE ERROR.
* TO *ERR* TO RETRY REQUEST OR ISSUE ERROR MESSAGE.
*
* MACROS ERROR.
WSE BSS 0 ENTRY
LDM STAT *PFM* STATUS BITS
LPK STNS
NJN WSE3 IF JOB SUSPENSION INHIBITED
LDM RDCT DRIVER STATUS
SHN 21-12
PJN WSE1 IF RECOVERABLE ERROR
LDM PWRF CHECK RESTART FLAGS
LPK RFRR
NJN WSE2 IF REQUEST ALREADY RETRIED
LDK RFRR SET RETRY REQUEST FLAG
RAM PWRF
WSE1 ERROR RTR,CH RETRY REQUEST
WSE2 ERROR MSE,CH,,T5 *EQXXX,DNYY, MASS STORAGE ERROR.*
WSE3 ERROR MSE,CH,,T5,,EI *EQXXX,DNYY, MASS STORAGE ERROR.*
SPACE 4,10
* COMMON DECKS.
*CALL COMPWEI
BUF SPACE 4,10
* BUF - BUFFER USED IN DEVICE TO DEVICE TRANSFER.
BUF BSS 0
.BUFL SET EPFW-BUF
ERRNG .BUFL-5020 NOT ROOM FOR 8 SECTORS IN BUFFER
CES SPACE 4,10
** CES - CREATE EOI SECTOR.
*
* ENTRY (CC) = COMMAND CODE.
* (FA) = FST ADDRESS.
* (FS - FS+4) = FST IMAGE (*GET*/*OLD*/*UGET* REQUEST).
* (SDAA - SDAC) = PARAMETERS FOR 1ST WRITE.
*
* EXIT (WEIA) SET UP WITH EOI DATA.
* (WESA) = FST ADDRESS.
CES2 LDD MA MOVE FST INFORMATION TO EOI BUFFER
CWM SDAA,ON
SBN 1
CES3 CRM WEIA+FSEI,ON
LDD FA SAVE FST ADDRESS
STM WESA
NFA FA,R COPY FILE NAME TO EOI BUFFER
ADK FNTL
CRM WEIA+FNEI,ON
CES SUBR ENTRY/EXIT
LDD CC CHECK REQUEST
LMN CCGT
ZJN CES1 IF *GET* FUNCTION
LMN CCOD&CCGT
ZJN CES1 IF *OLD*
LMN CCUG&CCOD
NJN CES2 IF NOT *UGET*
CES1 LDD MA COPY FST IMAGE TO EOI BUFFER
CWD FS
UJN CES3 READ FST ENTRY
SPACE 4,10
* EQUIVALENCE EXTERNALLY REFERENCED TAGS.
QUAL *
BUF EQU /".O"/BUF
DPCA EQU /".O"/DPCA
DPCB EQU /".O"/DPCB
DTD EQU /".O"/DTD
DTDA EQU /".O"/DTDA
IBA EQU /".O"/IBA
PLE EQU /".O"/PLE
PLEA EQU /".O"/PLEA
PTE EQU /".O"/PTE
SDP EQU /".O"/SDP
SDPA EQU /".O"/SDPA
SNSA EQU /".O"/SNSA
WNS EQU /".O"/WNS
OVERLAY (APPEND - ORIGINAL FILE TRANSFER.),(BUF+5)
SPACE 4,10
** THIS OVERLAY (TOGETHER WITH OVERLAY *3PP*) PERFORMS THE
* DEVICE-TO-DEVICE TRANSFER OF THE ORIGINAL PERMANENT FILE,
* WHEN REQUIRED, FOR THE INDIRECT ACCESS FILE COMMAND
* *APPEND*. ONCE THIS TRANSFER IS COMPLETE, OVERLAY *3PP*
* IS CALLED TO COPY THE LOCAL FILE.
OVL BSS 0 ENTRY
UJN ".Q"X RETURN AFTER LOAD
ADT SPACE 4,15
** ADT - APPEND DISK TRANSFER.
*
* ENTRY (FS - FS+4) = FST ENTRY FOR SYSTEM FILE.
* (PFFN) = BEGINNING TRACK OF READ FILE.
* (PFFN+1) = BEGINNING SECTOR OF READ FILE.
*
* EXIT TO *DTD*.
* TO *PLE* FOR LENGTH ERRORS.
*
* USES BB, P0, P1, T5, T6, T7, CM - CM+4, LF - LF+1.
*
* CALLS CSS, CTI, DTD, IBA, PDV, PLE, RNS, RSS, SDP, STI, WNS.
*
* MACROS ENDMS, ERROR, MONITOR, SETMS.
ADT BSS 0 ENTRY
LDK PTE SET ERROR PROCESSOR ADDRESS FOR *RNS*
STM MSRA
ADT2 LDD BB READ NEXT SECTOR
RJM RNS
LDI BB
ADM 1,BB
ZJN ADT3 IF EOI
RJM IBA INCREMENT BUFFER ADDRESSES
MJN ADT2 IF BUFFER NOT FULL
ADT3 RJM SDP SWAP DISK PARAMETERS
ADT4 LDI BB
ADM 1,BB
ZJN ADT6 IF EOI SECTOR
SOD LF+1 DECREMENT LENGTH
PJN ADT5 IF NO UNDEFLOW
AOD LF+1
SOD LF
PJN ADT5 IF NO LENGTH ERROR
LJM PLE PROCESS LENGTH ERROR
ADT5 RJM WNS WRITE NEXT SECTOR
RJM IBA INCREMENT BUFFER ADDRESS
MJN ADT4 IF STILL ROOM IN BUFFER
RJM SDP SWAP DISK PARAMETERS
SETMS READSTR,NS
RJM PDV PROCESS DEVICE STATUS
LJM ADT2 LOOP
* CHECK FOR DELAYED DELINK REQUEST FOR ORIGINAL FILE.
ADT6 LDM APDK+1
ZJP ADT9 IF NO DELINK REQUESTED
ENDMS
LDD MA COPY DELINK PARAMETERS
CWM APDK,ON
SBN 1
CRD CM
MONITOR DLKM
LDM STAT
LPC STBD+STXC
LMC STBD+STXC
ZJN ADT9 IF EXTENDING CHAIN ON BUFFERED DEVICE
LDD EQ CLEAR INDIRECT ALLOCATION INTERLOCK
STD CM+1
LDM DVLW
STD CM+2
LDN CTIS
STD CM+3
MONITOR STBM
* LDN 0 CLEAR INDIRECT ALLOCATION INTERLOCK FLAG
STM IAIF
* COPY LOCAL FILE TO INDIRECT FILE.
ADT9 SOM DPCA ENABLE SRU ACCUMULATION
LDN IPPN RESET PRU TRANSFER INCREMENT
STM DPCB
LDD FS SET UP LOCAL FILE PARAMETERS
STM SDAA
LDD FS+1
STM SDAB
LDN FSMS
STM SDAC
LDC BUF RESET BUFFER ADDRESS
STM SDPA
RJM SDP SWAP DISK PARAMETERS
SETMS READSTR,NS
RJM PDV PROCESS DEVICE STATUS
LJM DTD ENTER DEVICE TO DEVICE TRANSFER
BUFA SPACE 4,10
* BUFA - BUFFER FOR DEVICE TO DEVICE TRANSFER OF
* EXISTING INDIRECT FILE.
BUFA BSS 0
.BUFAL SET EPFW-BUFA
ERRNG .BUFAL-4316 NOT ROOM FOR 7 SECTORS IN BUFFER
SPACE 4,10
* EQUIVALENCE EXTERNALLY REFERENCED TAGS.
QUAL *
ADT EQU /".O"/ADT
BUFA EQU /".O"/BUFA
OVERLAY (STAGE FILE FROM ALTERNATE STORAGE.)
SPF SPACE 4,15
** THIS OVERLAY INITIATES A STAGE OPERATION FOR A FILE WHICH
* IS NOT CURRENTLY RESIDENT ON DISK, BUT WHICH HAS A VALID
* COPY ON ALTERNATE STORAGE. THIS IS ACCOMPLISHED BY
* ISSUING A *TDAM* REQUEST TO THE APPROPRIATE EXECUTIVE TO
* INITIATE STAGING OF THE FILE. THE JOB IS THEN PLACED IN
* TIMED-EVENT ROLLOUT TO AWAIT COMPLETION OF THE STAGE. THE
* ORIGINAL *PFM* REQUEST WILL BE REISSUED AUTOMATICALLY WHEN
* THE JOB ROLLS IN.
SPF BSS 0 ENTRY
RJM RMD RESET TO MASTER DEVICE
RJM CCC CHECK FOR CARTRIDGE COPY
STD P2 SAVE CARTRIDGE COPY STATUS
RJM CTC CHECK FOR TAPE COPY
STD P3 SAVE TAPE COPY STATUS
RJM UPF UPDATE PFC
* CHECK ERROR STATUS.
LDN 0 INDICATE CARTRIDGE STAGING ATTEMPT
STD P1
LDD P2
ZJN SPF5 IF NO ERROR ON CARTRIDGE COPY
AOD P1 INDICATE TAPE STAGING ATTEMPT
LDD P3
ZJN SPF5 IF NO ERROR ON TAPE COPY
* FILE CANNOT BE STAGED - DETERMINE CORRECT ERROR MESSAGE.
LDD P2 CHECK CARTRIDGE COPY ERROR STATUS
SBN 1
NJN SPF1 IF CARTRIDGE COPY EXISTS
LDD P3 CHECK TAPE COPY ERROR STATUS
SBN 1
NJN SPF1 IF TAPE COPY EXISTS
ERROR AIO,CH,IW * NO ALTERNATE STORAGE COPY EXISTS.*
SPF1 LDD P2 CHECK CARTRIDGE COPY ERROR STATUS
SBN 2
ZJN SPF2 IF STAGING DISABLED ERROR
LDD P3 CHECK TAPE COPY ERROR STATUS
SBN 2
NJN SPF3 IF NOT STAGING DISABLED ERROR
SPF2 ERROR SGD,CH,IW * STAGING DISABLED.*
SPF3 LDD P2 CHECK CARTRIDGE COPY ERROR STATUS
SBN 3
NJN SPF4 IF NOT TEMPORARY ERROR
ERROR TPE,CH,IW *(NAME) TEMPORARY ERROR, TRY LATER.*
SPF4 ERROR PPE,CH,IW *(FILE NAME) PERMANENT ERROR.*
* LOOP *MXRL* TIMES ISSUING *TDAM* REQUESTS TO THE EXECUTIVE.
SPF5 RJM STR SETUP *TDAM* REQUEST
LDC ART SET ROLLOUT TIME LIMIT
STM ERRD
LDN 0 INITIALIZE FOR LOOP
STD P0
* CHECK IF STAGING STILL ENABLED.
SPF6 LDN SSTL CHECK FOR STAGING DISABLED
CRD CM
LDD P1
NJN SPF8 IF TAPE STAGING REQUEST
LDD CM
SHN 21-6
PJN SPF9 IF CARTRIDGE STAGING ENABLED
SPF7 ERROR SGD,CH,IW *STAGING DISABLED.*
SPF7.1 LDD CM+1 CHECK FOR *ACS TAPE PF STAGING* ENABLED
SHN 21-11
UJN SPF8.1 CHECK IF ENABLED
SPF8 LDM FCTF,CI
SHN 21-TFACS
MJN SPF7.1 IF FILE ON ACS CARTRIDGE TAPE
LDD CM+1 CHECK FOR *TAPE PF STAGING* ENABLED
SHN 21-7
SPF8.1 MJN SPF7 IF STAGING DISABLED
* ISSUE *TDAM* REQUEST.
SPF9 LDN 1 SET WRITE FUNCTION
STD CM+1
SPFA LDC MTSI SET *MAGNET* SUBSYSTEM ID
* LDC MFSI (SET *MSS* SUBSYSTEM ID)
* LDC AFSI (SET *MSE* SUBSYSTEM ID)
STD CM+2
LDC 6*100 SET MESSAGE LENGTH
STD CM+3
SPFB LDC /MTX/PFTB SET ADDRESS OF *MAGNET* *TDAM* BUFFER
* LDC MIRE SET ADDRESS OF *MSS*/MSE* *TDAM* BUFFER
STD CM+4
MONITOR TDAM ISSUE *TDAM* REQUEST
LJM SPFC,CM+1 PROCESS ACCORDING TO *TDAM* REQUEST STATUS
SPFC BSS 0 *TDAM* STATUS PROCESSOR TABLE
UJN SPF10 (ST=0) *TDAM* REQUEST ACCEPTED
UJN SPF12 (ST=1) STORAGE MOVE IN PROGRESS
UJN SPF13 (ST=2) NOT READY FOR DATA
UJN SPF12 (ST=3) REJECT (NONZERO FIRST WORD)
UJN SPF13 (ST=4) INACTIVE
* PROCESS THE (ST=0) NORMAL STATUS CASE OF ACCEPTED REQUEST.
SPF10 RJM ISM ISSUE REQUEST STAGE MESSAGE
LDD CC
LMN CCSP
ZJN SPF11 IF *STAGEPF* REQUEST
EXIT PSI,CH,IW,,EC2 *(PFN) STAGE INITIATED.*
SPF11 EXECUTE 3PU TERMINATE *PFM* WITH NO ERROR STATUS
* PROCESS THE (ST=1)/(ST=3) STATUS CASES.
SPF12 AOD P0 TRY *TDAM* *MXRL* TIMES
SBN MXRL
ZJN SPF13 IF TIME TO GIVE UP
PAUSE NE
LDC 370001+SBNI DELAY
NJN *-1 IF DELAY NOT EXHAUSTED
UJP SPF6 CONTINUE REQUEST LOOP
* PROCESS THE (ST=2)/(ST=4) STATUS CASES.
SPF13 LDN 0 SET EST ORDINAL FOR EVENT
STM ERRE
SPFD LDC MTXE SET WAITING FOR *MAGNET* EVENT
* LDC MSXE (SET WAITING FOR *MSS* EVENT)
* LDC ASXE (SET WAITING FOR *MSE* EVENT)
STM ERRC
EXIT PWE,CH,IW,,EC1 *(PFN) WAITING FOR SUBSYSTEM.*
TITLE SUBROUTINES.
CCC SPACE 4,20
*** CCC - CHECK FOR CARTRIDGE ALTERNATE STORAGE COPY OF FILE.
*
* ENTRY (CI) = ADDRESS OF PFC ENTRY IN BUFFER.
*
* EXIT (A) = 0 IF CARTRIDGE COPY AVAILABLE.
* = 1 IF NO CARTRIDGE COPY EXISTS.
* = 2 IF COPY EXISTS BUT CARTRIDGE STAGING DISABLED.
* = 3 IF COPY EXISTS BUT TEMPORARY ERROR FLAG SET.
* = 4 IF COPY EXISTS BUT PERMANENT ERROR FLAG SET.
* *AFTMP* ERROR FLAG CLEARED IN PFC, IF PRESENT.
*
* USES CM - CM+4.
CCC4 LDN 1 SET *NO CARTRIDGE COPY EXISTS* STATUS
CCC SUBR ENTRY/EXIT
LDM FCAA,CI
ADM FCAA+1,CI
ADM FCAA+2,CI
ZJN CCC4 IF NO CARTRIDGE ALTERNATE STORAGE COPY
LDM FCAF,CI
LPK AFOBSM
NJN CCC4 IF CARTRIDGE COPY OBSOLETE
LDK SSTL CHECK IF CARTRIDGE STAGING ENABLED
CRD CM
LDD CM
SHN 21-6
PJN CCC2 IF CARTRIDGE PF STAGING ENABLED
LDN 2 SET *STAGING DISABLED* STATUS
CCC1 UJN CCCX RETURN
* CLEAR CARTRIDGE TEMPORARY ERROR FLAG, IF PRESENT.
CCC2 LDD CC
LMN CCSP
ZJN CCC3 IF *STAGEPF* REQUEST
LDM FCAF,CI
LPN AFTMPM
ZJN CCC3 IF NO TEMPORARY ERROR
LMM FCAF,CI CLEAR TEMPORARY ERROR FLAG
STM FCAF,CI
LDN 3 SET *TEMPORARY ERROR FLAG* STATUS
UJN CCC1 RETURN
CCC3 LDM FCAF,CI CHECK FOR CARTRIDGE ERROR FLAGS
LPN AFPSEM+AFPDEM
ZJN CCC1 IF NO PERMANENT ERRORS, RETURN *AVAILABLE*
LDN 4 SET *PERMANENT ERROR FLAG* STATUS
UJN CCC1 RETURN
CTC SPACE 4,15
** CTC - CHECK FOR TAPE ALTERNATE STORAGE COPY OF FILE.
*
* ENTRY (CI) = ADDRESS OF PFC ENTRY IN BUFFER.
*
* EXIT (A) = 0 IF TAPE COPY AVAILABLE.
* = 1 IF NO TAPE COPY EXISTS.
* = 2 IF COPY EXISTS BUT TAPE STAGING DISABLED.
* = 3 IF COPY EXISTS BUT *VSN MISSING* FLAG SET.
* = 4 IF COPY EXISTS BUT *DATA ERROR* FLAG SET.
*
* USES T1, CM - CM+4.
*
* CALLS STT.
CTC6 LDN 1 SET *NO COPY EXISTS* STATUS
CTC SUBR ENTRY/EXIT
LDM FCTV,CI
ADM FCTV+1,CI
ZJN CTC6 IF NO TAPE ALTERNATE STORAGE COPY OF FILE
LDK SSTL CHECK IF TAPE STAGING IS ENABLED
CRD CM
LDM FCTF,CI
STD T1 SAVE (FCTF)
SHN 21-TFACS
MJN CTC0.1 IF FILE ON ACS CARTRIDGE TAPE
LDD CM+1 CHECK FOR *TAPE PF STAGING* ENABLED
SHN 21-7
PJN CTC1 IF TAPE STAGING IS ENABLED
CTC0 LDN 2 SET *STAGING DISABLED* STATUS
UJN CTCX RETURN
CTC0.1 LDD CM+1 CHECK FOR *ACS TAPE PF STAGING* ENABLED
SHN 21-11
MJN CTC0 IF ACS TAPE STAGING IS DISABLED
CTC1 LDD T1
LPK TFPVNM+TFEPVM
ZJN CTC5 IF NO ERRORS ON PRIMARY VSN
LDD T1
LPK TFSVSM
NJN CTC4 IF SECONDARY VSN EXISTS
CTC2 LDD T1
LPK TFPVNM
ZJN CTC3 IF PRIMARY VSN AVAILABLE
LDN 3 SET *VSN NOT AVAILABLE* STATUS
UJN CTC5.1 RETURN
CTC3 LDN 4 SET *DATA ERROR* STATUS
UJN CTC5.1 RETURN
CTC4 LDD T1
LPK TFSVNM+TFESVM
ZJN CTC5 IF NO ERRORS ON SECONDARY VSN
LPK TFSVNM
NJN CTC2 IF SECONDARY VSN NOT AVAILABLE
UJN CTC3 SET *DATA ERROR* STATUS
CTC5 LDN 0 SET *COPY AVAILABLE* STATUS
CTC5.1 LJM CTCX RETURN
GEE SPACE 4,15
** GEE - GET EST ORDINAL FOR EVENT.
*
* ENTRY (P1) .NE. 0 IF TAPE STAGE REQUEST.
* (GEEA) PRESET WITH CORRECT EQUIPMENT MNEMONIC.
*
* EXIT (T5) = EST ORDINAL FOR EVENT.
* FOR *MSS* STAGE, ORDINAL OF FIRST *CS* EST.
* FOR *MSE* STAGE, ORDINAL OF FIRST *SS* EST.
* FOR TAPE STAGE, ORDINAL OF FIRST *MT*/*NT* EST.
*
* USES T5, T6, T0 - T0+4.
*
* MACROS ERROR, SFA.
GEE SUBR ENTRY/EXIT
* INITIALIZE FOR EST SEARCH.
LDN ESTP CALCULATE NUMBER OF EST ENTRIES
CRD T0
LDN NOPE INITIALIZE EST ORDINAL FOR SEARCH
STD T5
LDD T0+2 SAVE LAST EST ORDINAL + 1
STD T6
* SEARCH FOR ALTERNATE STORAGE EQUIPMENT.
GEE1 SFA EST,T5 READ EST ENTRY
ADK EQDE
CRD T0
LDD T0+3 CHECK EQUIPMENT MNEMONIC
GEEA LMC 2RMT EQUIPMENT MNEMONIC FOR TAPE STAGE
* LMC 2RCS (EQUIPMENT MNEMONIC FOR *MSS* STAGE)
* LMC 2RSS (EQUIPMENT MNEMONIC FOR *MSE* STAGE)
ZJN GEEX IF CORRECT EQUIPMENT MNEMONIC
LDD P1
ZJN GEE2 IF NOT TAPE STAGE REQUEST
LDD T0+3 CHECK EQUIPMENT MNEMONIC AGAIN
LMC 2RNT OTHER EQUIPMENT MNEMONIC FOR TAPE STAGE
ZJN GEEX IF CORRECT EQUIPMENT MNEMONIC
GEE2 AOD T5 ADVANCE EST ORDINAL
LMD T6
NJN GEE1 IF NOT END OF EST
ERROR PFN,CH,IW *DEVICE UNAVAILABLE.*
ISM SPACE 4,15
** ISM - ISSUE REQUEST STAGE MESSAGE.
*
* ISSUES AN *STRS* ACCOUNT FILE MESSAGE TO INDICATE THAT THE
* REQUEST FOR STAGE WAS SENT TO *MAGNET*.
*
* ENTRY (CI) = CATALOG INDEX POINTER TO CATALOG ENTRY.
* (P1) .NE. 0 IF TAPE STAGE REQUEST.
* (MSTA) = MST ADDRESS/10.
*
* EXIT ACCOUNT FILE MESSAGE ISSUED.
*
* USES T1, CM - CM+4.
*
* CALLS ACS, C2D, DFM.
ISM SUBR ENTRY/EXIT
LDD P1
ISME ZJN ISMX IF NOT TAPE PF STAGE REQUEST
* PSN (IF OPTICAL DISK REQUEST)
LDC ISMB+3 INITIALIZE POINTER FOR *ACS* CALLS
STD T1
* SET FILENAME INTO MESSAGE.
LDD CI SET ADDRESS OF CATALOG ENTRY
RAM ISMA+1
LDD MA
ISMA CWM FCFN,ON PFN AND UI
SBN 1 READ PFN
CRD CM
LDD CM+3
SCN 77
STD CM+3 CLEAR UI BITS FROM PFN
LDN CM INSERT FILE NAME IN BUFFER
RJM ACS
LDC ISMC APPEND COMMA
RJM ACS
* CONVERT USER INDEX TO DISPLAY CODE.
LDD MA READ UI
CRD CM
LDD CM+3
RJM C2D CONVERT 2 OCTAL DIGITS TO DISPLAY CODE
STD CM
LDD CM+4
SHN -6
RJM C2D CONVERT 2 OCTAL DIGITS TO DISPLAY CODE
STD CM+1
LDD CM+4
RJM C2D CONVERT 2 OCTAL DIGITS TO DISPLAY CODE
STD CM+2
* SUPPRESS LEADING ZEROS ON USER INDEX.
LDN 0 TERMINATE STRING BUFFER
STD CM+3
STD CM+4 CLEAR STARTING BYTE OFFSET
ISM1 LDM CM,CM+4
ADC -2R00
STD T0
SCN 77
NJN ISM3 IF UPPER DIGIT IS NON-ZERO
LDD T0
LPN 77
NJN ISM2 IF LOWER DIGIT IS NON-ZERO
AOD CM+4 INCREMENT OFFSET
SBN 3
MJN ISM1 IF ALL BYTES NOT EXAMINED
SOD CM+4 CORRECT OFFSET
* SET USER INDEX INTO MESSAGE.
ISM2 LDM CM,CM+4 LOWER DIGIT OF BYTE IS FIRST DIGIT
SHN 6
SCN 77
STM CM,CM+4
LDN CM
ADD CM+4
RJM ACS APPEND CHARACTERS TO STRING
AOD CM+4
SBN 3
PJN ISM4 IF LAST BYTE WAS SENT
ISM3 LDN CM
ADD CM+4
RJM ACS APPEND CHARACTERS TO STRING
ISM4 LDC ISMC APPEND COMMA
RJM ACS
* SET FAMILY/PACK NAME INTO MESSAGE.
LDM MSTA READ FAMILY/PACK NAME
SHN 3
ADN PFGL
CRD CM
LDD CM+3 CLEAR RESERVED FIELD
SCN 77
STD CM+3
LDN CM INSERT FAMILY IN BUFFER
RJM ACS
LDC ISMD APPEND TERMINATOR
RJM ACS
* ISSUE MESSAGE.
LDC ISMB+ACFN ISSUE MESSAGE TO ACCOUNT FILE
RJM DFM
LJM ISMX RETURN
ISMB DATA C*STRS, * ACCOUNT FILE MESSAGE BUFFER
BSSZ 14D
ISMC DATA 2H, MESSAGE SEPARATOR
CON 0 END OF STRING
ISMD DATA 2H. MESSAGE TERMINATOR
CON 0 END OF STRING
STR SPACE 4,25
** STR - SETUP *TDAM* REQUEST.
*
* ENTRY (CB) = CATALOG BUFFER.
* (CB-1) = CATALOG SECTOR.
* (CB-2) = CATALOG TRACK.
* (CI) = CATALOG INDEX POINTER TO CATALOG ENTRY.
* (EQ) = MASTER DEVICE EST ORDINAL.
* (FN - FN+4) = FILE NAME.
* (MSEQ) = ALTERNATE STORAGE EST ORDINAL.
* (MSTA) = MST ADDRESS/10.
* (PFPN - PFPN+4) = PERMANENT FILE CONTROL WORD.
* (PFUI - PFUI+1) = USER INDEX.
* (P1) .NE. 0 IF TAPE STAGE REQUEST.
* (UI - UI+1) = USER INDEX.
*
* EXIT MESSAGE BUFFER SETUP FOR *TDAM* REQUEST.
* (ERRE), (ERRC) SET WITH EVENT TO ROLL JOB OUT WITH.
* (SPFA), (SPFD) SET WITH SUBSYSTEM ID, EVENT.
* (SPFB) SET WITH SUBSYSTEM *TDAM* BUFFER ADDRESS.
*
* USES CM - CM+4, FN - FN+4, T0 - T0+4.
*
* CALLS GEE.
STR SUBR ENTRY/EXIT
* SET FILE ACCESS LEVEL AND FUNCTION CODE.
LDM FCAL,CI SET FILE ACCESS LEVEL
LPN 7
SHN 3
LMD HN SET FUNCTION CODE = 1 (TAPE/*MSS*/*MSE*)
STD CM
LDN 0
STD CM+1
LDD P1
NJP STR1.2 IF TAPE STAGE REQUEST
LDM FCAT,CI GET ALTERNATE STORAGE TYPE
LPN 77B
STD T1
SBN ATOD
NJN STR1 IF NOT OPTICAL STORAGE
LDD HN SET FUNCTION CODE = 2 (OPTICAL DISK)
RAD CM
ISTORE ISME,(PSN) SET *ISM* TO ISSUE OPTICAL STAGE MESSAGE
LDC 2RSO
STM ISMB
UJN STR1.1 SET SUBSYSTEM INFORMATION
STR1 LDC MIRE SET *MSS*/*MSE* *TDAM* BUFFER ADDRESS
STM SPFB+1
ERRPL MIRE-10000B CODE DEPENDS ON VALUE
* SET SUBSYSTEM ID AND SUBSYSTEM EVENT.
STR1.1 LDM STRC,T1 SET ALTERNATE STORAGE SUBSYSTEM ID
STM SPFA+1
LDM STRD,T1 SET ALTERNATE STORAGE SUBSYSTEM EVENT
STM SPFD+1
LDM STRE,T1 SET ALTERNATE STORAGE EQUIPMENT TYPE
STM GEEA+1
* SET *PEO* AND *DN*.
STR1.2 LDD CI OFFSET INTO CATALOG SECTOR
SBD CB
SBN 2
SHN -NWCES CALCULATE *PEO* VALUE
LPN 1S"NWCEM"-1
SHN 6 POSITION FOR *TDAM* REQUEST
STD CM+2
LDM MSTA GET DEVICE NUMBER
SHN 3
ADN PFGL
CRD T0
LDD T0+3
LPN 77
RAD CM+2 COMBINE *PEO* WITH *DN*
* SET FLAGS FOR CARTRIDGE OR OPTICAL STAGE.
LDD P1
NJN STR2 IF TAPE STAGE REQUEST
LDM FCAF,CI GET ALTERNATE STORAGE FLAGS
LPC AFPDRM+AFVERM+AFFREM
SHN 13-6 COMBINE WITH PEO AND DN
RAD CM+2
* SET CATALOG TRACK AND SECTOR.
STR2 LDM -2,CB SET CATALOG TRACK ADDRESS
STD CM+3
LDM -1,CB SET CATALOG SECTOR ADDRESS
STD CM+4
LDD MA TDAM+0 INTO MESSAGE BUFFER
CWD CM
* SET *AT* AND *ASA* FOR CARTRIDGE OR OPTICAL DISK STAGE.
LDD P1
NJN STR3 IF TAPE STAGE REQUEST
LDN 0 CLEAR RESERVED FIELD
STD CM
LDM FCAT,CI SET ALTERNATE STORAGE TYPE
LPN 77
STD CM+1
LDM FCAA,CI SET ALTERNATE STORAGE ADDRESS (ASA)
STD CM+2
LDM FCAA+1,CI
STD CM+3
LDM FCAA+2,CI
STD CM+4
LDD MA TDAM+1 INTO MESSAGE BUFFER
ADN 1
CWD CM
UJN STR4 PROCESS NEXT WORD
* SET FLAGS, FILE SEQUENCE NUMBER AND VSN FOR TAPE STAGE.
STR3 LDD CI SET ADDRESS OF CATALOG ENTRY
RAM STRA+1
LDD MA TDAM+1 INTO MESSAGE BUFFER
ADN 1
STRA CWM FCTF,ON
* SET PERMANENT FILE NAME AND USER INDEX.
STR4 LDD CI SET ADDRESS OF CATALOG ENTRY
RAM STRB+1
LDD MA TDAM+2 INTO MESSAGE BUFFER
ADN 2
STRB CWM FCFN,ON
* SET JSN.
LDD CP FETCH EJT ORDINAL
ADN TFSW
CRD CM
SFA EJT,CM READ JOB SEQUENCE NUMBER
ADK JSNE
CRD CM
LDN 0
STD CM+2
* SET EVENT FOR CARTRIDGE STAGE.
RJM GEE GET EST ORDINAL FOR EVENT
LDD T5
STD CM+3
STM ERRE
LDD P1
NJN STR5 IF TAPE STAGE REQUEST
LDM FCAA,CI SET FOLDED ASA IN EVENT
LMM FCAA+1,CI
LMM FCAA+2,CI
UJN STR6 SET EVENT
* SET EVENT FOR TAPE STAGE.
STR5 LDM -2,CB FOLD CATALOG TRACK AND SECTOR FOR EVENT
SHN 6
LMM -1,CB
STR6 STD CM+4 SET EVENT
STM ERRC
LDD MA TDAM+3 INTO MESSAGE BUFFER
ADN 3
CWD CM
* SET FAMILY/PACK NAME AND MASTER DEVICE EST ORDINAL.
LDD P1
NJN STR7 IF TAPE STAGE REQUEST
LDC LDNI+0 PREVENT EST ORDINAL STORE
STM STRF
STR7 LDM MSTA READ FAMILY/PACK NAME
SHN 3
ADN PFGL
CRD CM
LDD CM+3 CLEAR RESERVED FIELD
SCN 77
STD CM+3
STRF LDD EQ SET MASTER DEVICE EST ORDINAL
* LDN 0 (CARTRIDGE STAGE REQUEST)
STD CM+4
LDD MA TDAM+4 INTO MESSAGE BUFFER
ADN 4
CWD CM
* SET FILE LENGTH AND CREATION DATE/TIME.
LDM FCLF,CI SET FILE LENGTH
STD CM
LDM FCLF+1,CI
STD CM+1
LDM FCBS,CI GET IAPF/DAPF INDICATOR FROM SECTOR FIELD
LPC 4000B
LMC 4000B
RAD CM SET TDAM BLOCK *I* FIELD IF IAPF
LDM FCCD,CI TRANSFER CREATION DATE AND TIME FOR TDAM
STD CM+2
LDM FCCD+1,CI
STD CM+3
LDM FCCD+2,CI
STD CM+4
LDD MA TDAM+5 INTO MESSAGE BUFFER
ADN 5
CWD CM
LJM STRX RETURN
STRC INDEX ALTERNATE STORAGE SUBSYSTEM ID-S
INDEX ATMS,MFSI *MSS*
INDEX ATAS,ASSI *MSE*
INDEX ATOD,MTSI *MAGNET*
INDEX ATMAX+1
STRD INDEX ALTERNATE STORAGE EXECUTIVE EVENTS
INDEX ATMS,MSXE *MSS*
INDEX ATAS,ASXE *MSE*
INDEX ATOD,MTXE *MAGNET*
INDEX ATMAX+1
STRE INDEX ALTERNATE STORAGE EQUIPMENT MNEMONICS
INDEX ATMS,2RCS *MSS*
INDEX ATAS,2RSS *MSE*
INDEX ATOD,2ROD *MAGNET* - OPTICAL DISK
INDEX ATMAX+1
UPF SPACE 4,25
** UPF - UPDATE PFC ON USER ACCESS.
*
* ON A USER ACCESS WITH NO ERRORS, UPDATE THE LAST ACCESS
* DATE AND TIME IN THE PFC TO PREVENT THE IMMEDIATE RELEASE
* OF THE FILE BEFORE IT CAN BE ACCESSED. IF ERRORS WERE
* DETECTED, ONLY UPDATE THE PFC TO CLEAR *AFTPE* (IF PRESENT).
*
* ENTRY (CB) = CATALOG BUFFER ADDRESS.
* (CC) = COMMAND CODE.
* (CI) = ADDRESS OF PFC ENTRY IN BUFFER.
* (P2) = CARTRIDGE COPY ERROR STATUS.
* (P3) = TAPE COPY ERROR STATUS.
*
* EXIT LAST ACCESS DATE AND TIME UPDATED IN THE PFC.
* *ENDMS* PERFORMED.
* CATALOG INTERLOCK CLEARED.
*
* USES CM - CM+4.
*
* CALLS CCI, WBI.
*
* MACROS ENDMS.
UPF SUBR ENTRY/EXIT
LDD CC
LMN CCSP
ZJN UPFX IF *STAGEPF* REQUEST
LDD P3
ZJN UPF1 IF NO TAPE COPY ERRORS
LDD P2
ZJN UPF1 IF NO CARTRIDGE COPY ERRORS
SBN 3
ZJN UPF2 IF TEMPORARY ERROR ON CARTRIDGE COPY
UJN UPF3 CLEAR INTERLOCK AND RETURN
UPF1 LDN PDTL UPDATE LAST ACCESS DATE AND TIME
CRD CM
LDD CM+2
STM FCAD,CI
LDD CM+3
STM FCAD+1,CI
LDD CM+4
STM FCAD+2,CI
UPF2 LDD CB REWRITE CATALOG
RJM WBI
UPF3 ENDMS
RJM CCI CLEAR CATALOG INTERLOCK
UJN UPFX RETURN
SPACE 4,10
* COMMON DECKS.
*CALL COMPACS
*CALL COMPC2D
EJT$ EQU 0 DEFINE *COMPGFP* ACCESS TO EJT
*CALL COMPGFP
SPACE 4,10
* CHECK FOR OVERFLOW.
OVERFLOW OVLC,BUF1-2 OVERFLOW INTO CATALOG BUFFER
OVERLAY (CPU FILE TRANSFER.),OVLU
SPACE 4,10
*** THIS OVERLAY PROCESSES THE TRANSFER OF INDIRECT ACCESS
* FILES VIA THE CPU.
OVL BSS 0 ENTRY
LDD CC CHECK COMMAND CODE
LMK CCRS
ZJN OVL1 IF *RPFSTAT* REQUEST
RJM SCP SET UP CPU PARAMETERS
RJM SCF SET UP COMMUNICATION FILES
RJM PWS PREWRITE SYSTEM SECTOR AND EOI
OVL1 RJM IDR INITIATE *DMP=* AND SET UP RECALL REQUEST
EXECUTE 3PU RECALL *PFM*
TITLE SUBROUTINES.
IDR SPACE 4,20
** IDR - INITIATE *DMP=* AND SET UP *PFM* RECALL REQUEST.
*
* ENTRY (CC) = COMMAND CODE.
* (EQ) = MASTER EST ORDINAL.
* (CPFB) = *CPUPFM* CALL BLOCK IF NOT *RPFSTAT*
* REQUEST.
* (PWRF) = *PFM* RESTART FLAGS FOR RECALL.
*
* EXIT (CN - CN+4) = INPUT REGISTER FOR *PFM* RECALL.
* (FN - FN+4) = RECALL REQUEST FOR MONITOR.
* (MP - MP+4) = PARAMETER WORD FOR *PFM* RECALL.
* (STAU) = *STRP* BIT SET TO RECALL *PFM*.
* *DMP=* ROLLOUT INITIATED, IF NO TAPE ACTIVITY PENDING.
*
* USES T1, CM - CM+4.
*
* MACROS MONITOR.
IDR SUBR ENTRY/EXIT
* INITIATE *DMP=*.
LDD CC CHECK COMMAND CODE
LMK CCRS
NJN IDR1 IF NOT *RPFSTAT* REQUEST
LDM PWCC RESET ORIGINAL COMMAND CODE
STD CC
UJN IDR2 SET ORIGINAL CODE FOR *DMP=* CALL
IDR1 LDN CPFBL WRITE *CPUPFM* PARAMETER BLOCK TO NFL
STD T1
NFA DMPN
CWM CPFB,T1
LDD CC SET COMMAND CODE FOR *DMP=* CALL
IDR2 STM IDRA+4
LDD CP CHECK CONTROL POINT ACTIVITY
ADK STSW
CRD CM
LDD CM+4
SHN -4
LPN 17
NJN IDR3 IF TAPE ACTIVITY PENDING
LDD CP SET *DMP=* CALL
ADK SPCW
CWM IDRA,ON
LDN SAPS SET *CPUPFM* ACTIVE STATUS
STD CM+1
MONITOR SJCM
LDN ZERL START *DMP=* ROLLOUT
CRD CM
LDK ROSR
STD CM+1
MONITOR ROCM
* SET UP *PFM* RECALL REQUEST.
IDR3 LDD IA SET INPUT REGISTER
CRD CN
LDN ZERL
CRD FN SET RECALL REQUEST
CRD MP SET PARAMETER WORD
LDM PWRF RESTART FLAGS
STD MP
LDD CC ORIGINAL COMMAND CODE
STD MP+2
LDD EQ MASTER EST ORDINAL
STD MP+3
LDD CN+2 SET UP *CCRS* REQUEST IN RECALL STACK
SCN 77
LMN CCRS
STD CN+2
LDC PTMF TIMED RECALL
STD FN+1
LDC 200D RECALL FOR 200D MILLISECONDS
STD FN+4
LDK STRP SET *RECALL PFM* STATUS BIT
RAM STAU
LJM IDRX RETURN
IDRA VFD 18/3LCPF,6/30B,18/0,18/0 *CPUPFM* CALL WORD
PWS SPACE 4,15
** PWS - PREWRITE SYSTEM SECTOR AND EOI.
*
* ENTRY (EQ) = MASTER DEVICE EST ORDINAL.
* (FNTB) = FNT ADDRESS OF PERMANENT FILE.
* (LF - LF+1) = LENGTH OF PERMANENT FILE.
* (MSTA) = MASTER DEVICE MST ADDRESS/10.
* (PFCB) = BUFFER CONTAINING COPY OF PFC.
* (SDAB) = FIRST TRACK OF PERMANENT FILE.
* (SDAC) = FIRST SECTOR OF PERMANENT FILE.
*
* EXIT TO *HNG* IF INDIRECT CHAIN TRUNCATED.
*
* USES FA, T1, FS - FS+4, RI - RI+1.
*
* CALLS CRA, PDV, WEI, WSS.
*
* MACROS ENDMS, ERROR, MONITOR, SETMS.
PWS SUBR ENTRY/EXIT
LDD CC
LMN CCGT
ZJN PWSX IF *GET*
LMN CCOD&CCGT
ZJN PWSX IF *OLD*
LDD EQ SET SYSTEM SECTOR ADDRESS
STD T5
LDM SDAB
STD T6
LDM SDAC
STD T7
LDM FNTB READ FST
STD FA
NFA FA,R
ADK FSTL
CRD FS
* INITIALIZE BUFFER FOR SYSTEM SECTOR AND EOI.
LDC 502-1 CLEAR BUFFER
STD T1
PWS2 LDN 0 CLEAR NEXT BYTE
STM BFMS,T1
SOD T1
PJN PWS2 IF MORE TO CLEAR
LDC 5*NWCE-1 COPY PFC TO BUFFER
STD T1
PWS3 LDM PFCB,T1 COPY NEXT BYTE
STM CTSS,T1
SOD T1
PJN PWS3 IF MORE TO COPY
LDM STAT
LPK STEC
ZJN PWS4 IF NOT APPEND TO END OF CHAIN
LDN PSNI ALLOW FOR LACK OF SYSTEM SECTOR
STM PWSA
UJN PWS6 SKIP SYSTEM SECTOR WRITE
* WRITE SYSTEM SECTOR.
PWS4 SETMS IO,NS
RJM PDV PROCESS DEVICE STATUS
LDM CBFN+4
LPN FGIA
NJN PWS5 IF EXTENDING INDIRECTS ON BUFFERED DEVICE
SETMS IO,(RW,NS)
RJM PDV PROCESS DEVICE STATUS
PWS5 RJM WSS WRITE SYSTEM SECTOR
MJP PWS8 IF WRITE ERROR
ENDMS
* DETERMINE EOI LOCATION AND WRITE EOI SECTOR.
PWS6 LDM CBFN+4
LPN FGIA
NJP PWSX IF EXTENDING INDIRECTS ON BUFFERED DEVICE
LDM SDAB RESET FIRST TRACK
STD T6
LDD LF+1 GET NUMBER OF DATA SECTORS
STD RI+1
LDD LF
STD RI
LDM SDAC ADD RANDOM ADDRESS OF FIRST SECTOR
PWSA ADN 1 ADD ONE FOR SYSTEM SECTOR
* PSN (APPEND TO END OF CHAIN)
RAD RI+1 RANDOM ADDRESS OF EOI FROM START OF TRACK
SHN -14
RAD RI
RJM CRA CONVERT RANDOM ADDRESS TO TRACK AND SECTOR
MJN PWS7 IF ERROR IN CONVERSION
SETMS IO,(RW,NS)
RJM PDV PROCESS DEVICE STATUS
LDC BFMS WRITE EOI SECTOR
RJM WEI
MJN PWS8 IF MASS STORAGE ERROR
ENDMS
LJM PWSX RETURN
PWS7 RJM HNG HANG IF INDIRECT CHAIN TRUNCATED
PWS8 ERROR MSE,CH,,T5,,EI *EQXXX,DNYY, MASS STORAGE ERROR.*
SCF SPACE 4,20
** SCF - SET UP COMMUNICATION FILES.
*
* ENTRY (FNTA) = LOCAL FILE FNT ADDRESS.
* (FNTB) = /PFM*PFN/ FNT ADDRESS.
* (FNTC) = /PFM*ILK/ FNT ADDRESS.
* (FNTD) = /PFM*APF/ FNT ADDRESS.
* (CC) = COMMAND CODE.
*
* EXIT FNT ENTRIES UPDATED FOR COMMUNICATION FILES.
* /PFM*APF/ RETURNED IF NOT NEEDED.
* DRIVER RESET FOR MASTER DEVICE.
*
* USES FA, CM - CM+4, FN - FN+4, FS - FS+4.
*
* CALLS RMD, *0DF*.
*
* MACROS EXECUTE, NFA.
SCF SUBR ENTRY/EXIT
* SET UP /PFM*PFN/ FILE TO POINT TO PERMANENT FILE.
LDM FNTB SET FNT ADDRESS
STD FA
NFA FA,R
ADK FNTL
CRD FN
LDD CC
LMN CCGT
ZJN SCF1 IF *GET* REQUEST
LMN CCOD&CCGT
NJN SCF2 IF NOT *OLD* REQUEST
SCF1 LDD FN+3 SET WRITE LOCKOUT BIT IN FNT
SCN 1
LMN 1
STD FN+3
SCF2 LDN 10 SET *UPDATE* MODE
RAD FN+3
LDC 100*LIFT SET *LIFT* FILE TYPE
STD FN+4
LDD EQ SET UP FST
STD FS
SCFC LDC * SET FIRST TRACK OF FILE
* LDC (SDAB) (NORMAL TRANSFER)
* LDC (PFCB+FCBT) (APPEND TO END OF CHAIN)
* LDC (DVLW) (EXTENDING CHAIN ON BUFFERED DEVICE)
STD FS+1
SCFA LDC * SET CURRENT TRACK
STD FS+2
SCFB LDC * SET SECTOR
STD FS+3
LDN 5 SET STATUS
STD FS+4
LDM IAIF
ZJN SCF3 IF INDIRECT ALLOCATION INTERLOCK NOT SET
LDC 1000
RAD FS+4 SET TRACK INTERLOCK FLAG FOR FNT
LDN 0 CLEAR INDIRECT ALLOCATION INTERLOCK FLAG
STM IAIF
LDN FGIA SET *CPUPFM* INDIRECT ALLOCATION FLAG
RAM CBFN+4
LDD FN+3 CLEAR *UPDATE* MODE
SCN 10
STD FN+3
SCF3 NFA FA,R REWRITE FNT
ADK FNTL
CWD FN
ADK FSTL-FNTL
CWD FS
* SET UP /PFM*ILK/ FILE TO POINT TO CATALOG TRACK.
LDM FNTC SET FNT ADDRESS
STD FA
NFA FA,R READ FNT WORDS
ADK FNTL
CRD FN
ADN FUTL-FNTL
CRD CM
LDN ZERL
CRD FS
LDD FN+3 SET WRITE LOCKOUT BIT IN FNT
SCN 1
LMN 1
STD FN+3
LDC 100*LIFT *LIFT* FILE TYPE
STD FN+4
LDD EQ SET MASTER DEVICE (CATALOG) EST ORDINAL
STD FS
LDM CCIA SET CATALOG TRACK
STD FS+1
LDC 1005 STATUS (INCLUDING TRACK INTERLOCK BIT)
STD FS+4
SOM CCIB PREVENT CLEAR OF CATALOG TRACK INTERLOCK
LDN 10 SET PF ACTIVITY FLAG
RAD CM+2
LDN 0 PREVENT PF ACTIVITY DECREMENT IN *DPP*
STM EPFA
NFA FA,R REWRITE FNT
ADK FNTL
CWD FN
ADN FSTL-FNTL
CWD FS
ADN FUTL-FSTL
CWD CM
* UNLOAD /PFM*APF/ FILE, IF PRESENT AND NOT NEEDED.
LDM FNTD GET FNT ADDRESS
STD FA
ZJN SCF4 IF NO /PFM*APF/ FILE
LDM STAT
LPC STEC
ZJN SCF5 IF NOT APPEND TO END OF CHAIN
LDN 1
STM OVL0-1
EXECUTE 0DF,OVL0
LDN 0 CLEAR FNT ADDRESS
STM FNTD
RJM RMD RESET TO MASTER DEVICE
SCF4 LJM SCFX RETURN
* SET UP /PFM*APF/ FILE TO POINT TO ORIGINAL FILE ON *APPEND*.
SCF5 NFA FA,R READ FNT WORD
ADK FNTL
CRD FN
LDD FN+3 SET WRITE LOCKOUT BIT IN FNT
SCN 1
LMN 1
STD FN+3
LDC 100*LIFT SET *LIFT* FILE TYPE
STD FN+4
LDD EQ SET MASTER DEVICE EST ORDINAL
STD FS
LDM FCBT,CI SET FIRST TRACK OF FILE
STD FS+1
LDM APTK SET CURRENT TRACK
STD FS+2
STD T6
LDM APSC
STD FS+3
AOD FS+3 SET TO FIRST DATA SECTOR
LMM SLM
NJN SCF6 IF NOT AT END OF TRACK
STD FS+3 SET TO SECTOR ZERO
RJM SNT SET NEXT TRACK
STD FS+2
SCF6 LDN 5 SET STATUS
STD FS+4
NFA FA,R REWRITE FNT WORDS
ADK FNTL
CWD FN
ADN FSTL-FNTL
CWD FS
LJM SCFX RETURN
SCP SPACE 4,15
** SCP - SET UP CPU PARAMETERS.
*
* ENTRY (CB) = ADDRESS OF OLD CATALOG BUFFER.
* (CI) = ADDRESS OF OLD CATALOG ENTRY IN BUFFER.
* (FNTA) = FNT ADDRESS OF LOCAL FILE.
* (IAIF) = INDIRECT ALLOCATION INTERLOCK FLAG.
* (MSTA) = MASTER DEVICE MST ADDRESS/10.
* (PFCA) = ADDRESS OF NEW CATALOG ENTRY IN BUFFER.
*
* EXIT (CPFB) = BUFFER CONTAINING CPU TRANSFER PARAMETERS.
* (PFCB) = BUFFER CONTAINING COPY OF NEW PFC ENTRY.
* (CRAA) PRESET.
* (SNTA) PRESET.
* (SRAA) PRESET.
*
* USES T1, T6, T7.
*
* CALLS RMD, SNT, SRA.
SCP SUBR ENTRY/EXIT
RJM RMD RESET TO MASTER DEVICE
LDM MSTA CALCULATE FWA OF TRT
SHN 3
ADN TRLL
RJM CTA
SBD TH
STM CRAA+1 PRESET *COMPCRA*, *COMPSNT* AND *COMPSRA*
STM SNTA+1
STM SRAA+1
SHN -14
LMC ADCI
STM CRAA
STM SNTA
STM SRAA
* SAVE COPY OF NEW PFC FOR SYSTEM SECTOR.
LDM PFCA GET PFC ADDRESS
STM SCPA
LDC 5*NWCE-1
STD T1
SCP1 LDM *,T1 COPY NEXT BYTE
SCPA EQU *-1
STM PFCB,T1
SOD T1
PJN SCP1 IF MORE BYTES TO COPY
* SET LOCAL FILE NAME AND FILE LENGTH(S).
NFA FNTA,R SET FILE NAME
ADK FNTL
CRM CBFN,ON
LDM CBFN+3 CLEAR STATUS FIELD
SCN 77
STM CBFN+3
LDN 0
STM CBFN+4
LDD LF+1 SET UP FILE LENGTHS
STM CBLF+4
LDD LF
STM CBLF+3
LDM APLF+1
STM CBLF+2
LDM APLF
STM CBLF+1
LDN 0
STM CBLF
* CALCULATE FIRST DATA TRACK AND SECTOR.
LDM SDAB SET TRACK
STD T6
STM SCFC+1
STM SCPC+1
LDM SDAC SET SECTOR
STD T7
LDM STAT
LPC STEC
ZJN SCP3.1 IF NOT *APPEND* TO END OF CHAIN
LDM PFCB+FCBT SET CORRECT FIRST TRACK
STM SCFC+1
STM SCPC+1
UJN SCP4 SAVE TRACK AND SECTOR
SCP3.1 AOD T7 ADVANCE TO FIRST DATA SECTOR
LMM SLM
NJN SCP4 IF NOT AT END OF TRACK
STD T7 SET TO SECTOR ZERO
RJM SNT SET NEXT TRACK
STD T6
SCP4 LDD T6 SAVE TRACK
STM SCFA+1
LDD T7 SAVE SECTOR
STM SCFB+1
* CALCULATE RANDOM ADDRESS OF PERMANENT FILE.
LDM IAIF
ZJN SCP4.1 IF NOT EXTENDING CHAIN ON BUFFERED DEVICE
LDM DVLW SET CORRECT FIRST TRACK FOR FST
STM SCFC+1
UJN SCP5 SET *PFID* OF OLD CATALOG
SCP4.1 LDD CC
LMN CCGT
ZJN SCP6 IF *GET* REQUEST
LMN CCOD&CCGT
ZJN SCP6 IF *OLD* REQUEST
SCPC LDC * CALCULATE RANDOM ADDRESS
* LDC (SDAB) (TRANSFER WITHIN CHAIN)
* LDC (PFCB+FCBT) (APPEND TO END OF CHAIN)
RJM SRA
LDD RI
STM CBRI+3
LDD RI+1
STM CBRI+4
* SET *PFID* OF OLD CATALOG INTO PARAMETER BLOCK (*APPEND*).
SCP5 LDD CC
LMN CCAP
ZJN SCP7 IF *APPEND* REQUEST
SCP6 LJM SCPX RETURN
SCP7 LDM STAT
LPC STEC
NJN SCP6 IF APPEND TO END OF CHAIN
LDM -2,CB SET TRACK
STM CBID+3
LDM -1,CB SET SECTOR
STM CBID+4
LDM MSTA SET FAMILY NAME
SHN 3
ADN PFGL
CRM CBFM,ON
LDM CBFM+3 SET DEVICE NUMBER
LPN 77
STM CBID+2
LDD CI CALCULATE PFC ENTRY ORDINAL (PEO)
SBD CB
SBN 2
SHN -NWCES
LPN 1S"NWCEM"-1
SHN 6 SET PEO
RAM CBID+2
LDN 2 COPY CREATION DATE/TIME
STD T1
LDD CI
RAM SCPB
SCP8 LDM FCCD,T1 COPY NEXT BYTE
SCPB EQU *-1
STM CBCD+2,T1
SOD T1
PJN SCP8 IF MORE BYTES TO COPY
LDM CBUI+3 SET USER INDEX
SCN 77
LMD UI
STM CBUI+3
LDD UI+1
STM CBUI+4
LJM SCPX RETURN
SPACE 4,10
* WORKING STORAGE AND BUFFERS.
* BUFFERS.
PFCB BSS 5*NWCE PFC SAVE BUFFER
CPFB BSSZ 5*CPFBL *CPUPFM* PARAMETER BLOCK BUFFER
* LOCATIONS WITHIN *CPFB* BUFFER.
CBFN EQU CPFB LOCAL FILE NAME
CBLF EQU CPFB+5*1 FILE LENGTHS
CBRI EQU CPFB+5*2 RANDOM INDEX
CBSR EQU CPFB+5*3 SPECIAL REQUEST BLOCK
* LOCATIONS WITHIN SPECIAL REQUEST BLOCK IN *CPFB* BUFFER.
CBID EQU CBSR+5*SFID *PFID* FIELD
CBCD EQU CBSR+5*SFCD CREATION DATE FIELD
CBFM EQU CBSR+5*SFFM FAMILY NAME FIELD
CBUI EQU CBSR+5*SFUI USER INDEX FIELD
SPACE 4,10
* COMMON DECKS.
*CALL COMPCRA
WEI$ EQU 1 ALLOW BUFFER SPECIFICATION
*CALL COMPSRA
*CALL COMPWEI
WIS$ EQU 1 WRITE IAPF SYSTEM SECTOR
*CALL COMPWSS
SPACE 4,10
USE OVERFLOW
OVL0 EQU *+5 ZERO-LEVEL OVERLAY LOAD ADDRESS
ERRNG BFMS-OVL0-ZDFL *0DF* OVERFLOW
SPACE 4,10
OVERFLOW OVLU,GETA OVERFLOW INTO *GET* PROCESSING
SPACE 4,10
OVERFLOW OVLU,SAVA OVERFLOW INTO *SAVE* PROCESSING
SPACE 4,10
OVERFLOW OVLU,APPB OVERFLOW INTO *APPEND* PROCESSING
OVERLAY (ERROR PROCESSING.),OVLA
SPACE 4,10
** THIS OVERLAY PROCESSES PERMANENT FILE ERRORS BY SENDING
* THE INDICATED ERROR MESSAGE TO THE DAYFILE, SETTING THE
* FST ENTRY NOT BUSY OR DELETING THE FNT/FST ENTRY IF CREATED
* BY *PFM*, AND TERMINATING THE CALLING PROGRAM.
OVL BSS 0 ENTRY
* LJM SEP PROCESS ERROR
SPACE 4,10
*** PERMANENT FILE ERROR PROCESSING.
*
*
* COMMAND OR CENTRAL PROGRAM CALLS.
*
* IF THE ERROR PROCESSING BIT IS SET IN THE FET, PFM
* RETURNS THE ERROR CODE, SETS THE COMPLETE BIT AND
* ISSUES THE DAYFILE MESSAGE. THE ERROR CODE IS
* RETURNED IN WORD 0 OF THE FET BITS 10 - 17.
*
* IF THE ERROR PROCESSING BIT IS NOT SET, A DAYFILE
* MESSAGE IS ISSUED, THE CONTROL POINT ABORTED, AND THE
* PPU IS DROPPED.
*
* IF THE ERROR RETURN ADDRESS *ERAD* IS SET AND THE USER
* IS PROCESSING ERRORS, THE MESSAGE WILL NOT BE ISSUED
* TO THE DAYFILE BUT WILL BE RETURNED TO THE USER
* PROGRAM AT RA + ERAD. FOUR WORDS MUST BE ALLOCATED
* AT *ERAD* FOR MESSAGE.
*
* IF THE ERROR *FILE BUSY* IS ENCOUNTERED AN EVENT
* DESCRIPTOR (EST ORDINAL/FIRST TRACK) WILL BE SET
* IN *TERW* IN THE CP AREA SO THAT THE CALLING PROGRAM
* MAY ISSUE A ROLLOUT IF IT WANTS TO WAIT FOR FILE TO
* BECOME AVAILABLE.
*
* IF A DEVICE REQUIRED BY PFM IS TEMPORARILY
* INACCESSIBLE, AN ERROR STATUS WILL BE RETURNED TO THE
* CALLER IF REAL-TIME PROCESSING WAS SELECTED IN THE
* FET; OTHERWISE, THE JOB WILL BE ROLLED OUT IF IT IS
* NOT A SUBSYSTEM. THE PFM FUNCTION WILL BE RESTARTED
* WHEN THE JOB RESUMES EXECUTION. THE *ATTACH*,
* *CATLIST*, *CHANGE*, *DEFINE*, *DELPFC*, *DROPDS*,
* *GET*, *PERMIT*, *PURGE*, *SETPFAC*, AND *SETPFAL*
* REQUESTS CAN BE INTERRUPTED ON ANY I/O OPERATION AND
* RESTARTED. THE *APPEND*, *REPLACE*, AND *SAVE*
* REQUESTS CANNOT BE INTERRUPTED ONCE THE CATALOG
* ENTRY FOR THE PERMANENT FILE HAS BEEN WRITTEN AND
* THE FILE TRANSFER IS IN PROGRESS.
*
*
* IF ANY OF THE FOLLOWING ERRORS ARE ENCOUNTERED AND THE
* ERROR IS NOT DUE TO A HARDWARE FAILURE, THE MESSAGE
* *EQXXX, ERROR IDLE SET.*
* WILL BE ISSUED TO THE ERROR LOG AND ERROR IDLE STATUS
* WILL BE SET IN THE MST OF THE APPROPRIATE DEVICE.
* THIS WILL PREVENT FURTHER ACCESS TO THE DEVICE.
*
* * BAD CATALOG/PERMIT SECTOR.*
* * FILE LENGTH ERROR.*
*
* SETTING OF ERROR IDLE STATUS ON A FAILING DEVICE MAY
* BE REQUESTED FOR ANY OTHER TYPE 2 ERROR BY SPECIFYING
* THE *EI* PARAMETER ON THE *ERROR* MACRO CALL. THIS
* SHOULD BE DONE IF THE ERROR CAUSES THE CATALOG OR
* PERMITS FILE TO BE CORRUPTED. IT WILL BE SET IN
* THE FOLLOWING SITUATIONS.
*
* * MASS STORAGE ERROR.*
* - AN UNRECOVERABLE WRITE ERROR OCCURRED ON THE
* CATALOG OR PERMITS FILE AND DATA ON THE FILE HAS
* BEEN DESTROYED.
* - AN UNRECOVERABLE WRITE ERROR OCCURRED OR THE
* DEVICE BECAME INACCESSIBLE WHILE PERMIT SECTORS
* WERE BEING LINKED.
* - AN UNRECOVERABLE WRITE ERROR OCCURRED OR THE
* DEVICE BECAME INACCESSIBLE WHILE WRITING THE
* CATALOG FILE OR PERFORMING THE FILE TRANSFER FOR
* *APPEND*, *REPLACE*, OR *SAVE* COMMAND.
* (THE CATALOG ENTRY FOR THE PERMANENT FILE HAS BEEN
* ASSIGNED TO THE USER PRIOR TO TRANSFERRING THE FILE
* AND POINTS TO UNWRITTEN FILE SPACE.)
*
* * PFM ABORTED.*
* - *CPUPFM* HAS ABORTED BEFORE THE FILE TRANSFER IS
* COMPLETE FOR *APPEND*, *REPLACE*, OR *SAVE*
* COMMAND.
*
* * TRACK LIMIT.*
* - *CPUPFM* HAS ENCOUNTERED A TRACK LIMIT BEFORE THE
* FILE TRANSFER IS COMPLETE FOR *APPEND*, *REPLACE*,
* OR *SAVE* COMMAND.
SPACE 4,10
*** DAYFILE MESSAGES.
*
* ERROR 1 * (FILE NAME) BUSY.*
* DIRECT ACCESS FILE ATTACHED WITH CONFLICTING MODE.
*
* ERROR 2 * (FILE NAME) NOT FOUND.*
* PERMANENT FILE SPECIFED COULD NOT BE FOUND.
* OPTIONAL USER NAME NOT FOUND.
* LOCAL FILE SPECIFIED NOT FOUND.
* PERMANENT FILE SPECIFIED WAS NOT THE CORRECT TYPE OF FILE
* FOR THE COMMAND USED. FOR EXAMPLE, A DIRECT ACCESS FILE
* WAS FOUND USING A *GET* REQUEST OR AN INDIRECT ACCESS FILE
* WAS FOUND USING AN *ATTACH* REQUEST.
*
* ERROR 3 * (FILE NAME) EMPTY.*
* FILE CONTAINS NO DATA.
*
* ERROR 4 * (FILE NAME) NOT ON MASS STORAGE.*
* FILE TO BE SAVED DOES NOT RESIDE ON MASS STORAGE.
* FIRST TRACK OF FILE NOT RECOGNIZABLE.
*
* ERROR 5 * (FILE NAME) ALREADY PERMANENT.*
* USER ALREADY HAS FILE SAVED OR DEFINED.
*
* ERROR 6 * (FILE NAME) INCORRECT FILE TYPE.*
* USER HAS TRIED TO DEFINE A FILE THAT IS NOT A LOCAL FILE.
*
* ERROR 7 * FILE NAME ERROR.*
* FILE NAME CONTAINS INCORRECT CHARACTERS.
*
* ERROR 10 * USER ACCESS NOT VALID.*
* USER NOT VALIDATED FOR DIRECT AND/OR INDIRECT ACCESS FILES,
* OR ACCESS TO REMOVABLE DEVICES.
* USER IS NOT VALIDATED FOR ACCESS TO FAST ATTACH FILES.
* PERMIT *CATLIST* ATTEMPTED ON A FILE WITH AN ACCESS LEVEL
* ABOVE THAT OF THE JOB.
*
* ERROR 11 * INCORRECT DEVICE REQUEST.*
* DEVICE TYPE SPECIFIED ON REMOVABLE DEVICE REQUEST IS
* UNRECOGNIZED OR DOES NOT EXIST ON SYSTEM.
* THE PACKNAME REQUESTED FOR AUXILIARY DEVICE REQUEST IS
* AVAILABLE IN SYSTEM BUT NOT AS TYPE REQUESTED BY *R* OPTION.
*
* ERROR 12 * FILE TOO LONG.*
* LENGTH OF FILE TO BE PLACED IN PERMANENT FILES EXCEEDS
* THE LIMIT SET BY INSTALLATION.
* THIS MESSAGE IS ISSUED ON AN ATTACH FUNCTION IF THE USER
* ATTEMPTS TO ATTACH A FILE IN WRITE, APPEND OR MODIFY MODE
* OR DEFINE AN EXISTING FILE AND THE FILE EXCEEDED THE
* USERS FILE LENGTH CONTROLS.
*
* ERROR 13 * PFM INCORRECT REQUEST.*
* INCORRECT COMMAND CODE PASSED TO PFM.
* INCORRECT PERMIT MODE OR CATALOG TYPE SPECIFIED.
* PERMIT TYPE CATLIST WITH NO FILENAME.
* THE *BR* OR *PR* VALUE SPECIFIED IS INCORRECT.
*
* ERROR 14 * DEVICE UNAVAILABLE.*
* ACCESS TO PERMANENT FILE DEVICE REQUESTED IS NOT POSSIBLE.
* THIS ERROR IS ISSUED IF THE USER INDEX IS ZERO.
* THIS ERROR IS ISSUED IF THE MSF DEVICE ON WHICH THE FILE
* RESIDES IS NOT DEFINED IN THE EQUIPMENT CONFIGURATION.
*
* ERROR 15 * DIRECT ACCESS DEVICE ERROR.*
* DEVICE THAT FILE RESIDES ON MAY NOT CONTAIN DIRECT ACCESS FILE
*
* ERROR 16 * PF UTILITY ACTIVE.*
* UTILITY OPERATION CURRENTLY ACTIVE. OPERATION NOT ATTEMPTED.
* USER SHOULD RETRY THE OPERATION. ERROR CODE 16 IS ALSO
* RETURNED IN THE FET FOR ERROR 126 WITH THE ERROR MESSAGE,
* *WAITING - INACCESSIBLE DEVICE.*
*
* ERROR 17 * DATA TRANSFER ERROR.*
* ERROR IN READ OF DATA DURING TRANSFER OF FILE. TRANSFER
* IS COMPLETED WITH SECTOR CONTAINING ERROR TRANSFERRED AS READ.
*
* ERROR 20 * TOO MANY PERMANENT FILES.*
* NUMBER OF FILES IN CATALOG EXCEEDS ALLOWABLE LIMIT.
*
* ERROR 21 * TOO MUCH INDIRECT ACCESS FILE SPACE.*
* CUMULATIVE SIZE OF INDIRECT FILES IN CATALOG EXCEEDS
* THE ALLOWABLE LIMIT.
*
* ERROR 22 * PRUS REQUESTED UNAVAILABLE.*
* NUMBER OF PRUS SPECIFIED ON DEFINE REQUEST IS NOT AVAILABLE.
*
* ERROR 23 * I/O SEQUENCE ERROR.*
* PFM REQUEST ATTEMPTED ON LOCAL FILE THAT IS CURRENTLY ACTIVE.
*
* ERROR 24 * LOCAL FILE LIMIT.*
* THE JOBS LOCAL FILE LIMIT HAS BEEN EXCEEDED BY AN ATTEMPT
* TO GET OR ATTACH THIS FILE. (FILE NOT ATTACHED OR RETRIEVED)
*
* ERROR 25 * PRU LIMIT.*
* THE JOBS MASS STORAGE PRU LIMIT WAS EXCEEDED BY AN
* ATTEMPT TO GET THIS FILE. (FILE NOT ATTACHED OR RETRIEVED)
*
* ERROR 26 * PERMIT LIMIT EXCEEDED.*
* THE NUMBER OF EXPLICIT PERMIT ENTRIES FOR A FILE HAS
* REACHED THE LIMIT DEFINED BY *PMLN*.
*
* ERROR 27 * PFM ARGUMENT ERROR.*
* AN INCORRECT VALUE HAS BEEN SPECIFIED IN THE FET.
*
* ERROR 30 * RESEX FAILURE.*
* RESEX HAS DETECTED AN ERROR IN CONTROL FILES OR SOME OTHER
* FATAL ERROR HAS OCCURRED IN RESEX.
*
* ERROR 31 *EQXXX,DNYY, TRACK LIMIT.*
* EST ORDINAL XXX HAS NO SPACE.
*
* ERROR 32 *EQXXX,DNYY, FILE LENGTH ERROR.*
* LENGTH OF FILE DOES NOT EQUAL CATALOG LENGTH DURING TRANSFER.
*
* ERROR 33 *EQXXX,DNYY, RANDOM INDEX ERROR.*
* PERMIT RANDOM ADDRESS ERROR.
*
* ERROR 34 *EQXXX,DNYY, DIRECT ACCESS FILE ERROR.*
* SYSTEM SECTOR DATA FOR FILE DOES NOT VERIFY.
*
* ERROR 35 *EQXXX,DNYY, REPLACE ERROR.*
* SAME FILE FOUND TWICE DURING CATALOG SEARCH. THIS CAN
* OCCUR FOR APPEND OR REPLACE COMMANDS AFTER FILE IS FOUND,
* PURGED AND CATALOG SEARCH FOR HOLE IS CONTINUED.
*
* ERROR 36 *EQXXX,DNYY, PFM ABORTED.*
* *PFM* WAS UNABLE TO CONTINUE DUE TO AN OPERATOR OVERRIDE,
* OR *CPUPFM* ABORTED PRIOR TO COMPLETING ITS TRANSFER.
*
* ERROR 37 *EQXXX,DNYY, MASS STORAGE ERROR.*
* ERROR ENCOUNTERED IN READ OR WRITING PORTION OF PF CATALOG OR
* PERMIT INFORMATION.
*
* ERROR 40 * ERROR IN FILE DATA.*
* ERRORS IN THE FILE DATA WERE DETECTED BY *PFDUMP* WHILE
* IT WAS DUMPING THE FILE; THE FILE WAS LATER RELOADED.
*
* ERROR 41 * ERROR IN PERMIT DATA.*
* ERRORS IN THE FILE-S PERMIT ENTRIES WERE ENCOUNTERED BY
* *PFDUMP* WHILE IT WAS DUMPING THE FILE; THE FILE WAS LATER
* RELOADED.
*
* ERROR 42 * DATA/PERMIT ERRORS.*
* ERRORS WERE ENCOUNTERED IN BOTH THE DATA AND THE PERMIT
* ENTRIES WHILE *PFDUMP* WAS DUMPING THE FILE; THE FILE
* WAS LATER RELOADED.
*
* ERROR 43 * EOI CHANGED BY RECOVERY.*
* AN ERROR IN THE FILES EOI POSITION WAS DETECTED BY THE
* RECOVERY ROUTINES. THE POSITION WAS CHANGED TO THE
* BEST LOGICAL POSITION.
*
* ERROR 44 - 47 RESERVED
*
* ERROR 50 *EQXXX,DNYY, FILE BOI/EOI/UI MISMATCH.*
* THE VERIFICATION OF THE FILE-S STRUCTURE OR OWNER
* IDENTIFICATION FAILED. THE FILE DATA HAS BEEN LOST.
*
* ERROR 51 *EQXXX,DNYY, SYSTEM SECTOR ERROR.*
* ERRORS ENCOUNTERED IN VERIFICATION OF SYSTEM SECTOR
* OF FILE.
*
* ERROR 52 *EQXXX,DNYY, BAD CATALOG/PERMIT SECTOR.*
* THE LENGTH OF THE INDICATED CATALOG OR PERMIT SECTOR IS NOT
* A MULTIPLE OF THE ENTRY SIZE.
*
* ERROR 53 *EQXXX,DNYY, TRACK NOT RESERVED.*
* THERE IS NO TRACK RESERVED FOR THE FILE. THE DATA FOR THE
* FILE HAS BEEN LOST.
*
* ERROR 54 - 70 RESERVED
*
* ERROR 71 * (FILE NAME) PERMANENT ERROR.*
* UNRECOVERABLE ERRORS WERE DETECTED IN ATTEMPTING TO ACCESS
* THE FILE ON ALTERNATE STORAGE.
*
* ERROR 72 * (FILE NAME) STAGE INITIATED.*
* THE PERMANENT FILE IS BEING STAGED FROM ALTERNATE STORAGE
* TO DISK.
*
* ERROR 73 * (FILE NAME) WAITING FOR SUBSYSTEM.*
* THE PERMANENT FILE MUST BE STAGED FROM ALTERNATE STORAGE
* TO DISK AND THE APPROPRIATE SUBSYSTEM IS NOT CURRENTLY
* AVAILABLE TO PERFORM THE STAGE OPERATION.
*
* ERROR 74 * (FILE NAME) INTERLOCKED.*
* A FILE CAN NOT BE ATTACHED IN *WRITE*, *MODIFY* OR *APPEND*
* MODE WHEN THE FILE IS ATTACHED IN UTILITY MODE.
*
* ERROR 75 * (FILE NAME) IS DIRECT ACCESS.*
* USER IS ATTEMPTING AN INDIRECT FILE COMMAND WHEN THE FILE
* IS A DIRECT ACCESS FILE.
* CURRENTLY ERROR 2 IS REPORTED IN THE *FET*.
*
* ERROR 76 * (FILE NAME) IS INDIRECT ACCESS.*
* USER IS ATTEMPTING A DIRECT ACCESS FILE COMMAND WHEN THE
* FILE IS AN INDIRECT ACCESS FILE.
* CURRENTLY ERROR 2 IS REPORTED IN THE *FET*.
*
* ERROR 77 * (FILE NAME) IS EXECUTE ONLY.*
* THE SPECIFIED LOCAL FILE CANNOT BE ACCESSED BY *SAVE*,
* *REPLACE*, *APPEND* OR *DEFINE*, SINCE IT IS AN
* EXECUTE-ONLY FILE.
*
* ERROR 100 * PF STAGING DISABLED.*
* THE PERMANENT FILE MUST BE STAGED FROM ALTERNATE STORAGE
* TO DISK AND EITHER *CARTRIDGE PF STAGING* OR *TAPE
* PF STAGING*, OR BOTH, HAVE BEEN DISABLED.
*
* ERROR 101 * INCORRECT PFC ADDRESS.*
* THE DEVICE NUMBER, TRACK AND SECTOR SPECIFIED AS THE *PFC*
* ADDRESS ARE INCORRECT.
*
* ERROR 102 * PFC VERIFICATION ERROR.*
* THE CREATION DATE AND TIME, USER INDEX OR ALTERNATE STORAGE
* ADDRESS DO NOT AGREE WITH THE CURRENT *PFC* CONTENTS.
*
* ERROR 103 * FILE NOT DISK RESIDENT.*
* THE *UATTACH* FUNCTION DOES NOT SUPPORT ACCESS TO FILES WHICH
* ARE NOT DISK RESIDENT.
*
* ERROR 104 * INTERLOCK NOT AVAILABLE.*
* A SOFTWARE INTERLOCK IS CURRENTLY NOT AVAILABLE TO A REQUESTOR
* SPECIFYING *EP* AND *UP* EXIT PROCESSING OPTIONS.
*
* ERROR 105 * ALTERNATE IMAGE OBSOLETE.*
* THE *DROPDS* FUNCTION DOES NOT RETURN THE DISK SPACE FOR
* FILES WITH ALTERNATE STORAGE MARKED OBSOLETE OR WITHOUT
* AN ALTERNATE STORAGE ADDRESS SPECIFIED IN THE *PFC*.
*
* ERROR 106 * ALTERNATE STORAGE ERROR.*
* AN ATTEMPT TO DROP DISK SPACE WHEN A PERMANENT ERROR STATUS
* IS SET FOR THE ALTERNATE STORAGE FILE COPY.
*
* ERROR 107 * FNT FULL.*
* FNT SPACE IS NOT CURRENTLY AVAILABLE FOR A REQUEST WHICH HAS
* BOTH *EP* AND *UP* EXIT PROCESSING OPTIONS SET.
*
* ERROR 110 * INCORRECT CATALOG UPDATE.*
* THIS ERROR IS ISSUED IF AN ALTERNATE STORAGE ADDRESS EXISTS
* AND THE ALTERNATE STORAGE COPY IS NOT MARKED OBSOLETE WHEN
* PERFORMING A *SETASA* FUNCTION. THIS ERROR IS ALSO ISSUED
* IF A DISK ADDRESS EXISTS FOR A FILE IN THE *PFC* ENTRY WHEN
* PERFORMING A *SETDA* OR *UREPLAC* FUNCTION.
*
* ERROR 111 * PFM EXCESS ACTIVITY.*
* THE SYSTEM *PFM* ACTIVITY COUNT IS AT LIMIT. THIS CONDITION
* IS ONLY REPORTED FOR REQUESTS WITH BOTH *EP* AND *UP* EXIT
* PROCESSING OPTIONS SET.
*
* ERROR 112 * NOT VALIDATED TO SET XD/XT.*
* THE USER HAS ATTEMPTED TO SET AN EXPIRATION DATE FOR A FILE,
* AND IS NOT VALIDATED FOR THAT PRIVILEGE.
*
* ERROR 113 * XD/XT EXCEEDS MAXIMUM.*
* THIS MESSAGE IS ISSUED WHEN THE USER SPECIFIES AN EXPIRATION
* DATE OR TERM WHICH IS LARGER THAN THE PREDEFINED SYSTEM
* MAXIMUM EXPIRATION TERM.
*
* ERROR 114 * JOB CANNOT ACCESS FILE.*
* THE ACCESS LEVEL AND CATEGORY SET OF THE CALLING JOB DOES NOT
* ALLOW ACCESS TO THE SPECIFIED FILE.
*
* ERROR 115 * ACCESS LEVEL NOT VALID FOR JOB.*
* THE SPECIFIED ACCESS LEVEL IS NOT VALID FOR THE CALLING JOB.
*
* ERROR 116 * WRITE-DOWN OF DATA PROHIBITED.*
* THE LOCAL FILE HAS A HIGHER ACCESS LEVEL THAN THE FILE IT IS
* REPLACING OR IS BEING APPENDED TO.
* THE LOCAL FILE FILE HAS A LOWER ACCESS LEVEL THAN THE JOB ON
* A *DEFINE* REQUEST.
* THE PERMANENT FILE HAS A LOWER ACCESS LEVEL THAN THE JOB ON
* A *PERMIT*, *CHANGE*, OR *SETPFAC* REQUEST.
*
* ERROR 117 * ACCESS CATEGORIES NOT VALID FOR JOB.*
* THE SPECIFIED ACCESS CATEGORY SET IS NOT VALID FOR THE
* CALLING JOB.
*
* ERROR 120 * ACCESS LEVEL NOT VALID ON PF DEVICE.*
* THE LOCAL FILE ACCESS LEVEL IS INCOMPATIBLE WITH THE
* USERS MASTER DEVICE ACCESS LEVEL LIMITS.
*
* ERROR 121 * NOT VALID TO DOWNGRADE DATA.*
* THE USER HAS ISSUED *SETPFAL* REQUESTING THE FILE TO BE
* CHANGED TO A LOWER ACCESS LEVEL AND DOES NOT HAVE THE
* PRIVILEGE TO MAKE DATA LESS SECURE.
*
* ERROR 122 * (FILE NAME) - NO TEMP DEVICE FOUND.*
* THE USER HAS ATTEMPTED TO RETRIEVE AN INDIRECT PERMANENT
* FILE FOR WHICH THERE IS NO TEMPORARY DEVICES VALID FOR THE
* FILE-S ACCESS LEVEL.
*
* ERROR 123 * ACCESS LEVEL NOT VALID FOR FILE.*
* ONE OF TWO ERRORS -
* 1. THE SPECIFIED ACCESS LEVEL IS LESS THAN THE CURRENT
* ACCESS LEVEL OF THE LOCAL FILE, AND THE CALLER IS NOT
* VALIDATED TO DOWNGRADE FILES.
* 2. THE SPECIFIED ACCESS LEVEL IS NOT VALID ON THE DEVICE THAT
* THE LOCAL FILE RESIDES ON; THEREFORE, THE USER CAN NOT *SAVE*
* OR *DEFINE* THE FILE AT THAT ACCESS LEVEL.
*
* ERROR 124 * (FILE NAME) TEMPORARY ERROR, TRY LATER.*
* THE SYSTEM HAS ENCOUNTERED A TEMPORARY PROBLEM WHICH PREVENTS
* IT FROM STAGING YOUR FILE IN FROM ALTERNATE STORAGE.
* WAIT AWHILE, THEN TRY AGAIN.
*
* ERROR 125 * WAITING FOR NFL.*
* YOUR JOB HAS BEEN DELAYED AND/OR ROLLED OUT WAITING FOR NFL.
*
* ERROR 126 * WAITING - INACCESSIBLE DEVICE.*
* ACCESS TO THE PERMANENT FILE DEVICE REQUESTED IS NOT
* ALLOWED AT THIS TIME BECAUSE THE DEVICE HAS *SUSPECT*,
* *OFF*, OR *DOWN* STATUS. ERROR CODE 16 IS RETURNED IN
* THE FET FOR THIS CONDITION. USER SHOULD RETRY THE
* OPERATION.
*
* ERROR 127 (NO MESSAGE)
* REQUEST IS BEING RETRIED BY *PFM*.
*
* ERROR 130 * ERROR IN CATLIST CONTINUATION DATA.*
* THE CATLIST CONTINUATION DATA SPECIFIED IN *FET+6* POINTS
* TO AN INCORRECT TRACK AND/OR SECTOR.
SPACE 4,30
*** ERROR LOG MESSAGES.
*
* THE FOLLOWING MESSAGES ARE ISSUED TO THE ERROR LOG AS WELL
* AS TO THE USER AND SYSTEM DAYFILES. IN THE ERROR LOG, THE
* PREFIX *EQXXX,DNYY,* IS ADDED TO EACH OF THE MESSAGES.
*
* * TRACK LIMIT.*
* * FILE LENGTH ERROR.*
* * RANDOM INDEX ERROR.*
* * DIRECT ACCESS FILE ERROR.*
* * REPLACE ERROR.*
* * PFM ABORTED.*
* * MASS STORAGE ERROR.*
* * FILE BOI/EOI/UI MISMATCH.*
* * SYSTEM SECTOR ERROR.*
* * BAD CATALOG/PERMIT SECTOR.*
* * TRACK NOT RESERVED.*
*
* WHENEVER ONE OF THE ABOVE MESSAGES IS ISSUED TO THE ERROR
* LOG, ONE OF THE FOLLOWING MESSAGES IS ALSO ISSUED TO THE
* ERROR LOG TO IDENTIFY THE FILE IN ERROR.
*
* *EQXXX, FM=FAMILY,PF=PFN,UI=USERINDEX.*
* *EQXXX, TK=TRACK,SC=SECTOR.*
*
* IF *PFM* SETS ERROR IDLE ON THE DEVICE AS THE RESULT OF
* THE ERROR CONDITION, THE FOLLOWING MESSAGE IS ALSO ISSUED
* TO THE ERROR LOG.
*
* *EQXXX, ERROR IDLE SET.*
TITLE SYSTEM ERROR PROCESSING.
SEP SPACE 4,25
** SEP - SYSTEM ERROR PROCESSING.
*
* ENTRY (P1) = 3/EXC,7/MNE,1/EIF,1/CIF.
* (EXC) = EXIT CASE.
* (MNE) = ERROR MNEMONIC.
* (EIF) = ERROR IDLE FLAG.
* (CIF) = CHANNEL INTERLOCKED FLAG.
* (P2) = EST ORDINAL.
*
* EXIT (EP) = *EP* BOOLEAN.
* (P0) = ERROR IDLE FLAG.
* (P1) = ERROR CODE.
* (P3) = EXIT CASE.
* (RT) = *RT* BOOLEAN.
* (UP) = *UP* BOOLEAN.
* SEPB = EXIT CASE.
* TO *EXC* (X=0,1,...,6) TO PROCESS EXIT CASE.
* TO *RCL* TO RETRY REQUEST.
*
* USES T1 - T3, P1 - P3, FA, CM - CM+4, FN - FN+4, FS - FS+4.
*
* CALLS CAD, CAI, CEI, CLE, PDE, PPF, PRT, SFA.
MBUF BSS 0 MESSAGE ASSEMBLY BUFFER
SEP BSS 0 ENTRY
LDD P1 SEPARATE EXIT CASE
SHN 0-11
STD P3
STM SEPB SAVE EXIT CASE
LDD P1 SEPARATE ERROR IDLE FLAG
LPN 2
STD P0
LDD P1 SEPARATE ERROR CODE
SHN 0-2
LPC 177
STD P1
* SET UP THE *RT*, *EP* AND *UP* DIRECT CELLS.
LDM EPOP SET UP *RT*
SHN 0-1
LPN 1
STD RT
LDM EPOP SET UP *EP*
SHN 0-2
LPN 1
STD EP
LDM EPOP SET UP *UP*
SHN 0-3
LPN 1
STD UP
* PERFORM COMMON INITIAL ERROR PROCESSING.
RJM CAI CLEAR ALLOCATION AND *DAPF* INTERLOCKS
RJM CAD CHECK FOR ACCESS DENIED
RJM CEI CHECK FOR ERROR IDLE
RJM CLE CHECK FOR LENGTH ERROR
RJM PRT PROCESS PRESERVED AND RESERVED TRACKS
RJM PDE PROCESS *DMP=*
RJM PPF PROCESS SPECIAL *PFM* FILES
* INVOKE EXIT CASE.
LDD P1 CHECK ERROR CODE
LMK /ERRMSG/RTR
ZJP RCL IF REQUEST TO BE RETRIED
LDM SEPA,P3 GET EXIT CASE ADDRESS
STM SEPA
LJM E0C EXIT 0 CASE
SEPA EQU *-1
CON E1C EXIT 1 CASE
CON E2C EXIT 2 CASE
CON E3C EXIT 3 CASE
CON E4C EXIT 4 CASE
CON E5C EXIT 5 CASE
CON E6C EXIT 6 CASE
CON E7C EXIT 7 CASE
SEPB CON 0 EXIT CASE OF *EXC*
E0C SPACE 4,15
** E0C - EXIT 0 CASE PROCESSING.
*
* EXIT ERROR CODE IS RETURNED IN THE *FET*.
* IF (EP) = 0 THE JOB IS ABORTED.
* IF (EP) = 1, THE JOB IS NOT ABORTED.
*
* USES CM - CM+4.
*
* CALLS PEM, UFF.
E0C BSS 0 ENTRY
LDD P1
LMK /ERRMSG/FBS
NJN E0C1 IF NOT *FILE BUSY*
LDD CP SET *FILE BUSY* EVENT INTO *TERW*
ADK TERW
CRD CM
LDD CM+2 SET TIME
SCN 77
SHN 3
LMM ERRD
SHN 22-3
STD CM+2
SHN -6
SCN 77
LMM ERRE SET EST ORDINAL
STD CM+3
LDM ERRC SET FOLDED EVENT
STD CM+4
LDD CP
ADK TERW
CWD CM
E0C1 RJM PEM PROCESS ERROR MESSAGE
LJM UFF UPDATE FET FIELDS AND EXIT
E1C SPACE 4,25
** E1C - EXIT 1 CASE PROCESSING.
*
* SPECIAL *EP* AND *UP* CONTROLLED FOR TIME DEPENDENT
* PROCESSING WITH A POSSIBILITY OF ROLLOUT.
*
* ENTRY (EP) = *EP* BOOLEAN.
* (UP) = *UP* BOOLEAN.
*
* EXIT IF *EP* AND *UP*.
* IF EMRA, COPY MESSAGE TO EMRA BUFFER.
* SET STATUS IN FET.
* EXIT PFM.
* SET MESSAGE IN *MS2W*.
* IF SSID FIELD ZERO, ROLLOUT JOB.
* RECALL REQUEST.
* EXIT PFM.
*
* USES CM+1 - CM+4.
*
* CALLS GEA, REM, WCM.
*
* MACROS MONITOR.
E1C BSS 0 ENTRY
LDD EP
ZJN E1C3 IF *EP* NOT SET
LDD UP
ZJN E1C3 IF *UP* NOT SET
* RETURN STATUS TO USER.
E1C1 RJM GEA GET USER ERROR MESSAGE ADDRESS *EMRA*
ZJN E1C2 IF NO ERROR MESSAGE ADDRESS
LDM ERRMSG,P1 SPECIFY MESSAGE ADDRESS
RJM REM RETURN ERROR MESSAGE
E1C2 LJM UFF UPDATE FET FIELDS AND EXIT
* RECALL/ROLLOUT THE USER.
E1C3 RJM WCM SET MESSAGE IN *MS2W*
LDM SSID CHECK SUBSYSTEM ID
NJN E1C4 IF JOB NOT ROLLABLE
LDM ERRD SET ROLLOUT TIME
STD CM+2
LDM ERRE SET ROLLOUT EST ORDINAL
STD CM+3
LDM ERRC SET FOLDED ROLLOUT EVENT
STD CM+4
ADD CM+3
ADD CM+2
NJN E1C3.1 IF TIMED EVENT ROLLOUT
SOM E1CA SET SCHEDULER ROLLOUT OPTION
ERRNZ ROTE-ROSR-1 CODE DEPENDS ON VALUE
E1C3.1 LDD MA WRITE *ROCM* PARAMETERS TO MB
CWD CM
E1CA LDN ROTE SELECT TIMED/EVENT ROLLOUT
* LDN ROSR (SELECT SCHEDULER ROLLOUT)
STD CM+1
MONITOR ROCM REQUEST ROLLOUT
E1C4 LJM RCL SET FOR PFM RECALL AND EXIT PFM
E2C SPACE 4,15
** E2C - EXIT 2 CASE PROCESSING.
*
* SPECIAL *UP* OR *RT* CONTROLLED FOR STAGE INITIATED
* PROCESSING.
*
* ENTRY (RT) = *RT* BOOLEAN.
* (UP) = *UP* BOOLEAN.
*
* EXIT IF *UP* OR *RT*,
* IF *EMRA*, COPY MESSAGE TO *EMRA* BUFFER.
* SET STATUS IN FET.
* EXIT PFM.
* SET MESSAGE AT *MS1W* IN *CPA* FOR THE JOB.
* IF SSID FIELD ZERO, ROLLOUT JOB.
* RECALL REQUEST.
* EXIT PFM.
E2C BSS 0 ENTRY
LDD UP
ZJN E2C2 IF *UP* NOT SET
E2C1 LJM E1C1 RETURN STATUS TO CALLER
E2C2 LDD RT
NJN E2C1 IF *RT* SET
UJP E1C3 COMPLETE FOR NOT *UP*/*RT*
E3C SPACE 4,15
** E3C - EXIT 3 CASE PROCESSING.
*
* UNCONDITIONALLY ABORT THE REQUESTING JOB.
*
* EXIT MESSAGE ISSUED TO JOB DAYFILE.
* MESSAGE ISSUED TO SYSTEM DAYFILE.
*
* CALLS IDM, UFF.
E3C BSS 0 ENTRY
LDM ERRMSG,P1 ISSUE MESSAGE TO DAYFILE
RJM IDM
* ABORT THE JOB.
LDK STAJ SET *ABORT JOB* STATUS BIT
RAM STAU
LJM UFF UPDATE FET FIELDS AND EXIT
E4C SPACE 4,15
** E4C - EXIT 4 CASE PROCESSING.
*
* SPECIAL *EP*/*IP* OR *EP*/*UP* CONTROLLED FOR TIME DEPENDENT
* PROCESSING WITH RECALL POSSIBILITY.
*
* ENTRY (EP) = *EP* BOOLEAN.
* (UP) = *UP* BOOLEAN.
* (EPOP) = ERROR PROCESSING OPTIONS.
*
* EXIT IF *EP*/*IP*, OR IF *EP*/*UP* AND NON-ROLLABLE JOB,
* IF EMRA, COPY MESSAGE TO EMRA BUFFER.
* SET STATUS IN FET.
* EXIT PFM.
* RECALL REQUEST.
* EXIT PFM.
*
* CALLS E1C1, RCL.
E4C BSS 0 ENTRY
LDD EP
ZJN E4C1 IF *EP* NOT SET
LDM EPOP
LPN 1
NJN E4C0 IF *IP* SET
LDD UP
ZJN E4C1 IF *UP* NOT SET
LDM SSID CHECK SUBSYSTEM ID
ZJN E4C1 IF ROLLABLE JOB
E4C0 LJM E1C1 RETURN STATUS TO USER
E4C1 RJM WCM SET MESSAGE IN *MS2W*
LJM RCL RECALL *PFM*
E5C SPACE 4,10
** E5C - EXIT 5 CASE PROCESSING.
*
* SECURITY VIOLATION PROCESSING - ABORT JOB WITH *SVET* ERROR.
* IF CALLER IS *SSJ=*, PROCESS AS NORMAL ERROR.
*
* ENTRY (P1) = ERROR CODE.
*
* EXIT TO *E0C* IF CALLER IS *SSJ=*.
* MESSAGE ISSUED TO JOB DAYFILE.
* MESSAGE ISSUED TO SYSTEM DAYFILE.
* (SVET) = SECURITY VIOLATION ERROR FLAG SET.
*
* CALLS IDM, UFF.
E5C BSS 0 ENTRY
LDM SSJS
NJP E0C IF CALLER IS *SSJ=*
LDM ERRMSG,P1 ISSUE MESSAGE TO DAYFILE
RJM IDM
* ABORT THE JOB WITH AN *SVET* ERROR.
LDN SVET SET SECURITY VIOLATION ERROR FLAG
STD CM+1
MONITOR CEFM
LJM UFF UPDATE FET FIELDS AND EXIT
E6C SPACE 4,25
** E6C - EXIT 6 CASE PROCESSING.
*
* SPECIAL *RT* CONTROLLED FOR TIME DEPENDENT PROCESSING OF
* AN INACCESSIBLE MASS STORAGE DEVICE.
*
* ENTRY (P1) = ERROR CODE.
* (P2) = EST ORDINAL OF DEVICE.
* (RT) = *RT* BOOLEAN.
* (PWRF) = RESTART FLAGS FOR *PFM* RECALL.
* *RT* IS SET IF THE CALLER IS A SUBSYSTEM.
*
* EXIT TO *E1C1*, IF *RT* SET, TO RETURN STATUS TO CALLER.
* TO *1RJ* TO ROLLOUT THE JOB.
*
* USES IR+4, MP - MP+4.
*
* CALLS PAF, *1RJ*.
*
* MACROS EXECUTE.
E6C BSS 0 ENTRY
LDD RT
NJP E1C1 IF *RT* SET
* SELECT EVENT ROLLOUT THROUGH OVERLAY *1RJ*.
RJM PAF PROCESS PF ACTIVITY COUNT AND FNT
LDN ZERL SET PARAMETER WORD FOR *PFM* RECALL
CRD MP
LDM PWRF RESTART FLAGS
STD MP
LDD P1 ERROR CODE
STD MP+1
LDD P2 SET EST ORDINAL
STD IR+4
EXECUTE 1RJ ROLLOUT THE JOB
E7C SPACE 4,10
** E7C - EXIT 7 CASE PROCESSING.
*
* SPECIAL PROCESSING FOR TYPE 2 ERRORS IN *PURGE*. ISSUE THE
* ERROR MESSAGE TO THE ERROR LOG BUT DO NOT ABORT THE JOB.
*
* NOTE THAT CATALOG ENTRY FOR THE FILE HAS BEEN DELETED BEFORE
* THIS OVERLAY IS INVOKED IN THIS CASE.
*
* EXIT MESSAGE ISSUED TO ERROR LOG.
* ERROR CODE CLEARED.
*
* CALLS SEQ, UFF.
E7C BSS 0 ENTRY
RJM SEQ ISSUE ERROR LOG MESSAGE
LDN 0 CLEAR ERROR CODE
STD P1
LJM UFF UPDATE FET FIELDS AND EXIT
TITLE SUBROUTINES.
CPN SPACE 4,10
** CPN - COPY NAME.
* COPIES NAME WITH BLANK FILL.
*
* ENTRY (T3) = SOURCE ADDRESS.
* (A) = DESTINATION ADDRESS.
*
* USES T3, P3.
CPN SUBR ENTRY/EXIT
STD P3 SAVE DESTINATION ADDRESS
ADN 3
STM CPNA
CPN1 LDI T3
SCN 77
NJN CPN2 IF NOT NULL CHARACTER
LDC 100*1R
CPN2 STI P3
LDI T3
LPN 77
NJN CPN3 IF NOT NULL CHARACTER
LDN 1R
CPN3 RAI P3 ASSEMBLE CHARACTERS
AOD T3
AOD P3
LMC **
CPNA EQU *-1
NJN CPN1 IF NOT LAST FULL BYTE
LDI T3
SCN 77
ZJN CPNX IF NULL CHARACTER
LMN 1R,
STI P3
UJN CPNX RETURN
GEA SPACE 4,15
** GEA - GET ERROR MESSAGE RETURN ADDRESS.
*
* ENTRY (EP) = ERROR PROCESSING STATUS.
*
* EXIT (A) = 0 IF *EP* OR *EMRA* NOT SPECIFIED.
* (A) = *EMRA* ADDRESS IF *EP* AND *EMRA* SPECIFIED.
GEA SUBR ENTRY/EXIT
LDD EP
ZJN GEAX IF *EP* BOOLEAN NOT SET IN *FET*
LDM EMRA FORM *EMRA* BASE ADDRESS
LPN 37
SHN 14
ADM EMRA+1
UJN GEAX RETURN WITH*EMRA*
IDM SPACE 4,10
** IDM - ISSUE DAYFILE MESSAGE.
*
* ENTRY (A) = ADDRESS OF MESSAGE PLUS DESTINATION.
*
* EXIT ISSUES MESSAGE WITH FET ADDRESS.
*
* USES T1 - T4.
*
* CALLS DFM, C2D.
IDM SUBR ENTRY/EXIT
STD T4 SAVE ADDRESS
STD T1
SHN -14
STD T3
LDM SFAA
LPN 77
ADM SFAA+1
ZJN IDM1 IF NO FET ADDRESS PRESET
LDM EPOP CHECK ADDRESS SUPPRESS BIT
LPN 20
ZJN IDM2 IF FET ADDRESS NOT TO BE SUPPRESSED
IDM1 LJM IDM6 ISSUE MESSAGE WITHOUT ADDRESS
* FIND END OF MESSAGE.
IDM2 LDI T1
SHN -6
ZJN IDM3 IF END OF MESSAGE
LDI T1
LPN 77
ZJN IDM4 IF END OF MESSAGE
AOD T1
UJN IDM2 LOOP
IDM3 SOD T1 REPLACE *.* WITH *,*
LDI T1
SCN 77
ADN 1R,
STI T1
AOD T1
UJN IDM5 ADD FET ADDRESS TO MESSAGE
IDM4 LDC 2R, REPLACE *.* WITH *,*
STI T1
AOD T1
* STORE * AT * AT END OF MESSAGE.
IDM5 LDC 2R A
STI T1
AOD T1
LDC 2RT
STI T1
AOD T1
* SET FET ADDRESS IN MESSAGE.
RJM SFA CONVERT FET ADDRESS
SHN 14
SBD RA
SHN 6
STD T2
SHN -14
RJM C2D CONVERT DIGITS
STI T1
AOD T1
LDD T2
SHN -6
RJM C2D CONVERT DIGITS
STI T1
AOD T1
LDD T2
RJM C2D CONVERT DIGITS
STI T1
AOD T1
LDC 2R.
STI T1
AOD T1
LDN 0 SET ZERO BYTE
STI T1
* ISSUE MESSAGE.
IDM6 LDD T3 RESET MESSAGE ADDRESS
SHN 14
ADD T4
RJM DFM ISSUE MESSAGE
LJM IDMX RETURN
MEC SPACE 4,15
** MEC - MODIFY ERROR CODES.
*
* ENTRY (P1) = ERROR CODE FOR POSSIBLE MODIFICATION.
*
* EXIT (P1) = ERROR CODE TO BE REPORTED IN THE *FET*.
* CHANGE CODE WHICH REPORTS A WAIT FOR AN INACCESSIBLE
* DEVICE TO *PF UTILITY ACTIVE*.
MEC2 LMK /ERRMSG/WID&/ERRMSG/FIA
NJN MECX IF NOT *WID*, RETURN
LDK /ERRMSG/PFA CHANGE ERROR CODE TO *PFA*
STD P1
MEC SUBR ENTRY/EXIT
LDD P1 CHECK FOR ERROR CODES TO MODIFY
LMN /ERRMSG/FDA
ZJN MEC1 IF *FDA* THEN MODIFY
LMN /ERRMSG/FIA&/ERRMSG/FDA
NJN MEC2 IF NOT *FIA*
MEC1 LDN /ERRMSG/FNF CHANGE ERROR CODE TO *FNF*
STD P1
UJN MECX RETURN
MFN SPACE 4,10
** MFN - MERGE FILE NAME WITH MESSAGE.
*
* ENTRY (A) = FIRST WORD ADDRESS OF MESSAGE.
* (FN - FN+3) = FILE NAME.
*
* EXIT (A) = FIRST WORD ADDRESS OF MESSAGE.
*
* USES T1 - T3.
MFN SUBR ENTRY/EXIT
STD T1 SAVE MESSAGE ADDRESS
LDC MBUF ASSEMBLY AREA
STD T2
LDN 1R BLANK FIRST CHARACTER
STI T2
AOD T2
LDN FN
STD T3
LDD FN+3 CLEAR TRAILING CONTROL INFORMATION
SCN 77
STD FN+3
MFN1 LDI T3 GET BYTE
SHN -6 UPPER CHARACTER
ZJN MFN2 IF END OF FILE NAME
STI T2
AOD T2
LDI T3 LOWER CHARACTER
LPN 77
ZJN MFN2 IF END OF FILE NAME
STI T2
AOD T2
AOD T3
UJN MFN1 LOOP TO END OF FILE NAME
MFN2 LDN 1R INSERT SPACE
STI T2
AOD T2
MFN3 LDI T1 UPPER MESSAGE CHARACTER
SHN -6
STI T2
ZJN MFN4 IF END OF MESSAGE
AOD T2
LDI T1 LOWER MESSAGE CHARACTER
LPN 77
STI T2
ZJN MFN4 IF END OF MESSAGE
AOD T2
AOD T1
UJN MFN3 MOVE NEXT CHARACTER
MFN4 STM 1,T2 SET END OF MESSAGE
STM 2,T2
LDC MBUF
STD T1
STD T3
MFN5 LDI T1
ZJN MFN6 IF END OF MESSAGE REACHED
SHN 6
LMM 1,T1
STI T3
AOD T3
LDN 2
RAD T1
UJN MFN5 LOOP TO COMPLETE MESSAGE
MFN6 STI T3 SET END OF MESSAGE
LDC MBUF EXIT WITH (A) = MESSAGE ADDRESS
LJM MFNX RETURN
PAF SPACE 4,15
** PAF - PROCESS PF ACTIVITY COUNT AND LOCAL FILE FNT.
*
* ENTRY (EPFA) = EST ORDINAL OF DEVICE IF PF ACTIVITY
* TO BE DECREMENTED.
* (FNTA) = FNT ADDRESS OF LOCAL FILE.
*
* EXIT LOCAL FILE FNT SET COMPLETE.
* PF ACTIVITY COUNT DECREMENTED IF IT WAS SET.
*
* USES CM - CM+4, FS - FS+4.
*
* MACROS MONITOR.
PAF SUBR ENTRY/EXIT
* DECREMENT PF ACTIVITY COUNT.
LDM EPFA EST ORDINAL
ZJN PAF1 IF ACTIVITY NOT SET
STD CM+1
LDN DPAS DECREMENT PF ACTIVITY COUNT
STD CM+3
MONITOR STBM
* SET LOCAL FILE FNT COMPLETE.
PAF1 LDM FNTA
STD FA
ZJN PAFX IF NO LOCAL FILE FNT, RETURN
NFA FA,R
ADN FSTL
CRD FS
LDD FS+4 SET FST COMPLETE
SCN 1
ADN 1
STD FS+4
NFA FA,R
ADN FSTL
CWD FS
UJN PAFX RETURN
PEA SPACE 4,15
** PEA - PROCESS ERRORS REQUIRING SPECIAL ACTION.
*
* ENTRY (P1) = ERROR CODE.
* (EP) = *EP* BOOLEAN FROM *FET*.
* (SEPB) = EXIT CASE.
*
* EXIT IF THE USER IS NOT PROCESSING ERRORS;
* SET *TKET* ERROR FLAG IF *PRL* ERROR.
* SET *FLET* ERROR FLAG IF *LFL* ERROR.
* THE *STAJ* (ABORT JOB) STATUS BIT IS SET.
*
* USES CM - CM+4.
*
* MACROS MONITOR.
PEA SUBR ENTRY/EXIT
LDD EP
NJN PEAX IF *EP* SPECIFIED
LDD P1 CHECK ERROR TYPE
LMN /ERRMSG/PRL
NJN PEA1 IF NOT TRACK LIMIT
LDN TKET SET *TKET* ERROR FLAG
STD CM+1
UJN PEA2 SET TRACK LIMIT
PEA1 LMN /ERRMSG/LFL&/ERRMSG/PRL CHECK ERROR TYPE
NJN PEA3 IF NOT FILE LIMIT
LDN FLET SET *FLET* ERROR FLAG
STD CM+1
PEA2 MONITOR CEFM
UJN PEAX RETURN
PEA3 LDM SEPB
NJN PEAX IF SPECIAL EXIT CASE
LDK STAJ SET *ABORT JOB* STATUS BIT
RAM STAU
UJN PEAX RETURN
PEM SPACE 4,15
** PEM - PROCESS ERROR MESSAGE.
*
* ENTRY (P1) = ERROR CODE.
* (EP) = *EP* BOOLEAN FROM FET (0 OR 1).
*
* EXIT ERROR MESSAGE ISSUED BY TYPE.
*
* USES T1.
*
* CALLS DFM, GEA, IDM, MFN, PEA, REM, SEQ.
PEM SUBR ENTRY/EXIT
LDD P1
ZJN PEMX IF NO ERROR (*RPFSTAT* REQUEST)
LDM ERRCLS,P1 ERROR TYPE OR CLASS
STD T1
SHN 1 DETERMINE MESSAGE CODE BASE ADDRESS
ADC TDMO
STM PEMB SET MESSAGE CODE ADDRESS
LDM PEMA,T1 ESTABLISH CASE OF MESSAGE TYPE
STM PEMA
LJM PEM1 TYPE = 0 (FILE NAME REQUIRED)
PEMA EQU *-1
CON PEM2 TYPE = 1 (ISSUE TO JOB DAYFILE ONLY)
CON PEM5 TYPE = 2 (SYSTEM ERROR)
CON PEM6 TYPE = 3 (NO MESSAGE ERROR)
* PROCESS TYPE 0 ERROR MESSAGE.
PEM1 LDM ERRMSG,P1 BASE ADDRESS OF MESSAGE
RJM MFN MERGE FILENAME AND MESSAGE
STM ERRMSG,P1 SET NEW ERROR MESSAGE ADDRESS
* PROCESS TYPE 1 ERROR MESSAGE.
PEM2 RJM GEA GET USER ERROR MESSAGE ADDRESS *EMRA*
ZJN PEM3 IF ERMSG AND *EP* NOT SPECIFIED
LDM ERRMSG,P1 SPECIFY MESSAGE ADDRESS
RJM REM RETURN ERROR MESSAGE
UJN PEM4 RETURN
PEM3 RJM PEA PROCESS ERRORS REQUIRING SPECIAL ACTION
LDM **,EP GET MESSAGE OPTION
PEMB EQU *-1 (TABLE ADDRESS FOR MESSAGE TYPE)
SHN 14 POSITION
MJN PEM4 IF NO MESSAGE TO ISSUE
ADM ERRMSG,P1 ADD MESSAGE ADDRESS
RJM IDM ISSUE MESSAGE
PEM4 LJM PEMX RETURN
* PROCESS TYPE 2 ERROR MESSAGE.
* SYSTEM ERROR - ISSUE *SYSTEM ERROR* TO JOB DAYFILE.
PEM5 LDC PEMD+CPON *SYSTEM ERROR*
RJM DFM
RJM SEQ ISSUE ERROR LOG MESSAGE
UJN PEM2 COMPLETE ERROR PROCESSING
* PROCESS TYPE 3 ERROR MESSAGE.
PEM6 LDM ERRMSG,P1 SET MESSAGE DESTINATION ADDRESS
STM PEMC
LDD CP READ MESSAGE AT CP AREA
ADN MS1W
CRM **,TR
PEMC EQU *-1
LJM PEM2 COMPLETE ERROR PROCESSING
PEMD DATA C*SYSTEM ERROR.*
TDMO SPACE 4,10
** TDMO - TABLE OF DAYFILE MESSAGE OPTIONS.
*
*T 12/(OPTION IF CP ABORTING),12/(OPTION IF *EP* SET)
* BIT 5 IS SET IF NO MESSAGE IS TO BE ISSUED.
TDMO BSS 0
CON 0,CPON/10000B TYPE 0
CON 0,CPON/10000B TYPE 1
CON NMSN/10000B,NMSN/10000B TYPE 2
CON 40B,40B TYPE 3
PPF SPACE 4,15
** PPF - PROCESS SPECIAL *PFM* FILES.
*
* ENTRY (FNTA) = LOCAL FILE FNT ADDRESS.
* (ERRB) = 0 IF LOCAL FILE CREATED BY *PFM*.
* (FNTB) = /PFM*PFN/ FNT ADDRESS.
* (FNTC) = /PFM*ILK/ FNT ADDRESS.
* (FNTD) = /PFM*APF/ FNT ADDRESS.
*
* EXIT FILES UNLOADED IF CREATED BY *PFM*.
*
* CALLS *0DF*.
PPF SUBR ENTRY/EXIT
LDN 1
STM LOCF-1 SET *UNLOAD* OPTION FOR *0DF*
* PROCESS LOCAL FILE.
LDM FNTA
ZJN PPF1 IF NO LOCAL FILE FNT
STD FA
LDM ERRB
NJN PPF1 IF LOCAL FILE NOT CREATED BY *PFM*
PPFA LDN 0
* LDN 1 (*SYOT* + *GET* + *FILE LENGTH ERROR*)
NJN PPF1 IF FILE SHOULD NOT BE RETURNED
EXECUTE 0DF,LOCF
MJN PPF1 IF DEVICE INACCESSIBLE
LDN 0 CLEAR LOCAL FILE FNT ADDRESS
STM FNTA
* PROCESS /PFM*PFN/.
PPF1 LDM FNTB GET FNT ADDRESS
ZJN PPF2 IF FILE NOT PRESENT
STD FA
EXECUTE 0DF,LOCF
* PROCESS /PFM*ILK/.
PPF2 LDM FNTC GET FNT ADDRESS
ZJN PPF3 IF FILE NOT PRESENT
STD FA
EXECUTE 0DF,LOCF
* PROCESS /PFM*APF/.
PPF3 LDM FNTD GET FNT ADDRESS
ZJN PPF4 IF FILE NOT PRESENT
STD FA
EXECUTE 0DF,LOCF
PPF4 LJM PPFX RETURN
RCL SPACE 4,15
** RCL - RECALL PFM.
*
* ENTRY (P1) = ERROR CODE.
* (PWRF) = RESTART FLAGS.
*
* EXIT (CN - CN+4) = INPUT REGISTER FOR *PFM* RECALL.
* (FN - FN+4) = RECALL REQUEST FOR MONITOR.
* (MP - MP+4) = PARAMETER WORD FOR *PFM* RECALL.
* (AIPF, AIPF+1) = 0.
* (STAU) = *STRP* BIT SET TO RECALL *PFM*.
* TO *3PU* TO RECALL *PFM*.
RCL BSS 0 ENTRY
LDN 0 CLEAR PF ACCUMULATOR INCREMENT
STM AIPF
STM AIPF+1
LDN ZERL
CRD FN SET RECALL REQUEST
CRD MP SET PARAMETER WORD
LDM PWRF RESTART FLAGS
STD MP
LDD P1 ERROR CODE
STD MP+1
LDD IA READ INPUT REQUEST REGISTER
CRD CN
LDD MP+1 CHECK ERROR CODE
LMK /ERRMSG/RTR
NJN RCL2 IF NOT RETRY REQUEST
LDD CC COMMAND CODE
LMN CCRS
NJN RCL1 IF NOT *RPFSTAT* REQUEST
LDD CN+2 SET ORIGINAL COMMAND CODE IN REQUEST
SCN 77
LMM PWCC
STD CN+2
RCL1 LDN 0
UJN RCL3 SET DELAY TO 0 MILLISECONDS
RCL2 LDC 250D SET DELAY TO 250D MILLISECONDS
RCL3 STD FN+4
LDC PTMF SET TIMED RECALL
STD FN+1
LDK STRP SET *RECALL PFM* STATUS BIT
RAM STAU
EXECUTE 3PU RECALL *PFM*
REM SPACE 4,10
** REM - RETURN ERROR MESSAGE.
*
* ENTRY (A) = ADDRESS OF ERROR MESSAGE.
* (EMRA - EMRA+1) ADDRESS FOR MESSAGE RETURN.
*
* CALLS NONE
*
* USES T1, T2, T3
REM SUBR
STM REMA SAVE MESSAGE ADDRESS
STD T1
LDN 5 SET BYTES PER WORD
STD T2
LDN 1
STD T3 INITIALIZE CM WORD COUNT
REM1 LDI T1 SEARCH FOR END OF MESSAGE
ZJN REM2 IF ZERO BYTE FOUND
AOD T1
SOD T2
NJN REM1 IF NOT FULL CM WORD
AOD T3
LDN 5
STD T2 RESET BYTES PER WORD
UJN REM1 CONTINUE TO END OF MESSAGE
REM2 AOD T1 CLEAR REMAINDER OF MESSAGE TO FULL WORD
SOD T2
ZJN REM3 IF FULL CM WORD
LDN 0
STI T1 CLEAR MESSAGE TAIL
UJN REM2 LOOP FOR FULL CM WORD
REM3 LDM EMRA STORE MESSAGE
LPN 37
SHN 6
ADD RA
SHN 6
ADM EMRA+1
CWM *,T3 SEND MESSAGE TO CENTRAL
REMA EQU *-1
LJM REMX RETURN
SEQ SPACE 4,12
** SEQ - SET EQUIPMENT INFORMATION IN MESSAGE.
*
* SETS THE DEVICE TYPE, EST ORDINAL AND DEVICE NUMBER INTO
* THE ERROR MESSAGE AND ISSUES IT TO THE ERROR LOG. ALSO
* ISSUES TO THE ERROR LOG EITHER A MESSAGE SPECIFYING FAMILY,
* FILE NAME AND USER INDEX, OR A MESSAGE SPECIFYING TRACK
* AND SECTOR.
*
* ENTRY (CC) = COMMAND CODE.
* (P1) = ERROR CODE.
* (P2) = EST ORDINAL.
* (ERRC) = TRACK (FOR *BCS* ERROR).
* (ERRD) = SECTOR (FOR *BCS* ERROR).
*
* CALLS CFN, C2D, DFM.
*
* USES T2, T3, CM - CM+4.
*
* MACROS SFA.
SEQ6 LDM ERRMSG,P1 ISSUE MESSAGE TO ERRLOG
ADC ERLN
RJM DFM
SEQA LDN 0
* LDN 1 (EXTENDED MESSAGE REQUIRED)
ZJN SEQX IF EXTENDED MESSAGE NOT REQUIRED
LDC SEQB+ERLN ISSUE FM/PF/UI EXTENDED MESSAGE
* LDC SEQD+ERLN (ISSUE TRACK/SECTOR EXTENDED MESSAGE)
SEQE EQU *-1
RJM DFM
SEQF UJN SEQX RETURN
* PSN (ERROR IDLE SET)
LDC SEQG+ERLN *EQXXX, ERROR IDLE SET.*
RJM DFM
SEQ SUBR ENTRY/EXIT
LDD P1
LMN /ERRMSG/RSE
ZJN SEQ6 IF RESEX ERROR
AOM SEQA FLAG EXTENDED MESSAGE REQUIRED
LDM ERRMSG,P1 SET MESSAGE ADDRESS
STD T2
LDD P2 CONVERT UPPER TWO DIGITS OF EST ORDINAL
SHN -3
RJM C2D
STM 1,T2
STM SEQB+1
STM SEQD+1
STM SEQG+1
LDD P2 CONVERT LOWER DIGIT OF EST ORDINAL
LPN 7
SHN 6
ADC 2R0,
STM 2,T2
STM SEQB+2
STM SEQD+2
STM SEQG+2
SFA EST,P2 READ EST ENTRY
ADK EQDE
CRD CM
LDD CM+4 READ PFGL WORD OF MST
SHN 3
ADN PFGL
CRD CM
LDD CM+3 CONVERT DEVICE NUMBER
RJM C2D
STM 4,T2
LDD P1
LMN /ERRMSG/BCS
NJN SEQ1 IF NOT *BAD CATALOG/PERMIT SECTOR*
LJM SEQ5 PROCESS TRACK/SECTOR ERROR MESSAGE
* SET UP *EQXXX, FM= ,PF= ,UI= .* MESSAGE.
SEQ1 LDN CM COPY FAMILY NAME
STD T3
LDC SEQB+5 COPY NAME TO BUFFER
RJM CPN
LDD CC
LMN CCCT
NJN SEQ2 IF NOT CATLIST ERROR
LDD FN
NJN SEQ2 IF FILE NAME DEFINED
LDC SEQC SET FILE NAME TO *PERMITS*
UJN SEQ4 SET *PERMITS* ADDRESS
SEQ2 LDM PFFN CHECK PERMANENT FILE NAME
ZJN SEQ3 IF NOT SPECIFIED IN FET
LDC PFFN SET ADDRESS OF PERMANENT FILE NAME
UJN SEQ4 SET ADDRESS
SEQ3 LDN FN SET ADDRESS OF LOCAL FILE NAME
SEQ4 STD T3
LDC SEQB+13
RJM CPN
LDD UI+1 COPY USER INDEX
RJM C2D
STM SEQB+23
LDD UI+1
SHN -6
RJM C2D
STM SEQB+22
LDD UI
RJM C2D
STM SEQB+21
LJM SEQ6 ISSUE MESSAGES
* SET UP *EQXXX, TK= ,SC= .* MESSAGE.
SEQ5 LDM ERRC CONVERT TRACK NUMBER
SHN -6
RJM C2D
STM SEQD+5
LDM ERRC
RJM C2D
STM SEQD+6
LDM ERRD CONVERT SECTOR NUMBER
SHN -6
RJM C2D
STM SEQD+11
LDM ERRD
RJM C2D
STM SEQD+12
LDN SEQD-SEQB FORCE TRACK/SECTOR OF EXTENDED MESSAGE
RAM SEQE
LJM SEQ6 ISSUE MESSAGES
SEQB DATA C*EQXXX, FM= , PF= , UI= .*
SEQC DATA C*PERMITS*
SEQD DATA C*EQXXX, TK= ,SC= .*
SEQG DATA C*EQXXX, ERROR IDLE SET.*
UFF SPACE 4,15
** UFF - UPDATE FET FIELDS.
*
* ENTRY (P1) = ERROR CODE.
*
* EXIT TO *3RT*.
* (FN - FN+4) = FET + 0 WITH ERROR STATUS SET.
* (FS - FS+4) = FET + 1.
* (STAU) = *STDS* FLAG SET TO DROP PP.
*
* USES T1, T2.
*
* CALLS MEC, SFA, *3PU*.
UFF BSS 0 ENTRY
RJM MEC MODIFY ERROR CODE IF NEEDED
RJM SFA READ FIRST WORD OF *FET*
ZJN UFF1 IF NO FET ADDRESS
CRD FN
ADN 1 READ FET + 1
CRD FS
LDD P1 FORM MSB OF ERROR CODE
SHN -2
STD T2
LDD P1 FORM LSB OF ERROR CODE
LPN 3
SHN 13-1
ADN 1 SET COMPLETE BIT
STD T1
LDD FN+3 MERGE WITH END OF FILE NAME
SCN 77
ADD T2
STD FN+3
LDD FN+4
LPC 1776 CLEAR COMPLETE AND ERROR CODE BITS
ADD T1
STD FN+4
UFF1 LDK STDS SET *DROP PP* STATUS BIT
RAM STAU
EXECUTE 3PU DROP PP
WCM SPACE 4,15
** WCM - WRITE CONTROL POINT MESSAGE.
*
* ENTRY (P1) = ERROR CODE.
*
* EXIT MESSAGE WRITTEN TO *MS2W* OF JOB CONTROL POINT.
*
* USES T1.
*
* CALLS MFN.
WCM SUBR ENTRY/EXIT
LDM ERRCLS,P1 CHECK MESSAGE TYPE
NJN WCM1 IF NOT TYPE 0 MESSAGE
LDM ERRMSG,P1 MERGE FILE NAME WITH MESSAGE
RJM MFN
UJN WCM2 SETUP TO WRITE MESSAGE
WCM1 LDM ERRMSG,P1
WCM2 STM WCMA SET FOR MESSAGE COPY TO *MS2W*
ADN 5*3-1 FORCE END OF LINE
STM WCMB+1
LDN 0
WCMB STM *
LDD CP SET DESTINATION ADDRESS
ADN MS2W
CWM *,TR COPY MESSAGE TO *MS2W* OF JOB
WCMA EQU *-1
UJN WCMX RETURN
TITLE ERROR MESSAGES.
** ERROR MESSAGES.
*
* FORMAT (FIRST WORD), ERROR DESTINATION FLAG.
* (SECOND WORD), FIRST WORD ADDRESS OF MESSAGE.
*
* CONTENTS OF FIRST WORD.
* 0, SEND FILE NAME MESSAGE TO CONTROL POINT DAYFILE.
* 1, SEND MESSAGE TO CONTROL POINT DAYFILE.
* 2, SEND MESSAGE TO CONTROL POINT DAYFILE AND ERRORLOG.
LIST -R
MXER EQU /ERRMSG/MXER
ERRCLS INDEX
FBS ERRMSG 0,(BUSY.)
FNF ERRMSG 0,(NOT FOUND.)
EFL ERRMSG 0,(EMPTY.)
NMS ERRMSG 0,(NOT ON MASS STORAGE.)
FAP ERRMSG 0,(ALREADY PERMANENT.)
IFT ERRMSG 0,(INCORRECT FILE TYPE.)
FNE ERRMSG 1,( FILE NAME ERROR.)
IUA ERRMSG 1,( USER ACCESS NOT VALID.)
IDR ERRMSG 1,( INCORRECT DEVICE REQUEST.)
FTL ERRMSG 1,( FILE TOO LONG.)
ILR ERRMSG 1,( PFM INCORRECT REQUEST.)
PFN ERRMSG 1,( DEVICE UNAVAILABLE.)
DAD ERRMSG 1,( DIRECT ACCESS DEVICE ERROR.)
PFA ERRMSG 1,( PF UTILITY ACTIVE.)
DTE ERRMSG 1,( DATA TRANSFER ERROR.)
COF ERRMSG 1,( TOO MANY PERMANENT FILES.)
COS ERRMSG 1,( TOO MUCH INDIRECT ACCESS FILE SPACE.)
SPN ERRMSG 1,( PRUS REQUESTED UNAVAILABLE.)
IOE ERRMSG 1,( I/O SEQUENCE ERROR.)
LFL ERRMSG 1,( LOCAL FILE LIMIT.)
PRL ERRMSG 1,( PRU LIMIT.)
PLE ERRMSG 1,( PERMIT LIMIT EXCEEDED.)
PAE ERRMSG 1,( PFM ARGUMENT ERROR.)
RSE ERRMSG 2,( RESEX FAILURE.)
TKL ERRMSG 2,(EQXXX,DNYY, TRACK LIMIT.)
FLE ERRMSG 2,(EQXXX,DNYY, FILE LENGTH ERROR.)
RIN ERRMSG 2,(EQXXX,DNYY, RANDOM INDEX ERROR.)
DAF ERRMSG 2,(EQXXX,DNYY, DIRECT ACCESS FILE ERROR.)
RPE ERRMSG 2,(EQXXX,DNYY, REPLACE ERROR.)
ABT ERRMSG 2,(EQXXX,DNYY, PFM ABORTED.)
MSE ERRMSG 2,(EQXXX,DNYY, MASS STORAGE ERROR.)
EDA ERRMSG 1,( ERROR IN FILE DATA.)
EPT ERRMSG 1,( ERROR IN PERMIT DATA.)
EDP ERRMSG 1,( DATA/PERMIT ERRORS.)
FLC ERRMSG 1,( EOI CHANGED BY RECOVERY.)
NEM ERRMSG 3,( )
RS2 ERRMSG 1,() RESERVED
RS3 ERRMSG 1,() RESERVED
RS4 ERRMSG 1,() RESERVED
FSE ERRMSG 2,(EQXXX,DNYY, FILE BOI/EOI/UI MISMATCH.)
SSE ERRMSG 2,(EQXXX,DNYY, SYSTEM SECTOR ERROR.)
BCS ERRMSG 2,(EQXXX,DNYY, BAD CATALOG/PERMIT SECTOR.)
TNR ERRMSG 2,(EQXXX,DNYY, TRACK NOT RESERVED.)
PPE ERRMSG 0,(PERMANENT ERROR.)
PSI ERRMSG 0,(STAGE INITIATED.)
PWE ERRMSG 0,(WAITING FOR SUBSYSTEM.)
FIN ERRMSG 0,(INTERLOCKED.)
FDA ERRMSG 0,(IS DIRECT ACCESS.)
FIA ERRMSG 0,(IS INDIRECT ACCESS.)
FEO ERRMSG 0,(IS EXECUTE ONLY.)
SGD ERRMSG 1,( PF STAGING DISABLED.)
IPA ERRMSG 1,( INCORRECT PFC ADDRESS.)
PVE ERRMSG 1,( PFC VERIFICATION ERROR.)
FND ERRMSG 1,( FILE NOT DISK RESIDENT.)
INA ERRMSG 1,() INTERLOCK NOT AVAILABLE (NO MESSAGE)
AIO ERRMSG 1,( NO ALTERNATE STORAGE COPY OF FILE.)
ASE ERRMSG 1,( ALTERNATE STORAGE ERROR.)
FTF ERRMSG 1,( FNT FULL.)
ICU ERRMSG 1,( INCORRECT CATALOG UPDATE.)
PEA ERRMSG 1,( PFM EXCESS ACTIVITY.)
NVX ERRMSG 1,( NOT VALIDATED TO SET XD/XT.)
DEM ERRMSG 1,( XD/XT EXCEEDS MAXIMUM.)
JCA ERRMSG 1,( JOB CANNOT ACCESS FILE.)
LNJ ERRMSG 1,( ACCESS LEVEL NOT VALID FOR JOB.)
WDP ERRMSG 1,( WRITE-DOWN OF DATA PROHIBITED.)
CNJ ERRMSG 1,( ACCESS CATEGORIES NOT VALID FOR JOB.)
LNP ERRMSG 1,( ACCESS LEVEL NOT VALID ON PF DEVICE.)
NVD ERRMSG 1,( NOT VALID TO DOWNGRADE DATA.)
NTD ERRMSG 0,(- NO TEMP DEVICE FOUND.)
LNF ERRMSG 1,( ACCESS LEVEL NOT VALID FOR FILE.)
TPE ERRMSG 0,(TEMPORARY ERROR, TRY LATER.)
WNF ERRMSG 1,( WAITING FOR NFL.)
WID ERRMSG 1,( WAITING - INACCESSIBLE DEVICE.)
RTR ERRMSG 3,() REQUEST BEING RETRIED BY PFM (NO MESSAGE)
ECD ERRMSG 1,( ERROR IN CATLIST CONTINUATION DATA.)
INDEX MXER
ERRMSG INDEX
ERRMT HERE
INDEX MXER
LIST *
USE LITERALS
SPACE 4,10
* COMMON DECKS.
*CALL COMPACS
*CALL COMPCTI
*CALL COMPC2D
*CALL COMPSES
*CALL COMPTGB
* ACCOUNT FILE MESSAGE BUFFER.
SVM DATA C*MPNF, *
BSSZ 14
SVMA DATA 2H, MESSAGE SEPARATOR
CON 0 END OF STRING
SVMB DATA 2H. MESSAGE TERMINATOR
CON 0
SPACE 4,10
LOCF EQU *+5 ZERO LEVEL OVERLAY ADDRESS
ERRNG BFMS-LOCF-ZDFL *0DF* OVERFLOW
TITLE OVERLAYABLE SUBROUTINES.
CAD SPACE 4,10
** CAD - CHECK FOR ACCESS DENIED.
*
* ENTRY (P1) = ERROR MESSAGE.
* (PFPN) = OPTIONAL PACK NAME.
* (PFOU) = ALTERNATE USER NAME.
*
* EXIT *MPNF* ACCOUNT FILE MESSAGE ISSUED ON *FNF* ERRORS.
*
* CALLS ACS, DFM, SFN.
*
* USES T1, FN - FN+4.
CAD SUBR ENTRY/EXIT
LDD P1
LMN /ERRMSG/FNF
NJN CADX IF NOT * FILE NOT FOUND.*
LDM PFOU
ZJN CADX IF NOT AN ALTERNATE USER
LDD MA SAVE FN - FN+4
CWD FN
CRM CADA,ON
LDM PFFN GET PERMANENT FILE NAME
ZJN CAD1 IF PF NAME NOT SPECIFIED
LDN PFFN-PFSN
CAD1 ADC PFSN
RJM SFN
LDC SVM+3 INITIALIZE MESSAGE POINTER FOR ACS CALLS
STD T1
LDN FN INSERT FILE NAME IN MESSAGE BUFFER
RJM ACS
LDC SVMA APPEND COMMA SEPARATOR
RJM ACS
LDC PFOU SET USER NAME IN MESSAGE BUFFER
RJM SFN
LDN FN
RJM ACS
LDC SVMA APPEND COMMA SEPARATOR
RJM ACS
LDM PFPN CHECK FOR PACK NAME
ZJN CAD2 IF NO PACK NAME
LDC PFPN SET PACK NAME IN MESSAGE BUFFER
RJM SFN
LDN FN
RJM ACS
CAD2 LDC SVMB APPEND MESSAGE TERMINATOR
RJM ACS
LDC SVM+ACFN ISSUE DAYFILE MESSAGE
RJM DFM
LDC CADA RESTORE FILE NAME
RJM SFN
LJM CADX RETURN
CADA BSSZ 5 FILE NAME
CAI SPACE 4,15
** CAI - CLEAR ALLOCATION AND *DAPF* INTERLOCKS.
*
* ENTRY (EQ) = MASTER DEVICE EST ORDINAL.
* (AILK) = CATALOG/PERMIT ALLOCATION INTERLOCK TRACK.
* (DAIF) = DIRECT ACCESS FILE INTERLOCK FLAG.
* (IAIF) = INDIRECT ALLOCATION INTERLOCK FLAG.
* (PFEQ) = DIRECT ACCESS FILE EST ORDINAL.
* (PFFT) = DIRECT ACCESS FILE FIRST TRACK.
*
* EXIT ALLOCATION INTERLOCKS CLEARED.
* DIRECT ACCESS FILE INTERLOCK CLEARED.
*
* USES T5.
*
* CALLS CTI.
CAI SUBR ENTRY/EXIT
LDD EQ
ADC 4000 SET CHECKPOINT VIA *STBM*
STD T5
LDM AILK
ZJN CAI1 IF NO CATALOG/PERMIT ALLOCATION INTERLOCK
RJM CTI CLEAR TRACK INTERLOCK
CAI1 LDM IAIF
ZJN CAI2 IF INDIRECT ALLOCATION INTERLOCK NOT SET
LDM DVLW
RJM CTI CLEAR INDIRECT ALLOCATION INTERLOCK
LDN 0 CLEAR INDIRECT ALLOCATION INTERLOCK FLAG
STM IAIF
CAI2 LDM DAIF
ZJN CAIX IF DIRECT ACCESS FILE INTERLOCK NOT SET
LDM PFEQ
ADC 6000 CHECKPOINT + NO HANG ON UNRESERVED TRACK
STD T5
LDM PFFT
RJM CTI CLEAR DIRECT ACCESS FILE INTERLOCK
UJP CAIX RETURN
CEI SPACE 4,15
** CEI - CHECK FOR ERROR IDLE REQUIRED.
*
* ENTRY (P0) = ERROR IDLE FLAG.
* (P1) = ERROR CODE.
* (P2) = EST ORDINAL.
*
* EXIT ERROR IDLE STATUS SET ON DEVICE IF APPROPRIATE.
* (SEQF) = PRESET TO FORCE *EQXXX, ERROR IDLE SET.*
* MESSAGE IF ERROR IDLE SET.
*
* USES T5.
*
* CALLS SES.
*
* MACROS SMSTF.
CEI SUBR ENTRY/EXIT
LDD P0
ZJN CEIX IF NO ERROR IDLE REQUESTED
ISTORE SEQF,(PSN) FORCE *EQXXX, ERROR IDLE SET.* MESSAGE
LDD P2 SET ERROR IDLE STATUS ON DEVICE
STD T5
LDN STEI ERROR IDLE STATUS
RJM SES
SMSTF GDEI SET ERROR IDLE FLAG
UJN CEIX RETURN
CLE SPACE 4,10
** CLE - CHECK FOR LENGTH ERROR.
*
* ENTRY (P1) = ERROR CODE.
* (CC) = COMMAND CODE.
*
* EXIT (PPFA, PRTA) UPDATED IF *SYOT* LENGTH ERROR ON *GET*.
CLE SUBR ENTRY/EXIT
LDD CC
LMN CCGT
NJN CLEX IF NOT *GET* REQUEST
LDM JORG
LMK SYOT
NJN CLEX IF NOT SYSTEM ORIGIN JOB
LDD P1
LMN /ERRMSG/FLE
NJN CLEX IF NOT *FILE LENGTH ERROR*
AOM PPFA
AOM PRTA
UJN CLEX RETURN
PDE SPACE 4,15
** PDE - PROCESS *DMP=* JOB.
*
* ENTRY (CP) = CONTROL POINT ADDRESS.
*
* EXIT (SEPW) = CPU COMMUNICATION WORD CLEARED
*
* USES T3, CM - CM+4.
PDE SUBR ENTRY/EXIT
LDD CP CHECK *DMP=* STATUS
ADC SEPW
STD T3
CRD CM
LDD CM
LPN 20
NJN PDEX IF *DMP=* ENTRY POINT PRESENT
LDN ZERL CLEAR CPU COMMUNICATION WORD
CRD CM
LDD T3
ADN SPCW-SEPW
CWD CM
UJN PDEX RETURN
PRT SPACE 4,20
** PRT - PROCESS PRESERVED AND RESERVED TRACKS.
*
* ENTRY (FS - FS+4) = LOCAL FILE FST.
* (FNTA) = LOCAL FILE FNT ADDRESS.
* (PTKT) = PRESERVED TRACK IF NON-ZERO.
* (RTKE) = EST ORDINAL FOR RESERVED TRACK.
* (RTKT) = RESERVED TRACK IF NON-ZERO.
*
* EXIT (FS+1 - FS+3) = 0 IF RESERVED TRACK RELEASED.
* (AIPR, AIPR+1) = 0 IF RESERVED TRACK RELEASED.
* PRESERVED FILE BIT CLEARED IF SET.
* RESERVED TRACK RELEASED IF RESERVED.
*
* USES FA, CM - CM+4.
*
* MACROS MONITOR, NFA.
PRT SUBR ENTRY/EXIT
LDM PTKT CHECK PRESERVED TRACK
ZJN PRT1 IF TRACK NOT PRESERVED
STD CM+2
SBM RTKT
ZJN PRT1 IF TRACK ALSO RESERVED
LDD FS SET EST ORDINAL AND CHECKPOINT
LMC 4000
STD CM+1
LDN CPFS CLEAR PRESERVED FILE BIT
STD CM+3
MONITOR STBM
PRT1 LDN 0
* LDN 1 (*SYOT* + *GET* + *FILE LENGTH ERROR*)
PRTA EQU *-1
NJN PRTX IF TRACK SHOULD NOT BE RELEASED
LDM RTKT CHECK RESERVED TRACK
ZJN PRTX IF NO RESERVED TRACK TO RELEASE
STD CM+2 DROP RESERVED TRACK
LDM RTKE
LMC 4000
STD CM+1
MONITOR DTKM
* LDN 0 CLEAR FST
STD FS+1
STD FS+2
STD FS+3
STM AIPR CLEAR MASS STORAGE INCREMENT
STM AIPR+1
LDM FNTA RESTORE FNT ADDRESS
STD FA
NFA FA,R UPDATE FST
ADN FSTL
CWD FS
UJP PRTX RETURN
OVERFLOW OVLA,EPFW OVERFLOW INTO ERROR PROCESSING AREA
OVERLAY (TERMINATE PROGRAM.),OVLA
SPACE 4,10
*** THIS OVERLAY PERFORMS TERMINATION PROCESSING FOR *PFM*.
OVL BSS 0 ENTRY
LDM IAIF
ZJN OVL0 IF INDIRECT ALLOCATION INTERLOCK NOT SET
RJM HNG HANG
OVL0 RJM CLF COMPLETE LOCAL FILE FST
LDM STAU CHECK *PFM* STATUS BITS
LPK STRP+STDP
NJN OVL1 IF *PFM* TO BE RECALLED OR TERMINATED
RJM CCI CLEAR CATALOG INTERLOCK
RJM SFS SET FET STATUS
OVL1 UJN DPP DROP PP
CLF SPACE 4,10
** CLF - COMPLETE LOCAL FILE FST.
*
* ENTRY (FNTA) = LOCAL FILE FNT ADDRESS.
*
* USES CM - CM+4.
CLF SUBR ENTRY/EXIT
LDM FNTA
STD FA
ZJN CLFX IF NO LOCAL FILE FNT
NFA FA,R
ADN FSTL
CRD CM
LDD CM+4 SET LOCAL FILE FST COMPLETE
SCN 1
LMN 1
STD CM+4
NFA FA,R
ADN FSTL
CWD CM
UJN CLFX RETURN
DPP SPACE 4,25
** DPP - DROP PP.
*
* ENTRY (CN - CN+4) = INPUT REGISTER FOR *PFM* RECALL.
* (FN - FN+4) = RECALL REQUEST FOR MONITOR.
* (MP - MP+4) = PARAMETER WORD FOR *PFM* RECALL.
* (AIPF, AIPF+1) = ACCUMULATOR INCREMENT FOR PF ACCESS.
* (AIPR, AIPR+1) = ACCUMULATOR INCREMENT FOR PRU COUNT.
* (EPFA) = EST ORDINAL OF DEVICE IF PF ACTIVITY COUNT
* TO BE DECREMENTED.
* (STAU) = *STAJ* BIT SET IF JOB TO BE ABORTED.
* *STRP* BIT SET IF *PFM* TO BE RECALLED.
*
* EXIT PF ACTIVITY COUNT DECREMENTED IF IT WAS SET.
* ACCOUNTING UPDATED.
* JOB ABORTED IF *STAJ* SET.
* *PFM* RECALLED IF *STRP* SET.
* TO *PPR*.
*
* USES CM - CM+4.
*
* MACROS MONITOR, NFA.
DPP BSS 0 ENTRY
* DECREMENT PF ACTIVITY COUNT.
LDM EPFA EST ORDINAL
ZJN DPP2 IF ACTIVITY NOT SET
STD CM+1
LDN DPAS DECREMENT PF ACTIVITY COUNT
STD CM+3
MONITOR STBM
* UPDATE ACCOUNTING.
DPP2 LDM AIPR SET ACCUMULATOR INCREMENT FOR PRU COUNT
STM DPPB
LDM AIPR+1
STM DPPB+1
LDM AIPF SET ACCUMULATOR INCREMENT FOR PF ACCESS
STM DPPD
LDM AIPF+1
STM DPPD+1
LDD MA TRANSMIT REQUEST TO MESSAGE BUFFER
CWM DPPA,TR
LDN 2 SET NUMBER OF REQUESTS
STD CM+1
LDM STAU CHECK *PFM* STATUS BITS
LPK STAJ+STRP
NJN DPP3 IF JOB BEING ABORTED OR *PFM* RECALLED
STD CM+2 SELECT DROP PP OPTION
MONITOR UADM UPDATE ACCOUNTING
LJM DPP5 EXIT TO PP RESIDENT
DPP3 LDM DPPB
ADM DPPB+1
ADM DPPD
ADM DPPD+1
ZJN DPP3.1 IF NO ACCOUNTING TO UPDATE
LDN 1 SELECT NO DROP OPTION
STD CM+2
MONITOR UADM UPDATE ACCOUNTING
DPP3.1 LDM STAU
LPK STRP
NJN DPP4 IF *PFM* TO BE RECALLED
MONITOR ABTM ABORT JOB
UJN DPP5 EXIT TO PP RESIDENT
* RECALL *PFM*.
DPP4 LDD CN+1 CLEAR AUTO RECALL BIT IN INPUT REGISTER
SCN 40
STD CN+1
LDD IA
CWD CN
LDN 40 FORCE AUTO RECALL BIT IN RECALL REQUEST
RAD CN+1
LDD MA
CWD CN INPUT REGISTER FOR RECALL
ADN 1
CWD MP PARAMETER WORD FOR RECALL
ADN 1
CWD FN
CRD CM RECALL REQUEST
MONITOR RECM RECALL AND DROP PP
DPP5 LJM PPR EXIT TO PP RESIDENT
DPPA BSS 0 REQUEST TO UPDATE ACCOUNTING
CON CDCS SUBFUNCTION CODE
CON ACLW ADDRESS OF CONTROL POINT WORD
CON 0*100+22 POSITION AND WIDTH OF FIELD
DPPB CON 0,0 VALUE OF INCREMENT FOR PRU COUNT
DPPC BSS 0 REQUEST TO UPDATE ACCOUNTING
CON AISS SUBFUNCTION CODE
CON IOAW ADDRESS OF CONTROL POINT WORD
CON 0*100+24 POSITION AND WIDTH OF FIELD
DPPD CON 0,0 VALUE OF INCREMENT FOR PF ACCESS
SFS SPACE 4,15
** SFS - SET FET STATUS.
*
* ENTRY (STAU) = STATUS FLAGS.
* (FN - FN+4) = FET + 0 IF *STDS* SET IN *STAU*.
* (FS - FS+4) = FET + 1 IF *STDS* SET IN *STAU*.
*
* EXIT FET SET COMPLETE.
*
* USES CM - CM+4, FN - FN+4, FS - FS+4.
*
* CALLS SFA.
SFS SUBR ENTRY/EXIT
RJM SFA
ZJN SFSX IF NO FET ADDRESS
LDM STAU
LPK STDS
NJN SFS1 IF RETURNING ERROR CODE IN FET
RJM SFA
CRD FN READ FET STATUS WORD
ADN 1
CRD FS FET LENGTH/RANDOM BIT
LDD FN+4
LPC 1776
LMN 1 SET COMPLETION STATUS
STD FN+4
LDD FN+3 CLEAR UPPER BITS OF ERROR STATUS
SCN 77
STD FN+3
* UPDATE RANDOM INDEX IF RANDOM FET.
* DO NOT UPDATE IF FET IS TOO SHORT OR OUTSIDE FL.
SFS1 LDD FS+3 CHECK FET LENGTH
SHN -6
SBN CFCN-4
MJN SFS2 IF FET TOO SHORT
LDD FS+1
SHN 21-13
PJN SFS2 IF NOT RANDOM FET
LDD IR+3 CHECK RANDOM INDEX FIELD WITHIN FL
LPN 77
SHN 14
LMD IR+4
ADN CFCN
SHN -6
SBD FL
PJN SFS2 IF RANDOM INDEX FIELD NOT WITHIN FL
LDN ZERL
CRD CM
LDD HN SET RANDOM INDEX REWOUND
STD CM+2
RJM SFA
ADN CFCN
CWD CM
SFS2 RJM SFA
CWD FN
UJP SFSX RETURN
SPACE 4,10
** DEFINE COMMAND PROCESSOR SYMBOLS.
QUAL 3PC
CMD HERE
QUAL *
SPACE 4,10
OVERFLOW OVLA,EPFW OVERFLOW INTO ERROR PROCESSING AREA
TTL PFM - PERMANENT FILE MANAGER.
END