IDENT LFM,LFM
PERIPH
BASE MIXED
SST
EQV$ EQU 1 DEFINE NO EQUIPMENT CHECK FOR *COMPRSS*
MSR$ EQU 1 DEFINE ERROR PROCESSING FOR *COMPRNS*
QUAL$ EQU 1 DEFINE UNQUALIFIED COMMON DECKS
*COMMENT LFM - LOCAL FILE MANAGER.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
TITLE LFM - LOCAL FILE MANAGER.
SPACE 4,10
*** LFM - LOCAL FILE MANAGER.
* G. R. MANSFIELD. 70/12/18.
* M. S. CARTER. 76/06/24.
SPACE 4,10
*** LFM PERFORMS VARIOUS FILE MANAGING TASKS FOR A JOB.
SPACE 4,10
*** CALL.
*
*T, 18/ *LFM*, 1/1, 5/ , 12/ CODE, 6/ FP, 18/ FET
* CODE FUNCTION CODE
* FP FUNCTION PARAMETER -
* FOR FUNCTION 3, FP = FILE STATUS.
* FOR STATUS FUNCTION 13, FP=1, IF ADDITIONAL TAPE
* INFORMATION IS REQUESTED.
* FOR EQUIPMENT ASSIGMENT FUNCTIONS 14B, 15B AND
* 26B, IF BIT 19 IS SET, NO DAYFILE MESSAGE
* INDICATING THE EQUIPMENT ASSIGNED IS ISSUED.
* FOR OPERATOR EQUIPMENT ASSIGNMENT FUNCTION 26B,
* IF BIT 18 IS SET, OPERATOR TAPE ASSIGNMENT FOR
* DUPLICATE *VSN* IS REQUIRED.
* FOR FUNCTION 20B, FP = 0 TO ACCESS LIBRARY FILE,
* FP = 1 IF *SYSTEM* FILE TO BE ASSIGNED.
* FET ADDRESS OF FET
*
*T FET 42/ *FILE NAME*,17/,1/0
*T 12/ EQ,3/,1/E,44/
* EQ EQUIPMENT TYPE
* E RETURN ERROR CODE
*
* RETURN.
*
*T FET 42/ *FILE NAME*,8/ EC,9/,1/1
* EC ERROR CODE
SPACE 4,10
*** DAYFILE MESSAGES.
*
* * LFM INCORRECT REQUEST.* = *LFM* WAS CALLED WITHOUT
* AUTO RECALL OR WITH INCORRECT FUNCTION CODE.
*
* * COMMAND FILE ERROR.* = AN UNRECOVERABLE MASS STORAGE ERROR
* OCCURRED ON THE JOBS COMMAND FILE.
*
* * DUPLICATE FILE NAME.* = FILE ALREADY EXISTS FOR USER JOB.
*
* * FILE EMPTY.* = FILE EXISTS BUT IS EMPTY.
*
* * FILE NAME ERROR.* = FILE NAME CONTAINS INCORRECT CHARACTERS
* OR MORE THAN SEVEN CHARACTERS.
*
* * FILE NOT FOUND.* = REQUESTED FILE WAS NOT FOUND.
*
* * INCORRECT EQUIPMENT.* = USER SPECIFIED EQUIPMENT THAT DOES
* NOT EXIST OR IS NOT ALLOWED.
*
* * INCORRECT FILE STATUS.* - FILE STATUS IS OUT OF RANGE OF
* DEFINED VALUES.
*
* * INCORRECT FILE TYPE.* = FILE WAS NOT CORRECT TYPE FOR
* FUNCTION.
*
* * INCORRECT FILE MODE.* = FUNCTION NOT ALLOWED ON
* EXECUTE-ONLY FILE.
*
* * USER ACCESS NOT VALID.* = USER ATTEMPTED TO ACCESS
* SOMETHING WITHOUT REQUIRED VALIDATION.
*
* * ACCESS LEVEL NOT VALID FOR FILE.* = *LFM* WAS CALLED BY
* A USER WHO ATTEMPTED TO SET A FILE-S ACCESS LEVEL TO A
* LEVEL NOT VALID FOR THAT USER, OR FOR THE EQUIPMENT UPON
* WHICH THAT FILE RESIDED.
*
* * EQUIPMENT NOT AVAILABLE.* = EQUIPMENT IS IN USE OR DOES
* NOT EXIST, NO EQUIPMENT WITH THE PROPER ACCESS LEVEL CAN
* BE FOUND, OR THE MASS STORAGE DEVICE ENCOUNTERED AN I/O
* ERROR.
*
* * NO MASS STORAGE AVAILABLE.* = NO TRACKS COULD BE FOUND
* OF THE CORRECT TYPE.
*
* * FET TOO SHORT.* = FET IS NOT LONG ENOUGH TO ACCOMPLISH
* FUNCTION.
*
* * GETFNT TABLE TOO LARGE.* = TABLE USED BY GETFNT
* FUNCTION EXTENDS OUTSIDE FIELD LENGTH.
*
* * ADDRESS OUT OF RANGE.* = SOME PORTION OF THE PARAMETER
* BLOCK OR FET IS BEYOND THE USERS FIELD LENGTH.
*
* * PARAMETER BLOCK BUSY.* = COMPLETION BIT IS SET BEFORE
* PROCESSING OF FUNCTION BEGINS.
*
* * I/O SEQUENCE ERROR.* = A REQUEST WAS MADE ON A BUSY FILE.
*
* * MAGNETIC TAPE SUBSYSTEM NOT ACTIVE.* = NO UDT ADDRESS
* IN FST, OR MAGNET NOT PRESENT.
*
* * SYSTEM ERROR.* = LFM CANNOT COMPLETE THE REQUESTED LFM
* FUNCTION BECAUSE THE CALLING PROGRAM HAS A *DMP=* ENTRY
* POINT.
*
* * INCORRECT RANDOM ADDRESS.* = THE REQUESTED *LFM*
* FUNCTION SPECIFIED A CURRENT RANDOM ADDRESS OF ZERO.
*
* *XX, ASSIGNED TO FILENAM.* = *MSAL* DEVICE TYPE XX ASSIGNED.
*
* *TTXXX, ASSIGNED TO FILENAM.* = EST ORDINAL XXX WITH TYPE TT
* WAS ASSIGNED.
SPACE 4,10
*** ACCOUNT DAYFILE MESSAGES.
*
*
* *MFFI, FILENAME, LEVELNAME.* = AN INVALID ATTEMPT WAS MADE TO
* CHANGE THE ACCESS LEVEL ON FILE FILENAME TO LEVEL LEVELNAME.
SPACE 4,10
*** OPERATOR MESSAGES.
*
* * TRACK LIMIT.* = *LFM* IS WAITING FOR MASS STORAGE SPACE.
*
* *EQXXX, TRACK LIMIT.* = *LFM* IS WAITING FOR MASS STORAGE
* SPACE ON EST ORDINAL XXX.
*
* *REQUEST NNNNNNN, EQ* = JOB IS REQUESTING ASSIGNMENT
* OF EQUIPMENT TYPE *EQ* TO BE ASSIGNED TO FILE *NNNNNNN*.
SPACE 4,10
** ROUTINES CALLED.
*
*
* 0BF - BEGIN FILE.
* 0DF - DROP FILE.
SPACE 4,10
** NOTE - MONITOR FUNCTION *HNGM* WILL BE ISSUED IF *LFM*
* DETECTS AN INCORRECT FILE STATUS IN THE FNT WHEN PROCESSING A
* *FILINFO* REQUEST.
* THE *FNT* ENTRY.
SPACE 4
** COMMON DECKS.
*CALL COMPMAC
LIST X
*CALL COMSLFM
LIST *
SPACE 4
ORG PPFW
QUAL MTX
*CALL COMSMTX
QUAL *
*CALL COMSEVT
*CALL COMSLFD
*CALL COMSCPS
*CALL COMSJIO
*CALL COMSMLS
*CALL COMSMSP
*CALL COMSPFM
*CALL COMSSCD
*CALL COMSPIM
*CALL COMSSSD
*CALL COMSSSE
*CALL COMSSSJ
*CALL COMSWEI
*CALL COMSZOL
SPACE 4
**** DIRECT LOCATION ASSIGNMENTS.
FS EQU 20 - 24 FST ENTRY (5 LOCATIONS)
EQ EQU 25 EST ORDINAL
AL EQU 26 ACCESS LEVEL
FP EQU 27 FUNCTION PARAMETER
CN EQU 30 - 34 CM WORD BUFFER (5 LOCATIONS)
AB EQU CN FOR USE ON CALL TO *COMPCLD*
RI EQU 35 - 36 RANDOM INDEX
FF EQU 37 FET SPECIFIED FNT ADDRESS
FN EQU 40 - 44 FILE NAME (5 LOCATIONS)
UN EQU FN USER NAME (5 LOCATIONS)
FE EQU 45 FET LENGTH - 1
LS EQU 46 LAST FET STATUS
OC EQU 47 JOB ORIGIN CODE
FA EQU 57 ADDRESS OF FNT ENTRY
FT EQU 60 - 64 FNT POINTERS
****
SPACE 4
** ADDITIONAL DIRECT LOCATION ASSIGNMENTS DEFINED
* LOCALLY TO OVERLAYS.
*
* UD = 60-64 - OVERLAY 3LB.
* VS = 60-64 - OVERLAY 3LC.
* SP = 60-64 - OVERLAY 3LF.
* ST = 65 - OVERLAY 3LB.
* CF = 65 - OVERLAY 3LE.
* CB = 65 - OVERLAY 3LG.
* SX = 66 - OVERLAY 3LB.
* WO = 66 - OVERLAY 3LE.
* SB = 66-67 - OVERLAY 3LG.
SPACE 4
** ASSEMBLY CONSTANTS.
DNFS EQU 200 DEFAULT NUMBER OF FILES - GETFNT FCN.
CGNT EQU 10 FET PARAMETER WORD - GETFNT FCN.
SPACE 4
* OVERLAY CONTROL.
.N SET 0
OVLB MICRO 1,, 3L BASE OVERLAY NAME
TITLE OVERLAY COMMUNICATION MACROS.
OVERLAY SPACE 4
** OVERLAY - GENERATE OVERLAY CONSTANTS.
*
*
* OVERLAY (TEXT)
* ENTRY *TEXT* = TEXT OF SUBTITLE.
PURGMAC OVERLAY
OVERLAY MACRO TEXT
QUAL
.N SET .N+1
.M MICRO .N,1, ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
.O MICRO 1,3, "OVLB"".M"
QUAL ".O"
TTL LFM/".O" - TEXT
TITLE
IDENT ".O",OVL TEXT
*COMMENT LFM - TEXT
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
ORG OVL
LJM *
UJN *-2
ENDM
ENTRY SPACE 4
** ENTRY - DEFINE OVERLAY ENTRY POINT.
*
*
* ENTRY NAME
* ENTRY *NAME* = NAME OF ENTRY ADDRESS.
PURGMAC ENTRY
ENTRY MACRO NAME
QUAL
NAME EQU *+1R".M"*10000
QUAL ".O"
ENDM
CSR SPACE 4,10
** CSR - DEFINE 24 BIT QUANTITY FROM 18 BIT EQUATE.
*
* CSR R
*
* *R* = VALUE TO BE EXPANDED TO 24 BITS.
* IF *R* = 0, 77777777B WILL BE STORED.
CSR MACRO R
LOCAL N,O,P,Q
MACREF CSR
N SET R
IFNE R,0
O SET R/100B
P SET O*100B
Q SET R-P
CON O,Q*100B
ELSE
CON 7777B,7777B
ENDIF
CSR ENDM
TBLM SPACE 4,10
** TBLM - GENERATE LIST OF MASS STORAGE DEVICE MNEMONICS.
*
* TBLM EQ
* EQ = DEVICE MNEMONIC.
TBLM MACRO EQ
CON 2R_EQ
TBLM ENDM
TITLE MAIN PROGRAM.
LFM SPACE 4
** LFM - MAIN PROGRAM.
ORG PPFW
LFM RJM PRS PRESET PROGRAM
LFM1 LDC 0
LFMA EQU *-1 (OVERLAY NAME)
ZJN LFM2 IF NO OVERLAY REQUIRED
LMC 2L"OVLB" LOAD OVERLAY
RJM EXR
LFM2 LJM * PROCESS REQUEST
LFMB EQU *-1
LFMX RJM SNB SET FILE(S) NOT BUSY
LFM3 RJM SFS SET FILE STATUS
LDM DPPB CHECK FOR *UADM* DATA
SHN 14
ADM DPPB+1
ZJN DPP IF NO DATA
LDD MA ISSUE *UADM* FUNCTION
CWM DPPA,ON
LDN 1
STD CM+1
STD CM+2
MONITOR UADM
DPP SPACE 4,10
** DPP - DROP PP.
DPP MONITOR DPPM DROP PPU
LJM PPR RETURN TO PP RESIDENT
* *UADM* PARAMETER WORD.
DPPA CON CDCS DECREMENT CONTROL POINT AREA
* CON (CICS) INCREMENT CONTROL POINT AREA
CON ACLW
CON 0D*100+18D
DPPB CON 0,0
TITLE RESIDENT SUBROUTINES.
CKE SPACE 4,10
** CKE - CHECK ERROR PROCESSING.
*
* ENTRY (A) = ERROR CODE.
*
* EXIT (EQ) = ERROR CODE.
*
* USES CM - CM+4.
*
* CALLS CPA, DRF.
CKE SUBR ENTRY/EXIT
STD EQ SAVE MESSAGE CODE
ADN 1 SET FET ERROR CODE
SHN 12
STM SFSC
SHN -14
STM SFSB
RJM CPA READ FIRST
ADN 1
CRD CM
LDD CM+1
SHN 21-8D
PJN CKEX RETURN IF USER NOT PROCESSING ERROR
LDD EQ
LMN /ERR/LNV
ZJN CKEX IF ACCESS LEVEL NOT VALID FOR FILE
LMN /ERR/IOE&/ERR/LNV
ZJN CKEX IF I/O SEQUENCE ERROR
LMN /ERR/NMA&/ERR/IOE
NJN CKE1 IF NOT TRACK LIMIT
RJM DRF DROP FILE
CKE1 LJM LFMX EXIT
CLF SPACE 4,10
** CLF - CREATE LOCAL FILE.
*
* ENTRY (EQ) = EST ORDINAL.
* (FN - FN+4) = FILE NAME.
* (AL) = 8/, 1/ACCESS LEVEL FLAG, 3/ACCESS LEVEL.
*
* EXIT SEE *EFN*.
* (FN+4) = *SSST* FILE STATUS CLEARED.
*
* CALLS EFN.
*
* MACROS NFA.
CLF SUBR ENTRY/EXIT
RJM EFN ENTER FILE
LDD FN+4 CHECK FILE STATUS
LPN 77
LMN SSST
NJN CLFX IF NOT SPECIAL SYSTEM FILE
LCN SSST CLEAR SPECIAL SYSTEM FILE STATUS
RAD FN+4
NFA FA,R
CWD FN
UJN CLFX RETURN
CPA SPACE 4,10
** CPA - COMPUTE PARAMETER ADDRESS.
*
* ENTRY (IR+3 - IR+4) = RELATIVE PARAMETER ADDRESS.
*
* EXIT (A) = ABSOLUTE PARAMETER ADDRESS.
CPA SUBR ENTRY/EXIT
LDD IR+3
LPN 37
SHN 6
ADD RA
SHN 6
ADD IR+4
UJN CPAX RETURN
DEQ SPACE 4,10
** DEQ - DROP EQUIPMENT.
*
* ENTRY (EQ) = EST ORDINAL.
*
* USES T0, CM - CM+4.
*
* MACROS MONITOR, SFA.
DEQ SUBR ENTRY/EXIT
LDD EQ READ EST ENTRY
LPC 777
STD T0 SAVE EST ORDINAL
ZJN DEQX IF NO EQUIPMENT PRESENT
SFA EST
ADK EQDE
CRD CM
LDD CM
SHN 21-13
MJN DEQX IF MASS STORAGE
SHN 13-12
PJN DEQ1 IF NOT ALLOCATABLE
SFA EST,T0 CHECK EQUIPMENT ASSIGNMENT
ADK EQAE
CRD CM
LDD CM+4
ZJN DEQX IF NOT ASSIGNED
DEQ1 LDD T0
STD CM+1
MONITOR DEQM RELEASE EQUIPMENT
UJN DEQX RETURN
DRF SPACE 4,10
** DRF - DROP FILE.
*
* ENTRY (FA) = RELATIVE ADDRESS OF FNT ENTRY IN NFL.
*
* EXIT (A) = (FA) = 0.
*
* ERROR TO *EER3*.
*
* CALLS *0DF*.
*
* MACROS EXECUTE.
DRF SUBR ENTRY/EXIT
LDN 1 SET *UNLOAD* FILE FLAG FOR *0DF*
STM OVL0
EXECUTE 0DF,OVL0+1 DROP FILE
NJN EER3 IF MASS STORAGE DEVICE INACCESSIBLE
* STD FA
UJN DRFX RETURN
EER SPACE 4,10
** EER - EVALUATE MASS STORAGE ERROR RETURN.
*
* ENTRY (A) = ERROR RESPONSE FROM DRIVER.
* (T5) = EST ORDINAL.
*
* USES IR+4.
*
* CALLS ERR, SNB, *1RJ*.
*
* MACROS EXECUTE, PAUSE.
EER PSN ENTRY
SHN 21-12
PJN EER2 IF ERROR RECOVERABLE
EER1 LDN /ERR/WEQ
LJM ERR PROCESS ERROR
EER2 LDM MSD CHECK CALLER
SHN 21-13
PJN EER1 IF SUBSYSTEM
EER3 PAUSE
LDD CM+1
NJP LFMX IF ERROR FLAG SET
RJM SNB
LDD T5 SET EST ORDINAL
STD IR+4
EXECUTE 1RJ RECALL JOB
EFN SPACE 4,20
** EFN - ENTER FILE NAME.
*
* ENTRY (FN - FN+4) = FILE NAME.
* (AL) = 8/, 1/ACCESS LEVEL FLAG, 3/ACCESS LEVEL.
* (EQ) = EST ORDINAL.
*
* EXIT (FA) = ADDRESS OF FNT ENTRY.
* (FN - FN+4) = FNT ENTRY.
* (FS - FS+4) = FST ENTRY.
* TO *RSP* IF WAIT FOR NFL INCREASE TO CREATE
* FNT ENTRY.
*
* ERROR EXIT TO *ERR* IF DUPLICATE FILE NAME OR
* FILE NAME ERROR.
* EQUIPMENT RELEASED IF FILE NAME ERROR.
*
* USES FA, FS.
*
* CALLS COE, DEQ, VFN, *0BF*.
*
* MACROS EXECUTE.
EFN SUBR ENTRY/EXIT
RJM VFN VERIFY FILE NAME
NJN EFN1 IF NO ERROR
RJM DEQ RELEASE EQUIPMENT
LDN /ERR/FLN
UJN EFN2 PROCESS ERROR
EFN1 LDD EQ SET EQUIPMENT ASSIGNMENT
STD FS
LDD AL
SHN 6 PASS FILE ACCESS LEVEL TO *0BF*
ADN 2 RETURN TO ENTER PP STACK FOR NFL INCREASE
STM OVL0
EXECUTE 0BF,OVL0+1
UJN EFN3 CHECK RETURN STATUS
* DUPLICATE FILE FOUND.
LDN 0 CLEAR FNT ADDRESS
STD FA
LDN /ERR/DFN DUPLICATE FILE NAME
EFN2 UJN ERR PROCESS ERROR
EFN3 ZJN EFNX IF FNT ENTRY CREATED
RJM DEQ RELEASE EQUIPMENT
LDC 0
EFNA EQU *-1
ZJN EFN4 IF NO OPERATOR ASSIGNED EQUIPMENT TO RESET
RJM COE RESET OPERATOR ASSIGNED EQUIPMENT
EFN4 LDN NFIR REASON CODE = NFL INCREASE PENDING
LJM RSP ENTER PP RECALL STACK
ABT SPACE 4,10
** ABT - ABORT JOB.
*
* ENTRY (A) = ADDRESS OF MESSAGE.
*
* CALLS DFM.
*
* MACROS MONITOR.
ABT RJM DFM ISSUE DAYFILE MESSAGE
MONITOR ABTM
LJM PPR RETURN TO PP RESIDENT
CFL SPACE 4,10
** CFL - CHECK FET LENGTH.
*
* ENTRY (A) = COMPLEMENT OF (MINIMUM LENGTH - 1).
* (FE) = FET LENGTH - 1.
*
* EXIT TO *ERR*, IF ERROR.
CFL SUBR ENTRY/EXIT
ADD FE
PJN CFLX IF FET LENGTH SUFFICIENT
LDN /ERR/FTS * FET TOO SHORT.*
* LJM ERR ABORT
ERR SPACE 4,10
** ERR - PROCESS ERROR.
*
* ENTRY (A) = ERROR CODE.
ERR STD T0
LMN /ERR/IOE
NJN ERR1 IF NOT I/O SEQUENCE ERROR
STD FA CLEAR FNT ADDRESS
ERR1 LDD T0
RJM CKE CHECK ERROR PROCESSING
LDC ERP SET ERROR PROCESSOR ADDRESS
STM LFMB
SHN -14 SET OVERLAY NAME
STM LFMA
LJM LFM1 PROCESS ERROR
RCL SPACE 4,15
** RCL - RECALL *LFM*.
*
* ENTRY (A) = MESSAGE CODE.
* (T7) = MESSAGE ADDRESS.
*
* EXIT TO *DPP* TO DROP PP.
* TO *RSP* TO ENTER PP RECALL STACK.
*
* USES FS+4, CM - CM+4, CN - CN+4.
*
* CALLS CKE, DRF, SPB.
*
* MACROS MONITOR, NFA.
RCL RJM CKE CHECK ERROR PROCESSING
LDD T7 SET MESSAGE ADDRESS
ZJN RCL2 IF NO MESSAGE
STM RCLA
LDD EQ
LMN /ERR/NMA
ZJN RCL1 IF TRACK LIMIT
LDN 1
RJM SPB SET PAUSE BIT
RCL1 LDD CP STORE CONSOLE MESSAGE
ADN MS2W
CWM *,TR
RCLA EQU *-1
RCL2 AOD FS+4 SET FILE STATUS NOT BUSY
LDD FA
ZJN RCL3 IF NO FNT ENTRY
NFA FA,R
ADN FSTL
CWD FS STORE FST ENTRY
RCL3 LDD CP CHECK FOR ERROR FLAGS
ADN STSW
CRD CM
ADN SNSW-STSW
CRD CN
LDD CN+3
LPN 10
ADD CM+1
ZJN RCL4 IF NO ERROR FLAGS SET OR NO SUBSYSTEM IDLE
LJM DPP DROP PP AND EXIT TO PP RESIDENT
RCL4 LDD EQ
LMN /ERR/NMA
NJN RCL5 IF NOT TRACK LIMIT
RJM DRF CLEAR FNT ENTRY
LDN ZERL SET TRACK LIMIT EVENT
CRD CM
LDN TKLE
STD CM+4
MONITOR EATM
LDN TRLR SET TRACK LIMIT REASON CODE
UJN RSP ENTER PP RECALL STACK
RCL5 LDN WEAR SET WAIT EQUIPMENT ASSIGNMENT REASON CODE
* UJN RSP ENTER PP RECALL STACK
RSP SPACE 4,10
** RSP - RECALL STACK ENTRY PROCESSOR.
*
* ENTRY (A) = RECALL STACK REASON CODE.
* (IR - IR+4) = PP CALL.
*
* EXIT TO *PPR*.
*
* USES CM - CM+5.
*
* MACROS MONITOR.
RSP BSS 0 ENTRY
STD CM
LDN ZERL
CRD CM+1
LDD MA WRITE PP CALL
CWD IR
ADN 1 WRITE PARAMETER WORD
CWD CM
MONITOR RECM ENTER DEFAULT TIMED RECALL
LJM PPR EXIT TO PP RESIDENT
SFS SPACE 4,15
** SFS - SET FILE STATUS.
*
* ENTRY (LS) = LAST FET STATUS.
* (FN - FN+3) = FILE NAME FOR FET.
* (IR+3 - IR+4) = FET ADDRESS.
* (SFSB) = FET ERROR CODE (IF PERTINENT), SET BY *CKE*.
* (SFSA) = RETURN FILE FUNCTION FLAG, SET BY *PRS*.
* (SFSC) = FET ERROR CODE (IF PERTINENT), SET BY *CKE*.
*
* EXIT FET STATUS MADE *NOT BUSY* AND ERROR CODE FIELD SET.
*
* USES LS, FN+3, FN+4.
*
* CALLS CPA.
SFS SUBR ENTRY/EXIT
AOD LS MAKE FET NOT BUSY
STD FN+4
SFSA LDN 0
* LDN 1 (RETURN FILE INFORMATION)
NJN SFS1 IF RETURN FILE INFORMATION
LDD FN+3 SET FET ERROR CODE FIELD
SCN 77
LMC 0 LEFT 6 BITS OF 8 BIT ERROR CODE FIELD
SFSB EQU *-1
STD FN+3
LDC 0
SFSC EQU *-1
RAD FN+4
SFS1 RJM CPA REWRITE FET+0
CWD FN
UJN SFSX RETURN
SIF SPACE 4,15
** SIF - SEARCH FOR AND INTERLOCK FILE.
*
* ENTRY (A) = INITIAL FNT ADDRESS FOR SEARCH.
* (A) = 0, IF NO INITIAL FNT ADDRESS.
* (FN - FN+4) = FILE NAME.
*
* EXIT FNT/FST FOR FILE SET BUSY, ELSE TO *ERR*.
* (FA) = FNT ADDRESS IN NFL.
* (CM - CM+4) = FNT WORD.
* (FS - FS+4) = FST WORD.
*
* CALLS SAF, SFB.
SIF SUBR ENTRY/EXIT
RJM SAF SEARCH FOR ASSIGNED FILE
ZJN SIF1 IF FILE NOT FOUND
RJM SFB SET FILE BUSY
ZJN SIFX IF FILE SET BUSY
LDN /ERR/IOE&/ERR/FNF *I/O SEQUENCE ERROR*
SIF1 LMN /ERR/FNF *FILE NOT FOUND*
LJM ERR PROCESS ERROR
SNB SPACE 4,15
** SNB - SET FILE(S) NOT BUSY.
*
* ENTRY (FA) = FNT ADDRESS OF BUSY FILE.
* (FS - FS+4) = FST ENTRY OF FILE.
* (SNBA) = FNT ADDRESS OF SECOND FILE.
* = 0 IF NO SECOND FILE.
*
* EXIT (A) = (FA) = (SNBA) = 0.
*
* USES FA, FS - FS+4.
*
* MACROS NFA.
SNB SUBR ENTRY/EXIT
LDD FA
ZJN SNB1 IF ONE FILE NOT BUSY
AOD FS+4
NFA FA,R STORE FST ENTRY
ADN FSTL
CWD FS
SNB1 LDC 0 POSSIBLE SECOND FILE FNT ADDRESS
SNBA EQU *-1
STD FA
ZJN SNBX IF NO SECOND FILE
NFA FA,R
ADK FSTL
CRD FS
AOD FS+4 SET FILE NOT BUSY
NFA FA,R
ADK FSTL STORE FST INFORMATION
CWD FS
LDN 0 CLEAR FNT ADDRESS
STD FA
STM SNBA
UJP SNBX RETURN
SPB SPACE 4,10
** SPB - SET/CLEAR PAUSE BIT.
*
* ENTRY (A) = 0 CLEAR PAUSE BIT.
* (A) = 1 SET PAUSE BIT.
*
* EXIT (A) = ADDRESS OF *SNSW* IN CP AREA.
* (CM - CM+4) = *SNSW*.
*
* USES T1, CM - CM+4.
SPB SUBR ENTRY/EXIT
STD T1 SAVE PAUSE OPTION
LDD CP READ SWITCH WORD
ADN SNSW
CRD CM
LDD CM+3 SET/CLEAR PAUSE BIT
SCN 1
LMD T1
STD CM+3
LDD CP UPDATE SWITCH WORD
ADN SNSW
CWD CM
UJN SPBX RETURN
SVF SPACE 4,15
** SVF - SEARCH FOR VSN ENTRY FILE.
*
* ENTRY (FN - FN+4) = FILE NAME
*
* EXIT (A) = 0 NO FILE FOUND OR VSN ENTRY FILE FOUND
* (FA) = FNT ADDRESS.
* (FS - FS+4) = FNT ENTRY.
*
* USES CM - CM+4.
*
* CALLS SAF.
*
* MACROS NFA, SFA.
SVF SUBR ENTRY/EXIT
LDN 0 SET NO INITIAL FNT ADDRESS
RJM SAF SEARCH FOR ASSIGNED FILE
ZJN SVFX IF NO FILE
NFA FA,R READ FST
ADN FSTL
CRD CM
LDD CM CHECK EQUIPTMENT
SFA EST
ADK EQDE
CRD CM READ EST ENTRY
LDD CM+3
LMC 2RTE
UJN SVFX RETURN
UPP SPACE 4,10
** UPP - UPDATE PRIMARY FILE POINTERS.
*
* ENTRY (FA) = PRIMARY FILE FNT ADDRESS/OFFSET.
* (FS - FS+4) = PRIMARY FILE FST ENTRY.
*
* USES CM - CM+4.
*
* MACROS SFA, MONITOR.
UPP SUBR ENTRY/EXIT
* UPDATE WORD *TFSW* OF THE CONTROL POINT AREA.
LDD CP
ADK TFSW
CRD CM
LDD FA
STD CM+1
LDD CP
ADK TFSW
CWD CM
* UPDATE EJT ENTRY.
LDD FS STORE EQUIPMENT IN *UTEM* PARAMETER BLOCK
STM UPPA+3
LDD FS+1 STORE TRACK IN *UTEM* PARAMETER BLOCK
STM UPPA+4
LDD MA
CWM UPPA,ON
SFA EJT,CM SET EJT ENTRY ADDRESS FOR *UTEM*
STD CM+4
SHN -14
STD CM+3
LDN 1 SET NUMBER OF PARAMETERS FOR *UTEM*
STD CM+1
MONITOR UTEM UPDATE EJT ENTRY
UJN UPPX RETURN
UPPA VFD 1/0,5/PRFE,6/24D *UTEM* PARAMETER BLOCK
VFD 6/0,6/0
CON 0,0,0
SPACE 4,10
** COMMON DECKS.
QUAL COMPACS
*CALL COMPACS
QUAL *
EJT$ EQU 0 DEFINE *COMPGFP* ACCESS TO EJT
QFT$ EQU 0 DEFINE *COMPGFP* ACCESS TO QFT
IFP$ EQU 0 GENERATE *IFP* REMOTE CODE
*CALL COMPGFP
SAF$ EQU 0 SET INITIAL FNT ADDRESS PROVIDED
*CALL COMPSAF
*CALL COMPSEI
*CALL COMPSFB
*CALL COMPSRA
*CALL COMPVFN
USE OVERLAY
OVL EQU *+10
TITLE SUBROUTINES WHICH MAY BE OVERLAID.
PRS SPACE 4,20
** PRS - PRESET PROGRAM.
*
* ENTRY (IR - IR+4) = INPUT REGISTER.
*
* EXIT (AL) = 0.
* (EQ) = 0.
* (FA) = 0.
* (FE) = FET LENGTH - 1.
* (FF) = FET SPECIFIED FNT ADDRESS.
* (FP) = *LFM* FUNCTION CODE.
* (LS) = LAST FET STATUS.
* (OC) = ORIGIN CODE.
* (IR+3 - IR+4) = FET ADDRESS.
* (FN - FN+3) = FILE NAME.
*
* ERROR TO *ABT* IF INCORRECT REQUEST OR INCORRECT ADDRESS.
*
* CALLS CPA, CRS, IFP.
*
* MACROS SFA.
PRS SUBR ENTRY/EXIT
RJM CRS CHECK RECALL STATUS
NJN PRS1 IF CALLED WITH AUTO RECALL
LJM PRS6 ISSUE ERROR
PRS1 LDD IR+3 SAVE FUNCTION PARAMETER
SHN -6
STD FP
RJM IFP INITIALIZE EJT ACCESS
* CHECK FOR RETURN FILE INFORMATION FUNCTION.
LDD IR+2 CHECK FUNCTION CODE
SBN 32
NJN PRS2 IF NOT RETURN FILE INFORMATION
AOM SFSA
RJM CPA READ PARAMETER BLOCK LENGTH
CRD CM
LDD CM+3
LPN 77
ZJN PRS3 IF NO LENGTH
SBN 1
UJN PRS3 SAVE LENGTH
* CHECK IF FET IS CONTAINED IN FIELD LENGTH.
PRS2 RJM CPA READ FET LENGTH
ADN 1
CRD CM
LDD CM+3
SHN -6
ADN 5-1
PRS3 STD FE SAVE FET LENGTH - 1
LDD IR+3
LPN 77
SHN 14
MJN PRS4 IF OUT OF RANGE
LMD IR+4
ADD FE
SHN -6
SBD FL
MJN PRS5 IF FET CONTAINED IN FL
PRS4 LDC AORM * ADDRESS OUT OF RANGE.*
LJM ABT ABORT
* CHECK FUNCTION CODE.
PRS5 LDD IR+2 CHECK FUNCTION CODE
SHN 1
STD T7
ADC -TFCNL
MJN PRS7 IF LEGAL CODE
PRS6 LDC ILRM * LFM INCORRECT REQUEST.*
LJM ABT ABORT
PRS7 LDD CP FETCH EJT ORDINAL
ADN TFSW
CRD CM
SFA EJT,CM GET JOB ORIGIN TYPE FROM EJT ENTRY
ADN SCLE
CRD CM
LDD CM SET JOB ORIGIN TYPE
LPN 17
STD OC
LDM TFCN+1,T7 SET PROCESSOR ADDRESS
STM LFMB
ZJN PRS6 IF NOT DEFINED
* SET OVERLAY NAME.
LDM TFCN,T7
LPN 77
STM LFMA
RJM CPA
ADN 4
CRD CM
LDD CM
STD FF
RJM CPA READ FILE NAME
CRD FN
LDD FN+4 SAVE LAST FET STATUS
LPC 1776
STD LS
STD FN+4
LDD FN+3 CLEAR ERROR CODES
SCN 77
STD FN+3
LDN 0 CLEAR FNT ADDRESS
STD FA
STD EQ CLEAR EST ORDINAL
STD AL CLEAR ACCESS LEVEL
LJM PRSX RETURN
AORM DATA C* ADDRESS OUT OF RANGE.*
ILRM DATA C* LFM INCORRECT REQUEST.*
CRX SPACE 4,10
** CRX - CHECK RESEX CALL.
*
* EXIT RETURNS IF NOT CALLED.
* ABORTS IF RESEX DETECTED ERRORS.
* TERMINATES LFM IF CALL COMPLETED NORMALLY.
*
* USES T1, CM - CM+4, CN - CN+4.
CRX SUBR ENTRY/EXIT
LDD CP READ SPCW
ADC SPCW
CRD CM
LDD CM+2 CHECK RETURN STATUS
ZJN CRXX IF RESEX NOT CALLED
SCN 1
STD T1
LDN ZERL
CRD CN
LDD CP
ADC SPCW
CWD CN CLEAR SPCW
LDD T1
NJN CRX1 IF ERRORS FROM RESEX
LJM LFMX EXIT
CRX1 LDN /ERR/RDE * RESEX DETECTED ERRORS.*
LJM ERR PROCESS ERROR
FCN SPACE 4,10
** FCN - DEFINE FUNCTION PROCESSOR.
*
*
* FCN NAME,ORD
*
* ENTRY *NAME* = NAME OF FUNCTION PROCESSOR.
* *ORD* = REQUIRED FUNCTION ORDINAL, IF ORDINAL MUST
* REMAIN A PARTICULAR VALUE. AN ASSEMBLY ERROR
* WILL OCCUR IF THE ORDINAL ASSEMBLED DOES NOT
* AGREE WITH THE SPECIFIED *ORD* VALUE.
NOREF .I
.I SET 0
FCN MACRO A,B
LOC .I/2
IFNE B,0
ERRNZ .I/2-B ASSEMBLED ORDINAL NOT AS SPECIFIED
ENDIF
CON A/10000,A-A/10000*10000
.I SET .I+2
ENDM
TFCN SPACE 4,10
** TFCN - TABLE OF FUNCTION CODE PROCESSORS.
*
* 2 BYTES PER ENTRY.
*
*T, 12/ OV,12/ ADDR
* OV OVERLAY NAME
* ADDR ADDRESS OF FUNCTION PROCESSOR
TFCN BSS 0
FCN RNI RENAME INITIALIZATION
FCN 0 (UNUSED)
FCN 0 (UNUSED)
FCN STS SET FILE STATUS
FCN 0 (UNUSED)
FCN 0 (UNUSED)
FCN 0 (UNUSED)
FCN FSL SET FILE ACCESS LEVEL
FCN LCK LOCK FILE
FCN ULK UNLOCK FILE
FCN RLS RETURN LAST STATUS
FCN RCP RETURN CURRENT POSITION
FCN RQI REQUEST EQUIPMENT
FCN AEQ ASSIGN EQUIPMENT
FCN 0 (UNUSED)
FCN 0 (UNUSED)
FCN ALF ACCESS LIBRARY FILE
FCN ACS ATTACH COMMAND FILE
FCN ECS ENTER COMMAND FILE
FCN PCS POSITION COMMAND FILE
FCN LBI LABEL REQUEST
FCN GTF GET FNT/FST ENTRY
FCN OAE REQUEST OPERATOR ASSIGNMENT OF EQUIPMENT
FCN VSN ENTER VSN ENTRY FILE
FCN 0 (UNUSED)
FCN PRI MAKE FILE PRIMARY
FCN RFI RETURN FILE INFORMATION
FCN SLF SET LAST FILE EXECUTED
FCN 0 (UNUSED)
FCN 0,35 (RESERVED FOR INSTALLATIONS - MUST BE 35B)
FCN 0,36 (RESERVED FOR INSTALLATIONS - MUST BE 36B)
FCN 0,37 (RESERVED FOR INSTALLATIONS - MUST BE 37B)
LOC *O
TFCNL EQU *-TFCN
TITLE RESIDENT PROCESSORS.
ALF SPACE 4,25
*** FUNCTION 20.
* ACCESS LIBRARY FILE.
*
* ENTRY (FF) = FET SPECIFIED FNT ADDRESS.
* (FN - FN+3) = FILE NAME FROM FET+0.
* (FP) = FUNCTION PARAMETER.
* 0 = ACCESS LIBRARY FILE.
* 1 = ASSIGN *SYSTEM* FILE.
*
* EXIT FOR SUBFUNCTION 0 (ACCESS LIBRARY FILE), THE
* FOLLOWING INFORMATION IS RETURNED.
* RANDOM ADDRESS OF DIRECTORY STORED IN (FET+6).
* ADDRESS BIAS FOR DIRECTORY STORED IN (FET+7).
* SIGN BIT IN (FET+7) SET IF PROCEDURE FILE.
* IF FILE IS ACCESSED FROM *CLD*, A LOCAL FNT ENTRY IS
* CREATED, ASSIGNED TO THE CONTROL POINT AND POSITIONED
* AT THE FILE.
*
* FOR SUBFUNCTION 1 (ASSIGN *SYSTEM* FILE), A LOCAL
* FILE WITH *LIFT* FILE TYPE WILL BE CREATED TO
* ACCESS THE *SYSTEM* FILE IF THE JOB IS SYSTEM
* ORIGIN OR IF THE USER IS ALLOWED TO ACCESS
* THE SYSTEM FILE.
ALF LDD FP
ZJN ALF4 IF ACCESS LIBRARY FILE FUNCTION
* ASSIGN *SYSTEM* FILE.
LDD FF SET INITIAL LOCAL FNT ADDRESS
RJM SAF SEARCH FOR ASSIGNED FILE
NJN ALF3 IF LOCAL FILE PRESENT
ALF1 LDD OC CHECK JOB ORIGIN
LMK SYOT
ZJN ALF2 IF SYSTEM ORIGIN JOB
LDD CP CHECK USER ACCESS
ADK AACW
CRD CM
LDD CM+4
SHN 21-5
MJN ALF2 IF LEGAL TO ACCESS SYSTEM FILE
LDN /ERR/IUA * USER ACCESS NOT VALID.*
UJN ALF5 PROCESS ERROR
ALF2 RJM SSA SET SYSTEM FILE FNT ADDRESS
ERRNZ FNTG CHECK IF NOT WORD 0 OF SYSTEM FNT ENTRY
CRD CN READ SYSTEM FILE FNT WORD
RJM CPF COMPARE FILE NAMES
ZJN ALF3 IF FILE NAMES MATCH
LDN /ERR/FNF * FILE NOT FOUND.*
UJN ALF5 PROCESS ERROR
ALF3 RJM SSA READ SYSTEM FILE FST WORD
ADN FSTG
CRD CN
LJM ALF16 CONTINUE PROCESSING
* ACCESS LIBRARY FILE.
ALF4 LDN ZERL CLEAR FET+7
CRD CM
LDD FE
SBN 7
PJN ALF6 IF FET LONG ENOUGH
LDN /ERR/FTS * FET TOO SHORT.*
ALF5 LJM ERR PROCESS ERROR
ALF6 RJM CPA
ADN 7
CWD CM
LDD FF SET INITIAL FNT ADDRESS
RJM SAF SEARCH FOR ASSIGNED FILE
* SEARCH USER LIBRARY DIRECTORY (LBD).
LDD FE
SBN 10
MJN ALF6.5 IF FET LENGTH LESS THAN 9 WORDS
RJM CPA GET FILE NAME FROM FET+8
ADN 10
CRD FN
LDD FN
NJN ALF6.5 IF FILE NAME IS NON-ZERO
RJM CPA RESTORE FILE NAME FROM FET+0
CRD FN
ALF6.5 LDK LBDP GET LBD POINTER
CRD T1
LDD T3 MOVE POINTER
STD T1
LDD T3+1
STD T1+1
ALF7 LDD T1 READ DIRECTORY ENTRY
SHN 14
ADD T1+1
CRD CN
LDN 2 ADVANCE POINTER
RAD T1+1 ADVANCE DIRECTORY INDEX
SHN -14
RAD T1
LDD CN
ZJN ALF8 IF END OF DIRECTORY
RJM CPF COMPARE FILE NAMES
NJN ALF7 IF NO MATCH
AOM ALFB FLAG LBD PROCESSING
LJM AFL13 PROCESS MATCH
* SEARCH ENTRY POINT DIRECTORY (EPD).
ALF8 LDD MA SET ENTRY POINT NAME
CWD FN
CRD AB
LDD AB+3
SCN 77
STD AB+3
LDN 0
STD AB+4
RJM CLD SEARCH CENTRAL LIBRARY DIRECTORY
NJN ALF9 IF ENTRY FOUND
LDD FA
NJN AFL12 IF FILE ALREADY LOCAL
LJM ALF1 ASSIGN *SYSTEM* FILE
* PROCESS CLD ENTRY POINT.
ALF9 CRD CN READ PST ENTRY
SBN 1 READ SYSTEM FILE LOCATION
CRM CRFA,ON
LDD CN+1
LPN 37
LMN 3 RELOCATABLE TYPE RECORD
NJN ALF10 IF NOT RELOCATABLE
RJM CRF CREATE RELOCATABLE FNT FOR CLD
LJM ALF18 RETURN
ALF10 LMN 20&3 CHECK FOR *PROC*
ZJN ALF11 IF *PROC* RECORD
LMN 0&20 *TEXT* RECORD
NJN AFL12 IF NOT A *TEXT* RECORD
ALF11 LDN 1 FLAG *PROC* AND *TEXT* FILE PROCESSING
RJM CFN CREATE FNT ENTRY
ZJN ALF14 IF SAME ENTRY
AFL12 LDN 0 CLEAR FNT ADDRESS
STD FA
LDN /ERR/DFN * DUPLICATE FILE NAME.*
LJM ERR PROCESS ERROR
* BEGIN LBD PROCESSING.
AFL13 LDN 0 FLAG *ULIB* PROCESSING
RJM CFN CREATE FNT ENTRY
NJN AFL12 IF ERROR
ALF14 LDD T1 READ CONTROL WORD
SHN 14
ADD T1+1
ALFB SBN 0 EPD MATCH FOUND
* SBN 1 (LBD MATCH FOUND)
CRD CM
CRD T3
LDN 0
STD CM
STD T3
LDD CM+3
SHN 6
MJN AFL12 IF NOT RANDOM ADDRESS
LDC * SET *ULIB*/*PROC* BIT
* LDC 0 (ULIB PROCESSING)
* LDC 1 (PROC AND TEXT PROCESSING)
ALFA EQU *-1
STD CM
SOD CM+4
PJN ALF15 IF NO UNDERFLOW
AOD CM+4
SOD CM+3
ALF15 RJM CPA STORE FET + 6
ADN 6
CWD T3
ADN 1 STORE (FET+7)
CWD CM
ALF16 LDD FA
ZJN ALF17 IF FILE NOT ASSIGNED
LDN 0 CLEAR FNT ADDRESS
STD FA
LJM LFMX EXIT
ALF17 LDN NEEQ SET NULL EQUIPMENT
STD EQ
RJM CPA RESTORE FILE NAME FROM FET+0
CRD FN
RJM EFN ENTER FILE NAME
LDD CN SET FST ENTRY
STD FS
LDD CN+1
STD FS+1
STD FS+2
LDN FSMS
STD FS+3
ALF18 LDD TH
ERRNZ 1000-LIFT*100 ADJUST IF VALUE CHANGES
STD FN+4
LDD FN+3 SET LOCK
SCN 77
LMN 1
STD FN+3
NFA FA,R STORE FNT WORD
CWD FN
LJM LFMX EXIT
CFN SPACE 4,15
*** CFN - CREATE FNT ENTRY.
*
* ENTRY (A) = 0, IF NOT A PROC OR TEXT FILE.
* (A) = 1, IF IS A PROC OR TEXT FILE.
*
* EXIT (A) = 0, IF SAME FILE.
* (A) .NE. 0, IF NOT SAME FILE.
*
* USES CM - CM+4, CN - CN+4, FS - FS+4.
*
* CALLS SSA.
*
* MACROS NFA, SFA.
CFN SUBR ENTRY/EXIT
SHN 13
STM ALFA
RJM SSA SET SYSTEM FILE FNT ADDRESS
ADN FSTG
CRD CN
LDD FA
ZJN CFNX IF NO ASSIGNED FILE
NFA FA,R READ FST WORD
ADN FSTL
CRD FS
SFA EST,FS
ADK EQDE
CRD CM
LDD CM
SHN -12
LMN 3
NJN CFNX IF NOT A SYSTEM DEVICE
LDD CN+1
LMD FS+1
UJN CFNX RETURN
RNI SPACE 4,10
** RNI - RENAME INITIALIZATION.
RNI RJM CRX CHECK RESEX CALL
LDC RNM SET ENTRY
UJN RQI3 SET OVERLAY REQUEST
RQI SPACE 4,10
** RQI - EQUIPMENT REQUEST INITIALIZATION.
*
* ENTRY (FF) = FET SPECIFIED FNT ADDRESS.
* (FN - FN+3) = FILE NAME FROM FET+0.
RQI LDD FF SET INITIAL FNT ADDRESS
RJM SAF SEARCH FOR ASSIGNED FILE
ZJN RQI2 IF FILE NOT FOUND
RQI1 LDN 0 CLEAR FNT ADDRESS
STD FA
LJM LFMX EXIT
RQI2 LDC REQ SET ENTRY
RQI3 STM LFMB
SHN -14 SET OVERLAY NAME
STM LFMA
LJM LFM1 PROCESS REQUEST
LBI SPACE 4,10
** LBI - LABEL REQUEST INITIALIZATION.
LBI RJM CRX CHECK RESEX CALL
RJM SVF SEARCH FOR VSN FILE
NJN RQI1 IF NON-VSN FILE FOUND
LDC LBR SET ENTRY
UJN RQI3 SET OVERLAY REQUEST
TITLE RESIDENT PROCESSOR SUBROUTINES.
CPF SPACE 4,10
** CPF - COMPARE FILE NAMES.
*
* ENTRY (CN - CN+3) = FIRST FILE NAME.
* (FN - FN+3) = SECOND FILE NAME.
*
* EXIT (A) = 0 IF FILE NAMES MATCH.
CPF SUBR ENTRY/EXIT
LDD CN COMPARE FILE NAMES
LMD FN
NJN CPFX IF NO MATCH
LDD CN+1
LMD FN+1
NJN CPFX IF NO MATCH
LDD CN+2
LMD FN+2
NJN CPFX IF NO MATCH
LDD CN+3
LMD FN+3
SCN 77
UJN CPFX RETURN
CRF SPACE 4,20
** CRF - CREATE RELOCATABLE ROUTINE FNT.
*
* ENTRY (FN - FN+4) = FILE NAME.
* (CN - CN+4) = DIRECTORY ENTRY.
* (T1 - T1+1) = POINTER TO ENTRY IN PST.
*
* EXIT (FA) = FILE FNT ADDRESS.
* (FS - FS+4) = FST INFORMATION.
*
* USES EQ, FS - FS+3, CM - CM+4, CN - CN+4.
*
* CALLS EFN, SSA.
*
* MACROS SFA.
*
* NOTE - *CRF* WILL POSITION THE FST TO THE LOCATION
* OF THE RELOCATABLE PROGRAM ON THE SYSTEM
* DEVICE OR THE *ASR* DEVICE.
CRF SUBR ENTRY/EXIT
LDD T1 READ PST CONTROL WORD
SHN 14
ADD T1+1
CRD CN
LDN NEEQ SET EST ORDINAL
STD EQ
RJM EFN ENTER FILE NAME
* SET FST INFORMATION.
LDD CN+2 SET EST ORDINAL
LPC 777
STD FS
LDD CN+1 CHECK FOR ASR RESIDENT PROGRAM
SHN 21-13
PJN CRF1 IF NOT *ASR* DEVICE
SFA EST,FS CHECK FOR DEVICE *ON*
ADK EQDE
CRD CM
LDD CM
SHN 21-1
MJN CRF2 IF DEVICE OFF
LDD CN+3 SET FIRST = CURRENT
STD FS+1
STD FS+2
LDD CN+4
STD FS+3
UJN CRFX RETURN
CRF1 LDD CN+3 GET TRACK
STM CRFA+3
LDD CN+4 GET SECTOR
STM CRFA+4
CRF2 RJM SSA SET SYSTEM FILE FNT ADDRESS
ADN FSTG
CRD CM
LDD CM SET SYSTEM EQUIPMENT
STD FS
LDM CRFA+3 SET FIRST = CURRENT
STD FS+1
STD FS+2
LDM CRFA+4 SET SECTOR
STD FS+3
LJM CRFX RETURN
CRFA BSS 5 SYSTEM DEVICE INFORMATION
SSA SPACE 4,10
** SSA - SET SYSTEM FILE FNT ENTRY ADDRESS.
*
* EXIT (A) = ABSOLUTE ADDRESS OF SYSTEM FILE ENTRY.
*
* USES CM - CM+4.
SSA SUBR ENTRY/EXIT
LDN FNTP FETCH FNT POINTER
CRD CM
LDD CM GET SYSTEM FILE FNT ADDRESS
SHN 14
ADD CM+1
* ADN SYFO*FNTE
ERRNZ SYFO SYSTEM FILE IS NOT FIRST SYSTEM FNT ENTRY
UJN SSAX RETURN
SPACE 4,10
** COMMON DECKS.
*CALL COMPCLD
*CALL COMPCRS
SPACE 4,10
IFP HERE DUMP *IFP* REMOTE CODE
SPACE 4
** DEFINE ZERO LEVEL OVERLAY LOAD ADDRESS.
.L1 EQU 7777-1-ZBFL LENGTH OF *0BF*
.L2 EQU BFMS-1-ZDFL LENGTH OF *0DF*
.L3 MIN .L1,.L2
OVL0 EQU .L3 DEFINE ZERO LEVEL OVERLAY LOAD ADDRESS
SPACE 4,10
ERRNG OVL0-* CODE OVERFLOWS INTO ZERO LEVEL OVERLAYS
OVERLAY (ERROR PROCESSOR.)
ERP SPACE 4,10
** ERP - ERROR PPROCESSOR.
*
* ENTRY (EQ) = ERROR NUMBER.
ENTRY ERP
LDM ERPA,EQ
ZJN ERP1 IF NO DAYFILE MESSAGES ARE TO BE ISSUED
LDC =C* LFM ERROR.*
RJM DFM ISSUE DAYFILE MESSAGE
LDD EQ
LMN /ERR/DFN
NJN ERP0 IF NOT *DUPLICATE FILE NAME*
STD FN+4 TERMINATE FILE NAME
LDD FN+3
SCN 77
STD FN+3
LDM ERPA,EQ ADD FILE NAME TO MESSAGE
ADN 13
STD T1
LDN FN
RJM /COMPACS/ACS
LDC =C*. * ADD PERIOD
RJM /COMPACS/ACS
ERP0 LDM ERPA,EQ
LMC CPON
RJM DFM ISSUE DAYFILE MESSAGE
ERP1 RJM SNB SET FILE(S) NOT BUSY
ERP2 RJM SFS SET FILE STATUS
LDD EQ
LMN /ERR/LNV
ZJN ERP4 IF *ACCESS LEVEL NOT VALID FOR FILE* ERROR
MONITOR ABTM ABORT CONTROL POINT
ERP3 LJM PPR EXIT TO PP RESIDENT
ERP4 LDN SVET SET SECURITY VIOLATION ERROR FLAG
STD CM+1
MONITOR CEFM SET ERROR FLAG
MONITOR DPPM DROP PP
UJN ERP3 EXIT TO PPR
ERPA BSS 0
QUAL ERR
LOC 0
FNF CON =C* FILE NOT FOUND.*
FLN CON =C* FILE NAME ERROR.*
IFT CON =C* INCORRECT FILE TYPE.*
FLE CON =C* FILE EMPTY.*
MNA CON =C* MAGNETIC TAPE SUBSYSTEM NOT ACTIVE.*
CFE CON =C* COMMAND FILE ERROR.*
IEQ CON =C* INCORRECT EQUIPMENT.*
WEQ CON =C* EQUIPMENT NOT AVAILABLE.*
DFN CON =C* DUPLICATE FILE NAME - *
IUA CON =C* USER ACCESS NOT VALID.*
LNV CON =C* ACCESS LEVEL NOT VALID FOR FILE.*
CON 0 NOT USED
RDE CON 0 RESEX DETECTED ERROR
IOE CON =C* I/O SEQUENCE ERROR.*
CON 0 NOT USED
CON 0 NOT USED
NMA CON =C* NO MASS STORAGE AVAILABLE.*
ILM CON =C* INCORRECT FILE MODE.*
FTS CON =C* FET TOO SHORT.*
GTL CON =C* GETFNT TABLE TOO LARGE.*
CON 0 NOT USED
PBB CON =C* PARAMETER BLOCK BUSY.*
AOR CON =C* ADDRESS OUT OF RANGE.*
SYE CON =C* SYSTEM ERROR.*
IRA CON =C* INCORRECT RANDOM ADDRESS.*
ODE CON =C* OPTICAL DISK SYSTEM ERROR.*
IFS CON =C* INCORRECT FILE STATUS.*
LOC *O
QUAL *
SPACE 4,10
ERRNG OVL0-* CODE OVERFLOWS INTO ZERO LEVEL OVERLAYS
OVERFLOW OVL
OVERLAY (LOCAL FILE FUNCTIONS.)
SPACE 4,10
**** ADDITIONAL DIRECT LOCATION ASSIGNMENTS.
UD EQU 60 - 64 UDT WORD BUFFER (5 LOCATIONS)
ST EQU 65 FILINFO STATUS BYTE (1 LOCATION)
SX EQU 66 FILINFO EXTENDED STATUS (1 LOCATION)
****
RNM SPACE 4,25
*** FUNCTION 0.
* RENAME FILE.
*
* RENAME FILE TO THE NAME SPECIFIED IN (FET+6).
*
* RENAME,A=B.
* RENAME *B* TO *A*.
*
* 1. IF FILE *A* DOES NOT EXIST, THEN THE FILE NAME OF *B*
* IS CHANGED TO *A* IN THE LOCAL FNT.
*
* 2. IF FILE *A* EXISTS, THEN
* A. *0DF* IS CALLED TO DROP THE LOCAL AND GLOBAL FNT
* ENTRY FOR FILE *A*.
* NOTE - IF FILE *A* IS NAMED /INPUT/, *0DF* DOES NOT
* DROP THE FILE BUT RATHER CHANGES THE NAME TO /INPUT*/.
*
* B. THE FILE NAME OF *B* IS CHANGED TO *A* IN THE
* LOCAL FNT.
*
* * INCORRECT FILE TYPE.* - FILE *B* IS NOT TYPE LOFT, OR THE
* FILE TYPES OF *A* AND *B* ARE NOT THE SAME.
*
* ENTRY (FF) = FET SPECIFIED FNT ADDRESS.
ENTRY RNM
LCN 6 CHECK FET LENGTH .GE. 7
RJM CFL
LDD FF SET INITIAL FNT ADDRESS
RJM SIF SEARCH AND INTERLOCK FILE
LDD FA SET FNT ADDRESS OF *B*
STM RNMA
LDD FS+2 CHECK CURRENT TRACK
NJN RNM1 IF FILE HAS BEEN USED
AOM RNMD SET ERROR FLAG
RNM1 LDD FS SAVE EST ORDINAL IN *CFT*
STM CFTB
SFA EST
ADK EQDE
RJM CDP CHECK FOR DMP= CALLING PROGRAM
LDD CM+3
LPN 77
STM RNMC SET STATUS
LDD CM+4 CHECK FILE TYPE
STM RNMB PRESET FILE TYPE
SHN -6
RAM CFTA SET FILE TYPE
* GET NEW FILE NAME FROM FET.
RJM CPA READ NEW NAME - *A*
ADN 6
CRD FN
LDD FA SET FNT ADDRESS OF FILE *B*
STM SNBA
LDN 0 SET NO INITIAL FNT ADDRESS
RJM SAF SEARCH FOR ASSIGNED FILE
NJN RNM2 IF FILE *A* ALREADY EXISTS
* LDN 0
LJM RNM5 GET *B* FST
* CHECK FILE TYPE OF *A*.
RNM2 LMM RNMA
ZJN RNM3 IF SAME FILE
RJM SFB SET FILE *A* BUSY
ZJN RNM4 IF NO REJECT ON FILE INTERLOCK
LDN /ERR/IOE * I/O SEQUENCE ERROR.*
UJN RNM6 PROCESS ERROR
* EXIT WHEN FILE NAMES ARE THE SAME.
RNM3 STD FA
LJM LFMX EXIT
RNM4 RJM CFT CHECK FILE TYPE
NJN RNM7 IF INCORRECT FILE TYPE
RJM DRF DROP FILE *A*
* LDN 0
RNM5 STM SNBA
LDC 0 RESTORE FILE *B* FNT ADDRESS
RNMA EQU *-1
STD FA
NFA FA,R
ADN FSTL
CRD FS LOAD ORIGINAL FST ENTRY
RJM VFN VERIFY FILE NAME
NJN RNM8 IF NO ERROR
LDN /ERR/FLN FILE NAME ERROR
RNM6 LJM ERR PROCESS ERROR
* EXIT IF INCORRECT FILE TYPE ON FILE *B*.
RNM7 LDN /ERR/IFT * INCORRECT FILE TYPE.*
UJN RNM6 PROCESS ERROR
* CHANGE FILE NAME FROM *B* TO *A* IN FNT WORD.
RNM8 LDC * RESTORE FILE TYPE OF *B*
RNMB EQU *-1 FILE TYPE
STD FN+4
LDD FN+3 RESTORE FILE STATUS OF *B*
SCN 77
ADC *
RNMC EQU *-1 FILE STATUS
STD FN+3
NFA FA,R WRITE NEW FNT WORD
CWD FN
LDD FN+4
SHN -6
LMN PTFT
NJN RNM10 IF NOT PRIMARY TERMINAL TYPE
RNMD LDN 0
* LDN 1 (FILE NOT USED)
ZJN RNM9 IF FILE USED
LDN /ERR/FLE EMPTY FILE
LJM ERR PROCESS ERROR
RNM9 RJM UPP UPDATE PRIMARY FILE POINTERS
RNM10 LDN 0 SET TO NON-TAPE EQUIPMENT
* LDN 1 (TAPE EQUIPMENT)
RNME EQU *-1
NJN RNM11 IF TAPE EQUIPMENT
SFA EST,FS GET EQUIPMENT TYPE
ADK EQDE
CRD CM
LDD CM+3
LMC 2ROD
ZJP RNM12 IF OPTICAL DISK FILE
LJM LFMX EXIT
* PROCESS TAPE EQUIPMENT.
RNM11 LDN 0
STD CM+1
MONITOR ROCM ROLLOUT JOB
LDD IA READ REQUEST
CRD CM
CRD CN
LDD CN+1
SCN 77
ADN 20 SET RECALL PP PROCESSOR BIT
STD CN+1
STD CM+1
LDD CN+3
LPN 77
STD CN+3
LDD CP
ADC SPCW
CWD CN ENTER EXTERNAL CALL
LDD RA REWRITE USERS CALL
SHN 6
ADN 1
CWD CM
RJM CPA SET ORIGINAL NAME IN FET + 0
CRD FN
LJM LFMX EXIT
* PROCESS OPTICAL DISK EQUIPMENT.
RNM12 RJM CPA READ OLD FILE NAME
CRD FN
RJM SOF SEARCH OPTICAL DISK FILE
ZJN RNM14 IF FILE FOUND
RNM13 NFA FA,R RESTORE FNT/FST WORDS
CRD FN
ADN FSTL
CRD FS
LDN /ERR/ODE * OPTICAL DISK SYSTEM ERROR.*
LJM ERR PROCESS ERROR
RNM14 NFA FA,R SET NEW FILE NAME IN LABEL RECORD
CRM BFMS+2,ON
LDM BFMS+5
SCN 77
STM BFMS+5
LDN 0
STM BFMS+6
SETMS IO,RW
LDC BFMS+WLSF
RJM WDS WRITE SECTOR
MJN RNM13 IF WRITE ERROR
ENDMS
NFA FA,R RESTORE FNT/FST WORDS
CRD FN
ADN FSTL
CRD FS
LJM LFMX EXIT
STS SPACE 4,10
*** FUNCTION 3.
* SET FILE STATUS.
*
* ENTRY (IR+3 - IR+4) = FET ADDRESS.
* (FN - FN+3) = FILE NAME FROM FET+0.
* (FF) = FET SPECIFIED FNT ADDRESS.
* (FP) = FILE STATUS.
ENTRY STS ENTRY
LDD CP CHECK FOR *SSJ=* CALLER
ADC SEPW
CRD CM
LDD CM
SHN 21-2
MJN STS2 IF CALLER IS *SSJ=*
* FOR NON-*SSJ=* CALLER, VERIFY THAT VALUE SPECIFIED
* IS ALLOWED. OTHERWISE IGNORE REQUEST.
AOM STSA INDICATE NON-*SSJ=* CALLER
LDN TNFSL-1
STD T1
STS1 LDM TNFS,T1 CHECK IF SPECIFIED VALUE IS IN TABLE
LMD FP
ZJN STS2 IF NEW STATUS FOUND IN TABLE
SOD T1
PJN STS1 IF NOT END OF TABLE
LJM LFMX EXIT
STS2 LDD FP CHECK SPECIFIED STATUS
SBN MXST
MJN STS5 IF LEGAL STATUS
LDN /ERR/IFS * INCORRECT FILE STATUS.*
STS3 LJM ERR PROCESS ERROR
* CHECK CURRENT VALUE OF FILE STATUS FIELD.
STS4 NFA FA,R READ LOCAL FNT WORD
CRD FS
RJM SFB SET FILE BUSY
ZJN STS6 IF FILE SET BUSY
LDN /ERR/IOE * I/O SEQUENCE ERROR.*
UJN STS3 PROCESS ERROR
STS5 LDD FF SEARCH FOR ASSIGNED FILE
RJM SAF
NJN STS4 IF FILE FOUND
RJM EFN CREATE LOCAL FILE
NFA FA,R
CRD CM
* FOR A NON-*SSJ=* CALLER, VERIFY THAT THE CURRENT STATUS
* IS A VALUE THAT MAY BE CHANGED.
STS6 LDN 0
* LDN 1 (NON-*SSJ=* CALLER)
STSA EQU *-1
ZJN STS9 IF CALLER IS *SSJ=*
LDN TOFSL-1
STD T1
STS7 LDM TOFS,T1 COMPARE EXISTING STATUS WITH TABLE
LMD CM+4
LPN 77
ZJN STS9 IF EXISTING STATUS FOUND IN TABLE
SOD T1
PJN STS7 IF NOT END OF TABLE
STS8 LJM LFMX IGNORE REQUEST
* SET NEW FILE STATUS.
STS9 LDD CM+4
SCN 77
LMD FP
STD CM+4
NFA FA,R REWRITE FNT WORD
CWD CM
UJN STS8 EXIT
* TABLE OF STATUSES THAT MAY BE SET BY USER.
TNFS BSS 0
CON 0
CON NDST
TNFSL EQU *-TNFS
* TABLE OF STATUSES THAT MAY BE CHANGED BY USER.
TOFS BSS 0
CON 0
CON UPST
CON NDST
TOFSL EQU *-TOFS
FSL SPACE 4,20
*** FSL - FUNCTION 7.
*
* SET FILE ACCESS LEVEL.
*
* ENTRY (IR+3 - IR+4) = FET ADDRESS.
* (FET+1, BIT 39) = SECURITY PROCESSING BIT-
* = NONZERO, TAKE ACCESS LEVEL
* FROM FET+4, BITS 36-38.
* = ZERO, USE JOB SECURITY ACCESS LEVEL.
* (FN - FN+4) = FILE NAME.
ENTRY FSL
LDN 0 SET FILE BUSY
RJM SIF
SFA EST,FS READ EST ENTRY
ADK EQDE
CRD CN
LDD CN+3
RJM CTE CHECK FOR TAPE EQUIPMENT
PJN FSL0 IF TAPE FILE
LDD CM+4 CHECK FILE TYPE
SHN -6
LMN LOFT
ZJN FSL1 IF *LOFT*
LMN PTFT&LOFT
ZJN FSL1 IF *PTFT*
LMN QFFT&PTFT
ZJN FSL1 IF *QFFT*
FSL0 LDN /ERR/IFT * INCORRECT FILE TYPE.*
LJM ERR PROCESS ERROR
* EXTRACT REQUESTED SECURITY ACCESS LEVEL.
FSL1 RJM CPA READ FET+1
ADN 1
CRD CN
ADN 3 READ FET+4
CRD CM
LDD CN+1 CHECK *SP* BIT
SHN 21-3
PJN FSL2 IF NOT SET
LDD CM+1 EXTRACT SECURITY ACCESS LEVEL
UJN FSL3 CHECK REQUESTED LEVEL
FSL2 LDD CP READ JOB SECURITY WORD
ADC JSCW
CRD CM
LDD CM+1 EXTRACT JOB ACCESS LEVEL
SHN -11
* CHECK AND SET FILE SECURITY ACCESS LEVEL.
FSL3 LPN 7 SAVE REQUESTED LEVEL
STD CM+4
STM FSLB
LDD FA SET FNT ADDRESS
STD CM+3
LDN VSFS SET SUBFUNCTION
STD CM+1
MONITOR VSAM
LDD CM+1
NJN FSL4 IF INCORRECT ACCESS LEVEL
LJM LFMX EXIT
* PROCESS SECURITY VIOLATION.
FSL4 LDC FSLA+3 SET FILE NAME IN MESSAGE
STD T1
LDN FN
RJM /COMPACS/ACS
LDC =C*, * APPEND COMMA
RJM /COMPACS/ACS
LDC ** DETERMINE MNEMONIC OF ACCESS LEVEL
FSLB EQU *-1
SHN 2
ADC TALV APPEND NEW ACCESS LEVEL
RJM /COMPACS/ACS
LDC =C*. * TERMINATE MESSAGE WITH A PERIOD
RJM /COMPACS/ACS
LDC FSLA+ACFN ISSUE ACCOUNT FILE MESSAGE
RJM DFM
LDN /ERR/LNV * ACCESS LEVEL NOT VALID FOR FILE.*
LJM ERR PROCESS ERROR
FSLA DATA C*MFFI, *
BSSZ 12
LCK SPACE 4,10
*** FUNCTION 10.
* LOCK FILE.
* SET WRITE LOCKOUT FOR FILE.
* FILE MUST BE TYPE *LOFT* OR *PTFT*.
* THE FILE CAN ALSO BE TYPE *ROFT* IF CALLED BY *RESTART*.
*
* ENTRY (FF) = FET SPECIFIED FNT ADDRESS.
ENTRY LCK
LCK1 LDD FF SET INITIAL FNT ADDRESS
RJM SIF SEARCH AND INTERLOCK FILE
LDD CM+4
SHN -6
LMN LOFT
ZJN LCK3 IF LOCAL FILE TYPE
LMN PTFT&LOFT
ZJN LCK3 IF PRIMARY FILE TYPE
LMN ROFT&PTFT
NJN LCK1.1 IF NOT ROLLOUT FILE TYPE
LDM LCKA
LPN 1
ZJN LCK1.1 IF NOT *LOCK* FUNCTION
LDD CP
ADK SEPW
CRD CN
LDD CN+2
SHN 21-13
MJN LCK3 IF *RESTART*
LCK1.1 LDN /ERR/IFT * INCORRECT FILE TYPE.*
LCK2 LJM ERR PROCESS ERROR
LCK3 LDM LCKA
LPN 1
NJN LCK4 IF LOCK
LDD CM+3 CHECK FOR EXECUTE ONLY
SHN 21-2
PJN LCK4 IF NOT EXECUTE-ONLY
LDN /ERR/ILM * INCORRECT FILE MODE.*
UJN LCK2 PROCESS ERROR
LCK4 LDD CM+3
SCN 1
LCKA LMN 1
* LMN 0 (UNLOCK FUNCTION)
STD CM+3
NFA FA,R STORE FNT ENTRY
CWD CM
LJM LFMX EXIT
ULK SPACE 4,10
*** FUNCTION 11.
* UNLOCK FILE.
* CLEAR WRITE LOCKOUT FOR FILE.
* FILE MUST BE TYPE *LOFT* OR *PTFT* AND NOT EXECUTE-ONLY.
ENTRY ULK
SOM LCKA DO NOT SET WRITE LOCKOUT
LJM LCK1 PROCESS AS LOCK
RLS SPACE 4,10
*** FUNCTION 12.
* RETURN FILE FOUND/NOT FOUND.
*
* ENTRY (FF) = FET SPECIFIED FNT ADDRESS.
* (FN - FN+3) = FILE NAME FROM FET+0.
ENTRY RLS
LDD FF SET INITIAL FNT ADDRESS
RJM SAF SEARCH FOR ASSIGNED FILE
ZJN RLS2 IF NOT FOUND
RJM SFB SET FILE BUSY
ZJN RLS1 IF NO REJECT ON FILE INTERLOCK
LDN /ERR/IOE *I/O SEQUENCE ERROR.*
LJM ERR PROCESS ERROR
RLS1 LDN 2 FLAG FILE FOUND
RLS2 STD LS
LJM LFMX EXIT
RCP SPACE 4,20
*** FUNCTION 13.
* RETURN CURRENT POSITION AND STATUS.
* RETURN FILE ACCESS LEVEL IN FET+4 IF BIT 39 IN FET+1 IS SET.
* RETURN FNT ENTRY IN (FET+5).
* RETURN FST ENTRY IN (FET+6).
* OPTIONALLY RETURNS ADDITIONAL MAGNETIC TAPE INFORMATION
* TO FET+8 IN LABEL MACRO FORMAT.
* FIELDS RETURNED TO FET+8 INCLUDE -
* 1. LABEL BIT (58)
* 2. NONSTANDARD LABEL BIT (57)
* 3. TAPE DEVICE TYPE (55-56)
* 4. DENSITY (51-53)
* 5. CONVERSION MODE (48-50)
* 6. PROCESSING OPTIONS (36-47)
* 7. FORMAT (30-35)
* 8. NOISE SIZE (24-29) - IN FRAMES
* 9. BLOCK SIZE (0-23) - IN CM WORDS
* REFER TO LFM FUNCTION 24 DOCUMENTATION FOR FURTHER
* DETAILS ON CONTENTS OF FET+8 FIELDS.
*
* ENTRY (FF) = FET SPECIFIED FNT ADDRESS.
ENTRY RCP
LCN 6 CHECK FET LENGTH .GE. 7
RJM CFL
LDD FF SET INITIAL FNT ADDRESS
RJM SIF SEARCH AND INTERLOCK FILE
RJM CPA READ FIRST
ADN 1
CRD CN
ADN 3
CRD UD READ FET+4
ADN 1
CWD CM STORE FNT
ADN 1
CWD FS STORE FST
LDD CN+1 CHECK WHETHER TO RETURN FILE ACCESS LEVEL
SHN 21-3
PJN RCP0 IF NOT RETURNING FILE ACCESS LEVEL
NFA FA,R GET FILE ACCESS LEVEL
ADN FUTL
CRD CM
LDD CM+2 SET FILE ACCESS LEVEL IN FET+4
LMD UD+1
LPN 7
LMD UD+1
STD UD+1
RJM CPA WRITE FET+4
ADN 4
CWD UD
RCP0 LDN 0 INITIALIZE *FIRST* EQUIPMENT TYPE
STD CN
LDD FS READ EST ENTRY
ZJN RCP1 IF NO EQUIPMENT ASSIGNED
SFA EST
ADK EQDE
CRD CM
LDD CM+3 SET EQUIPMENT TYPE
STD CN
LDD CM CHECK EQUIPMENT TYPE
SHN 21-13
MJN RCP1 IF MASS STORAGE
SHN 21-12-21+13
MJN RCP1 IF ALLOCATABLE TYPE
LDC 4000
RAD CN
RCP1 RJM CPA STORE FIRST
ADN 1
CWD CN
LDD FP FUNCTION PARAMETER
LMN 1
NJN RCP2 IF EXTRA TAPE INFORMATION NOT REQUESTED
LDD CM+3
RJM CTE CHECK FOR TAPE EQUIPMENT
PJN RCP3 IF TAPE EQUIPMENT
RCP2 LJM LFMX EXIT
RCP3 STD FP SET TAPE DEVICE TYPE
LCN 10 CHECK FET LENGTH .GE. 9D
RJM CFL
LDN /MTX/UST4 GET *UST4* AND *UST5* WORDS FROM UDT
STD T1
LDN 2
RJM TUW READ UDT WORDS
LDD MA
CRD UD (UD - UD+4) = UST4
ADN 1
CRD CM (CM - CM+4) = UST5
LDN ZERL CLEAR FET+8 ASSEMBLY BUFFER
CRD CN
LDD UD SET LABELED FLAGS AND DEVICE TYPE
LPC 3700
STD CN
LDD CM CONVERT DENSITY
SHN -3
LPN 7
STD T2
LDD CM CONVERT CONVERSION MODE
LPN 7
SBN 1
RCP5 LMM TDEN-1,T2
RAD CN
LDD UD+1 SET PROCESSING OPTIONS
STD CN+1
* CONVERT NOISE BYTES (NB) AND FILL STATUS BACK TO NOISE SIZE
* (NS) IN FRAMES.
* 7-TRACK FORMULA -
* NS = NB * 2
* IF FILL STATUS, NS = NS - 1 = NB * 2 - 1
* 9-TRACK FORMULA -
* NS = ( NB * 3 ) / 2
* IF FILL STATUS, NS = NS - 1 = ( NB * 3 ) / 2 - 1
LDD FP CHECK TAPE DEVICE TYPE
LPN 1
NJN RCP7 IF *CT* OR *AT* DEVICE
LDD UD+2 FILL STATUS BIT
LPN 40
STD T1
LDD UD+2 NOISE SIZE IN BYTES
LPN 37
STD T2
SHN 1 NB * 2
STD CN+2
LDD FP
ZJN RCP6 IF 7-TRACK
LDD T2
ADD CN+2 NB + NB * 2
SHN -1 ( NB * 3 ) / 2
STD CN+2
RCP6 LDD T1
ZJN RCP7 IF NO FILL STATUS
SOD CN+2
RCP7 LDD UD+2 DATA FORMAT
LPC 7700
RAD CN+2
* RETURN BLOCK SIZE (IN CM WORDS).
* BLOCK SIZE = BLOCK WORD COUNT + CHUNK COUNT * 600B.
LDD UD+3 BLOCK WORD COUNT
STD CN+4
LDD UD+4 CHUNK COUNT
ZJN RCP9 IF NOT LONG BLOCK
STD T1
RCP8 LDC /MTX/LBWD
RAD CN+4
SHN -14
RAD CN+3
SOD T1
NJN RCP8 IF OVERFLOW COUNT NOT EXHAUSTED
* RETURN ADDITIONAL TAPE INFORMATION TO FET+8.
RCP9 RJM CPA STORE FET + 8
ADN 10
CWD CN
LJM LFMX EXIT
TUW SPACE 4,15
** TUW - TRANSFER UDT WORDS.
*
* ENTRY (A) = NUMBER OF WORDS TO TRANSFER.
* (T1) = FIRST WORD FROM UDT TO BE TRANSFERRED.
* (FS+1) = UDT ADDRESS OF ASSIGNED TAPE.
*
* EXIT CONTIGUOUS UDT WORDS REQUESTED IN MESSAGE BUFFER.
*
* ERROR TO *ERR* IF *MAGNET* NOT PRESENT.
* TO *LFMX*, IF ERROR FLAG SET ON CONTROL POINT.
*
* USES T1, T2, CM - CM+4.
*
* MACROS DELAY, MONITOR, PAUSE.
TUW SUBR ENTRY/EXIT
SHN 6
STD T2
LDD FS+1 UDT ADDRESS OF ASSIGNED TAPE
ZJN TUW2 IF NO UDT ADDRESS IN FST WORD
RAD T1 FWA IN MAGNET TO BE TRANSFERRED
TUW1 LDD T2 NUMBER OF WORDS TO TRANSFER
STD CM+3
LDD T1
STD CM+4
LDN 0 SET READ
STD CM+1
LCN 7777-MTSI SET *MAGNET* SUBSYSTEM ID
STD CM+2
MONITOR TDAM GET UDT WORDS
LDD CM+1
ZJN TUWX IF TRANSFER COMPLETE
SBN 3
TUW2 PJN TUW3 IF *MAGNET* NOT UP OR FUNCTION REJECT
PAUSE
DELAY
LDD CM+1
ZJN TUW1 IF NO ERROR FLAGS SET ON CP
LJM LFMX EXIT
TUW3 LDN /ERR/MNA * MAGNETIC TAPE SUBSYSTEM NOT ACTIVE *
LJM ERR PROCESS ERROR
RFI SPACE 4,30
*** RFI - FUNCTION 32.
* RETURN FILE INFORMATION.
* RETURN FILE INFORMATION TO USER IN SPECIFIED PARAMETER BLOCK.
*
* ENTRY (IR+3 - IR+4) = ADDRESS OF PARAMETER BLOCK.
* THE PARAMETER BLOCK SHOULD HAVE THE FOLLOWING FORMAT.
* (FE) = LENGTH OF PARAMETER BLOCK - 1.
* (FF) = FET SPECIFIED FNT ADDRESS.
*
*T ADDR 42/LFN, 6/LEN, 11/0, 1/0
*T,ADDR+1 60/,
*T,ADDR+2 60/,
*T,ADDR+3 60/,
*T,ADDR+4 60/,
* LEN = LENGTH OF TABLE, MUST BE .GE. 5.
*
* EXIT TO *ERR* IF ERROR ENCOUNTERED.
* PARAMETER BLOCK RETURNED TO USER IN THE FOLLOWING
* FORMAT.
*
*T ADDR 42/LFN, 6/LEN, 11/0, 1/1
*T ADDR+1 12/DEVICE TYPE, 12/RESERVED, 30/STATUS BITS, 6/FT
*T,ADDR+2 12/EQ, 48/0
*T,ADDR+3 24/FILE LENGTH IN SECTORS, 6/0, 24/CRA, 6/0
*T,ADDR+4 60/RESERVED
* LEN = LENGTH OF TABLE.
* STATUS BITS -
* 9/RESERVED.
* 2/TAPE DEVICE TYPE.
* 0 = 7-TRACK TAPE (*MT*).
* 1 = CARTRIDGE TAPE (*CT*).
* 2 = 9-TRACK TAPE (*NT*).
* 3 = ACS CARTRIDGE TAPE (*AT*).
* 1/TAPE FILE.
* 1/FILE AT EOI (MASS STORAGE ONLY).
* 1/FILE AT EOF (MASS STORAGE ONLY).
* 1/FILE AT BOI (MASS STORAGE ONLY).
* 1/LABELED TAPE FILE.
* 1/9-TRACK TAPE FILE.
* 1/7-TRACK TAPE FILE.
* 1/FILE OPEN.
* 1/INTERACTIVE TERMINAL FILE.
* 1/MASS STORAGE FILE.
* 1/FILE ON INACCESSIBLE DEVICE.
* 1/RESERVED.
* 1/FILE IS EXECUTE-ONLY.
* 1/FILE IN *RA* OR *RM* MODE.
* 1/FILE IN *RU* OR *RM* MODE.
* 1/FILE MAY BE ALTERED (*U*, *M* OR *W* MODE).
* 1/FILE MAY BE EXTENDED (*A*, *M* OR *W* MODE).
* 1/FILE MAY BE SHORTENED (*W* MODE).
* 1/FILE MAY NOT BE WRITTEN.
* FT = FILE TYPE.
* EQ = EST ORDINAL.
* CRA = CURRENT RANDOM ADDRESS.
*
* ADDITIONAL INFORMATION IS RETURNED BASED ON THE *KEY*
* SPECIFIED IN BITS 0-4 OF EACH WORD DEFINED IN THE *FILINFO*
* PARAMETER BLOCK BEYOND THE STANDARD 5 WORD LENGTH. THE KEY
* WORDS BEGIN AT THE *FILINFO* PARAMETER BLOCK ADDRESS + 5
* AND CAN BE IN ANY ORDER.
*
* KEY RETURNED WORD (IF APPLICABLE - ELSE BIT 5 IS SET)
*
* 1 48/0, 6/F, 1/0, 5/1
* 2 41/0, 1/IEP, 6/LBTYP, 3/DEN, 3/CV, 1/0, 5/2
* 3 RESERVED FOR ANSI 1977 LBL. STD.
* 4-13B RESERVED FOR CDC (COMMON O/S)
* 14B 12/0, 24/BSIZE, 12/PO, 6/NOISE, 1/0, 5/14B
* 15B-17B RESERVED FOR CDC (NOS ONLY)
* 20B-27B RESERVED FOR CDC (OTHER O/S-S)
* 30B-37B RESERVED FOR INSTALLATIONS
* F = TAPE FORMAT.
* 0 = INTERNAL BINARY (I)
* 1 = NOS/BE INTERNAL BINARY (SI)
* 2 = FOREIGN (F)
* 3 = STRANGER (S)
* 4 = LONG BLOCK STRANGER (L)
* 5 = LONG BLOCK INTERNAL BINARY (LI)
* 6-77B = RESERVED FOR CDC
* IEP = ERROR PROCESSING INHIBITED (IF SET).
* LBTYP = LABEL TYPE.
* 0 = UNLABELED
* 1 = STANDARD (ANSI 1969 STD.)
* 2 = RESERVED FOR CDC (ANSI 1977 STD.)
* 3-10B = RESERVED FOR CDC
* 11B-13B = NOS/BE ONLY
* 14B = NONSTANDARD (SKIP LABELS)
* 15B-67B = RESERVED FOR CDC
* 70B-77B = RESERVED FOR INSTALLATIONS
* DEN = TAPE DENSITY.
* 0 = NOT APPLICABLE
* 1 = 556 BPI (7-TRACK)
* 2 = 200 BPI (7-TRACK)
* 3 = 800 BPI (7- OR 9-TRACK)
* 4 = 1600 CPI (9-TRACK)
* 5 = 6250 CPI (9-TRACK)
* 6 = 38000 CPI (CARTRIDGE)
* 7 = RESERVED FOR CDC
* CV = CONVERSION MODE.
* 0 = BCD CONVERSION (7-TRACK)
* 1 = ASCII CONVERSION (9-TRACK)
* 2 = EBCDIC CONVERSION (9-TRACK)
* 3-7 = RESERVED FOR CDC
* BSIZE = MAXIMUM BLOCK SIZE (IN CM WORDS).
* PO = PROCESSING OPTIONS.
* 0 = ABORT ON IRRECOVERABLE PARITY ERROR
* WITH EP SET
* 1 = DO NOT ABORT ON IRRECOVERABLE PARITY
* WITHOUT EP SET
* 2 = INHIBIT ERROR PROCESSING
* 3 = ENFORCE RING OUT
* 4 = ENFORCE RING IN
* 5 = INHIBIT UNLOAD
* 6 = DISABLE GCR HARDWARE WRITE ERROR CORRECTION
* 7 = ISSUE ALL ERROR RECOVERY MESSAGES TO USER
* DAYFILE
* 8 = RESERVED FOR CDC
* 9-11 = END-OF-REEL PROCESSING OPTION
* 9 = OPTION *S*
* 10 = OPTION *P*
* 11 = OPTION *I*
* NOISE = NOISE SIZE (IN FRAMES).
ENTRY RFI RETURN FILE INFORMATION
LDN 0 CLEAR STATUS BYTES
STD ST
STD SX
LDN FIPBL*5-1*5-1
STD T1
RFI1 LDN 0 INITIALIZE PARAMETER BLOCK BUFFER
STM FIPB,T1
SOD T1
PJN RFI1 IF MORE WORDS TO CLEAR
RJM CPA GET PARAMETER BLOCK ADDRESS
CRD FN READ FIRST WORD OF PARAMETER BLOCK
ADN 1
CWM FIPB,ON ZERO WORD ONE OF PARAMETER BLOCK
LDD FN+4 CHECK IF COMPLETION BIT SET
SHN 21-0
PJN RFI2 IF COMPLETION BIT NOT SET
LDN /ERR/PBB * PARAMETER BLOCK BUSY.*
LJM ERR EXIT TO ERROR PROCESSOR
RFI2 LCN FIPBL-1 CHECK FET LENGTH .GE. MINIMUM LENGTH
RJM CFL
LDD FF SET INITIAL FNT ADDRESS
RJM SAF SEARCH FOR ASSIGNED FILE
NJN RFI3 IF FILE FOUND
LDN FIPBL-2 CLEAR REMAINDER OF PARAMETER BLOCK
STD T4
RJM CPA DETERMINE RETURN ADDRESS
ADN 2
CWM FIPB,T4
LJM LFMX EXIT
RFI3 RJM SFB SET FILE BUSY
ZJN RFI4 IF NO REJECT ON FILE INTERLOCK
LDN 0
STD FA
LDN /ERR/IOE * I/O SEQUENCE ERROR.*
LJM ERR EXIT TO ERROR PROCESSOR
* DETERMINE FILE TYPE.
RFI4 STD T4
LDD CM+4 GET FILE TYPE FROM FNT
SHN -6
STD T3
RFI5 LDM TAFT,T4 CHECK TABLE FOR MATCH
LMD T3
ZJN RFI6 IF MATCH
AOD T4
LMN TAFTL
NJN RFI5 IF NOT END OF TABLE
LDN 77 SET FILE TYPE = OTHER
STD T4
RFI6 LDD T4
STM FIPB+4 PLACE FILE TYPE IN PARAMETER BLOCK
LDD CM+3 PICK UP FILE ACCESS MODE
LPN 35 ISOLATE ACCESS MODE
STD EQ SAVE FILE ACCESS MODE
LDD FS GET EST ORDINAL
STD T5 SAVE EST ORDINAL
STM FIPB+1*5 PLACE EST ORDINAL IN PARAMETER BLOCK
ZJN RFI7 IF NOT ASSIGNED TO MASS STORAGE
SFA EST READ EST ENTRY FOR FILE
ADK EQDE
CRD CN
LDD CN+3 GET DEVICE TYPE
STM FIPB
LDD CN
SHN 21-13
MJN RFI7 IF MASS STORAGE
LJM RFI18 PROCESS NON MASS STORAGE
* CHECK FOR EOI, EOF, AND BOI FOR MASS STORAGE FILES.
RFI7 LDD FS+4 SET MASS STORAGE AND OPEN BITS
SHN -3
LPN 40
ADN 10
STD ST
LDD T5
ZJN RFI7.1 IF NOT ASSIGNED TO MASS STORAGE DEVICE
SETMS STATUS
LDM MSD
SHN 21-6
PJN RFI7.1 IF DEVICE ACCESSIBLE
LDN 4
RAD ST
RFI7.1 LDD FS+4 CHECK FOR EOF OR EOI
SHN 21-3
PJN RFI9 IF NOT EOI OR EOF
SHN 3-2
MJN RFI8 IF NOT EOF
LDN 2 SET BIT TO INDICATE EOF
UJN RFI10 SET UP FILE MODE FIELDS
RFI8 LDN 4 SET BIT TO INDICATE EOI
SHN 11
RAD ST
RFI9 LDD FS+1 CHECK FOR EMPTY FILE
ZJN RFI9.1 IF EMPTY FILE
LMD FS+2
NJN RFI11 IF FIRST TRACK .NE. CURRENT TRACK
LDD FS+3
LMN FSMS
NJN RFI11 IF CURRENT SECTOR .NE. FSMS
RFI9.1 LDN 1 SET BIT TO INDICATE BOI
RFI10 SHN 11
RAD ST
* DETERMINE FILE LENGTH.
RFI11 LDD FS+1 SET FIRST TRACK
ZJN RFI13 IF NO FIRST TRACK
STD T6
RJM SEI DETERMINE FILE LENGTH
SOD T3 SET FILE LENGTH IN PARAMETER BLOCK
PJN RFI12 IF NO BORROW
LDD T2
ZJN RFI12 IF LENGTH IS ZERO
SOD T2 BORROW
LCN 0
RFI12 STM FIPB+2*5+1
LDD T2
STM FIPB+2*5
* DETERMINE RANDOM ADDRESS.
RFI13 LDD FS+2 SET TRACK
ZJN RFI14 IF NO CURRENT TRACK
STD T6
LDD FS+3 SET SECTOR
STD T7
LDD FS+1
RJM SRA SET RANDOM ADDRESS
LDD RI SET RANDOM ADDRESS IN PARAMETER BLOCK
SHN 6
STM FIPB+2*5+3
SHN -14
STM FIPB+2*5+2
LDD RI+1
SHN 6
STM FIPB+2*5+4
SHN -14
RAM FIPB+2*5+3
* DETERMINE FILE ACCESS MODE.
RFI14 AOD ST DEFAULT TO EXECUTE MODE
LDN 0
STD T4
RFI15 LDM TAFM,T4 CHECK TABLE FOR MATCH
LMD EQ
LPN 77
ZJN RFI16 IF MATCH
AOD T4
LMN TAFML
NJN RFI15 IF NOT END OF TABLE
LDN SWET SET SYSTEM SOFTWARE ERROR FLAG
STD CM+2
LDC * SET ADDRESS WHERE ERROR DETECTED
STD CM+1
MONITOR CHGM CONDITIONALLY HANG PP
LJM LFMX RETURN
* PROGRAMMER NOTE - BECAUSE ALL POSSIBLE FILE MODES
* SHOULD BE INCLUDED IN TABLE *TAFM*, A MATCH
* FAILURE INDICATES THAT THE FNT ENTRY FOR THE
* FILE IS INCORRECT.
RFI16 LDM TAFM,T4 SET BITS TO INDICATE MODE
SCN 77
RFI17 RAM FIPB+4
LJM RFI27 CHECK FOR KEYWORD
* CHECK FOR TAPE OR TTY FILE.
RFI18 LDD CN+3 CHECK FOR *TTY* OR TAPE FILE
RJM CTE CHECK FOR TAPE EQUIPMENT
MJN RFI18.1 IF NOT TAPE EQUIPMENT
SHN 1 SAVE TAPE DEVICE TYPE AND TAPE FLAG
LMN 1
STD SX
LDD CN+3
LMC 2RMT
ZJN RFI21 IF *MT*
LMC 2RNT&2RMT
ZJN RFI20 IF *NT*
UJN RFI21.1 CHECK IF LABELED TAPE
RFI18.1 LDD CN+3
LMC 2RTT
ZJN RFI19 IF *TT*
LDN 20 CLEAR STATUS BYTE
RFI19 LMN 20 SET BIT TO INDICATE *TT*
STD ST
LJM RFI23 CHECK ACCESS MODE
RFI20 LDD HN
RFI21 ADD HN
STD ST SET 7-TRACK BIT OR 9-TRACK BIT
RFI21.1 LDD FS+4 CHECK IF LABELLED TAPE
LPC 4000
SHN -3
RAD ST
* CHECK FOR FILE OPENED.
LDN /MTX/UVSN
STD T1
LDN 1
RJM TUW TRANSFER UDT WORD
LDD MA
CRD UD GET VSN AND OPEN STATUS
LDD UD+3 CHECK FOR OPEN BIT
SHN 21-11
PJN RFI22 IF NOT OPEN
LDN 40 SET OPEN BIT FOR REPLY
RAD ST
* CHECK FOR WRITE LOCKOUT.
RFI22 LDN /MTX/UST1 GET DEVICE STATUS FROM UDT
STD T1
LDN 1
RJM TUW
LDD MA
CRD CN
LDD CN+4 CHECK FOR WRITE RING
SHN 21-7
PJN RFI24 IF NO WRITE RING
RFI23 LDD EQ PICK UP FILE ACCESS MODE
SHN 21-0
PJN RFI25 IF NOT WRITE LOCKOUT
RFI24 LDD HN SET READ BIT
UJN RFI26 SET UP FILE MODE FIELD
RFI25 LDC 300 SET READ AND WRITE BITS
RFI26 RAM FIPB+4
RFI27 LDD ST SET STATUS BYTES
STM FIPB+3
LDD SX
STM FIPB+2
* RETURN STANDARD PARAMETER BLOCK.
LDN FIPBL-1 NUMBER OF WORDS TO TRANSFER
STD FP
RJM CPA DETERMINE RETURN ADDRESS
ADN 1
CWM FIPB,FP
LDD FE SET KEYWORD COUNT - 1
SBN FIPBL-1+1
STD FE
PJN RFI32 IF KEYWORDS TO PROCESS
RFI28 LJM LFMX RETURN
* PROCESS KEY WORDS.
RFI29 LDN 40 SET KEY NOT DEFINED FLAG
RAD CN+4
RFI30 RJM CPA GET PARAMETER BLOCK ADDRESS
ADD FP
CWD CN RETURN KEYWORD
RFI31 SOD FE
MJN RFI28 IF NO MORE KEYS TO PROCESS
RFI32 AOD FP ADVANCE PARAMETER BLOCK POINTER
RJM CPA GET PARAMETER BLOCK ADDRESS
ADD FP
CRD CM READ NEXT KEY WORD
LDN ZERL INITIALIZE KEY WORD FIELDS
CRD CN
LDD CM+4
LPN 37
ZJN RFI31 IF ZERO KEY, IGNORE WORD
STD CN+4
LDN TAPKL
STD T1
RFI33 LCN TAPKE SEARCH FOR KEY
RAD T1
MJN RFI29 IF END OF TABLE
LDM TAPK,T1
LMD CN+4
NJN RFI33 IF NO MATCH
LDM TAPK+1,T1 GET KEY WORD PROCESSOR ADDRESS
STD T1
LJM 0,T1 JUMP TO KEYWORD PROCESSOR
RFI SPACE 4,15
** KEY WORD PROCESSORS.
*
* ENTRY (CN - CN+3) = 0.
* (CN+4) = KEY.
* (FS - FS+4) = FST ENTRY.
* (ST) = FILE STATUS
* (SX) = EXTENDED FILE STATUS
* (UD - UD+4) = WORD *UVSN* FROM THE UDT
*
* EXIT (CN - CN+4) = RETURNED KEY WORD.
* TO *RFI29*, IF KEY NOT APPLICABLE FOR FILE TYPE.
* TO *RFI30*, TO PROCESS NEXT KEY WORD.
*
* NOTES KEY WORD PROCESSORS CAN USE THE FOLLOWING
* DIRECT CELLS -
* EQ, OC, CM - CM+4, CN - CN+4, RI - RI+1.
RFI SPACE 4,10
** KEY 1.
* RETURN TAPE FORMAT.
RFI34 LDD SX CHECK FILE TYPE
LPN 1
ZJN RFI35 IF NOT TAPE FILE
LDD FS+2 DATA FORMAT
SHN -10
SHN 6
RAD CN+4
LJM RFI30 GET NEXT WORD
RFI35 LJM RFI29 SET KEY NOT DEFINED FLAG
RFI SPACE 4,10
** KEY 2.
* RETURN LABEL TYPE, DENSITY, CONVERSION MODE, AND
* INHIBIT ERROR PROCESSING BIT.
RFI36 RJM TAI TRANSFER ADDITIONAL TAPE INFORMATION
ZJN RFI35 IF NOT TAPE FILE
LDM FIPB+2*5
SHN 21-12
PJN RFI39 IF UNLABELED
SHN 21-11-21+12
PJN RFI37 IF STANDARD LABEL
LDN 14
UJN RFI38 SET LABEL TYPE
RFI37 LDN 1 SET ANSI LABELS
RFI38 STD CN+3
RFI39 LDM FIPB+2*5+1 ERROR PROCESSING INHIBITED
LPN 4
SHN 6-2
RAD CN+3
LDM FIPB+3*5 CONVERT DENSITY
SHN -3
LPN 7
STD T2
LDM FIPB+3*5 CONVERT CONVERSION MODE
LPN 7
SBN 1
RFI39.1 LMM TDEN-1,T2
SHN 6
RAD CN+4 MERGE DENSITY, CONVERSION MODE, AND KEY
LJM RFI30 RETURN KEY WORD
RFI SPACE 4,20
** KEY 4.
* RETURN CURRENT VSN AND REEL NUMBER.
RFI40 RJM TAI TRANSFER ADDITIONAL TAPE INFORMATION
ZJN RFI40.1 IF NOT TAPE FILE
LDD UD MOVE VSN TO KEY WORD
STD CN
LDD UD+1
STD CN+1
LDD UD+2
STD CN+2
LDM FIPB+4*5+3 UDT REEL NUMBER
ADN 1
STD CN+3 ACTUAL REEL NUMBER TO KEY WORD
LJM RFI30 RETURN KEY WORD
RFI40.1 LJM RFI29 SET KEY NOT DEFINED FLAG
RFI SPACE 4,15
** KEY 14B.
* RETURN BLOCK SIZE, PROCESSING OPTIONS, AND NOISE SIZE.
*
* NOTES TO CONVERT NOISE BYTES (NB) AND FILL STATUS FIELDS
* IN UDT WORD UST4 BACK TO NOISE SIZE (NS) IN FRAMES,
* THE FOLLOWING FORMULAS ARE USED.
* 7-TRACK FORMULA -
* NS = NB * 2
* IF FILL STATUS, NS = NS - 1 = NB * 2 - 1
* 9-TRACK FORMULA -
* NS = ( NB * 3 ) / 2
* IF FILL STATUS, NS = NS - 1 = ( NB * 3 ) / 2 - 1
RFI41 RJM TAI TRANSFER ADDITIONAL TAPE INFORMATION
NJN RFI42 IF TAPE FILE
LJM RFI29 SET KEY NOT DEFINED FLAG
RFI42 LDD SX
LPN 2
NJN RFI44.1 IF CARTRIDGE TAPE (*CT* OR *AT*)
LDM FIPB+2*5+2 FILL STATUS BIT
LPN 40
STD T1
LDM FIPB+2*5+2 NOISE SIZE IN BYTES
LPN 37
STD T2
SHN 1 NB * 2
STD T3
LDD ST
SHN 21-6
MJN RFI43 IF 7-TRACK
LDD T2
ADD T3 NB + NB * 2
SHN -1 ( NB * 3 ) / 2
STD T3
RFI43 LDD T1
ZJN RFI44 IF NO FILL STATUS
SOD T3
RFI44 LDD T3 MERGE NOISE SIZE AND KEY
SHN 6
RAD CN+4
RFI44.1 LDM FIPB+2*5+1 SET PROCESSING OPTIONS
STD CN+3
* RETURN BLOCK SIZE (IN CM WORDS).
* BLOCK SIZE = BLOCK WORD COUNT + CHUNK COUNT * 600B.
LDM FIPB+2*5+3 BLOCK WORD COUNT
STD CN+2
LDM FIPB+2*5+4 CHUNK COUNT
ZJN RFI46 IF NOT LONG BLOCK
STD T2
RFI45 LDC /MTX/LBWD
RAD CN+2
SHN -14
RAD CN+1
SOD T2
NJN RFI45 IF OVERFLOW COUNT NOT EXHAUSTED
RFI46 LJM RFI30 RETURN KEY WORD
SPACE 4,10
** KEY 15B.
* RETURN DIRECT ACCESS FILE VALIDATION SIZE AND ACCESS LEVEL.
RFI49 NFA FA,R
ADK FNTL
CRD CM GET FILE TYPE
ADK FUTL-FNTL
CRM FIPB,ON GET ACCESS LEVEL/FILE SIZE INDEX
LDM FIPB+2 SAVE ACCESS LEVEL IN PARAMETER BLOCK
LPN 7
SHN 6
RAD CN+4
LDD CM+4 CHECK FILE TYPE
SHN -6
LMN PMFT
NJN RFI51 IF NOT A DIRECT ACCESS FILE
LDM FIPB+2 CHECK FILE SIZE INDEX
SHN -6
LPN 7
NJN RFI50 IF INDEX IS NOT SYSTEM CONTROLLED
LDD CP GET EJT ORDINAL
ADN TFSW
CRD CM
SFA EJT,CM GET SERVICE CLASS
ADK SCLE
CRD CM
LDD CM
SHN -6
RJM RJC GET ADDRESS OF JOB CONTROL BLOCK
ZJN RFI51 IF NO JCB FOR SERVICE CLASS
ADK PFCT READ DIRECT ACCESS FILE SIZE LIMIT
CRD CM
LDD CM
SHN -11
RFI50 SHN 1 OFFSET INTO *TDMS*
STD T2
LDM TMDS,T2 SAVE DIRECT ACCESS VALIDATION
STD CN+2
LDM TMDS+1,T2
STD CN+3
RFI51 LJM RFI30 RETURN KEYWORD
RFI SPACE 4,10
** KEY 16B. SPACE REMAINING ON OPTICAL DISK
*
* 48/ SPACE, 6/ 0, 6/16B
* SPACE = NUMBER OF SECTORS REMAINING IN FILE IF THIS
* FILE IS OPEN FOR WRITE.
* = NUMBER OF SECTORS REMAINING IN PARTITION OR
* NUMBER OF PRE-ALLOCATED SECTORS REMAINING IF
* THIS FILE IS NOT OPEN.
RFI60 NFA FA,A GET CURRENT POSITION
ADK FSTL
CRD T0
ADK FUTL-FSTL GET STARTING DISK ADDRESS AND SIZE
CRD CM
LDD CM+4 COMPUTE SPACE REMAINING
SBD T2
STD CN+3
SHN -12 SAVE REMAINDER
LPN 1
ADD T1
LDD CM+3
SBD T1
STD CN+2
LJM RFI30 RETURN KEYWORD
SLF SPACE 4,10
*** SLF - FUNCTION 33B.
* SET LAST FILE EXECUTED.
*
* SET FNT POINTER IN THE CONTROL POINT AREA TO INDICATE
* THE FILE FROM WHICH THE LAST MAIN PROGRAM WAS LOADED.
*
* ENTRY (FF) = FET SPECIFIED FNT ADDRESS.
* FET MUST BE SET BUSY ON ENTRY.
*
* EXIT CPA UPDATED, IF NO ERRORS.
*
* ERROR TO *ERR*, IF ERRORS.
*
* USES CM - CM+4, FN - FN+4.
*
* CALLS CPA, SIF.
ENTRY SLF
LDD CP CHECK FOR SSJ=
ADC SEPW
CRD CM
LDD CM
SHN 21-2
MJN SLF1 IF SSJ= PRESENT
LDN /ERR/IUA * USER ACCESS NOT VALID.*
UJN SLF2 PROCESS ERROR
SLF1 RJM CPA READ FET+0
CRD FN
LDD FN+4 CHECK COMPLETE BIT
LPN 1
ZJN SLF3 IF FET BUSY
LDN /ERR/PBB * PARAMETER BLOCK BUSY.*
SLF2 LJM ERR PROCESS ERROR
SLF3 LDD FF SEARCH FOR FILE
RJM SIF
LDD CP UPDATE CPA
ADC EOCW
CRD CM
LDD FA
STD CM
LDD CP
ADC EOCW
CWD CM
LJM LFMX RETURN
TAFT SPACE 4,10
** TAFT - TABLE OF FILE TYPES.
TAFT BSS 0
LOC 0
CON LOFT LOCAL
CON INFT INPUT
CON QFFT QUEUED
CON 7777 RESERVED
CON PMFT PERMANENT (DIRECT)
CON 7777 RESERVED
CON PTFT PRIMARY
CON LIFT LIBRARY
LOC *O
TAFTL EQU *-TAFT
TAFM SPACE 4,10
** TAFM - TABLE OF FILE MODES.
*
* TABLE IS IN THE FOLLOWING FORMAT.
*
* 6/BS,6/FM
*
* WHERE BS = BITS TO SET IN PARAMETER BLOCK TO INDICATE
* FILE MODE.
* FM = FILE ACCESS MODE OBTAINED FROM THE *FNT*.
TAFM BSS 0
LOC 0
VFD 6/1,6/1 READ
VFD 6/17,6/0 WRITE
VFD 6/5,6/20 APPEND
VFD 6/15,6/30 MODIFY
VFD 6/61,6/31 READ/ALLOW MODIFY
VFD 6/41,6/21 READ/ALLOW APPEND
VFD 6/0,6/4 EXECUTE (INDIRECT ACCESS PERMANENT FILE)
VFD 6/0,6/5 EXECUTE (DIRECT ACCESS PERMANENT FILE)
VFD 6/11,6/10 UPDATE
VFD 6/21,6/11 READ/ALLOW UPDATE
LOC *O
TAFML EQU *-TAFM
TAPK SPACE 4,10
** TAPK - TABLE OF PARAMETER BLOCK KEYS.
*
*T 12/ KEY, 12/ PRAD
* KEY *FILINFO* ADDITIONAL INFORMATION KEY
* PRAD KEY WORD PROCESSOR ADDRESS.
TAPK BSS 0
LOC 0
CON FMTK,RFI34 FORMAT KEY
TAPKE EQU * ENTRY LENGTH
CON LTYK,RFI36 LABEL TYPE, DENSITY, CONVERSION MODE KEY
CON VSNK,RFI40 VSN, REEL NUMBER KEY
CON BSZK,RFI41 BLOCK SIZE, NOISE SIZE, OPTIONS KEY
CON DSVK,RFI49 DIRECT ACCESS FILE SIZE, ACCESS LEVEL
CON SPOD,RFI60 SPACE REMAINING ON OPTICAL DISK
LOC *O
TAPKL EQU *-TAPK
TDEN SPACE 4,10
** TDEN - TABLE OF DENSITY CONVERSIONS.
TDEN BSS 0
LOC 1
CON 2*10B 200 BPI
CON 1*10B 556 BPI
CON 3*10B 800 BPI/CPI
CON 4*10B 1600 CPI
CON 5*10B 6250 CPI
CON 6*10B 38000 CPI
LOC *O
SPACE 4,10
** TMDS - TABLE OF DIRECT ACCESS FILE VALIDATION SIZES.
TMDS BSS 0
LOC 0
CSR DSRNG7
CSR DSRNG1
CSR DSRNG2
CSR DSRNG3
CSR DSRNG4
CSR DSRNG5
CSR DSRNG6
CSR DSRNG7
LOC *O
TITLE SUBROUTINES.
CDP SPACE 4,10
** CDP - CHECK FOR DMP= PROGRAM.
*
* ENTRY (A) = EST ENTRY ADDRESS.
*
* ERROR TO *ERR*, IF CALLING PROGRAM IS *DMP=*.
*
* USES CN - CN+4.
*
* CALLS CTE.
CDP SUBR ENTRY/EXIT
CRD CN READ EST ENTRY
LDD CN+3
RJM CTE CHECK FOR TAPE EQUIPMENT
PJN CDP1 IF TAPE EQUIPMENT
LDD CN+3
LMC 2RTE
NJN CDPX IF NOT *TE* EQUIPMENT
CDP1 AOM RNME SAVE TAPE STATUS
LDD CP CHECK FOR *SPCW* BUSY
ADC SPCW
CRD CN
LDD CN
ZJN CDPX IF DMP= REQUEST NOT ALREADY PRESENT
LDN /ERR/SYE * SYSTEM ERROR.*
LJM ERR PROCESS ERROR
CFT SPACE 4,10
** CFT - CHECK FILE TYPE.
*
* ENTRY (CM - CM+4) = FNT WORD.
*
* EXIT (A) .NE. 0, IF INCORRECT FILE TYPE.
* (RNMB) CHANGED IF RETAINING OLD FILE TYPE.
*
* USES T1, T7, CN - CN+4.
CFT SUBR ENTRY/EXIT
LDD CM+4
SHN -6
STD T7
LDN TPFTL+1 SET TABLE LENGTH
STD T1
CFT1 SOD T1
ZJN CFTX IF END OF TABLE
LDM TPFT-1,T1
LMD T7
NJN CFT1 IF NOT MATCHING FILE TYPE
CFTA LDN 0
* LDN (A) (FILE TYPE OF *B*)
LMN LOFT
ZJN CFT2 IF LOCAL FILE TYPE
LMD T7
LMN LOFT
NJN CFTX IF NOT SAME TYPE
CFT2 LDC **
CFTB EQU *-1 (EST ORDINAL OF FILE *B*)
SFA EST READ EST ENTRY
ADK EQDE
CRD CN
LDD CM+4 PROPAGATE FILE TYPE OF *A*
SCN 77
STM RNMB
LDD CN
SHN 0-13 GET MASS STORAGE FLAG
LMN 1
UJN CFTX RETURN
TPFT SPACE 4,10
** TPFT - TABLE OF PROPAGATED FILE TYPES.
TPFT BSS 0
CON PTFT PRIMARY TERMINAL
TPFTL EQU *-TPFT TABLE LENGTH
CTE SPACE 4,10
** CTE - CHECK FOR TAPE EQUIPMENT.
*
* ENTRY (A) = EQUIPMENT MNEMONIC.
*
* EXIT (A) < 0 IF NOT TAPE EQUIPMENT.
* = 0 IF *MT*.
* = 1 IF *CT*.
* = 2 IF *NT*.
* = 3 IF *AT*.
CTE3 LCN 1 INDICATE NON-TAPE EQUIPMENT
CTE SUBR ENTRY/EXIT
LMC 2RMT
ZJN CTEX IF *MT* (*MT* = 0)
LMC 2RNT&2RMT
ZJN CTE1 IF *NT*
LMC 2RCT&2RNT
ZJN CTE2 IF *CT*
LMC 2RAT&2RCT
NJN CTE3 IF NOT *AT*
LDN 1 *AT* = 3
CTE1 ADN 1 *NT* = 2
CTE2 ADN 1 *CT* = 1
UJN CTEX RETURN
TAI SPACE 4,15
** TAI - TRANSFER ADDITIONAL INFORMATION FROM UDT.
*
* ENTRY (SX) = EXTENDED FILE STATUS.
*
* EXIT (A) = 0, IF NOT TAPE FILE.
* (FIPB) = UDT WORDS *UST2*, *UST3*, *UST4*, *UST5*,
* *UVRI* IF TAPE FILE.
*
* USES T1.
*
* CALLS TUW.
TAI SUBR ENTRY/EXIT
LDD SX
LPN 1
ZJN TAIX IF NOT TAPE FILE
TAIA LDN 0 UDT WORDS NOT YET TRANSFERRED
* LDN 1 (UDT WORDS ALREADY TRANSFERRED)
NJN TAIX IF ADDITIONAL INFORMATION TRANSFERRED
LDN /MTX/UST2 GET UST2, UST3, UST4, UST5 FROM UDT
STD T1
LDN 4 TRANSFER UDT WORDS
RJM TUW
LDN 4 SET WORD COUNT
STD T1
LDD MA
CRM FIPB,T1 READ UDT WORDS
LDK /MTX/UVRI SET UDT WORD TO READ
STD T1
LDN 1 SET WORD COUNT
RJM TUW TRANSFER UDT WORD
LDD MA
CRM FIPB+4*5,ON READ UDT WORD
AOM TAIA SET UDT WORDS TRANSFERRED FLAG
UJN TAIX RETURN
SPACE 4,10
** COMMON DECKS.
*CALL COMPRJC
*CALL COMPSOF
VAL$ SET 0
*CALL COMPVLC
SPACE 4,10
** BUFFER ASSIGNMENTS.
FIPB EQU * *FILINFO* PARAMETER BLOCK BUFFER
LOC FIPB+FIPBL*5-1*5
SPACE 4,10
ERRNG OVL0-* CODE OVERFLOWS INTO ZERO LEVEL OVERLAYS
OVERFLOW OVL
OVERLAY (EQUIPMENT REQUESTS.)
SPACE 4,10
**** ADDITIONAL DIRECT LOCATION ASSIGNMENTS.
VS EQU 60 - 64 VSN BUFFER (5 LOCATIONS)
****
REQ SPACE 4,20
*** FUNCTION 14.
* REQUEST EQUIPMENT.
*
*T FET+1 12/*EQ*, 48/
* EQ EQUIPMENT TYPE.
*
*T FET+7 6/*ID*, 54/
* ID CHECKPOINT MODE ID
* CBID = 75B = CHECKPOINT AT BOI.
* CKID = 76B = CHECKPOINT AT EOI.
*
* REQUEST OPERATOR EQUIPMENT ASSIGNMENT TO FILE.
* IF THE FILE WAS PREVIOUSLY ASSIGNED, FUNCTION IS IGNORED.
* REQUEST FUNCTION 14 CANNOT BE USED TO ASSIGN TAPE EQUIPMENT.
* IF *EQ* .NE. 0, EQUIPMENT ASSIGNMENT MUST BE THIS TYPE.
* IF *EQ* = *MS*, A MASS STORAGE DEVICE MUST BE ASSIGNED.
* IF *EQ* = *MT*, *NT*, *CT*, *AT* OR *TE*, THE ERROR MESSAGE
* * INCORRECT EQUIPMENT.* WILL BE ISSUED.
* FOR REQUEST WITH *EQ* = 0, OPERATOR ASSIGNMENT OF TAPE
* EQUIPMENT (*MT*, *NT*, *CT*, *AT*, *TE*) WILL BE REJECTED.
ENTRY REQ
RJM CPA READ FIRST
ADN 1
CRD CN
RJM GVA GET AND VALIDATE ACCESS LEVEL
LDD CN CHECK TYPE
ZJN REQ3 IF TYPE NOT REQUESTED
* IF EQUIPMENT TYPE IS REQUESTED, CHECK VALIDITY OF TYPE.
LMC 2RMS
ZJN REQ3 IF EQUIPMENT TYPE = *MS*
LDD CN
RJM CTE CHECK FOR TAPE EQUIPMENT
MJN REQ2 IF NOT TAPE EQUIPMENT
REQ1 LDN /ERR/IEQ * INCORRECT EQUIPMENT.*
LJM ERR PROCESS ERROR
REQ2 RJM SEQ SEARCH FOR EQUIPMENT
* REQUEST OPERATOR ASSIGNMENT.
REQ3 LDN 1
REQ4 RJM REA REQUEST EQUIPMENT ASSIGNMENT
PJN REQ4 IF TAPE RELATED EQUIPMENT
LDD EQ RESET OPERATOR EQUIPMENT IF ENTER RECALL
STM EFNA
LDD FS
SHN 21-13
MJN REQ6 IF MASS STORAGE
SHN 21-12-21+13
MJN REQ5 IF ALLOCATABLE DEVICE
RJM VAE VALIDATE ASSIGNED EQUIPMENT
UJN REQ6 ASSIGN FILE
REQ5 RJM DEQ RELEASE EQUIPMENT
REQ6 LJM ASF ASSIGN FILE
AEQ SPACE 4,25
*** FUNCTION 15.
* ASSIGN EQUIPMENT.
*
*T FET+1 12/*EQ*, 48/
* EQ EQUIPMENT TYPE, *MSAL* DEVICE TYPE, OR DESIRED
* EST ORDINAL + 7000B.
*
*T FET+7 6/*ID*, 54/
* ID CHECKPOINT MODE ID
* CBID = 75B = CHECKPOINT AT BOI.
* CKID = 76B = CHECKPOINT AT EOI.
*
* REQUEST FUNCTION 15 CANNOT BE USED TO ASSIGN TAPE EQUIPMENT.
* FOR REQUEST WITH *EQ* = *MT*, *NT*, *CT*, *AT* OR *TE* DEVICE
* TYPE OR SPECIFYING EST ORDINAL OF TAPE RELATED EQUIPMENT,
* ERROR MESSAGE * INCORRECT EQUIPMENT.* WILL BE ISSUED.
*
* NO SPECIAL VALIDATION IS REQUIRED TO ASSIGN TT (FROM TXOT
* ORIGIN), NE OR CC EQUIPMENT OR MASS STORAGE FILE TYPES MS,
* TP, IN, OT, PY, LO OR LG.
* NO SPECIAL USER VALIDATION IS REQUIRED WHEN USING MASS
* STORAGE DEVICE MNEMONICS. THE MASS STORAGE DEVICE MUST BE
* A TEMP DEVICE.
* OTHER REQUESTS ARE VALID ONLY FROM SYSTEM ORIGIN OR TO A
* USER WHO HAS SYSTEM ORIGIN PRIVILEGES. SEE TABLE *TAEQ*.
*
* ENTRY (FF) = FET SPECIFIED FNT ADDRESS.
ENTRY AEQ
LDD FF SET INITIAL FNT ADDRESS
RJM SAF SEARCH FOR ASSIGNED FILE
ZJN AEQ1 IF FILE NOT FOUND
LDN 0 CLEAR FNT ADDRESS
STD FA
LDN /ERR/DFN * DUPLICATE FILE NAME.*
LJM ERR PROCESS ERROR
* CHECK DEVICE SPECIFICATION IN FET.
AEQ1 RJM CPA READ FIRST
ADN 1
CRD CN
RJM GVA GET AND VALIDATE ACCESS LEVEL
LDD CN CHECK EQUIPMENT TYPE
SHN -11
LMN 7
ZJN AEQ6 IF ASSIGN-BY-ORDINAL REQUEST
* PROCESS DEVICE MNEMONIC.
LDD CN
LMC 2RMS
NJN AEQ3 IF NOT MASS STORAGE
STM ASFA CLEAR *MSAL* FLAGS
LDN NEEQ
STD EQ ASSIGN MASS STORAGE
LDD CN SET CORRECT DAYFILE MESSAGE
STM ASFC+1
AOM ASFB
AEQ2 LJM ASF ASSIGN FILE
AEQ3 RJM SEQ SEARCH FOR EQUIPMENT
MJN AEQ2 IF *MSAL* REQUEST
ZJN AEQ7 IF EQUIPMENT AVAILABLE
AEQ4 LDN /ERR/WEQ * EQUIPMENT NOT AVAILABLE.*
AEQ5 LJM ERR PROCESS ERROR
* PROCESS EST ORDINAL.
AEQ6 RJM VSO VALIDATE SYSTEM ORIGIN PRIVILEGE
NJN AEQ9.1 IF USER NOT VALIDATED FOR ASSIGN BY ORDINAL
LDD CN SET EST ORDINAL
LPC 777
STD EQ
RJM CEN CHECK EST ORDINAL
NJN AEQ4 IF NOT AVAILABLE
AEQ7 LDD FS+3
STD T2
LMC 2RTT
NJN AEQ9 IF NOT *TT*
LDD OC
LMK IAOT
ZJN AEQ10 IF INTERACTIVE
AEQ8 LDN /ERR/IEQ * INCORRECT EQUIPMENT.*
UJN AEQ5 PROCESS ERROR
AEQ9 RJM CDT CHECK DEVICE TYPE
ZJN AEQ10 IF DEVICE TYPE ALLOWED
RJM VSO VALIDATE SYSTEM ORIGIN
AEQ9.1 NJP VSJ1 IF USER NOT VALIDATED
LDD EQ
RJM VTE CHECK FOR TAPE EQUIPMENT
PJN AEQ8 IF TAPE RELATED EQUIPMENT
AEQ10 LDD FS
SHN 21-13
MJN AEQ11 IF MASS STORAGE
SHN 21-12-21+13
MJN AEQ11 IF ALLOCATABLE
LDD EQ REQUEST EQUIPMENT
STD CM+1
LDK REQS REQUEST ACTIVE EQUIPMENT
STD CM+2
MONITOR REQM
LDD CM+1 CHECK ASSIGNMENT
NJN AEQ11 IF ASSIGNMENT MADE
LJM AEQ4 EQUIPMENT NOT AVAILABLE
AEQ11 LJM ASF ASSIGN FILE
LBR EJECT
*** FUNCTION 24.
* LABEL TAPE REQUEST.
* REQUEST AUTOMATIC ASSIGNMENT OF MAGNETIC TAPE BY VOLUME
* SERIAL NUMBER.
* IF THE FILE WAS PREVIOUSLY ASSIGNED, FUNCTION IS IGNORED.
*
*T FET+1 12/EQ,48/
* EQ DEVICE TYPE (*MT*, *NT*, *CT*, *AT*, OR ZERO)
*
*T FET+7 6/ID,54/
* ID CHECKPOINT ID, IF TO BE SET ON FILE
* CBID = 75B = CHECKPOINT AT BOI.
* CKID = 76B = CHECKPOINT AT EOI.
*
*T FET+10B 1/R,1/L,1/N,2/TT,1/,3/D,3/CV,12/PO,6/F,6/NS,24/FC
* R LABEL PROCESSING
* 0 = READ LABEL FILE OPENED BY OPEN/ALTER
* 1 = WRITE LABEL FILE OPENED BY OPEN/WRITE
*
* L NOS LABELED IF SET
*
* N NON-STANDARD LABELS IF SET
*
* TT TAPE DEVICE TYPE
* 0 = 7-TRACK TAPE.
* 1 = CARTRIDGE TAPE.
* 2 = 9-TRACK TAPE.
* 3 = ACS CARTRIDGE TAPE.
*
* D DENSITY
* 0 = INSTALLATION DEFAULT
* 1 = 556 BPI
* 2 = 200 BPI
* 3 = 800 BPI/CPI
* 4 = 1600 CPI
* 5 = 6250 CPI
* 6 = 38000 CPI
*
* CV CONVERSION MODE
* 0 = INSTALLATION DEFAULT
* 1 = USASI/ASCII CONVERSION 9 TRACK
* 2 = EBCDIC CONVERSION 9 TRACK
*
* PO PROCESSING OPTIONS
* XXX0 = ABORT ON P.E. UNLESS E.P. SET
* XXX1 = ABORT ON P.E. REGARDLESS OF E.P.
* XXX2 = NO ABORT ON P.E.
* XXX4 = INHIBIT ERROR PROCESSING
* XX1X = ENFORCE RING OUT
* XX2X = ENFORCE RING IN
* XX4X = INHIBIT UNLOAD
* X1XX = TOGGLE INSTALLATION SETTING TO ENABLE/DISABLE
* GCR HARDWARE WRITE ERROR CORRECTION
* X2XX = TOGGLE INSTALLATION SETTING TO ENABLE/DISABLE
* ISSUING OF ERROR MESSAGES TO USER DAYFILE
* 0XXX = DEFAULT EOT OPTION SELECTED ACCORDING TO
* LABEL AND FORMAT SPECIFICATION
* 1XXX = STOP ON TAPE MARK AFTER EOT (UNLABELED)
* 1XXX = STOP ON TAPE MARK PLUS LABELS (LABELED)
* 2XXX = ACCEPT BLOCK IN PROGRESS ON EOT
* 4XXX = INGORE BLOCK IN PROGRESS ON EOT
*
* F DATA FORMAT
* 0 = INTERNAL BINARY
* 1 = NOS/BE INTERNAL BINARY
* 2 = FOREIGN
* 3 = STRANGER
* 4 = LONG BLOCK STRANGER
* 5 = LONG BLOCK INTERNAL BINARY
*
* NS NOISE SIZE IN FRAMES
*
* FS BLOCK SIZE IN FRAMES
*
*T FET+11B 36/VSN,6/A,3/0,15/SN
* VSN 6 CHARACTER VOLUME SERIAL NUMBER (SPACE FILLED)
* A 1 CHARACTER ACCESSIBILITY (DEFAULT = * *)
* SN FILE SECTION NUMBER (DEFAULT = 0001)
*
*T FET+12B 60/FI
* FI FIRST 10 CHARACTERS OF FILE IDENTIFIER
*
*T FET+13B 42/FI,3/0,15/QN
* FI LAST 7 CHARACTERS OF FILE IDENTIFIER (SPACE FILLED)
* QN FILE SEQUENCE NUMBER (DEFAULT = 0001)
*
*T FET+14B 36/SI,9/E,15/G
* SI 6 CHARACTER MULTI-SET IDENTIFIER (SPACE FILLED)
* E GENERATION VERSION NUMBER (DEFAULT = 00)
* G GENERATION NUMBER (DEFAULT = 0001)
*
*T FET+15B 30/RTD,30/CRD
* RTD RETENTION DATE (JULIAN) (DEFAULT = TODAY)
* CRD CREATION DATE (JULIAN) (DEFAULT = TODAY)
*
* FOR AUTOMATIC ASSIGNMENT, A VOLUME SERIAL NUMBER MUST BE
* SUPPLIED EITHER THROUGH A *VSN* COMMAND OR BY THE VSN
* FIELD IN FET+11B. IF THE VSN FIELD IN FET+11B IS ZERO
* AND NO VSN IS SPECIFIED, THE OPERATOR IS REQUESTED TO
* MAKE THE APPROPRIATE EQUIPMENT ASSIGNMENT.
ENTRY LBR
LDD CP CHECK FOR *SPCW* BUSY
ADC SPCW
CRD CN
LDD CN
NJN LBR1 IF DMP= REQUEST ALREADY PRESENT
STD CM+1 CALL *RESEX*
MONITOR ROCM ROLLOUT JOB
LDD IA READ REQUEST
CRD CM
LDD CM+1
SCN 77
ADN 20 SET RECALL PP PROCESSOR BIT
STD CM+1
LDD RA REWRITE USER CALL
SHN 6
ADN 1
CWD CM
LDD CM+2 CLEAR UNUSED FIELDS
LPN 77
STD CM+2
LDD CM+3
LPN 77
STD CM+3
LDD CP ENTER EXTERNAL CALL
ADC SPCW
CWD CM
LJM DPP DROP PPU
LBR1 LDN 0 CLEAR FNT ADDRESS
STD FA
LDN /ERR/SYE * SYSTEM ERROR.*
LJM ERR PROCESS ERROR
OAE SPACE 4,25
*** FUNCTION 26.
* REQUEST OPERATOR ASSIGNMENT OF EQUIPMENT.
*
*T FET+1 12/*EQ*, 12/, 12/*DD*, 24/
* EQ DEVICE TYPE (*MT*, *NT*, *CT*, *AT*,
* OR ZERO = ANY EQUIPMENT)
* DD DENSITY DISPLAY (*HD*, *PE*, *GE*) IF *EQ* = *NT*
*
*T FET+7 6/*ID*, 48/
* ID CHECKPOINT ID, IF TO BE SET ON NON-MAGNETIC TAPE FILE
* CBID = 75B = CHECKPOINT AT BOI.
* CKID = 76B = CHECKPOINT AT EOI.
*
*T FET+11B 36/*VSN*, 24/
* VSN DUPLICATE VSN CHOICE TO BE DISPLAYED IN OPERATOR
* REQUEST MESSAGE (FOR FP=1 FUNCTION ONLY)
*
* EXIT *EQ* = DEVICE TYPE OF ASSIGNED EQUIPMENT.
* *DD* = EST ORDINAL OF ASSIGNED UNIT IF TAPE EQUIPMENT.
*
* THIS FUNCTION IS CALLED BY *RESEX* TO GET THE OPERATOR
* TO MAKE AN EQUIPMENT ASSIGNMENT.
*
* CALLER MUST HAVE SSJ= ENTRY POINT SET.
ENTRY OAE
RJM VSJ VALIDATE SSJ=
RJM SVF SEARCH FOR VSN FILE
ZJN OAE2 IF VSN FILE OR NO ENTRY
LDN 0 CLEAR FNT ADDRESS
STD FA
LDN /ERR/DFN DUPLICATE FILE
OAE1 LJM ERR PROCESS ERROR
OAE2 LDD FA
ZJN OAE3 IF NO ENTRY
RJM SFB SET FILE BUSY
ZJN OAE3 IF NO REJECT ON FILE INTERLOCK
LDN /ERR/IOE * I/O SEQUENCE ERROR.*
UJN OAE1 PROCESS ERROR
OAE3 RJM CPA READ FIRST
ADN 1
CRD CN
ADN 10 READ VSN FROM FET+11B
CRD VS
RJM GVA GET AND VALIDATE ACCESS LEVEL
LDD FP
LPN 1
NJN OAE4 IF OPERATOR ASSIGNMENT ON DUPLICATE VSN
STD VS
OAE4 LDD CN
ZJN OAE6 IF NO EQUIPMENT SPECIFIED
RJM CTE CHECK FOR TAPE EQUIPMENT
ZJN OAE5 IF TAPE EQUIPMENT
LDN /ERR/IEQ * INCORRECT EQUIPMENT.*
UJN OAE1 PROCESS ERROR
OAE5 RJM SEQ SEARCH FOR EQUIPMENT
* REQUEST OPERATOR ASSIGNMENT.
OAE6 LDN 1
RJM REA REQUEST EQUIPMENT ASSIGNMENT
ZJN OAE9 IF TAPE EQUIPMENT (MT, NT, CT OR AT)
LDD EQ RESET OPERATOR EQUIPMENT IF ENTER RECALL
STM EFNA
LDD FS
SHN 21-13
MJN OAE8 IF MASS STORAGE
SHN 21-12-21+13
MJN OAE7 IF ALLOCATABLE DEVICE
RJM VAE VALIDATE ASSIGNED EQUIPMENT
UJN OAE8 ASSIGN FILE
OAE7 RJM DEQ RELEASE EQUIPMENT
OAE8 LJM ASF ASSIGN FILE
* RETURN TAPE EQUIPMENT.
OAE9 STD CM CLEAR REQUEST MESSAGE
LDD CP
ADN MS2W
CWD CM
LDN 0 CLEAR PAUSE BIT
RJM SPB
RJM DEQ RELEASE TAPE EQUIPMENT
LDD FS+3 RETURN DEVICE TYPE IN FET
STD CN
LDD EQ
STD CN+2
RJM CPA READ FET+1
ADN 1
CWD CN
LDD FA
ZJN OAE10 IF NO FNT/FST ENTRY
NFA FA,R
ADN FSTL
CRD FS READ FST ENTRY
OAE10 LJM LFMX RETURN
VSN SPACE 4,30
*** FUNCTION 27.
* BUILD TAPE FILE FNT/FST.
*
* ASSIGNMENT OPERATIONS.
*T FET+10 1/R,11/EQ,12/UDT,4/FM,20/0,1/L,11/0
*
* VSN OPERATIONS.
*T FET+10 30/0,18/VSN,12/0
*
* R RELEASE TAPE EQUIPMENT (REASSIGN TO *TE*)
*
* EQ EST ORDINAL
*
* UDT MAGNET UNIT DESCRIPTOR TABLE ADDRESS
*
* FM FORMAT
*
* L LABEL BIT
*
* VSN VSNFILE RANDOM INDEX
*
* CALLER MUST HAVE SSJ= ENTRY POINT SET.
*
* ENTRY (FN - FN+3) = FILE NAME FROM FET+0.
* (FF) = FET SPECIFIED FNT ADDRESS.
*
* EXIT FET+10B CLEARED IF REQUEST CANNOT BE SATISFIED.
* TO ERR IF LOCAL FILE LIMIT EXCEEDED.
ENTRY VSN
RJM VSJ VALIDATE SSJ=
LDD FF SET INITIAL FNT ADDRESS
RJM SAF SEARCH FOR ASSIGNED FILE
LDD FA SET FILE BUSY
ZJP VSN3 IF FILE NOT LOCAL
RJM SFB SET FILE BUSY
ZJN VSN1 IF NO REJECT ON FILE INTERLOCK
LDN /ERR/IOE *I/O SEQUENCE ERROR
LJM ERR PROCESS ERROR
* VALIDATE ENTRY.
VSN1 LDD FS
RJM VTE VERIFY TAPE ENTRY
MJN VSN2 IF NOT TAPE FILE
STD T1 SAVE ENTRY STATUS
RJM CPA READ FET+1
ADN 1
CRD CN
RJM GVA GET AND VALIDATE ACCESS LEVEL
LDD AL
ZJN VSN1.1 IF *AL* NOT SPECIFIED
NFA FA,R SET ACCESS LEVEL IN FNT
ADN FUTL
CRD CN
LDD AL
LPN 7
LMD CN+2
LPN 7
LMD CN+2
STD CN+2
NFA FA,R
ADN FUTL
CWD CN
VSN1.1 UJN VSN4 CONTINUE
VSN2 LDN /ERR/DFN *DUPLICATE FILE NAME.*
LJM ERR PROCESS ERROR
VSN3 LDN TEEQ ASSIGN TO *TE* EQUIPMENT
STD EQ
RJM CPA READ FET+1
ADN 1
CRD CN
RJM GVA GET AND VALIDATE ACCESS LEVEL
RJM CLF CREATE LOCAL FILE
LDN 1 SET VSN STATUS
STD T1
VSN4 RJM CPA READ FET+10
ADN 10
CRD CN
LDD CN CHECK TYPE OF OPERATION
NJN VSN6 IF ENTERING ASSIGNMENT INFORMATION
LDD FS+2 CHECK FOR VSN INDEX PRESENT
LPN 77
SHN 14
LMD FS+3
NJN VSN2 IF VSN INDEX ALREADY ENTERED
LDD FS+2 ENTER VSN INDEX
SCN 77
STD FS+2
LDD CN+2
LPN 77
RAD FS+2
LDD CN+3
STD FS+3
VSN5 LJM LFMX EXIT
VSN6 LDD T1 CHECK ENTRY STATUS
NJN VSN7 IF VSN ENTRY PRESENT
LDD CN
LPC 777
STD CN
LMD FS
NJN VSN8 IF EQUIPMENTS DO NOT MATCH
LDD CN
STD EQ
UJN VSN10 ENTER UDT ADDRESS
VSN7 LDD CN VALIDATE EQUIPMENT TO BE ASSIGNED
RJM VTE VERIFY TAPE EQUIPMENT
ZJN VSN9 IF TAPE EQUIPMENT
VSN8 LDN /ERR/IEQ * INCORRECT EQUIPMENT.*
LJM ERR PROCESS ERROR
VSN9 LDD CN ENTER EQUIPMENT
STD CM+1 RESERVE EQUIPMENT
LDK REQS REQUEST ACTIVE EQUIPMENT
STD CM+2
MONITOR REQM
LDD CM+1
ZJN VSN11 IF NOT RESERVED
LDD CN SET EST ORDINAL
STD FS
VSN10 LDD CN+1 ENTER UDT ADDRESS
STD FS+1
LDD FS+2
LPN 77
STD FS+2
LDD CN+2 ENTER FORMAT
LPC 7400
RAD FS+2
LDD CN+4 ENTER LABEL BIT
LPC 4000
RAD FS+4
UJN VSN12 EXIT
VSN11 LDN ZERL CLEAR FET+10
CRD CN
RJM CPA
ADN 10
CWD CN
VSN12 LJM LFMX EXIT
ASF SPACE 4,15
** ASF - ASSIGN NON-TAPE FILE.
*
* ENTRY (EQ) = EST ORDINAL.
* (AL) = 8/, 1/ACCESS LEVEL FLAG, 3/ACCESS LEVEL.
*
* EXIT (FA) = ADDRESS OF FNT ENTRY.
* (FN - FN+4) = FILE NAME.
* (FS - FS+4) = FST ENTRY.
*
* USES CN, EQ, FN+3, FS, FS+1, T1, T4, CM - CM+4.
*
* CALLS ACS, CLF, CPA, C2D, DFM, STB, UPC.
*
* MACROS MONITOR, NFA, SFA.
ASF BSS 0 ENTRY
LDD TH REQUEST ASSIGNMENT OF EQUIPMENT
RAD EQ
RJM CLF CREATE LOCAL FILE
LDN ZERL
CRD CM
LDC 7777 CHECK FOR ASSIGNMENT OF *MSAL* DEVICE
ASFA EQU *-1 (*MSAL* CODE - SET BY *SEQ*)
STD CM+2
SHN 21-13
MJN ASF1 IF NOT *MSAL* DEVICE
LDD AL PASS ACCESS LEVEL TO *RTCM*
LPN 7
LMN 40
SHN 6
STD CM+3
MONITOR RTCM ASSIGN MASS STORAGE SPACE
LDD CM+1 SET EST ORDINAL IN FST
LPC 777
STD FS
LDD CM+4 SET FIRST TRACK IN FST
STD FS+1
NFA FA,R REWRITE FST
ADN FSTL
CWD FS
ASF1 LDD FS FETCH EST ENTRY
STD EQ
LPC 777
ZJP ASF1.1 IF NO EQUIPMENT ASSIGNED
LDD EQ
SFA EST SET EQUIPMENT TYPE
ADK EQDE
CRD CM
LDD CM+3
STM ASFC
STD CN SET EQUIPMENT TYPE
LDD CM CHECK FOR MASS STORAGE
SHN 6
PJP ASF2 IF NOT MASS STORAGE
LDD FS+1
ZJN ASF1.0 IF NO TRACKS ASSIGNED
RJM UPC UPDATE PRU COUNTER
LJM ASF3 CONTINUE PROCESSING
ASF1.0 LDD EQ CONVERT UPPER TWO DIGITS OF EST ORDINAL
SHN -3
RJM C2D
STM ASFF+1
LDD EQ CONVERT LOWER DIGIT OF EST ORDINAL
LPN 7
SHN 6
ADC 2R0,
STM ASFF+2
LDC ASFF *EQXXX, TRACK LIMIT.*
UJN ASF1.2 PROCESS TRACK LIMIT
ASF1.1 LDD CM+3 CHECK *RTCM* REJECT REASON CODE
LMN 2
ZJN ASF1.3 IF REJECT BECAUSE OF ACCESS LEVEL
LDC ASFF+3 * TRACK LIMIT.*
ASF1.2 STD T7 SAVE MESSAGE ADDRESS
LDN /ERR/NMA
LJM RCL RECALL *LFM*
ASF1.3 LDN /ERR/WEQ * EQUIPMENT NOT AVAILABLE.*
LJM ERR ABORT
ASF2 LDC 4000 SET NON-MASS STORAGE BIT
RAD CN
ASF3 LDN 0 CLEAR CONSOLE MESSAGE
STD CM
LDD CP
ADN MS2W
CWD CM
RJM CPA STORE FIRST
ADN 1
CWD CN
ADN 4-1 GET FET+4
CRD CM
LDD FA SET FNT ADDRESS INTO FET+4
STD CM
RJM CPA COMPUTE PARAMETER ADDRESS
ADN 4
CWD CM
LDD FE
SBN 7
MJN ASF5 IF FET NOT LONG ENOUGH
RJM CPA COMPUTE PARAMETER ADDRESS
ADN 7
CRD CM
LDD CM GET CHECKPOINT ID
SHN -6
LMN CBID
ZJN ASF4 IF CHECKPOINT BOI ID
LMN CKID&CBID CHECK FOR CHECKPOINT EOI ID
NJN ASF5 IF NOT VALID ID
LDN CKST&CBST SET CHECKPOINT AT EOI FILE STATUS
ASF4 LMN CBST
STD T1
NFA FA,R SET CHECKPOINT ID STATUS IN FNT
CRD CN
LDD CN+4
SCN 77
ADD T1
STD CN+4
NFA FA,R
CWD CN
ASF5 LDN 0 CLEAR PAUSE BIT
RJM SPB
LDD FP
SHN 21-1
MJP LFMX IF NO DAYFILE MESSAGE TO BE ISSUED
LDM ASFC+1
NJN ASF7 IF MESSAGE FIELD ALREADY SET
LDD EQ CONVERT UPPER TWO DIGITS OF EST ORDINAL
SHN -3
RJM C2D
STM ASFC+1
LDD EQ CONVERT LOWER DIGIT OF EST ORDINAL
LPN 7
ADN 1R0
SHN 6
STM ASFC+2
ASF7 LDC ASFC+2 SET BUFFER ADDRESS
STD T1
LDC =C*, ASSIGNED TO *
RJM ACS
LDD FN+3
SCN 77
STD FN+3
LDN FN ADD FILENAME TO MESSAGE
RJM ACS
LDC =C*.* TERMINATE MESSAGE
RJM ACS
LDC ASFC SEND ASSIGNMENT MESSAGE
* LDC ASFC+1 (*MSAL* TYPE ASSIGNMENT)
ASFB EQU *-1
RJM DFM ISSUE DAYFILE MESSAGE
LJM LFMX EXIT
ASFC BSSZ 15 MESSAGE BUILD AREA
ASFF DATA C*EQXXX, TRACK LIMIT.*
CDT SPACE 4,20
** CDT - CHECK DEVICE TYPE.
*
* ENTRY (T2) = DEVICE TYPE TO CHECK FOR.
*
* EXIT (A) = 0, IF DEVICE TYPE FOUND IN TABLE.
* (A) .NE. 0 IF NOT FOUND.
*
* USES T1.
CDT2 LCN 0 SET NOT FOUND STATUS
CDT SUBR ENTRY/EXIT
LDN 0
STD T1
CDT1 LDM CDTA,T1 GET NEXT TABLE ENTRY
ZJN CDT2 IF END OF TABLE
LMD T2
ZJN CDTX IF MATCH
AOD T1
UJN CDT1 CHECK NEXT ENTRY
** TBLM - DEFINE MACRO TO PRODUCE *CDTA* TABLE.
*
*T 12/2R_EQT
PURGMAC TBLM
TBLM MACRO EQT
CON 2R_EQT
TBLM ENDM
LIST G
CDTA BSS 0
TBL "MSEQ"
CON 2RTT
CON 2RNE
CON 2RCC
CON 2ROD OPTICAL DISK
LIST *
CON 0 END OF TABLE
TITLE SUBROUTINES.
CEA SPACE 4,10
** CEA - CHECK EQUIPMENT ACCESS LEVELS.
*
* ENTRY (EQ) = EST ORDINAL.
* (AL) = 8/, 1/ACCESS LEVEL FLAG, 3/ACCESS LEVEL.
*
* EXIT (A) = 0 IF ACCESS LEVEL IN RANGE FOR EQUIPMENT.
*
* USES CM+1, CM+2, CM+4.
*
* MACROS MONITOR.
CEA SUBR ENTRY/EXIT
LDD AL GET ACCESS LEVEL
ZJN CEAX IF SYSTEM IS UNSECURED
LPN 7 ACCESS LEVEL
STD CM+4
LDN VAES SET SUBFUNCTION CODE
STD CM+1
LDD EQ EST ORDINAL
STD CM+2
MONITOR VSAM VALIDATE EQUIPMENT ACCESS LEVELS
LDD CM+1 GET REPLY
UJN CEAX RETURN
CEN SPACE 4,15
** CEN - CHECK EST ORDINAL.
*
* ENTRY (EQ) = EST ORDINAL.
* (AL) = 8/, 1/ACCESS LEVEL FLAG, 3/ACCESS LEVEL.
*
* EXIT (A) = 0 IF AVALIABLE.
* (FS - FS+4) = EST ENTRY.
*
* USES T1, T2, T3, CM - CM+4, FS - FS+4.
*
* CALLS CEA, CSJ.
*
* MACROS SFA.
CEN SUBR ENTRY/EXIT
LDN ESTP READ EST POINTER
CRD CM
LDD EQ
ZJN CEN2 IF EQUIPMENT 0
SBD CM+2
PJN CEN2 IF NOT IN LEGAL EST RANGE
SFA EST,EQ READ EST ENTRY
ADK EQDE
CRD FS
LDD FS+3
ZJN CEN2 IF EQUIPMENT NOT DEFINED
LDC TAEQ+TAEQM-1 SET START OF TABLE
STD T2
ADN TAEQL-TAEQM+1 SET END OF TABLE
STD T3
CEN1 AOD T2 SEARCH FOR INCORRECT EQUIPMENT
LMD T3
ZJN CEN3 IF END OF TABLE
LDI T2
LMD FS+3
NJN CEN1 IF NOT INCORRECT EQUIPMENT
CEN2 LDN /ERR/IEQ * INCORRECT EQUIPMENT.*
LJM ERR PROCESS ERROR
CEN3 LDD FS CHECK EQUIPMENT STATUS
SHN 21-13
PJN CEN5 IF NOT MASS STORAGE
SHN 13-10
PJN CEN4 IF NOT REMOVABLE DEVICE
RJM CSJ CHECK FOR SSJ= ENTRY POINT
PJN CEN2 IF JOB NOT SYSTEM ORIGIN
CEN4 LDD FS
SHN 21-6
MJN CEN2 IF DEVICE UNAVAILABLE
SHN 6-1
MJN CEN2 IF DEVICE OFF
RJM CEA CHECK EQUIPMENT ACCESS LEVELS
UJN CEN6 RETURN WITH EQUIPMENT AVAILABLE STATUS
CEN5 SHN 0-12-21+13
LMN 1
ZJN CEN6 IF ALLOCATABLE DEVICE
RJM CEA CHECK EQUIPMENT ACCESS LEVELS
NJN CEN6 IF ACCESS LEVEL OUT OF RANGE
SFA EST,EQ CHECK EQUIPMENT ASSIGNMENT
ADK EQAE
CRD CM
LDD CM+4 RETURN WITH JOB ASSIGNMENT STATUS
CEN6 LJM CENX RETURN
COE SPACE 4,10
** COE - CLEAR OR RESET OPERATOR ASSIGNED EQUIPMENT.
*
* ENTRY (A) = 0 IF TO CLEAR OPERATOR ASSIGNED EQUIPMENT.
* = EQUIPMENT IF TO RESET OPERATOR EQUIPMENT.
*
* EXIT (A) = OPERATOR ASSIGNED EQUIPMENT BEFORE CLEAR.
*
* USES T0, CM - CM+5.
QUAL
COE EQU *+1 DEFINE GLOBAL TAG
QUAL *
COE SUBR ENTRY/EXIT
STD T0 SAVE NEW VALUE FOR *OAEW*
LDD CP GET *OAEW* WORD
ADN OAEW
CRD CM+1
CRD CM
LDD T0
STD CM+4
ADD CM+1+4
ZJN COEX IF NO OPERATOR EQUIPMENT TO CLEAR
LDD CP CLEAR OR RESET OPERATOR EQUIPMENT
ADN OAEW
CWD CM
LDD CM+1+4 RETURN WITH PRIOR VALUE FROM *OAEW*
UJN COEX RETURN
CSJ SPACE 4,10
** CSJ - CHECK FOR SSJ= ENTRY POINT.
*
* EXIT (A) .LT. 0, IF JOB HAS SSJ= ENTRY POINT.
* (CM - CM+4) = *SEPW* WORD FROM CPA.
*
* USES CM - CM+4.
CSJ SUBR ENTRY/EXIT
LDD CP
ADC SEPW
CRD CM READ SPECIAL ENTRY POINT WORD
LDD CM
SHN 21-2
UJN CSJX RETURN
CTE SPACE 4,10
** CTE - CHECK FOR TAPE EQUIPMENT.
*
* ENTRY (A) = EQUIPMENT MNEMONIC.
*
* EXIT (A) .EQ. 0 = TAPE EQUIPMENT (MT, NT, CT OR AT).
* (A) .EQ. 1 = VSN EQUIPMENT (TE).
* (A) .LT. 0 = NOT TAPE RELATED EQUIPMENT.
CTE1 LDN 1 SET VSN EQUIPMENT
CTE SUBR ENTRY/EXIT
LPC 3777
LMC 2RMT
ZJN CTEX IF *MT*
LMC 2RNT&2RMT
ZJN CTEX IF *NT*
LMC 2RCT&2RNT
ZJN CTEX IF *CT*
LMC 2RAT&2RCT
ZJN CTEX IF *AT*
LMC 2RTE&2RAT
ZJN CTE1 IF *TE*
LCN 0 SET NOT TAPE RELATED
UJN CTEX RETURN
GVA SPACE 4,10
** GVA - GET AND VALIDATE ACCESS LEVEL.
*
* ENTRY (CN - CN+4) = FET+1.
* (FET+4) = ACCESS LEVEL IN BITS 39-36, IF *SP*
* (BIT 39) SET IN FET+1.
*
* EXIT (AL) = 8/,1/ACCESS LEVEL FLAG,3/ACCESS LEVEL.
* (FET+4) = VALIDATED ACCESS LEVEL IN BITS 39-36.
*
* ERROR TO *ERR* IF SECURITY VIOLATION.
*
* USES AL, CM - CM+4.
*
* CALLS CPA.
*
* MACROS MONITOR.
GVA1 LDD CP GET JOB ACCESS LEVEL
ADK JSCW
CRD CM
LDD CM+1
SHN -11
STD AL
RJM CPA GET (FET+4)
ADN 4
CRD CM
LDD CM+1 SET ACCESS LEVEL IN (FET+4)
SCN 7
LMD AL
STD CM+1
RJM CPA SAVE (FET+4)
ADN 4
CWD CM
GVA2 LDN 10 SET ACCESS LEVEL FLAG
RAD AL
GVA SUBR ENTRY/EXIT
LDK SSML CHECK SECURITY MODE
CRD CM
LDD CM
LPN 7
ZJN GVAX IF SYSTEM IS UNSECURED
LDD CN+1 CHECK *SP* BIT
SHN 21-3
PJN GVA1 IF *SP* BIT NOT SET
RJM CPA READ ACCESS LEVEL FROM FET+4
ADN 4
CRD CM
LDD CM+1
LPN 7
STD AL
LDN ZERL CLEAR WORD
CRD CM
LDD AL SET ACCESS LEVEL FOR *VSAM* CALL
STD CM+1
LDD MA WRITE PARAMETER WORD
CWD CM
LDN 1 SET TO VALIDATE ACCESS LEVEL
STD CM+4
LDN VAJS SET SUBFUNCTION
STD CM+1
MONITOR VSAM VALIDATE ACCESS LEVEL
LDD CM+1
ZJP GVA2 IF VALID ACCESS LEVEL
LDN /ERR/LNV * ACCESS LEVEL NOT VALID FOR FILE.*
LJM ERR PROCESS ERROR
RAW SPACE 4,15
** RAW - READ ACCESS CONTROL WORD.
*
* EXIT (CM - CM+4) = USER ACCESS CONTROL WORD FROM CPA
* OR FROM SSJ= PARAMETER BLOCK IF SSJ= JOB.
* (A) = (CM+4).
*
* USES CM - CM+4.
*
* CALLS CSJ.
*
* MACROS NFA.
RAW1 LDD CP READ ACCESS CONTROL WORD FROM CPA
ADK AACW
RAW2 CRD CM
LDD CM+4
RAW SUBR ENTRY/EXIT
RJM CSJ CHECK FOR SSJ= ENTRY POINT
PJN RAW1 IF NOT SSJ= JOB
LDD CM+3 CHECK IF SSJ= PARAMETER BLOCK PRESENT
LPN 37
ADD CM+4
ZJN RAW1 IF NO SSJ= PARAMETER BLOCK
NFA SSJN+AACS READ USER,S *AACW* WORD FROM SSJ= BLOCK
UJN RAW2 READ ACCESS WORD
REA SPACE 4,15
** REA - REQUEST EQUIPMENT ASSIGNMENT.
*
* ENTRY (A) = 0, IF PREVIOUS EQUIPMENT TO BE RELEASED.
* (AL) = 8/, 1/ACCESS LEVEL FLAG, 3/ACCESS LEVEL.
* (EQ) = PREVIOUS EQUIPMENT, IF RELEASE REQUIRED.
* (CN) = EQUIPMENT TYPE.
*
* EXIT (EQ) = ASSIGNED EQUIPMENT.
* (A) = 0, IF TAPE EQUIPMENT (MT, NT, CT OR AT).
* (A) .GT. 0, IF VSN EQUIPMENT (TE).
* (A) .LT. 0, IF NOT TAPE RELATED EQUIPMENT.
* (FS - FS+4) = ASSIGNED EQUIPMENT EST ENTRY.
*
* CALLS CEA, DEQ, ROA, VTE.
REA SUBR ENTRY/EXIT
NJN REA2 IF EQUIPMENT RELEASE NOT REQUIRED
REA1 RJM DEQ RELEASE EQUIPMENT
REA2 RJM ROA REQUEST OPERATOR ASSIGNMENT
RJM CEA CHECK EQUIPMENT ACCESS LEVELS
NJN REA1 IF ACCESS LEVEL OUT OF RANGE
LDD CN
ZJN REA3 IF NO TYPE REQUESTED
LMD FS+3 CHECK TYPE
LPC 3777
ZJN REA3 IF CORRECT TYPE
LDD CN
LMC 2RMS
NJN REA1 IF NOT *MS*
LDD FS
SHN 21-13
PJN REA1 IF NOT MASS STORAGE EQUIPMENT
REA3 LDD FS+3 CHECK FOR *DS*
LMC 2RDS
ZJN REA1 IF *DS*
LDD EQ
RJM VTE CHECK FOR TAPE EQUIPMENT
LJM REAX RETURN
ROA SPACE 4,20
** ROA - REQUEST OPERATOR ASSIGNMENT.
*
* ENTRY (FN - FN+4) = FILE NAME.
* (CN) = EQUIPMENT TYPE.
* (CN+2) = DISPLAY CODE FOR DENSITY, IF *NT* EQUIPMENT.
* (VS - VS+2) = VSN, IF TAPE EQUIPMENT.
* (FA) = FNT ADDRESS, IF VSN ENTRY PRESENT.
*
* EXIT (EQ) = ASSIGNED EQUIPMENT.
* (FS - FS+4) = EST ENTRY OF ASSIGNED EQUIPMENT.
*
* EXIT TO *RCL*, IF OPERATOR ASSIGNMENT OF EQUIPMENT
* STILL PENDING.
* (FS - FS+4) = FST ENTRY.
*
* USES T1, T7, CM - CM+4, FN+3.
*
* CALLS ACS, COE, SPB.
*
* MACROS MONITOR, NFA.
ROA10 STD CM+1
STD EQ SET POSSIBLE EST ORDINAL
SFA EST
ADK EQDE READ EST ENTRY
CRD FS
LDN TAEQM CHECK FOR INVALID EQUIPMENT
STD T1
ROA10.1 LDM TAEQ,T1
LMD FS+3
ZJN ROA11 IF INVALID EQUIPMENT
AOD T1
LMN TAEQL
NJN ROA10.1 IF NOT END OF TABLE
LDD FS CHECK EQUIPMENT STATUS
SHN 21-1
MJN ROA11 IF OFF OR DOWN
SHN 2+21-13
MJN ROAX IF MASS STORAGE
LDK REQS REQUEST ACTIVE EQUIPMENT
STD CM+2
MONITOR REQM
LDD CM+1 CHECK ASSIGNMENT
NJN ROAX IF ASSIGNMENT MADE
ROA11 LDN 0
STD EQ SET EQUIPMENT
UJN ROA1 REQUEST ASSIGNMENT
ROA SUBR ENTRY/EXIT
LDN 0 CLEAR OPERATOR ASSIGNED EQUIPMENT
RJM COE
ZJN ROA1 IF EQUIPMENT NOT ASSIGNED
LJM ROA10 PROCESS EQUIPMENT
ROA1 STD CM+1
LDD FN+3
SCN 77
STD FN+3
LDD FA
ZJN ROA2 IF NO FNT/FST ENTRY
NFA FA,R
ADN FSTL
CRD FS READ FST ENTRY
ROA2 LDC ROAB INITIALIZE MESSAGE ADDRESS
STD T1
LDN FN ENTER FILE NAME IN REQUEST MESSAGE
RJM ACS
LDD CN
NJN ROA3 IF DEVICE TYPE SPECIFIED
LJM ROA7 CHECK FOR *REQUEST* COMMAND
ROA3 LDC =2C, ADD *, *
RJM ACS
LDD CN
LPC 3777 CLEAR NON-ALLOCATABLE BIT
STD CM SAVE DEVICE TYPE
LMC 2RMT
ZJN ROA4 IF *MT*
LMC 2RCT&2RMT
ZJN ROA4 IF *CT*
LMC 2RAT&2RCT
ZJN ROA4 IF *AT*
LMC 2RNT&2RAT
NJN ROA6 IF NOT *NT*
LDD CN+2 GET DISPLAY CODE FOR DENSITY
STD CM
ROA4 LDN CM ENTER DEVICE TYPE OR DENSITY DISPLAY
RJM ACS
LDD VS
ZJN ROA5 IF NO VSN SPECIFIED
LDC =2C, ADD *, *
RJM ACS
LDN 0
STD VS+3 SET END OF VSN
LDN VS ENTER VSN INTO REQUEST MESSAGE
RJM ACS
ROA5 LDC ROAA SET MESSAGE ADDRESS
STD T7
LJM ROA9 RECALL
* CHECK FOR *REQUEST* CONTROL CARD.
ROA6 LDN CM ENTER DEVICE TYPE IN REQUEST MESSAGE
RJM ACS
ROA7 LDD CP CHECK FOR *REQUEST* IN *MS1W*
ADN MS1W
CRD CM
LDN 2
STD T1
ROA8 LDM CM,T1
LMM ROAA,T1
ZJN ROA8.1 IF POSSIBLY *REQUEST*
LMM ROAC,T1
NJN ROA5 IF NOT *$REQUEST*
ROA8.1 SOD T1
PJN ROA8 IF MORE CHARACTERS TO CHECK
LDD CM+3
LMM ROAA+3
SCN 77
ZJN ROA8.2 IF *REQUEST*
LMC 2RT &2RS
NJN ROA5 IF NOT *$REQUEST*
ROA8.2 STD T7
LDN 1
RJM SPB SET PAUSE BIT
ROA9 LDN /ERR/WEQ * EQUIPMENT NOT AVAILABLE.*
LJM RCL RECALL
ROAA DATA 10HREQUEST -
ROAB BSSZ 12
ROAC VFD 36/6RREQUES&6R$REQUE
SEQ SPACE 4,20
** SEQ - SEARCH FOR EQUIPMENT.
*
* ENTRY (CN) = TYPE.
* (IR+2) = FUNCTION CODE.
* (AL) = 8/, 1/ACCESS LEVEL FLAG, 3/ACCESS LEVEL.
*
* EXIT (A) .LT. 0, IF MSAL REQUEST.
* (A) = 0, IF EQUIPMENT PRESENT IN SYSTEM AND AVAILABLE.
* (A) .GT. 0, IF EQUIPMENT PRESENT IN SYSTEM BUT
* UNAVAILABLE.
* (EQ) = EST ORDINAL.
* (FS - FS+4) = EST ENTRY.
* (ASFA) = *RTCM* DEVICE SELECTION PARAMETER.
*
* ERROR TO *ERR*, IF EQUIPMENT NOT PRESENT IN SYSTEM.
*
* USES EQ, T0, T1, T2, CM - CM+4, FS - FS+4, T3 - T7.
*
* CALLS CEA, VSO.
*
* MACROS SFA.
SEQ11 LDN TTEQ SET *TT* EQUIPMENT
STD EQ
SFA EST
ADK EQDE
CRD FS GET EST ENTRY
LDN 0 RETURN AVAILABLE STATUS
SEQ SUBR ENTRY/EXIT
LDN ESTP READ EST POINTER
CRD CM
LDD CM+2 SAVE HIGHEST EST ORDINAL
STM SEQB
LDN NEEQ-1 INITIALIZE EST ORDINAL FOR SEARCH
STD EQ
STD T1 CLEAR TYPE FOUND FLAG
LDD CN CHECK TYPE
LPC 3777
LMC 2RTT
ZJN SEQ11 IF *TT*
LMC 2RDE&2RTT
ZJN SEQ4 IF *DE*
LMN 2RDP&2RDE
ZJN SEQ4 IF *DP*
LDN 0 INITIALIZE TABLE SEARCH
STD T2
SEQ1 LDD CN CHECK TABLE FOR MATCH
LPC 3777
ZJN SEQ6 IF FIELD NOT SET
LMM TAEQ,T2
ZJN SEQ2 IF MATCH
AOD T2
LMN TAEQL
NJN SEQ1 IF NOT END OF TABLE
UJN SEQ3 SEARCH EST
SEQ2 LDD IR+2 CHECK FUNCTION
LMN 15
NJN SEQ6 IF NOT FROM *AEQ*
LDN NEEQ
STD EQ
LDD T2 CHECK LOCATION OF EQUIPMENT IN TABLE
STM ASFA SET FLAG FOR *RTCM* CALL
SBN TAEQM
PJN SEQ6 IF INCORRECT EQUIPMENT
LJM SEQX RETURN
SEQ3 AOM SEQA DO NOT SEARCH FOR EXTENDED MEMORY TYPE
SEQ4 AOD EQ
LMC 0
SEQB EQU *-1
NJN SEQ7 IF NOT END OF EST
LDD T1
NJN SEQ6 IF TYPE NOT FOUND
LDN 1
SEQ5 LJM SEQX RETURN
SEQ6 LDN /ERR/IEQ * INCORRECT EQUIPMENT.*
LJM ERR PROCESS ERROR
SEQ7 SFA EST,EQ READ EST ENTRY
ADK EQDE
CRD FS
LDD FS+3 CHECK TYPE
LMD CN
LPC 3777
ZJN SEQ8 IF MATCH
STD T0
LDN 0
SEQA EQU *-1
* LDN 1 (NOT EXTENDED MEMORY TYPE)
SEQ7.1 NJN SEQ4 IF NOT CHECKING FOR EXTENDED MEMORY TYPE
LDD T0
LMN 2RDE&2RDP
NJN SEQ4 IF NO MATCH
SEQ8 STD T1 SET TYPE FOUND
LDD FS
SHN 21-1
MJN SEQ4 IF *OFF*
RJM CEA CHECK EQUIPMENT ACCESS LEVELS
NJN SEQ7.1 IF ACCESS LEVEL NOT IN RANGE
LDD FS
SHN 21-13
PJN SEQ10 IF NOT MASS STORAGE
LDD FS+4
SHN 3
ADN ACGL
CRD T3
ADN DILL-ACGL
CRD T2
LDD T3+4
SHN 21-4
MJN SEQ9.1 IF ERROR IDLE SET
RJM VSO VALIDATE CALLER
ZJN SEQ8.1 IF JOB HAS PROPER VALIDATION
LDD T2
SHN 21-0
PJN SEQ9.1 IF NOT *TEMP* DEVICE
SEQ8.1 LDD FS
LPC 500
SEQ9 NJN SEQ9.1 IF EQUIPMENT NOT AVAILABLE
LJM SEQ5 RETURN
SEQ9.1 LJM SEQ4 LOOP FOR NEXT EQUIPMENT
SEQ10 SHN 0-12-21+13
LMN 1
ZJN SEQ9 IF ALLOCATABLE DEVICE
SFA EST,EQ CHECK ASSIGNMENT STATUS
ADK EQAE
CRD T3
LDD T3+4
UJN SEQ9 CHECK ASSIGNMENT STATUS
TAEQ SPACE 4,10
** TAEQ - TABLE OF EQUIPMENT MNEMONICS.
*
* A MNEMONIC IN THE TABLE BEFORE *TAEQM* IMPLIES IT IS
* A SPECIAL MNEMONIC FOR ASSIGNMENT OF *MSAL*
* DEVICES. ANY MNEMONIC AFTER *TAEQM* IN THE TABLE
* IS AN INCORRECT DEVICE TYPE.
TAEQ INDEX
INDEX TMPS,2RTP TEMP DEVICE
INDEX INPS,2RIN INPUT DEVICE
INDEX OUTS,2ROT OUTPUT DEVICE
INDEX PRIS,2RPY PRIMARY DEVICE
INDEX LOCS,2RLO LOCAL DEVICE
INDEX LGOS,2RLG LGO DEVICE
INDEX MXRS
TAEQM EQU *-TAEQ FLAG FOR *RTCM* CALL
LOC TAEQM
CON 2RCM CONTROL MODULE
CON 2RCP CARD PUNCH
CON 2RCR CARD READER
CON 2RDS DISPLAY CONSOLE
CON 2RLP LINE PRINTER
CON 2RLQ LINE PRINTER
CON 2RLR LINE PRINTER
CON 2RLS LINE PRINTER
CON 2RLT LINE PRINTER
CON 2RLX 5870 NON-IMPACT PRINTER
CON 2RLY 5970 NON-IMPACT PRINTER
CON 2RMP MAP III/IV
CON 2RNC NAD
CON 2RND CDCNET DEVICE INTERFACE (MDI/MTI)
CON 2RNP 255X NETWORK PROCESSING UNIT
CON 2RRD REDEFINITION DEVICE
CON 2RRM TWO PORT MULTIPLEXER
CON 2RRP RING PORT
CON 2RSS MSE M860 CONTROLLER
CON 2RTT TIME-SHARING MULTIPLEXER
LOC *O
TAEQL EQU *-TAEQ
UPC SPACE 4,10
** UPC - UPDATE PRU COUNTER.
*
* ENTRY (CM - CM+4) = EST ENTRY.
*
* EXIT PRU COUNTER UPDATED IN NFL *SSJ=* BLOCK, IF PRESENT.
* OTHERWISE, THE COUNT IS SET FOR THE *UADM*
* FUNCTION TO UPDATE CONTROL POINT AREA WORD *ACLW*.
*
* USES T0, T1, T2, T3, CM - CM+4.
*
* MACROS NFA.
UPC3 LDD T1 SET SECTOR COUNT FOR *UADM*
STM DPPB+1
UPC SUBR ENTRY/EXIT
LDD CM+4 READ MST
SHN 3
ADK MDGL
CRD CM
LDD CM+4 SAVE SECTOR LIMIT
STD T1
LDD CP CHECK FOR *SSJ=* BLOCK PRESENT
ADK SEPW
CRD CM
LDD CM
SHN 21-2
PJN UPC3 IF NO *SSJ=* ENTRY POINT
LDD CM+3
LPN 37
SHN 14
ADD CM+4
ZJN UPC3 IF NO *SSJ=* BLOCK PRESENT
NFA SSJN+ACLS READ NFL COPY OF *SSJ=* BLOCK
CRD CM
LDD CM+3 GET CURRENT PRU COUNT
LPN 77
STD T2
SHN 14
LMD CM+4
STD T3
LMC 777777
ZJN UPC2 IF UNLIMITED VALIDATION
LDD T3 CALCULATE NEW PRU COUNT
SBD T1
STD T0
PJN UPC1 IF NO BORROW
SOD T2
MJN UPC2 IF RESULT IS NEGATIVE
AOD T0
UPC1 STD CM+4 SET NEW PRU COUNT
LDD CM+3
SCN 77
ADD T2
STD CM+3
NFA SSJN+ACLS
CWD CM
UPC2 LJM UPCX RETURN
VAE SPACE 4,10
** VAE - VALIDATE ASSIGNED EQUIPMENT.
*
* ENTRY (EQ) = EQUIPMENT EST ORDINAL.
*
* EXIT RELEASES EQUIPMENT AND EXITS TO *VSJ1*, IF NOT
* PROPERLY VALIDATED.
*
* CALLS DEQ, RAW.
VAE SUBR ENTRY/EXIT
RJM RAW READ ACCESS CONTROL WORD
SHN 21-6
MJN VAEX IF PROPERLY VALIDATED FOR ASSIGNED EQUIP
RJM DEQ RELEASE EQUIPMENT
UJN VSJ1 * USER ACCESS NOT VALID.*
VSJ SPACE 4,15
** VSJ - VALIDATE SSJ=.
*
* ENTRY AT *VSJ1*, IF USER ACCESS NOT VALID ERROR DETECTED.
*
* EXIT (FA) = UNCHANGED, IF NO ERROR.
*
* ERROR TO *ERR*, IF NOT PROPERLY VALIDATED.
*
* USES FA.
*
* CALLS CSJ.
VSJ SUBR ENTRY/EXIT
RJM CSJ CHECK FOR SSJ= ENTRY POINT
MJN VSJX IF JOB HAS SSJ= ENTRY POINT
VSJ1 LDN 0
STD FA
LDN /ERR/IUA * USER ACCESS NOT VALID.*
LJM ERR PROCESS ERROR
VSO SPACE 4,10
** VSO - VALIDATE SYSTEM ORIGIN PRIVLEDGES.
*
* ENTRY (OC) = ORIGIN CODE.
*
* EXIT (A) = 0 IF JOB IS SYSTEM ORIGIN OR HAS SYSTEM
* ORIGIN PRIVILEGES.
*
* CALLS RAW.
VSO SUBR ENTRY/EXIT
LDD OC CHECK FOR SYOT
LMK SYOT
ZJN VSOX IF SYOT JOB
RJM RAW READ ACCESS CONTROL WORD
LPN 20
LMN 20
UJN VSOX RETURN
VTE SPACE 4,10
** VTE - VERIFY TAPE ENTRY.
*
* ENTRY (A) = EST ORDINAL.
*
* EXIT (A) .EQ. 0 = TAPE EQUIPMENT (MT, NT, CT OR AT).
* (A) .EQ. 1 = VSN EQUIPMENT (TE).
* (A) .LT. 0 = NOT TAPE RELATED EQUIPMENT.
*
* USES CM - CM+4.
*
* CALLS CTE.
*
* MACROS SFA.
VTE SUBR ENTRY/EXIT
SFA EST READ EST ENTRY
ADK EQDE
CRD CM
LDD CM+3 CHECK EQUIPMENT TYPE
RJM CTE CHECK FOR TAPE EQUIPMENT
UJN VTEX RETURN
SPACE 4,10
** COMMON DECKS.
*CALL COMPACS
*CALL COMPC2D
SPACE 4,10
ERRNG OVL0-* CODE OVERFLOWS INTO ZERO LEVEL OVERLAYS
OVERFLOW OVL
OVERLAY (COMMAND FILE FUNCTIONS.)
SPACE 4,10
SPACE 4,10
**** ADDITIONAL DIRECT LOCATION ASSIGNMENTS.
SP EQU 60 - 64 COMMAND POINTER (5 LOCATIONS)
CF EQU 65 COMMAND FILE FLAGS
WO EQU 66 COMMAND SECTOR WORD COUNT OVERLAP
****
ACS SPACE 4,20
*** FUNCTION 21.
* ATTACH COMMAND FILE UNDER NAME FROM FET.
* ENTER CURRENT COMMAND COUNT IN (FET+6).
*
* ENTRY (FN - FN+3) = FILE NAME FROM FET+0.
*
*T FET+6 1/L,41/,18/ ADDR
*
* L = 1 IF FILE MUST BE CREATED AS A LOCKED LIBRARY FILE.
* ADDR = IF PRESENT IS ADDRESS TO RECEIVE POSITION INFORMATION.
*
* EXIT -
*
*T FET+6 42/0, 18/COMMAND COUNT
*
*T ADDR 30/0, 24/CURRENT RANDOM ADDR, 6/WC
*
* WC = WORD COUNT POSITION IN CURRECT SECTOR.
*
* ENTRY (FF) = FET SPECIFIED FNT ADDRESS.
ACS1 ENTRY ACS
LDD FF SET INITIAL FNT ADDRESS
RJM SAF SEARCH FOR ASSIGNED FILE
ZJN ACS2 IF NOT FOUND
LDN 0 CLEAR FNT ADDRESS
STD FA
LDN /ERR/DFN
LJM ERR PROCESS ERROR
ACS2 LDD CP READ COMMAND FST ENTRY
ADN CSSW
CRD CM
LDD CM CHECK STATUS
LPC 777
ADD CM+1
NJN ACS3 IF FILE DEFINED
LJM LFMX EXIT
ACS3 LDN NEEQ SET NULL EQUIPMENT
STD EQ
RJM EFN ENTER FILE NAME
LDD CP READ COMMAND POINTER
ADN CSPW
CRD SP
ADN CSSW-CSPW READ FST ENTRY
CRD FS
LDD FS SAVE ORIGINAL COMMAND FILE FLAGS
STD CF
LPC 777 SET EST ORDINAL
STD FS
STD T5
LDD FS+4 SAVE SECTOR WORD COUNT OVERLAP
LPN 77
STD WO
LDN 4 SET EOR OPERATION
STD FS+4
* CHECK IF POSITION INFORMATION TO BE RETURNED.
RJM CPA READ FET+6
ADN 6
CRD CN
LDD CN+3 CHECK IF ADDRESS PRESENT
LPN 77
STD CN+3
SHN 14
LMD CN+4
NJN ACS4 IF ADDRESS PRESENT
LJM ACS7 CHANGE TO *LIFT* FILE TYPE
ACS4 SHN -6 CHECK IF ADDRESS WITHIN FL
SBD FL
MJN ACS5 IF WITHIN FL
LDN /ERR/AOR * ADDRESS OUT OF RANGE.*
LJM ERR ABORT
ACS5 LDD CN SET FILE TYPE OPTION
SHN -13
RAM ACSA
LDD FS+2 CURRENT TRACK
STD T6
LDD FS+3 CURRENT SECTOR
STD T7
LDD FS+1 FIRST TRACK
RJM SRA SET RANDOM ADDRESS
SOD RI+1 ADJUST ADDRESS TO PREVIOUS SECTOR
PJN ACS6 IF NO UNDERFLOW
SOD RI
AOD RI+1
ACS6 LDD RI RETURN RANDOM ADDRESS
SHN 6
STD CM+3
SHN -14
STD CM+2
LDD RI+1
SHN 6
STD CM+4
SHN -14
RAD CM+3
LDC CSBN SET WORD COUNT
SBD SP+3
SBD WO ADJUST FOR OVERLAP
RAD CM+4
SHN -14
RAD CM+3
LDN 0 RETURN POSITION INFORMATION
STD CM
STD CM+1
LDD CN+3
SHN 6
ADD RA
SHN 6
ADD CN+4
CWD CM
LDD CF CHECK IF ORIGINAL COMMAND FILE
SHN 21-13
MJN ACS7 IF ORIGINAL JOB INPUT FILE
* IF THE USER OF *ACCSF* HAS BIT 59 SET IN FET+6,
* IT IS NECESSARY FOR THE COMMAND FILE TO BE
* ACCESSED AS A LOCKED, READ ONLY, LIBRARY FILE.
*
* *CHKPT* USES THIS OPTION BECAUSE IF THE FILE IS CREATED
* AS LOCAL, THE *ENCSF* MACRO CAN BE USED TO RESTORE THE
* COMMAND FILE AND THE CORRESPONDING POINTERS IN THE
* *CPA*. WHEN THE COMMAND BUFFER IS SUBSEQUENTLY
* RESTORED (FROM THE $DM*$ FILE) IT IS POSSIBLE FOR THE
* POINTERS TO THE COMMAND FILE (NOT RESTORED FROM
* THE $DM*$ FILE) TO BE INCORRECT IF A COMMAND WAS
* CONTINUED FROM THE PREVIOUS SECTOR.
*
* *ENQUIRE* USES THIS OPTION BECAUSE IT ONLY WANTS TO READ
* THE FILE, NOT REPOSITION OR RESTORE IT.
ACSA LDN 0
* LDN 1 (FILE MUST BE LOCKED LIBRARY FILE)
NJN ACS7 IF SETTING WRITE LOCKOUT
SOM ACSB DO NOT LOCK FILE
LDN ZERL CLEAR CONTROL POINT AREA POINTERS
CRD CM
CRD CN
LDD SP RETAIN CSPW BYTE 0
STD CM
LDD CP
ADK CSPW
CWD CM
ADN CSSW-CSPW
CWD CN
UJN ACS8 CHECK *SSJ=* VALUE
ACS7 LDC LIFT*100-LOFT*100 CHANGE FILE TYPE TO *LIFT*
RAD FN+4
ACS8 LDD CP CHECK *SSJ=* ADDRESS VALUE
ADC SEPW
CRD CM
LDD CM+3
LPN 77
LMN 40
SHN 14
LMD CM+4
NJN ACS9 IF *SSJ=* VALUE .NE. 400,000B
LDD FN+4 CHANGE FILE STATUS TO *SSST*
SCN 77
LMN SSST
STD FN+4
ACS9 LDD FS+1 REWIND FILE
STD FS+2
LDN FSMS
STD FS+3
LDD FN+3 SET LOCKED FILE
SCN 77
LMN 1
ACSB EQU *-1
* LMN 0 DO NOT LOCK FILE WHEN LOFT
STD FN+3
NFA FA,R STORE FNT WORD
CWD FN
LDN ZERL SET COMMAND COUNT
CRD CN
LDD SP+1
LPN 77
STD CN+3
LDD SP+2
STD CN+4
RJM CPA STORE (FET+6)
ADN 6
CWD CN
LJM LFMX EXIT
ECS SPACE 4,20
*** FUNCTION 22.
* REPLACE COMMAND FILE.
* IF FILE IS NOT DEFINED, COMMAND FILE WILL BE
* CLEARED.
*
* ENTRY (FN - FN+3) = FILE NAME FROM FET+0.
* FET+6 42/, 18/ADDR
*
* ADDR = IF PRESENT IS ADDRESS CONTAINING POSITION INFORMATION.
* THE FORMAT OF THIS ADDRESS IS THE FOLLOWING.
*
*T ADDR 24/CS, 6/0, 24/CURRENT RANDOM ADDR, 6/WC
*
* CS = COMMAND COUNT.
* WC = WORD COUNT POSITION IN SECTOR.
*
* ENTRY (FF) = FET SPECIFIED FNT ADDRESS.
ENTRY ECS
LDD FF SET INITIAL FNT ADDRESS
RJM SAF SEARCH FOR ASSIGNED FILE
NJN ECS1 IF FOUND
LDN ZERL
CRD FS CLEAR FST ENTRY
LDD CP READ COMMAND POINTER
ADN CSPW
CRD SP
LDC 4000 SET EOR
STD SP+1
LDD SP+4 CLEAR BUFFER
STD SP+3
LDD CP STORE COMMAND POINTER
ADN CSPW
CWD SP
LJM LFMX RETURN
ECS1 RJM SFB SET FILE BUSY
ZJN ECS2 IF NO REJECT ON FILE INTERLOCK
LDN /ERR/IOE *I/O SEQUENCE ERROR.*
LJM ERR ABORT
ECS2 LDD CM+4 CHECK FILE TYPE
SHN -6
LMN LOFT
NJN ECS3 IF NOT LOCAL FILE TYPE
LDD CM+3 CHECK FILE MODE
SHN 21-2
MJN ECS2.1 IF EXECUTE-ONLY FILE
LJM ECS6 LOCAL FILE TYPE
ECS2.1 LDN /ERR/ILM * INCORRECT FILE MODE.*
LJM ERR ABORT
ECS3 LMN LIFT&LOFT
NJN ECS4 IF NOT LIBRARY FILE TYPE
LDC ECS4 MUST HAVE POSITION PARAMETER
STM ECSA
* COMPARE TO ORIGINAL JOB INPUT FILE.
NFA FNTN+FSTL FETCH INPUT FILE FST INFORMATION
CRD CM
LDD FS COMPARE EQUIPMENT AND FIRST TRACK
LMD CM
NJN ECS4 IF LIBRARY TYPE BUT NOT INPUT
LDD FS+1
LMD CM+1
ZJN ECS5 IF ORIGINAL JOB FILE
ECS4 LDN /ERR/IFT * INCORRECT FILE TYPE.*
LJM ERR PROCESS ERROR
ECS5 LDC MJNI&UJNI PREVENT DROPPING TRACKS
LMM ECSC
STM ECSC
LDC 4000 SET ORIGINAL INPUT FILE FLAG
STM ECSB
ECS6 SFA EST,FS CHECK FOR MASS STORAGE
ADK EQDE
CRD CM
LDD CM
SHN 21-13
MJN ECS7 IF ON MASS STORAGE
LDN /ERR/IEQ * INCORRECT EQUIPMENT.*
UJN ECS9 ABORT
ECS7 LDD FS+2
NJN ECS10 IF FILE USED
ECS8 LDN /ERR/FLE * FILE EMPTY.*
ECS9 LJM ERR PROCESS ERROR
* CHECK IF POSITION INFORMATION TO BE RETRIEVED.
ECS10 RJM CPA READ FET+6
ADN 6
CRD CN
LDD CN+3 CHECK IF ADDRESS PRESENT
LPN 77
STD CN+3
SHN 14
ADD CN+4
NJN ECS11 IF ADDRESS PRESENT
LJM ECS13 IF ADDRESS NOT PRESENT
ECSA EQU *-1
* LJM ECS4 IF INPUT FILE BUT NO POSITION PARAMETER
ECS11 SHN -6 CHECK IF ADDRESS WITHIN FL
SBD FL
MJN ECS12 IF WITHIN FL
LDN /ERR/AOR * ADDRESS OUT OF RANGE.*
LJM ERR ABORT
ECS12 LDD CN+3 READ POSITION INFORMATION
SHN 6
ADD RA
SHN 6
ADD CN+4
CRD CM
LDD CM+3 GET CURRENT RANDOM ADDRESS
SHN 6
STD RI+1
SHN -14
STD RI
LDD CM+4
SHN -6
RAD RI+1
LDD CM+2
SHN 6
RAD RI
LDN 0
STD CN+3
LDD CM GET COMMAND COUNT
STD CN+1
LDD CM+1
STD CN+2
LDD CM+4 SET WORD COUNT
LPN 77
STD CN+4
LDD FS SET EQUIPMENT
STD T5
LMC 0
ECSB EQU *-1
* LMC 4000 WHEN ORIGINAL JOB INPUT FILE
STD FS
LDD FS+1 SET FIRST TRACK
STD T6
RJM PCF POSITION COMMAND FILE
LJM ECS16 STORE NEW FST WORD
* CONTINUE HERE IF POSITION INFORMATION NOT PRESENT.
ECS13 LDD CP READ COMMAND POINTER
ADN CSPW
CRD SP
LDD FS SET EQUIPMENT
STD T5
LDD FS+1 SET FIRST TRACK
STD FS+2
STD T6
LDN FSMS SET FIRST SECTOR
STD T7
SETMS IO
LDC BFMS READ FIRST SECTOR
RJM RNS
ENDMS
LDD T1 CHECK WORD COUNT
NJN ECS14 IF NOT EMPTY SECTOR
LJM ECS8 * FILE EMPTY.*
ECS14 LDN 0 CLEAR COMMAND COUNT
STD SP+1
STD SP+2
STD FS+4
LDC CSBN SET INITIAL COMMAND INDEX
STD SP+3
NFA SP+3,R STORE SECTOR
CWM BFMS+2,T1
LDD SP+3
SBD T1
STD SP+4
LDD T7 SET CURRENT SECTOR IN FST
STD FS+3
LDD T1 CHECK BUFFER WORD COUNT
LMD HN
ZJN ECS15 IF NOT SHORT SECTOR
LDC 4000 SET EOR FLAG
STD SP+1
ECS15 LDD FS+1
STD FS+2
LDD CP STORE COMMAND POINTER
ADN CSPW
CWD SP
ADN CSSW-CSPW READ FST ENTRY
ECS16 CRD CN
CWD FS STORE NEW FST ENTRY
LDD CN
SHN 21-13
MJN ECS17 IF OLD FILE WAS INPUT FILE
ECSC EQU *-1
* UJN ECS17 (ORIGINAL JOB INPUT FILE)
LDD CN DROP OLD COMMAND FILE
LPC 777
STD CM+1
LDD CN+1
STD CM+2
ZJN ECS17 IF NO FIRST TRACK
MONITOR DTKM
LDD CM+3 SET COUNT OF SECTORS RETURNED
STM DPPB
LDD CM+4
STM DPPB+1
LDN CICS SET INCREMENT SUBFUNCTION
STM DPPA
ECS17 LDD FA
ZJN ECS18 IF NO FNT ENTRY
STD CM+4
LDN DLFS CLEAR FNT ENTRY
STD CM+1
MONITOR PLFM
* LDN 0 CLEAR FNT ADDRESS
STD FA
ECS18 LJM LFMX EXIT
PCS SPACE 4,10
*** FUNCTION 23.
* POSITION COMMAND FILE.
*
* ENTRY -
*T FET+6 12/,24/ CS,24/ WC
* CS COMMAND COUNT
* WC WORD COUNT FROM BEGINNING OF FILE
ENTRY PCS
LDD CP READ COMMAND FST ENTRY
ADN CSSW
CRD FS
LDD FS SET EQUIPMENT
LPC 777
STD T5
LDD FS+1 SET FIRST TRACK
STD T6
NJN PCS1 IF FILE EXISTS
LDN /ERR/FLE FILE EMPTY
LJM ERR PROCESS ERROR
PCS1 RJM CPA READ (FET+6)
ADN 6
CRD CN
LDD CN+4 SET RANDOM INDEX
SCN 77
SHN 6
LMD CN+3
SHN 6
ADN FSMS
STD RI+1
SHN -14
STD RI
RJM PCF POSITION COMMAND FILE
CWD FS
LJM LFMX RETURN
PCF SPACE 4,25
** PCF - POSITION COMMAND FILE.
*
* ENTRY (RI - RI+1) = CURRENT RANDOM ADDRESS.
* (CN+1 - CN+2) = COMMAND COUNT.
* (CN+3 - CN+4) = WORD COUNT. FROM ECS THIS IS A 6 BIT
* WORD COUNT IN CN+4 RELATIVE TO THE PRU AND CN+3 = 0.
* IF FROM PCS THIS IS A 24 BIT WORD COUNT FROM THE
* BEGINNING OF FILE.
* (FS - FS+4) = FST ENTRY.
* (T5) = EST ORDINAL.
* (T6) = FIRST TRACK.
*
* EXIT (SP - SP+4) = WORD CSPW.
* (FS - FS+4) = UPDATED FST ENTRY.
* (A) = ADDRESS OF WORD *CSSW*.
*
* ERROR TO *ERR*, IF CURRENT RANDOM ADDRESS = 0, OR IF MASS
* STORAGE DEVICE ENCOUNTERED AN I/O ERROR.
*
* USES T2, T4, T6, T7, CN+4.
*
* CALLS CRA, RNS.
*
* MACROS ENDMS, SETMS.
PCF SUBR ENTRY
LDD RI CHECK CURRENT RANDOM ADDRESS
ADD RI+1
NJN PCF1 IF CURRENT RANDOM ADDRESS .NE. 0
LDN /ERR/IRA * INCORRECT RANDOM ADDRESS.*
LJM ERR PROCESS ERROR
PCF1 LDD CP READ COMMAND POINTER
ADN CSPW
CRD SP
RJM CRA CONVERT RANDOM ADDRESS
PJN PCF3 IF ADDRESS ON FILE
LDM ECSB
ZJN PCF2 IF NOT ORIGINAL JOB INPUT FILE
LJM PCF8 SET *EOR*
PCF2 LDD FS+1 SET FIRST TRACK
STD T6
LDN FSMS SET FIRST SECTOR
STD T7
LDN 0 CLEAR WORD COUNT
STD CN+4
PCF3 LDD T6 SET CURRENT TRACK
STD FS+2
LDD T7 SET CURRENT SECTOR
STD FS+3
SETMS IO
LDC BFMS READ SECTOR
RJM RNS
ENDMS
LDD T1
NJN PCF4 IF NOT EMPTY SECTOR
LJM PCF8 PROCESS *EOR*
PCF4 LDD CN+4
ADD CN+3
ZJN PCF5 IF POSITIONING TO BEGINNING
LDD CN+4
LPN 77
SBD T1
SBN 1
MJN PCF5 IF WORD COUNT ON FILE
LJM PCF8 SET *EOR*
PCF5 LDD CN+1 SET COMMAND COUNT
LPC 3777
STD SP+1
LDD CN+2
STD SP+2
LDC CSBN SET FIRST BUFFER ADDRESS
STD SP+3
LDD T6 UPDATE TRACK
STD FS+2
LDD T7 UPDATE SECTOR
STD FS+3
LDN 0 CLEAR WORD COUNT
STD FS+4
NFA SP+3,R WRITE NEXT SECTOR INTO BUFFER
CWM BFMS+2,T1
LDD SP+3 SET COMMAND LIMIT
SBD T1
STD SP+4
LDD CN+4 SET POSITION IN BUFFER
LPN 77
LMC -0
RAD SP+3
LDD T1
LMD HN
ZJN PCF7 IF NOT SHORT BLOCK
PCF6 LDC 4000 SET *EOR*
RAD SP+1
PCF7 LDD CP STORE COMMAND POINTER
ADN CSPW
CWD SP
ADN CSSW-CSPW SET ADDRESS OF *CSSW*
LJM PCFX EXIT
PCF8 LDC CSBN SET BUFFER EMPTY
STD SP+3
STD SP+4
LDN 0 CLEAR COMMAND COUNT
STD SP+1
STD SP+2
UJN PCF6 SET *EOR*
ERX SPACE 4,10
** ERX - EVALUATE MASS STORAGE ERROR RETURN.
*
* ENTRY (A) = ERROR RESPONSE FROM DRIVER.
* (T5) = EST ORDINAL.
* (FS - FS+4) = FST ENTRY.
*
* USES FS, IR+4, T0.
*
* CALLS ERR, SNB, *1RJ*.
*
* MACROS EXECUTE, PAUSE.
ERX PSN ENTRY
STD T0 SAVE ERROR RESPONSE
LDD FS INSURE FST IN CORRECT FORMAT
LPC 777
STD FS
LDD T0
SHN 21-12
PJN ERX2 IF ERROR RECOVERABLE
ERX1 LDN /ERR/CFE
LJM ERR PROCESS ERROR
ERX2 LDM MSD CHECK CALLER
SHN 21-13
PJN ERX1 IF SUBSYSTEM
ERX3 PAUSE
LDD CM+1
NJP LFMX IF ERROR FLAG SET
RJM SNB SET FST NONBUSY
LDD T5 SET EST ORDINAL
STD IR+4
EXECUTE 1RJ RECALL JOB
SPACE 4,10
** COMMON DECKS.
MSR EQU ERX ERROR PROCESSOR FOR *RNS*
*CALL COMPCRA
*CALL COMPRNS
SPACE 4,10
ERRNG OVL0-* CODE OVERFLOWS INTO ZERO LEVEL OVERLAYS
OVERFLOW OVL
OVERLAY (GETFNT AND PRIMARY FUNCTIONS.)
SPACE 4,10
**** ADDITIONAL DIRECT LOCATION ASSIGNMENTS.
CB EQU 65 CONTROL BITS - GETFNT FUNCTION.
* TEMPORARY STORAGE - PRIMARY FUNCTION.
SB EQU 66 - 67 FILE SELECTIVITY BITS - GETFNT FUNCTION.
****
TITLE GETFNT
GTF SPACE 4,50
*** FUNCTION 25.
* RETURN TABLE WITH FNT/FST ENTRIES (OPTIONALLY MODIFIED)
* FOR ALL WORKING FILES.
*
* ENTRY -
*T FET+8 12/NF, 6/, 18/SB, 2/, 1/F, 1/C, 1/M, 1/N, 18/TA
* WHERE -
* NF = MAXIMUM NUMBER OF FILE FNT/FST ENTRIES TO
* RETURN IN TABLE. TABLE SIZE MUST BE AT LEAST
* NF*2+1. FOR NEW FORMAT, TABLE MUST BE AT
* LEAST NF*2+2.
* SB = SELECTIVITY BITS. BIT SET IMPLIES FILE TYPE
* SELECTED. DEFAULT (*SB*=0) IS SELECTION OF
* ALL FILE TYPES. BIT POSITIONS AND CORRESPONDING
* FILE TYPES ARE DEFINED AS FOLLOWS -
*
* BIT FILE TYPE
* 41-38 UNUSED
* 37 LOFT
* 36 SYFT
* 35 FAFT
* 34 PMFT
* 33 PTFT
* 32 LIFT
* 31 RESERVED
* 30 RESERVED
* 29 QFFT
* 28 TEFT
* 27 PHQT
* 26 PRQT
* 25 ROFT
* 24 INFT
* F = SET INDICATES THE NEW FORMAT TWO-WORD ENTRY IS
* TO BE RETURNED. BITS 18 AND 19 (*M* AND *N*)
* ARE NOT CHECKED IF THIS BIT IS SET, SINCE THERE
* IS ONLY ONE FORMAT RETURNED IF *F* IS SET.
* C = SET IMPLIES TREAT CHECKPOINT FILES NORMALLY
* (LIKE ANY OTHER FILE). NOT SET IMPLIES WRITE
* CHECKPOINT FILE FNT/FST ENTRIES IN FET+9, AND
* ONWARD.
* M = SET IMPLIES MODIFY FST ENTRIES OF MS FILES
* WITH LENGTH OF FILE. NOT SET IMPLIES MODIFY
* WITH RANDOM INDEX.
* N = SET IMPLIES PERFORM NO MODIFICATION OF FST
* ENTRIES. NOT SET IMPLIES PERFORM PERTINENT
* MODIFICATIONS.
* TA = STARTING CM TABLE ADDRESS.
*
* IF NEW FORMAT IS REQUESTED (*F* SET) -
* (TA) = 48/, 12/ADDR
*
* WHERE -
* ADDR = 0, IF FIRST *GETFNT* CALL.
* = FWA OF THE LAST FNT ENTRY IN NFL PROCESSED BY
* LAST *GETFNT* CALL.
*
* EXIT IF *N* NOT SET -
* (FET+8) .LT. 0 IF AT LEAST 1 ERROR ENCOUNTERED.
* IF *C* NOT SET -
* (FET+9) = CHECKPOINT FILE FNT.
* = 0 IF NONE PRESENT (USER MUST PRESET).
* .LT. 0 IF MORE THAN TWO.
* (FET+10)= FST.
* (FET+11)= ALTERNATE CHECKPOINT FILE FNT.
* = 0 IF NO ALTERNATE (USER MUST PRESET).
* (FET+12)= FST.
*
* WRITES TABLE OF FNT/FST ENTRIES TO A CENTRAL MEMORY TABLE
* AND TERMINATES WITH A ZERO WORD. IF THE NEW FORMAT IS
* REQUESTED (BIT 21 SET), THE FIRST WORD OF THE TABLE
* CONTAINS AN ADDRESS AND THE FIRST FNT ENTRY
* BEGINS IN THE SECOND WORD OF THE TABLE. FOR MASS
* STORAGE FILES, BYTES 2 AND 3 OF FST ENTRY CAN BE MODIFIED
* WITH EITHER A RANDOM INDEX (CONVERTED FROM CURRENT TRACK
* AND SECTOR), OR THE FILE S LENGTH (NUMBER OF SECTORS).
* OPTIONALLY, FOR TAPE FILES, FST ENTRY CAN BE MODIFIED
* WITH *MT* IN BYTE 1 AND BLOCK NUMBER IN BYTES 2 AND 3.
* MODIFICATION CAN BE DONE ONLY IF THE OLD FORMAT
* IS TO BE RETURNED IN THE TABLE.
*
* IF NEW FORMAT IS SELECTED (*F* SET) -
* (TA) = 48/, 12/ADDR
*
* WHERE -
* ADDR = 0, IF SEARCH COMPLETE.
* = FWA OF THE LAST FNT ENTRY IN NFL PROCESSED
* BY THIS *GETFNT* CALL.
*
* OLD FORMAT OF TWO-WORD TABLE ENTRY RETURNED (*F* NOT SET) -
*
*T 42/FILENAME, 1/, 3/M, 1/, 1/W, 6/FT, 6/FS
*T, 12/EQ,48/D
*
* NEW FORMAT OF TWO-WORD TABLE ENTRY RETURNED (*F* SET) -
*
*T 42/ FILENAME,3/ AL,2/ I,1/W,6/ FT,6/ FS
*T+1 24/FL ,24/RB, 3/RES, 1/F ,4/M 3/RS, 1/L
*
* WHERE -
* AL = FILE ACCESS LEVEL.
* D = INFORMATION DEPENDS ON FILE TYPE AND/OR WHETHER
* OR NOT FST MODIFICATION IS SELECTED.
* IF TTY FILE -
* D = 12/*TT*, 36/
* IF TAPE FILE -
* D = 12/*MT*, 24/BLOCK COUNT, 12/
* IF MS FILE AND *M* SET -
* D = 12/, 24/RANDOM INDEX, 12/
* IF MS FILE AND *M* NOT SET -
* D = 12/, 24/FILE LENGTH, 12/
* IF OPTICAL DISK FILE AND *M* SET -
* D = 12/*OD*, 24/RANDOM INDEX, 12/
* IF OPTICAL DISK FILE AND *M* NOT SET -
* D = 12/*OD*, 24/FILE LENGTH, 12/
* EQ = EST ORDINAL.
* FL = FILE LENGTH (IF MS).
* = 0 (IF TAPE, TTY, OR OTHER).
* FS = FILE STATUS.
* FT = FILE TYPE.
* I = 0, IF MS FILE.
* = 1, IF TAPE FILE.
* = 2, IF TTY FILE.
* = 3, IF NOT MS, TAPE, OR TTY FILE.
* L = SET IF LAST OPERATION WAS WRITE.
* M = MODE OF USE ALLOWED.
* NEW FORMAT -
* 0 = READ.
* 1 = WRITE.
* 2 = MODIFY.
* 3 = APPEND.
* 4 = EXECUTE.
* 5 = READ ALLOW MODIFY.
* 6 = READ ALLOW APPEND.
* 7 = UPDATE.
* 10 = READ ALLOW UPDATE.
* 11-17 = RESERVED.
* OLD FORMAT -
* BIT 16 - SET IF EXTEND-ONLY FILE.
* BIT 15 - SET IF ALTER-ONLY FILE.
* BIT 14 - SET IF EXECUTE-ONLY FILE.
* RB = RANDOM INDEX (IF MS).
* = BLOCK COUNT (IF TAPE).
* = 77777777 (IF TAPE BUT *MAGNET* NOT PRESENT.)
* = 0 (IF TTY OR OTHER).
* F = THE FILE ERROR STATUS. SET IF THE FILE IS
* ON A DEVICE THAT IS NOT AVAILABLE.
* RS = READ STATUS (MS ONLY).
* 0 = INCOMPLETE READ.
* 1 = EOR.
* 2 = EOF.
* 3 = EOI.
* 4 = BOI.
* 5-7 = RESERVED.
* S = SET IF SYSTEM SECTOR CONTAINS CONTROL
* INFORMATION.
* W = SET IF WRITE LOCKOUT.
ENTRY GTF
RJM CPA READ FET+CFPN
ADN CGNT
CRD CN
RJM CCP CRACK CALLING PARAMETERS
MJN GTF1 IF ERROR
LDD CN+3 CHECK IF TABLE WITHIN RANGE
SHN 14
LMD CN+4
ADD CN
ADD CN
ADN 1
ADD FT+1
SHN -6
SBD FL
MJN GTF3 IF WITHIN RANGE
LDN /ERR/GTL * GETFNT TABLE TOO LARGE.*
UJN GTF2 ABORT
GTF1 LDN /ERR/FTS * FET TOO SHORT.*
GTF2 LJM ERR PROCESS ERROR
* DETERMINE FNT ENTRY FROM WHICH TO BEGIN SCAN.
GTF3 LDC FNTN-LENF FWA OF FNTS IN NFL
STD FT+4
LDD FT+1
ZJN GTF7 IF OLD FORMAT
LDD CN+4 SAVE FWA OF TABLE
STM GTFA+1
LDD CN+3 READ FIRST WORD OF TABLE
STM GTFA
SHN 6
ADD RA
SHN 6
ADD CN+4
CRD FS
LDD FS+4
ZJN GTF6 IF NO ADDRESS
SBD FT+4 (ADDRESS) - (FWA OF FNT-S)
MJN GTF4 IF ADDRESS OUT OF RANGE
LDD FT
SHN 6
SBD FS+4 (LWA OF FNT-S) - (ADDRESS)
PJN GTF5 IF ADDRESS NOT OUT OF RANGE
GTF4 LDN /ERR/AOR * ADDRESS OUT OF RANGE.*
UJN GTF2 PROCESS ERROR
GTF5 LDD FS+4
STD FT+4 SAVE ADDRESS (LAST FNT PROCESSED)
GTF6 AOD CN+4 ADVANCE TABLE ADDRESS (NEW FORMAT ONLY)
SHN -14
RAD CN+3
* SCAN FNT FOR FILES REQUESTED.
GTF7 LDN LENF GET NEXT FNT ENTRY
RAD FT+4
SHN -6
SBD FT
MJN GTF8 IF NOT END OF FNTS
LDN 0 CLEAR FNT ADDRESS
STD FT+4
LJM GTF15 TERMINATE SCAN
GTF8 NFA FT+4,R
CRD FN FNT
ADN FSTL
CRD FS FST
ADN FUTL-FSTL
CRD CM FUT
LDD CM+2 GET FILE ACCESS LEVEL
SHN 3
LPN 70
STD AL
LDD FN
ZJN GTF7 IF EMPTY ENTRY
RJM CFS CHECK FILE SELECTIVITY
PJN GTF7 IF FILE NOT SELECTED
LDD FT+1
ZJN GTF9 IF OLD FORMAT
RJM RFE REFORMAT FNT ENTRY (NEW FORMAT ONLY)
LDD AL SET FILE ACCESS LEVEL IN FNT ENTRY
RAD FN+3
UJN GTF10 MODIFY FST
GTF9 LDD CB CHECK IF FST MODIFICATION DESIRED
SHN 21-0
MJN GTF11 IF NO MODIFICATION DESIRED
GTF10 RJM MFF
NJP GTF7 IF ERROR EXIT
* CHECK FOR CHECKPOINT FILE.
GTF11 LDD CB CHECK FOR NORMAL TREATMENT
SHN 21-2
MJN GTF14 IF CHECKPOINT FILES TO BE TREATED NORMALLY
LDD FN+4
LPN 77
LMN CBST
ZJN GTF12 IF CHECKPOINT FILE TYPE *CB*
LMN CKST&CBST
NJN GTF14 IF NOT CHECKPOINT FILE TYPE *CK*
GTF12 RJM PCF PROCESS CHECKPOINT FILE
NJN GTF15 IF ERROR
GTF13 LJM GTF7 GET NEXT FNT ENTRY
* ENTER FNT/FST IN TABLE AND ADVANCE TABLE POINTER.
GTF14 LDD CN+3
SHN 6
ADD RA
SHN 6
ADD CN+4
CWD FN
ADN FSTL
CWD FS
LDN 2 ADVANCE TABLE POINTER
RAD CN+4
SHN -14
RAD CN+3
SOD CN DECREMENT FILE COUNTER
NJN GTF13 IF TABLE NOT FULL
* TERMINATE SCAN.
GTF15 LDN ZERL CLEAR LAST WORD OF TABLE
CRD CM
LDD CN+3
SHN 6
ADD RA
SHN 6
ADD CN+4
CWD CM
LDD FT+1
ZJN GTF16 IF OLD FORMAT
LDD FT+4 SAVE ZERO OR LAST FNT PROCESSED
STD CM+4
LDM GTFA REWRITE FIRST WORD OF TABLE
SHN 6
ADD RA
SHN 6
ADM GTFA+1
CWD CM
GTF16 RJM CPA RESET FILE NAME
CRD FN
LJM LFMX EXIT
GTFA BSS 2 FWA OF TABLE
TITLE PRIMARY
PRI SPACE 4,10
*** FUNCTION 31.
* MAKE FILE PRIMARY.
* THIS FUNCTION MAKES THE SPECIFIED FILE THE USER S NEW
* PRIMARY FILE. ANY EXISTING PRIMARY, WHICH IS NOT THE
* SPECIFIED FILE, IS CHANGED TO TYPE *LOFT*.
* THE SPECIFIED FILE MUST BE OF TYPE LOCAL AND BE A MASS
* STORAGE FILE TO BE MADE PRIMARY.
* THE FILE S FST ADDRESS IS SET INTO THE CPA.
SPACE 4,10
** PRI - PROCESS PRIMARY FUNCTION.
*
* ENTRY (FN - FN+3) = WORKING FILE NAME TO BE MADE PRIMARY.
* (FF) = INITIAL FNT ADDRESS FOR SEARCH.
*
* EXIT (FN - FN+3) = WORKING FILE NAME TO BE MADE PRIMARY.
* (FA) = FNT ENTRY ADDRESS.
* (FS - FS+4) = FST ENTRY.
ENTRY PRI
LDD FF SET INITIAL FNT ADDRESS
RJM SAF SEARCH FOR ASSIGNED FILE
NJN PRI1 IF FOUND
LDN NEEQ SET NULL EQUIPMENT
STD EQ CREATE NULL PRIMARY FILE
RJM EFN ENTER FILE NAME
UJN PRI3 CHECK IF FILE ALREADY PRIMARY
PRI1 RJM SFB SET FILE BUSY
ZJN PRI3 IF NO REJECT ON FILE INTERLOCK
PRI2 LDN /ERR/IOE * I/O SEQUENCE ERROR.*
UJN PRI6 PROCESS ERROR
PRI3 LDD CP READ CPA WORD
ADN TFSW
CRD CN
LDD CN+1
LMD FA
ZJP LFMX IF SPECIFIED FILE IS ALREADY PRIMARY
NFA FA,R CHECK FILE TYPE
CRD CM
LDD CM+4
SHN -6
LMN LOFT
ZJN PRI7 IF *LOCAL*
LDN /ERR/IFT * INCORRECT FILE TYPE.*
PRI6 LJM ERR PROCESS ERROR
PRI7 LDD FS CHECK FOR MASS STORAGE
ZJN PRI8 IF NO EQUIPMENT ASSIGNED
LMN NEEQ
ZJN PRI8 IF NULL EQUIPMENT
SFA EST,FS
ADK EQDE
CRD T1
LDD T1
SHN 21-13
MJN PRI8 IF MASS STORAGE FILE
LDN /ERR/IEQ * INCORRECT EQUIPMENT.*
UJN PRI6 PROCESS ERROR
PRI8 LDD FS+2
NJP PRI12 IF NOT AN EMPTY FILE
LDD FS+1
NJP PRI11 IF NOT A NULL FILE
LDD CP GET JOB ACCESS LEVEL
ADK JSCW
CRD CM
LDD CM+1
SHN -11
STD AL
LDN ZERL CLEAR *RTCM* PARAMETERS
CRD CM
LDN FSMS+1 SET SECTORS REQUESTED PARAMETER
STD CM+4
LDN PRIS SET *RTCM* PARAMETER FOR PRIMARY FILE
STD CM+2
AOM PRIA
LDD AL SET ACCESS LEVEL SELECTION
ADN 40
SHN 6
STD CM+3
MONITOR RTCM ASSIGN MASS STORAGE SPACE
LDD CM+4 SET FIRST TRACK
NJN PRI10 IF MASS STORAGE SPACE AVAILABLE
LDD CM+3 CHECK *RTCM* REJECT REASON CODE
LMN 2
ZJN PRI9 IF REJECT BECAUSE OF ACCESS LEVEL
LDN /ERR/NMA&/ERR/WEQ * NO MASS STORAGE AVAILABLE.*
PRI9 LMN /ERR/WEQ * EQUIPMENT NOT AVAILABLE.*
LJM ERR ISSUE ERROR
PRI10 STD FS+1
LDD CM+1 SET EST ORDINAL
STD FS
NFA FA,R UPDATE FST FOR *COMPWEI*
ADN FSTL
CWD FS
UJN PRI11.1 WRITE SYSTEM SECTOR AND EOI
PRI11 LPC 3777 ONLY SET SECTOR IN TRACK BYTE
STD CM+2
LDD FS SET EST ORDINAL
STD CM+1
LDN FSMS SET SECTOR
STD CM+3
MONITOR DTKM SET EOI SECTOR IN TRT
PRI11.1 LDD FS+1 UPDATE CURRENT TRACK
STD T6 SET FIRST TRACK PARAMETER
LDD HN UPDATE STATUS BYTE OF FST
STD FS+4
LDD FS
STD T5
SETMS IO
RJM WSS WRITE SYSTEM SECTOR
RJM WEI WRITE EOI
ENDMS
NFA FA,R RE-READ FNT ENTRY
CRD CM
PRIA LDN 0
* LDN 1 (MASS STORAGE SPACE ALLOCATED)
ZJN PRI12 IF NO SECTORS ALLOCATED
LDM SLM
STM DPPB+1
PRI12 LDD FS+1 REWIND FILE
STD FS+2
LDN FSMS
STD FS+3
LDD FS+4 UPDATE STATUS BYTE OF FST
SCN 77
LMN 4
STD FS+4
* CHANGE EXISTING PRIMARY FILE TO TYPE *LOFT*.
LDD CN+1
ZJP PRI17 IF NO PRIMARY FILE CURRENTLY EXISTS
LDD FA SAVE LOCAL FILE FNT ADDRESS
STD CB
NFA FA,R WRITE FST WORD
ADN FSTL
CWD FS
LDD CN+1 SAVE FST ADDRESS OF EXISTING PRIMARY FILE
STD FA
NFA FA,R READ FNT OF EXISTING PRIMARY FILE
CRD FS
LDD FS+4
SHN -6
LMN PTFT
NJN PRI16 IF NOT PRIMARY FILE
RJM SFB SET PRIMARY FILE BUSY
ZJN PRI15 IF NO REJECT ON FILE INTERLOCK
NFA CB,R
ADN FSTL
CRD FS
AOD FS+4
NFA CB,R
ADN FSTL
CWD FS
LJM PRI2 PROCESS AS I/O SEQ. ERROR
PRI15 LDC LOFT*100-PTFT*100 CHANGE FILE TYPE TO LOCAL
RAD CM+4
AOD FS+4 SET FST COMPLETE
NFA FA,R STORE FNT ENTRY
CWD CM
ADN FSTL
CWD FS
PRI16 LDD CB RESTORE LOCAL FILE FNT ADDRESS
STD FA
NFA FA,R RESTORE LOCAL FILE FNT ENTRY
CRD CM
ADN FSTL
CRD FS
* SET NEW FILE AS PRIMARY.
PRI17 LDC PTFT*100-LOFT*100 CHANGE FILE TYPE TO PRIMARY
RAD CM+4
NFA FA,R REWRITE FNT
CWD CM
RJM UPP UPDATE PRIMARY FILE POINTERS
LJM LFMX EXIT
TITLE SUBROUTINES
CCP SPACE 4,20
** CCP - CRACK CALLING PARAMETERS IN FET+CGNT.
* ALSO, A CHECK IS MADE TO SEE IF FET LENGTH IS
* CONSISTENT WITH FET LOCATIONS USED.
*
* ENTRY (CN) = NUMBER OF FILE ENTRIES TO RETURN IN TABLE.
* (CN+1 - CN+2) = SELECTIVITY BITS.
* (CN+3) = 2/,4/CONTROL BITS,6/
* (FE) = FET LENGTH - 1.
*
* EXIT (A) .GE. 0 IMPLIES FET LENGTH OK.
* (A) .LT. 0 IMPLIES FET LENGTH IN ERROR.
* (CN) = NUMBER OF FILE ENTRIES.
* (SB - SB+1) = SELECTIVITY BITS.
* (CB) = CONTROL BITS - RIGHT JUSTIFIED.
* (CN+3) - CONTROL BITS CLEARED.
* (CN+1) - CHECKPOINT FILE COUNTER CLEARED.
* (FT) = NFL/100B.
* (FT+1) = FORMAT FLAG.
*
* USES CB, CN, CN+1, CN+3, SB, SB+1, T1, FT - FT+4.
CCP SUBR ENTRY/EXIT
LDD CN SET NUMBER OF FILE ENTRIES
NJN CCP1 IF NOT DEFAULT
LDC DNFS
STD CN
CCP1 LDD CN+1 SET SELECTIVITY BITS
LPN 77
SHN 14
LMD CN+2
NJN CCP2 IF NOT DEFAULT
LCN 0 ALL BITS SET FOR DEFAULT
CCP2 STD SB+1
SHN -14
STD SB
LDN 0 PRESET CHECKPOINT FILE COUNTER
STD CN+1
LDN 10 PRESET T1 FOR FET LENGTH CHECK
STD T1
LDD CN+3 EXTRACT CONTROL BITS
SHN -6
STD CB
SHN 21-2
MJN CCP3 IF TREAT CHECKPOINT FILES NORMALLY
LDN 4
RAD T1
CCP3 LDD CP GET NEGATIVE FL
ADN FLSW
CRD FT NEGATIVE FL/100B
* LDN 0 PRESET FORMAT FLAG
* STD FT+1
LDD CN+3 CHECK FOR OLD FORMAT
SHN 21-11
PJN CCP4 IF OLD FORMAT
AOD FT+1 SET FLAG FOR NEW FORMAT
LCN 2 RETURN FILE LENGTH TO BYTES 0 AND 1 OF FST
RAM MFFA
SBN 1
STM MFFB
CCP4 LDD CN+3 CLEAR CONTROL BITS
LPN 77
STD CN+3
LDD FE
SBD T1
LJM CCPX EXIT
CFS SPACE 4,15
** CFS - CHECK FILE SELECTIVITY.
*
* ENTRY (SB) AND (SB+1) = SELECTIVITY BITS.
* (FN - FN+4) = FNT ENTRY.
* (FS - FS+4) = FST ENTRY.
*
* EXIT (A) .LT. 0 IMPLIES SELECTED.
* (A) .GE. 0 IMPLIES NOT SELECTED.
*
* USES T1.
*
* CALLS SDQ.
CFS SUBR ENTRY/EXIT
LDD FN+4 SET FILE TYPE
SHN -6
STD T1
SBN MXFT
MJN CFS2 IF TYPE DOES NOT EXCEED MAXIMUM
CFS1 LDN /ERR/IFT * INCORRECT FILE TYPE.*
LJM ERR PROCESS ERROR
CFS2 LDM TFTS,T1 SET SHIFT INSTRUCTION
ZJN CFS1 IF INCORRECT FILE TYPE
STM CFSA
LDD SB LOAD SELECTIVITY MASK
SHN 14
LMD SB+1
CFSA SHN **
MJN CFSX IF FILE SELECTED
* FOR COMPATIBILITY, CHECK FOR *PRQT* OR *PHQT*.
LDD T1
LMN QFFT
NJN CFSX IF FILE MAPPING NOT REQUIRED
LDD SB+1
LPN 14
ZJN CFSX IF *PRQT* AND *PHQT* NOT SELECTED
RJM SDQ SET DISPOSITION CODE
ZJN CFSX IF NOT *PRQT* OR *PHQT*
* LDD SB
* SHN 14
* LMD SB+1
LDD SB+1
CFSB SHN ** (SET BY *SDQ*)
UJN CFSX RETURN
CMS SPACE 4,10
** CMS - CHECK FOR MASS STORAGE RESIDENT FILE.
*
* ENTRY (FS - FS+4) = FILE FST ENTRY.
*
* EXIT (A) .LT. 0, IF FILE IS ON MASS STORAGE.
* (CM - CM+4) = EST ENTRY FOR FILE.
* (T5) = EST ORDINAL.
*
* USES T5, CM - CM+4.
*
* MACROS SFA.
CMS SUBR ENTRY/EXIT
LDD FS SET EST ORDINAL
STD T5
SFA EST READ EST ENTRY
ADK EQDE
CRD CM
LDD CM
SHN 21-13 POSITION MASS STORAGE BIT
UJN CMSX RETURN
MFF SPACE 4,20
** MFF - MODIFY FILE S FST.
*
* ENTRY (FS - FS+4) = FST ENTRY.
* (FN - FN+4) = FNT WORD, IF NEW FORMAT REQUESTED.
* (CB) = CONTROL BITS.
* (FT+1) = FORMAT FLAG.
* (FT+4) = FNT ADDRESS.
*
* EXIT (A) = 0 IMPLIES NORMAL RETURN.
* (A) .NE. 0 IMPLIES ERROR EXIT.
* (FS - FS+4) = MODIFIED FST.
* (FN+3) UPDATED, IF TAPE FILE AND NEW FORMAT REQUESTED.
*
* USES T2, T3, T5, T6, T7, CM - CM+4, FN - FN+4 (ONLY IF
* NEW FORMAT REQUESTED OR IF ERROR RETURN).
*
* CALLS CMS, CPA, SEI, SPA.
*
* MACROS DELAY, MONITOR, PAUSE.
*
* ERROR FET+CGNT IS SET NEGATIVE.
MFF SUBR ENTRY/EXIT
RJM CMS CHECK FOR MASS STORAGE RESIDENT FILE
PJN MFF1 IF NOT MASS STORAGE FILE
LJM MFF12 PROCESS MASS STORAGE FILE
MFF1 LDD CM+3
LMN 1RT
SHN 14
LMN 1RM
ZJN MFF1.1 IF *MT*
LMN 1RN&1RM
ZJN MFF1.1 IF *NT*
LMN 1RC&1RN
ZJN MFF1.1 IF *CT*
LMN 1RA&1RC
MFF1.1 ZJN MFF6 IF *AT*
LMN 1RT&1RA
ZJN MFF2 IF *TT*
LDD CM+3
LMC 2ROD
ZJP MFF21 IF *OD*
* FILE IS NOT MASS STORAGE, TAPE, OPTICAL DISK OR TTY.
LDD FT+1
ZJN MFF4 IF OLD FORMAT
LDN 3S1 SET NON-MS, TAPE, TTY FILE
UJN MFF3 CLEAR FST INFORMATION
* TTY FILE.
MFF2 LDC 2RTT SHOW TTY FILE
STD FS+1
LDD FT+1
ZJN MFF5 IF OLD FORMAT
LDN 1S2 SET TTY FILE
MFF3 RAD FN+3
LDN 0 CLEAR FILE LENGTH
STD FS
STD FS+1
MFF4 STD FS+2 CLEAR RANDOM INDEX/BLOCK COUNT
STD FS+3
MFF5 LJM MFFX RETURN
* TAPE FILE.
MFF6 LDD FS+1 GET USER DESCRIPTOR TABLE ADDRESS
ADN /MTX/UST2
STD CM+4
LDN 0 SET READ
STD CM+1
LDD HN SET WORD COUNT
STD CM+3
LCN 7777-MTSI SET *MAGNET* SUBSYSTEM ID
STD CM+2
MONITOR TDAM
LDD CM+1
ZJN MFF8 IF COMPLETE
SBN 2
PJN MFF7 IF *MAGNET* NOT PRESENT
PAUSE
DELAY
LDD CM+1
NJN MFF11 IF ERROR
UJN MFF6 TRY AGAIN
MFF7 LDD FT+1
ZJN MFF11 IF OLD FORMAT
LCN 0
STD FS+2
STD FS+3
UJN MFF9 SET TAPE FILE
* SET CURRENT BLOCK COUNT.
MFF8 LDD MA SAVE BLOCK COUNT
CRD CM
LDD CM+2
STD FS+2
LDD CM+3
STD FS+3
LDD FT+1
ZJN MFF10 IF OLD FORMAT
MFF9 LDN 1S1 SET TAPE FILE
RAD FN+3
LJM MFF17 CLEAR FILE LENGTH
MFF10 LDC 2RMT SET TAPE FILE
STD FS+1
UJN MFF15 RETURN
* SET ERROR PARAMETER IN FET.
MFF11 LCN 0 SET ERROR EXIT
STD FN
RJM CPA
ADN CGNT
CWD FN
LJM MFFX RETURN
* MASS STORAGE FILE.
MFF12 LDD FT+1
NJN MFF13 IF NEW FORMAT
LDD CB CHECK TYPE OF MODIFICATION DESIRED
SHN 21-1
MJN MFF16 IF FILE LENGTH REQUESTED
* RETURN RANDOM INDEX.
MFF13 LDD FS+2 SET TRACK
STD RI+1
ZJN MFF14 IF FILE NOT USED
STD T6
LDD FS+3 SET SECTOR
STD T7
LDD FS+1 SET FIRST TRACK
RJM SRA SET RANDOM ADDRESS
NJN MFF11 IF ERROR
LDD RI SET ADDRESS IN FST
MFF14 STD FS+2
LDD RI+1
STD FS+3
LDD FT+1
NJN MFF16 IF NEW FORMAT
MFF15 LDN 0
LJM MFFX RETURN
* RETURN FILE LENGTH.
MFF16 LDD FS+1 SET FIRST TRACK
ZJN MFF18 IF FILE NOT USED
STD T6
RJM SEI DETERMINE FILE LENGTH
LCN FSMS DO NOT COUNT SYSTEM SECTOR
RAD T3
PJN MFF20 IF NO UNDERFLOW
SOD T2 COMPENSATE FOR UNDERFLOW
PJN MFF19 IF SECTORS ASSIGNED TO FILE
MFF17 LDN 0
MFF18 STD T2
UJN MFF20 CLEAR FILE LENGTH
MFF19 AOD T3 COMPENSATE FOR ONES COMPLEMENT SUBTRACTION
MFF20 STD FS+3
MFFA EQU *-1
* STD FS+1 (NEW FORMAT)
LDD T2
MFFB STD FS+2
* STD FS (NEW FORMAT)
UJN MFF15 RETURN
* OPTICAL DISK FILE.
MFF21 LDD FT+1
NJN MFF22 IF NEW FORMAT
LDD CB CHECK TYPE OF MODIFICATION DESIRED
SHN 21-1
MJN MFF23 IF FILE LENGTH REQUESTED
* RETURN RANDOM ADDRESS.
MFF22 LDD FS+2 SET RANDOM ADDRESS
STD FS+3
LDD FS+1
STD FS+2
MFF23 LDC 2ROD SET OPTICAL DISK FILE
STD FS+1
LDD FT+1
NJN MFF24 IF NEW FORMAT
LDD CB CHECK MODIFICATION TYPE
SHN 21-1
PJP MFF15 IF FILE LENGTH NOT REQUESTED
* RETURN FILE LENGTH.
MFF24 LDD FT+4 GET FNT ORDINAL
NFA FT+4,R
ADN FUTL
CRD CM
LDD CM+3 SET FILE LENGTH IN FST
STD T2
LDD CM+4
LJM MFF20 RETURN FILE LENGTH
PCF SPACE 4,20
** PCF - PROCESS CHECKPOINT FILE.
*
* ENTRY (FN - FN+4) = FNT ENTRY.
* (FS - FS+4) = FST ENTRY.
* (CN+1) = CHECKPOINT FILE COUNTER.
* (IR+3 - IR+4) = FET+0 ADDRESS.
*
* EXIT (A) = 0 IMPLIES NORMAL RETURN.
* (A) .NE. 0 IMPLIES ERROR EXIT - MORE THAN TWO
* CHECKPOINT FILES EXIST.
* FN - FN+4 RESET (ON ERROR RETURN ONLY).
*
* USES CM (ON ERROR RETURN ONLY), CN+1.
*
* CALLS CPA.
*
* ON ERROR RETURN, FET+CGNT+1 IS MADE NEGATIVE.
PCF SUBR ENTRY/EXIT
LDN 2 INCREMENT CHECKPOINT FILE COUNTER
RAD CN+1
LMN 6
NJN PCF1 IF NOT TOO MANY CHECKPOINT FILES
LCN 0 SET ERROR
STD CM
RJM CPA READ FET FILE NAME
CRD FN
ADN CGNT+1 SET ERROR RETURN
CWD CM
UJN PCFX ERROR EXIT
* ENTER CHECKPOINT FILE FNT/FST INTO FET.
PCF1 RJM CPA
ADN CGNT-1
ADD CN+1
CWD FN
ADN 1
CWD FS
LDN 0
UJN PCFX EXIT
RFE SPACE 4,15
** RFE - REFORMAT FNT ENTRY.
*
* ENTRY (CM+3) = EQUIPMENT MNEMONIC.
* (FN - FN+4) = FNT.
*
* ENTRY (FN - FN+4) = FNT.
* (FS - FS+4) = FST.
*
* EXIT (FN - FN+4) = NEW FORMAT FNT.
* (FS - FS+4) = NEW FORMAT FST.
*
* USES FN+3, FS+4, T4, CM+1 - CM+3.
*
* CALLS CMS.
*
* MACROS MONITOR, SETMS.
RFE SUBR ENTRY/EXIT
RJM CMS CHECK FOR MASS STORAGE RESIDENT FILE
MJN RFE1 IF MS RESIDENT
LDD CM+3
LMC 2ROD
STD CM+3
ZJN RFE1 IF OPTICAL DISK
LDD FS+4 CLEAR READ STATUS AND REFORMAT
SHN -1
LPN 1
STD FS+4
UJN RFE1.0 REFORMAT ACCESS MODE
RFE1 LDD FS+4
SHN -1
LPN 7
STD FS+4
LDD CM+3
NJN RFE1.1 IF MASS STORAGE
LDD FS+1
ADD FS+2
ZJN RFE1.2 IF AT BOI
RFE1.0 UJN RFE2 REFORMAT ACCESS MODE
RFE1.1 BSS 0
* LDD FS (SET UP BY *CMS*)
* STD T5
SETMS STATUS DETERMINE DEVICE ACCESSIBILITY
LDM MSD RETURN STATUS TO CALLER
SHN 10-6
LPC 400 SET FILE ACCESSIBILITY FLAG
RAD FS+4
LDD FS+1
ZJN RFE2 IF EMPTY FILE
LMD FS+2
NJN RFE2 IF FIRST TRACK .NE. CURRENT TRACK
LDD FS+3
LMN FSMS
NJN RFE2 IF CURRENT SECTOR .NE. *FSMS*
RFE1.2 LDD FS+4 SET BOI STATUS
LPC 401
ADN 10
STD FS+4
RFE2 LDN 0 REFORMAT FILE ACCESS MODE
STD T4
RFE3 LDM TAFM,T4 CHECK TABLE
LMD FN+3
LPN 35 IGNORE *DIAGNOSTIC*, *UATTACH* STATUS
ZJN RFE4 IF MATCH
AOD T4
LMN TAFML
NJN RFE3 IF NOT END OF TABLE
LDN SWET SET SYSTEM SOFTWARE ERROR FLAG
STD CM+2
LDC * SET ADDRESS WHERE ERROR DETECTED
STD CM+1
MONITOR CHGM CONDITIONALLY HANG PP
* LDN 0
UJN RFE5 RETURN ZERO FOR FILE PERMISSION
RFE4 LDM TAFM,T4 GET EQUIVALENT MODE VALUE FROM TABLE
SHN -6
SHN 4
RFE5 RAD FS+4
LDD FN+3 CLEAR FILE ACCESS MODE FROM FNT
SCN 76
STD FN+3
LJM RFEX RETURN
SDQ SPACE 4,15
** SQD - SEARCH QFT FOR DISPOSITION CODE.
*
* ENTRY (FS - FS+4) = FST ENTRY.
*
* EXIT (CFSA) = SHIFT COUNT FOR GETFNT SELECTIVITY BITS
* IF TYPE PHQT OR PRQT.
* (A) = 0 IF DISPOSITION CODE NOT PHQT OR PRQT.
*
* USES T1 - T6, CM - CM+4.
*
* MACROS SFA.
SDQ5 LDN 0 SET FLAG
SDQ SUBR ENTRY/EXIT
LDN QFTP GET NUMBER OF QFT ENTRIES
CRD CM
LDN 0 SET COUNTER
STD CM
* SEARCH QFT TO DETERMINE DISPOSITION CODE.
SDQ1 AOD CM INCREMENT QFT ORDINAL
LMD CM+2
ZJN SDQX IF NO MORE ENTRIES
SDQ2 SFA QFT,CM ACCESS QFT ENTRIES
CRD T2
ADN ENTQ-JSNQ GET EQUIPMENT AND FIRST TRACK
CRD T1 COMPARE EQUIPMENT
LDD FS
SBD T1
NJN SDQ1 IF NOT SAME EQUIPMENT
LDD FS+1 COMPARE FIRST TRACK
SBD T2
NJN SDQ1 IF NOT SAME FIRST TRACK
LDD T2+4 DETERMINE DISPOSITION CODE
SHN -11
LMN PHQT
NJN SDQ3 IF NOT PUNCH QUEUE TYPE
LDC SHNI+16
UJN SDQ4 STORE COUNT
SDQ3 LMN PRQT&PHQT
NJN SDQ5 IF NOT PRINT OR PUNCH QUEUE TYPE
LDC SHNI+17
SDQ4 STM CFSB SET SHIFT INSTRUCTION
LJM SDQX RETURN
WDS SPACE 4,10
** WDS - WRITE MASS STORAGE.
*
* ENTRY (A) = BUFFER ADDRESS.
* (T5 - T7) = MASS STORAGE PARAMETERS.
*
* EXIT (A) .GE. 0.
*
* ERROR TO *EER*.
*
* CALLS WDS.
WDS SUBR ENTRY/EXIT
RJM //WDS
PJN WDSX IF SUCCESSFUL WRITE
LJM EER EVALUATE ERROR RETURN
TAFM SPACE 4,10
** TAFM - TABLE OF FILE MODES.
*
* TABLE IS IN THE FOLLOWING FORMAT.
*
* 6/EV,6/FM
*
* WHERE FM = FILE ACCESS MODE OBTAINED FROM THE FNT.
* EV = EQUIVALENT MODE VALUE TO BE RETURNED TO CALLER.
TAFM BSS 0
LOC 0
VFD 6/0,6/1 READ
VFD 6/1,6/0 WRITE
VFD 6/2,6/30 MODIFY
VFD 6/3,6/20 APPEND
VFD 6/4,6/4 EXECUTE (INDIRECT ACCESS PERMANENT FILE)
VFD 6/4,6/5 EXECUTE (DIRECT ACCESS PERMANENT FILE)
VFD 6/5,6/31 READ/ALLOW MODIFY
VFD 6/6,6/21 READ/ALLOW APPEND
VFD 6/7,6/10 UPDATE
VFD 6/10,6/11 READ/ALLOW UPDATE
LOC *O
TAFML EQU *-TAFM
TFTS SPACE 4,10
** TFTS - TABLE OF FILE TYPE SHIFTS.
TFTS INDEX
INDEX ROFT,SHNI+20
INDEX LIFT,SHNI+11
INDEX PTFT,SHNI+10
INDEX PMFT,SHNI+7
INDEX FAFT,SHNI+6
INDEX SYFT,SHNI+5
INDEX LOFT,SHNI+4
INDEX INFT,SHNI+21
INDEX QFFT,SHNI+14
INDEX MXFT END OF TABLE
SPACE 4,10
** COMMON DECKS.
*CALL COMPWEI
*CALL COMPWSS
SPACE 4,10
ERRNG OVL0-* CODE OVERFLOWS INTO ZERO LEVEL OVERLAYS
OVERFLOW OVL
SPACE 4,10
TTL LFM - LOCAL FILE MANAGER.
END