IDENT PFLOAD1,PFLRL,PFL,01,00
TITLE PFLOAD - PERMANENT FILE LOAD.
ABS
SST
SYSCOM B1
SPACE 4,10
*COMMENT PFLOAD - PERMANENT FILE LOAD.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
SPACE 4,10
*** PFLOAD - PERMANENT FILE LOAD.
* D. A. HIVELEY 70/12/22.
* S. T. WORSTELL 73/02/15.
SPACE 4,10
*** *PFLOAD* IS A PERMANENT FILE UTILITY PROGRAM WHICH LOADS
* FILES FROM AN ARCHIVE FILE ONTO A PERMANENT FILE DEVICE.
* *PFLOAD* MAY BE CALLED BY THE PERMANENT FILE SUPERVISOR
* OR BY A COMMAND.
*
* SEE *COMSPFS* FOR A DESCRIPTION OF THE PARAMETERS VALID FOR
* *PFLOAD*.
*
* *PFLOAD* CAN PERFORM SEVERAL TYPES OF PERMANENT FILE LOADS.
* AN INCREMENTAL LOAD IS PERFORMED BY READING THE CATALOG
* IMAGE RECORD (CIR) FROM THE MOST RECENT SELECTIVE
* *PFDUMP* (FIRST REEL OF INCREMENTAL LOAD PROCESS) AND
* PLACING IT ON A RANDOM FILE.
* EACH ITEM IN THE CIR REPRESENTS A FILE AT THE TIME OF THE
* SELECTIVE DUMP.
* WHEN READING AN ARCHIVE FILE, IF A MATCH IS FOUND ON THE
* CIR, THE FILE IS A CANDIDATE FOR LOADING AND THE ENTRY IN
* THE CIR IS CLEARED. ELSE, THE FILE IS SKIPPED BECAUSE IT
* HAS BEEN EITHER PURGED OR PREVIOUSLY LOADED.
*
* DIRECT ACCESS FILES ARE LOADED TO THE DEVICE ON WHICH THEY
* RESIDED WHEN DUMPED UNLESS THE DEVICE NO LONGER EXISTS OR
* THE FILE IS NOT ALLOWED ON THE DEVICE (I.E. USER INDEX .LT.
* *AUIMX* AND USER INDEX DOES NOT MATCH THE SECONDARY DEVICE
* MASK). IF THE FILE CAN NOT BE LOADED ON THE ORIGINAL
* DEVICE, IT WILL BE LOADED ON THE DESTINATION DEVICE IF
* SPECIFIED (*DD* PARAMETER) AND IF THE FILE IS ALLOWED ON
* THAT DEVICE. IF THE FILE CAN NOT BE LOADED ON EITHER DEVICE,
* AN *ALTERNATE DEVICE NOT FOUND.* MESSAGE WILL BE ISSUED AND
* THE FILE WILL BE SKIPPED. A DIRECT ACCESS FILE IS CONSIDERED
* TO HAVE RESIDED ON THE MASTER DEVICE BEING LOADED IF IT
* ORIGINALLY RESIDED ON ITS OWN MASTER DEVICE. IF THE *OP=L*
* OPTION IS SPECIFIED, EACH DIRECT ACCESS FILE WILL BE LOADED
* TO THE DEVICE WITH THE MOST SPACE AVAILABLE OF THOSE WHERE
* THE DEVICE MASK ALLOWS IT TO RESIDE, REGARDLESS OF PREVIOUS
* RESIDENCE OR *DD* SPECIFICATION.
*
* ARCHIVE FILE ERRORS MAY BE ENCOUNTERED WHEN PROCESSING A
* FILE. THIS COULD BE CAUSED BY AN ERROR WHEN WRITING THE
* ARCHIVE FILE (*PFDUMP*) OR READING THE ARCHIVE FILE. SUCH
* THINGS AS DROPPED RECORDS, PARITY ERRORS COULD CAUSE THIS.
* IF ARCHIVE FILE ERRORS ARE ENCOUNTERED THEY ARE PROCESSED BY
* SETTING THE LENGTH IN THE CATALOG FOR FILES THAT ARE TOO
* SHORT AND TRUNCATING EXTRA PRUS TO MATCH LENGTH SPECIFIED IN
* THE CATALOG FOR FILES TOO LONG.
SPACE 4,10
*** SECURITY CONSIDERATIONS.
*
* ON A SECURE SYSTEM, THE DEVICE SELECTED FOR A FILE TO RESIDE
* ON MUST HAVE SECURITY ACCESS LEVEL LIMITS ALLOWING THE FILE-S
* ACCESS LEVEL FROM THE PFC ENTRY TO RESIDE THERE. IF NO
* DEVICE CAN BE FOUND, THE FILE IS SKIPPED AND A MESSAGE
* ISSUED.
SPACE 4,10
*** MESSAGE LEGEND.
*
* THE FOLLOWING LEGEND DEFINES PARAMETERS THAT ARE USED IN MANY
* OF THE *PFLOAD* ERROR MESSAGES. THE DESCRIPTIVE CHARACTER
* STRINGS DEFINED HERE ARE REPLACED BY THEIR ACTUAL VALUE WHEN
* A PARTICULAR MESSAGE IS ISSUED. THE _ CHARACTER DOES NOT
* APPEAR IN ACTUAL MESSAGES BUT IS USED IN THE DOCUMENTATION AS
* A DELIMITER TO AVOID AMBIGUITIES.
*
* DD = DEVICE NUMBER.
* EEE = EST ORDINAL.
* MMMMMM = FILE COUNT.
* NNNNNNN = PERMANENT FILE NAME.
* UUUUUU = USER INDEX.
* XXXXXXXX = COUNT OF PRU-S TRUNCATED.
SPACE 4,20
*** OPERATOR MESSAGES.
*
* SEE *MESSAGE LEGEND* ABOVE FOR A DESCRIPTION OF PARAMETERS
* APPEARING IN THESE MESSAGES.
*
* *LOADING NNNNNNN UUUUUU*
* LOAD OF THE INDICATED FILE IS IN PROGRESS.
*
* *SKIPPING NNNNNNN UUUUUU*
* THE INDICATED FILE IS BEING SKIPPED BECAUSE IT WAS NOT
* SELECTED FOR LOAD.
*
* *CREATING CATALOG IMAGE RECORD*
* THE CATALOG IMAGE RECORD FROM THE ARCHIVE FILE IS
* BEING COPIED TO A SCRATCH FILE.
*
* *CLEARING UTILITY INTERLOCK*
* *PFLOAD* IS WAITING FOR *PFU* TO CLEAR THE PERMANENT
* FILE UTILITY INTERLOCK ON A DEVICE.
*
* *SETTING UTILITY INTERLOCK*
* *PFLOAD* IS WAITING FOR *PFU* TO SET THE PERMANENT
* FILE UTILITY INTERLOCK ON A DEVICE.
SPACE 4,10
*** INFORMATIVE DAYFILE MESSAGES.
*
* SEE *MESSAGE LEGEND* ABOVE FOR A DESCRIPTION OF PARAMETERS
* APPEARING IN THESE MESSAGES.
*
* * ERROR IN ARCHIVE FILE LABEL.*
* THE FORMAT OF THE ARCHIVE FILE LABEL IS INCORRECT.
*
* * MMMMMM FILES LOADED WITH ERRORS.*
* THE NUMBER OF FILES WHICH WERE LOADED BUT WHICH HAD
* ERRORS IN THE FILE DATA OR PERMITS. THE PFC ENTRIES
* OF SUCH FILES WILL INDICATED THE ERRORS THAT
* OCCURRED.
*
* * MMMMMM FILES SKIPPED WITH ERRORS.
* THE NUMBER OF SELECTED FILES WHICH COULD NOT BE
* LOADED.
*
* * MMMMMM FILES LOADED.
*
* * READ ERRORS ENCOUNTERED ON ARCHIVE FILE.*
* UNRECOVED ERRORS OCCURRED WHEN READING THE ARCHIVE
* FILE. IT IS POSSIBLE THAT SOME FILES THAT SHOULD HAVE
* BEEN LOADED WERE NOT FOUND.
* THE NUMBER OF FILES LOADED FROM THE ARCHIVE FILE.
SPACE 4,10
*** NON-FATAL ERROR DAYFILE MESSAGES.
*
* SEE *MESSAGE LEGEND* ABOVE FOR A DESCRIPTION OF PARAMETERS
* APPEARING IN THESE MESSAGES.
*
* * ALTERNATE DEVICE NOT FOUND, FN=NNNNNNN, UI=UUUUUU.*
* THE DEVICE NUMBER IN THE PFC ENTRY OF A DIRECT ACCESS
* FILE WAS NOT FOUND IN THE SYSTEM, AND THE *DD* OR
* *OP=L* OPTIONS WERE NOT SPECIFIED. THE FILE IS NOT
* LOADED.
*
* * ARCHIVE FILE BLOCK ERROR, FN=NNNNNNN, UI=UUUUUU.*
* A PFC, PERMIT, OR DATA BLOCK WAS DETECTED WITH AN
* INCORRECT SUB-TYPE, AN INCORRECT LENGTH FOR THE BLOCK
* TYPE, OR INCORRECT CONTENTS FOR THE BLOCK TYPE. ALSO
* ISSUED WHEN PERMIT OR DATA BLOCKS WERE PRESENT OR
* MISSING WHEN THEY SHOULD NOT BE BASED ON INFORMATION
* IN THE PFC BLOCK OR WHEN A BLOCK OF UNKNOWN TYPE IS
* ENCOUNTERED. THE FILE IS NOT LOADED.
*
* * ARCHIVE FILE READ ERROR, FN=NNNNNNN, UI=UUUUUU.*
* A READ ERROR OCCURRED ON THE ARCHIVE FILE WHILE
* PROCESSING THE INDICATED FILE. THE FILE IS NOT
* LOADED.
*
* * DATA WRITE ERROR, FN=NNNNNNN, UI=UUUUUU.*
* A MASS STORAGE ERROR OCCURRED WHILE WRITING THE
* INDICATED FILE. IF DIRECT ACCESS, THE MASS STORAGE
* SPACE FOR THE FILE IS DROPPED, CAUSING THE FAILING
* TRACK TO BE FLAWED. IF INDIRECT ACCESS, THE FAILING
* PORTION OF THE INDIRECT ACCESS FILE CHAIN IS CATALOGED
* UNDER THE *FLAWPF* USER INDEX (377775) TO PREVENT
* REALLOCATION. THE FILE IS NOT LOADED.
*
* * ERROR ON FILE PURGE, FN=NNNNNNN, UI=UUUUUU.*
* THE FILE WAS FOUND IN THE SYSTEM AFTER AN ATTEMPTED
* PURGE WHEN OP=R WAS SECIFIED. THIS INDICATES EITHER
* THAT *PFM* ENCOUNTERED AN ERROR OR THAT A USER
* RECREATED THE FILE AFTER THE PURGE BUT BEFORE *PFLOAD*
* RESET THE UTILITY INTERLOCK ON THE MASTER DEVICE.
* THE FILE IS NOT LOADED.
*
* * FILE LOAD SUPPRESSED BY ERROR OPTION, FN=NNNNNNN,
* UI=UUUUUU.*
* AN ERROR OCCURRED WHEN THE FILE WAS DUMPED AND THE
* *PFLOAD* *EO* OPTION WAS SPECIFIED. THE FILE IS NOT
* LOADED.
*
* * FILE TRUNCATED, FN=NNNNNNN, UI=UUUUUU.*
* THE FILE ON THE ARCHIVE FILE IS TOO SHORT EITHER WITH
* ERROR PADDED EOFS OR A READ ERROR. THE FILE IS
* TRUNCATED AND THE LENGTH IN THE CATALOG IS UPDATED TO
* REFLECT THE SMALLER SIZE.
*
* * INCORRECT FILE NAME/USER INDEX, OOOOOOOOOOOOOOOOOOOO.*
* A FILE WITH AN INCORRECT NAME AND/OR USER INDEX WAS
* ENCOUNTERED. THE FILE NAME (48 BITS) FOLLOWED BY THE
* USER INDEX (18 BITS) ARE SHOWN IN OCTAL. THE ARCHIVE
* FILE IS POSITIONED TO THE NEXT RECORD.
*
* * NO DEVICE FOR FILE ACCESS LEVEL, FN=NNNNNNN, UI=UUUUUU.*
* NONE OF THE DEVICES WHERE THE FILE IS ELIGIBLE TO
* RESIDE HAS SECURITY ACCESS LEVEL LIMITS THAT WILL
* ALLOW THE INDICATED FILE TO RESIDE THERE. THE FILE IS
* NOT LOADED.
*
* * NO SPACE FOR FILE, FN=NNNNNNN, UI=UUUUUU.*
* THE LENGTH OF THE NAMED DIRECT ACCESS FILE WAS GREATER
* THAN THE AMOUNT OF SPACE AVAILABLE ON THE DEVICE THAT
* HAS BEEN SELECTED. IF *OP=L* HAS BEEN SPECIFIED, THIS
* IS THE DEVICE WITH MAXIMUM SPACE OF THOSE WHERE THE
* FILE IS ELIGIBLE TO RESIDE. THE FILE IS NOT LOADED.
SPACE 4,10
*** FATAL ERROR DAYFILE MESSAGES.
*
* SEE *MESSAGE LEGEND* ABOVE FOR A DESCRIPTION OF PARAMETERS
* APPEARING IN THESE MESSAGES.
*
* THESE ERRORS RESULT IN *PFLOAD* BEING ABORTED.
*
* * ARCHIVE FILE LABEL MISSING ON INCREMENTAL LOAD.*
* NO ARCHIVE FILE LABEL WAS FOUND ON THE FIRST ARCHIVE
* FILE OF AN INCREMENTAL LOAD SEQUENCE.
*
* * CATALOG IMAGE FORMAT ERROR.*
* A CATALOG IMAGE RECORD WAS FOUND ON THE ARCHIVE FILE
* BUT IT WAS IN A FORMAT NOT RECOGNIZED BY *PFLOAD*. IT
* IS NOT POSSIBLE TO USE THE BAD ARCHIVE FILE AS THE
* FIRST FILE OF AN INCREMENTAL LOAD. THE BAD ARCHIVE
* FILE CAN BE USED IN A NORMAL LOAD, HOWEVER, BY USING
* THE OMIT OPTION (OP=O) TO SKIP THE CATALOG IMAGE
* RECORD.
*
* * CATALOG READ ERROR, FN=NNNNNNN, UI=UUUUUU.*
* THE INDICATED FILE WAS CATALOGED IN A SECTOR AFFECTED
* BY A MASS STORAGE ERROR.
*
* * CATALOG WRITE ERROR, FN=FFFFFFF, UI=UUUUUU.*
* THE CATALOG INFORMATION FOR THE INDICATED FILE COULD
* NOT BE WRITTEN BECAUSE OF A MASS STORAGE WRITE ERROR.
* ERROR IDLE STATUS IS SET FOR THE MASTER DEVICE IF DATA
* ON THE CATALOG FILE HAS BEEN CORRUPTED.
*
* * DESTINATION DEVICE NOT FOUND.*
* THE DEVICE SPECIFIED ON THE *DD* PARAMETER WAS NOT
* FOUND.
*
* * ERROR IDLE DETECTED, EQ_EEE.*
* AN ERROR IDLE CONDITION HAS BEEN DETECTED ON THE
* INDICATED EQUIPMENT.
*
* * EXTRACT OPTION REQUIRES CIR.*
* THE EXTRACT OPTION WAS SPECIFIED FOR THE LOAD BUT THE
* ARCHIVE FILE DID NOT CONTAIN A CATALOG IMAGE RECORD.
*
* * NO FILES SELECTED.*
* THE FILE SELECTION PARAMETERS SPECIFIED FOR THE LOAD
* WERE SUCH THAT NO DEVICES IN THE SYSTEM COULD CONTAIN
* THE SPECIFIED FILES. THIS MAY BE CAUSED BY
* CONFLICTING SELECTION PARAMETERS.
*
* * PERMIT WRITE ERROR, FN=NNNNNNN, UI=UUUUUU.*
* THE PERMIT INFORMATION FOR THE INDICATED FILE COULD
* NOT BE WRITTEN BECAUSE OF A MASS STORAGE ERROR. ERROR
* IDLE STATUS IS SET FOR THE MASTER DEVICE IF DATA ON
* THE PERMITS FILE HAS BEEN CORRUPTED.
*
* * SELECTED FILES NOT ON ARCHIVE FILE.*
* THE FILES SELECTED FOR LOADING ARE NOT CONTAINED ON
* THE ARCHIVE FILE. THIS WAS DETERMINED FROM
* INFORMATION CONTAINED IN THE ARCHIVE FILE DUMP LABEL.
*
* * SELECTED MASTER OR TRUE DEVICE NOT FOUND.*
* THE DEVICE SPECIFIED WITH THE *DN* OR *TD* PARAMETER
* WAS NOT FOUND.
*
* * TRACK LIMIT, EQ_EEE.*
* A TRACK LIMIT HAS OCCURRED ON THE INDICATED EQUIPMENT.
SPACE 4,10
*** OPERATOR MESSAGES WHICH REQUIRE ACTION.
*
* THE FOLLOWING MESSAGES REQUIRE K-DISPLAY INPUT FOR
* INCREMENTAL LOAD OPERATIONS.
*
* * READ ERROR IN CATALOG IMAGE DM CT.*
* AN ERROR WAS ENCOUNTERED WHILE READING CATALOG IMAGE
* INFORMATION FOR CATALOG TRACK *CT* FOR THE MASTER
* DEVICE WITH MASK *DM*. OPERATOR ENTRY OF *K.GO.* WILL
* CAUSE THE AFFECTED CATALOG TRACK TO BE SKIPPED BUT
* OTHER CATALOG TRACKS TO BE PROCESSED. ENTRY OF
* ANYTHING ELSE WILL CAUSE *PFLOAD* TO ABORT.
*
* *END OF LOAD FILE - SEE RIGHT SCREEN.*
*
* THE END OF AN INCREMENTAL LOAD FILE HAS BEEN
* ENCOUNTERED. THE *K* DISPLAY RIGHT SCREEN DISPLAYS
* THE OPTIONS AVAILABLE TO THE OPERATOR. THESE INCLUDE
* TERMINATION OF THE LOAD, LISTING THE REMAINING FILES
* FROM THE CATALOG IMAGE RECORD, OR SPECIFICATION OF THE
* VSN OF THE NEXT TAPE IN THE INCREMENTAL LOAD SEQUENCE.
COMMON SPACE 4,10
** COMMON DECKS.
*CALL COMCCMD
*CALL COMCDCM
*CALL COMCMAC
QUAL COMSACC
*CALL COMSACC
QUAL *
*CALL COMSCPS
*CALL COMSDSP
*CALL COMSLFD
*CALL COMSLFM
*CALL COMSMLS
*CALL COMSMST
QUAL MTX
*CALL COMSMTX
QUAL *
*CALL COMSPFM
LIST X
*CALL COMSPFS
LIST *
*CALL COMSPFU
*CALL COMSPRD
*CALL COMSRPV
*CALL COMSSFM
*CALL COMSVER
TITLE PROGRAM CONSTANTS.
* PROGRAM CONSTANTS.
NDEV EQU 10B MAXIMUM NUMBER OF MASTER DEVICES ON *CIR*
NWCD EQU 201B NUMBER WORDS/CIR DIRECTORY
* BUFFER LENGTHS.
MBUFL EQU 30061B MAIN BUFFER LENGTH
MXCBS EQU 20 MAXIMUM CATALOG BUFFER SECTOR COUNT
CBUFL EQU 101B*MXCBS+1 CATALOG BUFFER LENGTH
PBUFL EQU 101B*20+1 PERMIT BUFFER LENGTH
DBUFL EQU 6001B DATA BUFFER LENGTH
OUTBL EQU 1001B OUTPUT BUFFER LENGTH
TLBFL EQU /COMSPFS/AFLBL TAPE LABEL BUFFER LENGTH
FLBFL EQU 100B/NWCE*2000 FILE LIST BUFFER LENGTH
FLCBL EQU 1001B FILE LIST CIRCULAR BUFFER LENGTH
CWBFL EQU 1 CONTROL WORD BUFFER LENGTH
MSFBL EQU 10001B *COMCMSF* SORT FILES BUFFER LENGTH
PFLBL EQU 1001B PROCESSED FILES FILE BUFFER LENGTH
SABFL EQU 1000B SUMMARY FILE ASSEMBLY BUFFER LENGTH
SRTBL EQU 20000B SORT BUFFER LENGTH
SSBFL EQU 100B SYSTEM SECTOR BUFFER LENGTH
SUMBL EQU 1001B SUMMARY FILE BUFFER LENGTH
TDBFL EQU 511 TEMPORARY DATA BUFFER LENGTH
CIBFL EQU 3001B CATALOG IMAGE BUFFER LENGTH
CIRTL EQU NWCD*NDEV+1 *CIR* CATALOG TRACK DIRECTORY LENGTH
LBUFL EQU 1001B LIST CIR ENTRIES OUTPUT BUFFER LENGTH
PFMBL EQU NWCE+1 *PFM* CATLIST BUFFER LENGTH
DSPBL EQU 7 *DSP* PARAMETER BLOCK LENGTH
ODEBL EQU 20B OPTICAL DISK EXTENSION BUFFER LENGTH
* MISCELLANEOUS CONSTANTS.
CWSW EQU 5 CONTROL WORD STATUS WORD IN FET
FEDT EQU 1 FILE DATA ERROR CODE
FEPM EQU 2 FILE PERMIT ERROR CODE
DLSS EQU 4 DATA LINKAGE SYSTEM SECTOR CODE
DLEI EQU 2 DATA LINKAGE EOI CODE
DLEF EQU 1 DATA LINKAGE EOF CODE
NCES EQU 100B/NWCE NUMBER OF CATALOG ENTRIES PER SECTOR
* *COMSPFS* EQUIVALENCES.
CPAR EQU /COMSPFS/CPL
IDSA EQU /COMSPFS/PADR
LBWD EQU /COMSPFS/LBWD
* *SETPFP*/*GETPFP* FLAG CONSTANTS.
FMPR EQU 10B FAMILY NAME PARAMETER FLAG
PKPR EQU 4 PACKNAME PARAMETER FLAG
UNPR EQU 2 USER NAME PARAMETER FLAG
UIPR EQU 1 USER INDEX PARAMETER FLAG
TITLE RESERVED LOCATIONS.
ORG /COMSPFS/OVLB
* RESERVED LOCATIONS.
PFLRL BSS 0
ACEA DATA 77000B END OF ARCHIVE FILE CONTROL WORD
AFLI VFD 60/0LPFDUMP ARCHIVE FILE LABEL IDENTIFIER
ANCE CON 0 ADDRESS OF NEW CATALOG ENTRIES
AREF CON 0 ARCHIVE FILE READ ERROR FLAG
BFCA CON 0 BAD FILE CATALOG ADDRESS
CBFO CON 1 CATALOG BUFFER ORDINAL
CCTR CON 0 CURRENT CATALOG TRACK
CEWF CON 0 CATALOG ENTRIES WRITTEN FLAG
CIFC CON 0 *CIR* REMAINING FILE COUNT
CSWC CON 0 CATALOG SECTOR WORD COUNT
DDMA CON 0 DESTINATION DEVICE *MSTT* ADDRESS
EOLF CON 0 END OF LOAD FLAG
FLOF CON 0 FILE LIST OVERFLOW FLAG
FLPT CON 0 FILE LIST POINTER
INCF CON 0 INCREMENTAL LOAD FLAG
IPFF CON 0 INCOMPLETE PERMANENT FILE FLAG
MAEQ CON 0 MASTER DEVICE EST ORDINAL
MMSK CON 0 CURRENT MASTER MASK
NCTR CON 0 NUMBER OF CATALOG TRACKS
PAFL CON 0 *PFU* ACTIVE FLAG
PFCO CON 0 PFC ONLY FLAG
RCWF CON 0 CONTROL WORD RE-USE FLAG
RICT CON 0 RANDOM INDEX COUNTER
SKER CON 0 SKIP TO EOR FLAG
UDAT CON 0 UTILITY CONTROL DATE UPDATE FLAG
TFST BSSZ NCES*MXCBS FILE STATUS TABLE
TITLE MESSAGE CONSTANTS.
* DISPLAYED MESSAGE CONSTANTS.
MSGA DATA 10HLOADING
MSGC DATA 40C PFLOAD DEVICE FAM/PACK
MSGE DATA 10HSKIPPING
MSGH DATA 40HEND OF LOAD FILE - SEE RIGHT SCREEN.
MSGJ DATA 30C SETTING UTILITY INTERLOCK.
MSGK DATA 30C CLEARING UTILITY INTERLOCK.
MSGP DATA 40CENTERED VSN TOO LONG.
MSGQ DATA 40CNO VSN ENTERED.
MSGT DATA 40HINCORRECT OPTION.
MSGV DATA 40CARCHIVE LABEL BAD, SELECT NEW VSN.
MSGW DATA C*$REQUEST K DISPLAY.*
BLNK DATA 40H
SPACE 4,10
* ERROR MESSAGES.
ERAB DATA C* ARCHIVE FILE BLOCK ERROR, FN=???????, UI=!!!!!!.*
ERAL DATA C* ERROR IN ARCHIVE FILE LABEL.*
ERAN DATA C* ALTERNATE DEVICE NOT FOUND, FN=???????, UI=!!!!!!.*
ERAR DATA C* ARCHIVE FILE READ ERROR, FN=???????, UI=!!!!!!.*
ERCR DATA C* CATALOG READ ERROR, FN=???????, UI=!!!!!!.*
ERCW DATA C* CATALOG WRITE ERROR, FN=???????, UI=!!!!!!.*
ERDW DATA C* DATA WRITE ERROR, FN=???????, UI=!!!!!!.*
EREO DATA C* FILE LOAD SUPPRESSED BY ERROR OPTION, FN=???????, UI
,=!!!!!!.*
ERER DATA C* MISSING EOR, FN=???????, UI=!!!!!!.*
ERFT DATA C* FILE TRUNCATED, FN=???????, UI=!!!!!!.*
ERID DATA C* ERROR IDLE DETECTED, FN=???????, UI=!!!!!!.*
ERIN DATA C* INCORRECT NAME/INDEX, FN=???????, UI=!!!!!!.*
ERIS DATA C* ERROR IDLE SET, FN=???????, UI=!!!!!!.*
ERND DATA C* NO DEVICE FOR FILE ACCESS LEVEL, FN=???????, UI=!!!!
,!!.*
ERNE DATA C* NO EOI FOR FILE, FN=???????, UI=!!!!!!.*
ERNS DATA C* NO SPACE FOR FILE, FN=???????, UI=!!!!!!.*
ERPE DATA C* ERROR ON FILE PURGE, FN=???????, UI=!!!!!!.*
ERPW DATA C* PERMIT WRITE ERROR, FN=???????, UI=!!!!!!.*
ERTL DATA C* TRACK LIMIT, FN=???????, UI=!!!!!!.*
SPACE 4,10
* FILE COUNT MESSAGES.
LDMS DATA C* ?????? FILE! LOADED.*
SEMS DATA C* ?????? FILE! SKIPPED WITH ERRORS.*
LEMS DATA C* ?????? FILE! LOADED WITH DATA ERRORS.*
SPACE 4,10
* INFORMATIVE MESSAGES.
AEMS DATA C* READ ERRORS ENCOUNTERED ON ARCHIVE FILE.*
TITLE FETS.
* FETS.
CATS BSS 0 CATALOG TRACKS
ZZZZZG1 FILEB CBUF,CBUFL,FET=10D
PETS BSS 0 PERMIT ENTRIES
ZZZZZG2 FILEB PBUF,PBUFL,FET=10D
DATA BSS 0 FILE DATA
ZZZZZG3 FILEB DBUF,DBUFL,FET=10D
T BSS 0 ARCHIVE FILE
TAPE FILEB MBUF,MBUFL,EPR,FET=14D
ORG TAPE+8
VFD 1/0,1/1,58/0
ORG TAPE+14
ODEB BSSZ ODEBL OPTICAL DISK EXTENSION BUFFER
CIRF BSS 0 CATALOG IMAGE RECORD
ZZZZZG4 RFILEB CIBF,CIBFL,FET=10D
FO BSS 0 FILE LIST OVERFLOW
ZZZZZG5 FILEB FLCB,FLCBL,FET=10D
P BSS 0 PURGE, CATLIST FET FOR OP=R
PURG FILEB PFMB,PFMBL,EPR,FET=13
LCIR BSS 0 OUTPUT
ZZZZZG6 FILEB LBUF,LBUFL,FET=10D
UIFT FILEB 0,0,(FET=10) FET TO CONTROL UTILITY INTERLOCK
UIFL BSSZ 1 UTILITY INTERLOCK FLAG
** NOTE - THE STATUS PORTION OF THE *CATS*, *PETS*, AND *DATA*
* FETS ARE USED IN THE FOLLOWING MANNER.
*
*T, 42/ FILENAME,14/0,1/ C,1/ R,1/ W,1/ F
*
* C = COMPLETION OF LOAD (*DATA*).
* R = FORCED READ - FILL BUFFER (*CATS*).
* W = FORCED WRITE - EMPTY BUFFER (ALL FILES).
* F = *PFU* FINISHED.
TITLE MAIN LOOP.
* MAIN LOOP.
PFL RJ PRS PRESET PROGRAM
* CHECK FOR END OF LOAD.
PFL1 RJ CEL CHECK FOR END OF LOAD
ZR X6,PFL2 IF NOT END OF LOAD
RJ EOL PROCESS END OF LOAD
EQ END TERMINATE
PFL2 RJ PCB PROCESS CATALOG BLOCK
ZR X6,PFL1 IF FILE NOT TO BE LOADED
* CHECK FOR PERMIT ENTRIES.
RJ RCW READ CONTROL WORD
SX1 X1+2
ZR X1,PFL1 IF READ ERROR
SX5 X3-2 BLOCK CODE
SA4 TCBF+FCRI CATALOG PERMIT RANDOM INDEX
LX4 24
MX0 36
BX4 -X0*X4
NZ X5,PFL5 IF NO PERMITS ON ARCHIVE FILE
NZ X4,PFL4 IF PERMIT RANDOM INDEX PRESENT
PFL3 SA1 TCBF+FCUI
SB2 ERAB * ARCHIVE FILE BLOCK ERROR ...*
RJ SFE SEND ERROR MESSAGE
RJ SER SKIP TO END OF RECORD
EQ PFL1 FILE NOT TO BE LOADED
* PROCESS PERMITS.
PFL4 RJ PPB PROCESS PERMIT BLOCK
ZR X6,PFL1 IF FILE NOT TO BE LOADED
EQ PFL6 PROCESS DATA
PFL5 ZR X4,PFL7 IF NO PERMITS IN CATALOG
EQ PFL3 PROCESS ARCHIVE FILE ERROR
* PROCESS DATA.
PFL6 RJ RCW READ CONTROL WORD
PFL7 SA1 PFCO *PFC ONLY* FLAG
NG X3,PFL10 IF PHYSICAL EOR ON ARCHIVE MEDIUM
BX5 X3
SX3 X3-3
BX4 X1+X3
NG X4,PFL8 IF NO DATA BLOCK PRESENT
ZR X4,PFL11 IF DATA PRESENT AND *PFC ONLY*
ZR X3,PFL10 IF DATA PRESENT
PFL8 NZ X1,PFL11 IF NO DATA AND NOT *PFC ONLY*
PFL9 RJ WCE WRITE CATALOG ENTRY
EQ PFL1 CHECK FOR END OF LOAD
PFL10 ZR X1,PFL9 IF PFC ONLY
RJ PDB PROCESS DATA BLOCK
NZ X6,PFL9 IF FILE TO BE LOADED
EQ PFL1 CHECK FOR END OF LOAD
PFL11 NG X5,PFL12 IF ARCHIVE MEDIUM AT EOR/EOF/EOI
RJ SER SKIP TO EOR
PFL12 SA1 TCBF+FCUI
SB2 ERAB * ARCHIVE FILE BLOCK ERROR ...*
RJ SFE SEND ERROR MESSAGE
EQ PFL1 CHECK FOR END OF LOAD
TITLE SUBROUTINES.
APR SPACE 4,15
** APR - ABORT PROCESSOR.
*
* EXIT ANY INCOMPLETE PERMANENT FILE DELETED.
* COMPLETE PERMANENT FILES FLUSHED TO MASS STORAGE.
* UTILITY PROCESSOR DROPPED.
* UTILITY INTERLOCK CLEAR.
* PERMANENT FILE PARAMETERS RESTORED.
* *PFLOAD* SYSTEM FILES RETURNED.
*
* CALLS CIN, DUP, FPF.
*
* MACROS RETURN, SETPFP.
APR SUBR ENTRY/EXIT
RJ FPF FLUSH PERMANENT FILES
RJ DUP DROP UTILITY PROCESSOR
RJ CIN CLEAR UTILITY INTERLOCK
SETPFP GPAR RESTORE PERMANENT FILE PARAMETERS
RETURN CATS RETURN *PFLOAD* SYSTEM FILES
RETURN PETS
RETURN DATA
RETURN CIRF
RETURN FO
EQ APRX RETURN
ADF SPACE 4,20
** ADF - ASSIGN DIRECT ACCESS FILE DEVICE.
*
* ENTRY PFC ENTRY IN *TCBF*.
*
* EXIT (B2) = 0 IF DEVICE ASSIGNED.
* (B2) = ERROR MESSAGE ADDRESS IF NO DEVICE ASSIGNED.
* (X7) = *MSTT* ADDRESS OF DEVICE IF DEVICE ASSIGNED.
* (X7) = *MSTT* ADDRESS OF DEVICE IF NO SPACE FOR FILE
* ERROR AND FILE MUST RESIDE ON ON THAT DEVICE.
* (X7) = 0 IF NO SPACE FOR FILE ERROR AND DEVICE
* SELECTION BY LOAD LEVELING.
*
* USES X - 1, 2, 3, 4, 5, 6, 7.
* A - 1, 2, 3, 4, 5.
* B - 2, 6.
*
* CALLS CAL, RAS, SFD, SRD.
ADF9 SB2 B0+ SET NO ERROR
ADF SUBR ENTRY/EXIT
* CHECK AUXILIARY DEVICE LOAD.
SA2 CPAR+/COMSPFS/CPPN
SA4 TCBF+FCUI GET USER INDEX
SA1 CPAR+/COMSPFS/CPOP GET UTILITY OPTIONS
ZR X2,ADF1 IF NOT AUXILIARY DEVICE LOAD
SA5 MSTT+1 GET DEVICE PARAMETERS
EQ ADF4 CHECK ACCESS LEVEL AND SPACE AVAILABLE
* CHECK LOAD LEVELING OPTION AND SUBFAMILY USER INDEX.
ADF1 SA3 TCBF+FCDN GET DEVICE NUMBER FROM CATALOG
MX6 -3
BX6 -X6*X4 LAST DIGIT OF USER INDEX
BX4 X4-X6
SB6 X6+8-59 SET DAPF MASK SHIFT COUNT
SX4 X4-SBUI
SX2 B0+ SET MASTER DEVICE
ZR X4,ADF2 IF SUBFAMILY USER INDEX
LX3 -36
LX1 59-54
MX6 -6
NG X1,ADF5 IF *OP=L* SPECIFIED
BX2 -X6*X3 DEVICE NUMBER FROM PFC
* SEARCH FOR DEVICE IN CURRENT SYSTEM.
ADF2 RJ SFD SEARCH FOR DEVICE
ZR X1,ADF3 IF DEVICE NOT FOUND
SA5 A1+B1 GET DEVICE PARAMETERS
AX6 X5,B6
ZR X4,ADF4 IF SUBFAMILY USER INDEX, IGNORE DAPF MASK
NG X6,ADF4 IF USER INDEX ALLOWED ON DEVICE
* CHECK DESTINATION DEVICE IF DEVICE FROM PFC NOT FOUND.
ADF3 SA1 DDMA GET DESTINATION DEVICE *MSTT* ADDRESS
ZR X1,ADF7 IF DESTINATION DEVICE NOT SPECIFIED
SA5 X1+B1 GET DEVICE PARAMETERS
AX6 X5,B6
PL X6,ADF7 IF USER INDEX NOT ALLOWED ON DEVICE
* CHECK ACCESS LEVELS AND SPACE ON DEVICE.
ADF4 RJ CAL CHECK ACCESS LEVELS
NG X6,ADF8 IF ACCESS LEVEL ERROR
SX3 B0 SET NO SPACE INCREMENT
RJ RAS RETURN AVAILABLE SPACE
SX7 A5-B1 SET DEVICE POINTER
NZ X1,ADF9 IF SPACE FOR FILE ON DEVICE
EQ ADF6 PROCESS NO SPACE FOR FILE
* PROCESS LOAD LEVELING OPTION.
ADF5 RJ SRD SELECT RESIDENCY DEVICE
SX7 B2 SET DEVICE POINTER
GT B2,B1,ADF9 IF DEVICE FOUND
SX7 B0 CLEAR DEVICE POINTER FOR NO SPACE ERROR
NG B2,ADF7 IF NO DEVICE FOR USER INDEX
ZR B2,ADF8 IF NO DEVICE FOR ACCESS LEVEL
* PROCESS FILE ASSIGNMENT ERRORS.
ADF6 SB2 ERNS * NO SPACE FOR FILE ...*
EQ ADFX RETURN
ADF7 SB2 ERAN * ALTERNATE DEVICE NOT FOUND ...*
EQ ADFX RETURN
ADF8 SB2 ERND * NO DEVICE FOR FILE ...*
EQ ADFX RETURN
AUP SPACE 4,20
** AUP - ACTIVATE UTILITY PROCESSOR.
*
* (PAFL) = 0 IF *PFU* NOT ACTIVE.
* = 1 IF *PFU* ALREADY ACTIVE.
* (MAEQ) = MASTER EQUIPMENT.
* (CPDN) = DEVICE NUMBER.
* (TCBF+FCUI) = USER INDEX TO ACTIVATE *PFU* ON.
*
* EXIT (PAFL) = 1.
* (RICT) = RANDOM INDEX OF *PETS* EOI.
* *PFU* ACTIVATED IF NOT ALREADY ACTIVE.
* *CATS* AND *PETS* FILES SET UP FOR PROCESSING.
*
* USES X - 1, 2, 3, 6, 7.
* A - 1, 2, 3, 6, 7.
*
* CALLS RCT.
*
* MACROS CALLPFU, RECALL.
AUP SUBR ENTRY/EXIT
SA2 PAFL *PFU* ACTIVITY FLAG
SA3 MAEQ
NZ X2,AUPX IF *PFU* ALREADY ACTIVE
SA2 CPAR+/COMSPFS/CPDN
LX3 23-11 SET MASTER EQUIPMENT
BX6 X3
SA1 FAPM SET FET ADDRESS PARAMETER
SA6 DATA+FTDW
LX2 54 SET DEVICE NUMBER
BX7 X2+X1
SA7 CATS+FTPM
SA1 CATS CLEAR FET STATUS FIELDS
SA2 PETS
MX3 42
BX6 X3*X1
SX1 B1 SET *CATS* FET COMPLETE
BX7 X6+X1
SA7 A1
BX6 X3*X2
SA1 DATA
SA6 A2
BX7 X3*X1
SA7 A1
BX6 X6-X6 CLEAR SECTOR COUNTS
SA6 CATS+FTSC
SA6 PETS+FTSC
SA6 DATA+FTSC
SA6 DATA+FTDL CLEAR DATA FILE STATE WORD
CALLPFU CATS,CTLM ACTIVATE *PFU* LOAD PROCESSOR
RECALL DATA WAIT FOR *PFU* TO INITIALIZE
RJ RCT READ CATALOG TRACK
SA1 PETS+FTSC SET PETS RANDOM INDEX
MX2 24
BX6 X2*X1
LX6 -36
SA6 RICT
EQ AUPX RETURN
FAPM VFD 6/0,18/DATA,18/PETS,18/PAFL FET ADDRESS PARAMETER
BFL SPACE 4,30
** BFL - BUILD FILE LIST.
*
* ENTRY (A0) = ADDRESS OF CATALOG SECTOR.
* (X0) = WORD COUNT OF CATALOG SECTOR.
* (CSWC) = WORD COUNT OF CATALOG SECTOR.
* (FLOF) = 0 IF NO FILE LIST OVERFLOW.
* = 1 IF FILE LIST OVERFLOWED TO MASS STORAGE.
* (FLPT) = NEXT AVAILABLE LOCATION IN FILE LIST BUFFER.
* (FLBF) = MEMORY RESIDENT PORTION OF FILE LIST.
*
* EXIT (A0) = LWA+1 OF CATALOG SECTOR.
* (FLOF) = 0 IF NO FILE LIST OVERFLOW.
* = 1 IF FILE LIST OVERFLOWED TO MASS STORAGE.
* (FLPT) = NEXT AVAILABLE LOCATION IN FILE LIST BUFFER.
* (FLBF) = MEMORY RESIDENT PORTION OF FILE LIST.
* FILE NAME AND USER INDEX FOR EACH CATALOG ENTRY IS
* ADDED TO THE FILE LIST.
* OVERFLOW PORTIONS OF THE FILE LIST ARE WRITTEN TO A
* SCRATCH FILE.
* SCRATCH FILE BUFFER IS FLUSHED IF FILE LIST OVERFLOW
* HAS OCCURRED AND THE CATALOG SECTOR IS SHORT.
*
* USES X - 0, 1, 2, 5, 6, 7.
* A - 0, 1, 5, 6, 7.
*
* MACROS WRITE, WRITEW.
BFL SUBR ENTRY/EXIT
BFL1 SX0 X0-NWCE
NG X0,BFL3 IF NO MORE CATALOG ENTRIES
SA5 A0+FCFN+FCUI*0 GET FILE NAME AND USER INDEX
SA1 FLPT
MX6 -18
BX6 -X6*X5 CHECK USER INDEX
ZR X6,BFL2.2 IF CATALOG HOLE
SX6 X6-IFUI
SX2 X1-FLBF-FLBFL
ZR X6,BFL2.2 IF INDIRECT ACCESS FLAW
NG X2,BFL2 IF FILE LIST NOT FULL
SX6 B1+ SET FILE LIST OVERFLOW
SA6 FLOF
WRITEW FO,FLBF+FLBFL-100B,100B WRITE LAST SECTOR OF BUFFER
SA1 FLPT BACK BUFFER POINTER UP ONE SECTOR
SX1 X1-100B
BFL2 SX6 X1+B1 ADVANCE BUFFER POINTER
BX7 X5
SA6 A1 UPDATE BUFFER POINTER
SA7 X1 ENTER FILE IN LIST
BFL2.2 SA0 A0+NWCE ADVANCE CATALOG SECTOR ADDRESS
EQ BFL1 PROCESS NEXT CATALOG ENTRY
BFL3 SX2 A0+NWCE SET POINTER TO END OF SECTOR
IX0 X0+X2
SA0 X0
SA1 CSWC
SX2 X1-100B
ZR X2,BFLX IF NOT SHORT SECTOR
SA1 FLOF
ZR X1,BFLX IF NO FILE LIST OVERFLOW
WRITE FO FLUSH SCRATCH FILE BUFFER
EQ BFLX RETURN
CAL SPACE 4,15
** CAL - CHECK ACCESS LEVELS.
*
* ENTRY (TCBF) = CATALOG ENTRY OF FILE.
* (X5) = SECOND WORD OF *MSTT* ENTRY.
* (A5) = ADDRESS OF SECOND WORD OF *MSTT* ENTRY.
*
* EXIT (X6) .LT. 0 IF THE ACCESS LEVEL OF THE FILE IS NOT
* WITHIN THE DEVICE ACCESS LEVEL LIMITS OF THE
* DEVICE.
* (X5) = SECOND WORD OF *MSTT* TABLE ENTRY.
* (A5) = ADDRESS OF SECOND WORD OF *MSTT* ENTRY.
*
* USES X - 0, 1, 5, 6, 7.
* A - 1.
CAL SUBR ENTRY/EXIT
SA1 SYSS CHECK SECURITY MODE
SX6 B0+ SET NO ERROR
ZR X1,CALX IF NOT SECURE SYSTEM
SA1 TCBF+FCAL GET ACCESS LEVEL OF FILE
MX0 -3
LX5 -30
BX6 -X0*X5 DEVICE ACCESS LEVEL UPPER LIMIT
LX5 -3
LX1 -36
BX7 -X0*X5 DEVICE ACCESS LEVEL LOWER LIMIT
BX1 -X0*X1 FILE ACCESS LEVEL
LX5 33 RESTORE *MSTT* WORD
IX6 X6-X1
NG X6,CALX IF ACCESS LEVEL TOO HIGH FOR DEVICE
IX6 X1-X7 ERROR IF ACCESS LEVEL TOO LOW FOR DEVICE
EQ CALX RETURN
CDE SPACE 4,20
** CDE - CHECK DEVICE ENVIRONMENT.
*
* ENTRY PFC ENTRY IN *TCBF*.
*
* EXIT (B2) = 0 IF NO ERROR.
* (B2) = ERROR MESSAGE ADDRESS IF FILE CANNOT BE LOADED.
* (X7) = PFC ENTRY *FCDN* WORD SET WITH DEVICE NUMBER IF
* NO ERROR.
* (X7) = *MSTT* ADDRESS OF REQUIRED DEVICE IF NO SPACE
* FOR FILE ERROR AND LOAD LEVELING NOT USED.
* (X7) = 0 IF NO SPACE FOR FILE ERROR AND LOAD LEVELING
* USED IN DEVICE SELECTION.
*
* USES X - 1, 2, 5, 6, 7.
* A - 1, 2, 5, 6.
* B - 2.
*
* CALLS ADF, CAL, SFD.
CDE SUBR ENTRY/EXIT
* CHECK MASTER DEVICE ACCESS LEVELS.
SX2 B0 SET MASTER DEVICE SEARCH
RJ SFD SEARCH FOR DEVICE
SA5 A1+B1
RJ CAL CHECK ACCESS LEVEL
SB2 ERND * NO DEVICE FOR FILE ...*
NG X6,CDEX IF MASTER DEVICE ACCESS LEVEL CONFLICT
SA1 TCBF+FCBS CHECK FILE TYPE
SA2 PFCO
LX1 59-11
SX6 B0 SET TO CLEAR DEVICE NUMBER
PL X1,CDE1 IF INDIRECT ACCESS FILE
ZR X2,CDE1 IF *PFC ONLY* FILE
RJ ADF ASSIGN DIRECT ACCESS FILE DEVICE
NZ B2,CDEX IF ERROR IN DEVICE ASSIGNMENT
* CHECK MASTER DEVICE ASSIGNMENT.
SA1 X7+ GET DEVICE NUMBER FROM *MSTT*
SA2 CPAR+/COMSPFS/CPDN MASTER DEVICE NUMBER
MX6 -6
BX6 -X6*X1 DEVICE NUMBER
BX2 X6-X2
NZ X2,CDE1 IF SELECTED DEVICE IS NOT MASTER
SX6 B0 CLEAR DEVICE NUMBER
* SET DEVICE NUMBER IN *FCDN* WORD.
CDE1 SA1 TCBF+FCDN
MX7 -6
LX7 36
LX6 36
BX7 X7*X1
SB2 B0 SET NO ERROR
BX7 X7+X6 MERGE DEVICE NUMBER
EQ CDEX RETURN
CEL SPACE 4,20
** CEL - CHECK FOR END OF LOAD.
*
* ENTRY (SKER) = 0 IF SKIP TO EOR NOT REQUIRED.
* = NON-ZERO IF SKIP TO EOR REQUIRED.
*
* EXIT (X6) = 0 IF NOT END OF LOAD.
* = NON-ZERO IF END OF LOAD.
* (CWBF) = CATALOG CONTROL WORD IF NOT END OF LOAD.
* ARCHIVE FILE TRANSITIONS PERFORMED AS NECESSARY.
* ARCHIVE LABEL PROCESSED IF PRESENT.
*
* USES X - 1, 2, 5, 6, 7.
* A - 1, 2, 6.
* B - 2.
*
* CALLS ART, CIN, DUP, IFL, PAL, RCW, SCI, SER.
*
* MACROS READCW, RECALL, SKIPFF.
CEL SUBR ENTRY/EXIT
* PROCESS FILE SKIP FLAG.
SA1 SKER
ZR X1,CEL1 IF FILE SKIP FLAG NOT SET
BX6 X6-X6 CLEAR FILE SKIP FLAG
SA6 A1
RJ DUP DROP UTILITY PROCESSOR
RJ CIN CLEAR UTILITY INTERLOCK
RJ SER SKIP TO END OF RECORD
* CHECK IF ALL SELECTED FILES HAVE BEEN LOADED.
CEL1 SA1 AFDM GET ARCHIVE FILE DEVICE MASK
SA2 FLSM GET REMAINING FILE SELECTIONS MASK
SA3 CPAR+/COMSPFS/CPDI
SA4 MASK GET ACTIVE DEVICES MASK
BX1 X1*X2
NZ X3,CEL1.1 IF DESTINATION USER INDEX SPECIFIED
BX1 X1*X4
CEL1.1 ZR X1,CEL10 IF LAST ARCHIVE FILE AND NO FILES SELECTED
SA1 /COMSPFS/FISP
SA2 /COMSPFS/NFIS
ZR X1,CEL2 IF NO USER INDEX/FILE NAME SELECTIONS
ZR X2,CEL10 IF ALL SPECIFIED FILES FOUND
CEL2 SA1 INCF
ZR X1,CEL2.1 IF NOT INCREMENTAL LOAD
SA1 CIFC
ZR X1,CEL10 IF END OF CATALOG IMAGE
CEL2.1 SA2 EOLF
ZR X2,CEL3 IF END OF LOAD NOT REACHED
SA2 CPAR+/COMSPFS/CPNB
SB2 X2+
LE B2,B1,CEL9 IF FILE COUNT ONE
CEL2.2 RJ SER SKIP TO END OF RECORD
PL X1,CEL2.2 IF NOT EOF/EOI
EQ CEL7 PROCESS EOF/EOI
* PROCESS NEXT ARCHIVE FILE CONTROL WORD.
CEL3 RJ RCW READ ARCHIVE FILE CONTROL WORD
SX6 X3-1
NZ X7,CEL5 IF READ ERROR
ZR X6,CELX IF CATALOG CONTROL WORD
ZR X3,CEL4 IF LABEL CONTROL WORD
NG X1,CEL7 IF EOF/EOI
NZ X1,CEL3 IF EOR
SA1 CWBF CHECK FOR END OF LOAD
SA2 ACEA
BX6 X1-X2
ZR X6,CEL6 IF END OF ARCHIVE FILE CONTROL WORD
RJ DUP DROP UTILITY PROCESSOR
RJ CIN CLEAR UTILITY INTERLOCK
RJ SER SKIP TO END OF RECORD
EQ CEL3 GET NEXT CONTROL WORD
* PROCESS ARCHIVE FILE LABEL.
CEL4 RJ DUP DROP UTILITY PROCESSOR
RJ CIN CLEAR UTILITY INTERLOCK
SX6 B1+ SET CONTROL WORD RE-USE FLAG
SA6 RCWF
RJ PAL PROCESS ARCHIVE LABEL
ZR X6,CEL8 IF NOT A BAD LABEL
RJ IFL INITIALIZE OUTPUT FILE FOR FILE PROCESSING
SB2 ERAL * ERROR IN ACHIVE FILE LABEL.*
RJ SEM
EQ CEL3 GET NEXT CONTROL WORD
* PROCESS ARCHIVE FILE READ ERROR.
CEL5 RJ DUP DROP UTILITY PROCESSOR
RJ CIN CLEAR UTILITY INTERLOCK
RJ SER SKIP TO END OF RECORD
EQ CEL3 GET NEXT CONTROL WORD
* PROCESS END OF ARCHIVE FILE CONTROL WORD.
CEL6 RECALL TAPE
SA1 X2+B1 REWIND BUFFER
SX6 X1
SA6 A1+B1
SA6 A6+B1
SX6 30B CHECK FOR EOF/EOI ON ARCHIVE FILE
SA1 X2
BX7 X6*X1
BX6 X7-X6
ZR X6,CEL7 IF ARCHIVE FILE AT EOF/EOI
SKIPFF X2,B1,R SKIP TO EOF
* PROCESS MULTIPLE FILE ARCHIVE OPTION.
CEL7 SA1 TAPE
LX1 59-9
NG X1,CEL9 IF ARCHIVE FILE AT EOI
SA1 CPAR+/COMSPFS/CPNB CHECK FILE COUNT
SB2 X1
SX6 B2-B1
LE B2,B1,CEL9 IF NO MORE FILES TO PROCESS
SA6 A1+ SET NEW FILE COUNT
RJ DUP DROP UTILITY PROCESSOR
RJ CIN CLEAR UTILITY INTERLOCK
RJ PSF PROCESS SORTED FILE OUTPUT FOR LAST FILE
READCW TAPE,17B INITIALIZE CONTROL WORD READ
SX6 B0+ CLEAR CONTROL WORD STATUS WORD
SA6 TAPE+CWSW
RJ PAL PROCESS ARCHIVE LABEL
ZR X6,CEL8 IF NOT BAD LABEL
SB2 ERAL * ERROR IN ACHIVE FILE LABEL.*
RJ SEM
RJ SER SKIP TO END OF RECORD
CEL8 RJ SCI SKIP CATALOG IMAGE
RJ IFL INITIALIZE OUTPUT FILE FOR FILE PROCESSING
EQ CEL3 GET NEXT CONTROL WORD
* CHECK INCREMENTAL LOAD STATUS.
CEL9 SA1 INCF
ZR X1,CEL10 IF NOT INCREMENTAL LOAD
SA1 CIFC
ZR X1,CEL10 IF END OF CATALOG IMAGE
RJ PSF PROCESS SORTED FILE OUTPUT
SX6 B0+
SA6 EOLF CLEAR END OF LOAD FLAG ON INCREMENTAL LOAD
SA6 MXDC CLEAR DEVICE POSITION AND CATALOG TRACK
SX6 377B
SA6 AFDM RESET ARCHIVE FILE DUMP MASK
RJ ART ADVANCE INCREMENTAL LOAD
ZR X6,CEL8 IF NOT END OF INCREMENTAL LOAD
* SET END OF LOAD STATUS.
CEL10 SX6 B1 SET END OF LOAD STATUS
EQ CELX RETURN
CIN SPACE 4,15
** CIN - CLEAR PF UTILITY INTERLOCK.
*
* ENTRY (UIFL) = 0 IF UTILITY INTERLOCK NOT SET.
* = 1 IF UTILITY INTERLOCK SET.
* (MAEQ) = EQUIPMENT TO CLEAR INTERLOCK ON.
*
* EXIT (UIFL) = 0.
* *PFU* CALLED TO CLEAR UTILITY INTERLOCK IF NOT ALREADY
* CLEAR.
*
* USES X - 1, 2, 3, 6.
* A - 1, 2, 3, 6.
*
* MACROS CALLPFU, MESSAGE, MOVE.
CIN SUBR ENTRY/EXIT
SA1 UIFL CHECK PF UTILTIY INTERLOCK FLAG
SA2 MAEQ SET MASTER DEVICE EST ORDINAL
ZR X1,CINX IF UTILITY INTERLOCK ALREADY CLEAR
SX1 UIFL SET INTERLOCK FLAG ADDRESS
LX2 48
BX6 X2+X1
SA3 IDSA+/COMSPFS/ADM2 K DISPLAY MESSAGE ADDRESS
SA6 UIFT+FTPM
MOVE 3,MSGK,X3 * CLEARING UTILITY INTERLOCK.*
MESSAGE MSGK,2,R
CALLPFU UIFT,CTCU,R CLEAR PF UTILITY INTERLOCK
SA3 IDSA+/COMSPFS/ADM2 K DISPLAY MESSAGE ADDRESS
MOVE 3,BLNK,X3 CLEAR MESSAGES
MESSAGE (=C**),2,R
EQ CINX RETURN
CSP SPACE 4,20
** CSP - CHECK SELECTION PARAMETERS.
*
* ENTRY (CPAR) = CONVERTED PARAMETER ARRAY.
* (TCBF) = CATALOG ENTRY FOR CURRENT FILE.
*
* EXIT (X6) = 0 IF FILE NOT TO BE LOADED.
* (X6) .NE. 0 IF FILE TO BE LOADED.
* DESTINATION USER INDEX SET IN *TCBF* CATALOG ENTRY IF
* SPECIFIED.
*
* USES X - 0, 1, 2, 3, 4, 6, 7.
* A - 1, 2, 3, 4, 6, 7.
* B - 2, 4.
*
* CALLS CSC.
CSP SUBR ENTRY/EXIT
* CHECK SELECTION CRITERIA.
SB4 TCBF SET PFC ADDRESS
RJ CSC CHECK SELECTION CRITERIA
ZR X6,CSPX IF FILE NOT TO BE LOADED
ZR B6,CSP2 IF NO FILE NAME SELECTION
SA1 CPAR+/COMSPFS/CPOP
SA2 CPAR+/COMSPFS/CPNB
SA3 /COMSPFS/NFIS
SA4 B6+ READ FILE NAME ENTRY
SX6 B1
LX1 59-52
SB4 X2
IX7 X3-X6 DECREMENT FILE SELECTION COUNT
PL X1,CSP1 IF REPLACE OPTION NOT SELECTED
GT B4,B1,CSP2 IF NOT LAST ARCHIVE FILE
CSP1 LX6 17-0
SA7 A3 UPDATE FILE SELECTION COUNT
BX6 X6+X4 SET FILE FOUND FLAG
SA6 B6 WRITE FILE NAME ENTRY
* PROCESS DESTINATION USER INDEX AND DETERMINE IF FILE-S MASTER
* DEVICE SELECTED FOR LOAD.
CSP2 SA1 CPAR+/COMSPFS/CPDI
SA2 TCBF+FCUI
SA3 MASK
MX7 -3
MX0 -1
ZR X1,CSP3 IF DESTINATION USER INDEX NOT SPECIFIED
MX6 42
BX6 X6*X2
BX6 X6+X1 SET DESTINATION INDEX IN CATALOG ENTRY
BX2 X1
SA6 A2+
CSP3 BX2 -X7*X2 USER INDEX BITS 0 - 2
SB2 X2
AX6 X3,B2 SELECT MASK BIT
BX6 -X0*X6
ZR X6,CSPX IF USER INDEX NOT TO BE LOADED
* CHECK TRUE DEVICE SELECTION.
SA1 CPAR+/COMSPFS/CPTD
ZR X1,CSPX IF NO TRUE DEVICE SELECTION
SA2 TMDA+X2
SA3 TCBF+FCDN
SA2 X2+
MX0 -6
LX3 24
BX2 -X0*X2 MASTER DEVICE NUMBER
BX3 -X0*X3 OLD RESIDENCY DEVICE NUMBER
IX2 X2-X1
BX3 X3-X1
ZR X2,CSPX IF FILE CATALOGED ON TRUE DEVICE
ZR X3,CSPX IF FILE RESIDED ON TRUE DEVICE
BX6 X6-X6 SET TO NOT LOAD FILE
EQ CSPX RETURN
DDS SPACE 4,10
** DDS - DELETE DATA SPACE.
*
* ENTRY (*CATS* IN POINTER) = ADDRESS OF CATALOG ENTRY.
*
* EXIT DATA SPACE FOR FILE DELETED.
*
* USES X - 1, 2, 3, 6, 7.
* A - 1, 2, 3, 6, 7.
*
* CALLS FDB, SFD.
DDS SUBR ENTRY/EXIT
RJ FDB FLUSH DATA BUFFER
SA3 CATS+2 CHECK FOR FILE WITH WRITE ERROR
SA1 X3+FCUI
SX6 X1+
SX7 X1-IFUI
ZR X6,DDSX IF WRITE ERROR ON FILE
ZR X7,DDSX IF WRITE ERROR ON FILE
SA1 X3+FCBS+FCBT* SET FIRST TRACK AND SECTOR OF FILE
MX3 -12
BX6 -X3*X1
LX3 12
BX7 X3*X1 CLEAR FIRST TRACK OF FILE
BX3 -X3*X1
LX1 59-11
ZR X3,DDSX IF NO FIRST TRACK
SA7 A1+
PL X1,DDS1 IF INDIRECT ACCESS FILE
SA2 A1+FCDN-FCBT
MX6 -6
LX2 -36
BX2 -X6*X2 SET DEVICE NUMBER
MX6 -9
RJ SFD SEARCH FOR DEVICE
LX1 -6
BX6 -X6*X1 SET EST ORDINAL
SX6 X6+4000B SET *DROP TRACKS* FLAG
DDS1 BX6 X3+X6 PUT PARAMETER IN FET
SA1 DATA SET POSITION REQUEST IN FET
MX3 42
BX7 X3*X1
SA6 DATA+FTPM
SA7 A1
EQ DDSX RETURN
DIF SPACE 4,15
** DIF - DELETE INCOMPLETE FILE.
*
* ENTRY (IPFF) = INCOMPLETE PERMANENT FILE FLAG.
*
* EXIT (IPFF) = 0.
* (*TFST* ENTRY) = 0.
* ANY INCOMPLETE PERMANENT FILE DELETED.
*
* USES X - 1, 6.
* A - 1, 6.
*
* CALLS DDS, DPS.
DIF SUBR ENTRY/EXIT
SA1 IPFF
ZR X1,DIF1 IF NO INCOMPLETE PERMANENT FILE
RJ DDS DELETE DATA SPACE
RJ DPS DELETE PERMIT SPACE
DIF1 SA1 CBFO
SA1 TFST+X1
SX6 B0
SA6 IPFF CLEAR INCOMPLETE FILE FLAG
SA6 A1 CLEAR FILE STATUS
EQ DIFX RETURN
DPS SPACE 4,15
** DPS - DELETE PERMIT SPACE.
*
* ENTRY (*CATS* IN POINTER) = ADDRESS OF CATALOG ENTRY.
*
* EXIT PERMIT SPACE FOR FILE DELETED.
* (RICT) = UPDATED TO REFLECT DELETED PERMITS.
*
* USES X - 1, 3, 6, 7.
* A - 1, 3, 6, 7.
* B - 6, 7.
*
* CALLS FPB, WPR.
*
* MACROS RECALL.
DPS SUBR ENTRY/EXIT
RJ FPB FLUSH PERMIT BUFFER
SA3 CATS+2 GET PERMIT RANDOM INDEX
SA1 X3+FCRI
MX6 24
BX7 X6*X1
ZR X7,DPSX IF NO PERMITS
LX7 -36
SA1 X2 SET POSITION REQUEST IN FET
SA7 RICT UPDATE PERMIT RANDOM INDEX
MX3 42
BX6 X3*X1
SA7 X2+FTPM PUT RANDOM INDEX PARAMETER IN FET
SA6 X2
RECALL X2
SX7 B1+B1 SET EOI CONTROL WORD
SB6 LWRD SET BUFFER ADDRESS
LX7 54
SB7 B1 SET BUFFER WORD COUNT
SA7 B6
RJ WPR WRITE EOI SECTOR
RJ FPB FLUSH PERMIT BUFFER TO FORCE EOI WRITE
EQ DPSX RETURN
DUP SPACE 4,15
** DUP - DROP UTILITY PROCESSOR.
*
* ENTRY (PAFL) = 0 IF *PFU* NOT ACTIVE.
* = 1 IF *PFU* ACTIVE.
*
* EXIT (PAFL) = 0.
* *PFU* DROPPED IF ACTIVE.
* CATALOG PROCESSING COMPLETED.
*
* USES X - 1, 2, 6.
* A - 1, 6.
*
* CALLS FCB.
*
* MACROS RECALL.
DUP SUBR ENTRY/EXIT
SA1 PAFL
ZR X1,DUPX IF *PFU* NOT ACTIVE
RJ FCB FLUSH CATALOG BUFFER
RECALL DATA
SA1 DATA SIGNAL *PFU* TO DROP
MX2 42
BX6 X2*X1
SX1 10B
BX6 X6+X1
SA6 A1
RECALL DATA WAIT FOR *PFU* TO COMPLETE
EQ DUPX RETURN
DWE SPACE 4,40
** DWE - DATA WRITE ERROR PROCESSOR.
*
* ENTRY (DATA+FTPM) = FST ENTRY AT TIME OF ERROR.
* WRITE ERROR DETECTED ON DATA FILE.
*
* EXIT (BFCA) = BAD FILE CATALOG ADDRESS.
*
* IF A WRITE ERROR -
* DATA FOR BAD FILE REMOVED FROM BUFFER.
* (DATA+FTSC) = DECREMENTED BY SECTOR COUNT REMOVED FROM
* BUFFER.
* FILE LENGTH IN CATALOG DECREMENTED BY THE NUMBER OF
* SECTORS - 1 REMOVED FROM BUFFER.
* USER INDEX OF FILE CLEARED FROM CATALOG FOR A DIRECT
* ACCESS FILE AND SET TO A SPECIAL WRITE ERROR USER
* INDEX FOR AN INDIRECT ACCESS FILE.
* DATA WRITE ERROR MESSAGES ISSUED.
* MASS STORAGE SPACE DROPPED FOR A DIRECT ACCESS FILE.
* ERROR STATUS CLEARED FROM FET.
*
* IF A TRACK LIMIT OR ERROR IDLE -
* DATA AND PERMITS FOR UNWRITTEN CATALOG ENTRIES ARE
* PURGED.
* UTILITY PROCESSOR IS DROPPED.
* UTILITY INTERLOCK IS CLEARED.
* TRACK LIMIT OR ERROR IDLE MESSAGES ARE ISSUED.
* MESSAGE IDENTIFYING FIRST FILE NOT LOADED IS ISSUED.
* EXIT TO *ABT* IS TAKEN.
*
* USES X - 1, 2, 3, 6, 7.
* A - 1, 2, 3, 6, 7.
* B - 2.
*
* CALLS CFE, PFD, SEC, SFE.
DWE SUBR ENTRY/EXIT
SA1 DATA GET FET ERROR CODE
MX2 -6
LX1 -12
BX6 -X2*X1
SX2 A1 SAVE FET ADDRESS
SX1 X6-FEWE
ZR X1,DWE0 IF WRITE ERROR WITH DATA TANSFERRED
SX1 X6-FEWN CHECK WRITE ERROR WITH NO DATA TRANSFERRED
NZ X1,DWE3 IF NOT WRITE ERROR
DWE0 SA1 DATA+FTPM
MX7 -9
LX1 12
BX7 -X7*X1 SET EST ORDINAL
SA7 DWEB
* SET BAD FILE CATALOG ADDRESS.
SA1 DATA+3 GET CONTROL WORD FOR BAD SECTOR
SA2 X1
LX2 -36 SET BAD FILE CATALOG ADDRESS
SX6 X2
SA6 BFCA
* REMOVE BAD FILE FROM BUFFER.
SX2 DATA SKIP TO END OF BAD FILE
RJ SEC
SA1 DATA+FTSC ADJUST SECTOR COUNTER
SX3 A0
IX6 X1-X3
SA6 A1
* SET CORRECT CATALOG LENGTH AND USER INDEX.
SA2 BFCA ADJUST CATALOG LENGTH
SX3 A0-B1 LEAVE BAD SECTOR WITH FILE
SA1 X2+FCLF+FCBS*
LX3 36
IX6 X1-X3
SA3 X2+FCUI
LX1 59-11 CHECK FILE TYPE
SA6 A1
MX2 42 CLEAR USER INDEX
BX7 X2*X3
NG X1,DWE2 IF DIRECT ACCESS FILE
SX1 IFUI SET *IAPF* FLAWED SECTOR CHAIN USER INDEX
BX7 X7+X1
DWE2 SA7 A3+
* ISSUE ERROR MESSAGE.
SA2 BFCA
SA1 X2+FCUI
SB2 ERDW * DATA WRITE ERROR ...*
RJ SFE SEND ERROR MESSAGE
RJ CFE COUNT FILE SKIPPED
* DROP DIRECT ACCESS FILE.
SA2 BFCA
SA1 X2+FCBS+FCBT*
LX1 59-11
PL X1,DWEX IF INDIRECT ACCESS FILE
MX7 -12
SA3 DWEB SET BAD EQUIPMENT
BX6 -X7*X1 SET FIRST TRACK OF FILE
LX6 12
SX3 X3+4000B SET *DROP TRACKS* FLAG
BX7 X3+X6
MX2 42
SA7 DATA+FTPM PUT POSITION PARAMETERS IN FET
SA1 DATA SET POSITION FUNCTION IN FET
BX6 X2*X1
SA6 A1
EQ DWEX RETURN
* PROCESS TRACK LIMIT/ERROR IDLE CONDITION.
DWE3 RJ PFD PROCESS FULL DEVICE
SB2 B0 SET NO MESSAGE
EQ ABT ABORT
DWEA CON 0 WRITE ERROR MESSAGE ADDRESS
DWEB CON 0 EST ORDINAL
ECL SPACE 4,10
** ECL - EDIT CATALOG ENTRY FOR LOAD.
*
* ENTRY CATALOG ENTRY IN *TCBF*.
*
* EXIT CATALOG ENTRY FIELDS MODIFIED AS REQUIRED.
*
* USES X - 0, 1, 2, 3, 4, 6, 7.
* A - 1, 2, 3, 4, 6, 7.
ECL SUBR ENTRY/EXIT
* PROCESS UTILITY CONTROL DATE OPTION.
SA1 UDAT FETCH UTLITY CONTROL UPDATE FLAG
ZR X1,ECL1 IF FORCED UPDATE FLAG NOT SET
SA2 TCBF+FCUD
MX0 24
BX6 X0*X2
BX6 X6+X1 SET UTILITY CONTROL DATE
SA6 A2+
* PROCESS OP=Z OPTION.
ECL1 SA1 PFCO FETCH *PFC ONLY* FLAG
ZR X1,ECL2 IF *PFC* ONLY
SA1 CPAR+/COMSPFS/CPOP
BX6 X6-X6
LX1 59-46
PL X1,ECL2 IF *OP=Z* NOT SELECTED
SA6 TCBF+FCAA+FCAT*0+FCAF*0 CLEAR CARTRIDGE POINTERS
SA6 TCBF+FCTV+FCTS*0+FCTF*0 CLEAR TAPE POINTERS
EQ ECLX RETURN
* INITIALIZE ALTERNATE STORAGE FLAGS.
ECL2 SA1 TCBF+FCAF CHECK ALTERNATE STORAGE INFORMATION
SA2 TCBF+FCTF
MX0 -59
BX6 -X0*X1 CLEAR *AFLOK* FLAG
BX7 -X0*X2 CLEAR *TFLOK* FLAG
MX0 -36
BX3 -X0*X1
BX4 -X0*X2
SX0 1
LX1 59-48
LX0 52-0
ZR X3,ECL3 IF NO CARTRIDGE ALTERNATE STORAGE COPY
NG X1,ECL3 IF CARTRIDGE COPY IS OBSOLETE
BX6 X6+X0 SET *AFVER* FLAG
ECL3 ZR X4,ECL4 IF NO TAPE ALTERNATE STORAGE COPY
LX0 48-52
BX7 X7+X0 SET *TFVER* FLAG
ECL4 SA6 TCBF+FCAF SET CARTRIDGE ALTERNATE STORAGE FLAGS
SA7 TCBF+FCTF SET TAPE ALTERNATE STORAGE FLAGS
EQ ECLX RETURN
EFL SPACE 4,20
** EFL - ENTER FILE LIST.
*
* ENTRY (TCBF) = CATALOG ENTRY FOR FILE.
* (FLOF) = 0 IF NO FILE LIST OVERFLOW.
* = 1 IF FILE LIST OVERFLOWED TO MASS STORAGE.
* (FLPT) = NEXT AVAILABLE LOCATION IN FILE LIST BUFFER.
* (FLBF) = MEMORY RESIDENT PORTION OF FILE LIST.
*
* EXIT (FLOF) = 0 IF NO FILE LIST OVERFLOW.
* = 1 IF FILE LIST OVERFLOWED TO MASS STORAGE.
* (FLPT) = NEXT AVAILABLE LOCATION IN FILE LIST BUFFER.
* (FLBF) = MEMORY RESIDENT PORTION OF FILE LIST.
* FILE ADDED TO FILE LIST.
*
* USES X - 1, 2, 6, 7.
* A - 1, 2, 6, 7.
*
* MACROS WRITE, WRITEW.
EFL SUBR ENTRY/EXIT
SA1 FLPT CHECK FOR FULL FILE LIST
SX6 X1-FLBF-FLBFL
NG X6,EFL1 IF FILE LIST NOT FULL
WRITEW FO,FLBF+FLBFL-100B,100B WRITE LAST SECTOR OF BUFFER
WRITE X2
SA1 FLPT BACK LIST POINTER UP ONE SECTOR
SX1 X1-100B
SX6 B1+ SET FILE LIST OVERFLOW
SA6 FLOF
EFL1 SA2 TCBF+FCFN+FCUI* PUT FILE IN FILE LIST
BX7 X2
SA7 X1
SX6 X1+B1 ADVANCE FILE LIST POINTER
SA6 A1
EQ EFLX RETURN
EOL SPACE 4,15
** EOL - END OF LOAD PROCESSOR.
*
* EXIT UTILITY PROCESSOR DROPPED.
* UTILITY INTERLOCK CLEARED.
* LOAD SYSTEM FILES RETURNED.
* ARCHIVE FILE POSITIONED AS APPROPRIATE.
*
* USES X - 1, 3, 6, 7.
* A - 1, 3.
*
* CALLS CIN, DUP, PSF.
*
* MACROS RECALL, RETURN, SKIPFF.
EOL SUBR ENTRY/EXIT
RJ DUP DROP UTILITY PROCESSOR
RJ CIN CLEAR UTILITY INTERLOCK
RJ PSF PROCESS SORTED FILE OUTPUT
RETURN CATS RETURN LOAD SYSTEM FILES
RETURN PETS
RETURN DATA
SETPFP GPAR RESTORE PERMANENT FILE PARAMETERS
RETURN DATA RETURN FILES
RETURN CIRF
RETURN FO
RECALL TAPE POSITION ARCHIVE FILE
SA1 CPAR+/COMSPFS/CPNB
ZR X1,EOLX IF NO FILE COUNT SPECIFIED
SA3 X2 CHECK FOR EOF/EOI ON ARCHIVE FILE
SX6 30B
BX7 X6*X3
BX6 X7-X6
NZ X6,EOL3 IF NOT EOF/EOI
SX1 X1-1
EOL3 ZR X1,EOLX IF NO FILES TO SKIP
SKIPFF X2,X1 SKIP FILES NOT PROCESSED
EQ EOLX RETURN
FCB SPACE 4,40
** FCB - FLUSH CATALOG BUFFER.
*
* ENTRY (CEWF) = 0 IF NO CATALOG ENTRIES IN BUFFER.
* = NON-ZERO IF CATALOG ENTRIES IN BUFFER.
* (CSWC) = CURRENT CATALOG SECTOR WORD COUNT.
*
* EXIT (CBFO) = 0.
* (CEWF) = 0.
* THE FOLLOWING CONDITIONS EXIST IF (CEWF) WAS NON-ZERO.
* (CSWC) = 0.
* (ANCE) = FWA OF CATALOG BUFFER.
* PERMIT BUFFER FLUSHED.
* DATA BUFFER FLUSHED.
* CATALOG BUFFER WRITTEN TO MASS STORAGE.
* CATALOG BUFFER REWOUND.
*
* IF A CATALOG WRITE ERROR IS DETECTED THE UTILITY
* PROCESSOR IS DROPPED, ERROR IDLE STATUS IS SET ON THE
* MASTER EQUIPMENT IF DATA ON THE CATALOG FILE HAS
* BEEN CORRUPTED, THE UTILITY INTERLOCK IS CLEARED,
* CATALOG WRITE ERROR MESSAGES ARE ISSUED AND EXIT IS TO
* *ABT*.
*
* IF A TRACK LIMIT OR ERROR IDLE CONDITION IS DETECTED,
* DATA AND PERMITS FOR UNWRITTEN CATALOG ENTRIES ARE
* PURGED, THE UTILITY PROCESSOR IS DROPPED, THE UTILITY
* INTERLOCK IS CLEARED, TRACK LIMIT OR ERROR IDLE
* MESSAGES ARE ISSUED, THE FIRST FILE NOT LOADED IS
* IDENTIFIED AND EXIT IS TO *ABT*.
*
* USES X - 1, 2, 3, 5, 6, 7.
* A - 1, 2, 3, 6, 7.
*
* CALLS FDB, FPB, LLF, PCE, PFD.
*
* MACROS RECALL.
FCB SUBR ENTRY/EXIT
SA1 CEWF
ZR X1,FCBX IF NO CATALOG ENTRIES IN BUFFER
SA1 CSWC GET SECTOR WORD COUNT
ZR X1,FCB3 IF SECTOR IS EMPTY
* GET SECTOR CONTROL WORD.
SA2 CATS+FTIN
SA3 CATS+FTFT
SX2 X2
SX3 X3
IX6 X2-X1 IN - SECTOR WORD COUNT
IX7 X6-X3
ZR X7,FCB1 IF WRAP AROUND
PL X7,FCB2 IF NO WRAP AROUND
FCB1 SA3 CATS+FTLM
SX3 X3
IX6 X3+X7 LIMIT + COMPLEMENT OF REMAINING COUNT
FCB2 SA2 X6-1 GET SECTOR CONTROL WORD
* INSERT WORD COUNT INTO SECTOR CONTROL WORD.
MX7 48
BX6 X7*X2
IX7 X6+X1
SA7 A2
* INCREMENT BUFFER SECTOR COUNTER.
SA2 CATS+FTSC
SX6 X2+1
SA6 A2+
* FLUSH CATALOG AND ASSOCIATED BUFFERS.
FCB3 RJ FPB FLUSH PERMIT BUFFER
RJ FDB FLUSH DATA BUFFER
SA1 CATS ISSUE WRITE REQUEST
MX2 42
BX7 X2*X1
SX1 B1+B1 SET WRITE FUNCTION CODE
BX6 X7+X1
SA6 A1
RECALL A1 WAIT FOR *PFU* TO FLUSH BUFFER
RJ LLF LIST LOADED FILES
SA1 CATS CHECK ERROR STATUS
MX7 -6
LX1 -12
BX6 -X7*X1
NZ X6,FCB4 IF MASS STORAGE ERROR
SA1 A1+B1 REWIND BUFFER
SX7 X1
SA7 A1+B1
SA7 A7+B1
SA7 ANCE SET ADDRESS OF NEW CATALOG ENTRIES
SA6 CSWC CLEAR SECTOR WORD COUNT
SA6 CATS+FTSC CLEAR SECTOR COUNTER
SA6 CEWF CLEAR *CATALOG ENTRIES WRITTEN*
SA6 CBFO RESET CATALOG BUFFER ORDINAL
EQ FCBX RETURN
* PROCESS CATALOG WRITE ERROR.
FCB4 SX1 X6-FEWE
ZR X1,FCB4.1 IF WRITE ERROR WITH DATA TRANSFERRED
SX1 X6-FEWN CHECK WRITE ERROR WITH NO DATA TRANSFERRED
NZ X1,FCB5 IF NOT WRITE ERROR
FCB4.1 SA2 CATS+FTOT GET BAD SECTOR CONTROL WORD
SA3 CATS+FTPM GET BAD TRACK AND SECTOR ADDRESS
MX6 24
LX3 12 PUT BAD ADDRESS IN CONTROL WORD
SA1 X2
LX6 -12
BX2 X6*X3
BX3 -X6*X1
BX7 X2+X3
SA7 A1
SX6 ERCW * CATALOG WRITE ERROR...*
RJ PCE PROCESS CATALOG WRITE ERROR
SB2 B0 SET NO MESSAGE
EQ ABT ABORT
* PROCESS TRACK LIMIT/ERROR IDLE CONDITION.
FCB5 SX2 CATS
RJ PFD PROCESS FULL DEVICE
SB2 B0 SET NO MESSAGE
EQ ABT ABORT
FDB SPACE 4,10
** FDB - FLUSH DATA BUFFER.
*
* EXIT DATA BUFFER FLUSHED.
* DATA WRITE ERRORS PROCESSED IF NECESSARY.
*
* USES X - 2.
*
* CALLS DWE, FUB.
FDB SUBR ENTRY/EXIT
FDB1 SX2 DATA FLUSH DATA BUFFER
RJ FUB
ZR X6,FDBX IF NO MASS STORAGE ERROR
RJ DWE PROCESS DATA WRITE ERROR
EQ FDB1 FLUSH DATA BUFFER
FPB SPACE 4,20
** FPB - FLUSH PERMIT BUFFER.
*
* EXIT (X2) = PERMIT FET ADDRESS.
* PERMIT BUFFER FLUSHED.
*
* IF A PERMIT WRITE ERROR, TRACK LIMIT ERROR OR ERROR
* IDLE CONDITION IS DETECTED, CLEANUP IS PERFORMED AND
* EXIT IS TO *ABT*.
*
* USES X - 2, 5.
*
* CALLS FUB, PWE.
FPB SUBR ENTRY/EXIT
SX2 PETS FLUSH PERMIT BUFFER
RJ FUB
ZR X6,FPBX IF NO PERMIT WRITE ERROR
RJ PWE PROCESS PERMIT WRITE ERROR
SB2 B0 SET NO MESSAGE
EQ ABT ABORT
FPF SPACE 4,15
** FPF - FLUSH PERMANENT FILES.
*
* ENTRY (UIFL) = UTILITY INTERLOCK STATUS.
* (PAFL) = UTILITY PROCESSOR ACTIVITY FLAG.
*
* EXIT ANY INCOMPLETE PERMANENT FILE DELETED.
* COMPLETE PERMANENT FILES FLUSHED TO MASS STORAGE.
*
* USES X - 1, 2, 6.
* A - 1, 2, 6.
*
* CALLS DIF, SSC.
*
* MACROS CALLPFU, RECALL.
FPF1 RJ DIF DELETE INCOMPLETE FILE
FPF SUBR ENTRY/EXIT
SA1 UIFL CHECK UTILITY INTERLOCK STATUS
SX2 X1-1
NZ X2,FPFX IF UTILITY INTERLOCK NOT SET
SA1 PAFL
NZ X1,FPF1 IF UTILITY PROCESSOR ALREADY ACTIVE
SA1 CATS+2 SET CATALOG WORD COUNT
SA2 A1+B1
IX6 X1-X2
SX1 101B SET SECTOR COUNT
ZR X6,FPFX IF NO CATALOG ENTRIES
IX6 X6/X1
SA6 CATS+FTSC
SX2 PETS SET PERMIT FILE SECTOR COUNTER
RJ SSC
SX2 DATA SET DATA FILE SECTOR COUNTER
RJ SSC
SA1 MAEQ SET MASTER EQUIPMENT AND NON-INITIAL FLAG
SX2 B1
LX1 12
BX6 X1+X2
SA6 DATA+FTDW
SA1 CPAR+/COMSPFS/CPDN SET MASTER DEVICE NUMBER
SA2 FAPM SET FET ADDRESS PARAMETERS
LX1 54
BX6 X1+X2
SA6 CATS+FTPM
SA1 PETS SET PERMITS FET BUSY
MX2 48
BX6 X2*X1
SA6 A1
SA1 DATA SET DATA FET BUSY
BX6 X2*X1
SA6 A1+
CALLPFU CATS,CTLM ACTIVATE UTILITY LOAD PROCESSOR
RECALL DATA WAIT FOR UTILITY PROCESSOR TO INITIALIZE
EQ FPF1 DELETE INCOMPLETE FILE
FUB SPACE 4,20
** FUB - FLUSH UTILITY BUFFER.
*
* ENTRY (X2) = FET ADDRESS.
*
* EXIT (X2) = FET ADDRESS.
* (X6) = 0 IF NO ERROR DETECTED.
* = FET ERROR CODE IF ERROR DETECTED.
* *PFU* WRITE FUNCTION CODE PLACED IN FET IF BUFFER NOT
* EMPTY.
* FET NOT BUSY.
*
* USES X - 1, 3, 6, 7.
* A - 1, 3, 7.
*
* MACROS RECALL.
FUB SUBR ENTRY/EXIT
FUB1 RECALL X2
SA1 X2+2 CHECK FOR EMPTY BUFFER
SA3 A1+B1
IX6 X1-X3
ZR X6,FUBX IF BUFFER EMPTY
SA1 X2 ISSUE WRITE REQUEST
MX7 42
BX6 X7*X1
SX3 B1+B1 SET WRITE FUNCTION CODE
BX7 X6+X3
LX1 -12 GET ERROR STATUS
MX3 -6
BX6 -X3*X1
NZ X6,FUBX IF WRITE ERROR
SA7 X2
EQ FUB1 WAIT FOR *PFU* TO FLUSH BUFFER
IFM SPACE 4,10
** IFM - ISSUE FILE COUNT MESSAGES.
*
* EXIT FILES PROCESSED COUNTS ISSUED TO DAYFILE.
*
* USES X - 1, 5.
* A - 1, 5.
*
* CALLS IFC.
*
* MACROS MESSAGE.
IFM SUBR ENTRY/EXIT
SA1 AREF
ZR X1,IFM1 IF NO ARCHIVE FILE READ ERRORS
MESSAGE AEMS * READ ERRORS ENCOUNTERED ON ARCHIVE...*
IFM1 SA5 IFMA
RJ IFC ISSUE FILE COUNT MESSAGES
EQ IFMX RETURN
IFMA BSS 0 MESSAGE TABLE
VFD 1/1,1/0,22/0,18/LDMS,18/PRFC
VFD 1/1,1/0,22/0,18/SEMS,18/SEFC
VFD 1/1,1/0,22/0,18/LEMS,18/PEFC
CON 0 END OF TABLE
LLF SPACE 4,15
** LLF - LIST LOADED FILES.
*
* EXIT CATALOG DATA WRITTEN TO OUTPUT FILES FOR LOADED FILES
* IN CATALOG BUFFER.
*
* USES X - 1, 2, 3, 4, 5, 6, 7.
* A - 0, 1, 2, 3, 4, 5, 6, 7.
*
* CALLS CFP.
LLF SUBR ENTRY/EXIT
SA3 CATS+FTFT
SX4 -NWCE INITIALIZE SECTOR WORD COUNT
SX5 B0+ INITIALIZE CATALOG ORDINAL
MX6 -18
BX3 -X6*X3 ADDRESS OF FIRST SECTOR CONTROL WORD
LLF1 SA1 CATS+FTOT GET *OUT* POINTER
SX4 NWCE+X4 EXCESS WORDS IN PREVIOUS SECTOR
IX3 X3+X4 LWA+1 OF PREVIOUS SECTOR
IX6 X3-X1
PL X6,LLFX IF NO MORE SECTORS IN BUFFER
SA4 X3 READ SECTOR CONTROL WORD
MX6 -12
BX4 -X6*X4 SECTOR WORD COUNT
SX3 X3+B1 SKIP CONTROL WORD
LLF2 SX4 X4-NWCE DECREMENT SECTOR WORD COUNT
NG X4,LLF1 IF NO MORE CATALOG ENTRIES IN SECTOR
SA1 X3+FCUI GET USER INDEX
SA2 ANCE
MX6 -18
BX6 -X6*X1
IX2 X3-X2
SX3 X3+NWCE ADVANCE CATALOG ENTRY ADDRESS
SX5 X5+1 ADVANCE CATALOG BUFFER ORDINAL
NG X2,LLF2 IF OLD CATALOG ENTRY
ZR X6,LLF2 IF CATALOG HOLE (DATA WRITE ERROR)
SX6 X6-IFUI
ZR X6,LLF2 IF IAPF FLAW (DATA WRITE ERROR)
BX6 X3
BX7 X4
SA6 LLFA SAVE NEXT CATALOG ENTRY ADDRESS
SA7 A6+B1 SAVE SECTOR WORD COUNT
SA1 TFST-1+X5 GET FILE STATUS
SX6 X5
SA6 A7+B1 SAVE CATALOG BUFFER ORDINAL
BX7 X1
SA0 X3-NWCE SET CATALOG ENTRY ADDRESS
SA7 FLST SET FILE STATUS
RJ CFP COUNT FILE PROCESSED
SA3 LLFA RESTORE CATALOG ENTRY ADDRESS
SA4 LLFA+1 RESTORE SECTOR WORD COUNT
SA5 LLFA+2 RESTORE CATALOG BUFFER ORDINAL
EQ LLF2 PROCESS NEXT CATALOG ENTRY
LLFA CON 0 CATALOG ENTRY ADDRESS
CON 0 REMAINING SECTOR WORD COUNT
CON 0 CATALOG BUFFER ORDINAL
MCE SPACE 4,20
** MCE - MOVE CATALOG ENTRY TO BUFFER.
*
* ENTRY (TCBF - TCBF+NWCE-1) = CATALOG ENTRY.
* (*CATS* IN POINTER) = BUFFER ADDRESS FOR CATALOG.
* (IPFF) = INCOMPLETE FILE FLAG.
*
* EXIT ANY INCOMPLETE FILE DELETED.
* CATALOG ENTRY MOVED TO *CATS* BUFFER.
* FIRST TRACK AND PERMIT RANDOM INDEX CLEARED FROM
* CATALOG ENTRY IN *CATS* BUFFER.
* (IPFF) = 1.
*
* USES X - 1, 2, 6, 7.
* A - 1, 2, 6, 7.
* B - 2, 3.
*
* CALLS DIF.
MCE SUBR ENTRY/EXIT
RJ DIF DELETE INCOMPLETE FILE
SA1 CATS+2 BUFFER ADDRESS = IN
SB2 NWCE-1 CATALOG ENTRY WORD COUNT - 1
SB3 TCBF CATALOG ENTRY ADDRESS
MCE1 SA2 B3+B2 GET WORD FROM CATALOG ENTRY
BX6 X2
SA6 X1+B2 STORE WORD IN BUFFER
SB2 B2-B1 DECREMENT WORD COUNT
PL B2,MCE1 IF MORE WORDS TO MOVE
SA2 X1+FCBS
LX2 59-11
PL X2,MCE2 IF NOT DIRECT ACCESS FILE
SX6 B1 INCREMENT FILE LENGTH (DATA SECTORS +1)
SA2 X1+FCLF
LX6 36-0
IX6 X2+X6
SA6 A2+
MCE2 SA2 X1+FCRI CLEAR RANDOM INDEX
MX7 -36
BX6 -X7*X2
SA6 A2
MX7 48
SA2 X1+FCBT CLEAR FIRST TRACK
LX7 12
BX6 X7*X2
SX7 B1 SET INCOMPLETE PERMANENT FILE FLAG
SA6 A2
SA7 IPFF
EQ MCEX RETURN
PAL SPACE 4,25
** PAL - PROCESS ARCHIVE FILE LABEL.
*
* EXIT (X6) = 0 IF ARCHIVE FILE LABEL GOOD OR IF ARCHIVE FILE
* LABEL NOT FOUND AND NOT INCREMENTAL LOAD.
* (X6) .NE. 0 IF ARCHIVE FILE LABEL BAD OR IF ARCHIVE
* FILE LABEL NOT FOUND AND INCREMENTAL LOAD.
* (TLBF+/COMSPFS/PFAL) = 0 IF ARCHIVE FILE LABEL NOT
* PRESENT OR BAD.
* (TLBF - TLBF+/COMSPFS/AFLBL-1) = NEW ARCHIVE FILE
* LABEL IF PRESENT AND GOOD.
* LABEL INFORMATION SET IN OUTPUT FILE HEADER IF LABEL
* PRESENT AND GOOD.
* ARCHIVE FILE INFORMATION BLOCK WRITTEN TO CATALOG
* ENTRIES FILE IF LABEL PRESENT AND GOOD OR LABEL NOT
* FOUND.
* OUTPUT FILE INITIALIZED FOR FILE PROCESSING IF LABEL
* PRESENT AND GOOD OR LABEL NOT FOUND.
*
*
* USES X - 1, 2, 5, 6, 7.
* A - 0, 1, 2, 7.
*
* CALLS PLP, RCW, SER.
*
* MACROS CWREAD, MOVE.
* PROCESS LABEL NOT FOUND.
PAL4 SA2 INCF
SX7 1
NZ X2,PAL2.1 IF INCREMENTAL LOAD
NG X1,PAL5 IF EOF/EOI
NZ X1,PAL1 IF EOR
SA7 RCWF SET CONTROL WORD RE-USE FLAG
PAL5 SA0 B0 SET LABEL NOT FOUND
RJ PLP PROCESS LABEL PARAMETERS
SX6 B0+ CLEAR BAD LABEL STATUS
PAL SUBR ENTRY/EXIT
SX7 B0+ PRESET NO LABEL PRESENT
SA7 TLBF+/COMSPFS/PFAL
PAL1 RJ RCW READ ARCHIVE FILE CONTROL WORD
NZ X7,PAL3 IF READ ERROR
NZ X3,PAL4 IF NOT LABEL CONTROL WORD
SA1 CWBF GET LABEL WORD COUNT
MX2 -9
BX6 -X2*X1
SX1 X6-/COMSPFS/AFLBL
NZ X1,PAL2 IF BAD LABEL WORD COUNT
CWREAD TAPE,TDBF,X6 READ ARCHIVE FILE LABEL
NZ X7,PAL3 IF READ ERROR
NZ X1,PAL2 IF LABEL INCOMPLETE
SA1 TDBF+/COMSPFS/PFAL CHECK LABEL IDENTIFIER
SA2 AFLI
MX6 36
BX1 X6*X1
IX2 X1-X2
NZ X2,PAL2 IF NOT CORRECT LABEL IDENTIFIER
MOVE /COMSPFS/AFLBL,TDBF,TLBF MOVE LABEL TO LABEL BUFFER
SA0 TLBF SET ARCHIVE LABEL ADDRESS
RJ PLP PROCESS ARCHIVE LABEL PARAMETERS
RJ SER SKIP TO END OF RECORD
BX6 X6-X6 CLEAR BAD LABEL STATUS
SA6 EOLF CLEAR END OF LOAD FLAG
EQ PALX RETURN
* PROCESS BAD LABEL.
PAL2 SA2 INCF
NZ X2,PAL2.1 IF INCREMENTAL LOAD
RJ SER SKIP TO END OF RECORD
SA0 B0 SET LABEL NOT FOUND
RJ PLP PROCESS LABEL PARAMETERS
PAL2.1 SX6 B1 SET BAD LABEL STATUS
EQ PALX RETURN
* PROCESS READ ERROR.
PAL3 SA7 AREF INDICATE READ ERROR
RJ SER SKIP TO END OF RECORD
EQ PAL1 READ ARCHIVE FILE CONTROL WORD
PCB SPACE 4,40
** PCB - PROCESS CATALOG BUFFER.
*
* EXIT (X6) = 0 IF FILE NOT TO BE LOADED.
* = 1 IF FILE TO BE LOADED.
* (TCBF) = CATALOG ENTRY FOR CURRENT FILE.
* (MMSK) = UPDATED MASTER DEVICE MASK.
* (NCTR) = UPDATED NUMBER OF CATALOG TRACKS.
* (MAEQ) = UPDATED MASTER EQUIPMENT.
* (CPAR+/COMSPFS/CPDN) = UPDATED MASTER DEVICE NUMBER.
* (SKER) = 1 IF *SKIP TO EOR* REQUIRED.
* (PFCO) = 0 IF *PFC ONLY* FILE.
* (PFCO) .NE. 0 IF NOT *PFC ONLY* FILE.
* MASTER DEVICE SWITCH MADE IF NECESSARY.
* FILES OPENED IF A MASTER DEVICE SWITCH IS MADE.
*
* USES X - 0, 1, 2, 4, 5, 6, 7.
* A - 1, 5, 7.
*
* CALLS CCE, CCI, CDE, CFE, CSP, DFN, ECL, EFL, GCT, MCE, PGF,
* SFE, SFL, SMD, VFN.
*
* MACROS CWREAD, MESSAGE, MOVE.
PCB SUBR ENTRY/EXIT
* CHECK FOR PFC ONLY FILE.
SA1 CWBF FETCH CONTROL WORD
MX0 -3 EXTRACT SUBTYPE
LX0 11-2
BX7 -X0*X1
SA7 PFCO SAVE *PFC ONLY* FLAG
* READ AND VALIDATE CATALOG ENTRY.
MX0 -9
BX5 -X0*X1
CWREAD TAPE,TCBF,X5
NZ X7,PCB10 IF READ ERROR
RJ VFN VALIDATE FILE NAME
PL X3,PCB9 IF FILE NAME NOT VALID
SA1 TCBF+FCUI VALIDATE USER INDEX
SX6 X1+
NG X6,PCB9 IF USER INDEX NOT VALID
* CHECK FORMAT OF CATALOG ENTRY.
SA1 CWBF CHECK SIZE OF CATALOG ENTRY
MX6 -9
BX2 -X6*X1
SX1 X2-NWCE
ZR X1,PCB1 IF CURRENT SIZE
SX4 TCBF
RJ CCE CONVERT CATALOG ENTRY TO CURRENT FORMAT
* PROCESS SELECTION PARAMETERS.
PCB1 SA1 CPAR+/COMSPFS/CPOP
LX1 59-46
PL X1,PCB2 IF *OP=Z* NOT SELECTED
SA1 PFCO
ZR X1,PCB6 IF PFC ONLY FILE
PCB2 RJ CCI CHECK CATALOG IMAGE
NZ X6,PCB6 IF FILE NOT TO BE LOADED
RJ CSP CHECK SELECTION PARAMETERS
ZR X6,PCB6 IF FILE NOT TO BE LOADED
* DETERMINE IF FILE CAN BE LOADED IN CURRENT ENVIRONMENT.
RJ SMD SET MASTER DEVICE PARAMETERS
RJ SFL SEARCH FILE LIST
ZR X6,PCB3 IF FILE ALREADY PRESENT
RJ CDE CHECK DEVICE ENVIRONMENT
ZR B2,PCB5 IF NO ERROR
EQ PCB8 ISSUE ERROR MESSAGE AND SKIP FILE
PCB3 SA1 CPAR+/COMSPFS/CPOP
LX1 59-52
PL X1,PCB9 IF REPLACE OPTION NOT SPECIFIED
RJ CDE CHECK DEVICE ENVIRONMENT
SX6 B2-ERNS
ZR B2,PCB4 IF NO ERROR
NZ X6,PCB8 IF NOT *NO SPACE FOR FILE* ERROR
PCB4 RJ PGF PURGE FILE
NZ B2,PCB8 IF NO SPACE FOR FILE
RJ SFL SEARCH FILE LIST
SB2 ERPE * ERROR ON FILE PURGE ...*
ZR X6,PCB8 IF FILE FOUND AGAIN AFTER PURGE
RJ CDE CHECK DEVICE ENVIRONMENT
NZ B2,PCB8 IF ERROR
* LOAD FILE.
PCB5 SA7 TCBF+FCDN SET DEVICE NUMBER
RJ EFL ENTER FILE IN LIST
SA1 TCBF+FCUI
SA2 MSGA *LOADING ...*
RJ DFN DISPLAY MESSAGE
RJ ECL EDIT CATALOG ENTRY FOR LOAD
RJ MCE MOVE CATALOG ENTRY TO CATALOG BUFFER
SX6 B1 SET LOAD FILE
EQ PCBX RETURN
* DETERMINE IF END OF INDEX LOAD.
PCB6 SA5 MXDC
ZR X5,PCB9 IF NOT SELECTIVE LOAD
SA1 TCBF+FCUI CURRENT USER INDEX
MX2 -3
BX2 -X2*X1 SUBFAMILY INDEX
SA2 SFDT+X2
LX1 -3
SX6 X2 CATALOG TRACK MASK
BX2 -X6*X2 ARCHIVE FILE DEVICE ORDINAL
BX1 X6*X1 CATALOG TRACK
BX6 X2+X1
IX6 X5-X6
PL X6,PCB9 IF NOT PAST USER INDEX-S CATALOG TRACK
SX7 1
SA7 EOLF SET END OF LOAD FLAG
EQ PCB9 SKIP FILE
* ISSUE ERROR MESSAGE AND COUNT FILE NOT LOADED.
PCB8 SA1 TCBF+FCUI SET FILE NAME AND USER INDEX
RJ SFE SEND ERROR MESSAGE
RJ CFE ISSUE MESSAGE AND COUNT FILE NOT LOADED
* SKIP FILE.
PCB9 SX7 B1 SET SKIP TO EOR FLAG
SA7 SKER
SA1 TCBF+FCUI
SA2 MSGE *SKIPPING ...*
RJ DFN DISPLAY MESSAGE
SX6 B0 SET SKIP FILE
EQ PCBX RETURN
* PROCESS READ ERROR.
PCB10 SA7 AREF INDICATE READ ERROR
EQ PCB9 SKIP FILE
PCE SPACE 4,25
** PCE - PROCESS CATALOG ERROR.
*
* ENTRY (X6) = CATALOG READ OR WRITE ERROR MESSAGE ADDRESS.
* (CPAR+/COMSPFS/CPDN) = MASTER DEVICE NUMBER.
* (CCTR) = CURRENT CATALOG TRACK.
* (MAEQ) = MASTER DEVICE EST ORDINAL.
* (*CATS* BUFFER) = CATALOG ENTRIES FOR FILES AFFECTED
* BY THE ERROR. CONTROL WORD FOR
* FIRST SECTOR IN BUFFER CONTAINS
* TRACK AND SECTOR ADDRESS OF THE
* ERROR.
*
* EXIT *PFU* DROPPED.
* IF A WRITE ERROR, ERROR IDLE STATUS IS SET FOR THE
* MASTER EQUIPMENT IF DATA ON THE CATALOG FILE HAS
* BEEN CORRUPTED.
* UTILITY INTERLOCK CLEARED.
* CATALOG ERROR MESSAGES ISSUED.
*
* USES X - 1, 2, 3, 6, 7.
* A - 1, 2, 3, 6, 7.
*
* CALLS CIN, DUP, SEI, SFE.
PCE SUBR ENTRY/EXIT
SA6 PCEB SAVE MESSAGE ADDRESS
* DROP *PFU*.
SX6 B0+ CLEAR *CATALOG ENTRIES WRITTEN*
SA6 CEWF
RJ DUP DROP UTILITY PROCESSOR
* IDENTIFY FAILING DEVICE.
SA1 PCEB ERROR MESSAGE ADDRESS
SX1 X1-ERCW
NZ X1,PCE0.1 IF NOT WRITE ERROR
SA1 CATS GET ERROR CODE FROM FET
MX2 -6
LX1 -12
BX1 -X2*X1 ERROR CODE
SX1 X1-FEWE
NZ X1,PCE0.1 IF DATA NOT TRANSFERRED TO DEVICE
SB2 ELWC * ERROR IDLE SET - PF CATALOG WRITE ...*
RJ SEI SET ERROR IDLE STATUS
PCE0.1 RJ CIN CLEAR UTILITY INTERLOCK
* LIST FILES IN CATALOG BUFFER.
SA2 CATS+3 SET ADDRESS OF FIRST CONTROL WORD
PCE1 SA1 CATS+2 CHECK IF MORE SECTORS IN BUFFER
IX3 X2-X1
MX6 -12
PL X3,PCEX IF NO MORE SECTORS IN BUFFER
SA1 X2 SET SECTOR WORD COUNT
BX3 -X6*X1
SX2 X2+1 SET ADDRESS OF NEXT CATALOG ENTRY
PCE2 SX3 X3-NWCE DECREMENT SECTOR WORD COUNT
NG X3,PCE1 IF END OF CATALOG SECTOR
SA1 X2+FCFN SET FILE NAME AND USER INDEX
SX2 X2+NWCE ADVANCE CATALOG ENTRY ADDRESS
MX7 -18
BX6 -X7*X1 USER INDEX
ZR X6,PCE2 IF CATALOG HOLE
BX6 X2 SAVE CATALOG ENTRY ADDRESS
SA6 PCEA
BX7 X3 SAVE SECTOR WORD COUNT
SA7 A6+B1
SA2 PCEB
SB2 X2 SET ERROR MESSAGE ADDRESS
RJ SFE SEND ERROR MESSAGE
SA2 PCEA RESTORE CATALOG ENTRY ADDRESS
SA3 PCEA+1 RESTORE SECTOR WORD COUNT
EQ PCE2 PROCESS NEXT CATALOG ENTRY
PCEA BSSZ 2 SECTOR ADDRESS AND LENGTH PARAMETERS
PCEB CON 0 ERROR MESSAGE ADDRESS
PDB SPACE 4,20
** PDB - PROCESS DATA BLOCK.
*
* ENTRY (X3) .LT. 0 IF EOR DETECTED ON ARCHIVE FILE.
* .GE. 0 IF EOR NOT DETECTED ON ARCHIVE FILE.
* (*CATS* IN POINTER) = ADDRESS OF CATALOG ENTRY.
*
* EXIT (X6) = 0 IF FILE NOT TO BE LOADED.
* = NON-ZERO IF FILE TO BE LOADED.
* DATA FOR FILE WRITTEN TO MASS STORAGE.
* (SKER) = 1 IF *SKIP TO EOR* REQUIRED.
*
* USES X - ALL.
* A - 1, 2, 3, 4, 6, 7.
* B - 6, 7.
*
* CALLS AFE, CFE, DIF, DWE, RCW, SCE, SFE, WPR.
*
* MACROS CWREAD, RECALL.
PDB SUBR ENTRY/EXIT
* PRESET DATA PROCESSING PARAMETERS.
SA1 TCBF+FCLF SET FILE LENGTH
MX0 -24
SX2 B1 ADJUST LENGTH FOR EOI
LX1 -36
BX6 -X0*X1
IX7 X6+X2
BX5 X5-X5 CLEAR WORD ACCUMULATOR
SA1 TCBF+FCBS CHECK FILE TYPE
SA7 PDBB
BX6 X6-X6 CLEAR *PFU* CONTROL WORD
LX1 59-11
SA6 PDBD CLEAR BUFFER POINTER
SX7 SSBFL INITIALIZE SYSTEM SECTOR LENGTH
SA7 PDBC
PL X1,PDB1 IF INDIRECT ACCESS FILE
* SET DEVICE NUMBER FOR DIRECT ACCESS FILE IN LINKAGE WORD.
SA1 TCBF+FCDN GET DN FROM CATALOG
MX0 -6
LX1 -36
BX6 -X0*X1
LX6 48
NZ X6,PDB1 IF DEVICE SPECIFIED IN CATALOG
SA1 CPAR+/COMSPFS/CPDN SET MASTER DEVICE NUMBER
LX1 48
BX6 X1
NZ X1,PDB1 IF DN SPECIFIED
MX6 1 SET 4000B FOR PACK DAPF DN
PDB1 LX6 24
* SET CATALOG ADDRESS IN LINKAGE WORD.
SA1 CATS+2 GET ADDRESS OF CATALOG ENTRY
LX1 36
BX6 X6+X1
SA6 LWRD
NG X3,PDB13 IF PHYSICAL EOR
EQ PDB3
PDB2 RJ RCW READ CONTROL WORD
NZ X7,PDB25 IF READ ERROR
SX0 X3-3
NZ X0,PDB12 IF NOT DATA TYPE
* BREAK UP CONTROL WORD
PDB3 SA4 CWBF CHECK FOR ERROR CONTROL WORD
SA3 PDBE
MX0 42
BX2 X0*X4
BX2 X2-X3
ZR X2,PDB26 IF ERROR CONTROL WORD
MX0 51
BX1 -X0*X4 SET NUMBER OF WORDS
AX4 9
AX0 6
BX0 -X0*X4 SET DATA MARK
IX5 X5+X1 INCREMENT WORD COUNT
* CHECK FOR SYSTEM SECTOR.
SA3 PDBC GET REMAINING SYSTEM SECTOR LENGTH
SX4 X0-4
BX7 X7-X7
BX6 X4+X3
ZR X6,PDB12 IF SYSTEM SECTOR NOT BOI
ZR X4,PDB4 IF SYSTEM SECTOR
ZR X3,PDB6 IF SYSTEM SECTOR PROCESSING COMPLETED
SX7 X3-SSBFL
ZR X7,PDB5 IF BOI NOT SYSTEM SECTOR
SB2 ERAB * ARCHIVE FILE BLOCK ERROR ...*
EQ PDB27 ISSUE MESSAGE AND SUPPRESS FILE LOAD
PDB4 IX7 X3-X1 DECREMENT REMAINING SYSTEM SECTOR LENGTH
PL X7,PDB5 IF SYSTEM SECTOR NOT TOO LONG
SB2 ERAB * ARCHIVE FILE BLOCK ERROR ...*
EQ PDB27 ISSUE MESSAGE AND SUPPRESS FILE LOAD
* READ FILE DATA INTO BUFFER.
PDB5 SA7 PDBC SAVE REMAINING SYSTEM SECTOR LENGTH
PDB6 ZR X5,PDB8 IF NO WORDS TO READ
SA4 PDBD POINTER TO NEXT AVAILABLE WORD
BX3 -X4
SX3 X3+100B
IX2 X5-X3
PL X2,PDB7 IF NOT ENOUGH SPACE
IX6 X4+X5 NEW POINTER
SA6 A4
CWREAD TAPE,TDBF+X4,X5
NZ X7,PDB25 IF READ ERROR
BX5 X5-X5 CLEAR WORD COUNT
ZR X0,PDB2 IF NO FILE MARK
SX2 X0-4
ZR X2,PDB2 IF FIRST PART OF SPLIT SYSTEM SECTOR
SX0 X0-1
ZR X0,PDB10 IF EOR
SB2 ERAB * ARCHIVE FILE BLOCK ERROR ...*
EQ PDB22 PROCESS ARCHIVE FILE ERROR
* PROCESS BUFFER WITH NOT ENOUGH SPACE AVAILABLE.
PDB7 SX6 B0+ RESET WORDS WRITTEN
SA6 A4
IX5 X5-X3 WORDS LEFT IN MAIN BUFFER
CWREAD TAPE,TDBF+X4,X3
NZ X7,PDB25 IF READ ERROR
SX6 100B
EQ PDB14 PROCESS BLOCK
* PROCESS FILE MARKS.
PDB8 ZR X0,PDB2 IF PLAIN DATA BLOCK
SX2 X0-4
ZR X2,PDB2 IF SYSTEM SECTOR
SX2 X0-1
NZ X2,PDB11 IF NOT EOR
* PROCESS EOR WITH ZERO LENGTH PRU.
SX6 B0+ SET PRU LENGTH TO ZERO
PDB9 BX0 X0-X0 CLEAR DATA MARK
EQ PDB14 PROCESS DATA BLOCK
* PROCESS EOR WITH SHORT PRU.
PDB10 SA1 PDBD SET PRU LENGTH
BX6 X1
BX7 X7-X7 CLEAR WORDS WRITTEN
SA7 A1
EQ PDB14 PROCESS DATA BLOCK
* PROCESS EOF.
PDB11 SX6 DLEF SET EOF INDICATOR
LX6 54
EQ PDB9 CLEAR DATA MARK
* PROCESS EOI.
PDB12 NG X3,PDB13 IF EOI
SB2 ERAB * ARCHIVE FILE BLOCK ERROR ...*
EQ PDB22 PROCESS MISSING EOI
PDB13 SX0 3 SET EOI CONDITION
SX6 DLEI SET EOI INDICATOR
LX6 54
* PROCESS DATA BLOCK
PDB14 SA1 LWRD SET PRU LENGTH
MX2 48
BX2 -X2*X6
SB7 X2+B1
MX2 42
LX2 54
BX1 X2*X1
BX6 X6+X1
SX3 X0-4
ZR X3,PDB15 IF SYSTEM SECTOR
SA1 PDBB DECREMENT LENGTH
SX2 B1
IX7 X1-X2
SX3 X0-3
IX1 X7-X2
PL X1,PDB16 IF MORE LENGTH INDICATED BY CATALOG
ZR X3,PDB17 IF EOI
EQ PDB22 PROCESS FILE TOO LONG
* PROCESS SYSTEM SECTOR.
PDB15 SX1 DLSS SET SYSTEM SECTOR INDICATOR
LX1 54
BX6 X6+X1
BX0 X0-X0 CLEAR DATA MARK
EQ PDB18 WRITE SYSTEM SECTOR TO DATA FILE
* WRITE SECTOR TO DATA FILE.
PDB16 ZR X3,PDB21 IF FILE TOO SHORT
PDB17 SA7 A1 SAVE REMAINING LENGTH
PDB18 SA6 LWRD SAVE DATA LINKAGE WORD
SB6 A6 SET BUFFER ADDRESS
PDB19 SX2 DATA
RJ WPR WRITE SECTOR TO DATA FILE
NZ B7,PDB20 IF WRITE ERROR
SX1 X0-3
NZ X1,PDB6 IF NOT EOI
SX6 B1+ SELECT FILE LOADING
EQ PDBX RETURN
* PROCESS DATA WRITE ERROR.
PDB20 BX6 X0 SAVE ARCHIVE CONTROL WORD PARAMETERS
LX7 X5
SA6 PDBA
SA7 A6+B1
RJ DWE PROCESS DATA WRITE ERROR
SA1 PDBA RESTORE ARCHIVE CONTROL WORD PARAMETERS
SA2 A1+B1
BX0 X1
LX5 X2
SA1 LWRD RESTORE SECTOR WORD COUNT
MX2 -12
BX3 -X2*X1
SB6 A1 RESTORE BUFFER ADDRESS
SA1 BFCA CHECK IF ERROR ON CURRENT FILE
SA2 CATS+2
SB7 X3+B1
BX7 X1-X2
NZ X7,PDB19 IF ERROR NOT ON CURRENT FILE
SA1 PDBB LENGTH NOT WRITTEN TO BUFFER
SA3 X2+FCLF ADJUST CATALOG LENGTH
LX1 36
IX7 X3-X1
SX6 B1 SELECT FILE LOADING
SA7 A3
SA6 SKER SET SKIP TO EOR FLAG
EQ PDBX RETURN
* PROCESS FILE TOO SHORT.
PDB21 SA1 TCBF+FCUI
SB2 ERFT * FILE TRUNCATED ...*
RJ SFE SEND ERROR MESSAGE
EQ PDB24 PROCESS TRUNCATED FILE
* PROCESS ERRORS.
PDB22 SA1 TCBF+FCUI
RJ SFE SEND ERROR MESSAGE
SX6 B1+ SET SKIP TO EOR FLAG
SA6 SKER
PDB24 SA2 PDBB UPDATE LENGTH IN CATALOG
SX1 B1
IX7 X2-X1 ALLOW FOR EOI SECTOR
ZR X7,PDB13 IF NO CATALOG CHANGE
MX6 0
SA6 A2
RECALL DATA WAIT FOR *PFU* COMPLETION
SA1 CATS+2 SET NEW LENGTH IN CATALOG
SA2 X1+FCLF
LX2 24
IX6 X2-X7 NEW FILE LENGTH
LX6 36
SA6 A2
EQ PDB13 FORCE EOI
* PROCESS READ ERROR.
PDB25 SB2 ERAR * ARCHIVE FILE READ ERROR ...*
EQ PDB22 PROCESS ERROR
* PROCESS ERROR CONTROL WORD.
PDB26 SX6 FEDT SET DATA ERROR IN CATALOG
RJ SCE
SA1 CWBF CLEAR CONTROL WORD ERROR FLAGS
MX7 -15
BX6 -X7*X1
LX1 -15 GET ERROR TYPE
MX7 -3
BX2 -X7*X1
SA6 A1
ZR X2,PDB21 IF TRUNCATED FILE ERROR
SA1 CPAR+/COMSPFS/CPEO
NZ X1,PDB27 IF BAD FILE PROCESSING SUPPRESSED
SX7 X2-2
NZ X7,PDB3 IF NOT SUPPRESSED FILE CONTROL WORD
SB2 EREO * FILE LOAD SUPPRESSED BY ERROR ...*
* ISSUE ERROR MESSAGE AND SUPRESS FILE LOAD.
PDB27 SA1 TCBF SET FILE NAME AND USER INDEX
RJ SFE SEND ERROR MESSAGE
RJ CFE COUNT FILE NOT LOADED
RJ DIF DELETE INCOMPLETE FILE
SX7 B1 SET SKIP TO EOR FLAG
BX6 X6-X6 CLEAR LOAD FLAG
SA7 SKER
EQ PDBX RETURN
PDBA BSSZ 2 ARCHIVE CONTROL WORD PARAMETERS
PDBB CON 0 LENGTH ACCUMULATOR
PDBC CON 0 REMAINING SYSTEM SECTOR LENGTH
PDBD CON 0 WORDS WRITTEN
PDBE VFD 42/7HERROR**,18/0
PFD SPACE 4,25
** PFD - PROCESS FULL DEVICE.
*
* ENTRY (X2) = FET ADDRESS OF FILE WITH ERROR.
* (X6) = ERROR CODE.
* ((X2)+FTPM) = FST ENTRY AT TIME OF ERROR.
* (ANCE) = ADDRESS OF NEW CATALOG ENTRIES.
* (*CATS* IN POINTER) = ADDRESS OF FIRST CATALOG SECTOR
* NOT LOADED.
*
* EXIT DATA AND PERMITS FOR UNWRITTEN CATALOG ENTRIES PURGED.
* ERROR MESSAGE ISSUED.
* UTILITY INTERLOCK CLEARED.
*
* USES X - ALL.
* A - 0, 1, 2, 5, 6, 7.
* B - 5, 6, 7.
*
* CALLS CIN, COD, DUP, FUB, SEM, SFD, SSC, WPR.
*
* MACROS RECALL.
PFD SUBR ENTRY/EXIT
* ISSUE ERROR MESSAGE.
SB5 ERTL * TRACK LIMIT ...*
SX1 X6-FETL
ZR X1,PFD1 IF TRACK LIMIT ERROR
SB5 ERID * ERROR IDLE DETECTED ...*
PFD1 SA1 X2+FTPM
MX6 -9
LX1 -48
BX1 -X6*X1 EST ORDINAL OF DEVICE WITH ERROR
RJ COD CONVERT EST ORDINAL
BX1 X4
SB2 1R+
RJ SNM SET EST ORDINAL IN MESSAGE
SB2 B5 SET MESSAGE ADDRESS
RJ SEM SEND ERROR MESSAGE
* PURGE DATA AND PERMITS FOR UNWRITTEN CATALOG ENTRIES.
RECALL DATA
RECALL PETS
SA1 PETS+FTSC SAVE OLD SECTOR COUNTER
SX0 X1+
RJ SSC SET BUFFER SECTOR COUNT
SA1 PETS+FTSC ADJUST SECTOR COUNTER
IX6 X0-X1
SA6 A1
SA1 PETS+FTFT REWIND PERMIT BUFFER
SX6 X1
SA6 A1+B1
SA6 A6+B1
BX4 X4-X4 CLEAR IAPF PROCESSED FLAG
SA0 B0 CLEAR PERMITS PROCESSED FLAG
SB5 B0 CLEAR BLOCK WORD COUNT
SA5 CATS+FTOT GET FWA OF CATALOG ENTRIES
SA2 IPFF
SA1 A5-B1 GET LWA+1 OF CATALOG ENTRIES
SX5 X5-NWCE
BX0 X1
ZR X2,PFD4 IF NO INCOMPLETE FILE
SX0 X0+NWCE INCLUDE INCOMPLETE FILE
PFD4 SX5 X5+NWCE ADVANCE TO NEXT CATALOG ENTRY
GT B5,PFD5 IF NOT END OF CATALOG BLOCK
SB5 100B SET FULL BLOCK WORD COUNT
SX5 X5+1 SKIP CONTROL WORD
PFD5 IX6 X5-X0
SB5 B5-NWCE DECREMENT BLOCK WORD COUNT
MX3 -12
PL X6,PFD10 IF NO MORE CATALOG ENTRIES
SA2 ANCE
SA1 X5+FCUI
IX7 X5-X2
SX6 X1
NG X7,PFD4 IF AN OLD CATALOG ENTRY
SX7 X1-IFUI
ZR X6,PFD7 IF A HOLE
ZR X7,PFD7 IF WRITE ERROR ON FILE
SA1 X5+FCBT+FCBS* GET FIRST TRACK AND SECTOR OF FILE
BX6 -X3*X1
LX3 12
BX7 X3*X1 CLEAR FIRST TRACK OF FILE
BX3 -X3*X1
LX1 59-11
SA7 A1
ZR X3,PFD7 IF NO FIRST TRACK
NG X1,PFD8 IF DIRECT ACCESS FILE
NZ X4,PFD7 IF IAPF FILE ALREADY PROCESSED
SX4 B1+ SET IAPF FILE PROCESSED FLAG
PFD6 BX6 X3+X6 PUT PARAMETERS IN FET
MX3 42
SA6 DATA+FTPM
SA1 DATA PUT POSITION REQUEST IN FET
BX7 X3*X1
SA7 A1
RECALL A1 WAIT FOR POSITIONING TO COMPLETE
PFD7 SA1 X5+FCRI GET PERMIT RANDOM INDEX
MX3 -24
LX1 -36
BX6 -X3*X1
ZR X6,PFD4 IF NO PERMITS
SB7 A0
NZ B7,PFD4 IF PERMITS ALREADY PROCESSED
SA0 B1 SET PERMITS PROCESSED FLAG
MX3 42
SA6 PETS+FTPM PUT RANDOM INDEX PARAMETER IN FET
SA1 PETS SET POSITION REQUEST IN FET
BX7 X3*X1
SB6 LWRD SET BUFFER ADDRESS
SX6 B1+B1 SET EOI CONTROL WORD
SA7 A1
LX6 54
SB7 B1 SET BUFFER WORD COUNT
SA6 B6
SX2 A1 SET PERMITS FET ADDRESS
RJ WPR WRITE EOI SECTOR
RJ FUB FLUSH PERMIT BUFFER
EQ PFD4 PROCESS NEXT CATALOG ENTRY
* PROCESS DIRECT ACCESS FILE.
PFD8 SA1 X5+FCDN GET DEVICE NUMBER FROM CATALOG
MX6 -6
LX1 -36
BX2 -X6*X1
RJ SFD SEARCH FOR DEVICE
LX1 -6 SET EST ORDINAL
MX7 -9
BX7 -X7*X1 EXTRACT EST ORDINAL
SX6 X7+4000B SET *DROP TRACKS* FLAG
EQ PFD6 DROP TRACK CHAIN
* DROP UTILITY PROCESSOR AND UTILITY INTERLOCK.
PFD10 BX6 X6-X6 CLEAR *CATALOG ENTRIES WRITTEN*
SA6 CEWF
RJ DUP DROP UTILITY PROCESSOR
RJ CIN CLEAR UTILITY INTERLOCK
EQ PFDX RETURN
PGF SPACE 4,25
** PGF - PURGE FILE ON REPLACE OPTION.
*
* ENTRY (X6) .NE. 0 IF SPACE AVAILABLE FOR FILE.
* (X6) = 0 IF NO SPACE FOR DIRECT ACCESS FILE.
* (X7) = REQUIRED DEVICE NUMBER IF .NE. 0 AND NO SPACE
* FOR DIRECT ACCESS FILE.
* (X7) = 0 IF LOAD LEVELING USED IN DEVICE SELECTION AND
* NO SPACE FOR DIRECT ACCESS FILE.
*
* EXIT (B2) = 0 IF FILE PURGE ATTEMPTED.
* (B2) = * NO SPACE FOR FILE* MESSAGE ADDRESS IF FILE
* PURGE NOT ATTEMPTED.
* UTILITY INTERLOCK SET AND *PFU* ACTIVE.
*
* USES X - 1, 2, 3, 5, 6, 7.
* A - 1, 2, 3, 5, 6, 7.
* B - 2.
*
* CALLS AUP, CAL, CIN, DUP, RAS, SFD, SIN.
*
* MACROS CATLIST, PURGE, SETPFP.
* REACTIVATE *PFU* AND RETURN NO SPACE FOR FILE ERROR.
PGF5 RJ SIN SET UTILITY INTERLOCK
RJ AUP ACTIVATE *PFU*
SB2 ERNS * NO SPACE FOR FILE ...*
PGF SUBR ENTRY/EXIT
* SAVE ENTRY CONDITIONS AND DROP *PFU*.
SA6 PGFB SAVE NO SPACE STATUS
SA7 A6+1 SAVE DEVICE POINTER
RJ DUP DROP UTILITY PROCESSOR
RJ CIN CLEAR UTILITY INTERLOCK
* SET FILE NAME AND USER INDEX FOR *PFM*.
SA1 TCBF+FCFN GET FILE NAME AND USER INDEX
SA2 PGFA GET CURRENT USER INDEX
MX7 -18
BX6 -X7*X1 USER INDEX
BX7 X7*X1 FILE NAME
IX2 X2-X6
SA7 P+CFPN SET FILE NAME IN FET
ZR X2,PGF1 IF SAME USER INDEX
SA6 PGFA UPDATE CURRENT USER INDEX
SA6 SPAR+2 SET USER INDEX IN *CPM* CALL
SX6 UIPR SET USER INDEX FLAG
SA6 SPAR
SETPFP SPAR SET USER INDEX
* DETERMINE IF PURGE WILL CREATE SUFFICIENT SPACE FOR FILE.
PGF1 SA1 PGFB
NZ X1,PGF4 IF SPACE FOR FILE AVAILABLE
SX6 PFMB SET IN = OUT = FIRST
SA6 P+2
SA6 P+3
CATLIST P GET DEVICE NUMBER AND FILE LENGTH
SA1 P
MX6 -8
AX1 10
BX1 -X6*X1
NZ X1,PGF5 IF ERROR ON CATLIST CALL
SA2 PFMB+FCDN GET DEVICE NUMBER
SA3 PFMB+FCBS+FCLF*0 GET FIRST SECTOR AND LENGTH
MX6 -6
LX2 -36
LX3 59-11
BX2 -X6*X2
PL X3,PGF5 IF INDIRECT ACCESS FILE
RJ SFD SEARCH FOR DEVICE
ZR X1,PGF5 IF DEVICE NOT FOUND
SA2 PGFB+1
SA5 A1+1 GET DEVICE PARAMETERS
ZR X2,PGF2 IF LOAD LEVELING USED TO SELECT DEVICE
SB2 X2
SB2 A1-B2
ZR B2,PGF3 IF SAME DEVICE
EQ PGF5 SET NO SPACE FOR FILE
PGF2 RJ CAL CHECK ACCESS LEVELS
NG X6,PGF5 IF ACCESS LEVEL ERROR
PGF3 MX6 -24
MX7 -12
LX3 -24
LX5 -36
BX3 -X6*X3 FILE LENGTH
SX6 B1+B1
BX1 -X7*X5 DEVICE SECTOR LIMIT
IX3 X3+X6 INCLUDE SYSTEM SECTOR AND EOI IN LENGTH
SX6 X1-1
BX7 X1
IX3 X3+X6
LX5 36 RESTORE DEVICE PARAMETERS
IX3 X3/X7
IX3 X3*X1 SPACE OCCUPIED BY FILE
RJ RAS CHECK SPACE ON DEVICE WITH FILE PURGE
ZR X1,PGF5 IF NO SPACE AVAILABLE
* REQUIRE FILE NOT BUSY TO AVOID PURGING OLD FILE WITHOUT
* CREATING SPACE FOR FILE TO BE LOADED.
SA1 P+CFPN
SX6 SRNB SET NOT BUSY REQUIRED
LX6 12
BX6 X1+X6
SA6 A1+
* PURGE FILE AND REACTIVATE *PFU*. ERROR STATUS IS NOT CHECKED
* SINCE A PURGE FAILURE WILL BE DETECTED BY THE FILE NAME
* REAPPEARING IN THE FILE LIST WHEN *PFU* IS REACTIVATED.
PGF4 PURGE P PURGE FILE
RJ SIN SET UTILITY INTERLOCK
RJ AUP ACTIVATE *PFU*
SB2 B0 SET NO ERROR
EQ PGFX RETURN
PGFA CON 0 CURRENT USER INDEX
PGFB CON 0 NO SPACE FOR FILE STATUS
CON 0 REQUIRED DEVICE POINTER
PPB SPACE 4,30
** PPB - PROCESS PERMIT BLOCK.
*
* ENTRY (CWBF) = PERMIT CONTROL WORD.
* (RICT) = CURRENT PERMIT RANDOM INDEX.
* (*CATS* IN POINTER) = ADDRESS OF CATALOG ENTRY.
*
* EXIT (X6) = 0 IF FILE NOT TO BE LOADED.
* (X6) = 1 IF FILE TO BE LOADED.
* (RICT) = UPDATED PERMIT RANDOM INDEX.
* (SKER) = 1 IF *SKIP TO EOR* REQUIRED.
* CATALOG ENTRY UPDATED WITH RANDOM INDEX OF FIRST
* PERMIT SECTOR.
* PERMIT SECTORS WRITTEN TO *PETS* FILE.
* ARCHIVE FILE POSITIONED AT EOR IF FILE NOT TO BE
* LOADED, OTHERWISE AT FIRST WORD FOLLOWING PERMITS.
*
* IF A PERMIT WRITE ERROR, TRACK LIMIT ERROR OR ERROR
* IDLE CONDITION IS DETECTED, CLEANUP IS PERFORMED AND
* EXIT IS TO *ABT*.
*
* USES X - 0, 1, 2, 3, 5, 6, 7.
* A - 1, 2, 3, 6, 7.
* B - 2, 3, 6, 7.
*
* CALLS CFE, PWE, RCW, SCE, SFE, WPR.
*
* MACROS CWREAD.
PPB SUBR ENTRY/EXIT
SA3 CATS+2 PUT FIRST RANDOM INDEX IN CATALOG
SA1 X3+FCRI
SA2 RICT
MX3 -36
BX7 -X3*X1
LX2 36
BX6 X2+X7
SA6 A1
BX5 X5-X5 CLEAR SECTOR BUFFER WORD COUNT
PPB1 SA1 CWBF SET WORD COUNT OF CONTROL WORD
MX2 -9
BX0 -X2*X1
* FILL PERMIT SECTOR BUFFER.
PPB2 SX1 100B
IX3 X1-X5 REMAINING WORD COUNT OF SECTOR BUFFER
IX2 X0-X3
PL X2,PPB3 IF CONTROL WORD WILL FILL SECTOR BUFFER
BX3 X0 SET TO READ REMAINDER OF CONTROL WORD
PPB3 ZR X3,PPB4 IF NO WORDS TO READ
SB6 TDBF+X5 SET SECTOR BUFFER ADDRESS
IX0 X0-X3 REMAINING WORD COUNT FOR CONTROL WORD
IX5 X5+X3 SECTOR BUFFER WORD COUNT
CWREAD TAPE,B6,X3
NZ X7,PPB5 IF READ ERROR
ZR X1,PPB2 IF CONTROL WORD BLOCK COMPLETE
SB2 ERAB * ARCHIVE BLOCK ERROR ...*
EQ PPB6 PROCESS INCOMPLETE PERMIT BLOCK
* PROCESS END OF CONTROL WORD.
PPB4 NZ X0,PPB10 IF NOT END OF CONTROL WORD
SA1 CWBF GET EOR FLAG
MX2 -3
LX1 -9
BX3 -X2*X1 SET LAST SECTOR FLAG
LX1 -6
BX6 -X2*X1
SB3 X3
NZ X6,PPB8 IF ERROR CONTROL WORD
EQ B3,B1,PPB9 IF EOR FLAG SET IN CONTROL WORD
RJ RCW READ NEXT CONTROL WORD
SX2 X3-2
ZR X2,PPB1 IF A PERMIT CONTROL WORD
* PROCESS ARCHIVE FILE ERROR.
PPB5 SA7 AREF INDICATE READ ERROR
SB2 ERAR * ARCHIVE FILE READ ERROR ...*
PPB6 SA1 CATS+FTIN
SA1 X1+FCUI
RJ SFE SEND ERROR MESSAGE
RJ CFE COUNT FILE NOT LOADED
SX7 B1 SET SKIP TO EOR FLAG
BX6 X6-X6 SELECT NO FILE LOAD
SA7 SKER
EQ PPBX RETURN
* PROCESS EMPTY PERMIT SECTOR.
PPB8 SX6 FEPM SET PERMIT ERROR IN CATALOG
RJ SCE
PPB9 NZ X5,PPB10 IF NOT EMPTY SECTOR
SA3 CATS+2 CLEAR PERMIT RANDOM INDEX FROM CATALOG
SA1 X3+FCRI
MX2 -36
BX7 -X2*X1
SX6 B1 SELECT FILE LOAD
SA7 A1
EQ PPBX RETURN
* WRITE PERMIT SECTOR TO PERMIT FILE.
PPB10 SA1 RICT ADVANCE RANDOM INDEX
SA2 CATS+2 GET CATALOG ADDRESS
SX6 B1
IX7 X1+X6
SB7 X5+B1 SET SECTOR WORD COUNT
SA7 A1
SA1 X2+FCUI GET USER INDEX FROM CATALOG
LX2 36 BUILD SECTOR CONTROL WORD
BX6 X2+X5
LX7 36
MX2 -18
SA6 LWRD
BX1 -X2*X1
ZR X3,PPB11 IF NOT LAST SECTOR
BX7 X7-X7 CLEAR PERMIT LINKAGE RANDOM INDEX
PPB11 LX1 12 GET PERMIT LINKAGE WORD
BX6 X7+X1
SB6 LWRD SET WORKING BUFFER ADDRESS
BX5 X3 SAVE LAST SECTOR FLAG
SX2 PETS SET FET ADDRESS
SA6 B6+B1
RJ WPR WRITE PERMIT SECTOR
NZ B7,PPB12 IF PERMIT WRITE ERROR
ZR X5,PPB2 IF NOT LAST SECTOR
SX6 B1 SELECT FILE LOAD
EQ PPBX RETURN
* PROCESS PERMIT WRITE ERROR.
PPB12 RJ PWE PROCESS PERMIT WRITE ERROR
SB2 B0 SET NO MESSAGE
EQ ABT ABORT LOAD
PWE SPACE 4,35
** PWE - PERMIT WRITE ERROR PROCESSOR.
*
* ENTRY (X6) = FET ERROR CODE.
* (CPAR+COMSPFS/CPDN) = MASTER DEVICE NUMBER.
* (PETS+FTPM) = BAD TRACK AND SECTOR ADDRESS.
* (*PETS* OUT POINTER) = ADDRESS OF CONTROL WORD FOR
* BAD SECTOR.
*
* EXIT *PFU* DROPPED.
*
* IF A WRITE ERROR -
* ERROR IDLE STATUS SET FOR MASTER EQUIPMENT IF DATA
* ON THE PERMITS FILE HAS BEEN CORRUPTED.
* UTILITY INTERLOCK CLEARED.
* PERMIT WRITE ERROR MESSAGES ISSUED.
*
* IF A TRACK LIMIT OR ERROR IDLE -
* DATA AND PERMITS FOR UNWRITTEN CATALOG ENTRIES ARE
* PURGED.
* UTILITY PROCESSOR IS DROPPED.
* UTILITY INTERLOCK IS CLEARED.
* TRACK LIMIT OR ERROR IDLE MESSAGES ARE ISSUED.
* MESSAGE IDENTIFYING FIRST FILE NOT LOADED IS
* ISSUED.
*
* USES X - 1, 2, 6, 7.
* A - 1, 2, 6, 7.
* B - 2.
*
* CALLS CIN, DUP, PFD, SEI, SFE.
* PROCESS TRACK LIMIT/ERROR IDLE CONDITION.
PWE3 SX2 PETS
RJ PFD PROCESS FULL DEVICE
PWE SUBR ENTRY/EXIT
SX1 X6-FEWE
ZR X1,PWE1 IF WRITE ERROR WITH DATA TRANSFERRED
SX1 X6-FEWN CHECK WRITE ERROR WITH NO DATA TRANSFERRED
NZ X1,PWE3 IF NOT WRITE ERROR
* PROCESS WRITE ERROR.
PWE1 SA6 PWEA SAVE ERROR CODE
BX6 X6-X6 CLEAR *CATALOG ENTRIES WRITTEN*
SA6 CEWF
RJ DUP DROP UTILITY PROCESSOR
SA1 PWEA ERROR CODE
SX1 X1-FEWE
NZ X1,PWE2 IF DATA NOT TRANSFERRED TO DEVICE
SB2 ELWP * ERROR IDLE SET - PF PERMITS WRITE ...*
RJ SEI SET ERROR IDLE STATUS
PWE2 RJ CIN CLEAR UTILITY INTERLOCK
* IDENTIFY AFFECTED FILE.
SA2 PETS+3 GET BAD SECTOR CONTROL WORD
SA1 X2
LX1 -36 SET FILE NAME OF BAD FILE
SA1 X1+FCFN+FCUI*
SB2 ERPW * PERMIT WRITE ERROR ...*
RJ SFE SEND ERROR MESSAGE
EQ PWEX RETURN
PWEA BSS 1 FET ERROR CODE
RAS SPACE 4,25
** RAS - RETURN AVAILABLE SPACE.
*
* ENTRY (X5) = SECOND WORD OF *MSTT* ENTRY.
* (A5) = ADDRESS OF SECOND WORD OF *MSTT* ENTRY.
* (X3) = INCREMENT TO ADD TO AVAILABLE SPACE.
* CATALOG ENTRY IN *TCBF*.
*
* EXIT (X1) = 2/0, 3/ST, 31/0, 24/SC IF SUFFICIENT SPACE FOR
* FILE ON DEVICE AND DEVICE IS ACCESSIBLE.
* ST = 7 IF DEVICE *ON* AND NOT SUSPECT.
* = 6 IF DEVICE *ON* AND SUSPECT.
* = 5 IF DEVICE *IDLE* AND NOT SUSPECT.
* = 4 IF DEVICE *IDLE* AND SUSPECT.
* = 2 IF DEVICE *OFF*.
* SC = AVAILABLE SECTOR COUNT ON DEVICE.
* (X1) = 0 IF INSUFFICIENT SPACE FOR FILE ON DEVICE OR
* DEVICE STATE IS *DOWN*.
* (A5) = ADDRESS OF SECOND WORD OF *MSTT* ENTRY.
*
* USES X - 1, 2, 5, 6, 7.
* A - 1, 2, 6, 7.
*
* MACROS SYSTEM.
RAS1 SX1 B0+ SET DEVICE NOT AVAILABLE FOR FILE
RAS SUBR ENTRY/EXIT
LX5 12
MX6 -12
SX1 DALL+1 WORD COUNT FOR READ
BX6 -X6*X5 MST ADDRESS / 10B
LX1 36
LX6 3+18
BX6 X6+X1 MERGE WORD COUNT
SX2 RASB BUFFER ADDRESS
BX6 X6+X2 MERGE BUFFER ADDRESS
MX7 1 SET CMR READ
SA6 RASA SET STATUS WORD
SA7 RASB SET BUFFER CONTROL WORD
SYSTEM RSB,R,A6 READ MST DATA
SA1 RASB+TDGL
SA2 RASB+DALL
MX7 -12
MX6 3
LX6 -2
BX1 -X7*X1 TRACKS AVAILABLE
BX2 X6*X2 DEVICE STATE AND SUSPECT STATUS
LX5 12
IX6 X6-X2 DEVICE STATUS FACTOR
AX2 56
BX7 -X7*X5 SECTOR LIMIT
SX2 X2-DWES
IX1 X1*X7 SECTORS AVAILABLE ON DEVICE
ZR X2,RAS1 IF DEVICE STATE IS *DOWN*
SA2 TCBF+FCLF
IX1 X1+X3 ADD INCREMENT TO AVAILABLE SPACE
MX7 -24
LX2 24
BX2 -X7*X2 LENGTH OF FILE
SX7 B1+B1
IX2 X1-X2
IX2 X2-X7 SUBTRACT SYSTEM SECTOR AND EOI
IX1 X1+X6 MERGE SECTORS AVAILABLE AND STATUS FACTOR
NG X2,RAS1 IF INSUFFICIENT SPACE FOR FILE
EQ RASX RETURN
RASA VFD 12/0,12/DALL+1,18/0,18/RASB *RSB* STATUS WORD
RASB BSSZ DALL+1 MST DATA BUFFER
ERRNG DALL-TDGL CODE DEPENDS ON WORD ORDER
RCT SPACE 4,45
** RCT - READ CATALOG TRACK.
*
* *RCT* POSITIONS THE CATALOG FILE TO THE CURRENT CATALOG
* TRACK, READS THE TRACK AND BUILDS A LIST OF FILES THAT ARE
* CONTAINED ON THE TRACK. THE CATALOG FILE FET AND BUFFER ARE
* LEFT IN A STATE READY TO WRITE ADDITIONAL CATALOG ENTRIES.
*
* ENTRY (CATS+FTCA) = PARAMETERS DEFINING CURRENT CATALOG
* TRACK.
* UTILITY PROCESSOR ACTIVE.
* UTILITY INTERLOCK SET.
*
* EXIT (FLOF) = 0 IF NO FILE LIST OVERFLOW.
* = 1 IF FILE LIST OVERFLOWED TO MASS STORAGE.
* (FLPT) = LWA+1 OF MEMORY RESIDENT PORTION OF FILE
* LIST.
* (FLBF) = MEMORY RESIDENT PORTION OF FILE LIST.
* (CSWC) = WORD COUNT OF CATALOG SECTOR REMAINING IN
* CIRCULAR BUFFER.
* (CEWF) = 0.
* (CATS+FTSC) = 0.
* (ANCE) = FIRST ADDRESS AVAILABLE FOR NEW CATALOG
* ENTRIES.
* (CBFO) = BUFFER ORDINAL FOR NEW CATALOG ENTRIES.
* CIRCULAR BUFFER (STARTING AT FIRST) CONTAINS A *FULL
* SECTOR* CONTROL WORD WITH POSITIONING PARAMETERS
* NECESSARY TO REWRITE THE LAST CATALOG SECTOR. ANY
* CATALOG ENTRIES FROM THE LAST SECTOR FOLLOW THE
* CONTROL WORD.
*
* IF A CATALOG READ ERROR IS DETECTED, THE UTILITY
* PROCESSOR IS DROPPED, ERROR IDLE STATUS IS SET ON THE
* MASTER EQUIPMENT, THE UTILITY INTERLOCK IS CLEARED,
* CATALOG READ ERROR MESSAGES ARE ISSUED AND EXIT IS TO
* *ABT*.
*
* USES X - 0, 1, 2, 3, 5, 6, 7.
* A - 0, 1, 2, 3, 6, 7.
* B - 7.
*
* CALLS BFL, PCE.
*
* MACROS RECALL, REWIND.
RCT SUBR ENTRY/EXIT
* POSITION CATALOG FILE.
SA1 CATS POSITION CATALOG FILE
MX2 42
BX6 X2*X1
SA6 A1
BX7 X7-X7 CLEAR FILE LIST OVERFLOW
SA7 FLOF
SX6 FLBF SET FILE LIST BUFFER EMPTY
SA6 FLPT
SA7 CEWF CLEAR *CATALOG ENTRIES WRITTEN*
RECALL A1+ WAIT FOR POSITION COMPLETE
REWIND FO,R REWIND OVERFLOW SCRATCH FILE
* READ CATALOG TRACK.
RCT1 SA1 CATS+1 REWIND CATALOG BUFFER
SX6 X1
SA6 A1+B1
SA6 A6+B1
SA0 X1 SAVE BUFFER FIRST POINTER
SA1 A1-B1 ISSUE READ REQUEST
MX2 42
BX1 X2*X1
SX7 4 SET READ FUNCTION CODE
BX6 X1+X7
SA6 A1
RECALL A1 WAIT FOR READ TO COMPLETE
RCT2 SA1 CATS+2 CHECK FOR MORE DATA IN BUFFER
SX2 A0
IX6 X2-X1
PL X6,RCT1 IF NO DATA IN BUFFER
SA1 A0 GET SECTOR CONTROL WORD
MX2 -12 EXTRACT WORD COUNT
BX6 -X2*X1
LX2 12 EXTRACT EOF/EOI FLAG
BX7 -X2*X1
LX1 59-49
NZ X7,RCT3 IF NOT EOF/EOI
SX6 B0+ CLEAR SECTOR WORD COUNT
RCT3 SA6 CSWC SAVE SECTOR WORD COUNT
NG X1,RCT5 IF MASS STORAGE ERROR
BX0 X6
SA0 A0+B1
RJ BFL BUILD FILE LIST
SA1 CSWC CHECK FOR SHORT SECTOR
SX6 X1-100B
ZR X6,RCT2 IF NOT SHORT SECTOR
* MOVE LAST SECTOR TO START OF BUFFER.
SA2 CATS+1 DESTINATION ADDRESS = FIRST
SX6 A0-B1 SET ADDRESS OF LAST SECTOR
IX7 X6-X1
SA3 X7 SET FULL SECTOR WORD COUNT IN CONTROL WORD
MX7 48
SX6 100B
BX3 X7*X3
BX7 X3+X6
RCT4 SA7 X2 STORE ONE WORD OF SECTOR
SX2 X2+B1
SA3 A3+B1
BX7 X3
SX1 X1-1
PL X1,RCT4 IF NOT END OF SECTOR
BX6 X2 SET IN POINTER
SA6 A2+B1
SA6 ANCE SET ADDRESS OF NEW CATALOG ENTRIES
SA1 CSWC
SX2 NWCE
IX6 X1/X2 NUMBER OF CATALOG ENTRIES IN SECTOR
SA6 CBFO SET NEXT CATALOG ORDINAL
EQ RCTX RETURN
* PROCESS CATALOG READ ERROR.
RCT5 SX7 A0 OUT = ADDRESS OF CONTROL WORD
SA7 CATS+3
LX1 49-59 SET SECTOR WORD COUNT
MX3 48
BX1 X3*X1
IX2 X7+X6 IN = LWA+1 OF SECTOR
BX6 X1+X6
SX7 X2+B1
SA6 A0+
SA7 A7-B1
SX6 ERCR * CATALOG READ ERROR*
RJ PCE PROCESS CATALOG READ ERROR
SB2 B0 SET NO ERROR
EQ ABT ABORT
RCW SPACE 4,20
** RCW - READ ARCHIVE FILE CONTROL WORD.
*
* ENTRY (RCWF) = 0 IF NEW CONTROL WORD TO BE READ.
* = NON-ZERO IF OLD CONTROL WORD IN *CWBF* TO
* BE USED.
*
* EXIT (X1) = READ STATUS FROM *CWREAD*.
* (X3) = -1 IF EOR/EOF/EOI OR READ ERROR DETECTED.
* = CONTROL WORD CODE, OTHERWISE.
* (X7) = READ ERROR STATUS FROM *CWREAD*.
* (CWBF) = ARCHIVE FILE CONTROL WORD.
* (RCWF) = 0.
* *CWSW* CLEARED FOR ARCHIVE FILE IF EOR WAS DETECTED
* WITHOUT READ ERROR.
*
* USES X - 1, 2, 3, 6, 7.
* A - 1, 2, 6, 7.
*
* MACROS CWREAD.
* PROCESS RE-USED CONTROL WORD.
RCW3 SA2 CWBF UNPACK CONTROL WORD CODE
MX6 -3
BX7 X7-X7 CLEAR ERROR STATUS
LX2 -12
BX1 X1-X1 CLEAR EOR/EOF/EOI STATUS
SA7 A1 CLEAR CONTROL WORD RE-USE FLAG
BX3 -X6*X2
RCW SUBR ENTRY/EXIT
SA1 RCWF
NZ X1,RCW3 IF CONTROL WORD RE-USE FLAG SET
* PROCESS NEW CONTROL WORD.
CWREAD TAPE,CWBF,B1 READ ARCHIVE FILE CONTROL WORD
NZ X7,RCW2 IF READ ERROR
NZ X1,RCW1 IF EOR/EOF/EOI
SA2 B6-B1 UNPACK CONTROL WORD CODE
MX6 -3
LX2 -12
BX3 -X6*X2
EQ RCWX RETURN
* PROCESS EOR/EOF/EOI.
RCW1 SX3 -B1 SET EOR/EOF/EOI/READ ERROR STATUS
NG X1,RCWX IF EOF/EOI
BX6 X6-X6 CLEAR EOR
SA6 TAPE+CWSW
EQ RCWX RETURN
* PROCESS READ ERROR.
RCW2 SA7 AREF INDICATE READ ERROR
SX3 -B1 SET EOR/EOF/EOI/READ ERROR STATUS
EQ RCWX RETURN
RIP SPACE 4,10
** RIP - REPRIEVE INTERRUPT PROCESSOR.
*
* EXIT BUSY FETS SET COMPLETE TO ALLOW TERMINATION
* PROCESSING.
*
* MACROS COMPFET.
RIP SUBR ENTRY/EXIT
COMPFET (CATS,PETS,DATA,CIRF,TAPE,UIFT,FO,O,SU)
EQ RIPX RETURN
SCE SPACE 4,15
** SCE - SET CATALOG ERROR CODE.
*
* ENTRY (X6) = DATA ERROR OR PERMIT ERROR CODE.
* (*CATS* IN POINTER) = ADDRESS OF CATALOG ENTRY.
* (CBFO) = CATALOG BUFFER ORDINAL.
*
* EXIT CATALOG ERROR CODE SET IN CATALOG ENTRY AND IN FILE
* STATUS ENTRY.
*
* USES X - 1, 6, 7.
* A - 1, 6, 7.
SCE SUBR ENTRY/EXIT
SA1 CATS+2
SA1 X1+FCEC GET CURRENT *PFC* ERROR CODE
LX6 42
BX7 X1+X6 MERGE NEW ERROR CODE
LX6 -41
SA7 A1
SA1 CBFO GET CATALOG BUFFER ORDINAL
SA1 TFST+X1 GET FILE STATUS WORD
BX7 X1+X6 MERGE ERROR CODE
SA7 A1
EQ SCEX RETURN
SCI SPACE 4,20
** SCI - SKIP CATALOG IMAGE RECORD.
*
* EXIT (RCWF) = SET IF A CONTROL WORD OTHER THAN FOR A
* CATALOG IMAGE RECORD WAS FOUND BEFORE
* EOF/EOI.
* ARCHIVE FILE POSITIONED FOR PROCESSING FIRST RECORD
* THAT IS NOT A CATALOG IMAGE RECORD. THIS MAY BE AT
* EOF/EOI.
*
* USES X - 5, 6.
* A - 6.
*
* CALLS RCW, SER.
SCI4 SX6 B1+ SET CONTROL WORD RE-USE FLAG
SA6 RCWF
SCI SUBR ENTRY/EXIT
SCI1 RJ RCW READ ARCHIVE FILE CONTROL WORD
SX6 X3-5
ZR X6,SCI3 IF CATALOG IMAGE RECORD
PL X3,SCI4 IF CONTROL WORD AVAILABLE
NZ X7,SCI2 IF READ ERROR
NG X1,SCIX IF EOF/EOI
EQ SCI1 CHECK NEXT RECORD
* SKIP TO END OF RECORD.
SCI2 SA7 AREF INDICATE READ ERROR
SCI3 RJ SER SKIP TO END OF RECORD
EQ SCI1 CHECK NEXT RECORD
SEC SPACE 4,15
** SEC - SKIP THROUGH EOI CONTROL WORD.
*
* ENTRY (X2) = FET ADDRESS.
*
* EXIT (X2) = FET ADDRESS.
* (A0) = SECTOR COUNT SKIPPED.
* *CIO* EOR STATUS SET IN FET.
* DATA READ FROM BUFFER UNTIL AN EOI SECTOR IS READ OR
* UNTIL BUFFER IS EMPTY.
*
* USES X - 0, 5, 6.
* A - 0, 5, 6.
*
* MACROS READW, RECALL.
SEC3 SX5 X5-2
NZ X5,SEC1 IF NOT EOI CONTROL WORD
SEC SUBR ENTRY/EXIT
RECALL X2 SET EOR STATUS IN FET
SA5 X2
MX6 42
SX0 23B
BX5 X6*X5
BX6 X5+X0
SA0 B0 CLEAR SECTOR COUNT
SA6 A5
SEC1 READW X2,SECA,B1 READ CONTROL WORD
NZ X1,SECX IF BUFFER EMPTY
SA5 SECA GET SECTOR WORD COUNT
MX6 -12
BX0 -X6*X5
AX5 54 GET CONTROL WORD TYPE
SA0 A0+B1 INCREMENT SECTOR COUNT
SEC2 ZR X0,SEC3 IF END OF SECTOR
READW X2,SECA,B1 READ ONE WORD OF SECTOR
NZ X1,SECX IF BUFFER EMPTY
SX0 X0-1
EQ SEC2 CHECK FOR END OF SECTOR
SECA CON 0 SCRATCH BUFFER
SER SPACE 4,10
** SER - SKIP TO END OF RECORD.
*
* EXIT ARCHIVE FILE POSITIONED AT EOR/EOF/EOI.
* *CWSW* CLEARED FOR ARCHIVE FILE IF NOT EOF/EOI.
* (X1) .LT. 0 IF EOF/EOI.
*
* USES X - 2, 5, 6, 7.
* A - 2, 6.
*
* MACROS CWREAD.
SER SUBR ENTRY/EXIT
SER1 CWREAD TAPE,TDBF,TDBFL
ZR X7,SER2 IF NO READ ERROR
SA7 AREF INDICATE READ ERROR
ZR B7,SER1 IF TRANSFER COMPLETE
SER2 ZR X1,SER1 IF NOT EOR/EOF/EOI
NG X1,SERX IF EOF/EOI
SX6 B0+ CLEAR EOR
SA6 TAPE+CWSW
EQ SERX RETURN
SFD SPACE 4,15
** SFD - SEARCH FOR DEVICE.
*
* ENTRY (X2) = DEVICE NUMBER TO SEARCH FOR IF .NE. 0.
* (X2) = 0 IF SEARCH FOR MASTER DEVICE.
* (CPAR+/COMSPFS/CPDN) = MASTER DEVICE NUMBER.
*
* EXIT (A1) = ADDRESS OF FIRST WORD OF DEVICE-S *MSTT* ENTRY.
* (X1) = FIRST WORD OF DEVICE-S ENTRY.
* (X1) = 0 IF DEVICE NOT FOUND IN TABLE.
*
* USES X - 0, 1, 2, 7.
* A - 1, 2.
* B - 7.
SFD SUBR ENTRY/EXIT
MX0 -6
SB7 MSTT
NZ X2,SFD1 IF NOT MASTER DEVICE SEARCH
SA2 CPAR+/COMSPFS/CPDN GET MASTER DEVICE NUMBER
SFD1 SA1 B7+ READ NEXT TABLE ENTRY
ZR X1,SFDX IF END OF TABLE
SB7 B7+2 ADVANCE TABLE ADDRESS
BX7 -X0*X1
IX7 X2-X7
NZ X7,SFD1 IF NOT MATCHING DEVICE
EQ SFDX RETURN
SFL SPACE 4,15
** SFL - SEARCH FILE LIST.
*
* ENTRY (TCBF) = CATALOG ENTRY FOR FILE.
* (FLOF) = 0 IF NO FILE LIST OVERFLOW.
* = 1 IF FILE LIST OVERFLOWED TO MASS STORAGE.
* (FLPT) = NEXT AVAILABLE LOCATION IN FILE LIST BUFFER.
* (FLBF) = MEMORY RESIDENT PORTION OF FILE LIST.
*
* EXIT (X6) = 0 IF FILE IN LIST.
* (X6) .NE. 0 IF FILE NOT IN LIST.
*
* USES X - 0, 1, 2, 3, 5, 6.
* A - 1, 2, 3.
*
* MACROS READ, READW, REWIND.
SFL5 SX6 B1+ SET FILE NOT FOUND
SFL SUBR ENTRY/EXIT
* CHECK FOR PRIVATE AUXILIARY DEVICE.
SA1 CPAR+/COMSPFS/CPPN
SA2 CPAR+/COMSPFS/CPUN
MX5 60 SET TO CHECK FILE NAME AND USER INDEX
ZR X1,SFL1 IF NOT AUXILIARY DEVICE
ZR X2,SFL1 IF NOT PRIVATE DEVICE
MX5 42 SET TO CHECK FILE NAME ONLY
* SEARCH MEMORY RESIDENT PORTION OF FILE LIST.
SFL1 SA1 TCBF+FCFN+FCUI*0 GET FILE NAME AND USER INDEX
SA2 FLPT LWA+1 OF FILE LIST
SX0 FLBF FWA OF FILE LIST
SFL2 IX6 X0-X2
PL X6,SFL3 IF NO MORE ENTRIES IN LIST
SA3 X0 COMPARE FILE NAME AND USER INDEX
BX6 X3-X1
BX6 X5*X6
SX0 X0+1 ADVANCE FILE LIST BUFFER ADDRESS
ZR X6,SFLX IF MATCHING ENTRY
EQ SFL2 CHECK NEXT ENTRY
* SEARCH SCRATCH FILE PORTION OF FILE LIST.
SFL3 SA3 FLOF
ZR X3,SFL5 IF NO FILE LIST OVERFLOW
REWIND FO START SCRATCH FILE READ
READ FO
SFL4 READW FO,SFLA,1 GET NEXT FILE LIST ENTRY
NZ X1,SFL5 IF END OF SCRATCH FILE
SA1 TCBF+FCFN+FCUI* COMPARE FILE NAME AND USER INDEX
SA2 SFLA
BX6 X1-X2
BX6 X5*X6
ZR X6,SFLX IF MATCHING ENTRY
EQ SFL4 CHECK NEXT ENTRY
SFLA CON 0 FILE LIST ENTRY SCRATCH WORD
SIN SPACE 4,15
** SIN - SET PF UTILITY INTERLOCK.
*
* ENTRY (UIFL) = UTILITY INTERLOCK FLAG.
* (MAEQ) = EQUIPMENT TO SET INTERLOCK ON.
*
* EXIT (UIFL) = 1.
* *PFU* CALLED TO SET UTILITY INTERLOCK IF NOT ALREADY
* SET.
*
* USES X - 1, 2, 3, 6.
* A - 1, 2, 3, 6.
*
* MACROS CALLPFU, MESSAGE, MOVE.
SIN SUBR ENTRY/EXIT
SA1 UIFL
NZ X1,SINX IF UTILITY INTERLOCK ALREADY SET
SA2 MAEQ SET MASTER DEVICE EST ORDINAL
SX1 UIFL SET INTERLOCK FLAG ADDRESS
LX2 48
BX6 X2+X1
SA3 IDSA+/COMSPFS/ADM2 K DISPLAY MESSAGE ADDRESS
SA6 UIFT+FTPM
MOVE 3,MSGJ,X3 * SETTING UTILITY INTERLOCK.*
MESSAGE MSGJ,2,R
CALLPFU UIFT,CTSU,R SET PF UTILITY INTERLOCK
SA3 IDSA+/COMSPFS/ADM2 K DISPLAY MESSAGE ADDRESS
MOVE 3,BLNK,X3 CLEAR MESSAGES
MESSAGE (=C**),2,R
EQ SINX RETURN
SMD SPACE 4,30
** SMD - SET MASTER DEVICE PARAMETERS.
*
* ENTRY (TCBF) = CURRENT CATALOG ENTRY.
* (MMSK) = CURRENT MASTER DEVICE MASK.
* (NCTR) = CURRENT NUMBER OF CATALOG TRACKS.
* (CCTR) = CURRENT CATALOG TRACK.
*
* EXIT (MMSK) = UPDATED MASTER DEVICE MASK.
* (NCTR) = UPDATED NUMBER OF CATALOG TRACKS.
* (CCTR) = UPDATED CURRENT CATALOG TRACK.
* (MAEQ) = UPDATED MASTER EQUIPMENT.
* (CPAR+/COMSPFS/CPDN) = UPDATED MASTER DEVICE NUMBER.
* MASTER DEVICE SWITCH MADE IF NECESSARY.
* FILES OPENED IF A MASTER DEVICE SWITCH IS MADE.
* UTILITY INTERLOCK SET.
* UTILITY PROCESSOR ACTIVE.
* FILES POSITIONED.
*
* USES X - 0, 1, 2, 3, 4, 6, 7.
* A - 1, 2, 3, 4, 6, 7.
* B - 2.
*
* CALLS AUP, CIN, DUP, FCB, RCT, SIN.
*
* MACROS CALLPFU, RETURN, SETFS.
SMD1 RJ DUP DROP UTILITY PROCESSOR
RJ CIN CLEAR UTILITY INTERLOCK
* GET CATALOG TRACK PARAMETERS.
SX1 PDWD SET ADDRESS OF PF DESCRIPTION WORD
SX2 TCBF+FCUI SET ADDRESS OF USER INDEX IN CATALOG
LX1 18
BX6 X1+X2
SA6 CATS+FTCA
SA6 CATS+FTPM
CALLPFU CATS,CTCT,R GET CATALOG TRACK PARAMETERS
* SET UP NEW MASTER DEVICE PARAMETERS.
SA3 TCBF+FCUI SET *TMDA* INDEX
MX0 -3
BX3 -X0*X3
SA3 TMDA+X3 GET *MSTT* ADDRESS
SA3 X3+
SA4 A3+B1
MX0 -6
BX6 -X0*X3 SET MASTER DEVICE NUMBER
MX0 -9
SA6 CPAR+/COMSPFS/CPDN
LX3 -6
BX6 -X0*X3 SET MASTER EQUIPMENT
LX3 -9
SA6 MAEQ
BX7 -X0*X3 SET NUMBER OF CATALOG TRACKS
MX0 -8
BX6 -X0*X4 SET MASTER DEVICE MASK
LX3 -9
SA7 NCTR
SA6 MMSK
SA1 TCBF+FCUI SET CURRENT CATALOG TRACK
SX2 X7-1
LX1 -3
BX7 X2*X1
SA7 CCTR
* SET UP CATALOG FST ENTRY.
SA1 CATS+FTPM GET CATALOG TRACK PARAMETERS
SX2 5 SET FILE STATUS
MX0 -24
BX1 -X0*X1 SET EQ AND FIRST TRACK
MX0 -12
BX6 -X0*X1 SET CURRENT TRACK
LX1 36
BX2 X2+X1 BUILD CATALOG TRACK FST ENTRY
LX6 24
BX7 X2+X6
SA7 A1
LX0 36 SET ID, EQ AND STATUS
BX6 X0*X2
* SET UP PERMITS FST ENTRY.
SX1 10000B*FSMS SET SECTOR FOR *PETS* AND *DATA*
BX6 X6+X1
MX0 -12
BX1 -X0*X3 SET FIRST PERMITS TRACK
BX2 X1 SET CURRENT TRACK
LX1 36
LX2 24
BX7 X6+X1
LX3 -24
BX7 X7+X2
SA7 PETS+FTPM
* SET UP DATA FST ENTRY.
BX1 -X0*X3 SET FIRST DATA TRACK
BX2 X1 SET CURRENT TRACK
LX1 36
BX7 X6+X1
LX2 24
BX7 X7+X2
SA7 DATA+FTPM
* OPEN FILES AND SET SPECIAL SYSTEM FILE STATUS
RETURN CATS RETURN ANY EXISTING FILES
RETURN PETS
RETURN DATA
CALLPFU CATS,CTOP,R OPEN *CATS* FILE
CALLPFU PETS,CTOP,R OPEN *PETS* FILE
CALLPFU DATA,CTOP,R OPEN *DATA* FILE
SETFS CATS,SSST
SETFS PETS,SSST
SETFS DATA,SSST
* SET UTILITY INTERLOCK AND ACTIVATE *PFU*.
SMD2 RJ SIN SET UTILITY INTERLOCK
RJ AUP ACTIVATE *PFU*
* CHECK FOR NEW MASTER DEVICE.
SMD SUBR ENTRY/EXIT
SA2 TCBF+FCUI USER INDEX OF FILE
SA1 MMSK
MX0 -3
BX6 -X0*X2 SELECT CORRECT MASK BIT
SB2 X6-59
AX1 X1,B2
PL X1,SMD1 IF NOT CORRECT MASTER DEVICE
* CHECK FOR NEW CATALOG TRACK.
LX2 -3
SA1 NCTR SET CATALOG TRACK MASK
SA3 CCTR CURRENT CATALOG TRACK
SX6 X1-1
BX7 X6*X2 NEW CATALOG TRACK
IX2 X3-X7
ZR X2,SMD2 IF SAME CATALOG TRACK
* SWITCH CATALOG TRACKS.
SA1 PAFL
SA7 A3+ SAVE NEW CATALOG TRACK
ZR X1,SMD2 IF *PFU* NOT ACTIVE
RJ FCB FLUSH CATALOG BUFFER
RJ RCT READ NEW CATALOG TRACK
EQ SMDX RETURN
SRD SPACE 4,15
** SRD - SELECT RESIDENCY DEVICE FOR LOAD LEVELING.
*
* ENTRY PFC ENTRY FOR FILE IN *TCBF*.
* (B6) = DAPF MASK SHIFT COUNT.
*
* EXIT (B2) = *MSTT* ADDRESS OF DEVICE IF DEVICE SELECTED.
* (B2) = -1 IF NO DEVICE FOR USER INDEX OF FILE.
* (B2) = 0 IF NO DEVICE FOR ACCESS LEVEL OF FILE.
* (B2) = 1 IF NO DEVICE WITH SPACE FOR FILE.
*
* USES X - 2, 3, 4, 5.
* A - 5.
* B - 2, 3.
*
* CALLS CAL, RAS.
SRD SUBR ENTRY/EXIT
* INITIALIZE SEARCH PARAMETERS.
SA5 MSTT-1 INITIALIZE SEARCH ADDRESS
SB2 -B1 PRESET ERROR STATUS = NO DEVICE FOR UI
SX4 -B1 INITIALIZE BEST DEVICE STATUS
* ADVANCE TO NEXT DEVICE AND CHECK DEVICE MASK.
SRD1 SA5 A5+2 GET DEVICE PARAMETERS
AX2 X5,B6 POSITION DAPF MASK BIT
ZR X5,SRDX IF END OF DEVICES
PL X2,SRD1 IF USER INDEX NOT ALLOWED ON DEVICE
* CHECK ACCESS LEVELS, DEVICE STATE, AND AVAILABLE SPACE.
RJ CAL CHECK ACCESS LEVELS
SB3 B0 SET ACCESS LEVEL ERROR
NG X6,SRD2 IF FILE NOT WITHIN DEVICE LEVELS
SX3 B0 SET NO SPACE INCREMENT
RJ RAS RETURN AVAILABLE SPACE
SB3 B1 SET NO SPACE FOR FILE ERROR
ZR X1,SRD2 IF INSUFFICIENT SPACE ON DEVICE
IX2 X1-X4
NG X2,SRD1 IF PREVIOUS DEVICE BETTER
BX4 X1 SET NEW BEST DEVICE STATUS
SB2 A5-B1 SET BEST DEVICE POINTER
EQ SRD1 ADVANCE TO NEXT DEVICE
* PROCESS ACCESS LEVEL CONFLICT OR NO SPACE AVAILABLE.
SRD2 SX2 B2-B3
PL X2,SRD1 IF NO LOWER PRIORITY ERROR SET
SB2 B3 UPDATE ERROR STATUS
EQ SRD1 ADVANCE TO NEXT DEVICE
SSC SPACE 4,15
** SSC - SET SECTOR COUNTER.
*
* ENTRY (X2) = FET ADDRESS.
* FET NOT BUSY.
*
* EXIT (X2) = FET ADDRESS.
* (X2+FTSC) = SECTOR COUNT IN BUFFER.
*
* USES X - 1, 5, 6, 7.
* A - 1, 5, 6, 7.
*
* MACROS READW.
SSC3 SA1 SSCA RESTORE IN
SA5 A1+B1 RESTORE OUT
BX6 X1
LX7 X5
SA6 X2+2
SA7 A6+B1
SSC SUBR ENTRY/EXIT
SA1 X2+2 SAVE IN
SA5 A1+B1 SAVE OUT
BX6 X1
LX7 X5
SA6 SSCA
SA7 A6+B1
SA1 X2 SET EOR STATUS IN FET
MX6 48
SX5 23B
BX1 X6*X1
SX7 B0+ CLEAR SECTOR COUNT
BX6 X1+X5
SA7 X2+FTSC
SA6 X2+
SSC1 READW X2,SSCB,B1 READ CONTROL WORD
NZ X1,SSC3 IF BUFFER EMPTY
SA1 SSCB GET SECTOR WORD COUNT
MX6 -12
BX5 -X6*X1
SA1 X2+FTSC INCREMENT SECTOR COUNT
SX6 X1+B1
SA6 A1
SSC2 ZR X5,SSC1 IF END OF SECTOR
READW X2,SSCB,B1 READ ONE WORD OF SECTOR
NZ X1,SSC3 IF BUFFER EMPTY
SX5 X5-1
EQ SSC2 CHECK FOR END OF SECTOR
SSCA BSSZ 2 IN AND OUT SAVE AREA
SSCB CON 0 SCRATCH BUFFER
VFN SPACE 4,10
** VFN - VALIDATE FILE NAME.
*
* ENTRY (TCBF) = CURRENT CATALOG ENTRY.
*
* EXIT (X3) .GE. 0, IF FILE NAME NOT VALID
*
* USES X - 0, 1, 2, 3.
* A - 1.
VFN SUBR ENTRY/EXIT
SA1 TCBF+FCFN CHECK FILE NAME
MX2 42
BX1 X2*X1
MX0 -6
LX1 6
SX2 1R9+1
VFN1 BX3 -X0*X1 CHECK FOR NON-ALPHANUMERIC CHARACTER
ZR X3,VFNX IF CHARACTER NOT VALID
BX1 X0*X1
IX3 X3-X2
PL X3,VFNX IF CHARACTER NOT VALID
LX1 6
NZ X1,VFN1 IF MORE CHARACTERS
EQ VFNX RETURN
WCE SPACE 4,20
** WCE - WRITE CATALOG ENTRY.
*
* ENTRY (CSWC) = CURRENT CATALOG SECTOR WORD COUNT.
* (*CATS* IN POINTER) = ADDRESS OF CATALOG ENTRY.
*
* EXIT (CSWC) = UPDATED SECTOR WORD COUNT.
* (CBFO) = UPDATED CATALOG BUFFER ORDINAL.
* (IPFF) = 0.
* (CEWF) = 0 IF CATALOG BUFFER FLUSHED.
* = 1 IF CATALOG BUFFER NOT FLUSHED.
* CATALOG FILE BUFFER POINTERS ADJUSTED.
* CATALOG BUFFER FLUSHED IF NECESSARY.
* FULL SECTOR CONTROL WORD WRITTEN TO BUFFER IF
* NECESSARY.
*
* USES X - 1, 2, 6, 7.
* A - 1, 2, 6, 7.
*
* CALLS FCB.
WCE SUBR ENTRY/EXIT
BX6 X6-X6 CLEAR INCOMPLETE FILE FLAG
SA6 IPFF
SX7 B1 SET *CATALOG ENTRIES WRITTEN*
SA7 CEWF
SA2 CBFO ADVANCE CATALOG ORDINAL
IX7 X2+X7
SA7 A2
SA2 CATS+2 SET IN POINTER TO END OF CATALOG ENTRY
SA1 CSWC ADJUST SECTOR WORD COUNT
SX6 X2+NWCE
SX7 X1+NWCE
SA6 A2
SA7 A1
SX1 X7-100B
NG X1,WCEX IF NOT FULL SECTOR
BX6 X6-X6 CLEAR SECTOR WORD COUNT
SA6 A1
SA1 CATS+FTSC INCREMENT SECTOR COUNTER
SX7 X1+B1
SA7 A1+
LX7 59-11
NG X7,WCE1 IF AT SECTOR LIMIT
SA1 CATS+4 CHECK BUFFER SPACE
SA2 CATS+2
SX6 X1-101B
IX7 X2-X6
NG X7,WCE2 IF ROOM FOR FULL SECTOR
WCE1 RJ FCB FLUSH CATALOG BUFFER
WCE2 SX6 100B SET FULL SECTOR CONTROL WORD
SA1 CATS+2
SA6 X1
SX7 X1+B1 ADJUST IN POINTER
SA7 A1+
EQ WCEX RETURN
WPR SPACE 4,20
** WPR - WRITE PRU TO *PFU* CIRCULAR BUFFER.
*
* ENTRY (X2) = FET ADDRESS.
* (B6) = FWA OF WORKING BUFFER.
* (B7) = WORD COUNT OF WORKING BUFFER.
*
* EXIT (X2) = FET ADDRESS.
* (B7) = 0 IF NO WRITE ERROR DETECTED.
* = SAME AS ENTRY IF WRITE ERROR DETECTED.
* (X6) = ERROR CODE FROM FET IF (B7) IS NON-ZERO.
* DATA WRITTEN TO CIRCULAR BUFFER.
* WRITE REQUEST ISSUED IF BUFFER AT LEAST HALF FULL.
*
* USES X - 1, 3, 6, 7.
* A - 1, 3, 6, 7.
* B - 2, 3, 4, 6, 7.
*
* CALLS FUB.
*
* MACROS RECALL.
WPR SUBR ENTRY/EXIT
* CHECK SECTOR COUNTER.
SA1 X2+FTSC CHECK SECTOR COUNTER
LX1 59-11
PL X1,WPR1 IF SECTOR COUNTER NOT AT THRESHOLD
RJ FUB FLUSH BUFFER
NZ X6,WPRX IF WRITE ERROR
SA6 X2+FTSC CLEAR SECTOR COUNTER
* CHECK BUFFER SPACE.
WPR1 ZR B7,WPRX IF NO DATA TO TRANSFER
SA1 X2+2 (B2) = IN
SB2 X1
SA1 A1+B1 (B4) = OUT
SB4 X1
SA1 A1+B1 (B3) = LIMIT
SB3 X1
SB4 B4-B2 BUFFER SPACE + 1 = OUT - IN
GE B4,B1,WPR2 IF NO BUFFER WRAP
SA1 X2+B1 BUFFER SPACE + 1 = (OUT-IN)+(LIMIT-FIRST)
SB4 B4+B3
BX1 -X1
SB4 B4+X1
WPR2 GT B4,B7,WPR4 IF ENOUGH ROOM IN BUFFER
* PROCESS BUFFER FULL.
SA1 X2 GET FILE NAME
MX6 42
BX7 X6*X1
LX1 59-0 CHECK BUFFER STATUS
SX3 B1+B1 SET WRITE FUNCTION CODE
MX6 -6
PL X1,WPR3 IF BUFFER BUSY
LX1 0-12-59+0+60 GET ERROR STATUS
BX6 -X6*X1
IX7 X7+X3
NZ X6,WPRX IF WRITE ERROR
SA7 X2 ISSUE WRITE REQUEST
WPR3 RECALL WAIT FOR *PFU* TO CATCH UP
EQ WPR1 CHECK BUFFER SPACE
* MOVE DATA TO CIRCULAR BUFFER.
WPR4 SA1 B6 MOVE WORD
SB6 B6+B1 ADVANCE WORKING BUFFER ADDRESS
BX6 X1
SB7 B7-B1 DECREMENT WORD COUNT
SA6 B2
SB2 B2+B1 ADVANCE IN
LT B2,B3,WPR5 IF IN .LT. LIMIT
SA1 X2+B1 IN = FIRST
SB2 X1
WPR5 NZ B7,WPR4 IF WORKING BUFFER NOT EMPTY
* CHECK BUFFER THRESHOLD.
SX6 B2 UPDATE IN
SA3 X2 CHECK BUFFER STATUS
SA1 X2+FTSC INCREMENT SECTOR COUNTER
SA6 X2+2
SX7 X1+B1
LX3 59-0
SA7 A1
SA1 X2+B1 FIRST
PL X3,WPRX IF BUFFER ALREADY BUSY
SA3 X2+3 OUT
SX6 B3
SX1 X1
IX7 X6-X1 BUFFER SIZE = LIMIT - FIRST
SX6 B2 BUFFER WC = IN - OUT
IX3 X6-X3
PL X3,WPR6 IF NO BUFFER WRAP
IX3 X3+X7 BUFFER WC = BUFFER WC + BUFFER SIZE
WPR6 AX7 1 BUFFER SIZE / 2
IX1 X3-X7
NG X1,WPRX IF BUFFER NOT AT LEAST HALF FULL
SA1 X2 GET FILE NAME
MX6 42
BX7 X6*X1
LX1 -12 GET ERROR STATUS
MX3 -6
BX6 -X3*X1
SX1 B1+B1 SET WRITE FUNCTION CODE
BX7 X7+X1
NZ X6,WPRX IF WRITE ERROR
SA7 X2+ ISSUE WRITE REQUEST
EQ WPRX RETURN
TITLE INCREMENTAL LOAD SUBROUTINES.
AAT SPACE 4,20
** AAT - ASSIGN NEXT ARCHIVE TAPE.
*
* ENTRY (X1) = VSN LEFT JUSTIFIED.
*
* EXIT (X6) = 0 IF NEW ARCHIVE TAPE ASSIGNED.
* (X6) .NE. 0 IF ARCHIVE FILE LABEL BAD OR MISSING ON
* SELECTED TAPE.
* OLD ARCHIVE FILE UNLOADED.
* ARCHIVE FILE LABEL PROCESSED IF LABEL GOOD.
*
* USES X - 1, 4, 5, 6, 7.
* A - 1, 4, 6, 7.
*
* CALLS PAL, ZTB.
*
* MACROS LABEL, READCW, UNLOAD.
AAT SUBR ENTRY/EXIT
RJ ZTB SPACE FILL VSN
MX7 36
BX7 X7*X6
SX6 B0
SA7 TAPE+11B SET VSN IN FET
SA6 A7+B1 CLEAR TAPE LABEL PARAMETERS
SA6 A6+B1
SA6 A6+B1
SA6 A6+B1
UNLOAD TAPE,R UNLOAD OLD ARCHIVE FILE
SA4 X2+B1 CLEAR DEVICE TYPE
MX6 -48
SX5 1 CLEAR ERROR PROCESSING BIT
BX4 -X6*X4
LX5 44
BX6 -X5*X4
SA6 A4
LABEL TAPE REQUEST ARCHIVE TAPE
SA4 X2+B1 SET ERROR PROCESSING BIT
BX6 X5+X4
SA6 A4
SA1 X2+B1 SET IN=OUT=FIRST
SX6 X1
SA6 A1+B1
SA6 A6+B1
READCW X2,17B INITIATE CONTROL WORD READ
SX6 B0+ CLEAR CONTROL WORD STATUS WORD
SA6 TAPE+CWSW
RJ PAL CHECK ARCHIVE LABEL
ZR X6,AATX IF GOOD ARCHIVE FILE LABEL
UNLOAD TAPE,R UNLOAD TAPE
SX6 B1 SET ASSIGNMENT NOT MADE
EQ AATX RETURN
ART SPACE 4,20
** ART - ARCHIVE FILE TRANSITION PROCESSOR.
*
* ENTRY END OF INCREMENTAL LOAD FILE DETECTED.
*
* EXIT (X6) = 0 IF NOT END OF INCREMENTAL LOAD.
* = NON-ZERO IF END OF INCREMENTAL LOAD.
* UTILITY PROCESSOR INACTIVE.
* UTILITY INTERLOCK CLEAR.
* FILES REMAINING ON CATALOG IMAGE RECORD LISTED IF
* SELECTED BY OPERATOR.
* NEW ARCHIVE FILE ASSIGNED IF NOT END OF LOAD.
*
* USES X - 1, 2, 4, 5, 6, 7.
* A - 1, 2, 4, 5, 7.
* B - 2, 3, 4, 5.
*
* CALLS AAT, ARM, CCI, CIN, CMA, DUP, KIP, LFS, SRS, USB, ZTB.
*
* MACROS MOVE.
ART SUBR ENTRY/EXIT
* DROP *PFU* AND FLUSH CIR BUFFER.
RJ DUP DROP UTILITY PROCESSOR
RJ CIN CLEAR UTILITY INTERLOCK
SX7 B0+ SET FLAG TO FLUSH CIR BUFFER
SA7 TCBF+FCUI
RJ CCI FLUSH CIR BUFFER
* PROCESS *OP=V* SELECTED.
SA1 CPAR+/COMSPFS/CPOP
LX1 59-51
PL X1,ART1 IF *OP=V* NOT SELECTED
SA1 TLBF+/COMSPFS/PVAL CHECK FOR NEXT VSN
SA2 =10H
MX6 36
BX2 X1-X2
BX1 X6*X1
BX2 X6*X2
ZR X1,ARTX IF NEXT VSN NOT PRESENT
ZR X2,ARTX IF NEXT VSN NOT PRESENT
RJ AAT ASSIGN ARCHIVE TAPE
ZR X6,ARTX IF TAPE ASSIGNED
SB2 ERAL * ERROR IN ACHIVE FILE LABEL.*
EQ ABT ABORT
* SET *K* DISPLAY RIGHT SCREEN FOR INPUT.
ART1 SA5 IDSA+/COMSPFS/ADM2
MOVE 4,MSGH,X5 *END OF LOAD FILE - SEE RIGHT SCREEN.*
SX6 ARTA
RJ SRS SELECT RIGHT SCREEN
* CLEAR VSN SELECTION.
ART2 SA1 =10H
SX6 B0
BX7 X1
SA6 VSPR CLEAR *VSN* PARAMETER
SA7 ARTB+1 CLEAR VSN IN DISPLAY
* GET OPERATOR INPUT.
ART3 SX7 B0+ CLEAR *LIST* AND *END* INDICATORS
SA7 LTPR
SA7 ENPR
SB2 ART4 SET ARGUMENT PROCESSOR ADDRESS
SB3 ART9 SET FUNCTION PROCESSOR ADDRESS
EQ /COMSPFS/KIP PROCESS KEYBOARD INPUT
* PROCESS ARGUMENT ENTRY.
ART4 SB2 /COMSPFS/KIN SET PARAMETERS ADDRESS
RJ USB UNPACK PARAMETERS
SB3 ARGT SET ARGUMENT TABLE ADRESS
RJ ARM PROCESS ARGUMENTS
ZR X1,ART5 IF NO ERROR
SA5 IDSA+/COMSPFS/ADER
MOVE 4,MSGT,X5 *INCORRECT OPTION.*
EQ ART3 PROCESS KEYBOARD INPUT
ART5 SA1 ENPR
ZR X1,ART6 IF NOT END OF LOAD
RJ CMA CLEAR MESSAGE AREA
SX6 B1 SET END OF LOAD STATUS
EQ ARTX RETURN
ART6 SA1 LTPR
ZR X1,ART7 IF NOT LIST FILES
RJ CMA CLEAR MESSAGE AREA
RJ LFS LIST FILES
EQ ART1 PROCESS KEYBOARD INPUT
ART7 SA1 VSPR
MX7 42
MX6 -24
ZR X1,ART3 IF VSN NOT ENTERED
BX1 X7*X1
BX7 -X6*X1
ZR X7,ART8 IF VALID VSN
SA5 IDSA+/COMSPFS/ADER
MOVE 4,MSGP,X5 *ENTERED VSN TOO LONG.*
EQ ART2 CLEAR VSN SELECTION
ART8 RJ ZTB SPACE FILL VSN
SA6 ARTB+1 SET VSN IN DISPLAY
EQ ART3 PROCESS KEYBOARD INPUT
* PROCESS *GO* ENTRY.
ART9 SA1 VSPR
NZ X1,ART10 IF VSN ENTERED
SA5 IDSA+/COMSPFS/ADER DISPLAY BAD LABEL MESSAGE
MOVE 4,MSGQ,X5 *NO VSN ENTERED.*
EQ ART3 GET OPERATOR INPUT
ART10 RJ AAT ASSIGN ARCHIVE TAPE
ZR X6,ART12 IF TAPE ASSIGNED
SA5 IDSA+/COMSPFS/ADER DISPLAY BAD LABEL MESSAGE
MOVE 4,MSGV,X5 *ARCHIVE LABEL BAD, SELECT NEW VSN.*
EQ ART2 CLEAR VSN SELECTION
* PROCESS TAPE ASSIGNED.
ART12 RJ CMA CLEAR MESSAGE AREA
SX6 B0 SET TAPE ASSIGNED
EQ ARTX RETURN
* RIGHT SCREEN BUFFER FOR TAPE TRANSITION.
ARTA VFD 12/0,36/0,12/0 DISPLAY CONTROL WORD
KDL 10,T,(INCREMENTAL LOAD FILE TRANSITION OPTIONS.)
KDL 13,H,(ENTER K.OPTION.)
KDL 13,,(OPTION)
KDL 30,H,(DESCRIPTION)
KDL 13,K,(END TERMINATE LOAD.)
KDL 13,K,(LIST LIST REMAINING FILES.)
ARTB KDL 13,K,(VSN = VSN OF NEXT TAPE.)
KDL 13,K,(GO RESUME LOAD AFTER VSN ENTERED.)
CON 0 END OF BUFFER
* ENTERED PARAMETERS.
LTPR CON 0 *LIST*
ENPR CON 0 *END*
VSPR CON 0 *VSN*
* ARGUMENT TABLE.
ARGT BSS 0
LIST ARG -NZ,LTPR,,1
END ARG -NZ,ENPR,,1
VSN ARG NZ,VSPR,,1
CON 0
NZ CON 1 NON-ZERO VALUE
CCI SPACE 4,20
** CCI - CHECK CATALOG IMAGE.
*
* ENTRY (TCBF) = CATALOG ENTRY BEING PROCESSED.
* (TCBF+FCUI) = 0, IF INDEX TO BE FLUSHED.
* (INCF) = INCREMENTAL LOAD FLAG.
* (CIFC) = FILE COUNT FOR CATALOG IMAGE RECORD.
* (CIRT) = CATALOG IMAGE RECORD DIRECTORY.
*
* EXIT (X6) = 0 IF FILE TO BE LOADED (OR NOT INCREMENTAL
* LOAD).
* .NE. 0 OTHERWISE.
* (TCBF) = UPDATED WITH ACCESS INFORMATION FROM THE CIR
* IF AN INCREMENTAL LOAD AND FILE TO BE LOADED.
*
* USES X - ALL.
* A - 1, 2, 3, 4, 5, 6, 7.
* B - 2, 3, 4.
*
* MACROS READ, REWRITE, REWRITER.
CCI SUBR ENTRY/EXIT
SA1 INCF
BX6 X6-X6 PRESET TO LOAD FILE
MX0 42
ZR X1,CCIX IF NOT AN INCREMENTAL LOAD
SA1 TCBF+FCUI GET USER INDEX OF FILE
ZR X1,CCI10 IF CATALOG BUFFER TO BE FLUSHED TO DISK
BX1 -X0*X1
MX0 -3 SAVE DEVICE MAP BITS
BX3 -X0*X1
SB2 X3
SX5 B0 SET INDEX
CCI1 SX6 NWCD
IX4 X5*X6
SX5 X5+B1
SA4 CIRT+X4 READ HEADER WORD
NZ X4,CCI2 IF DEVICE THERE
SX6 B1 EXIT - DEVICE NOT FOUND
EQ CCIX RETURN
CCI2 AX4 X4,B2
MX0 -1
BX4 -X0*X4
ZR X4,CCI1 IF NOT CORRECT DEVICE
SA4 A4 GET NUMBER CATALOG TRACKS
AX4 12
SX4 X4-1 SET MASK
AX1 3
BX1 X4*X1
SB2 X1
SA4 A4+B1
SA5 A4+B2
SX6 B1
ZR X5,CCIX IF NO ENTRIES
CCI3 SA1 CCIA FETCH LAST RANDOM INDEX
SX6 B1 SET RANDOM REWRITE REQUEST
MX2 -29
LX6 29
BX5 X6+X5
NG X1,CCI5 IF NO DATA IN BUFFER
BX4 -X2*X5 EXTRACT RANDOM INDEX
IX4 X4-X1
ZR X4,CCI6 IF NO RANDOM INDEX CHANGE
SA4 CCIB FETCH INDEX MODIFICATION FLAG
BX6 X6+X1
NZ X4,CCI5 IF INDEX NOT MODIFIED
SA1 CIRF CHECK END STATUS
SA6 CIRF+6 SET RANDOM INDEX FOR WRITE
LX1 59-4
PL X1,CCI4 IF NOT END OF RECORD
REWRITER CIRF,R
EQ CCI5 PROCESS NEXT INDEX
CCI4 REWRITE CIRF,R
CCI5 SA1 CIRF+1 FETCH FIRST
BX6 X5
SX7 X1
SA6 CIRF+6 SET NEW RANDOM INDEX
MX2 -29
SA7 A1+B1 SET IN=FIRST
SA7 A7+B1 SET OUT=FIRST
SA7 CCIB CLEAR BUFFER MODIFIED FLAG (SET NONZERO)
BX6 -X2*X6
SA6 CCIA SAVE RANDOM INDEX
READ CIRF,R LOAD IMAGE BUFFER
CCI6 SA1 CIRF
SA4 TCBF+FCUI FETCH USER INDEX AND FILE
LX1 17-4
SB4 X1 END OF RECORD INDICATOR
SA1 CIRF+2 FETCH IN
SA2 A1+B1 FETCH OUT
IX7 X1-X2
SX6 B1
ZR X7,CCIX IF END OF RECORD AND BUFFER EMPTY
SB2 X1 SET LAST BUFFER ADDRESS
SB3 X2 SET ADDRESS OF FIRST ENTRY
CCI7 SA1 B3 FETCH NEXT ENTRY
IX1 X1-X4
ZR X1,CCI8 IF CATALOG ENTRY FOUND
SB3 B3+2
LT B3,B2,CCI7 IF MORE ENTRIES IN BUFFER
NG B4,CCIX IF END OF RECORD
SA1 CIRF+6 FETCH RANDOM INDEX
SA4 CCIB FETCH BUFFER MODIFICATION FLAG
MX2 -29
LX1 30 CURRENT RANDOM INDEX
BX5 X2*X5 PREVIOUS INDEX
BX6 -X2*X1
BX5 X5+X6
ZR X4,CCI3 IF BUFFER MODIFIED
EQ CCI5 PROCESS NEXT BUFFER LOAD
* UPDATE CATALOG ENTRY WITH INFORMATION FROM CIR.
CCI8 BX6 X6-X6
SA6 CCIB SET BUFFER MODIFIED FLAG
SA6 B3
SA1 B3+B1 FETCH NEW ACCESS INFORMATION FROM CIR
SA2 TCBF+FCAD
MX0 18
BX7 X0*X1 EXTRACT NEW ACCESS COUNT
SA3 TCBF+FCAC
BX1 -X0*X1 NEW DEVICE NUMBER AND LAST ACCESS DATE
LX7 -6
BX2 X0*X2 CLEAR OLD DEVICE NUMBER AND ACCESS DATE
MX0 -36
BX6 X1+X2 UPDATE DEVICE NUMBER AND ACCESS DATE
SA6 A2
BX3 -X0*X3 CLEAR OLD ACCESS COUNT
BX7 X7+X3 UPDATE ACCESS COUNT
SA7 A3
BX6 X6-X6
SA5 A5 UPDATE DIRECTORY ENTRY
LX5 30
SX1 B1
IX7 X5-X1
MX5 -30
BX5 -X5*X7
NZ X5,CCI9 IF MORE ENTRIES LEFT
BX7 X7-X7
CCI9 LX7 30
SA7 A5
SA4 CIFC DECREMENT FILE COUNT
IX7 X4-X1
SA7 A4
EQ CCIX RETURN
* CLEAN UP CATALOG BUFFER.
CCI10 SA1 CCIA FETCH CURRENT RENDOM INDEX
SA2 CCIB FETCH BUFFER MODIFICATION FLAG
SA4 CIRF
NG X1,CCI12 IF NO DATA IN BUFFER
NZ X2,CCI12 IF BUFFER NOT MODIFIED
SX6 B1
SX7 -B1
LX6 29
SA7 A1 CLEAR CURRENT RANDOM INDEX
LX4 59-4
BX6 X6+X1
SA7 A2 CLEAR BUFFER MODIFICATION FLAG
SA6 CIRF+6 RESET RANDOM INDEX
PL X4,CCI11 IF NOT END OF RECORD
REWRITER CIRF,R
EQ CCI12 SET NO LOAD STATUS
CCI11 REWRITE CIRF,R
CCI12 SX6 B1
EQ CCIX RETURN
CCIA DATA -1 CURRENT RANDOM INDEX
CCIB DATA -1 BUFFER MODIFICATION FLAG
CMA SPACE 4,10
** CMA - CLEAR MESSAGE AREA.
*
* EXIT *K* DISPLAY ERROR MESSAGE LINES CLEARED.
*
* USES X - 5.
* A - 5.
*
* MACROS MOVE.
CMA SUBR ENTRY/EXIT
SA5 IDSA+/COMSPFS/ADM2
MOVE 4,BLNK,X5
SA5 A5+B1
MOVE 4,BLNK,X5
EQ CMAX RETURN
LFS SPACE 4,20
** LFS - LIST FILES ON CATALOG IMAGE RECORD.
*
* ENTRY (CIFC) = REMAINING FILE COUNT.
* (CIRT - CIRT+NWCD*NDEV) = DIRECTORY OF CATALOG IMAGE
* RECORD FILE.
*
* EXIT FILE LIST CREATED AND RELEASED FOR PRINTING.
*
* USES X - 1, 2, 5, 6.
* A - 1, 5, 6.
* B - 2.
*
* CALLS CDD, FCI, RPP.
*
* MACROS MESSAGE, MOVE, READ, READW, RECALL, ROUTE, WRITEF,
* WRITEH.
LFS SUBR ENTRY/EXIT
SA1 PAGE
SX7 B1+
BX6 X1
SA7 A1 RESET PAGE NUMBER
SA6 LFSK SAVE OUTPUT FILE PAGE NUMBER
SX6 LCIR
SA6 OFFA SET OUTPUT FILE FET ADDRESS
SX2 LFSL SET TITLE TEXT
SX6 CIS SET CIR SUBHEADER PROCESSOR
RJ RPP RESET PAGE PARAMETERS
SX6 -1
SA6 LFSA
SA5 IDSA+/COMSPFS/ADMS
MOVE 3,LFSB,X5 DISPLAY *LISTING FILES* MESSAGE
MESSAGE LFSB,1
SA5 CIFC SET TOTAL FILE COUNT
ZR X5,LFS4 IF NO FILES
LFS1 SA1 LFSA SET DEVICE INDEX
SX2 NWCD
SX6 X1+B1
SA6 A1
IX6 X6*X2
SA5 CIRT+X6
ZR X5,LFS4 IF NO DEVICES LEFT
AX5 12
BX6 X5 SAVE CATALOG TRACK COUNT
SA6 LFSD
SX6 A5 SAVE DIRECTORY ADDRESS
SA6 LFSF
LFS2 SA1 LFSF GET DIRECTORY ADDRESS
SA5 X1+B1
SX6 A5 SAVE DIRECTORY ADDRESS
SA6 LFSF
SA1 LFSD
SX6 X1-1
SA6 LFSD
NG X6,LFS1 IF END OF CATALOGS
ZR X5,LFS2 IF NO FILES LEFT ON THIS TRACK
RECALL CIRF
SA1 X2+B1 REWIND BUFFER
SX6 X1
SA6 A1+B1
SA6 A6+B1
MX6 -30
BX6 -X6*X5
SA6 CIRF+6
AX5 30
READ CIRF INITIATE RANDOM READ
LFS3 READW CIRF,LFSG,2 READ CATALOG IMAGE ENTRY
NZ X1,LFS2 IF END OF CATALOG TRACK
SA1 LFSG
ZR X1,LFS3 IF NULL ENTRY
BX6 X5 SAVE FILE COUNT
SA6 LFSE
SX6 A1+ SET CATALOG IMAGE ADDRESS
RJ FCI FORMAT CIR ENTRY FOR OUTPUT
SA5 LFSE RESTORE FILE COUNT
SX1 B1
IX5 X5-X1 DECREMENT FILE COUNT
NZ X5,LFS3 IF MORE FILES
EQ LFS2 PROCESS NEXT CATALOG TRACK
LFS4 SA1 CIFC CONVERT FILE COUNT
RJ CDD
SA6 LFSH+2
WRITEH LCIR,LFSH,3
WRITEF LCIR,R
SX6 B0+ CLEAR PARAMETER BLOCK
SB2 DSPBL-1
LFS5 SA6 DSPB+B2
SB2 B2-1
PL B2,LFS5 IF NOT END OF BLOCK
SA5 LCIR SET UP *DSP* PARAMETER BLOCK
MX2 42
BX6 X2*X5
SA6 DSPB
SA5 LFSJ SET FLAG BITS
BX6 X5
SA6 A6+B1
ROUTE DSPB,RECALL
SA5 IDSA+/COMSPFS/ADMS
MOVE 3,BLNK,X5
MESSAGE (=C**),1
SA1 LFSK RESET OUTPUT FILE PAGE NUMBER
BX6 X1
SA6 PAGE
SX6 O
SA6 OFFA RESET OUTPUT FILE FET ADDRESS
EQ LFSX RETURN
LFSA CON 0 DEVICE INDEX
LFSB DATA 30C LISTING REMAINING FILES.
LFSD CON 0 CATALOG TRACK COUNT
LFSE CON 0 FILE COUNT
LFSF CON 0 DIRECTORY ADDRESS
LFSG BSSZ 2 SCRATCH CATALOG IMAGE ENTRY
LFSH DATA 30H0 TOTAL FILE COUNT
LFSJ VFD 24/0,12/2HPR,6/0,18/FRDC
LFSK CON 1 OUTPUT FILE PAGE NUMBER
LFSL DATA 50H1FILES REMAINING ON CATALOG IMAGE RECORD.
SRS SPACE 4,15
** SRS - SELECT RIGHT SCREEN.
*
* *SRS* REPLACES THE CURRENT RIGHT SCREEN WITH THE REQUESTED
* ONE AND ALERTS THE OPERATOR TO ENTER AN OPTION.
*
* ENTRY (X6) = FWA OF THE REQUESTED RIGHT SCREEN BUFFER.
*
* USES X - 0, 5, 6.
* A - 5, 6.
*
* MACROS MESSAGE.
SRS SUBR ENTRY/EXIT
SA5 IDSA+/COMSPFS/KDCW CHANGE *K* DISPLAY CONTROL WORD
MX0 42
LX6 18
LX0 18
BX5 X0*X5
BX6 X5+X6
SA6 A5
MESSAGE MSGW,2 * REQUEST K DISPLAY.*
EQ SRSX RETURN
TITLE COMMON DECKS.
* COMMON DECKS.
*CALL COMCARM
*CALL COMCCCE
*CALL COMCCDD
ERP1$ EQU 1 SELECT *COMCCIO* ERROR PROCESSING OPTION
*CALL COMCCIO
*CALL COMCCOD
*CALL COMCCPM
*CALL COMCDXB
*CALL COMCEDT
FCE$ EQU 0
*CALL COMCFCE
GMS$ EQU 1 USE SORT KEY MASK
MWK$ EQU 1 ALLOW MULTIPLE WORD SORT KEYS
*CALL COMCGMS
*CALL COMCJCR
*CALL COMCLFM
*CALL COMCMSF
*CALL COMCMVE
*CALL COMCPFM
COM$ EQU 1 ASSEMBLE COMMON ROUTINES
PFA$ EQU 1 ASSEMBLE COMMON ARCHIVE FILE ROUTINES
DVA$ EQU 1 ASSEMBLE DEVICE ACCESS ROUTINES
PFR$ EQU 1 ASSEMBLE ARCIVE FILE READ ROUTINES
LIST X
*CALL COMCPFS
LIST *
*CALL COMCPFU
*CALL COMCPOP
*CALL COMCRDW
*CALL COMCSCB
*CALL COMCSFN
*CALL COMCSNM
*CALL COMCSYS
*CALL COMCUSB
*CALL COMCVDT
*CALL COMCWTC
*CALL COMCWTH
*CALL COMCWTO
*CALL COMCWTW
*CALL COMCZTB
TITLE BUFFERS.
USE LITERALS
* BUFFERS.
PBUF EQU * PERMIT BUFFER
DBUF EQU PBUF+PBUFL DATA BUFFER
TCBF EQU DBUF+DBUFL TEMPORARY CATALOG BUFFER
CWBF EQU TCBF+NWCE CONTROL WORD BUFFER
MBUF EQU CWBF+CWBFL MAIN INPUT BUFFER
CBUF EQU MBUF+MBUFL CATALOG BUFFER
TLBF EQU CBUF+CBUFL TAPE LABEL BUFFER
PFMB EQU TLBF+TLBFL *PFM* CATLIST BUFFER
DSPB EQU PFMB+PFMBL *DSP* PARAMETER BLOCK
LWRD SPACE 4,20
** LWRD - *PFU* BUFFER LINKAGE WORD.
*
*T LWRD 6/ TY,18/ CA,12/ 0,12/ DN,12/ LN
*
* TY = SECTOR TYPE.
* 0 = FULL SECTOR OR EOR SECTOR.
* 1 = EOF SECTOR.
* 2 = EOI SECTOR.
* 4 = SYSTEM SECTOR.
* CA = ADDRESS OF CATALOG ENTRY FOR FILE.
* DN = 0 FOR INDIRECT ACCESS FILES.
* = DEVICE NUMBER FOR DIRECT ACCESS FILES.
* = 4000 FOR DIRECT ACCESS FILES ON AN AUXILIARY DEVICE.
* LN = LENGTH OF SECTOR.
*
* LINKAGE WORD MUST IMMEDIATELY PRECEDE *TDBF*.
LWRD EQU DSPB+DSPBL *PFU* BUFFER LINKAGE WORD
TDBF EQU LWRD+1 TEMPORARY DATA BUFFER
FLBF EQU TDBF+TDBFL FILE LIST BUFFER
FLCB EQU FLBF+FLBFL FILE LIST CIRCULAR BUFFER
OUTB EQU FLCB+FLCBL OUTPUT FILE BUFFER
SUMB EQU OUTB+OUTBL SUMMARY FILE BUFFER
PFLB EQU SUMB+SUMBL PROCESSED FILES FILE BUFFER
MS1B EQU PFLB+PFLBL SORT FILE 1
MS2B EQU MS1B+MSFBL SORT FILE 2
MS3B EQU MS2B+MSFBL SORT FILE 3
MS4B EQU MS3B+MSFBL SORT FILE 4
SRTB EQU MS3B SORT BUFFER (OVERLAYS *MS3B* AND *MS4B*)
ERRNG MSFBL*2-SRTBL SORT BUFFER OVERFLOW
CIBF EQU MS4B+MSFBL *CIR* SCRATCH FILE BUFFER
CIRT SPACE 4,40
** CIRT - *CIR* DIRECTORY TABLE.
*
* *CIRT* IS A DIRECTORY TO THE CATALOG IMAGE RECORD (*CIR*)
* WHICH IS COPIED FROM THE ARCHIVE FILE TO THE RANDOM FILE
* *CIRF*. *CIRT* IS INDEXED BY CATALOG TRACK NUMBER (*CT*)
* AND THE RELATIVE DEVICE NUMBER WITHIN THE DIRECTORY (*RDEV*)
* AS DEFINED BELOW.
*
*T,CIRT+DI 36/,12/ NCT,12/ DM
*T,CIRT+TI 30/ FC,30/ RI
*T, 60/ 0
*
* CT = CATALOG TRACK NUMBER.
* DI = DEVICE INDEX = NWCD*RDEV.
* DM = DEVICE MASK.
* FC = FILE COUNT FOR CATALOG TRACK.
* NCT = NUMBER OF CATALOG TRACKS FOR DEVICE.
* NWCD = NUMBER OF DIRECTORY WORDS PER DEVICE. (ASSEMBLY
* CONSTANT.)
* RDEV = RELATIVE DEVICE IN DIRECTORY.
* RI = RANDOM INDEX IN *CIRF* FOR CATALOG TRACK FILE LIST.
* TI = CATALOG TRACK INDEX = DI+1+CT.
*
* EACH MASTER DEVICE HAS A RECORD ON *CIRF* FOR EACH NON-NULL
* CATALOG TRACK CONTAINING THE *CIR* ENTRIES FOR THAT TRACK.
CIRT EQU CIBF+CIBFL *CIR* DIRECTORY TABLE
LBUF EQU CIRT+CIRTL LIST *CIR* ENTRIES OUTPUT BUFFER
ENDB EQU LBUF+LBUFL+5 END OF BUFFERS
TITLE PRESET.
PRE SPACE 4,40
** PRS - PRESET PROGRAM.
*
* ENTRY (CPAR) = CONVERTED PARAMETER ARRAY.
* FILES *ZZZZZG0* THROUGH ZZZZZG9 AND *ZZZZZGA* RETURNED
* BY *PFS*.
* FILE *ZZZZZGB* RETURNED BY *PFS* IF NO FILE
* SELECTIONS.
* FILE *ZZZZZGB* CONTAINS FILE SELECTIONS IF PRESENT.
*
* EXIT (B1) = 1.
* (MSTT) = TABLE OF DEVICES IN FAMILY BEING LOADED.
* (MASK) = MASK FOR MASTER DEVICES BEING LOADED.
* (TMDA) = TABLE OF MASTER DEVICE ADDRESSES.
* (PDWD) = PF DESCRIPTION WORD FOR FAMILY OR AUXILIARY
* DEVICE BEING LOADED.
* (MPFM) = FAMILY NAME PARAMETER.
* (MPPN) = PACK NAME PARAMETER.
* EXIT TO *ABT* FOR EXTRACT OPTION WITHOUT CIR.
* ARCHIVE FILE ASSIGNED.
* CATALOG IMAGE RECORD PROCESSED.
* DEVICE SELECTION PERFORMED.
* SELECTION PARAMETERS PUT IN ACCOUNTING MESSAGES.
* APPROPRIATE ACCOUNTING MESSAGES ISSUED TO DAYFILE AND
* OUTPUT FILE.
* *K* DISPLAY COORDINATES INITIALIZED.
*
* USES X - 0, 1, 2, 5, 6, 7.
* A - 1, 2, 5, 6, 7.
* B - 1.
*
* CALLS AAF, BMT, CAS, GAM, IFL, IOF, PCI, SBS, SFP, SMP, SSP,
* SSS, STC.
*
* MACROS MEMORY, REPRIEVE, SKIPFF.
PRS SUBR ENTRY/EXIT
SB1 1
MEMORY CM,,R,ENDB REQUEST REQUIRED MEMORY
REPRIEVE RPVB,SET,277B SET EXTENDED REPRIEVE PROCESSING
RJ SSS SET SECURED SYSTEM STATUS
* OPEN ARCHIVE FILE.
SA1 CPAR+/COMSPFS/CPTB
SA2 TAPE
MX0 42 SET ARCHIVE FILE NAME
BX6 X0*X1
BX2 -X0*X2
BX6 X6+X2
SA6 A2
SX2 TAPE SET OPTICAL DISK EXTENSION BUFFER
SA3 PRSC
RJ SOE SET FET EXTENSION IF OPTICAL DISK FILE
OPEN TAPE,READNR,R
SA1 CPAR+/COMSPFS/CPSF
ZR X1,PRS1 IF NO FILE SKIP COUNT SPECIFIED
SKIPFF TAPE,X1
* INITIALIZE FILES AND DEVICE ENVIRONMENT.
PRS1 RJ IOF INITIALIZE OUTPUT FILES
SX3 PRSA PRESET *K* DISPLAY COORDINATES
RJ PRK
RJ BMT BUILD MASS STORAGE TABLE
SX6 DSTBUF SET DEVICE STATUS BUFFER ADDRESS
RJ ODV OUTPUT DEVICE STATUS
SX0 ENDB SET BUFFER ADDRESS
RJ RPS READ FILE SELECTIONS
RJ SMK SET FILE SELECTION MASK
RJ SMP SET MASTER DEVICE PARAMETERS
RJ GAM GENERATE ACCOUNTING MESSAGES
RJ STC SET TAPE CHARACTERISTICS
READCW TAPE,17B INITIATE CONTROL WORD READ
BX6 X6-X6 CLEAR CONTROL WORD STATUS WORD
SA6 TAPE+CWSW
RJ PAL PROCESS ARCHIVE LABEL
SB2 ERAL * ERROR IN ACHIVE FILE LABEL.*
NZ X6,ABT IF BAD ARCHIVE FILE LABEL
RJ SFP SET PERMANENT FILE PARAMETERS
* SET UTILITY CONTROL DATE UPDATE FLAG.
SA1 CPAR+/COMSPFS/CPUD
ZR X1,PRS3 IF UNCONDITIONAL UPDATE NOT SELECTED
SA1 /COMSPFS/STDT SET TO UPDATE UTILITY CONTROL DATE
BX6 X1
SA6 UDAT
* PROCESS INCREMENTAL LOAD PARAMETERS.
PRS3 RJ PCI PROCESS CATALOG IMAGE
RJ IFL INITIALIZE OUTPUT FILE FOR FILE PROCESSING
SA1 CPAR+/COMSPFS/CPOP
LX1 59-49
PL X1,PRSX IF EXTRACT OPTION NOT SPECIFIED
SA1 INCF
SB2 EREC * EXTRACT OPTION REQUIRES CIR.*
ZR X1,ABT IF CATALOG IMAGE RECORD NOT PRESENT
SA1 ACEA SET END OF LOAD CONTROL WORD
SX7 B1 SET CONTROL WORD RE-USE FLAG
BX6 X1
SA7 RCWF
SA6 CWBF
EQ PRSX RETURN
PRSA BSS 0 Y-COORDINATE TABLE
KDL *
PRSC VFD 36/,6/ODEBL,18/ODEB POINTER TO *OD* EXT. BUFFER
TITLE PRESET SUBROUTINES.
GAM SPACE 4,20
** GAM - GENERATE ACCOUNTING MESSAGES.
*
* ENTRY (MASK) = MASK OF MASTER DEVICES BEING LOADED.
* (CPAR) = COMVERTED PARAMETER ARRAY.
*
* EXIT SELECTION PARAMETERS PUT IN ACCOUNTING MESSAGES.
* APPROPRIATE ACCOUNTING MESSAGES ISSUED TO DAYFILE AND
* OUTPUT FILE.
*
* USES X - 0, 1, 2, 5, 6, 7.
* A - 1, 2, 5, 6, 7.
*
* CALLS COD, SFN.
*
* MACROS EDATE, ETIME, MESSAGE, MOVE, WRITEH.
GAM SUBR ENTRY/EXIT
* PUT CORRECT DEVICE NUMBER IN MESSAGES.
SA1 CPAR+/COMSPFS/CPDN
SA2 CPAR+/COMSPFS/CPTD
MX6 -6
IX1 X1+X2
BX1 -X6*X1 SET *DN* OR *TD* DEVICE NUMBER
RJ COD
MX0 24
SA5 MSGC+1
BX5 X0*X5
BX7 -X0*X6
BX7 X7+X5
SA7 A5 SET DEVICE NUMBER IN MESSAGE
* PUT FAMILY/PACK NAME IN MESSAGES.
SA5 CPAR+/COMSPFS/CPPN SET PACKNAME PARAMETERS
SA2 GAMM
MX0 42
BX1 X5
NZ X5,GAM3 IF PACKNAME SPECIFIED
SA2 GAML SET FAMILY NAME PARAMETERS
SA1 CPAR+/COMSPFS/CPFN
GAM3 LX6 X2
BX1 X0*X1 PUT FAMILY/PACK NAME IN MESSAGE
SA6 MSGC+2
RJ SFN
ZR X5,GAM4 IF PACKNAME NOT SPECIFIED
SA1 GAMN PUT PACKNAME IN MESSAGE
BX7 X1
SA7 A6-B1
GAM4 BX6 X0*X6 ADD PERIOD TO NAME
SX2 1L.
BX1 -X0*X2
BX6 X6+X1
SA6 MSGC+3
MESSAGE MSGC,,R
WRITEH O,GAMJ,1
WRITEH O,MSGC,4
SA1 CPAR+/COMSPFS/CPUD
ZR X1,GAM5 IF UTILITY CONTROL UPDATE NOT REQUESTED
WRITEH O,GAMO,4
GAM5 SA5 CPAR+/COMSPFS/CPOP
BX1 X5
LX1 59-46
PL X1,GAM6 IF OP=Z NOT SPECIFIED
WRITEH O,GAMP,4
GAM6 MX0 2
LX5 3
SA1 GAMI
BX5 X0*X5
LX6 X1
ZR X5,GAM8 IF NOT INDIRECT OR DIRECT ONLY
SA6 GAMK
SX2 GAMH
PL X5,GAM7 IF DIRECT ONLY
SX2 GAMG
GAM7 MOVE 3,X2,GAMK+1
WRITEH O,GAMK,4
GAM8 SA5 CPAR+/COMSPFS/CPOP
MX0 3
BX5 X0*X5
ZR X5,GAM11 IF NO DATE OPTION SPECIFIED
LX5 2
SA2 X5+GAMD LOAD *CREATED*, *ACCESSED*, OR *MODIFIED*
SA5 CPAR+/COMSPFS/CPAD
BX6 X2
SA6 GAMK SET DATE/TIME OPTION MESSAGE
ZR X5,GAM9 IF AFTER DATE NOT SPECIFIED
SA2 GAMC
BX1 X5
AX1 18
BX6 X2
SA6 GAMK+1 SET *AFTER* IN MESSAGE
EDATE X1
MX2 -18
SA6 GAMK+2 SET DATE IN MESSAGE
BX1 -X2*X5
ETIME X1
SA6 GAMK+3 SET TIME IN MESSAGE
GAM9 SA5 CPAR+/COMSPFS/CPBD
ZR X5,GAM10 IF BEFORE DATE NOT SPECIFIED
SA2 GAMC+1
BX6 X2
SA6 A6+B1 SET *BEFORE* IN MESSAGE
BX1 X5
AX1 18
SA0 A6+B1
EDATE X1
MX2 -18
SA6 A0 SET DATE IN MESSAGE
BX1 -X2*X5
SA0 A6+B1
ETIME X1
SA6 A0 SET TIME IN MESSAGE
GAM10 WRITEH O,GAMK,A6-GAMK+1
GAM11 SA2 /COMSPFS/FISP
ZR X2,GAM12 IF NO FILE SELECTIONS
MOVE 2,GAMB,GAMK *SELECTED FILES ON *
SA1 CPAR+/COMSPFS/CPUI
NZ X1,GAM13 IF ONLY 1 USER INDEX
MOVE 3,GAMQ,GAMK+2 * MULTIPLE USER INDICES*
EQ GAM14 WRITE MESSAGE
GAM12 SA1 CPAR+/COMSPFS/CPUI
ZR X1,GAMX IF NO USER INDEX SELECTED
MOVE 2,GAMA,GAMK * ALL FILES FOR *
GAM13 SA2 GAMF
SA1 CPAR+/COMSPFS/CPUI
BX6 X2
SA6 GAMK+2 *USER INDEX*
RJ COD
LX6 12
SA6 A6+B1
SA1 =10H
BX6 X1
SA6 GAMK+4
GAM14 WRITEH O,GAMK,5
EQ GAMX RETURN
GAMA DATA 20H ALL FILES FOR
GAMB DATA 20HSELECTED FILES ON
GAMC DATA 10H AFTER
DATA 10H BEFORE
GAMD DATA 10H MODIFIED
DATA 10H ACCESSED
DATA 10H CREATED
GAMF DATA 10HUSER INDEX
GAMG DATA 30H INDIRECT ACCESS FILES ONLY
GAMH DATA 30H DIRECT ACCESS FILES ONLY
GAMI DATA 10H LOADING -
GAMJ DATA 10H1
GAMK DATA 40H
DATA 30H
GAML DATA 10H FAMILY
GAMM DATA 10H PACK
GAMN DATA 10H PACK
GAMO DATA 40H UPDATE UTILITY CONTROL DATE.
GAMP DATA 40H CLEAR ALTERNATE STORAGE INFORMATION.
GAMQ DATA 30H MULTIPLE USER INDICES
PCI SPACE 4,20
** PCI - PROCESS CATALOG IMAGE RECORD.
*
* EXIT (RCWF) = SET IF A CONTROL WORD OTHER THAN FOR A
* CATALOG IMAGE RECORD WAS FOUND BEFORE
* EOF/EOI.
* (INCF) = NON-ZERO IF CATALOG IMAGE FOUND AND NOT TO
* BE IGNORED.
* CATALOG IMAGE COPIED TO SCRATCH FILE AND DIRECTORY
* BUILT IF (INCF) IS NON-ZERO.
* CATALOG IMAGE SKIPPED IF PRESENT AND (INCF) IS ZERO.
* ARCHIVE FILE POSITIONED FOR PROCESSING FIRST RECORD
* THAT IS NOT A CATALOG IMAGE RECORD. THIS MAY BE AT
* EOF/EOI.
* EXIT TO *ABT* IF FATAL ERROR.
*
* USES X - 0, 1, 2, 3, 5, 6, 7.
* A - 1, 2, 3, 5, 6, 7.
* B - 2, 3.
*
* CALLS COD, ICI, KIP, OCI, PSI, RCW, SCI, SEM, SER.
*
* MACROS CWREAD, MESSAGE, MOVE, WRITER, WRITEW.
PCI14 RJ SCI SKIP CATALOG IMAGE
PCI SUBR ENTRY/EXIT
SA1 CPAR+/COMSPFS/CPOP
LX1 59-48
NG X1,PCI14 IF OMIT *CIR* SPECIFIED
RJ RCW READ ARCHIVE FILE CONTROL WORD
NG X3,PCI14 IF EOR/EOF/EOI OR READ ERROR
SX1 X3-5
ZR X1,PCI0 IF CATALOG IMAGE RECORD
SX6 B1 SET CONTROL WORD RE-USE FLAG
SA6 RCWF
EQ PCIX RETURN
* INITIALIZE FOR INCREMENTAL LOAD.
PCI0 SA1 TLBF+/COMSPFS/PFAL
NZ X1,PCI1 IF ARCHIVE FILE LABEL READ
SB2 ERMI * NO ARCHIVE LABEL ON INCREMENTAL LOAD...*
EQ ABT ABORT
PCI1 SX7 B1 SET INCREMENTAL LOAD FLAG
BX6 X6-X6
SA7 INCF
SB2 CIRT SET FWA TO CLEAR
SB3 CIRT+CIRTL SET LWA+1 TO CLEAR
PCI2 SA6 B2 CLEAR WORD OF BUFFERS
SB2 B2+B1
LT B2,B3,PCI2 IF NOT END OF BUFFERS
RJ ICI INITIALIZE FOR OUTPUT OF CIR DATA
PCI3 MESSAGE MSCI,1 * CREATING CATALOG IMAGE RECORD*
SA5 IDSA+/COMSPFS/ADMS
MOVE 3,MSCI,X5
BX6 X6-X6 CLEAR CATALOG TRACK WORD COUNT
SA6 PCIB
* COPY CATALOG IMAGE RECORD INFORMATION.
PCI4 SA1 CWBF SET BLOCK WORD COUNT
MX2 -9
BX0 -X2*X1
LX1 0-48 CHECK IF NEW DEVICE
MX2 -12
BX3 -X2*X1
LX1 0-36-0+48 SET CATALOG TRACK COUNT
SX6 X3-2RCH
NZ X6,PCI5 IF NOT NEW DEVICE
BX7 -X2*X1
LX1 0-24-0+36 SET DEVICE MASK
SA7 PCIE
BX6 -X2*X1
MX2 -24
SA6 PCIF
SA3 PCIC SET DIRECTORY ADDRESS FOR NEXT DEVICE
SX6 X3+NWCD
BX7 -X2*X1 PUT DEVICE HEADER IN DIRECTORY
SA6 A3
SX2 X6-CIRT-NWCD*NDEV
PL X2,PCI10 IF TOO MANY DEVICES
SA7 X6+
PCI5 SA1 PCIC CHECK FOR DEVICE HEADER
SX2 X1-CIRT
NG X2,PCI10 IF NO DEVICE HEADER
ZR X0,PCI7 IF ZERO WORD COUNT
CWREAD TAPE,TDBF,X0 READ CATALOG IMAGE BLOCK
NZ X7,PCI11 IF READ ERROR
NZ B7,PCI10 IF INCOMPLETE CATALOG IMAGE BLOCK
WRITEW CIRF,TDBF,X0 COPY BLOCK TO SCRATCH FILE
SA1 PCIB INCREMENT WORD COUNT
IX6 X1+X0
SA6 A1
NZ X1,PCI6 IF NOT FIRST BLOCK
SA1 PCIE SET CATALOG TRACK MASK
SA2 TDBF GET USER INDEX
SX6 X1-1
LX2 0-3 SET CATALOG TRACK
BX7 X6*X2
SA7 PCID
* WRITE CIR DATA TO SELECTED OUTPUT FILES.
PCI6 SX6 TDBF SET BUFFER ADDRESS
SX7 X0 SET WORD COUNT
RJ OCI OUTPUT CATALOG IMAGE ENTRIES
* CHECK FOR EOR (END OF CATALOG TRACK).
PCI7 SA2 CWBF CHECK FOR EOR BLOCK
MX0 -3
LX2 0-9
BX6 -X0*X2
NZ X6,PCI8 IF EOR BLOCK
RJ RCW READ ARCHIVE FILE CONTROL WORD
NZ X7,PCI11 IF READ ERROR
SX6 X3-5
NZ X6,PCI10 IF NOT CATALOG IMAGE CONTROL WORD
EQ PCI4 COPY MORE CATALOG IMAGE RECORD
* SET DIRECTORY ENTRY.
PCI8 SA1 PCIB
ZR X1,PCI9 IF AN EMPTY CATALOG TRACK
SA2 CIFC UPDATE TOTAL FILE COUNT
AX3 X1,B1 FILE COUNT = WORD COUNT / 2
IX6 X2+X3
SA6 A2
LX3 30 30/FILE COUNT, 30/RANDOM INDEX
SA2 PCIA
BX6 X3+X2
AX1 6 SECTOR COUNT = WORD COUNT / 64 + 1
SX7 B1
IX0 X1+X7
SA3 PCIC GET DIRECTORY ADDRESS
SA1 PCID GET CATALOG TRACK
IX7 X2+X0 UPDATE RANDOM INDEX
SA7 A2
IX3 X3+X1 SAVE DIRECTORY ENTRY
SA6 X3+B1
WRITER CIRF,R FLUSH THIS CATALOG TRACK
* PROCESS END OF CATALOG IMAGE RECORD.
PCI9 RJ RCW READ ARCHIVE FILE CONTROL WORD
NZ X7,PCI11 IF READ ERROR
SX6 X3-5
ZR X6,PCI3 IF CATALOG IMAGE RECORD
NG X1,PCI9.1 IF EOF/EOI
NZ X1,PCI9 IF EOR
MESSAGE (=C**),1 CLEAR CREATING CATALOG IMAGE MESSAGE
SA5 IDSA+/COMSPFS/ADMS
MOVE 3,BLNK,X5
SX6 1 SET CONTROL WORD RE-USE FLAG
SA6 RCWF
PCI9.1 RJ PSI PROCESS SORTED CIR OUTPUT
EQ PCIX RETURN
* PROCESS CATALOG IMAGE RECORD FORMAT ERROR.
PCI10 SB2 ERIF * CATALOG IMAGE FORMAT ERROR.*
EQ ABT ABORT
* PROCESS CATALOG IMAGE RECORD READ ERROR.
PCI11 SA7 AREF INDICATE READ ERROR
SA1 PCIF PUT DEVICE MASK IN MESSAGE
RJ COD
SA1 =1A. ADD PERIOD TO MESSAGE
LX6 30
BX5 X1-X6
SA1 PCID PUT CATALOG TRACK IN MESSAGE
RJ COD
LX6 6
BX7 X6-X5
SA7 ERIR+3
SA5 IDSA+/COMSPFS/ADER PUT MESSAGE ON *K* DISPLAY
MOVE 4,ERIR,X5
SB2 ERIR *READ ERROR IN CATALOG IMAGE*
RJ SEM SEND ERROR MESSAGE
SB3 PCI12 SET *K.GO.* PROCESSOR ADDRESS
SB2 PCI13 SET *K.ANYTHING ELSE.* PROCESSOR ADDRESS
EQ /COMSPFS/KIP PROCESS KEYBOARD INPUT
* PROCESS *K.GO.* RESPONSE TO READ ERROR.
PCI12 RJ SER SKIP TO END OF RECORD
EQ PCI8 BUILD DIRECTORY ENTRY
PCI13 SB2 B0 SET NO MESSAGE
EQ ABT ABORT
PCIA CON 1 RANDOM INDEX FOR *CIR*
PCIB CON 0 CATALOG TRACK WORD COUNT
PCIC CON CIRT-NWCD CURRENT DIRECTORY ADDRESS
PCID CON 0 CURRENT CATALOG TRACK
PCIE CON 0 NUMBER OF CATALOG TRACKS FOR DEVICE
PCIF CON 0 DEVICE MASK BEING READ
SMP SPACE 4,20
** SMP - SET MASTER DEVICE PARAMETERS.
*
* ENTRY (MSTBUF) = MST ENTRY OF DEVICE DESCRIBED BY
* PACKNAME PARAMETER.
*
* EXIT PACK NAME, UNIT COUNT AND EQUIPMENT MNEMONIC SET IN
* *PURG* FET IF AUXILIARY DEVICE BEING LOADED.
* (DDMA) = DESTINATION DEVICE *MSTT* ADDRESS IF
* DESTINATION DEVICE SPECIFIED.
* TO *ABT* IF DESTINATION DEVICE NOT FOUND.
*
* USES X - 1, 2, 3, 6, 7.
* A - 1, 2, 6, 7.
* B - 2, 3.
*
* CALLS SFD.
SMP SUBR ENTRY/EXIT
* INITIALIZE *PURG* FET FOR AUXILIARY DEVICE.
SA1 CPAR+/COMSPFS/CPPN
ZR X1,SMP5 IF PACK NAME NOT SPECIFIED
SA2 MSTBUF+DDLL SET UNIT COUNT
MX3 -3
LX2 12
BX1 -X3*X2
SA2 MSTT+1
LX2 -18 SET EQUIPMENT MNEMONIC
SX1 X1+B1
MX3 -11
BX6 X6+X1 MERGE UNIT COUNT WITH PACK NAME
SA1 PURG+1 CLEAR OLD MNEMONIC FROM FET
BX2 -X3*X2
MX3 -48
SA6 PURG+CFPK
BX1 -X3*X1
LX2 48 PUT MNEMONIC IN FET
BX7 X2+X1
SA7 A1
* SET DESTINATION DEVICE *MSTT* ADDRESS.
SMP5 SA2 CPAR+/COMSPFS/CPDD
ZR X2,SMPX IF NO DESTINATION DEVICE
BX6 X2
RJ SFD SEARCH FOR DEVICE
NZ X1,SMP6 IF DEVICE FOUND
SB2 ERDN * DESTINATION DEVICE NOT FOUND.*
EQ ABT ABORT
SMP6 SX6 A1+ SET DESTINATION DEVICE *MSTT* ADDRESS
SA6 DDMA
EQ SMPX RETURN
STC SPACE 4,10
** STC - SET TAPE CHARACTERISTICS.
*
* EXIT TAPE CHARACTERISTICS SET IN FET.
*
* USES X - 1, 2, 3, 4, 5, 6.
* A - 1, 4, 5, 6.
*
* MACROS FILINFO, RECALL, SETFS.
STC SUBR ENTRY/EXIT
RECALL TAPE
MX1 42
SA5 X2 SET ARCHIVE FILE NAME IN PARAMETER BLOCK
SA4 STCA
BX5 X1*X5
SX4 X4
BX6 X5+X4
SA6 A4
FILINFO STCA GET FILE INFORMATION
SA1 STCA+1 GET TAPE DEVICE TYPE
SA4 STCA+FIPBL GET TAPE FORMAT
LX1 59-24
PL X1,STC3 IF NOT TAPE FILE
MX3 2
LX1 59-26-59+24
BX6 X3*X1 SET TAPE DEVICE TYPE
SA5 A4+1 GET DENSITY, CONVERSION MODE, LABEL TYPE
LX6 56-59
LX4 -6
MX1 -6
LX5 -6
BX4 -X1*X4 TAPE FORMAT
BX2 -X1*X5 DENSITY AND CONVERSION MODE
LX5 -6
BX5 -X1*X5 LABEL TYPE
LX4 30
SA1 A5+1 GET PROCESSING OPTIONS
BX6 X6+X4
LX2 -12
MX4 -12
LX1 -12
BX6 X6+X2
SX2 7757B
BX1 -X4*X1 PROCESSING OPTIONS
BX1 X2*X1 CLEAR PO=W IF SELECTED
SX2 /MTX/POGH*100B+/MTX/POLM*200B
BX1 X1-X2 SET OPTIONS TO TOGGLE INSTALLATION BITS
LX1 -24
BX6 X6+X1
ZR X5,STC2 IF UNLABELED
MX3 1
LX3 58-59 SET LABELED TAPE BIT
BX6 X6+X3
SX5 X5-14B
NZ X5,STC2 IF STANDARD LABELS
LX3 57-59-58+59 SET NONSTANDARD LABEL BIT
BX6 X6+X3
STC2 SA6 TAPE+LBWD SET TAPE INFORMATION
STC3 SETFS TAPE,0 CLEAR SPECIAL FILE STATUS
EQ STCX RETURN
STCA VFD 42/0,6/STCAL,12/1 *FILINFO* PARAMETER BLOCK
BSS FIPBL-1
CON FMTK FORMAT KEYWORD
CON DENK DENSITY, CONVERSION, LABEL TYPE KEYWORD
CON POPK PROCESSING OPTIONS KEYWORD
STCAL EQU *-STCA
SPACE 4,10
* PRESET MESSAGES.
MSCI DATA 30CCREATING CATALOG IMAGE RECORD
SPACE 4,10
* PRESET ERROR MESSAGES.
ERDN DATA C* DESTINATION DEVICE NOT FOUND.*
EREC DATA C* EXTRACT OPTION REQUIRES CIR.*
ERIF DATA C* CATALOG IMAGE FORMAT ERROR.*
ERIR DATA 40C READ ERROR IN CATALOG IMAGE DM CT.
ERMI DATA C* NO ARCHIVE LABEL ON INCREMENTAL LOAD FILE.*
COMMON SPACE 4,10
** PRESET COMMON DECKS.
*CALL COMCDCP
LIST X
*CALL COMCPFP
LIST *
*CALL COMCRSB
*CALL COMCSOE
PRK HERE ASSEMBLE Y-COORDINATE PRESET CODE HERE
SPACE 4,10
* PRESET BUFFERS.
ESTADD EQU * RSB PARAMETER WORD FOR EST
ESTBUF EQU ESTADD+1 EST BUFFER
MSTADD EQU ESTBUF+ESMX*ESTE *RSB* PARAMETER WORD FOR MST READ
MSTBUF EQU MSTADD+1 MST BUFFER
DSTBUF EQU MSTBUF+MSTL
PRSL EQU DSTBUF+2*63+2 PRESET LWA+1
SPACE 4
END