IDENT LDD,/LDD/LDD
PERIPH
BASE MIXED
SST
IRA$ EQU 1 SET USER RANDOM ADDRESS INITIALIZATION
MSR$ EQU 1 SET USER MASS STORAGE ERROR PROCESSING
QUAL$ EQU 1 SET UNQUALIFIED COMMON DECKS
*COMMENT FDL - LOAD FAST DYNAMIC LOAD DIRECTORIES.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
TITLE LDD - LOAD FAST DYNAMIC LOAD DIRECTORIES.
SPACE 4,10
*** LDD - LOAD FAST DYNAMIC LOAD DIRECTORIES.
* S. L. KSANDER. 76/04/01.
SPACE 4,10
*** LDD PROCESSES THE PHYSICAL LOADING OF FAST DYNAMIC
* LOAD CAPSULE DIRECTORY INFORMATION INTO THE USER SPECIFIED
* AREA. IF A FUNCTION CODE OF 404 IS PRESENT THEN
* CCL PROCEDURE RECORDS ARE LOCATED RATHER THAN CAPSULES.
SPACE 4,10
*** CALL FORMAT.
*
*
*T 18/ *LDD* ,1/,1/A,4/,12/ DI,6/ RSTAT,1/B,17/ FET
*
* A AUTO RECALL.
* DI DIRECTORY INDEX. (*LDD* RECALL ONLY)
* RSTAT RECALL STATUS BITS. (*LDD* RECALL ONLY)
* 2/LOCAL USER LIBRARY OFFSET.
* 4/GLOBAL LIBRARY SET INDEX.
* B *LDD* RECALL STATUS.
*
*
* FET.
*
*T FET 42/ *GROUP*,9/ STATUS,9/ CODE
*T, 12/,18/ LIST,12/ DIRL,18/ DIRA
*
* INITIAL CALL.
*
* GROUP NAME OF GROUP FOR WHICH DIRECTORY INFORMATION IS
* REQUESTED
* STATUS IGNORED
* CODE FUNCTION CODE.
* 0 = LOCATE CAPSULES.
* 402 = LOCATE TEXT RECORD IN *CLD*.
* 404 = LOCATE TEXT RECORDS.
* LIST ADDRESS OF LIBRARY NAME LIST THAT IS TO BE SEARCHED
* AFTER THE GLOBAL LIBRARY SET, TERMINATED BY ZERO WORD
* DIRL LENGTH OF DIRECTORY STORAGE AREA
* DIRA BASE ADDRESS OF DIRECTORY AREA
*
*
* CALL COMPLETION.
*
* GROUP NOT CHANGED
* STATUS 000 = NO ERRORS
* 001 = ILLEGAL FUNCTION CODE
* 002 = BAD DIRECTORY ADDRESS AND/OR LENGTH (OUTSIDE OF
* JOB FL)
* 003 = BAD LIBLIST ADDRESS AND/OR LENGTH (OUTSIDE OF
* JOB FL)
* 010 = LIBRARY NOT FOUND OR LIBRARY NOT MASS STORAGE
* RESIDENT
* 020 = INSUFFICIENT DIRECTORY SPACE GIVEN
* CODE SET TO 001
* LIST NOT CHANGED
* DIRL SET TO ACTUAL LENGTH REQUIRED
* DIRA NOT CHANGED
*
* *LDD* RECALL.
*
* AFTER EACH LIBRARY HAS BEEN PROCESSED, *LDD* WILL CHECK
* THE TOTAL NUMBER OF SECTORS READ AGAINST THE ASSEMBLY
* CONSTANT *RSLM*. IF THIS LIMIT IS EXCEEDED, *LDD* WILL
* PLACE ITSELF IN RECALL AND RESTART AGAIN WHEN IT IS
* RECALLED.
*
*
* DIRECTORY ENTRY FORMAT.
*
*
* SYSTEM FILE DIRECTORY ENTRY.
*
*T DIRA 12/7777,12/ 0,12/ FNT,6/ ORD,18/ 0
*T,DIRA+1 42/ NAME, 18/ INDEX
*T,DIRA+2 1/1,23/ 0,18/ PRU,18/ LENGTH
*
*
* LOCAL FILE DIRECTORY ENTRY.
*
*T DIRA 1/1,41/ *LFN*,18/ 0
*T,DIRA+1 42/ NAME, 18/ INDEX
*T,DIRA+2 1/1,23/ 0,18/ PRU,18/ LENGTH
*
*
* FNT ADDRESS OF SYSTEM FILE FNT ENTRY
* ORD ORDINAL OF SYSTEM LIBRARY IN LIBRARY NAME TABLE
* LFN LOCAL FILE NAME
* NAME NAME OF CAPSULE OR TEXT RECORD.
* INDEX INDEX RELATIVE TO START OF DIRECTORY OF THE FILE
* ENTRY ASSOCIATED WITH THIS NAME.
* PRU DISK ADDRESS OF FIRST SECTOR OF CAPSULE OR TEXT
* RECORD.
* LENGTH LENGTH OF CAPSULE OR TEXT RECORD.
SPACE 4,15
*** DAYFILE MESSAGES.
*
* * LDD - ARGUMENT ERROR - XXXXXX.* = FET ADDRESS .LT. 2 OR
* .GT. FL-2.
*
* * LDD - I/O SEQUENCE ERROR - FILENAM AT XXXXXX.* = MULTIPLE
* CONCURRENT FUNCTIONS WERE ATTEMPTED ON FILE *FILENAM*.
*
* * LDD - DEVICE ERROR - FILENAM AT XXXXXX.* = AN UNRECOVERED
* DEVICE ERROR WAS ENCOUNTERED ON FILE *FILENAM*.
*
* FOR ALL MESSAGES, XXXXXX IS THE ADDRESS OF THE *LDD*
* PARAMETER BLOCK.
SPACE 4,10
*** OPERATOR MESSAGES.
*
*
* NONE.
SPACE 4,25
**** ASSEMBLY CONSTANTS.
QUAL ERR ERROR CODES.
ILF EQU 1 ILLEGAL FUNCTION
IAD EQU 2 ILLEGAL ADDRESS
FNF EQU 3 FILE NOT FOUND (LDQ)
ILA EQU 3 ILLEGAL LIBLIST ADDRESS (LDD)
IRA EQU 4 ILLEGAL RANDOM ADDRESS
WPR EQU 5 WRONG PROGRAM
IBF EQU 6 INSUFFICIENT BUFFER
ILE EQU 10 ILLEGAL LIBRARY ENTRY
IDS EQU 20 INSUFFICIENT DIRECTORY SPACE
FERT EQU 40 FATAL ERROR TYPES.
ARG EQU 40 ARGUMENT ERROR (MUST ALWAYS BE FATAL)
IOS EQU 41 I/O SEQUENCE ERROR (MUST ALWAYS BE FATAL)
MSR EQU 42 MASS STORAGE ERROR (MUST ALWAYS BE FATAL)
QUAL *
MEPO EQU 1 MASS STORAGE ERROR PROCESSING OPTION
RSLM EQU 1000 RECALL SECTOR LIMIT
****
SPACE 4,10
*** COMMON DECKS.
*CALL COMPMAC
*CALL COMSCPS
*CALL COMSMSP
*CALL COMSPIM
*CALL COMSSRU
SPACE 4,25
**** DIRECT LOCATION ASSIGNMENTS.
ER EQU 17 EOR FLAG
FS EQU 20 - 24 FST ENTRY
CC EQU 25 CAPSULE COUNT
GO EQU 26 GROUP ORDINAL
CL EQU 27 LENGTH OF CENTRAL MEMORY DIRECTORY
GN EQU 30 - 34 GROUP NAME
AB EQU 30 - 34 NAME TO SEARCH FOR IN *CLD*
UL EQU 35 - 36 USER SPECIFIED FILE LIST ADDRESS
DI EQU 37 ACTUAL DIRECTORY LENGTH
FN EQU 40 - 44 FNT ENTRY
FW EQU 45 - 46 FWA OF CM BUFFER
TI EQU 45 - 46 LIBRARY BASE RANDOM INDEX
EC EQU 47 ERROR CODE
FA EQU 57 RELATIVE FNT ADDRESS IN NFL
BL EQU 60 BUFFER LIMIT ADDRESS
SI EQU 61 - 62 SRU INCREMENT TO ERROR PROCESSOR
RI EQU 63 - 64 RANDOM INDEX
BS EQU 65 - 66 BUFFER SIZE (CM BUFFER)
DA EQU 65 - 66 DIRECTORY BASE ADDRESS
DL EQU 67 USER SPECIFIED DIRECTORY LENGTH
****
TITLE MACRO DEFINITIONS.
SPACE 4,10
** MACRO DEFINITIONS.
COMMON SPACE 4,10
** COMMON - COMMON CODE FOR *LDD* AND *LDQ*.
*
* THIS MACRO PROVIDES IDENTICAL CODE FOR *LDD* AND *LDQ*.
COMMON MACRO
CIS SPACE 4,10
** CIS - CLEAR INTERLOCKS.
*
* ENTRY (CISA) = TRACK NUMBER IF INTERLOCK SET.
*
* EXIT (CISA) = 0.
*
* CALLS CTI.
CIS SUBR ENTRY/EXIT
LDC 0
CISA EQU *-1
ZJN CISX IF NO INTERLOCK SET
RJM CTI
* LDN 0 CLEAR INTERLOCK SET STATUS
STM CISA
UJN CISX RETURN
MSR SPACE 4,15
** MSR - MASS STORAGE ERROR PROCESSING.
*
* ENTRY (A) = STATUS RETURNED FROM AN I/O ERROR.
* (T5) = EST ORDINAL.
* (FA) = FNT ADDRESS IF LOCAL FILE PRESENT.
* = 0, OTHERWISE.
*
* USES FS+4, IR+4.
*
* CALLS CIS.
*
* MACROS ERROR, EXECUTE.
MSR CON 0 ENTRY
SHN 21-12
MJN MSR2 IF UNRECOVERABLE ERROR
LDM MSD
SHN 21-13
MJN MSR3 IF NOT SUBSYSTEM
MSR2 RJM CIS
ERROR MSR * DEVICE ERROR.*
* CALL *1RJ* TO RECALL THE PP AND ROLL THE JOB.
MSR3 LDD T5 EST ORDINAL
STD IR+4
RJM CIS CLEAR INTERLOCKS
AOD FS+4 SET FET NOT BUSY
LDD FA
ZJN MSR4 IF NO LOCAL FNT
NFA FA,R
ADN FSTL
CWD FS
MSR4 EXECUTE 1RJ
SPACE 4,10
** COMMON DECKS.
*CALL COMPCTI
*CALL COMPRNS
ENDM
ERROR SPACE 4,15
** ERROR - SET ERROR STATUS.
*
*
*NAME ERROR CODE
*
* ENTRY *NAME* = OPTIONAL LOCATION TAG.
* *CODE* = ERROR CODE.
PURGMAC ERROR
ERROR MACRO A
MACREF ERROR
LDN /ERR/A
RJM ERR
ENDM
LDCA SPACE 4,20
** LDCA - LOAD ABSOLUTE CM ADDRESS.
*
*
*NAME LDCA DC
*
* ENTRY *NAME* = OPTIONAL LOCATION TAG.
* *DC* = FIRST OF TWO DIRECT LOCATIONS TO BE USED.
PURGMAC LDCA
LDCA MACRO X
MACREF LDCA
LDD X
LPN 37
SHN 6
ADD RA
SHN 6
ADD X+1
ENDM
MSG SPACE 4,15
** MSG - DEFINE MESSAGE.
*
*ERR MSG (TEXT)
*
* ENTRY *ERR* = ERROR CODE.
* *TEXT* = ERROR MESSAGE.
PURGMAC MSG
MACRO MSG,ERR,TEXT
LOCAL A
MACREF MSG
A MICRO 1,,$TEXT$
A MICCNT A
ERRNG 20D-A MESSAGE TOO LONG
ERR CON =Z$TEXT$
ENDM
LDD TITLE MAIN PROGRAM.
QUAL LDD
*** LDD - MAIN PROGRAM.
ORG PPFW
LDD RJM PRS PRESET
LDDB LDN 0
* LDN 1 (FUNCTION CODE 402)
NJN LDD3.4 IF FUNCTION CODE IS 402
LDD CP READ GLOBAL LIBRARY SET
ADC LB1W
CRM TLBD,TR
LDD1 LDN 0 CLEAR FNT ADDRESS
STD FA
STD FN CLEAR FILE NAME
STM SISA
PAUSE
LDD CM+1 CHECK ERROR FLAGS
ZJN LDD3 IF NO ERROR FLAGS
LDD2 LJM SCS SET COMPLETE STATUS
LDD3 RJM CRP CHECK RECALL PARAMETERS
RJM GNL GET NEXT LIBRARY
LDD FN CHECK LIBRARY FOUND
NJN LDD5 IF NOT END OF LIBRARIES
LDDA LDN 0
* LDN 1 (FUNCTION CODE 404)
ZJN LDD2 IF NOT FUNCTION CODE 404
LDD3.4 RJM SCP SEARCH *CLD* FOR PROCEDURE RECORD
NJN LDD4 IF ENTRY FOUND
ERROR ILE ILLEGAL LIBRARY ENTRY
UJN LDD2 EXIT
LDD4 RJM PDE PROCESS DIRECTORY ENTRY
UJN LDD2 SET COMPLETE STATUS
LDD5 RJM LNL LOCATE NEXT LIBRARY
LDD FN CHECK LIBRARY FOUND
ZJN LDD6 IF LIBRARY NOT FOUND
* PROCESS *ULIB* RECORD.
LDC BUF LOAD BUFFER MEMORY
RJM LBM
LDC BUF RESET BUFFER ADDRESS
STD T3
RJM VUT VALIDATE *ULIB* TABLES
NJN LDD7 IF NO ERROR IN *ULIB* TABLES
LDD6 ERROR ILE ILLEGAL LIBRARY ENTRY
RJM CIS CLEAR INTERLOCK STATUS
UJN LDD8
LDD7 RJM SFG SEARCH FOR GROUP NAME
ZJN LDD6 IF NO MATCH ON GROUP NAME
* PROCESS *OPLD* RECORD.
RJM SIS SET INTERLOCK STATUS
LDD FS+1 SET FIRST TRACK
STD T6
RJM CRA CONVERT RANDOM ADDRESS
MJN LDD6 IF RANDOM INDEX ERROR
LDC BUF LOAD BUFFER MEMORY
RJM LBM
LDC BUF RESET BUFFER ADDRESS
STD T3
RJM VOT VALIDATE *OPLD* TABLE
MJN LDD6 IF ERROR IN *OPLD* TABLE
RJM PGM PROCESS GROUP MEMBERS
ZJN LDD8 IF NO FIND OR CAPSULE PROCESSING
LJM LDD2 IF FIND ON FUNCTION CODE 404
LDD8 AOD FS+4 SET FILE NOT BUSY
LDD FA
ZJN LDD9 IF NOT LOCAL LIBRARY
NFA FA,R
ADN FSTL
CWD FS
LDD9 LJM LDD1 LOOP
TITLE LIBRARY MANIPULATION ROUTINES.
GNL SPACE 4,15
*** GNL - GET NEXT LIBRARY NAME.
*
* ENTRY (UL - UL+1) = ADDRESS OF NEXT USER LIBLIST ENTRY.
* (TLBD) = GLOBAL LIBRARY SET.
* (FN) = 0.
*
* EXIT (FN) = 0 IF NO LIBRARY FOUND.
* (FN - FN+4) = NAME OF NEXT USER LIBRARY.
* (UL - UL+1) = UPDATED TO NEXT USER LIBLIST ENTRY.
* TO *ERR* IF ILLEGAL LIBLIST ADDRESS.
*
* USES T7, CM - CM+4, FN - FN+4, UL - UL+1.
* PROCESS USER LIBLIST ENTRY.
GNL4 LDD UL CHECK USER SPECIFIED LIBLIST
SHN 14
ADD UL+1
ZJN GNLX IF NO USER SPECIFIED LIBLIST
SHN -6 CHECK USER LIBLIST ADDRESS
SBD FL
MJN GNL6 IF LIBLIST ADDRESS WITHIN FL
GNL5 ERROR ILA ILLEGAL LIBLIST ADDRESS
GNL6 LDCA UL READ LIBRARY NAME
CRD FN
AOD UL+1 ADVANCE LIBLIST ADDRESS
SHN -14
RAD UL
GNL7 LDD FN+3 SET LIBRARY NAME
SCN 77
STD FN+3
LDN 0
STD FN+4
GNL SUBR ENTRY/EXIT
LDC TLBD+3 CHECK END OF GLOBAL LIBRARY SET TABLE
GNLA EQU *-1
STD T7
LMC TLBDL
GNLB EQU *-1
* LMC TLBDL-5 (ONE LOCAL USER LIBRARY)
* LMC TLBDL-12 (TWO LOCAL USER LIBRARIES)
ZJN GNL1 IF END OF GLOBAL LIBRARY SET
LDI T7 GET NEXT LIBRARY ORDINAL
GNLC SHN -6 POSITION ORDINAL
* SHN 0 (LIBRARY ORDINAL IN LOWER SIX BITS)
LPN 77
NJN GNL2 IF NOT END OF GLOBAL LIBRARY SET
GNL1 LJM GNL4
GNL2 STD T7
AOM GNLE ADVANCE GLOBAL LIBRARY INDEX
SHN -1
ADC TLBD+3
STM GNLA
LDM GNLC ADVANCE SHIFT INSTRUCTION
LMN -6+77
STM GNLC
LDD T7
SBN 77
ZJN GNL3 IF LOCAL USER LIBRARY
ADN 76 SET OFFSET = (ORDINAL-1) * 2
SHN 1
STD T7
LDC LBDP READ LIBRARY DIRECTORY
CRD CM
LDD CM+2 FORM ADDRESS OF LIBRARY NAME
SHN 14
ADD CM+3
ADD T7 ADD OFFSET
CRD FN READ LIBRARY NAME
LJM GNL7
* READ LOCAL FILE LIBRARY NAME.
GNL3 LDD CP READ LOCAL USER LIBRARY NAME
ADC LB3W
GNLD EQU *-1
* ADC LB2W (SECOND LOCAL USER LIBRARY)
CRD FN READ LIBRARY NAME
SOM GNLD ADVANCE LOCAL USER LIBRARY POINTER
LCN 5 ADVANCE END OF GLOBAL LIBRARY SET TABLE
RAM GNLB
AOM CRPA ADVANCE RECALL VALUE
LJM GNL7
GNLE CON 0 GLOBAL LIBRARY SET BYTE INDEX
LNL SPACE 4,25
*** LNL - LOCATE NEXT LIBRARY.
*
* ENTRY (FN - FN+3) = LIBRARY NAME.
* (LNLA) = FNT ADDRESS SYSTEM FILE.
*
* EXIT (FN) = 0 IF LIBRARY NOT FOUND.
* (T5) = EQUIPMENT.
* (T6) = FIRST TRACK OF LIBRARY FILE.
* (FA) = FNT ADDRESS IF LOCAL FILE LIBRARY FOUND.
* (PDEB) = INDEX OF LIBRARY FILE HEADER IN DIRECTORY.
* (RI - RI+1) = RANDOM INDEX OF LIBRARY *ULIB* RECORD.
* (FS - FS+4) = FST OF LOCAL FILE USER LIBRARY.
* (DIRA - DIRA+4) = FIRST WORD OF DIRECTORY ENTRY FOR
* LIBRARY.
* (CISA) = SET TO INDICATE INTERLOCK CLEARED.
* (SISA) = SET TO INDICATE IF INTERLOCK REQUIRED.
* RANDOM ACCESS PROCESSORS PRESET.
* DRIVER LOADED AND ERROR PROCESSING SET.
*
* USES FA, CM - CM+4, FN - FN+4, FS - FS+4, RI - RI+4,
* T1 - T7.
*
* CALLS CRA, IRA, SAF, SFB, SIS.
*
* MACROS ERROR, SETMS, SFA.
LNL SUBR ENTRY/EXIT
RJM SAF SEARCH FOR ASSIGNED FILE
NJN LNL1 IF FILE FOUND
LJM LNL5 SEARCH SYSTEM LIBRARIES
LNL1 RJM SFB SET FILE BUSY
ZJN LNL2 IF FILE SET BUSY
ERROR IOS * I/O SEQUENCE ERROR.*
LNL2 LDD CM+3 CHECK FILE MODE
LPN 4
ZJN LNL2.1 IF NOT EXECUTE-ONLY
LDD CP CHECK VALID ACCESS
ADC EOCW
CRD T1
LDD T1
LMD FA
NJN LNL4 IF NOT VALID ACCESS
LNL2.1 LDD CM+4 CHECK FILE TYPE
SHN -6
LMN PMFT
NJN LNL3 IF NO PERMANENT FILE
LDD CM+3 CHECK ACCESS MODE
LPN 20
ZJN LNL3 IF NOT M, A, RM, OR RA MODE
LDD FS+1
STM SISA SET INTERLOCK REQUIRED STATUS
LNL3 LDD FS
STD T5
SFA EST READ EST ENTRY
ADK EQDE
CRD CM
LDD CM CHECK EQUIPMENT TYPE
SHN 21-13
PJN LNL4 IF NOT MASS STORAGE
LDD FS+2 CHECK FOR TRACK
ZJN LNL4 IF FILE EMPTY
LJM LNL10 PROCESS LOCAL FILE
* SET ERROR STATUS.
LNL4 LDN 0 CLEAR FIRST BYTE OF LIBRARY NAME
STD FN
LJM LNLX RETURN
* SEARCH LIBRARY NAME TABLE FOR LIBRARY.
LNL5 STD T5 CLEAR LIBRARY ORDINAL
LDC LBDP READ LIBRARY NAME TABLE FWA
CRD CM-1
LNL6 AOD T5 ADVANCE ORDINAL
LDD CM+1 READ LIBRARY NAME
SHN 14
ADD CM+2
CRD FS
ADN 1 READ RANDOM ADDRESS
CRD RI-3
LDD FS COMPARE CHARACTERS 1 AND 2
ZJN LNL4 IF END OF LIBRARY NAME TABLE
LMD FN
ZJN LNL8 IF CHARACTERS MATCH
LNL7 LDN 2 ADVANCE LIBRARY NAME TABLE ADDRESS
RAD CM+2
SHN -14
RAD CM+1
UJN LNL6 LOOP TO END OF LIBRARY NAME TABLE
LNL8 LDD FN+1 COMPARE CHARACTERS 3 AND 4
LMD FS+1
NJN LNL7 IF NO COMPARE
LDD FN+2 COMPARE CHARACTERS 5 AND 6
LMD FS+2
NJN LNL7 IF NO COMPARE
LDD FN+3 COMPARE CHARACTER 7
LMD FS+3
SCN 77
NJN LNL7 IF NO COMPARE
* FORM SYSTEM LIBRARY DIRECTORY HEADER.
LDN ZERL CLEAR DIRECTORY ENTRY
CRM DIRA,ON
LDD DI SET INDEX TO FILE ENTRY
STM PDEB
LDD T5 ADD LIBRARY ORDINAL
SHN 6
STM DIRA+3
LCN 0
STM DIRA
LDN FNTP READ SYSTEM FST ENTRY
CRD CM
LDD CM
SHN 14
LMD CM+1
ERRNZ SYFO SYSTEM FILE ORDINAL .NE. 0
ADN FSTG
CRD FS
CRD T5
LDD RI SET RANDOM ADDRESS BIAS
SHN 14
ADD RI+1
SBN 1
STD TI+1
SHN -14
STD TI
RJM IRA INITIALIZE RANDOM ACCESS PROCESSORS
RJM CRA CONVERT RANDOM ADDRESS
PJN LNL9 IF NO RANDOM INDEX ERROR
LJM LNL4
LNL9 SETMS READSYS SYSTEM SELECTION OF EQUIPMENT
LJM LNLX RETURN
* FORM LOCAL LIBRARY DIRECTORY HEADER.
LNL10 LDD FS+1 SET FIRST TRACK
STD T6
LDN 0 SET INITIAL RANDOM ADDRESS
STD RI
STD TI
LDN FSMS
STD RI+1
SBN 1 SET RANDOM ADDRESS BIAS
STD TI+1
LDD MA FORM FIRST WORD OF DIRECTORY
CWD FN
CRM DIRA,ON
LDC 4000 FLAG FILE DIRECTORY ENTRY
RAM DIRA
LDD DI SET INDEX TO FILE ENTRY
STM PDEB
RJM IRA INITIALIZE RANDOM ACCESS PROCESSORS
RJM SIS SET INTERLOCK STATUS
RJM CRA
PJN LNL11 IF NO RANDOM INDEX ERROR
LJM LNL4
LNL11 SETMS IO
LJM LNLX RETURN
PGM SPACE 4,15
*** PGM - PROCESS GROUP MEMBERS.
*
* ENTRY (GO) = ORDINAL OF GROUP NAME WITHIN CURRENT LIBRARY.
* (T2) = *OPLD* TABLE BASE ADDRESS.
* (BL) = BUFFER LIMIT ADDRESS.
* (ER) = BUFFER EOR/EOF/EOI STATUS.
* (GN - GN+4) = NAME OF *CCL* PROCEDURE TO LOCATE
* IF FUNCTION CODE 404.
*
* EXIT ALL CAPSULES OR PROCEDURE RECORDS PROCESSED.
* (A) = 1 IF FIND ON FUNCTION CODE 404.
* (A) = 0 IF NO FIND ON FUNCTION CODE 404 OR *EOR*
* STATUS REACHED FOR PROCESSING OF CAPSULES.
* TO *SCS* IF ERROR FLAG SET.
*
* USES T1, T2, T3.
*
* CALLS LBM, PDE, SIS.
PGM SUBR ENTRY/EXIT
LDD T2 SKIP *OPLD* TABLE
ADN 1*5
PGM1 STD T3 SET BASE ADDRESS
PGM2 LDN 0
* LDN 1 (FUNCTION CODE 404)
PGMA EQU *-1
ZJN PGM5 IF NOT FUNCTION CODE 404
LDM 4,T3 CHECK FOR TYPE *PROC*
LMN 20
ZJN PGM3 IF TYPE *PROC*
LJM PGM6 IF NOT TYPE *PROC*
PGM3 LDD T3
STD T1
LDN GN CHECK NAME FOR MATCH
STD T2
PGM4 LDI T2
LMI T1
NJN PGM6 IF NO MATCH
AOD T1
AOD T2
LMN GN+3
NJN PGM4 IF 3 BYTES NOT PROCESSED
LDI T2 CHECK FOURTH BYTE
LMI T1
SCN 77
NJN PGM6 IF NO MATCH
RJM PDE PROCESS DIRECTORY ENTRY
LDN 1
LJM PGMX RETURN
PGM5 LDM 4,T3 CHECK FOR TYPE *CAP*
LMN 16
NJN PGM6 IF NOT TYPE *CAP*
LDM 5,T3 CHECK GROUP ORDINAL
LMD GO
NJN PGM6 IF NOT CORRECT GROUP ORDINAL
RJM PDE PROCESS DIRECTORY ENTRY
PGM6 LDN 2*5 INCREMENT BASE ADDRESS
RAD T3
SBD BL CHECK BUFFER LIMIT
PJN PGM7 IF BUFFER EXHAUSTED
LJM PGM2 LOOP
PGM7 LDD ER CHECK EOR STATUS
NJN PGM8 IF NOT *EOR* IN BUFFER
LJM PGMX IF *EOR* IN BUFFER
PGM8 RJM SIS SET INTERLOCK STATUS
LDC BUF RELOAD BUFFER
RJM LBM LOAD BUFFER MEMORY
LDC BUF+2 RESET BASE ADDRESS
LJM PGM1 LOOP
SFG SPACE 4,20
*** SFG - SEARCH FOR GROUP MEMBERS.
*
* ENTRY (A) = NUMBER OF GROUP NAMES IN *ULIB* RECORD.
* (T2) = *ULIB* TABLE BASE ADDRESS.
* (TI - TI+1) = BASE RANDOM ADDESS OF LIBRARY.
* (GN - GN+4) = GROUP NAME.
* (BL) = BUFFER LIMIT ADDRESS.
* (ER) = BUFFER EOR/EOF/EOI STATUS.
*
* EXIT (A) = 0 IF NO GROUP NAMES FOUND.
* (A) .NE. 0 IF GROUP NAME FOUND WITHIN *ULIB* RECORD.
* (A) = 1 IF FUNCTION CODE 404.
* (CC) = NUMBER OF CAPSULES IN CURRENT GROUP.
* (GO) = ORDINAL OF GROUP WITHIN CURRENT LIBRARY.
* (RI - RI+1) = RANDOM INDEX OF LIBRARY *OPLD* RECORD.
* TO *SCS* IF ERROR FLAG SET.
*
* USES T3, CC, GO, RI - RI+1.
*
* CALLS LBM, SIS.
SFG SUBR ENTRY/EXIT
STD CC SAVE GROUP COUNT
LDM 3,T2 SET *OPLD* RANDOM ADDRESS
ADD TI+1
STD RI+1
SHN -14
ADM 2,T2
ADD TI
STD RI
SFGA LDN 0
* LDN 1 (FUNCTION CODE 404)
NJN SFGX IF FUNCTION CODE 404
LDN 1 INITIALIZE GROUP NAME ORDINAL
STD GO
LDD T2 SKIP *ULIB* HEADER
ADN 5
SFG1 STD T3 SET BASE ADDRESS
SFG2 LDD GN CHECK GROUP NAME
LMI T3
LPC 3777
ZJN SFG4 IF MATCH
SFG3 SOD CC DECREMENT GROUP COUNT
ZJN SFGX IF ALL GROUPS PROCESSED
AOD GO INCREMENT GROUP ORDINAL
LDN 5 ADVANCE TO NEXT ITEM
RAD T3
SBD BL CHECK BUFFER LIMIT
PJN SFG5 IF BUFFER EXHAUSTED
UJN SFG2 LOOP
SFG4 LDD GN+1 COMPARE NAME CHARACTERS 3 AND 4
LMM 1,T3
NJN SFG3 IF NO MATCH
LDD GN+2 COMPARE NAME CHARACTERS 5 AND 6
LMM 2,T3
NJN SFG3 IF NO MATCH
LDD GN+3 COMPARE NAME CHARACTER 7
LMM 3,T3
SCN 77
NJN SFG3 IF NO MATCH
LDM 4,T3 SET CAPSULE COUNT
STD CC
LJM SFGX RETURN
SFG5 LDD ER CHECK EOR STATUS
NJN SFG6 IF EOR NOT IN BUFFER
LJM SFGX RETURN, SET NAME NOT FOUND
SFG6 RJM SIS SET INTERLOCK STATUS
LDC BUF RELOAD BUFFER
RJM LBM LOAD BUFFER MEMORY
LDC BUF+2 RESET BASE ADDRESS
LJM SFG1 LOOP
TITLE SUBROUTINES.
SPACE 4,10
** COMMON SUBROUTINES.
COMMON
CRP SPACE 4,10
** CRP - CHECK RECALL PARAMETERS.
*
* ENTRY (DPPB - DPPB+1) = CURRENT ACCUMULATOR UPDATE.
*
* USES CM - CM+4, GN+3 - GN+4.
*
* CALLS DPP.
*
* MACROS LDCA, MONITOR.
CRP SUBR ENTRY/EXIT
LDM DPPC CHECK TIME TO RECALL
ADC -RSLM
MJN CRPX IF NOT TIME TO RECALL
* SET RECALL PARAMETERS.
LDM GNLE
SHN -1
STD CM
CRPA LDN 0 SET NUMBER OF LOCAL USER LIBRARIES
SHN 4
LMD CM
SHN 6
LMN 40 SET RECALL BIT
RAD IR+3
LDD DI SET DIRECTORY INDEX
STD IR+2
LDM GNLC SET LIBRARY ORDINAL POSITION
LPN 1
LMN 1
STD GN+4
LDM SCSA SET EXISTING ERROR CODE
SHN 11
RAD GN+4
SHN -14
RAD GN+3
LDCA IR+3 REWRITE PARAMETER BLOCK
CWD GN
LDN 1 SELECT NO DROP PP
RJM DPP UPDATE ACCOUNTING
LDN ZERL
CRD CM
LDN PTLR PRU TRANSFER LIMIT
STD CM
LDD MA STORE PP RECALL REQUEST
CWD IR
ADN 1
CWD CM
MONITOR RECM
LJM PPR EXIT TO PP RESIDENT
DPP SPACE 4,10
** DPP - DROP PPU.
*
* ENTRY (A) = 0 IF PP TO BE DROPPED.
* (FA) = FNT ADDRESS.
* (FS - FS+4) = FST INFORMATION.
* (DPPB - DPPB+1) = MASS STORAGE ACCOUNTING INCREMENT.
*
* EXIT ACCOUNTING UPDATED.
* FST SET NOT BUSY.
* PP DROPPED IF SELECTED.
*
* USES CM - CM+4.
*
* MACROS MONITOR, NFA.
DPP SUBR ENTRY/EXIT
STD CM+2 SET PP DROP / NO DROP OPTION
LDD FA
ZJN DPP1 IF NO LOCAL FNT
AOD FS+4
NFA FA,R SET FST NOT BUSY
ADN FSTL
CWD FS
DPP1 LDD MA COPY PARAMETER WORD TO MESSAGE BUFFER
CWM DPPA,ON
LDN 1 SET WORD COUNT
STD CM+1
MONITOR UADM
UJN DPPX RETURN
DPPA CON AISS SUB FUNCTION
CON IOAW WORD TO UPDATE
CON 40D*100+20D FIELD TO UPDATE
DPPB CON 0,0 INCREMENT
DPPC DATA 0 PRU COUNTER
ERR SPACE 4,15
** ERR - ERROR PROCESSOR.
*
* ENTRY (A) = ERROR CODE.
*
* EXIT RETURN IF CONTINUATION ERROR. (MULTIPLE ERROR CODES)
* SET ERROR CODE AND DROP IF NON-FATAL ERROR.
* EXECUTE *2LD* IF FATAL ERROR.
*
* USES EC, SI - SI+1.
*
* CALLS SCS, 2LD.
*
* MACROS EXECUTE.
ERR SUBR ENTRY/EXIT
STD EC STORE ERROR CODE
SBN /ERR/FERT CHECK FOR FATAL ERROR
MJN ERR1 IF NOT FATAL ERROR
LDM DPPB SET MASS STORAGE INCREMENT
STD SI
LDM DPPB+1
STD SI+1
EXECUTE 2LD
ERR1 LCN 0 SET ERROR CODE BITS IN RESPONSE
LMD EC
STM ERRA
LDM SCSA
LPC *
ERRA EQU *-1
LMD EC
STM SCSA
LDD EC CHECK FOR CONTINUATION
LMN /ERR/ILE
ZJN ERRX IF CONTINUATION ERROR
LMN /ERR/IDS&/ERR/ILE
ZJN ERRX IF CONTINUATION ERROR
LJM SCS SET COMPLETE STATUS
IBA SPACE 4,15
** IBA - INCREMENT BUFFER ADDRESS.
*
* ENTRY (T3) = BUFFER ADDRESS.
* (IBAA - IBAA+1) = DATA SAVED FROM LAST SECTOR.
*
* EXIT (A) .GE. 0 IF BUFFER FULL.
* (T3) = NEW BUFFER ADDRESS.
* (BL) = BUFFER LIMIT ADDRESS.
* (IBAA - IBAA+1) = DATA SAVED FROM CURRENT SECTOR.
* PREVIOUS DATA RESTORED OVER LINKAGE BYTES.
*
* USES T3.
IBA1 LDI T3 SAVE DATA AREA
STM IBAA
LDM 1,T3
STM IBAA+1
LCN 1 SET EXIT CONDITION
IBA SUBR ENTRY/EXIT
LDM IBAA RESTORE PREVIOUS DATA
STI T3
LDM IBAA+1
STM 1,T3
LDC 100*5 INCREMENT BUFFER ADDRESS
RAD T3
ADC -BFMS CHECK BUFFER FULL
MJN IBA1 IF BUFFER NOT FULL
UJN IBAX EXIT
IBAA CON 0,0 DATA SAVE AREA
LBM SPACE 4,15
** LBM - LOAD BUFFER MEMORY.
*
* ENTRY (A) = ADDRESS OF START OF BUFFER.
*
* EXIT (BL) = BUFFER LIMIT ADDRESS.
* (ER) = BUFFER EOR/EOF/EOI STATUS.
* (DPPB - DPPB+1) = SRU ACCUMULATOR INCREMENTED.
* BUFFER FILLED OR EOR/EOF/EOI ENCOUNTERED.
* CHANNEL DROPPED.
* TRACK INTERLOCK CLEARED, IF SET.
* TO *SCS* IF ERROR FLAG SET.
*
* USES T3, BL, ER, DPPB - DPPB+1.
*
* CALLS CIS, IBA, RNS, SCS.
*
* MACROS ENDMS, PAUSE.
LBM SUBR ENTRY/EXIT
STD T3 SET BUFFER FWA
ADN 2 SET INITIAL BUFFER LIMIT
STD BL
UJN LBM2
LBM1 RJM IBA INCREMENT BUFFER ADDRESS
PJN LBM4 IF BUFFER FULL
LBM2 LDN IMLL INCREMENT MASS STORAGE ACCUMULATOR
RAM DPPB+1
SHN -14
RAM DPPB
AOM DPPC
LDD T3 READ NEXT SECTOR
RJM RNS
SHN 2 ADJUST BUFFER LIMIT ADDRESS
ADD T1
RAD BL
LDD T1 SET EOR/EOF/EOI STATUS
SHN -6
STD ER
NJN LBM1 IF NOT EOR/EOF/EOI
LBM3 LDM IBAA RESTORE BASHED DATA
STI T3
LDM IBAA+1
STM 1,T3
LBM4 ENDMS
RJM CIS CLEAR INTERLOCK STATUS
PAUSE
LDD CM+1 CHECK ERROR FLAG
ZJN LBM5 IF ERROR FLAG NOT SET
LJM SCS SET COMPLETE STATUS
LBM5 LJM LBMX RETURN
PDE SPACE 4,25
** PDE - PROCESS DIRECTORY ENTRY.
*
* ENTRY (T3) = ADDRESS OF DIRECTORY ENTRY.
* (CL) = LENGTH OF CENTRAL MEMORY DIRECTORY.
* (DI) = CURRENT LENGTH REQUIRED FOR DIRECTORY.
* (DL) = USER SPECIFIED DIRECTORY LENGTH.
* (TI - TI+1) = BASE RANDOM ADDESS OF LIBRARY.
* (PDEB) = INDEX TO LIBRARY FILE HEADER IN DIRECTORY.
* (DIRA - DIRA+4) = FIRST WORD OF DIRECTORY ENTRY.
*
* EXIT IF ENTRY FOUND IN DIRECTORY.
* NO CHANGE.
* IF ENTRY NOT FOUND AND NO DIRECTORY OVERFLOW.
* (CL) UPDATED TO REFLECT ENTRY LENGTH.
* (DI) UPDATED TO REFLECT ACTUAL DIRECTORY LENGTH.
* ENTRY WRITTEN TO DIRECTORY.
* IF ENTRY NOT FOUND AND DIRECTORY OVERFLOW.
* (DI) UPDATED TO REFLECT ACTUAL DIRECTORY LENGTH.
* ERROR CODE *IDS* SET IN RESPONSE.
*
* USES T1, T3, CL, DI, DL.
*
* CALLS SFE.
* PROCESS DIRECTORY OVERFLOW.
PDE6 LDD T1 ADVANCE ACTUAL DIRECTORY SPACE REQUIRED
RAD DI
LDM DIRA CHECK IF FILE HEADER PRESENT
ZJN PDEX IF NO FILE HEADER
LDN 0 CLEAR FILE HEADER
STM DIRA
PDE SUBR ENTRY/EXIT
LDD CL
ZJN PDE1 IF CENTRAL DIRECTORY EMPTY
RJM SFE SEARCH FOR DUPLICATE ENTRY
ZJN PDEX IF ENTRY FOUND
PDE1 LDN 2 SET DIRECTORY ENTRY LENGTH
STD T1
LDM DIRA
ZJN PDE2 IF NO FILE HEADER REQUIRED
AOD T1
PDE2 LDD DL
PDEA EQU *-1
*PDE2 UJN PDE6 (DIRECTORY OVERFLOW)
SBD CL
SBD T1
PJN PDE3 IF WITHIN DIRECTORY
LDM PDED
STM PDEA
ERROR IDS INSUFFICIENT DIRECTORY SPACE
LJM PDE6 UPDATE REQUIRED DIRECTORY LENGTH
PDE3 LDD T1 ADVANCE CENTRAL MEMORY DIRECTORY LENGTH
RAD CL
LDD T3 SET CAPSULE NAME ADDRESS
STM PDEC
LDC * SET FILE INDEX
PDEB EQU *-1
STM 4,T3
LDM 7,T3 SET ENTRY LENGTH
SHN -6
STM DIRB+4
LDM 6,T3
SHN 6
RAM DIRB+4
SHN -14
STM DIRB+3
LDD TI+1 SET RANDOM ADDRESS OF CAPSULE
ADM 11,T3
SHN 14
STM DIRB+2 SAVE UPPER 12 BITS
SHN -6
SCN 77
RAM DIRB+3
LDD TI
ADM 10,T3
SHN 6
RAM DIRB+2
LDN 0 SET CORE ADDRESS
STM DIRB+1
LDC 4000
STM DIRB
LDM DIRA CHECK TWO OR THREE WORD ENTRY
ZJN PDE4 IF TWO WORD ENTRY
* WRITE THREE WORD DIRECTORY ENTRY.
LDCA DA WRITE HEADER WORD TO DIRECTORY
ADD DI ADD INDEX
CWM DIRA,ON FILE HEADER
UJN PDE5 WRITE DIRECTORY
* WRITE TWO WORD DIRECTORY ENTRY.
PDE4 LDCA DA WRITE DIRECTORY
ADD DI ADD INDEX
PDE5 CWM **,ON CAPSULE NAME
PDEC EQU *-1
CWM DIRB,ON POSITION INFORMATION
LJM PDE6 UPDATE REQUIRED DIRECTORY LENGTH
PDED BSS 0
LOC PDEA
UJN PDE6
LOC *O
SCP SPACE 4,25
** SCP - SEARCH *CLD* FOR PROCEDURE RECORDS.
* SCP SEARCHES THE *CLD* FOR A SPECIFIED PROCEDURE
* RECORD AND THEN SETS UP THE ENTRY CONDITIONS FOR
* *PDE* TO PROCESS THE DIRECTORY ENTRY.
*
* ENTRY (AB - AB+4) = NAME LEFT JUSTIFIED, ZERO FILLED.
*
* EXIT (TI - TI+1) = 0.
* (PDEB) = 0.
* (DIRA - DIRA+4) = SYSTEM LIBRARY DIRECTORY HEADER.
* (T3) = *BUF*, WHERE *BUF* CONTAINS THE *CLD* ENTRY IN
* THE FOLLOWING FORMAT.
*
*T BUF 42/PROCEDURE NAME, 18/0
*T BUF+1 36/0, 24/RANDOM ADDRESS BIAS
*
* USES T3, T5, T6, TI - TI+1, PDEB, DIRA - DIRA+4.
*
* CALLS CLD.
SCP SUBR ENTRY/EXIT
LDN ZERL CLEAR DIRECTORY ENTRY
CRM DIRA,ON
LCN 0 FORM SYSTEM LIBRARY DIRECTORY HEADER
STM DIRA
RJM CLD SEARCH CENTRAL LIBRARY DIRECTORY
ZJN SCPX IF ENTRY NOT FOUND
CRM BUF+5,ON READ PST ENTRY
LDN 0 CLEAR ALTERNATE EQ POINTER
STD T5
LDD MA SET ENTRY POINT NAME IN BUFFER
CWD AB
CRM BUF,ON
LDC BUF SET UP POINTER TO ENTRY
STD T3
LDM BUF+3
SCN 77
STM BUF+3
LDN 0
STM BUF+4
STM BUF+1*5+0
STM BUF+1*5+1
STM BUF+1*5+2
STD TI
STD TI+1
STM PDEB
LDM BUF+1*5+3
LPN 77
STM BUF+1*5+3
LDN 1
LJM SCPX RETURN
SCS SPACE 4,15
** SCS - SET COMPLETE STATUS.
*
* ENTRY (DI) = ACTUAL LENGTH OF DIRECTORY REQUIRED.
* (SCSA) = CURRENT STATUS CODE.
* (IR+3 - IR+4) = FET ADDRESS.
*
* EXIT STATUS SET IN FIRST WORD OF FET.
* UPDATED DIRECTORY LENGTH RETURNED.
* LOCAL FILE SET NOT BUSY IF PRESENT.
*
* USES GN - GN+4, CM - CM+4, FS - FS+4.
*
* CALLS DPP.
*
* MACROS LDCA.
SCS LDC 0 SET STATUS CODE
SCSA EQU *-1
SHN 11 POSITION STATUS RESPONSE
ADN 1 SET COMPLETE BIT
STD GN+4
SHN -14
RAD GN+3
LDCA IR+3 RETURN LENGTH OF DIRECTORY
ADN 1
CRD CM
LDD CM+2 SET DIRECTORY LENGTH
SCN 77
SHN 6
LMD DI
SHN -6
STD CM+2
LDD DI
SHN 6
LMD CM+3
SCN 77
LMD CM+3
STD CM+3
LDCA IR+3 RETURN STATUS
CWD GN
ADN 1 RETURN UPDATED DIRECTORY LENGTH
CWD CM
LDN 0 SELECT DROP PP
RJM DPP UPDATE ACCOUNTING
LJM PPR EXIT TO PP RESIDENT
SFE SPACE 4,10
** SFE - SEARCH FOR ENTRY IN CENTRAL MEMORY DIRECTORY.
*
* ENTRY (T3) = INDEX TO CAPSULE NAME.
* (CL) = LENGTH OF CENTRAL MEMORY DIRECTORY.
*
* EXIT (A) .EQ. 0 IF MATCHING ENTRY FOUND.
* (A) .NE. 0 IF NO MATCH FOUND.
*
* USES T1, CM - CM+4.
SFE4 LDD CM+1 COMPARE BYTE 2 OF CAPSULE NAMES
LMM 1,T3
NJN SFE3 IF BYTES DO NOT COMPARE
LDD CM+2 COMPARE BYTE 3 OF CAPSULE NAMES
LMM 2,T3
NJN SFE3 IF BYTES DO NOT COMPARE
LDD CM+3
LMM 3,T3
SCN 77
NJN SFE3 IF CHARACTERS DO NOT COMPARE
SFE SUBR ENTRY/EXIT
LDN 0 INITIALIZE DIRECTORY OFFSET
STD T1
SFE1 AOD T1 INCREMENT DIRECTORY OFFSET
SFE2 LDCA DA GET DIRECTORY ENTRY
ADD T1
CRD CM
LDD CM
SHN 6
MJN SFE1 IF FILE SPECIFICATION ENTRY
* COMPARE DIRECTORY ENTRY.
SHN -6
LMI T3 COMPARE NAMES
ZJN SFE4 IF BYTES COMPARE
SFE3 LDN 2 INCREMENT DIRECTORY OFFSET
RAD T1
SBD CL
MJN SFE2 IF MORE CAPSULES TO PROCESS
LDN 1 SET EXIT CONDITION
UJN SFEX RETURN
SIS SPACE 4,15
** SIS - SET INTERLOCK STATUS.
*
* ENTRY (SISA) = TRACK NUMBER IF INTERLOCK REQUIRED.
*
* EXIT (CISA) = TRACK NUMBER IF INTERLOCK SET.
* (T6) SAVED AND RESTORED.
* TO *SCS* IF ERROR FLAG SET.
*
* USES T6.
*
* CALLS STI, SCS.
SIS1 LDD T6 SET TRACK INTERLOCKED STATUS
STM CISA
LDC 0 RESTORE CURRENT TRACK
SISB EQU *-1
STD T6
SIS SUBR ENTRY/EXIT
LDD T6
STM SISB
LDC 0 CHECK INTERLOCK REQUIRED STATUS
SISA EQU *-1
ZJN SISX IF NO INTERLOCK REQUIRED
STD T6
RJM STI SET TRACK INTERLOCK
ZJN SIS1 IF ERROR FLAG NOT SET
LJM SCS SET COMPLETE STATUS
VOT SPACE 4,10
** VOT - VALIDATE *OPLD* TABLE.
*
* ENTRY (T3) = BUFFER ADDRESS.
* (BL) = BUFFER LIMIT ADDRESS.
*
* EXIT (A) .LT. 0 IF ERROR IN TABLE.
* (T2) = *OPLD* TABLE BASE ADDRESS.
VOT1 LCN 1 SET EXIT CONDITION
VOT SUBR ENTRY/EXIT
LDM 2,T3 CHECK PREFIX TABLE
LMC 7700
NJN VOT1 IF NOT 7700 TABLE
LDM 3,T3 SET *OPLD* TABLE ADDRESS
ADN 1
STD T2
SHN 2
RAD T2
ADN 2
ADD T3
STD T2
ADN 3*5-1 CHECK MINIMUM *OPLD* IN BUFFER
SBD BL
PJN VOT1 IF *OPLD* NOT IN BUFFER
LDI T2 CHECK *OPLD* TABLE
LMC 7000
NJN VOT1 IF NOT *OPLD* TABLE
UJN VOTX RETURN
VUT SPACE 4,10
** VUT - VALIDATE *ULIB* TABLES.
*
* ENTRY (T3) = BUFFER ADDRESS.
* (BL) = BUFFER LIMIT ADDRESS.
*
* EXIT (A) = NUMBER OF GROUP NAMES IN *ULIB*.
* (A) = 1 IF FUNCTION CODE 404.
* (A) = 0 IF ERROR IN *ULIB* TABLE.
* (T2) = *ULIB* TABLE BASE ADDRESS.
VUT2 LDN 0 SET EXIT CONDITION
VUT SUBR ENTRY/EXIT
LDM 2,T3 CHECK PREFIX TABLE
LMC 7700
NJN VUT2 IF NOT 7700 TABLE
LDM 3,T3 SET PREFIX TABLE LENGTH
ADN 1
STD T2
SHN 2
RAD T2
ADN 2
ADD T3
STD T2
ADN 2*5-1 CHECK MINIMUM *ULIB* IN BUFFER
SBD BL
PJN VUT2 IF *ULIB* NOT IN BUFFER
LDI T2 CHECK *ULIB* RECORD
LMC 7600
NJN VUT2 IF NOT *ULIB* RECORD
VUTA LDN 0
* LDN 1 (FUNCTION CODE 404)
ZJN VUT1 IF NOT FUNCTION CODE 404
UJN VUTX RETURN
VUT1 LDM 1,T2 SET NUMBER OF GROUP NAMES IN *ULIB*
UJN VUTX RETURN
TITLE COMMON DECKS AND BUFFERS.
COMMON SPACE 4,15
** COMMON DECKS.
*CALL COMPCLD
*CALL COMPCRA
*CALL COMPSAF
*CALL COMPSFB
*CALL COMPSTI
*CALL COMPIRA
SPACE 4,20
USE //
** TLBD - GLOBAL LIBRARY SET.
TLBD EQU *
TLBDL EQU TLBD+3*5
* RETURNED DIRECTORY ENTRY.
DIRA EQU TLBDL
DIRB EQU DIRA+1*5
** BUF - MASS STORAGE BUFFER.
BUF EQU DIRB+1*5
.1 SET BFMS+1-BUF-2
ERRZR .1/500 MAXIMUM SECTORS FOR BUFFER
ERRNG .1-.1/500*500 BYTES REMAINING BEFORE OVERFLOW
TITLE PRESET.
PRS SPACE 4,20
** PRS - PRESET.
*
* ENTRY (IR - IR+4) = *LDD* CALL.
*
* EXIT (DI) = 0.
* (CL) = 0.
* (GN - GN+4) = GROUP NAME.
* (DL) = USER SPECIFIED DIRECTORY LENGTH.
* (DA) = DIRECTORY BASE ADDRESS.
* (UL - UL+1) = USER SPECIFIED LIBLIST ADDRESS.
* (LNLA) = FNT FWA.
* TO *ERR* IF ILLEGAL PARAMETER OR ADDRESS.
*
* USES CL, CM - CM+4, DA, DI, DL, FA, GN - GN+4,
* UL - UL+1, LNLA.
*
* CALLS CRS.
*
* MACROS ERROR, LDCA.
PRS SUBR ENTRY/EXIT
LDN 0
STD DI CLEAR DIRECTORY INDEX
STD FA CLEAR FNT ADDRESS
STD CL CLEAR CENTRAL DIRECTORY LENGTH
LDD IR+3 SET RECALL OPTION
SHN -5
LPN 1
RAM PRSA
LDD IR+3 CHECK PARAMETER ADDRESS
STM PRSB SAVE RECALL PARAMETERS
LPN 37
STD IR+3
SHN 14
LMD IR+4
SBN 2
MJN PRS1 IF ILLEGAL ADDRESS
ADN 1+2
SHN -6
SBD FL
MJN PRS2 IF PARAMETER ADDRESS WITHIN FL
PRS1 ERROR ARG * ARGUMENT ERROR.*
PRS2 RJM CRS CHECK RECALL STATUS
ZJN PRS1 IF NOT CALLED WITH AUTO RECALL
LDCA IR+3 READ GROUP NAME AND FUNCTION CODE
CRD GN
ADN 1 READ SECOND WORD OF PARAMETER BLOCK
CRD CM
LDD GN+3 CLEAR STATUS CODE
SCN 77
STD GN+3
LDD GN+4 CHECK FUNCTION CODE
LPC 776
ZJN PRS4 IF LEGAL FUNCTION CODE
LMC 402 CHECK FOR FUNCTION CODE 402
ZJN PRS2.5 IF FUNCTION CODE IS 402
LMK 404&402 CHECK FOR FUNCTION CODE 404
NJN PRS3 IF ILLEGAL FUNCTION CODE
* SET FUNCTION CODE 404 PROCESSING.
AOM LDDA
AOM PGMA
AOM SFGA
AOM VUTA
UJN PRS4
* SET FUNCTION CODE 402 PROCESSING.
PRS2.5 AOM LDDB
UJN PRS4 CONTINUE PROCESSING
PRS3 ERROR ILF ILLEGAL FUNCTION CODE
PRS4 LDD CM+2 SET LENGTH OF USER SPECIFIED DIRECTORY
SHN 6
STD DL
LDD CM+3
SHN -6
RAD DL
LDD CM+3 SET DIRECTORY BASE ADDRESS
LPN 37
STD DA
SHN 14
ADD CM+4
STD DA+1
SBN 2 CHECK DIRECTORY ADDRESS
MJN PRS5 IF ILLEGAL ADDRESS
ADN 2-1
ADD DL
SHN -6
SBD FL
MJN PRS6 IF DIRECTORY ADDRESS WITHIN FL
PRS5 ERROR IAD ILLEGAL DIRECTORY ADDRESS
PRS6 LDD CM+2 SET USER LIBLIST ADDRESS
SHN -6
STD UL+1
LDD CM+1
SHN 6
RAD UL+1
SHN -14
LPN 37
STD UL
SHN 14 CHECK USER SPECIFIED LIBLIST ADDRESS
LMD UL+1
ZJN PRS9 IF NO LIBLIST ADDRESS SPECIFIED
SBN 2
MJN PRS7 IF ILLEGAL ADDRESS
ADN 2
SHN -6
SBD FL
MJN PRS9 IF USER LIBLIST ADDRESS WITHIN FL
PRS7 ERROR ILA ILLEGAL LIBLIST ADDRESS
PRS8 LJM PRSX RETURN
PRS9 LDN 0 CHECK RECALL STATUS
PRSA EQU *-1
* LDN 1 (RECALL OPTION)
ZJN PRS8 IF NOT RECALL OPTION
LDD IR+2 SET DIRECTORY LENGTH PARAMETER
STD DI
STD CL CL = MIN(DL,DI)
SBD DL
MJN PRS10 IF (DL) .LT. (DI)
LDD DL
STD CL
PRS10 LDCA IR+3 SET PREVIOUS ERROR CODES
CRD CM
LDD CM+3
SHN 14
ADD CM+4
SHN -11
STM SCSA
LDC * SET LIBRARY PARAMETERS
PRSB EQU *-1
* LDC IR+3 (RECALL PARAMETERS)
SHN -6
LPN 17
SHN 1
STM GNLE
SHN -1
RAM GNLA
LDD CM+4 CHECK BYTE POSITION
LPN 1
ZJN PRS11 IF NO REPOSITION NEEDED
LDC SHNI+0
STM GNLC
AOM GNLE
PRS11 LDM PRSB SET LOCAL USER LIBRARY PARAMETERS
SHN -12
ZJN PRS12 IF NO LOCAL USER LIBRARIES
RAM CRPA SET LIBRARY ORDINAL POSITION
LPN 77 SET LOCAL USER LIBRARY OFFSET
STD CM
SHN 2
RAD CM
LDC TLBDL
SBD CM
STM GNLB
LDC LB2W
STM GNLD
PRS12 LJM PRSX RETURN
SPACE 4,10
** COMMON DECKS.
*CALL COMPCRS
TTL LDQ - LOAD QUICKLY.
TITLE
IDENT LDQ,/LDQ/LDQ
*COMMENT FDL - LOAD QUICKLY.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
SPACE 4,5
*** LDQ - LOAD QUICKLY.
* GREGG TOWNSEND. 76/02/04.
* J. J. EIKUM. 76/04/01.
SPACE 4,10
*** LDQ IS USED TO QUICKLY READ A CAPSULE OR OVERLAY INTO
* THE FIELD LENGTH OF A JOB, GIVEN THE RANDOM ADDRESS OF THE
* CAPSULE OR OVERLAY ON A MASS STORAGE DEVICE. THE PREFIX
* TABLE IS REMOVED AND THE REST OF THE RECORD IS TRANSFERRED
* WITHOUT MODIFICATION.
SPACE 4,10
*** CALL.
*
*
*T, 18/ *LDQ*,24/ ,18/ ADDR
*
* ADDR ADDRESS OF A FOUR-WORD PARAMETER BLOCK:
*
*T ADDR 42/ *FILE*,9/STAT,9/FUNC
*T, 42/ *GRPNAME*,18/0
*T, 42/ *NAME*,18/FWA
*T, 24/0,18/PRU,18/LWA+1
*
* *FILE* FILE FROM WHICH TO LOAD. IF BITS 59-48 = 7777,
* THEN LOAD FROM THE SYSTEM.
* STAT STATUS RETURNED BY LDQ.
* 000 FUNCTION COMPLETED SUCCESSFULLY.
* 001 ILLEGAL FUNCTION.
* 002 CM BUFFER NOT COMPLETELY WITHIN FIELD LENGTH.
* 003 NO SUCH FILE, NOT MASS STORAGE, OR EXECUTE-ONLY.
* 004 PRU NUMBER OUTSIDE FILE BOUNDARIES.
* 005 WRONG PROGRAM OR GARBAGE FOUND AT SPECIFIED PRU.
* 006 INSUFFICIENT FWA-LWA SPACE TO HOLD PROGRAM.
* FUNC FUNCTION REQUEST. LDQ WILL ADD 1 WHEN FINISHED.
* 000 LOAD CAPSULE.
* 002 LOAD OVERLAY.
* *GRPNAME* NAME OF CAPSULE GROUP. IGNORED FOR OVERLAY LOAD.
* *NAME* NAME OF CAPSULE OR OVERLAY TO BE LOADED.
* FWA FIRST WORD ADDRESS OF LOADABLE AREA.
* LWA+1 UPPER LIMIT OF LOADABLE AREA.
* PRU PRU ADDRESS OF PROGRAM TO BE LOADED.
SPACE 4,15
*** DAYFILE MESSAGES.
*
* * LDQ - ARGUMENT ERROR - XXXXXX.* = FET ADDRESS .LT. 2 OR
* .GT. FL-4.
*
* * LDQ - I/O SEQUENCE ERROR - FILENAM AT XXXXXX.* = MULTIPLE
* CONCURRENT FUNCTIONS WERE ATTEMPTED ON FILE *FILENAM*.
*
* * LDQ - DEVICE ERROR - FILENAM AT XXXXXX.* = AN UNRECOVERED
* DEVICE ERROR WAS ENCOUNTERED ON FILE *FILENAM*.
*
* FOR ALL MESSAGES, XXXXXX IS THE ADDRESS OF THE *LDD*
* PARAMETER BLOCK.
LDQ TITLE MAIN PROGRAM.
QUAL LDQ
** LDQ - MAIN PROGRAM.
ORG PPFW
LDQ RJM PRS
RJM RFS READ FIRST SECTOR
RJM CPY COPY PROGRAM
* UJN CFN
CFN SPACE 4,10
** CFN - COMPLETE FUNCTION.
CFN AOD FN+4 SET PARAMETER BLOCK COMPLETE
LDCA IR+3 REWRITE FIRST PARAMETER WORD
CWD FN
* UJN DPP
DPP SPACE 4,10
** DPP - DROP PP.
DPP LDD FA
ZJN DPP1 IF NOT LOCAL FILE LOAD
AOD FS+4
NFA FA,R SET FST NOT BUSY
ADN FSTL
CWD FS
DPP1 LDD MA STORE *UADM* PARAMETER BLOCK
CWM DPPA,ON
LDN 1 SET WORD COUNT
STD CM+1
LDN 0 SET DROP PP FLAG
STD CM+2
MONITOR UADM UPDATE ACCOUNTING AND DROP PP
LJM PPR
DPPA CON AISS SUB FUNCTION
CON IOAW WORD TO UPDATE
CON 40D*100+20D FIELD TO UPDATE
CON 0,0 INCREMENT
TITLE SUBROUTINES.
SPACE 4,10
** COMMON SUBROUTINES.
COMMON
CPN SPACE 4,12
** CPN - COMPARE NAMES.
*
* ENTRY (A) = ADDRESS OF NAME 1.
* (GN - GN+3) = NAME 2.
*
* EXIT (A) = 0 IF SEVEN CHARACTERS MATCH.
*
* USES T2.
CPN SUBR ENTRY/EXIT
STD T2
LDI T2 COMPARE FIRST BYTES
LMD GN
NJN CPNX IF NOT EQUAL
LDM 1,T2 COMPARE SECOND BYTES
LMD GN+1
NJN CPNX IF NOT EQUAL
LDM 2,T2 COMPARE THIRD BYTES
LMD GN+2
NJN CPNX IF NOT EQUAL
LDM 3,T2 COMPARE SEVENTH CHARACTERS
LMD GN+3
SCN 77
UJN CPNX RETURN WITH (A)=0 ONLY IF MATCH
CPY SPACE 4,25
** CPY - COPY PROGRAM.
*
* ENTRY (T1) = VALID WORD COUNT.
* (T3) = ADDRESS OF WORDS IN PP BUFFER.
* (T5) = EST ORDINAL.
* (T6) = TRACK.
* (T7) = SECTOR.
* (ER) = EOR FLAG.
* (FW - FW+1) = FWA OF CM BUFFER.
* (BS - BS+1) = BUFFER SIZE.
* (BFMS - BFMS+501) = FIRST SECTOR.
*
* EXIT TO *ERR* IF CM BUFFER TOO SMALL.
* CHANNEL DROPPED.
*
* USES T1, T3, T6, T7, CM - CM+4, FW - FW+1, BS - BS+1,
* EC, ER.
*
* CALLS CIS, DDT, MSR, RNS.
*
* MACROS ENDMS, ERROR.
* PROCESS DIRECT TRANSFER COPY.
CPY4 LDD FW SET *DDT* PARAMETERS
ADD BS
SHN 14
ADD FW+1
ADD BS+1
SHN 14
STD CM+2
SHN -6
SCN 77
ADD FW
STD CM+3
LDD FW+1
STD CM+4
LDC RDDS*10000+7777
RJM DDT DO DIRECT TRANSFER
SHN -14
STD EC SAVE STATUS
LDD T4 NUMBER OF SECTORS TRANSFERED
RAM DPPA+4 UPDATE ACCOUNT INCREMENT
ERRNZ IMLL-1 CODE DEPENDS ON VALUE
SHN -14
RAM DPPA+3
LDD EC
ZJN CPY6 IF NO ERRORS
SHN 21-4
MJN CPY5 IF INSUFFICIENT FL TO LOAD
LDM RDCT
RJM MSR PROCESS MASS STORAGE ERROR
CPY5 ENDMS
ERROR IBF INSUFFICIENT BUFFER
CPY6 ENDMS
RJM CIS CLEAR INTERLOCK STATUS
CPY SUBR ENTRY/EXIT
CPY1 LDD BS DECREMENT BUFFER SIZE
SHN 14
LMD BS+1
SBD T1
MJN CPY5 IF BUFFER TOO SMALL
STD BS+1
SHN -14
STD BS
LDD T3 SET PP BUFFER ADDRESS
STM CPYA
LDCA FW WRITE BUFFER TO CM
CWM **,T1
CPYA EQU *-1
LDD T1 UPDATE FWA
RAD FW+1
SHN -14
RAD FW
LDD ER
NJN CPY3 IF EOR NOT READ
CPY2 LJM CPY6 EXIT
CPY3 LDC BFMS READ NEXT SECTOR
CPYC EQU *-1
* LJM CPY4 (DIRECT TRANSFER COPY)
RJM RNS
SHN -6 SAVE EOR FLAG
STD ER
LDN IMLL INCREMENT PRU COUNT
RAM DPPA+4
SHN -14
RAM DPPA+3
LDD T1
ZJN CPY2 IF EMPTY PRU
LDN 2 ADJUST FWA TO SKIP HEADER
RAD T3
LJM CPY1 LOOP
ERR SPACE 4,10
** ERR - SET ERROR AND EXIT.
*
* ENTRY (A) = ERROR CODE.
* (DPPA+3 - DPPA+4) = MASS STORAGE INCREMENT.
*
* EXIT TO *2LD* IF FATAL ERROR.
* TO *CFN* IF NON-FATAL ERROR.
* (BITS 11-13 OF FN+4) = STATUS.
*
* USES EC, SI, SI+1.
*
* CALLS CFN, CIS.
ERR SUBR
STD EC SAVE ERROR CODE
RJM CIS CLEAR INTERLOCK STATUS
ERR1 LDD EC CHECK ERROR TYPE
SBN /ERR/FERT
MJN ERR2 IF NON-FATAL ERROR
LDM DPPA+3 SET ACCOUNTING INCREMENT
STD SI
LDM DPPA+4
STD SI+1
EXECUTE 2LD PROCESS ERROR
ERR2 LDD EC SET STATUS FIELD
SHN 11
RAD FN+4
LJM CFN EXIT
RFS SPACE 4,25
** RFS - READ FIRST SECTOR.
*
* ENTRY (T4) = CHANNEL.
* (T5) = EST ORDINAL.
* (T6) = TRACK.
* (T7) = SECTOR.
* (GN - GN+3) = OVERLAY/CAPSULE NAME.
*
* EXIT TO *ERR* IF ERROR DETECTED.
* (T1) = VALID WORD COUNT.
* (T3) = ADDRESS OF WORDS IN PP BUFFER.
* (T6) = CURRENT TRACK.
* (T7) = NEXT SECTOR.
* (ER) = 0 IF EOR.
*
* USES T2, CM - CM+4, GN - GN+4.
*
* CALLS CPN, RNS.
*
* MACROS ENDMS, ERROR.
RFS SUBR ENTRY/EXIT
LDN IMLL INCREMENT PRU COUNT
RAM DPPA+4
LDC BFMS READ FIRST SECTOR
RJM RNS
SHN -6 SAVE EOR FLAG
STD ER
LDN 2 ADJUST BUFFER POINTER TO SKIP HEADER
RAD T3
LDI T3 CHECK FIRST WORD
LMC 7700
NJN RFS1 IF NOT 7700 TABLE (ERROR)
LDD T3 COMPARE CAPSULE/OVERLAY NAME TO EXPECTED
ADN 5
RJM CPN
NJN RFS1 IF NOT SAME NAME
LDM 1,T3 SKIP 7700 TABLE
ADN 1 ENSURE 7700 HEADER IN SECTOR
STD T2
SHN 2
ADD T2
RAD T3
LDD T1 ADJUST WORD COUNT
SBD T2
MJN RFS1 IF WORD COUNT IN 77 TABLE .GT. SECTOR SIZE
STD T1
LDD FN+4
ZJN RFS2 IF LOADING A CAPSULE
LDI T3
SHN -6
SBN 50
MJN RFS1 IF .LT. 50XX TABLE
SBN 52-50
ZJN RFS1 IF 52XX TABLE
SBN 54-52+1
PJN RFS1 IF .GT. 54XX TABLE
LJM RFSX VALID OVERLAY FORMAT, EXIT
RFS1 ENDMS
ERROR WPR WRONG PROGRAM
RFS2 LDI T3 CHECK HEADER
LMC 6000
NJN RFS1 IF NOT CAPSULE
LDCA IR+3 READ GROUP NAME
ADN 1
CRD GN
LDD T3
ADN 5
RJM CPN COMPARE WITH ACTUAL READ
NJN RFS1 IF NOT SAME NAME
LJM RFSX RETURN
SPACE 4
** COMMON DECKS.
*CALL COMPDDT
PRS TITLE PRESET.
** PRS - PRESET.
*
* ENTRY (IR - IR+4) = LDQ CALL.
*
* EXIT TO *ERR* IF ERROR DETECTED.
* (FA) = 0 IF SYSTEM FILE.
* (FA) = FNT ADDRESS IF LOCAL FILE.
* (FS - FS+4) = FST ENTRY IF LOCAL FILE.
* (FN - FN+3) = FILE NAME.
* (FN+4) = FUNCTION CODE.
* (FW - FW+1) = FWA OF BUFFER.
* (BL - BL+1) = BUFFER LENGTH.
* (GN - GN+3) = OVERLAY/CAPSULE NAME.
* (T4) = CHANNEL.
* (T5) = EST ORDINAL.
* (T6) = TRACK.
* (T7) = SECTOR.
* CHANNEL RESERVED AND DISK POSITIONED.
* ERROR PROCESSING OPTION SET.
*
* USES CM - CM+4, GN - GN+4.
*
* CALLS ALF, ASF, CRA, IRA, SMS, POS.
PRS SUBR ENTRY/EXIT
LDN 0
STD FA
LDD IR+3 CHECK PARAMETER BLOCK ADDRESS
LPN 37
STD IR+3
SHN 14
LMD IR+4
SBN 2
MJN PRS1 IF ILLEGAL ADDRESS
ADN 3+2
SHN -6
SBD FL
MJN PRS2 IF LEGAL ADDRESS
PRS1 ERROR ARG * ARGUMENT ERROR.*
PRS2 LDCA IR+3 READ FILE NAME AND FUNCTION CODE
CRD FN
ADN 2 READ FWA OF BUFFER
CRD CM
ADN 1 READ RANDOM INDEX AND LWA
CRD GN
LDD FN+3 CLEAR STATUS FIELD
SCN 77
STD FN+3
LDD FN+4
LPC 776
STD FN+4
SHN -1
SBN 2
MJN PRS3 IF LEGAL FUNCTION CODE
ERROR ILF ILLEGAL FUNCTION
PRS3 LDD CM+3 SET FWA OF BUFFER
LPN 37
STD FW
SHN 14
LMD CM+4
STD FW+1
SBN 2
MJN PRS4 IF ILLEGAL ADDRESS
LDD GN+3 CHECK LWA+1 OF BUFFER
LPN 37
SHN 14
LMD GN+4
SBN 1
SHN -6
SBD FL
MJN PRS5 IF LEGAL ADDRESS
PRS4 ERROR IAD ILLEGAL ADDRESS
PRS5 LDD GN+3 SET BUFFER LENGTH
LPN 37
SHN 14
LMD GN+4
SBD FW+1
STD BS+1
SHN -14
SBD FW
STD BS
SHN 14
LMD BS+1
MJN PRS4 IF FWA .GT. LWA+1
ZJN PRS4 IF FWA .EQ. LWA+1
LDD GN+3 SET RANDOM INDEX
SCN 77
SHN 6
LMD GN+2
SHN 6
ZJN PRS8 IF ILLEGAL RANDOM ADDRESS
STD RI+1
SHN -14
LPN 77
STD RI
LDCA IR+3 READ OVERLAY/CAPSULE NAME
ADN 2
CRD GN
* ACCESS FILE.
LDD FN CHECK FILE TYPE
LMC 7777
ZJN PRS6 IF SYSTEM FILE
RJM ALF ACCESS LOCAL FILE
UJN PRS7
PRS6 RJM ASF ACCESS SYSTEM FILE
PRS7 RJM IRA INITIALIZE RANDOM ACCESS
RJM CRA CONVERT RANDOM ADDRESS
PJN PRS9 IF LEGAL RANDOM ADDRESS
PRS8 ERROR IRA ILLEGAL RANDOM ADDRESS
* RESERVE CHANNEL.
PRS9 LDD FA
NJN PRS10 IF NOT SYSTEM FILE
SETMS READSYS ALLOW SYSTEM SELECTION OF EQUIPMENT
UJN PRS11 CHECK IF DIRECT TRANSFER SUPPORTED
* PRESET FOR DIRECT TRANSFER IF AVAILABLE.
PRS10 SETMS IO
PRS11 LDD CM+4
SHN 3
ADN DILL
CRD CM
LDD CM+3
SHN 21-13
PJN PRS12 IF DIRECT TRANSFER NOT AVAILABLE
LDC CPY4 PRESET *CPY* FOR DIRECT TRANSFER
STM CPYC
LDC LJMI
STM CPYC-1
PRS12 LJM PRSX RETURN
ALF SPACE 4,20
** ALF - ACCESS LOCAL FILE.
*
* ENTRY (FN - FN+3) = FILE NAME.
*
* EXIT TO *ERR* IF ERROR.
* (T5) = EST ORDINAL.
* (T6) = FIRST TRACK.
* (FA) = FNT ADDRESS.
* (FS - FS+4) = FST ENTRY.
* TRACK INTERLOCK SET IF NEEDED.
*
* USES CM - CM+4, FN - FN+4, RI - RI+4, T0 - T6.
*
* CALLS ERR, SAF, SFB, STI.
*
* MACROS ERROR, NFA, SFA.
ALF6 RJM SFB SET FILE BUSY
ZJN ALF2 IF FILE SET BUSY
ERROR IOS I/O SEQUENCE ERROR
ALF SUBR ENTRY/EXIT
LDD FN CLEAR UPPER BIT
LPC 3777
STD FN
RJM SAF SEARCH FOR ASSIGNED FILE
NJN ALF6 IF FILE FOUND
ALF1 ERROR FNF FILE NOT FOUND
ALF2 LDD CM+3 CHECK FILE STATUS
LPN 4
ZJN ALF3 IF NOT EXECUTE ONLY
LDD CP CHECK VALID ACCESS
ADC EOCW
CRD T1
LDD T1
LMD FA
NJN ALF1 IF NOT VALID ACCESS
ALF3 NFA FA,R RESET FST INFORMATION
ADN FSTL
CRD FS
LDD FS+2
ZJN ALF1 IF EMPTY FILE
LDD FS SET EST ORDINAL
STD T5
SFA EST READ EST ENTRY
ADK EQDE
CRD T0
LDD T0 CHECK EQUIPMENT TYPE
SHN 21-13
PJN ALF1 IF NOT ON MASS STORAGE
LDD FS+1 SET FIRST TRACK
STD T6
LDD CM+4 CHECK FOR TRACK INTERLOCK NEEDED
SHN -6
LMN PMFT
NJN ALF5 IF NOT PERMANENT FILE
LDD CM+3
LPN 20
ZJN ALF5 IF NOT M, A, RM, OR RA MODE
RJM STI SET TRACK INTERLOCK
ZJN ALF4 IF INTERLOCK SET AND ERROR FLAG NOT SET
LJM DPP
ALF4 LDD T6 SET TRACK INTERLOCKED STATUS
STM CISA
ALF5 LJM ALFX
ASF SPACE 4,12
** ASF - ACCESS SYSTEM FILE.
*
* EXIT (T5) = EST ORDINAL.
* (T6) = FIRST TRACK.
*
* USES CM - CM+4.
ASF SUBR ENTRY/EXIT
LDN FNTP READ FNT POINTER
CRD CM
LDD CM READ SYSTEM FILE FST
SHN 14
LMD CM+1
ERRNZ SYFO SYSTEM FILE ORDINAL .NE. 0
ADN FSTG
CRD CM
LDD CM+1 SET FIRST TRACK
STD T6
LDD CM SET SYSTEM EQUIPMENT
STD T5
UJN ASFX
SPACE 4,10
** COMMON DECKS.
*CALL COMPCRA
*CALL COMPSAF
*CALL COMPSFB
*CALL COMPSTI
*CALL COMPIRA
TTL 2LD - PROCESS LDD/LDQ ERRORS.
TITLE
IDENT 2LD,PPFW
QUAL 2LD
*COMMENT FDL - ERROR PROCESSOR.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
ERP SPACE 4,10
** ERP - ERROR PROCESSOR.
*
* ENTRY (EC) = ERROR CODE.
* (FA) = FNT ADDRESS IF LOCAL FILE.
* (FA) = 0 IF SYSTEM FILE.
* (SI - SI+1) = MASS STORAGE ACCOUNTING INCREMENT.
* (FN - FN+3) = FILE NAME.
* (IR - IR+1) = PP NAME.
* (IR+3 - IR+4) = PARAMETER BLOCK ADDRESS.
*
* EXIT LOCAL FILE SET COMPLETE.
* MESSAGE ISSUED.
* ACCOUNTING UPDATED.
* PPU DROPPED.
*
* USES T1, CM - CM+4.
*
* CALLS ACS, ANS, DFM.
*
* MACROS MONITOR, NFA, PAUSE.
ORG PPFW
ERP SUBR
LDC BUF SET ADDRESS FOR PROCESSOR NAME
STD T1
LDN 1R ADD SPACE CHARACTER
SHN 14
ADD IR SET FIRST CHARACTER
SHN 14
STI T1
LMI T1 SET LAST CHARACTERS
ADD IR+1
SHN 14
STM BUF+1
LDN 2 SET ASSEMBLY ADDRESS
RAD T1
LDN 0 SET BYTE BOUNDARY
STI T1
LDC =Z* - * ADD * - *
RJM ACS
LDD EC ADD MESSAGE
SBN /ERR/FERT
STD T2
LDM TMSG,T2
RJM ACS
LDC =Z* - * ADD * - *
RJM ACS
LDD EC CHECK ERROR TYPE
LMN /ERR/ARG
ZJN ERP3 IF * ARGUMENT ERROR.*
LDD FA
NJN ERP1 IF LOCAL FILE
LDC =Z*SYSTEM*
UJN ERP2
ERP1 LDD FN+3 TERMINATE FILE NAME
SCN 77
STD FN+3
LDN FN ADD FILE NAME
ERP2 RJM ACS
LDC =Z* AT * ADD * AT *
RJM ACS
ERP3 LDD IR+3 ADD ADDRESS
SHN 14
LMD IR+4
RJM ANS
LDC =Z*.* ADD PERIOD
RJM ACS
LDC BUF ISSUE DAYFILE MESSAGE
RJM DFM
PAUSE CHECK ERROR FLAG
LDD CM+1
NJN ERP4 IF ERROR FLAG SET
LDN PPET SET ERROR FLAG
STD CM+1
MONITOR CEFM
ERP4 AOD FS+4 SET FST ENTRY COMPLETE
LDD EC CHECK ERROR TYPE
LMN /ERR/IOS
ZJN ERP5 IF I/O SEQUENCE ERROR
LDD FA
ZJN ERP5 IF NO FST ADDRESS
NFA FA,R
ADN FSTL
CWD FS
ERP5 LDD SI SET ACCOUNTING INCREMENT
STM ERPC
LDD SI+1
STM ERPC+1
LDD MA SET REQUEST IN MESSAGE BUFFER
CWM ERPB,ON
LDN 1 SET WORD COUNT
STD CM+1
LDN 0 SET DROP PPU
STD CM+2
MONITOR UADM
LJM PPR
ERPB CON AISS SUB FUNCTION
CON IOAW WORD TO UPDATE
CON 40D*100+20D FIELD TO UPDATE
ERPC CON 0,0 INCREMENT
TMSG SPACE 4
TMSG BSS 0
QUAL ERR
LOC FERT
ARG MSG (ARGUMENT ERROR)
IOS MSG (I/O SEQUENCE ERROR)
MSR MSG (DEVICE ERROR)
LOC *O
QUAL *
SPACE 4,10
** COMMON DECKS.
*CALL COMPACS
*CALL COMPANS
BUF SPACE 4,10
USE BUFFERS
BUF BSS 0 ASSEMBLY BUFFER
SPACE 4
TTL LDD/LDQ - FAST DYNAMIC LOADER.
END