IDENT PFDUMP1,/COMSPFS/OVLB,PFD,01,00
ABS
SST
SYSCOM B1
TITLE PFDUMP - PERMANENT FILE DUMP.
SPACE 4,10
*COMMENT PFDUMP - PERMANENT FILE DUMP.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
SPACE 4,10
*** PFDUMP - PERMANENT FILE DUMP UTILITY.
* D. A. HIVELEY 71/09/30.
* S. T. WORSTELL 72/06/05.
* P. L. VERELL 79/06/28.
* G. S. YODER 87/01/31.
SPACE 4,10
*** *PFDUMP* IS A PERMANENT FILE UTILITY THAT COPIES FILES STORED
* ON A PERMANENT FILE DEVICE TO A BACKUP STORAGE FILE. FILES
* CREATED BY *PFDUMP* MAY BE RELOADED BY THE *PFLOAD* UTILITY
* PROGRAM.
*
* *PFDUMP* MAY BE CALLED BY THE PERMANENT FILE SUPERVISOR *PFS*
* OR BY COMMAND. SEE *COMSPFS* FOR A DESCRIPTION OF THE
* PARAMETERS VALID FOR *PFDUMP*.
*
* PERMANENT FILE DUMPS ARE CLASSIFIED AS ONE OF THE FOLLOWING
* TYPES -
*
* 1. FULL - NO OPTIONS ARE SPECIFIED EXCEPT FOR FAMILY NAME OR
* PACK NAME, MASTER DEVICE NUMBER (*DN*) OR TRUE DEVICE
* NUMBER (*TD*). IF *DN* IS SPECIFIED, IT MUST BE A MASTER
* DEVICE. IF A DEVICE NUMBER IS NOT SPECIFIED, THE ENTIRE
* FAMILY WILL BE PROCESSED.
*
* 2. INCREMENTAL - ALL FILES CHANGED SINCE SOME SPECIFIED DATE
* AND TIME (USUALLY THE PREVIOUS INCREMENTAL OR FULL DUMP)
* ARE DUMPED USING THE *OP=M*, *AD* AND *AT* OPTIONS.
* THE ONLY OTHER OPTIONS THAT ARE SPECIFIED ARE THOSE FOR A
* FULL DUMP.
*
* FULL AND INCREMENTAL DUMPS ARE USED TOGETHER TO RESTORE A
* PERMANENT FILE BASE AFTER A DEVICE FAILURE. IF FULL DUMPS
* ARE PERFORMED BY DEVICE, THE CORRESPONDING INCREMENTAL DUMPS
* SHOULD BE PERFORMED USING THE SAME DEVICE NUMBERS.
*
* 3. PARTIAL - ANY OTHER OPTIONS ARE SPECIFIED TO RESTRICT THE
* FILES SELECTED TO BE DUMPED. PARTIAL DUMPS ARE NOT
* GENERALLY USED AS PART OF A PERMANENT FILE BACKUP SCHEME.
*
*
* PERMANENT FILE DUMPS DO NOT REQUIRE AN IDLE SYSTEM. HOWEVER,
* EACH CATALOG TRACK IS INTERLOCKED WHILE THE FILES CATALOGED
* THERE ARE DUMPED. DURING THIS TIME NO USER MAY PEFORM
* PERMANENT FILE OPERATIONS ON THOSE FILES, ALTHOUGH A
* USER CAN CONTINUE TO ACCESS A DIRECT ACCESS FILES WHICH
* WAS ATTACHED EARLIER. *PFDUMP* WILL NOT DUMP ANY FILE
* WHICH IS CURRENTLY ATTACHED IN WRITE, MODIFY OR APPEND
* MODE; A FILE CURRENTLY ATTACHED IN UPDATE MODE WILL BE
* DUMPED EXCEPT ON A DESTAGE DUMP (*DT* OPTION).
*
* SECURITY CONSIDERATIONS.
*
* IN AN UNSECURED SYSTEM, *PFDUMP* WILL USE THE *LA* AND *UA*
* PARAMETERS AS SELECTION CRITERIA ALONG WITH ANY OTHER
* SPECIFIED PARAMETERS.
*
* IN A SECURE SYSTEM, *PFDUMP* MUST ENSURE TWO THINGS. FIRST,
* THAT THE RANGE OF ACCESS LEVELS DUMPED IS WITHIN THE SYSTEM
* ACCESS LIMITS. SECOND, THAT THE EQUIPMENT TO WHICH THE
* ARCHIVE (AND VERIFY) FILES ARE ASSIGNED HAVE APPROPRIATE
* ACCESS LEVEL LIMITS TO ALLOW PROCESSING OF ALL POTENTIALLY
* DUMPED FILES.
*
* IF THE *LA* AND *UA* PARAMETERS ARE USED TO SELECT THE RANGE
* OF ACCESS LEVELS, *PFS* HAS VERIFIED THAT THEY ARE WITHIN
* THE SYSTEM ACCESS LEVEL LIMITS. IF THESE PARAMETERS ARE NOT
* USED, THE RANGE IS CALCULATED AS THE MAXIMUM RANGE DEFINED BY
* THE DEVICE ACCESS LEVEL LIMITS OF ALL THE DEVICES TO BE
* PROCESSED BY *PFDUMP*.
SPACE 4,30
*** MESSAGE LEGEND.
*
* THE FOLLOWING LEGEND DEFINES PARAMETERS THAT ARE USED IN MANY
* OF THE *PFDUMP* 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 = NUMBER OF FILES
* NNNNNNN = PERMANENT FILE NAME.
* RRRRRRRR = RELATIVE PRU OF FILE CONTAINING AN ERROR.
* UUUUUU = USER INDEX.
SPACE 4,10
*** INFORMATIVE DAYFILE MESSAGES.
*
* * MMMMMM FILES SKIPPED WITH ERRORS.*
* THE NUMBER OF SELECTED FILES WHICH COULD NOT BE
* DUMPED.
*
* * MMMMMM FILES DUMPED WITH PERMIT/DATA ERRORS.*
* THE NUMBER OF FILES ON WHICH DISK ERRORS WERE
* ENCOUNTERED DURING THE DUMP PROCESS. IF THESE FILES
* ARE RELOADED, *PFLOAD* WILL SET THE APPROPRIATE ERROR
* FLAGS IN THE FILE-S *PFC* ENTRY (SEE *EO* OPTION
* DOCUMENTATION).
*
* * MMMMMM *PFC ONLY* FILES DUMPED.
* THE NUMBER OF ALTERNATE STORAGE RESIDENT FILES FOR
* WHICH ONLY THE *PFC* AND PERMITS WERE DUMPED.
*
* * MMMMMM FILES SELECTED FOR *PFC ONLY* DUMP.*
* THE NUMBER OF ALTERNATE STORAGE RESIDENT FILES
* SELECTED TO HAVE ONLY THE *PFC* AND PERMITS DUMPED
* WHEN THE *IP* OPTION WAS SPECIFIED.
*
* * MMMMMM FILES DUMPED.*
* THE NUMBER OF FILES DUMPED TO THE ARCHIVE FILE.
*
* * MMMMMM FILES SELECTED FOR DUMP.*
* THE NUMBER OF FILES SELECTED FOR DUMP WHEN THE *IP*
* OPTION WAS SELECTED.
*
* * MMMMMM DUMPED FILES STAGED.*
* THE NUMBER OF FILES WHICH WERE STAGED FROM ALTERNATE
* STORAGE MEDIA TO DUMP THE FILE DATA.
*
* * MMMMMM DUMPED FILES PURGED.*
* THE NUMBER OF FILES PURGED AFTER BEING DUMPED WHEN
* *OP=P* WAS SPECIFIED.
*
* * MMMMMM DUMPED FILES NOT PURGED.*
* THE NUMBER OF FILES WHICH WERE DUMPED BUT NOT PURGED
* WHEN THE *OP=P* OPTION WAS SPECIFIED. THIS WILL OCCUR
* WHEN DATA OR PERMIT ERRORS ARE ENCOUNTERED DURING A
* FILE DUMP OR WHEN A FILE IS PURGED BY A USER BETWEEN
* THE TIME OF THE FILE DUMP AND THE *PFDUMP* PURGE
* PROCESSING.
*
* * MMMMMM DUMPED FILES DESTAGED.*
* THE NUMBER OF DUMPED FILES FOR WHICH THE TAPE
* ALTERNATE STORAGE INFORMATION WAS SET IN THE FILE-S
* *PFC* ENTRY WHEN A DESTAGE DUMP (DT OPTION) WAS
* SPECIFIED.
*
* * MMMMMM DUMPED FILES NOT DESTAGED.*
* THE NUMBER OF DUMPED FILES FOR WHICH THE TAPE
* ALTERNATE STORAGE INFORMATION WAS NOT SET IN THE
* FILE-S *PFC* ENTRY WHEN A DESTAGE DUMP (DT OPTION) WAS
* SPECIFIED. THIS WILL OCCUR WHEN DATA OR PERMIT ERRORS
* ARE ENCOUNTERED DURING A FILE DUMP OR WHEN A FILE IS
* MODIFIED OR PURGED BY A USER BETWEEN THE TIME OF THE
* FILE DUMP AND THE *PFDUMP* ALTERNATE STORAGE UPDATE
* PROCESSING.
*
* * NO FILES PROCESSED.*
* NO FILES WERE DUMPED ON THIS DEVICE.
*
* * PFDUMP COMPLETE.*
* *PFDUMP* TERMINATED WITHOUT FATAL ERRORS.
SPACE 4,10
*** FATAL ERROR DAYFILE MESSAGES.
*
* THESE ERRORS RESULT IN *PFDUMP* ABORTING.
*
* * ACCESS LEVEL LIMITS OUT OF RANGE.*
* THE DEVICE ACCESS LEVELS OF THE DEVICES THAT WILL BE
* PROCESSED CONTAIN A RANGE OF ACCESS LEVELS OUTSIDE THE
* SYSTEM ACCESS LEVEL LIMITS.
*
* * ACCESS LEVELS NOT ALLOWED ON ARCHIVE FILE EQUIPMENT.*
* THE RANGE OF ACCESS LEVELS TO BE DUMPED IS NOT ALLOWED
* ON THE EQUIPMENT WHERE THE ARCHIVE FILE, THE VERIFY
* FILE, THE RELEASE DATA FILE, OR THE SUMMARY FILE
* RESIDES.
*
* * INTERNAL ERROR ON FILE ZZZZZOD.*
* PFDUMP WAS NOT ABLE TO LOCATE THE SPECIFIED OPTICAL
* DISK ARCHIVE FILE IN THE *ZZZZZOD* FILE.
*
* * NO FILES SELECTED.*
* THE FILE SELECTION PARAMETERS SPECIFIED FOR THE DUMP
* WERE SUCH THAT NO DEVICES IN THE SYSTEM COULD CONTAIN
* THE SPECIFIED FILES. THIS MAY BE CAUSED BY
* CONFLICTING SELECTION PARAMETERS.
*
* * NT/CT/AT TAPE OR OD REQUIRED FOR DESTAGE.*
* THE FILE SPECIFIED FOR EITHER THE ARCHIVE FILE OR THE
* VERIFY FILE A DESTAGE DUMP WAS NOT AN *NT*, *CT* OR
* *AT* TAPE OR AN *OD* OPTICAL DISK DEVICE.
*
* * OPTICAL DISK LABEL NOT VALID FOR DESTAGE.*
* THE SPECIFIED OPTICAL DISK ARCHIVE FILE EITHER DOES
* NOT HAVE A RECORDED FILE NAME OF *PFARCHIVE*, DOES NOT
* HAVE AN OWNER IDENTIFIER OF *SYSTEMX*, OR DOES NOT
* HAVE A GROUP IDENTIFIER EQUAL TO THE FAMILY OF THE
* ARCHIVE.
*
* * PARTITION NOT VALID FOR DESTAGE.*
* THE SPECIFIED OPTICAL DISK ARCHIVE FILE WAS NOT ON THE
* *DEFAULT* PARTITION.
*
* * SELECTED MASTER OR TRUE DEVICE NOT FOUND.*
* THE DEVICE SPECIFIED WITH THE *DN* OR *TD* PARAMETER
* WAS NOT FOUND.
*
* * VERSION NUMBER EXCEEDED FOR DESTAGE.*
* THE VERSION NUMBER OF THE ARCHIVE FILE IS GREATER THAN
* 4095.
*
* * VSN NOT VALID FOR DESTAGE.*
* THE TAPE OR OPTICAL DISK VSN WAS NOT IN THE CORRECT
* FORMAT FOR DESTAGE. VSNS MUST BE TWO LETTERS FOLLOWED
* BY 4 NUMBERS OF THE RANGE (0 - 4095).
*
SPACE 4,10
*** NON-FATAL ERROR DAYFILE MESSAGES.
*
* SEE *MESSAGE LEGEND* ABOVE FOR A DESCRIPTION OF PARAMETERS
* APPEARING IN THESE MESSAGES.
*
*
* * ALTERNATE STORAGE TAPE READ ERROR, FN=NNNNNNN, UI=UUUUUU.*
* A READ ERROR OCCURRED WHEN COPYING FILE DATA FROM AN
* ALTERNATE STORAGE TAPE. THE FILE DATA IS TRUNCATED AT
* THE POINT OF THE ERROR.
*
* * BAD SYSTEM SECTOR, FN=NNNNNNN, UI=UUUUUU.*
* THE SYSTEM SECTOR FOR THE SPECIFIED FILE IS NOT IN THE
* CORRECT FORMAT. THE FILE IS NOT DUMPED.
*
* * CATALOG READ ERROR, UI=UUUUUU.
* A MASS STORAGE ERROR OCCURRED WHILE READING THE
* PERMANENT FILE CATALOG TRACK FOR THE INDICATED USER
* INDEX. ANY REMAINING FILES CATALOGED ON THE AFFECTED
* TRACK WILL NOT BE DUMPED.
*
* * CATALOG UPDATE ERROR, FN=NNNNNNN, UI=UUUUUU.*
* A DISK READ/WRITE ERROR HAS OCCURRED WHILE ATTEMPTING
* TO UPDATE THE UTILITY CONTROL DATE/TIME OR THE *TFLOK*
* FLAG IN THE CATALOG ENTRY OF THE SPECIFIED FILE.
* ERROR IDLE STATUS IS SET FOR THE DEVICE IF A WRITE
* ERROR OCCURRED AND DATA ON THE CATALOG FILE HAS BEEN
* CORRUPTED.
*
* * DATA READ ERROR, FN=NNNNNNN, UI=UUUUUU.*
* A MASS STORAGE ERROR OCCURRED WHEN DUMPING THE DATA
* OF FILE NNNNNNN. IF NO DATA WAS TRANSFERRED OR IF THE
* FILE DUMP IS SUPPRESSED WITH THE *EO* OPTION, THE FILE
* IS TRUNCATED AT THE POINT OF THE ERROR. IF THE BAD
* SECTOR DATA WAS TRANSFERRED AND THE FILE DUMP IS NOT
* SUPPRESSED, THE REMAINDER OF THE FILE IS DUMPED IF
* POSSIBLE. IN EITHER CASE, IF THE FILE IS LATER
* RELOADED BY *PFLOAD*, THE DATA ERROR FLAG WILL BE SET
* IN THE FILE-S PFC ENTRY.
*
* * DEVICE NOT FOUND, FN=NNNNNNN, UI=UUUUUU, DN_DD.*
* THE SPECIFIED DIRECT ACCESS FILE, RESIDENT ON DEVICE
* *DD*, WAS TO BE DUMPED BUT DEVICE *DD* COULD NOT BE
* FOUND IN THE SYSTEM. THE FILE IS NOT DUMPED.
*
* * FILE BUSY, FN=NNNNNNN, UI=UUUUUU.*
* THE SPECIFIED DIRECT ACCESS FILE WAS BUSY IN WRITE,
* MODIFY, OR APPEND MODE (ANY DUMP) OR WAS BUSY IN ANY
* WRITEABLE MODE (DESTAGE DUMP - *TA* OPTION). THE FILE
* IS NOT DUMPED.
*
* * FILE NOT FOUND ON ALTERNATE STORAGE TAPE, FN=NNNNNNN,
* UI= UUUUUU.*
* THE DATA FOR THE SPECIFIED FILE WAS NOT FOUND ON THE
* ASSIGNED ALTERNATE STORAGE TAPE. THE FILE IS NOT
* DUMPED.
*
* * FILE LENGTH ERROR, FN=NNNNNNN, UI=UUUUUU.*
* THE NUMBER OF DATA SECTORS READ FOR THE INDICATED FILE
* DID NOT MATCH THE LENGTH DETERMINED FROM THE TRT
* (DIRECT ACCESS) OR FROM THE CATALOG (INDIRECT ACCESS).
* IF THE DATA READ EXCEEDS THE DETERMINED LENGTH, THE
* EXCESS SECTORS ARE TRUNCATED.
*
* * NO DISK OR ALTERNATE STORAGE POINTERS FOR FILE, FN=NNNNNNN,
* UI=UUUUUU.*
* THE SPECIFIED FILE HAS NEITHER A DISK IMAGE NOR AN
* ALTERNATE STORAGE IMAGE. THE FILE IS NOT DUMPED.
*
* * PERMIT FORMAT ERROR, FN=NNNNNNN, UI=UUUUUU.*
* THE LENGTH OF A PERMIT SECTOR IS INCORRECT OR THE USER
* INDEX CONTAINED IN A PERMIT SECTOR DID NOT MATCH THE
* USER INDEX OF THE FILE. NO FURTHER PERMITS ARE DUMPED
* FOR THAT FILE. IF THE FILE IS LATER LOADED BY
* *PFLOAD*, THE PERMITS ERROR FLAG WILL BE SET IN THE
* FILE-S PFC ENTRY.
*
* * PERMIT RANDOM INDEX ERROR, FN=NNNNNNN, UI=UUUUUU.*
* A PERMIT RANDOM INDEX FOR THE INDICATED FILE IS NOT
* WITHIN THE PERMITS CHAIN. NO FURTHER PERMITS ARE
* DUMPED FOR THAT FILE. IF THE FILE IS LATER LOADED BY
* *PFLOAD*, THE PERMITS ERROR FLAG WILL BE SET IN THE
* FILE-S PFC ENTRY.
*
* * PERMIT READ ERROR, FN=NNNNNNN, UI=UUUUUUU.*
* A MASS STORAGE ERROR OCCURRED WHEN READING PERMITS FOR
* THE INDICATED FILE. NEITHER THE BAD PERMIT SECTOR NOR
* ANY FOLLOWING IT ARE DUMPED FOR THAT FILE. IF THE
* FILE IS LATER LOADED BY *PFLOAD*, THE PERMITS ERROR
* FLAG WILL BE SET IN THE FILE-S PFC ENTRY.
*
* * STAGED FILE RESCAN TERMINATED, FN=NNNNNNN, UI=UUUUUU.*
* ISSUED FOR EACH FILE NOT DUMPED DUE TO THE OPERATOR
* DISCONTINUING THE RESCAN OF A GIVEN CATALOG TRACK FOR
* STAGED FILES.
*
* * UNABLE TO STAGE FILE, FN=NNNNNNN, UI=UUUUUU.*
* A CARTRIDGE OR TAPE ALTERNATE STORAGE ERROR CONDITION
* PREVENTS THE FILE FROM BEING STAGED AT THIS TIME. THE
* PFC AND PERMITS ONLY ARE DUMPED FOR THIS FILE.
*
* * ZERO LENGTH FILE, FN=NNNNNNN, UI=UUUUUU.*
* THE SPECIFIED FILE EITHER HAS NO SYSTEM SECTOR OR NO
* EOI SECTOR. THE FILE IS NOT DUMPED.
SPACE 4
*** OPERATOR MESSAGES.
*
* * CLEARING PF ACTIVITY COUNT.*
* *PFDUMP* IS WAITING FOR *PFU* TO DECREMENT THE
* PERMANENT FILE ACTIVITY COUNT SINCE DUMPING HAS BEEN
* COMPLETED.
*
* *DUMPING (FILENAME) (USER INDEX)*
*
* * GENERATING CATALOG IMAGE.*
* THE CATALOG IMAGE RECORD IS BEING WRITTEN TO THE
* ARCHIVE FILE (INCREMENTAL DUMP).
* INDICATES THE FILE CURRENTLY BEING DUMPED.
*
* * RESCAN CATALOG TRACK FOR STAGED FILES.*
* * THE RIGHT SCREEN LISTS YOUR OPTIONS.* - *PFDUMP* IS
* RESCANNING THE PREVIOUSLY PROCESSED CATALOG TRACK
* SEARCHING FOR STAGED FILES NEWLY LINKED TO THEIR
* CATALOG ENTRIES.
*
* THE FOLLOWING RIGHT SCREEN DISPLAY REMINDS THE
* OPERATOR HOW TO DISCONTINUE OR CONTINUE THE RESCAN OF
* A GIVEN CATALOG TRACK FOR STAGED FILES.
*
* RESCAN OPTIONS
*
* ENTER K.RO.
*
* RO DESCRIPTION
*
* GO CONTINUE RESCANNING.
* SKIP SCAN NEXT CATALOG TRACK.
*
* * SETTING PF ACTIVITY COUNT.*
* *PFDUMP* IS WAITING FOR *PFU* TO INCREMENT THE
* PERMANENT FILE ACTIVITY COUNT BEFORE DUMPING A DEVICE.
*
* * WAIT FOR ALTERNATE STORAGE INTERLOCK.*
* *PFDUMP* IS ATTEMPTING TO ATTACH ALTERNATE STORAGE
* CATALOG FILES TO INSURE THEIR INCLUSION ON THE DUMP.
*
* * WAIT FOR CATALOG INTERLOCK.*
* *PFDUMP* IS WAITING FOR *PFU* TO SET A CATALOG TRACK
* INTERLOCK BEFORE DUMPING FILES CATALOGED ON THAT
* TRACK.
*
* * WAIT FOR FILE STAGING.*
* *PFDUMP* HAS GONE INTO RECALL AND RELEASED ALL CATALOG
* TRACK INTERLOCKS TO ALLOW THE ALTERNATE STORAGE
* EXECUTIVE(S) TO LINK ANY STAGED FILES TO THEIR
* RESPECTIVE CATALOG ENTRIES.
SPACE 4,10
* COMMON DECKS.
*CALL COMCMAC
*CALL COMCCMD
*CALL COMCDCM
*CALL COMSACC
*CALL COMSLFD
*CALL COMSMLS
*CALL COMSMMF
*CALL COMSMST
QUAL COMSMTX
*CALL COMSMTX
QUAL *
*CALL COMSPFM
LIST X
*CALL COMSPFS
LIST *
*CALL COMSPFU
*CALL COMSPRD
*CALL COMSRPV
*CALL COMSPRO
*CALL COMSSFM
*CALL COMSVER
QUAL TFM
*CALL COMSTFM
QUAL *
TITLE MACROS.
ARCHIVE SPACE 4,20
** ARCHIVE - PROCESS ARCHIVE FILE OPERATION.
*
* ARCHIVE FNC,P1,P2
*
* FNC = FUNCTION CODE MNEMONIC.
* WRITEW = WRITE WORDS ON ARCHIVE FILE.
* P1 = WORKING BUFFER ADDRESS.
* P2 = WORD COUNT.
* WRITER = WRITE EOR ON ARCHIVE FILE. (NO PARAMETERS).
* WRITEF = WRITE EOF ON ARCHIVE FILE. (NO PARAMETERS).
* P1 = FIRST PARAMETER.
* P2 = SECOND PARAMETER.
*
* USES B - 6, 7.
*
* CALLS PAF.
PURGMAC ARCHIVE
ARCHIVE MACRO FNC,P1,P2
MACREF ARCHIVE
.1 SET 0
ECHO 0,F=(WRITEW,WRITER,WRITEF),B6P=(P1,0,17B),B7P=(P2,-1,-1
,)
MATCH IFC EQ,$F$FNC$
R= B6,B6P
R= B7,B7P
RJ PAF
.1 SET 1
STOPDUP
MATCH ENDIF
ENDD
IFNE .1,1,1
ERR ARCHIVE - INCORRECT FUNCTION CODE.
ENDM
CWWRITE SPACE 4,20
** CWWRITE - CONTROL WORD WRITE WORDS.
*
* CWWRITE FET,BUF,BUFL
*
* FET = FET ADDRESS FOR FILE.
* BUF = WORKING BUFFER ADDRESS.
* BUFL = LENGTH OF WORKING BUFFER.
*
* *BUFL* WORDS ARE TRANSFERRED FROM THE WORKING BUFFER *BUF* TO
* THE CIRCULAR BUFFER. BUFFER CONTROL WORDS ARE ADDED AS
* NECESSARY.
*
* USES X - 2.
* B - 6, 7.
*
* CALLS CWW.
PURGMAC CWWRITE
CWWRITE MACRO FET,BUF,BUFL
MACREF CWWRITE
R= B6,BUF
R= B7,BUFL
R= X2,FET
RJ CWW
ENDM
TITLE PROGRAM CONSTANT SECTION.
SPACE 4,10
* MISCELLANEOUS CONSTANTS.
BFAC EQU 1000B BLOCKING FACTOR
DFAC EQU 2500B CATALOG TRACK RESCAN DELAY FACTOR
DLEMX EQU 100B MAXIMUM READ DATA LIST ENTRIES
MSTEL EQU 2 MST TABLE ENTRY LENGTH
MXLRR EQU 5 RETRY LIMIT FOR ARCHIVE FILE LABEL READ
NWCM EQU 100B NUMBER OF WORDS IN A *CMU* MOVE
ERRNZ NWCM-NWCM/10B*10B CHARACTER COUNT = MULTIPLE OF 20B
NWPR EQU 100B NUMBER WORDS/PRU
NWCP EQU NWPR+2 NUMBER WORDS/*CIO* CONTROL WORD PRU
TCRQL EQU 3 LENGTH OF TAPE COPY REQUEST ENTRY
* BUFFER LENGTHS.
CATBL EQU 10*NWCP+1 CATALOG BUFFER LENGTH
CBUFL EQU 10*NWPR CATALOG WORKING STORAGE LENGTH
DBUFL EQU 12001B DATA BUFFER LENGTH
DBUFHL EQU 1101B DATA WORKING STORAGE LENGTH
DLRBL EQU DLEMX+1 DATA LIST REQUEST BUFFER LENGTH
DLCBL EQU DLEMX*NWCE DATA LIST CATALOG BUFFER LENGTH
DLDBL EQU DLEMX DATA LIST DISK ADDRESS BUFFER LENGTH
LKBUFL EQU 401B LOCK BUFFER LENGTH
MSFBL EQU 10001B *COMCMSF* SORT FILES BUFFER LENGTH
ODEBL EQU 20B OPTICAL DISK EXTENSION BUFFER LENGTH
ODFBL EQU 401B OPTICAL DISK MOUNT FILE BUFFER LENGTH
OUTBL EQU 1001B OUTPUT FILE BUFFER LENGTH
PBUFL EQU NWPR+1 PERMIT BUFFER LENGTH
PHBUFL EQU NWPR PERMIT WORKING STORAGE LENGTH
PFLBL EQU 1001B PROCESSED FILES FILE BUFFER LENGTH
PFRBL EQU NWPR+1 *PFM* REQUEST FILE BUFFER LENGTH
RBUFL EQU 4011B RDF BUFFER LENGTH
RDFHL EQU 8 RDF WORKING STORAGE LENGTH
REQBL EQU 101B FILE STAGING REQUEST LIST BUFFER LENGTH
RESBL EQU 101B RESCAN SELECTION SCREEN BUFFER LENGTH
SABFL EQU 1000B SUMMARY FILE ASSEMBLY BUFFER LENGTH
SRTBL EQU 20000B SORT BUFFER LENGTH
SBTCC EQU SRTBL/TCRQL MAXIMUM TAPE COPY REQUESTS IN *SRTB*
SBTCL EQU SBTCC*TCRQL LENGTH OF TAPE COPY REQUESTS IN *SRTB*
SUMBL EQU 1401B SUMMARY FILE BUFFER LENGTH
TBUFL EQU 30061B ARCHIVE (TAPE) FILE BUFFER LENGTH
TCLBL EQU 1001B TAPE COPY FILE LIST BUFFER LENGTH
VBUFL EQU 30061B VERIFY FILE BUFFER LENGTH
* ARCHIVE FILE CONTROL WORD VALUES.
LCWC EQU 01000B LABEL CONTROL WORD
COCW EQU 10000B CATALOG ONLY CONTROL WORD
CCWC EQU 11000B CATALOG CONTROL WORD
PMCW EQU 20000B PERMIT CONTROL WORD
PRCW EQU 21000B PERMIT RECORD CONTROL WORD
DCWC EQU 30000B DATA CONTROL WORD
DRCW EQU 31000B DATA RECORD CONTROL WORD
DFCW EQU 32000B DATA FILE CONTROL WORD
DSCW EQU 34000B DATA SYSTEM SECTOR CONTROL WORD
ERCW EQU 47000B END OF REEL CONTROL WORD
CICW EQU 50000B CATALOG IMAGE CONTROL WORD
CRWC EQU 51000B CATALOG IMAGE RECORD CONTROL WORD
CFCW EQU 52000B CATALOG IMAGE FILE CONTROL WORD
EODC EQU 77000B END OF DUMP CONSTANT
* RELEASE DATA FILE (RDF) CONTROL WORD VALUES.
HCWD EQU 1000B HEADER RECORD CONTROL WORD
ECWD EQU 2007B EXTRACT RECORD CONTROL WORD
CCWD EQU 3000B MSF CATALOG RECORD CONTROL WORD
* *SETPFP* OPTION 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
* *COMSPFS* EQUIVALENCES.
CPAR EQU /COMSPFS/CPL CONVERTED PARAMETER LIST
IDSA EQU /COMSPFS/PADR
TITLE MAIN ROUTINES.
** MAIN PROGRAM.
*
* EXIT TO *END*.
*
* CALLS GLF, GRC, OPN, PCF, PCT, PFR, PRS, PSF, PTF, RLF, RMF,
* SDI, SNC, SND, TER.
*
* MACROS MESSAGE, RETURN, SETPFP.
ORG /COMSPFS/OVLB
PFD RJ PRS PRESET PROGRAM
* PROCESS NEXT DEVICE.
PFD1 RJ SND SET NEXT DEVICE
ZR X1,PFD4 IF NO MORE DEVICES
RJ OPN OPEN DEVICE FILES
RJ GLF GET LOCK FILES
* PROCESS CATALOG TRACK.
PFD2 RJ SNC SET NEXT CATALOG TRACK
RJ PCF POSITION CATALOG FILE
NG X5,PFD3 IF END OF CATALOG TRACKS
RJ PCT PROCESS CATALOG TRACK
EQ PFD2 SET NEXT CATALOG TRACK
* GENERATE *RDF* EXTRACT RECORDS AND RELEASE LOCK FILES.
PFD3 RJ GRC GENERATE *RDF* CATALOG RECORDS
RJ RLF RELEASE LOCK FILES
RJ RMF RETURN MASTER DEVICE FILES
EQ PFD1 SET NEXT DEVICE
* PROCESS TAPE ALTERNATE STORAGE RESIDENT FILES.
PFD4 RJ PTF PROCESS TAPE RESIDENT FILES
* END OF DUMP.
RJ TER TERMINATE ARCHIVE FILE AND RETURN FILES
RJ SDI SET DEVICE INHIBIT DATES
RJ PSF PROCESS SORTED FILE AND STATISTICS OUTPUT
RJ PFR PROCESS *PFM* REQUESTS
EQ END TERMINATE
PCT SPACE 4,20
** PCT - PROCESS CATALOG TRACK.
*
* EXIT ALL SELECTED FILES CATALOGED ON THIS CATALOG TRACK
* DUMPED EXCEPT FOR FILES WHICH WILL BE COPIED FROM
* ALTERNATE STORAGE TAPES.
*
* USES X - 1, 2, 6, 7.
* A - 1, 6, 7.
* B - 2.
*
* CALLS CSI, CCR, CSP, GRE, IRS, MRE, PFI, PPD, PRL, RCS, RFC,
* RFS, SCA.
*
* MACROS MOVE, READCW.
PCT SUBR ENTRY/EXIT
* INITIALIZE NORMAL CATALOG TRACK SCAN.
SX6 B0+ SET NORMAL SCAN MODE
SX7 B0+ SET FIRST CATALOG ON TRACK
* INITIALIZE CATALOG SCAN.
PCT1 SA6 SCAN SET SCAN MODE
SA7 CTIN SET INITIAL CATALOG TRACK INDEX
SX6 B0+
SA6 RSTS CLEAR STAGE REQUEST
SA1 CATS+FTFT
SX6 X1
SA6 A1+B1 SET IN = FIRST
SA6 A1+2 SET OUT = FIRST
READCW CATS,17B INITIATE CATALOG READ
* READ CATALOG SECTOR.
PCT2 SA0 CSBF INITIALIZE CATALOG ADDRESS
SX2 CATS SET FET ADDRESS
RJ RCS READ CATALOG SECTOR
ZR X1,PCT3 IF READ COMPLETE
PL X1,PCT11 IF END OF CATALOG TRACK OR FATAL ERROR
SA1 CTIN
SX6 X1+4 COUNT CATALOG ENTRIES IN BAD SECTOR
SA6 A1
EQ PCT2 READ NEXT SECTOR
* CHECK FILE SELECTED.
PCT3 SA1 SCAN
NZ X1,PCT4 IF CATALOG RESCAN
RJ CSI CHECK SPECIAL USER INDEX
ZR X6,PCT10 IF FILE NOT TO BE PROCESSED
SA1 CPAR+/COMSPFS/CPRD
ZR X1,PCT5 IF RDF NOT REQUESTED
RJ GRE GENERATE RDF EXTRACT RECORD
EQ PCT5 CHECK SELECTIVE PARAMETERS
PCT4 RJ CCR CHECK CATALOG RESCAN FILE
ZR X6,PCT10 IF FILE NOT TO BE PROCESSED
NG X6,PCT11 IF END OF RESCAN FILE
PCT5 RJ CSP CHECK SELECTION PARAMETERS
ZR X6,PCT10 IF FILE NOT TO BE PROCESSED
SA3 CPAR+/COMSPFS/CPIP
SB2 X6-2
NZ X3,PCT9 IF PROCESSING INHIBITED
RJ SCA SET CATALOG DISK ADDRESS
ZR B2,PCT6 IF ONLY PFC/PERMITS TO BE DUMPED
EQ B2,B1,PCT7 IF STAGE FILE FROM ALTERNATE STORAGE
GT B2,B1,PCT8 IF COPY FILE FROM ALTERNATE STORAGE TAPE
* DUMP FILE WITH DATA.
RJ MRE MAKE READ LIST ENTRY
NZ X6,PCT10 IF READ LIST NOT FULL
RJ PRL PROCESS READ LIST
EQ PCT10 ADVANCE CATALOG POINTERS
* DUMP PFC AND PERMITS ONLY.
PCT6 MOVE NWCE,A0,CATH SAVE CATALOG ENTRY (PFC)
RJ PPD PROCESS PFC/PERMITS ONLY DUMP
EQ PCT10 ADVANCE CATALOG POINTERS
* STAGE FILE FROM ALTERNATE STORAGE.
PCT7 RJ RFS REQUEST FILE STAGING
EQ PCT10 ADVANCE CATALOG POINTERS
* COPY FILE FROM ALTERNATE STORAGE TAPE.
PCT8 RJ RFC REQUEST FILE COPY FROM TAPE
EQ PCT10 ADVANCE CATALOG POINTERS
* PROCESS DUMP INHIBITED.
PCT9 RJ PFI PROCESS FILE WITH DUMP INHIBITED
* ADVANCE CATALOG POINTERS.
PCT10 SA1 CTIN
SA2 CSLW
SX3 B1
MX7 -2
BX7 -X7*X1 INDEX IN CATALOG SECTOR
IX6 X1+X3 ADVANCE CATALOG TRACK INDEX
LX7 4 WORD OFFSET IN SECTOR
ERRNZ NWCE-20B
SA6 A1
SX7 X7+CSBF+NWCE ADVANCE CATALOG ADDRESS
IX2 X7-X2
SA0 X7 SET CATALOG ADDRESS
NG X2,PCT3 IF MORE ENTRIES IN CURRENT SECTOR
EQ PCT2 READ NEXT CATALOG SECTOR
* END OF CATALOG TRACK.
PCT11 RJ PRL PROCESS READ LIST
SA1 RSTS
ZR X1,PCTX IF NO FILE STAGE REQUESTED
RJ IRS INITIALIZE RESCAN
NZ X6,PCT1 IF RESCAN NOT TERMINATED
EQ PCTX RETURN
TITLE GENERAL SUBROUTINES.
AAT SPACE 4,10
** AAT - ASSIGN ALTERNATE STORAGE TAPE.
*
* ENTRY (ASTI) = TAPE REQUEST PARAMETERS FROM REQUEST FILE.
*
* USES X - 1, 2, 5, 6, 7.
* A - 5, 6, 7.
*
* CALLS CDD.
*
* MACROS LABEL.
AAT SUBR ENTRY/EXIT
* SET TAPE DESCRIPTORS.
SA5 ASTI
SX7 2450B SET LABELED *GE* TAPE
SX2 /COMSMTX/TFI+5000B SET *I* FORMAT AND OPTIONS
LX5 0-55
MX6 -2
BX6 -X6*X5 CARTRIDGE TAPE FLAGS
LX6 7
ZR X6,AAT1 IF NOT CARTRIDGE TAPE
SX7 X6+2000B SET LABELED *CT* OR *AT* TAPE
AAT1 PL X5,AAT2 IF NOT *LI* FORMAT TAPE
SX2 /COMSMTX/TFLI+5000B SET *LI* FORMAT AND OPTIONS
AAT2 LX7 48
LX2 30-0
BX7 X7+X2 MERGE TAPE DEVICE TYPE AND FORMAT
LX5 0-24-0+55
SA7 AST+10B SET TAPE DEVICE TYPE AND FORMAT
* SET VSN.
MX6 -12
BX1 -X6*X5 VSN NUMERIC SUFFIX
SX1 X1+10000D FORCE CONVERSION OF LEADING ZEROES
RJ CDD CONVERT VSN SUFFIX
MX7 -24
BX6 -X7*X6 CONVERTED VSN SUFFIX
MX7 12
LX6 24
LX5 36
BX7 X7*X5 VSN PREFIX
BX7 X7+X6 MERGE PREFIX AND SUFFIX
SX6 B0
SA7 AST+11B SET VSN
* ASSIGN TAPE.
SA6 A7+B1 CLEAR UNUSED FET FIELDS
SA6 A6+B1
SA6 A6+B1
SA6 A6+B1
SA1 AST+1
MX6 -48
BX6 -X6*X1 CLEAR DEVICE CODE
SX7 X1
SA6 A1
SA7 A1+B1 SET *IN* = *FIRST*
SA7 A7+B1 SET *OUT* = *FIRST*
LABEL AST REQUEST TAPE ASSIGNMENT
EQ AATX RETURN
ALF SPACE 4,20
** ALF - ATTACH LOCK FILE.
*
* ENTRY (B6) = LOCK FILE INDEX.
* (B4) = 0, IF *MSS* FILE BEING ATTACHED.
* (B4) = 8, IF *MSE* FILE BEING ATTACHED.
* (CMSK) = CONTROL MASK HAVING BIT SET FOR EACH
* SUBFAMILY STILL NEEDING LOCK.
* (GPAR+2) = ORIGINAL (42/ USER NAME,18/ USER INDEX).
* *LFAT* = FWA OF LOCK FILE FET ARGUMENT TABLE.
* *LOCK* = FWA OF LOCK FILE FET.
* PERMANENT FILE PARAMETERS SET FOR FAMILY DESIRED.
*
* EXIT (B6) = LOCK FILE INDEX.
* (CMSK) = CONTROL MASK UPDATED.
* (LMSK) = LOCK MASK UPDATED.
* LOCK FILE ATTACHED, IF AVAILABLE.
*
* USES X - 0, 1, 2, 3, 4, 6, 7.
* A - 1, 2, 3, 6, 7.
*
* MACROS ATTACH, CATLIST, SETFET, SETPFP.
ALF SUBR ENTRY/EXIT
MX0 42
SA1 LFAT+B6 ADJUST FET ARGUMENTS
SA2 LOCK FILE NAME
BX6 X0*X1
SA6 A2+8
BX3 -X0*X2
BX6 X3+X6
SA6 A2
BX6 -X0*X1
SA6 LOCK+FTIN SET *IN* POINTER
* ATTEMPT TO ATTACH DESIRED LOCK FILE.
SX6 UIPR SET SUBFAMILY USER INDEX
SA6 SPAR
SX7 B6-B4 GET SUBFAMILY INDEX
SX7 X7+SBUI SUBFAMILY USER INDEX
SA7 SPAR+2
SETPFP SPAR
SETFET LOCK,ERP=E SET USER ERROR PROCESSING
CATLIST LOCK,,,,,,,IE GET PFC ENTRY
ATTACH LOCK,,,,RU,,,,IE
* CHECK ATTACH ERROR CODE.
SA1 X2
MX0 -8
LX1 7-17
BX4 -X0*X1 ERROR CODE
ZR X4,ALF1 IF NO ERROR ON *ATTACH*
SX3 X4-/ERRMSG/FNF
NZ X3,ALFX IF FILE FOUND BUT UNAVAILABLE
* INDICATE LOCK FILE OBTAINED.
ALF1 SA1 LMSK SET LOCK MASK BIT
SX2 B1
LX2 B6,X2
BX6 X1+X2
SA6 A1
AX2 B4
SA1 CMSK CLEAR CONTROL MASK BIT
BX6 X1-X2
SA6 A1
EQ ALFX RETURN
APR SPACE 4,10
** APR - ABORT PROCESSOR.
*
* EXIT SCRATCH FILES RETURNED.
* OUTPUT FILES FLUSHED.
* INTERLOCKS RELEASED.
*
* CALLS CAC, CID, FAF, RLF, RMF.
*
* MACROS MESSAGE, RETURN, SETPFP.
APR SUBR ENTRY/EXIT
RETURN CATC
RETURN REQS
RETURN RESS
RETURN TC
RETURN PFMREQ
RJ RLF RELEASE LOCK FILES
RJ RMF RETURN MASTER DEVICE FILES
RJ CAC CLEAR PERMANENT FILE ACTIVITY COUNT
RJ CID CHECK INCOMPLETE FILE DUMP
ARCHIVE WRITEF WRITE EOF ON ARCHIVE/VERIFY FILES
RJ FAF FLUSH ARCHIVE/VERIFY FILES
SETPFP GPAR RESTORE PERMANENT FILE PARAMETERS
EQ APRX RETURN
CCR SPACE 4,15
** CCR - CHECK CATALOG RESCAN FILE.
*
* ENTRY (A0) = CATALOG ENTRY ADDRESS.
* (CTIN) = CURRENT CATALOG TRACK INDEX.
* (RESE - RESE+1) = CURRENT RESCAN ENTRY.
*
* EXIT (A0) = CATALOG ENTRY ADDRESS.
* (X6) .LT. 0 IF END OF RESCAN FILE.
* (X6) = 0 IF FILE TO BE SKIPPED.
* (X6) .GT. 0 IF FILE TO BE PROCESSED.
*
* USES X - 1, 2, 3, 4, 6.
* A - 1, 2, 3, 4.
CCR SUBR ENTRY/EXIT
CCR1 SA1 RESE
SA2 CTIN
SA3 RESE+1
SA4 A0+FCFN
SX6 B0+ SET TO SKIP FILE
IX1 X1-X2
BX3 X3-X4
NG X1,CCR2 IF CURRENT ENTRY PAST STAGE REQUEST
NZ X1,CCRX IF STAGE REQUEST PAST CURRENT ENTRY
NZ X3,CCRX IF NOT SAME FILE NAME AND USER INDEX
SX6 1 SET PROCESS FILE
EQ CCRX RETURN
CCR2 READW RESS,RESE,2 READ NEXT STAGE REQUEST
ZR X1,CCR1 IF NOT END OF RESCAN FILE
SX6 -1 SET TERMINATE RESCAN
EQ CCRX RETURN
CDT SPACE 4,15
** CDT - COPY FILE DATA FROM ALTERNATE STORAGE TAPE.
*
* ENTRY ALTERNATE STORAGE TAPE POSITIONED AT FIRST BLOCK
* AFTER CATALOG ENTRY.
*
* EXIT FILE DATA COPIED FROM ALTERNATE STORGE TAPE TO ARCHIVE
* FILE(S).
*
* USES X - 1, 2, 3, 4, 5, 6, 7.
* A - 1, 2, 4, 5, 6, 7.
* B - 2, 3.
*
* CALLS RCW, SFE, WDT.
*
* MACROS ARCHIVE, CWREAD.
CDT SUBR ENTRY/EXIT
SX6 B0+
SA6 CDTA INITIALIZE BUFFER WORD COUNT
* SKIP PERMITS BLOCKS.
CDT1 RJ RCW READ BLOCK CONTROL WORD
NZ X7,CDT5 IF ERROR
NZ X1,CDT5 IF EOR, EOF, OR EOI ON ARCHIVE FILE
SX1 X3-3
ZR X1,CDT3 IF DATA BLOCK
SX1 X3-2
NZ X1,CDT5 IF NOT PERMITS BLOCK
CWREAD AST,DBUFH,X6 READ BLOCK
NZ X7,CDT5 IF ERROR
NZ X1,CDT5 IF EOR, EOF, OR EOI
EQ CDT1 READ BLOCK CONTROL WORD
* READ NEXT DATA BLOCK CONTROL WORD.
CDT2 RJ RCW READ BLOCK CONTROL WORD
NZ X7,CDT5 IF ERROR
NG X1,CDT5 IF EOF OR EOI ON ARCHIVE FILE
NZ X1,CDT6 IF EOR ON ARCHIVE FILE
SX1 X3-3
NZ X1,CDT5 IF NOT DATA BLOCK
* COPY DATA BLOCK TO ARCHIVE FILES.
CDT3 SA1 CDTA
SA5 WREM
LX4 9
SX7 X4
SA7 CDTB SAVE BLOCK SUB-TYPE
IX7 X1+X6 BUFFER WORD COUNT INCLUDING NEW DATA BLOCK
SX5 X5-1 DATA SPACE REMAINING IN 1000B WORD SEGMENT
IX2 X5-X7
PL X2,CDT4 IF SUFFICIENT ROOM IN SEGMENT FOR DATA
IX3 X5-X1 SET WORD COUNT TO FILL SEGMENT
IX6 X6-X3
SA6 CDTC SAVE WORDS REMAINING IN NEW BLOCK
CWREAD AST,DBUFH+X1,X3 READ DATA
SA4 CDTB
NZ X7,CDT5 IF ERROR
NZ X1,CDT5 IF EOR, EOF, OR EOI ON ARCHIVE FILE
SX7 4000B
SB2 DBUFH SET DATA ADDRESS
SX6 DCWC+X5 SET DATA BLOCK TYPE AND LENGTH
SB3 X5+ SET WORD COUNT
BX4 X7*X4 PRESERVE SYSTEM SECTOR FLAG
BX6 X6+X4 MERGE SYSTEM SECTOR STATUS
SA6 CONTH SET CONTROL WORD
RJ WDT WRITE DATA
SA2 CDTC
SX1 B0+ SET OFFSET FOR READ
SX6 X2+ SET WORD COUNT TO READ
SX7 X2+ SET WORD COUNT IN BUFFER
CDT4 SA7 CDTA UPDATE WORDS IN WORKING BUFFER
CWREAD AST,DBUFH+X1,X6 READ DATA
SA4 CDTB
NZ X7,CDT5 IF ERROR
NZ X1,CDT5 IF EOR, EOF, OR EOI ON ARCHIVE FILE
ZR X4,CDT2 IF NOT SYSTEM SECTOR, EOR OR EOF BLOCK
SA1 CDTA
SB2 DBUFH SET DATA ADDRESS
SX6 DCWC+X1
BX6 X6+X4 SET DATA BLOCK SUB-TYPE
SB3 X1 SET WORD COUNT
SA6 CONTH SET CONTROL WORD
RJ WDT WRITE DATA
SX7 B0+
SA7 CDTA SET NO DATA IN BUFFER
EQ CDT2 READ NEXT BLOCK CONTROL WORD
* PROCESS ERROR IN ALTERNATE STORAGE FILE.
CDT5 SA1 FLST
SX6 2
BX6 X1+X6 SET DATA ERROR IN FILE STATUS
SA6 A1
SA1 CATH+FCUI
SB2 ERTR * READ ERROR ON ALTERNATE STORAGE ...*
RJ SFE SEND ERROR MESSAGE
* FLUSH DATA IN WORKING BUFFER AND COMPLETE FILE DUMP.
CDT6 SA1 CDTA
ZR X1,CDT7 IF NO DATA IN WORKING BUFFER
SB2 DBUFH SET DATA ADDRESS
SB3 X1+ SET WORD COUNT
SX6 DCWC+X1 SET BLOCK TYPE
SA6 CONTH SET CONTROL WORD
RJ WDT WRITE DATA
CDT7 SA1 FLST
LX1 59-1
PL X1,CDT8 IF NO ERROR IN FILE DATA
SA1 LGCW GET ERROR CONTROL WORD
BX6 X1
SB3 B0 CLEAR DATA WORD COUNT
SA6 CONTH
SB2 CONTH SET BUFFER ADDRESS
RJ WDT WRITE ERROR CONTROL WORD
CDT8 ARCHIVE WRITER WRITE EOR ON ARCHIVE FILE
SX6 BFAC
SA6 WREM RESET BLOCK STATUS FOR NEXT FILE
EQ CDTX RETURN
CDTA CON 0 WORDS IN *DBUFH*
CDTB CON 0 DATA CONTROL WORD SUB-TYPE
CDTC CON 0 WORDS REMAINING IN DATA BLOCK
CFD SPACE 4,15
** CFD - COMPLETE FILE DUMP.
*
* ENTRY CATALOG ENTRY, PERMITS AND FILE DATA WRITTEN TO
* ARCHIVE FILE.
*
* EXIT FILE INFORMATION WRITTEN TO OUTPUT AND SUMMARY FILES.
* *PFM* REQUEST FORMATTED IF FILE TO BE PURGED OR
* ALTERNATE STORAGE POINTERS TO BE UPDATED.
*
* USES X - 1, 2, 3, 6, 7.
* A - 0, 1, 2, 3, 6.
* B - 2.
*
* CALLS CFP, UCE, WPR.
CFD SUBR ENTRY/EXIT
SX6 B0+ CLEAR INCOMPLETE FILE FLAG
SA6 IFST
SA0 CATH SET CATALOG ADDRESS
RJ CFP COUNT FILE PROCESSED
SA1 FLST
MX6 -3
BX1 -X6*X1
NZ X1,CFDX IF PFC ONLY DUMP OR ERROR IN FILE
SA1 CPAR+/COMSPFS/CPOP
SA2 CPAR+/COMSPFS/CPDT
SX7 B0
LX1 59-53
NG X1,CFD2 IF PURGE FILES AFTER DUMP
ZR X2,CFDX IF NOT DESTAGE DUMP
SB2 CTSL SET *TFLOK* FLAG FUNCTION
RJ UCE UPDATE CATALOG ENTRY
SA3 FLOK
NG X3,CFD1 IF ARCHIVE TO OPTICAL DISK
SA2 CATH+FCTV GET TAPE ALTERNATE STORAGE INFORMATION
SX7 B1+
LX7 42-0
BX7 X2+X7 MERGE *SETASA* TAPE ALTERNATE STORAGE FLAG
EQ CFD2 WRITE *PFM* REQUEST
CFD1 SA2 CATH+FCAA GET OPTICAL ALTERNATE STORAGE INFORMATION
BX7 X2
SA2 CATH+FCOA GET OPTICAL DISK ADDRESS
MX3 24
BX6 X3*X2
SA6 PFRS+2 SET ADDRESS IN *PFM* REQUEST PARAMETERS
CFD2 RJ WPR WRITE *PFM* REQUEST PARAMETERS
EQ CFDX RETURN
CID SPACE 4,25
** CID - CHECK INCOMPLETE FILE DUMP.
*
* ENTRY (IFST) = 0 IF NO INCOMPLETE FILE DUMP.
* (IFST) = 1 IF INCOMPLETE FILE DUMP AND PFC DUMPED.
* (IFST) = 2 IF INCOMPLETE FILE DUMP AND PERMITS DUMPED.
* CATALOG ENTRY IN *CATH* IF INCOMPLETE FILE DUMP.
* (FLST) = FILE STATUS WORD IF INCOMPLETE FILE DUMP.
*
* EXIT EOR WRITTEN ON ARCHIVE AND VERIFY FILES.
* CATALOG DATA OUTPUT AND FILE COUNTS UPDATED FOR FILE
* BEING DUMPED.
* ARCHIVE FILE ERROR FLAGS SET IF PERMITS DUMP AND/OR
* DATA DUMP INCOMPLETE.
*
* USES X - 1, 6.
* A - 0, 1, 6.
*
* CALLS CFP.
*
* MACROS WRITER.
CID SUBR ENTRY/EXIT
SA1 IFST
ZR X1,CIDX IF NO INCOMPLETE FILE DUMP
ARCHIVE WRITER WRITE EOR ON ARCHIVE/VERIFY FILES
SA1 IFST
SX6 X1-2
ZR X6,CID1 IF PERMITS DUMP COMPLETE
SA1 CATH+FCRI
MX6 24
BX6 X6*X1
ZR X6,CID1 IF NO PERMITS
SX6 4 SET PERMITS LOST FLAG
CID1 SA1 FLST
LX1 59-0
NG X1,CID2 IF *PFC ONLY* FILE
SX6 X6+2 SET DATA ERROR FLAG
CID2 LX1 1
BX6 X1+X6 MERGE ERROR FLAGS
SA6 FLST UPDATE FILE STATUS
SA0 CATH SET CATALOG ENTRY ADDRESS
RJ CFP COUNT FILE PROCESSED
EQ CIDX RETURN
CSI SPACE 4,10
** CSI - CHECK SPECIAL USER INDEX.
*
* ENTRY (A0) = CATALOG ADDRESS.
*
* EXIT (A0) = CATALOG ADDRESS.
* (X6) .NE. 0 IF FILE TO BE DUMPED.
* (X6) = 0 IF FILE NOT TO BE DUMPED.
*
* USES X - 1, 2, 3, 6, 7.
* A - 1, 2, 3.
CSI2 SX6 B0+ SET NO FILE DUMP
CSI SUBR ENTRY/EXIT
SA1 CPAR+/COMSPFS/CPOP
SA2 CPAR+/COMSPFS/CPDT
SA3 A0+FCUI
SX6 B1 SET TO DUMP FILE
LX1 59-53
SX7 X3-IFUI
SX3 X3+ USER INDEX
ZR X3,CSI2 IF CATALOG HOLE
ZR X7,CSI2 IF INDIRECT ACCESS DATA FLAW
ZR X2,CSI1 IF NOT DESTAGE DUMP
SX2 X3-SYUI
ZR X2,CSI2 IF SYSTEM USER INDEX
SX1 377770B
SX2 SBUI
BX1 X1*X3
BX1 X1-X2
NZ X2,CSIX IF NOT SUBFAMILY USER INDEX
EQ CSI2 SET NO FILE DUMP
CSI1 PL X1,CSIX IF PURGE OPTION NOT SELECTED
SA1 /COMSPFS/FISP
SX2 X3-PGUI
NZ X1,CSIX IF USER INDEX SELECTIONS PRESENT
NG X2,CSIX IF FILE TO BE DUMPED
EQ CSI2 SET NO FILE DUMP
CSP SPACE 4,20
** CSP - CHECK SELECTION PARAMETERS.
*
* ENTRY (A0) = ADDRESS OF CATALOG ENTRY.
* (CPAR) = CRACKED PARAMETER ARRAY.
*
* EXIT (A0) = ADDRESS OF CATALOG ENTRY.
* (X6) = 0 IF FILE NOT TO BE DUMPED.
* (X6) = 1 IF TOTAL FILE TO BE DUMPED.
* (X6) = 2 IF ONLY PFC AND PERMITS TO BE DUMPED.
* (X6) = 3 IF STAGE FILE FROM ALTERNATE STORAGE.
* (X6) = 4 IF FILE TO BE COPIED FROM ALTERNATE STORAGE
* TAPE.
*
* USES X - 1, 2, 4, 6, 7.
* A - 1, 2, 3, 6.
* B - 2, 3, 4.
*
* CALLS CBR, CFE, CSC, SFE, SFL.
CSP SUBR ENTRY/EXIT
* CHECK TRUE DEVICE RESIDENCE CRITERION.
* DISK RESIDENCY IS CHECKED BECAUSE OLDER SYSTEM LEVELS DID
* NOT CLEAR THE DEVICE NUMBER IN THE PFC ENTRY WHEN DISK SPACE
* WAS RELEASED.
SA1 CPAR+/COMSPFS/CPTD
SX6 B0+ SET NO FILE DUMP
SA6 FLCF CLEAR *FILE LENGTH CORRECT* FLAG
ZR X1,CSP1 IF NO TRUE DEVICE SELECTION
SA2 A0+FCDN
SA3 CPAR+/COMSPFS/CPDN
SA4 A0+FCBT
MX7 -6
LX2 -36
BX3 X1-X3
LX4 59-23
ZR X3,CSP1 IF TRUE DEVICE IS MASTER DEVICE
BX2 -X7*X2 RESIDENCY DEVICE
PL X4,CSPX IF FILE NOT DISK RESIDENT
BX2 X1-X2
NZ X2,CSPX IF FILE DOES NOT RESIDE ON TRUE DEVICE
* GET FILE LENGTH IF REQUIRED AND CHECK SELECTION CRITERIA.
* FILES SPECIFIED IN TABLE *TSFF* WILL BE DUMPED ON AN
* INCREMENTAL DUMP EVEN IF THE SPECIFIED DATE/TIME CRITERION
* IS NOT MET BECAUSE THEY MAY HAVE BEEN MODIFIED WHILE IN
* FAST ATTACH MODE.
CSP1 SA1 FLSF
ZR X1,CSP2 IF FILE LENGTH NOT REQUIRED FOR SELECTION
RJ SFL SET FILE LENGTH
ZR X6,CSPX IF DEVICE NOT FOUND ERROR
CSP2 SB4 A0 SET CATALOG ENTRY ADDRESS
RJ CSC CHECK SELECTION CRITERIA
NZ X6,CSP4 IF FILE SELECTED
ZR X7,CSPX IF NON-SELECTION NOT DUE TO DATE/TIME
SA1 INCD
ZR X1,CSPX IF NOT INCREMENTAL DUMP
SA2 TSFF-1
SA1 A0+FCUI
CSP3 SA2 A2+1 GET FAST ATTACH FILE NAME AND USER INDEX
ZR X2,CSPX IF END OF ENTRIES
BX3 X1-X2
NZ X3,CSP3 IF NO MATCH
* CHECK FILE BACKUP REQUIREMENTS.
CSP4 RJ CBR CHECK BACKUP REQUIREMENTS
SA1 CPAR+/COMSPFS/CPOP
SX6 X6-BRNO
LX1 59-53
NG X1,CSP6 IF PURGE OPTION SPECIFIED
ZR X6,CSPX IF BACKUP NOT REQUIRED
ZR B2,CSP6 IF NO ALTERNATE STORAGE COPIES
NZ B7,CSP5 IF ALTERNATE DATE/TIME USED IN SELECTION
ZR X7,CSP6 IF FILE NOT BACKED UP ON ALTERNATE STORAGE
* DETERMINE IF THE FILE CAN BE DUMPED AS *PFC ONLY*.
* NOTE - IF *OP=Z* OR A DESTAGE DUMP IS SELECTED, *PRS*
* SETS THE *COS* LIMIT TO FORCE A DATA DUMP FOR ALL FILES.
CSP5 RJ SFL ENSURE FILE LENGTH CORRECT IN PFC ENTRY
ZR X6,CSPX IF DEVICE NOT FOUND ERROR
SA1 A0+FCLF GET FILE LENGTH
SA2 CPAR+/COMSPFS/CPCO
MX7 -24
LX1 -36
BX7 -X7*X1
IX7 X7-X2
PL X7,CSP9 IF FILE SIZE .GE. *PFC* ONLY LIMIT
* CHECK DISK IMAGE.
CSP6 SA1 A0+FCBT GET BEGINNING TRACK POINTER
SX6 B1 SET TOTAL FILE DUMP
LX1 59-23
NG X1,CSPX IF DISK IMAGE EXISTS
NZ B2,CSP7 IF ALTERNATE STORAGE COPY EXISTS
SA1 A0+FCFN SET FILE NAME AND USER INDEX
SB2 ERNP * NO DISK OR ALTERNATE STORAGE ...*
RJ SFE SEND ERROR MESSAGE
RJ CFE COUNT FILE SKIPPED
EQ CSP10 SET NO FILE DUMP
* DETERMINE IF FILE TO BE STAGED FROM ALTERNATE STORAGE.
CSP7 SA1 CPAR+/COMSPFS/CPOP
SX6 3 SET STAGE FILE
ZR B3,CSP8 IF FILE NOT ON TAPE ALTERNATE STORAGE
SX6 4 SET COPY FILE FROM TAPE
CSP8 LX1 59-47
PL X1,CSPX IF FILE STAGING NOT SUPPRESSED
CSP9 SA1 CPAR+/COMSPFS/CPDT
NZ X1,CSP10 IF DESTAGE DUMP
SX6 2 SET DUMP PFC AND PERMITS ONLY
EQ CSPX RETURN
* SET TO NOT DUMP FILE.
CSP10 SX6 B0 CLEAR *DUMP FILE* FLAG
EQ CSPX RETURN
* TABLE OF SPECIAL FAST ATTACH FILES.
TSFF BSS 0 TABLE OF SPECIAL FAST ATTACH FILES
VFD 42/0L"APFN",18/SYUI
VFD 42/0L"PPFN",18/SYUI
VFD 42/0L"TMFC",18/"TMUI"
CON 0 END OF TABLE
CWW SPACE 4,50
** CWW - CONTROL WORD WRITE.
*
* *CWW* TRANSFERS DATA FROM A WORKING BUFFER TO A
* CIRCULAR BUFFER. CONTROL WORDS ARE INSERTED INTO THE
* CIRCULAR BUFFER AS NECESSARY BASED ON THE PRU SIZE CONTAINED
* IN THE FET. IF THE BUFFER BECOMES SUFFICIENTLY FULL TO
* REQUIRE DUMPING, A *CIO* *WRITECW* REQUEST IS ISSUED FOR
* THE FILE.
*
* *CWW* USES A WORD IN THE FET TO CONTROL THE BLOCKING
* OF DATA. THE LOCATION OF THIS WORD IN THE FET IS DETERMINED
* BY THE ASSEMBLY CONSTANT *CWSW*. BEFORE THE INITIAL CALL TO
* *CWW* FOR A GIVEN FET THE LOCATION *CWSW* OF THAT FET SHOULD
* BE INITIALIZED TO -1 TO INSURE PROPER OPERATION OF *CWW*.
* AFTER THE INITIAL CALL TO *CWW* FOR A GIVEN FET, THE LOCATION
* *CWSW* IS MAINTAINED AUTOMATICALLY BY *CWW* AND SHOULD NOT BE
* SET BY THE CALLER.
*
* AN END OF RECORD WRITE CAUSES AN END OF RECORD LEVEL
* NUMBER *LN* (SEE *B6* ENTRY CONDITION) TO BE WRITTEN ON THE
* FILE.
*
* ENTRY (X2) = FET ADDRESS.
* (B6) = FWA OF WORKING BUFFER IF (B7) .GE. 0.
* = LN = END OF RECORD LEVEL NUMBER IF (B7) .LT. 0.
* (B7) = WORD COUNT OF WORKING BUFFER (.GE. 0).
* = .LT. 0 FOR AN END OF RECORD WRITE.
*
* EXIT (X2) = FET ADDRESS.
* (B6) = ADDRESS OF NEXT WORD TO BE TRANSFERRED FROM
* WORKING BUFFER.
* (B7) = 0 IF OPERATION WAS COMPLETED.
* = REMAINING WORD COUNT IF A BUFFER DUMP WAS
* NECESSARY AND AN ERROR STATUS WAS DETECTED IN
* THE FET.
* = .LT. 0 IF AN ERROR WAS DETECTED AS ABOVE AND
* THE CALL WAS FOR AN END OF RECORD WRITE.
* (X7) = ERROR STATUS IF (B7) .NE. 0.
*
* USES X - 1, 3, 4, 6, 7.
* A - 1, 3, 6, 7.
* B - 2, 3, 4, 5, 6, 7.
*
* CALLS MMC.
*
* MACROS RECALL, WRITECW.
* SAVE CURRENT BLOCK WORD COUNT.
CWW17 SX6 B2+ SAVE CURRENT BLOCK WORD COUNT
SA6 X2+CWSW
CWW SUBR ENTRY/EXIT
ZR B7,CWWX IF WORKING BUFFER EMPTY
SA1 X2+4 SET LIMIT
SB5 X1
LX1 -18 SET BLOCK SIZE
SA3 X2+CWSW GET CURRENT BLOCK WORD COUNT
SB3 X1
SB2 X3
SA1 X2+2 IN
SB4 X1
NG B2,CWW1 IF NO PARTIAL BLOCK IN BUFFER
SX1 B4+B2 IN = IN + BLOCK LENGTH
SB4 X1+B1
LT B4,B5,CWW1 IF IN .LT. LIMIT
SA1 X2+B1 IN = IN-LIMIT+FIRST
SB4 B4-B5
SB4 X1+B4
* DETERMINE BUFFER SPACE.
CWW1 SA3 X2+3 OUT
SX6 B4+B1 BUFFER SPACE = OUT-(IN+1)
IX4 X3-X6
PL X4,CWW2 IF NO BUFFER WRAP
SA3 X2+B1 FIRST
SX6 X4+B5 BUFFER SPACE = BUFFER SPACE+(LIMIT-FIRST)
SX3 X3
IX4 X6-X3
CWW2 ZR X4,CWW13 IF NO SPACE IN BUFFER
* PROCESS TRAILING CONTROL WORD.
NE B2,B3,CWW4 IF CURRENT BLOCK NOT FULL
SB2 -B1 SET CURRENT BLOCK EMPTY
BX6 X6-X6 SET LEVEL 0 SECOND CONTROL WORD
SA6 B4
SB4 B4+B1 ADVANCE IN
LT B4,B5,CWW3 IF IN .LT. LIMIT
SA1 X2+B1 IN = FIRST
SB4 X1
CWW3 SX6 B4+ UPDATE IN
SX4 X4-1 DECREMENT BUFFER SPACE
SA6 X2+2
ZR X4,CWW13 IF NO SPACE IN BUFFER
* PROCESS LEADING CONTROL WORD.
CWW4 PL B2,CWW6 IF BLOCK STARTED
SB2 B0 CLEAR BLOCK WORD COUNT
SX6 B3 (X7) = 5*BLOCK SIZE
SX1 B3
LX6 2
IX7 X6+X1
LX1 36 24/BLOCK SIZE,36/5*BLOCK SIZE
BX6 X1+X7
SA6 B4 STORE LEADING CONTROL WORD
SB4 B4+B1 ADVANCE IN
LT B4,B5,CWW5 IF IN .LT. LIMIT
SA1 X2+B1 IN = FIRST
SB4 X1
CWW5 SX4 X4-1 DECREMENT BUFFER SPACE
ZR X4,CWW13 IF NO SPACE IN BUFFER
* PROCESS END OF RECORD WRITE.
CWW6 PL B7,CWW8 IF NOT END OF RECORD CALL
SX6 B6 SAVE LEVEL NUMBER
LX6 48
SA6 B4
SX1 B2 BLOCK BYTE COUNT = 5 * BLOCK WORD COUNT
LX1 2
SX3 X1+B2
SX1 B3 24/BLOCK SIZE,36/BLOCK BYTE COUNT
LX1 36
BX6 X1+X3
SB4 B4+B1 ADVANCE IN
LT B4,B5,CWW7 IF IN .LT. LIMIT
SA1 X2+B1 IN = FIRST
SB4 X1
CWW7 SA1 X2+2 UPDATE FIRST CONTROL WORD
SX7 B4 UPDATE IN
SA6 X1
SA7 A1
SB7 B0+ CLEAR WORKING BUFFER WORD COUNT
SB2 -B1 SET CURRENT BLOCK EMPTY FLAG
EQ CWW13 BUFFER AHEAD
* TRANSFER DATA FROM WORKING BUFFER TO CIRCULAR BUFFER.
CWW8 SB5 B5-B4 DETERMINE AVAILABLE SPACE WITHOUT WRAP
LE B5,B7,CWW9 IF BUFFER WRAP
SB5 B7 USE WORKING BUFFER WORD COUNT
CWW9 SX1 B3-B2 DETERMINE REMAINING BLOCK WORD COUNT
SX3 B5+
IX6 X4-X1
PL X6,CWW10 IF BLOCK COUNT FITS IN AVAILABLE SPACE
SX1 X4+ USE AVAILABLE SPACE WORD COUNT
CWW10 IX6 X3-X1
PL X6,CWW11 IF NO BUFFER WRAP
SX1 B5 USE SPACE AVAILABLE WITHOUT WRAP
CWW11 SX3 B6 SET STARTING ADDRESS OF MOVE
SX6 B4 SET DESTINATION ADDRESS OF MOVE
SB6 B6+X1 INCREMENT WORKING BUFFER ADDRESS
SB2 B2+X1 INCREMENT BLOCK COUNT
SB4 B4+X1 INCREMENT IN
SB5 X1+
SB7 B7-B5 DECREMENT WORKING BUFFER WORD COUNT
RJ MMC MOVE DATA FROM WORKING BUFFER
SA1 X2+FTLM REREAD LIMIT
SB5 X1+
LT B4,B5,CWW12 IF LIMIT NOT REACHED
SA1 X2+B1 READ FIRST
SB4 X1
CWW12 NZ B7,CWW1 IF MORE DATA TO WRITE
* PROCESS FULL BUFFER AND BUFFER AHEAD.
CWW13 SA1 X2 CHECK FET STATUS
LX1 59-0
NG X1,CWW14 IF FET NOT BUSY
ZR B7,CWW17 IF WORKING BUFFER EMPTY
RECALL WAIT FOR *CIO* TO CATCH UP
EQ CWW1 TRANSFER REMAINDER OF DATA
CWW14 LX1 0-10-59+0+60 CHECK ERROR STATUS
MX3 -4
BX7 -X3*X1
NZ X7,CWW17 IF ERROR ON LAST WRITE REQUEST
NZ B7,CWW16 IF WORKING BUFFER NOT EMPTY
SA1 X2+B1 FIRST
SA3 X2+3 OUT
SX6 B5
SX1 X1
IX7 X6-X1 BUFFER SIZE = LIMIT-FIRST
SX6 B4
IX3 X6-X3 BUFFER WC = IN-OUT
PL X3,CWW15 IF NO BUFFER WRAP
IX3 X3+X7 BUFFER WC = BUFFER WC+BUFFER SIZE
CWW15 AX7 1 BUFFER SIZE/2
IX1 X3-X7
NG X1,CWW17 IF BUFFER NOT AT LEAST HALF FULL
SX6 B3+2 MINIMUM BLOCK LENGTH
IX1 X3-X6
NG X1,CWW17 IF NOT FULL BLOCK IN BUFFER
* CALL *CIO* TO WRITE DATA.
CWW16 WRITECW X2 CALL *CIO* TO WRITE DATA
NZ B7,CWW1 IF WORKING BUFFER NOT EMPTY
EQ CWW17 SAVE CURRENT BLOCK WORD COUNT
CWSW EQU 5 CONTROL WORD STATUS WORD
DLY SPACE 4,10
** DLY - DELAY.
*
* ENTRY (B2) = NUMBER OF RECALL-S TO ISSUE.
*
* USES B - 2.
*
* MACROS RECALL.
DLY SUBR ENTRY/EXIT
DLY1 RECALL
SB2 B2-B1
GT B2,DLY1 IF MORE DELAY NEEDED
EQ DLYX RETURN
DSF SPACE 4,15
** DSF - DROP STAGED FILES.
*
* ENTRY DATA LIST ELEMENTS IN *DLRB*.
* CATALOG TRACK INTERLOCK SET.
*
* EXIT DISK SPACE OCCUPIED BY STAGED FILES DROPPED.
* CATALOG TRACK INTERLOCK SET.
*
* USES X - 1, 5, 6.
* A - 1, 5, 6.
* B - 2.
*
* CALLS SDP, SPR.
*
* MACROS DROPDS, PCINT.
DSF SUBR ENTRY/EXIT
PCINT CATS,CTCC CLEAR CATALOG TRACK INTERLOCK
SA5 DLRB GET FIRST LIST ENTRY
DSF1 BX1 X5
RJ SDP SET DATA LIST PARAMETERS
SB2 DDBK SET SPECIAL REQUEST BLOCK ADDRESS
RJ SPR
DROPDS DDFT DROP DISK SPACE
SA1 STFC INCREMENT NUMBER OF FILES STAGED
SX6 X1+B1
SA6 A1
SA5 A5+1 GET NEXT LIST ENTRY
NZ X5,DSF1 IF MORE DATA LIST ELEMENTS
PCINT CATS,CTSC SET CATALOG TRACK INTERLOCK
EQ DSFX RETURN
DTF SPACE 4,20
** DTF - DUMP TAPE RESIDENT FILE.
*
* ENTRY (RESE - RESE+2) = REQUEST PARAMETERS.
* (DBUFH - DBUFH+17B) = CATALOG ENTRY FROM TAPE.
*
* EXIT FILE DUMP COMPLETE IF FILE FOUND AND SELECTED.
* ALL DEVICE ACCESS FILES RETURNED.
* PF ACTIVITY COUNT AND CATALOG TRACK INTERLOCK NOT SET.
*
* USES X - 0, 1, 2, 3, 6, 7.
* A - 1, 2, 3, 6.
* B - 3.
*
* CALLS CAC, CDT, CFD, CSP, OPF, PFC, PPD, RCS, RMF, RPF, SAC,
* SCA, SFL.
*
* MACROS CALLPFU, MOVE, PCINT, READCW.
DTF SUBR ENTRY/EXIT
* SET UP CATALOG AND PERMITS FILES AND SET INTERLOCKS.
SA1 RESE+1
MX6 -18
MX7 -3
BX6 -X6*X1 USER INDEX
BX2 -X7*X1 SUBFAMILY INDEX
SA6 PDUI SET USER INDEX FOR *RCS* ERROR MESSAGE
SA2 TMDA+X2 GET MASTER DEVICE *MSTT* ADDRESS
SA3 X2+ GET MASTER DEVICE EST ORDINAL
BX6 X2
SA6 MSTA SET MASTER DEVICE *MSTT* ADDRESS
MX6 -6
BX6 -X6*X3
SA6 CPAR+/COMSPFS/CPDN SET MASTER DEVICE NUMBER
MX6 -9
LX3 -6
BX6 -X6*X3
SA6 MAEQ SET MASTER DEVICE EST ORDINAL
RJ SAC SET PF ACTIVITY COUNT
SA1 RESE+2
SA2 MAEQ
MX6 36
SX3 5
LX6 -12
BX6 X6*X1 FIRST TRACK, CURRENT TRACK AND SECTOR
LX2 48
BX6 X6+X3 MERGE FILE STATUS
BX6 X6+X2 MERGE EST ORDINAL
SA6 CATS+FTPM SET FST PARAMETERS
CALLPFU CATS,CTOL,R OPEN CATALOG FILE
RJ OPF OPEN PERMITS FILE
PCINT CATS,CTSC SET CATALOG TRACK INTERLOCK
* READ CATALOG ENTRY.
SA1 CATS+FTFT
SX6 X1
SA6 A1+B1 SET IN = FIRST
SA6 A1+2 SET OUT = FIRST
READCW CATS,17B INITIATE CATALOG READ
RJ RCS READ CATALOG SECTOR
NZ X1,DTF3 IF ERROR IN READ
SA2 RESE+2
MX6 -2
BX6 -X6*X2 CATALOG BUFFER INDEX
LX6 4
ERRNZ NWCE-20B
SA0 CSBF+X6 SET CATALOG ENTRY ADDRESS
* VERIFY CATALOG ENTRY.
SA1 A0+FCFN
SA2 RESE+1
SA3 A0+FCCD
SA4 DBUFH+FCCD
MX6 -36
BX1 X1-X2 COMPARE FILE NAMES FROM REQUEST AND PFC
BX3 X3-X4 COMPARE CREATION TIME FROM TAPE AND PFC
BX3 -X6*X3
NZ X1,DTF3 IF NOT SAME FILE NAME AND USER INDEX
NZ X3,DTF3 IF NOT SAME CREATION DATE/TIME
SA1 A0+FCMD
SA2 DBUFH+FCMD
SA3 A0+FCTV
SA4 DBUFH+FCTV
MX7 -42
BX1 X1-X2 COMPARE DATA MODIFCATION DATE AND TIME
BX3 X3-X4 COMPARE ALTERNATE STORAGE POINTERS
BX1 -X6*X1
BX3 -X7*X3
NZ X1,DTF3 IF NOT SAME DATA MODIFICATION DATE/TIME
NZ X3,DTF3 IF NOT SAME ALTERNATE STORAGE POINTERS
* DUMP FILE IF SELECTED.
RJ CSP CHECK SELECTION PARAMETERS
ZR X6,DTF3 IF NOT TO PROCESS FILE
SX0 X6-2
RJ SCA SET CATALOG DISK ADDRESS
MOVE NWCE,A0,CATH MOVE CATALOG ENTRY
NZ X0,DTF2 IF FILE DATA TO BE DUMPED
RJ PPD DUMP PFC AND PERMITS
EQ DTF3 RETURN MASTER DEVICE FILES
DTF2 RJ SFL SET FILE LENGTH
SX5 CCWC SET DUMP WITH FILE DATA
RJ PFC WRITE CATALOG ENTRY
RJ RPF WRITE FILE PERMITS
PCINT CATS,CTCC CLEAR CATALOG TRACK INTERLOCK
RJ CDT COPY FILE DATA FROM TAPE
RJ CFD COMPLETE FILE DUMP
* RETURN DEVICE FILES AND DECREMENT PF ACTIVITY COUNT.
DTF3 RJ RMF RETURN MASTER DEVICE FILES
RJ CAC DECREMENT PF ACTIVITY COUNT
EQ DTFX RETURN
FAF SPACE 4,10
** FAF - FLUSH ARCHIVE FILES.
*
* EXIT ARCHIVE AND VERIFY FILES FLUSHED.
*
* USES X - 1, 2.
* A - 1.
*
* CALLS FCW.
FAF SUBR ENTRY/EXIT
SX2 TAPE FLUSH ARCHIVE FILE BUFFER
RJ FCW
SA1 CPAR+/COMSPFS/CPVF
ZR X1,FAFX IF NO VERIFY FILE SPECIFIED
SX2 PFVER
RJ FCW FLUSH VERIFY FILE BUFFER
EQ FAFX RETURN
FCW SPACE 4,20
** FCW - FLUSH BUFFER USING CONTROL WORD WRITE.
*
* A CONTROL WORD WRITE REQUEST (*WRITECW*) IS ISSUED
* FOR THE SPECIFIED FILE IF THE BUFFER IS NOT EMPTY.
*
* ENTRY (X2) = FET ADDRESS.
*
* EXIT (X2) = FET ADDRESS.
*
* USES X - 1, 3.
* A - 1, 3.
*
* MACROS RECALL, WRITECW.
FCW SUBR ENTRY/EXIT
RECALL X2 WAIT COMPLETION OF ANY PENDING OPERATION
SA1 X2+2 GET *IN*
SA3 A1+B1 GET *OUT*
IX1 X1-X3
ZR X1,FCWX IF BUFFER EMPTY
WRITECW X2 FLUSH BUFFER
EQ FCWX RETURN
FTR SPACE 4,10
** FTR - FORMAT ALTERNATE STORAGE TAPE REQUEST PARAMETERS.
*
* ENTRY (A1) = *FCTV* WORD FROM CATALOG ENTRY.
*
* EXIT (X7) = TAPE REQUEST PARAMETERS FORMATTED FOR SORT.
*
* USES X - 1, 2, 6, 7.
FTR SUBR ENTRY/EXIT
SX7 700B
MX6 -24
LX7 48
BX7 X7*X1 TAPE TYPE FLAGS AND FORMAT
BX6 -X6*X1 VSN POINTER
MX2 -18
LX6 24
LX1 0-24
BX7 X7+X6 MERGE VSN POINTER
BX2 -X2*X1 FILE SEQUENCE NUMBER
BX7 X7+X2 MERGE SEQUENCE NUMBER
EQ FTRX RETURN
GLF SPACE 4,20
** GLF - GET LOCK FILES.
*
* ENTRY (MSSF) = 0, IF NOT *MSS* ENVIRONMENT.
* = 1, IF *MSS* ENVIRONMENT.
* (ASFF) = 0, IF NOT *MSE* ENVIRONMENT.
* = 1, IF *MSE* ENVIRONMENT.
* (FMPN) = FAMILY NAME.
*
* EXIT (LMSK) = 0, IF NO LOCK FILES ATTACHED.
* .NE. 0, IF LOCK FILES ATTACHED.
*
* USES X - 1, 2, 3, 6, 7.
* A - 1, 2, 3, 6, 7.
* B - 4, 5, 6.
*
* CALLS ALF.
*
* MACROS CALLPFU, MESSAGE, MOVE, SETPFP.
GLF SUBR ENTRY/EXIT
SA1 MSSF
SA2 ASFF
BX1 X1+X2
ZR X1,GLFX IF NEITHER *MSS* NOR *MSE* ENVIRONMENT
SA1 CPAR+/COMSPFS/CPPN
NZ X1,GLFX IF DUMPING AUXILIARY PACK
SA1 MSTA
SA1 X1+B1
MX6 -8
BX6 -X6*X1 DEVICE MASK
SA6 CMSK SET SUBFAMILY CONTROL DEVICE MASK
SA6 GLFA
* INITIALIZE LOCK LOOP.
SA3 IDSA+/COMSPFS/ADM1 ISSUE WAIT MESSAGE
MOVE 4,MSGAA,X3 K-DISPLAY
MESSAGE MSGAA,2,R B-DISPLAY
* CLEAR FIRST WORD OF EACH LOCK FILE *PFC* ENTRY BUFFER.
SB6 LFATL-1 SET LENGTH OF *LFAT* TABLE
SX6 B0+
GLF0 SA1 LFAT+B6 GET ADDRESS OF *PFC* ENTRY BUFFER
SA6 X1
SB6 B6-B1 DECREMENT *LFAT* INDEX
PL B6,GLF0 IF MORE ENTRIES
* GET NEEDED LOCK FILES FOR *MSS*.
SA1 MSSF
ZR X1,GLF4 IF NOT *MSS* ENVIRONMENT
SB4 B0
GLF1 SB6 B0
GLF2 SA1 CMSK
SX2 B1+
LX2 B6,X2
BX3 X2*X1
ZR X3,GLF3 IF THIS LOCK FILE NOT NEEDED
RJ ALF ATTACH LOCK FILE
GLF3 SB6 B6+1 INCREMENT INDEX
SB5 MNSF
LT B6,B5,GLF2 IF SUBFAMILIES NOT EXHAUSTED
SA1 GLFA
SA2 LMSK
BX1 X1-X2
ZR X1,GLF4 IF ALL NEEDED LOCK FILES OBTAINED
CALLPFU LKC1,CTGU,R GET LOCK FILES HELD BY *MSS* EXECUTIVE
SB2 100B
RJ DLY DELAY
EQ GLF1 RETRY ATTACHING NEEDED LOCK FILES
* GET NEEDED LOCK FILES FOR *MSE*.
GLF4 SA1 ASFF
ZR X1,GLF8 IF NOT *MSE* ENVIRONMENT
SA1 GLFA RESET MASK
BX6 X1
SA6 CMSK
SB4 10B
GLF5 SB6 10B
GLF6 SA1 CMSK
SX2 B1
LX2 B6,X2
AX2 B4
BX3 X2*X1
ZR X3,GLF7 IF THIS LOCK FILE NOT NEEDED
RJ ALF ATTACH LOCK FILE
GLF7 SB6 B6+1 INCREMENT INDEX
SB5 B4+MNSF
LT B6,B5,GLF6 IF SUBFAMILIES NOT EXHAUSTED
SA1 GLFA
SA2 LMSK
AX2 B4
BX1 X1-X2
ZR X1,GLF8 IF ALL NEEDED LOCK FILES OBTAINED
CALLPFU LKC2,CTGU,R GET LOCK FILES HELD BY *MSE* EXECUTIVE
SB2 100B
RJ DLY DELAY
EQ GLF5 RETRY ATTACHING NEEDED LOCK FILES
GLF8 SX6 UIPR CLEAR USER INDEX
SA6 SPAR
SX7 B0+
SA7 SPAR+2
SETPFP SPAR
SA3 IDSA+/COMSPFS/ADM1 CLEAR WAIT MESSAGE
MOVE 4,MSGL,X3 K-DISPLAY
MESSAGE (=C**),2,R B-DISPLAY
EQ GLFX RETURN
GLFA BSSZ 1 SUBFAMILY CONTROL MASK HOLD
GRC SPACE 4,20
** GRC - GENERATE *RDF* CATALOG RECORDS.
*
* ENTRY (LMSK) = LOCK FILE MASK.
* (MSSF) = 0, IF NOT AN *MSS* ENVIRONMENT.
* = 1, IF AN *MSS* ENVIRONMENT EXISTS.
* (ASFF) = NONZERO, IF *MSE* ENVIRONMENT.
* *LFAT* = FWA OF LOCK FILE FET ARGUMENT TABLE.
* *LOCK* = FWA OF LOCK FILE FET.
* *RDF* = FWA OF *RDF* FET.
*
* EXIT IF RELEASE DATA FILE (RDF) GENERATION REQUESTED
* AND AN *MSS* AND/OR AN *MSE* ENVIRONMENT
* EXISTS, AN *MSS* AND/OR AN *MSE* CATALOG
* RECORD IS WRITTEN TO THE *RDF* FOR EACH SUBFAMILY
* INDICATED IN THE DUMP DEVICE MASK.
*
* USES X - 0, 1, 2, 3, 6.
* A - 1, 2, 3, 6.
* B - 2, 3.
*
* MACROS READ, READW, REWIND, SETFET, WRITER, WRITEW.
GRC SUBR ENTRY/EXIT
SA1 CPAR+/COMSPFS/CPRD
ZR X1,GRCX IF RDF NOT REQUESTED
SA1 RDFE
ZR X1,GRC0.1 IF NO *RDF* EXTRACTS WRITTEN
BX6 X6-X6 CLEAR EXTRACT WRITTEN FLAG
SA6 A1
WRITER RDF,R TERMINATE SERIES OF *RDF* DEVICE EXTRACTS
GRC0.1 SA1 MSSF
SA2 ASFF
BX1 X1+X2
ZR X1,GRCX IF NEITHER *MSS* NOR *MSE* ENVIRONMENT
BX6 X6-X6 INITIALIZE FET TABLE INDEX
SA6 GRCA
* INITIALIZE LOCK FET.
SA1 LOCK+1 FIRST
MX0 42
BX6 X0*X1
SX2 CATB
BX6 X6+X2
SA6 A1
BX6 X2 IN
SA6 A6+B1
SA6 A6+B1 OUT
SETFET LOCK,ERP=B0 CLEAR USER ERROR PROCESSING BIT
* DETERMINE NEXT *MSS*/*MSE* CATALOG FILE TO PROCESS.
GRC1 SA1 GRCA
SX2 LFATL-1
IX2 X2-X1
NG X2,GRCX IF SUBFAMILIES EXHAUSTED
SB3 X1
SX2 B1 INCREMENT FET TABLE INDEX
IX6 X1+X2
SA6 A1
SA1 LMSK CHECK LOCK FILE MASK
SB2 59
SB2 B2-B3
LX1 B2,X1
PL X1,GRC1 IF SUBFAMILY NOT DUMPED
* OPEN *MSS*/*MSE* CATALOG FILE.
SA1 LOCK SET LOCK FET FILE NAME
SA2 LFAT+B3
MX0 42
BX6 X0*X2
BX3 -X0*X1
BX6 X6+X3
SA6 A1+
REWIND LOCK,R INITIATE *CIO*
READ X2
* WRITE *RDF* CATALOG RECORD CONTROL WORD.
SX6 CCWD BUILD CATALOG RECORD CONTROL WORD
SX1 B3 SET SUBFAMILY NUMBER
LX1 53-5
BX6 X1+X6
SA6 RDFH
WRITEW RDF,RDFH,B1
* COPY *MSS*/*MSE* CATALOG FILE TO RELEASE DATA FILE.
GRC2 READW LOCK,RDFH,RDFHL
NZ X1,GRC3 IF END OF MSF CATALOG
WRITEW RDF,RDFH,RDFHL
EQ GRC2 COPY NEXT SECTOR
GRC3 SX1 B6-RDFH
WRITEW RDF,RDFH,X1
WRITER X2,R
EQ GRC1 PROCESS NEXT CATALOG FILE
GRCA BSSZ 1 INDEX HOLD
GRE SPACE 4,15
** GRE - GENERATE *RDF* EXTRACT RECORD.
*
* ENTRY (A0) = CATALOG ENTRY ADDRESS.
* (CPAR+/COMSPFS/CPDN) = DEVICE NUMBER.
*
* EXIT EXTRACT RECORD WRITTEN TO THE RELEASE DATA FILE,
* IF ALTERNATE STORAGE ADDRESS NOT ZERO.
* (RDFE) = 1, IF EXTRACT RECORD WRITTEN.
*
* USES X - 0, 1, 6.
* A - 1, 6.
*
* MACROS WRITEW.
GRE SUBR ENTRY/EXIT
SA1 CPAR+/COMSPFS/CPIP
NZ X1,GREX IF INHIBITED PROCESSING
SA1 A0+FCAA GET ALTERNATE STORAGE ADDRESS
MX0 -36
BX1 -X0*X1
ZR X1,GREX IF NO ALTERNATE STORAGE ADDRESS
SX6 1 SET RDF EXTRACT FLAG
SA6 RDFE
* BUILD EXTRACT RECORD CONTROL WORD.
SX6 ECWD
SA1 CPAR+/COMSPFS/CPDN SET DEVICE NUMBER
LX1 59-5
BX6 X1+X6
SA1 A0+FCUI SET SUBFAMILY NUMBER
MX0 -3
BX1 -X0*X1
LX1 53-5
BX6 X1+X6
SA6 RDFH
* BUILD BODY OF EXTRACT RECORD.
SA1 A0+FCFN+FCUI* SET FILE NAME AND USER INDEX
BX6 X1
SA6 A6+B1
SA1 A0+FCCD SET CREATION DATE/TIME
MX0 -36
BX6 -X0*X1
SA6 A6+B1
SA1 A0+FCMD SET DATA MODIFICATION DATE/TIME
BX6 -X0*X1
SA6 A6+B1
SA1 A0+FCKD SET CONTROL MODIFICATION DATE/TIME
BX6 -X0*X1
SA6 A6+B1
SA1 A0+FCUD SET UTILITY CONTROL DATE/TIME
BX6 -X0*X1
SA1 A0+FCBT+FCBS*
MX0 -24
BX1 -X0*X1
ZR X1,GRE1 IF FILE NOT DISK RESIDENT
MX0 1 SET *DISK RESIDENT* FLAG
BX6 X0+X6
GRE1 SA6 A6+B1
SA1 A0+FCAF+FCAT*0+FCAA* ALTERNATE STORAGE INFORMATION
BX6 X1
SA6 A6+B1
WRITEW RDF,RDFH,8 WRITE EXTRACT RECORD
EQ GREX RETURN
IFM SPACE 4,10
** IFM - ISSUE FILE COUNT MESSAGES.
*
* EXIT FILES PROCESSED COUNTS ISSUED TO DAYFILE.
*
* USES X = 1, 2, 5, 6.
* A = 1, 2, 5, 6.
*
* CALLS IFC.
IFM SUBR ENTRY/EXIT
SA1 CPAR+/COMSPFS/CPIP
SA5 IFMD
NZ X1,IFM2 IF PROCESSING INHIBITED
SA5 IFMA
RJ IFC ISSUE FILE COUNT MESSAGES
SA1 CPAR+/COMSPFS/CPOP
SA2 CPAR+/COMSPFS/CPDT
SA5 IFMB
LX1 59-53
NG X1,IFM1 IF PURGE OPTION SPECIFIED
SA5 IFMC
ZR X2,IFMX IF NOT DESTAGE DUMP
IFM1 SA1 PRFC
SA2 PPFC
IX6 X1-X2
SA6 NPFC SET FILES NOT POST PROCESSED
IFM2 RJ IFC ISSUE FILE COUNT MESSAGES
EQ IFMX RETURN
IFMA BSS 0 NORMAL PROCESSING MESSAGE TABLE
VFD 1/1,1/0,22/0,18/DUMS,18/PRFC
VFD 1/1,1/0,22/0,18/POMS,18/POFC
VFD 1/0,1/0,22/0,18/STMS,18/STFC
VFD 1/1,1/0,22/0,18/SEMS,18/SEFC
VFD 1/1,1/0,22/0,18/DEMS,18/PEFC
CON 0 END OF TABLE
IFMB BSS 0 DUMP WITH PURGE MESSAGE TABLE
VFD 1/1,1/0,22/0,18/PGMS,18/PPFC
VFD 1/0,1/0,22/0,18/NPMS,18/NPFC
CON 0 END OF TABLE
IFMC BSS 0 DESTAGE DUMP MESSAGE TABLE
VFD 1/1,1/0,22/0,18/DSMS,18/PPFC
VFD 1/0,1/0,22/0,18/NDMS,18/NPFC
CON 0 END OF TABLE
IFMD BSS 0 INHIBITED PROCESSING MESSAGE TABLE
VFD 1/1,1/0,22/0,18/SDMS,18/PRFC
VFD 1/1,1/0,22/0,18/SPMS,18/POFC
CON 0 END OF TABLE
IRF SPACE 4,10
** IRF - INITILIZE RESCAN FILES.
*
* EXIT *REQS* FILE FLUSHED, REWOUND, AND RENAMED TO *RESS*.
* OLD *RESS* FILE RETURNED.
*
* USES X - 0, 1, 2, 6.
* A - 1, 2, 6.
*
* MACROS READ, RECALL, RENAME, REWIND, WRITEF.
IRF SUBR ENTRY/EXIT
WRITEF REQS,R FLUSH REQUEST FILE BUFFER
RENAME REQS,RESS CREATE SCREEN FILE FROM REQUEST FILE
REWIND RESS
RECALL REQS
SA1 IRFA RESTORE LFN IN *REQS* FET
SA2 REQS
MX0 -18
BX6 -X0*X2
BX6 X1+X6
SA6 A2
READ RESS
EQ IRFX RETURN
IRFA CON 0LZZZZZG5 ORIGINAL *REQS* FILE NAME
IRS SPACE 4,15
** IRS - INITIALIZE RESCAN FOR STAGED FILES.
*
* ENTRY CATALOG TRACK INTERLOCK SET.
*
* EXIT (X6) = 1 IF TO RESCAN CATALOG TRACK.
* (X7) = INITIAL CATALOG TRACK INDEX IF TO RESCAN TRACK.
* CATALOG TRACK INTERLOCK SET.
*
* USES X - 1, 2, 3, 5, 6, 7.
* A - 1, 2, 3, 6.
* B - 2.
*
* CALLS CFE, IRF, SRS.
*
* MACROS CALLPFU, MESSAGE, MOVE, PCINT, RECALL, READW.
IRS SUBR ENTRY/EXIT
* CLEAR CATALOG TRACK INTERLOCK AND ISSUE STATUS MESSAGE.
PCINT CATS,CTCC CLEAR CATALOG TRACK INTERLOCK
RJ IRF INITIALIZE RESCAN FILES
MESSAGE MSGS,1 *WAITING FOR STAGED FILES*
SA3 IDSA+/COMSPFS/ADMS
MOVE 3,MSGS,X3 SET STATUS MESSAGE IN *K* DISPLAY
SX6 RESC
RJ SRS SELECT RIGHT SCREEN
* DELAY FOR FILE STAGING.
SX5 DFAC SET NUMBER OF RECALLS TO WAIT
IRS1 SA1 /COMSPFS/KIN GET K-DISPLAY INPUT
SA2 IRSA
SX6 B0
SA6 A1+ CLEAR INPUT
BX2 X1-X2
ZR X2,IRS2 IF *SKIP* ENTERED
RECALL
SX5 X5-1
NZ X5,IRS1 IF MORE DELAY
* INITIALIZE RESCAN OF CATALOG TRACK.
READW RESS,RESE,2 READ FIRST RESCAN REQUEST
RETURN CATS,R RETURN OLD CATALOG FILE
SA1 RSTS
SA2 CATS+FTPM
MX6 24
SX7 5
LX1 12
BX6 X6*X2 PRESERVE EST ORDINAL AND FIRST TRACK
BX1 X1+X7 MERGE CURRENT TRACK/SECTOR AND STATUS
BX6 X6+X1
SA6 A2 SET FST PARAMETERS
CALLPFU CATS,CTOL,R OPEN CATALOG FILE
SX5 B1 SET TO RESCAN TRACK
EQ IRS3 RESET TRACK INTERLOCK
* ISSUE MESSAGES FOR SKIPPED FILES.
IRS2 READW RESS,RESE,2 READ STAGE REQUEST ENTRY
SX5 B0+ SET NO RESCAN
NZ X1,IRS3 IF END OF REQUESTS
SA1 RESE+1 SET FILE NAME AND USER INDEX
SB2 ERRT * STAGED FILE RESCAN TERMINATED ...*
RJ SFE SEND ERROR MESSAGE
RJ CFE COUNT FILE SKIPPED
EQ IRS2 READ NEXT ENTRY
* CLEAR MESSAGE AND RESET CATALOG TRACK INTERLOCK.
IRS3 SA3 IDSA+/COMSPFS/ADER CLEAR HELP MESSAGE
MOVE 4,MSGW,X3
PCINT CATS,CTSC RESET CATALOG TRACK INTERLOCK
SA1 RSIN
BX6 X5 SET RESCAN STATUS
BX7 X1 SET CATALOG INDEX FOR RESCAN
EQ IRSX RETURN
IRSA CON 0LSKIP *SKIP* KEYBOARD ENTRY
MMC SPACE 4,10
** MMC - MOVE MEMORY VIA *CMU* OR REGISTERS.
*
* ENTRY (X1) = WORD COUNT OF MOVE.
* (X3) = ADDRESS TO MOVE FROM.
* (X6) = ADDRESS TO MOVE TO.
*
* USES X - 0, 1, 3, 6.
* A - 1, 3, 6.
* B - 5.
MMC SUBR ENTRY/EXIT
LX3 30 BUILD DESCRIPTOR WORD
BX6 X6+X3
SA3 MMCB GET ADDRESS INCREMENT
UX3,B5 X3 EXTRACT CHARACTER COUNT
PX6 X6,B5 SET CHARACTER COUNT UPPER FIELD
SB5 X1 SET WORD COUNT
BX1 X0 SAVE X0
MMC1 SA6 A3-B1 STORE DESCRIPTOR WORD
SB5 B5+X3 DECREMENT WORD COUNT
NG B5,MMC2 IF SHORT BLOCK TO MOVE
IM MMCA
IX6 X6-X3 INCREMENT ADDRESSES
GT B5,B0,MMC1 IF MORE DATA TO TRANSFER
BX0 X1 RESTORE X0
EQ MMCX RETURN
* PROCESS BLOCK SHORTER THAN *NWCM* WORDS.
MMC2 SX3 B5+NWCM RESET CHARACTER COUNT IN DESCRIPTOR
UX6 X6
LX0 X3,B1 COMPUTE CHARACTERS LEFT TO MOVE
LX3 3
IX3 X0+X3
MX0 4
LX3 -4
BX0 X0*X3 EXTRACT LOWER FIELD
SB5 2000B+X3 SET UPPER FIELD
LX0 -30
PX6 X6,B5
BX6 X6+X0
SA6 MMCA STORE DESCRIPTOR
IM MMCA
BX0 X1 RESTORE X0
EQ MMCX RETURN
MMCA VFD 12/0 UPPER CHARACTER COUNT OF MOVE
VFD 18/0 ADDRESS TO MOVE FROM
VFD 4/0 LOWER CHARACTER COUNT FIELD
VFD 8/0
VFD 18/0 ADDRESS TO MOVE TO
MMCB VFD 12/-NWCM*10D/20B,18/-NWCM,30/-NWCM ADDRESS INCREMENT
ERRNZ MMCB-MMCA-1 CODE DEPENDS ON LOCATION OF CELLS
MMCL EQU *-MMC LENGTH OF CODE TO OVERLAY
* THE FOLLOWING CODE IS USED WHEN NO *CMU* IS PRESENT.
MOVE RMT
LOC MMC
MMC SUBR ENTRY/EXIT
SA3 X3 READ FIRST WORD TO MOVE
SB5 X1-10B SET WORD COUNT
SA1 X6-1 INITIALIZE STORE ADDRESS
BX6 X1
SA6 A1
NG B5,MMC4 IF LESS THAN 10B WORDS TO MOVE
* REGISTER MOVE LOOP.
MMC3 SA1 A3+B1
BX6 X3
SA6 A6+B1
SA3 A1+B1
BX6 X1
SA6 A6+B1
SA1 A3+B1
BX6 X3
SA6 A6+B1
SB5 B5-10B DECREMENT WORD COUNT
SA3 A1+B1
BX6 X1
SA6 A6+B1
SA1 A3+B1
BX6 X3
SA6 A6+B1
SA3 A1+B1
BX6 X1
SA6 A6+B1
SA1 A3+B1
BX6 X3
SA6 A6+B1
SA3 A1+B1
BX6 X1
SA6 A6+B1
PL B5,MMC3 IF MORE 10 WORD BLOCKS TO MOVE
* MOVE REMAINDER OF DATA.
MMC4 SB5 B5+10B
ZR B5,MMCX IF NO MORE DATA TO MOVE
MMC5 BX6 X3
SA3 A3+B1
SB5 B5-B1
SA6 A6+B1
GT B5,B0,MMC5 IF MORE DATA TO MOVE
EQ MMCX RETURN
ERRPL *-MMC-MMCL CODE TOO LARGE TO OVERLAY *MMC*
LOC *O
MOVE RMT
MRE SPACE 4,20
** MRE - MAKE DATA READ LIST ENTRY.
*
* ENTRY (A0) = CATALOG ADDRESS.
*
* EXIT (A0) = CATALOG ADDRESS.
* (X6) = 0 IF DATA LIST FULL.
* (X6) .NE. 0 IF DATA LIST NOT FULL.
* DATA READ LIST ENTRY MADE IF NO ERROR.
* (NDLE) = UPDATED COUNT OF READ LIST ENTRIES.
*
* USES X - 0, 1, 2, 3, 5, 6, 7.
* A - 1, 2, 6, 7.
* B - 2.
*
* CALLS CDS, CFE, SDE.
*
* MACROS MOVE.
MRE SUBR ENTRY/EXIT
* SET BUFFER INDEX AND TRACK/SECTOR IN ENTRY.
SA1 A0+FCBT
SA2 NDLE
MX0 -24
BX7 -X0*X1 TRACK AND SECTOR
SB2 X2 NEXT CATALOG INDEX
LX1 59-11
PX7 X7,B2 SET CATALOG INDEX AND TRACK/SECTOR
MX0 24
PL X1,MRE2 IF INDIRECT ACCESS FILE
* PROCESS DIRECT ACCESS FILE.
SA1 A0+FCDN
SA2 CPAR+/COMSPFS/CPDN
MX0 48
MX6 -6
LX1 -36
BX1 -X6*X1 DEVICE NUMBER
ZR X1,MRE1 IF FILE RESIDES ON MASTER DEVICE
SX2 X1+
MRE1 SX2 X2+4000B SET DIRECT ACCESS FLAG
BX7 X0*X7
BX7 X7+X2 SET DEVICE NUMBER IN LIST ENTRY
ZR X1,MRE3 IF FILE RESIDES ON MASTER DEVICE
RJ CDS CHECK DEVICE STATUS
NZ X6,MRE3 IF DEVICE FOUND
SX2 X1+ SET DEVICE NUMBER
SA1 A0+FCFN GET FILE NAME AND USER INDEX
SB2 ERDN * DEVICE NOT FOUND ...*
RJ SDE SEND ERROR MESSAGE
RJ CFE COUNT FILE SKIPPED
SX6 B1 SET DATA LIST NOT FULL
EQ MREX RETURN
* PROCESS INDIRECT ACCESS FILE.
MRE2 SA1 A0+FCLF
SX6 B1
LX6 24
BX7 X7+X6 SET FILE LENGTH ADJUSTMENT
BX1 X0*X1 FILE LENGTH
LX1 -12
IX7 X7+X1 SET FILE LENGTH IN ENTRY
* PUT ENTRY IN LIST.
MRE3 SA1 CADA
SA7 DLRB+B2 PUT READ LIST ENTRY IN TABLE
SX3 B2+
LX3 4 OFFSET IN *DLCB*
ERRNZ NWCE-20B
BX6 X1
SX3 DLCB+X3 CATALOG ADDRESS IN *DLCB*
SA6 DLDB+B2 SAVE DISK ADDRESS
MOVE NWCE,A0,X3 MOVE CATALOG ENTRY TO BUFFER
SX6 B2+B1 ADVANCE READ LIST ENTRY COUNT
SX7 B0
SA6 NDLE UPDATE ENTRY COUNT
SA7 DLRB+X6 WRITE TERMINATOR WORD
SX6 X6-DLEMX SET LIST FULL STATUS
EQ MREX RETURN
OPF SPACE 4,10
** OPF - OPEN PERMITS FILE.
*
* EXIT PERMITS FILE OPENED.
*
* USES X - 1, 2, 3, 6, 7.
* A - 1, 2, 7.
*
* MACROS CALLPFU.
OPF SUBR ENTRY/EXIT
SA2 MSTA
SA1 MAEQ
SA2 X2
MX6 -12
SX7 10005B FIRST SECTOR AND FILE STATUS
LX1 48
LX2 -24
BX7 X1+X7 MERGE EST ORDINAL, SECTOR, AND STATUS
BX3 -X6*X2 PERMITS FIRST TRACK
BX2 -X6*X2 SET CURRENT TRACK
LX3 36
LX2 24
BX7 X7+X3 MERGE FIRST TRACK
BX7 X7+X2 MERGE CURRENT TRACK
SA7 PETS+FTPM SET PARAMETER WORD
CALLPFU PETS,CTOL,R OPEN FILE
EQ OPFX RETURN
OPN SPACE 4,20
** OPN - OPEN DEVICE FILES.
*
* ENTRY (MSTA) = MASTER DEVICE *MSTT* ENTRY ADDRESS.
* (MAEQ) = MASTER DEVICE EST ORDINAL.
* (CPAR+/COMSPFS/CPDN) = MASTER DEVICE NUMBER.
*
* EXIT CATALOG, PERMIT AND DATA FILES OPENED.
*
* USES X - 1, 2, 3, 5, 6, 7.
* A - 1, 2, 5, 7.
*
* CALLS OCF, OPF.
*
* MACROS CALLPFU.
OPN SUBR ENTRY/EXIT
* OPEN CATALOG AND PERMITS FILES.
RJ OCF OPEN CATALOG FILE
RJ OPF OPEN PERMITS FILE
* OPEN DATA FILE.
SA2 MSTA
SA1 MAEQ
SA2 X2
MX6 -12
SX7 10005B FIRST SECTOR AND FILE STATUS
LX1 48
LX2 -48
BX7 X1+X7 MERGE EST ORDINAL, SECTOR, AND STATUS
BX3 -X6*X2 INDIRECT DATA CHAIN FIRST TRACK
BX2 -X6*X2 SET CURRENT TRACK
LX3 36
LX2 24
BX7 X7+X3 MERGE FIRST TRACK
BX7 X7+X2 MERGE CURRENT TRACK
SA7 DATA+FTPM
CALLPFU DATA,CTOL,R
* SET UP DATA FET FOR *PFU* READ LIST FUNCTION (CTRL).
SA2 CPAR+/COMSPFS/CPDN SET MASTER DEVICE NUMBER
SA1 MAEQ SET MASTER DEVICE EST ORDINAL
SA5 CPAR+/COMSPFS/CPDT
SX7 X2+4000B
LX1 47-11
LX7 59-11
ZR X5,OPN1 IF NOT DESTAGE DUMP
SX5 1 SET TO CHECK UPDATE MODE FILE BUSY
LX5 35-0
BX7 X7+X5
OPN1 BX7 X7+X1
SA7 DATA+FTPM
EQ OPNX RETURN
PAF SPACE 4,10
** PAF - PROCESS ARCHIVE FILE OPERATION.
*
* ENTRY (B6) = FIRST PARAMETER FOR *CWWRITE* MACRO.
* (B7) = SECOND PARAMETER FOR *CWWRITE* MACRO.
*
* USES X - 1, 2, 6, 7.
* A - 1, 2, 6, 7.
* B - 6, 7.
*
* MACROS CWWRITE.
PAF SUBR ENTRY/EXIT
SX6 B6 SAVE PARAMETERS
SX7 B7
SA6 PAFA
SA7 PAFA+1
CWWRITE TAPE,B6,B7 WRITE DATA TO ARCHIVE FILE
SA1 CPAR+/COMSPFS/CPVF
ZR X1,PAFX IF NO VERIFY FILE SPECIFIED
SA1 PAFA RESTORE PARAMETERS
SA2 PAFA+1
SB6 X1
SB7 X2
CWWRITE PFVER,B6,B7 WRITE DATA TO ARCHIVE VERIFY FILE
EQ PAFX RETURN
PAFA BSS 2 PARAMETER SAVE AREA
PAR SPACE 4,15
** PAR - POSITION ALTERNATE STORAGE TAPE TO NEXT RECORD.
*
* EXIT ALTERNATE STORAGE TAPE POSITIONED TO START OF NEXT
* RECORD IF NOT CURRENTLY AT EOF OR EOI.
* (X1) .LT. 0 IF CURRENTLY AT EOF OR EOI.
* (CWSW) = 0 IF NOT AT EOF OR EOI.
*
* USES X - 6.
* A - 6.
*
* MACROS CWREAD.
PAR SUBR ENTRY/EXIT
PAR1 CWREAD AST,DBUFH,DBUFHL
ZR X7,PAR2 IF NO READ ERROR
ZR B7,PAR1 IF TRANSFER COMPLETE
PAR2 ZR X1,PAR1 IF NOT EOR/EOF/EOI
NG X1,PARX IF EOF/EOI
SX6 B0+ ENABLE READ OF NEXT RECORD
SA6 AST+CWSW
EQ PARX RETURN
PAT SPACE 4,15
** PAT - PROCESS ALTERNATE STORAGE TAPE.
*
* EXIT FILES RESIDING ON SELECTED TAPE DUMPED.
*
* USES X - 1, 2, 6, 7.
* A - 1, 2, 6, 7.
* B - 2, 3.
*
* CALLS AAT, CFE, DTF, FTR, IRF, PAR, RCW, SFE.
*
* MACROS CWREAD, READCW, READW, UNLOAD, WRITEW.
PAT SUBR ENTRY/EXIT
* ASSIGN TAPE.
UNLOAD AST,R RETURN CURRENT TAPE
RJ AAT ASSIGN ALTERNATE STORAGE TAPE
SX6 1
SA6 PATA+1 ENABLE RESCAN OF TAPE
* INITIALIZE TAPE PASS.
PAT1 SX6 B0+
SA6 PATA CLEAR FILE PROCESSED FLAG
SA6 PATB CLEAR RESCAN REQUESTED
SX0 MXLRR SET RETRY LIMIT FOR LABEL READ
* INITIATE READ AND PROCESS ARCHIVE FILE LABEL.
PAT2 SX0 X0-1 DECREMENT LABEL READ RETRY COUNTER
NG X0,PAT9 IF RETRIES EXHAUSTED
REWIND AST REWIND ARCHIVE FILE
SX6 B0
SA6 AST+CWSW CLEAR CONTROL WORD STATUS WORD
READCW X2,17B INITIATE READ
RJ RCW READ BLOCK CONTROL WORD
NZ X7,PAT2 IF ERROR
NZ X1,PAT9 IF EOR, EOF, OR EOI
NZ X3,PAT9 IF NOT ARCHIVE LABEL CONTROL WORD
CWREAD AST,DBUFH,X6+B1 READ BLOCK
NZ X7,PAT2 IF READ ERROR
NE B7,B1,PAT9 IF NOT FULL BLOCK TERMINATED BY EOR
* READ NEXT REQUEST.
PAT3 READW RESS,RESE,TCRQL READ REQUEST
ZR X1,PAT4 IF NOT END OF REQUESTS
SA1 PATB
ZR X1,PATX IF RESCAN NOT REQUESTED
EQ PAT8 CHECK RESCAN LIMIT
* FIND NEXT TAPE FILE.
PAT4 RJ PAR POSITION ARCHIVE FILE TO NEXT RECORD
RJ RCW READ BLOCK CONTROL WORD
NZ X7,PAT4 IF ERROR
NG X1,PAT7 IF EOF OR EOI
NZ X1,PAT4 IF EOR
SX3 X3-1
SX4 X4-1
SX2 X6-NWCE
NZ X3,PAT4 IF NOT CATALOG BLOCK
NZ X4,PAT4 IF NOT FILE DUMP WITH DATA
NZ X2,PAT4 IF NOT CORRECT BLOCK LENGTH
CWREAD AST,DBUFH,X6 READ BLOCK
NZ X7,PAT4 IF READ ERROR
NZ X1,PAT4 IF PREMATURE EOR, EOF, OR EOI
* COMPARE TAPE FILE TO REQUEST.
PAT5 SA1 DBUFH+FCTV GET TAPE ALTERNATE STORAGE INFORMATION
RJ FTR FORMAT TAPE REQUEST PARAMETERS
SA1 RESE
MX6 -18
BX7 -X6*X7 SEQUENCE NUMBER OF CURRENT FILE
BX1 -X6*X1 SEQUENCE NUMBER OF REQUEST
IX7 X7-X1
NG X7,PAT4 IF NOT YET AT REQUESTED FILE
NZ X7,PAT6 IF PAST REQUESTED FILE
* DUMP FILE.
SX6 B1+
SA6 PATA SET FILE PROCESSED
RJ DTF DUMP TAPE RESIDENT FILE
EQ PAT3 CHECK REQUEST AND TAPE FILE
* SET TO PROCESS REQUEST ON RESCAN.
PAT6 SX7 1
SA7 PATB SET RESCAN REQUESTED
WRITEW REQS,RESE,TCRQL WRITE REQUEST FOR RESCAN
READW RESS,RESE,TCRQL READ NEXT REQUEST
ZR X1,PAT5 IF NOT END OF REQUESTS
EQ PAT8 CHECK RESCAN LIMIT
* PROCESS EOF/EOI ON TAPE WITH REQUESTS REMAINING.
* ALL REMAINING REQUESTS WILL BE COPIED TO RESCAN FILE.
PAT7 WRITEW REQS,RESE,TCRQL WRITE REQUEST FOR RESCAN
READW RESS,RESE,TCRQL READ NEXT REQUEST
ZR X1,PAT7 IF NOT END OF REQUESTS
* CHECK RESCAN LIMIT.
PAT8 RJ IRF INITIALIZE RESCAN FILES
SA1 PATA
SA2 A1+B1
IX2 X1+X2
BX6 X1
SA6 A2 SET LAST PASS STATUS
NZ X2,PAT1 IF FILES PROCESSED ON THIS OR LAST PASS
* ISSUE MESSAGES FOR FILES NOT FOUND ON ALTERNATE STORAGE TAPE.
PAT9 READW RESS,RESE,TCRQL READ REQUEST
NZ X1,PATX IF END OF REQUESTS
SA1 RESE+1 SET FILE NAME AND USER INDEX
SB2 ERNT * FILE NOT FOUND ON ALTERNATE STORAGE ...*
RJ SFE SEND ERROR MESSAGE
RJ CFE COUNT FILE SKIPPED
EQ PAT9 READ NEXT ENTRY
PATA CON 0 FILE PROCESSED ON CURRENT PASS FLAG
CON 0 FILE PROCESSED ON LAST PASS FLAG
PATB CON 0 TAPE RESCAN REQUESTED
PFC SPACE 4,25
** PFC - PROCESS FILE CATALOG ENTRY.
*
* ENTRY CATALOG ENTRY IN *CATH*.
* (FLOK) = *AFLOK*/*TFLOK* SELECTION FLAG.
* (SCAN) = 0, IF NORMAL SCAN.
* = 1, IF RESCAN.
* (X5) = SKELETON CONTROL WORD.
*
* EXIT TRACK AND SECTOR FIELDS OF CATALOG ENTRY IMAGE CLEARED
* IF RESCAN MODE TO IDENTIFY FILE NOT DISK RESIDENT AT
* THE TIME OF DUMP.
* ALTERNATE STORAGE INFORMATION CLEARED IN CATALOG ENTRY
* IMAGE IF ZERO ALTERNATE STORAGE OPTION SELECTED.
* TAPE ALTERNATE STORAGE VSN POINTER SET IN CATALOG
* IMAGE IF DESTAGE DUMP.
* CATALOG ENTRY IMAGE WRITTEN TO ARCHIVE FILE.
* (FLST) = FILE STATUS (*PFC ONLY* STATUS SET).
* (IFST) = 1 (CATALOG ENTRY DUMPED).
*
* USES X - 0, 1, 2, 3, 5, 6, 7.
* A - 1, 2, 3, 6, 7.
* B - 2, 3.
*
* CALLS DFN, WDT.
PFC SUBR ENTRY/EXIT
SA1 CATH+FCFN
SX7 X5-CCWC
ZR X7,PFC0.1 IF FILE DATA TO BE DUMPED
SX7 1 SET *PFC ONLY* FLAG
PFC0.1 SA7 FLST INITIALIZE FILE STATUS
* BUILD DUMP FILE CONTROL WORD.
MX6 42
BX1 X6*X1
SX5 X5+NWCE SET WORD COUNT
BX6 X1+X5 SET FILE NAME
SA6 CONTH
* UPDATE FILE LENGTH IN CATALOG ENTRY.
* NOTE - CODE IN SUBROUTINE *CSP* ENSURES THAT THE FILE
* LENGTH IN THE PFC IS ALREADY CORRECT IF THE FILE DATA
* IS NOT TO BE DUMPED.
SA1 CATH+FCBS CHECK FILE TYPE
SA2 CATH+FCLF SET LENGTH IN CATALOG ENTRY
MX0 24
LX1 59-11
BX6 X2
BX2 -X0*X2
PL X1,PFC2 IF INDIRECT ACCESS FILE
NZ X7,PFC2 IF DATA NOT TO BE DUMPED
SA3 DBUFH GET ACCURATE LENGTH FROM CONTROL WORD
LX3 59-47
BX6 X0*X3
BX6 X6+X2
PFC1 SX2 B1 ADJUST LENGTH TO EXCLUDE EOI SECTOR
BX1 X0*X6 GET FILE LENGTH
ZR X1,PFC2 IF ZERO FILE LENGTH
LX2 36-0
IX6 X6-X2
SA6 A2 UPDATE CATALOG ENTRY
* WRITE CATALOG ENTRY TO ARCHIVE FILE.
PFC2 SA1 CATH+FCFN SET FILE NAME AND USER INDEX
SA2 =10HDUMPING
RJ DFN DISPLAY STATUS MESSAGE
SA1 SCAN
ZR X1,PFC3 IF NORMAL SCAN MODE
SA1 CATH+FCBT CLEAR BEGINNING TRACK FIELD
MX2 48
LX2 23-11
BX6 X2*X1
SA6 A1
PFC3 SA1 CPAR+/COMSPFS/CPDT
ZR X1,PFC3.2 IF NOT DESTAGE DUMP
SA3 FLOK
NG X3,PFC3.1 IF DESTAGE TO OPTICAL DISK
SA1 VSNP
SX2 1
LX2 24
BX6 X1
IX7 X1+X2 INCREMENT FILE SEQUENCE NUMBER
SA6 CATH+FCTV+FCTS*0+FCTF*0 SET TAPE STORAGE INFORMATION
SA7 VSNP STORE UPDATED VSN POINTER
EQ PFC3.2 CONTINUE
PFC3.1 SA1 VSNP
BX6 X1
SA6 CATH+FCAA+FCAF*0+FCAT*0 SET OPTICAL DISK INFORMATION
RECALL T WAIT COMPLETION OF ANY PENDING OPERATION
SA1 T+6 GET CURRENT DISK ADDRESS
MX3 24
LX1 30-24
BX7 X3*X1
SA1 CATH+FCOA INSERT DISK ADDRESS INTO *FCOA*
BX6 -X3*X1
BX6 X6+X7
SA6 A1
PFC3.2 SA1 CPAR+/COMSPFS/CPOP
SA2 FLST
SX6 B0+
LX1 59-46
LX2 59-0
NG X2,PFC3.3 IF DUMPING PFC AND PERMITS ONLY
PL X1,PFC3.3 IF *OP=Z* NOT SELECTED
SA6 CATH+FCAA+FCAT*0+FCAF*0 CLEAR CARTRIDGE POINTERS
SA6 CATH+FCTV+FCTS*0+FCTF*0 CLEAR TAPE POINTERS
SA1 CATH+FCOA CLEAR OPTICAL DISK ADDRESS
MX6 24
BX6 -X6*X1
SA6 A1+
PFC3.3 SB2 CATH
SB3 NWCE
RJ WDT WRITE CATALOG ENTRY TO ARCHIVE FILE
SX6 1 SET PFC DUMPED INCOMPLETE FILE STATUS
SA6 IFST
EQ PFCX RETURN
PFI SPACE 4,15
** PFI - PROCESS FILE WITH DUMP INHIBITED.
*
* ENTRY (A0) = CATALOG ADDRESS.
* (B2) = 0 IF *PFC ONLY* DUMP SELECTED.
*
* EXIT (A0) = CATALOG ADDRESS.
* OUTPUT FILES WRITTEN WITH FILE INFORMATION.
*
* USES X - 7.
* A - 7.
*
* CALLS CFP, SFL.
PFI SUBR ENTRY/EXIT
SX7 B0
NZ B2,PFI1 IF NOT *PFC ONLY* FILE SELECTION
SX7 B1 SET *PFC ONLY* FLAG
PFI1 SA7 FLST INITIALIZE FILE STATUS
RJ SFL ENSURE FILE LENGTH CORRECT IN PFC ENTRY
ZR X6,PFIX IF DEVICE NOT FOUND ERROR
RJ CFP COUNT FILE PROCESSED
EQ PFIX RETURN
PPD SPACE 4,10
** PPD - PROCESS PFC/PERMITS ONLY DUMP.
*
* EXIT PFC ENTRY AND PERMITS WRITTEN TO ARCHIVE FILE.
*
* USES X - 5, 6, 7.
* A - 0.
*
* CALLS CFP, PFC, RPF, SFL.
*
* MACROS ARCHIVE.
PPD SUBR ENTRY/EXIT
RJ SFL ENSURE FILE LENGTH SET IN CATALOG ENTRY
SX5 COCW SET *PFC ONLY* CONTROL WORD
RJ PFC WRITE CATALOG ENTRY
RJ RPF WRITE FILE PERMITS
ARCHIVE WRITER WRITE EOR ON ARCHIVE FILE
SX6 B0+
SX7 BFAC
SA6 IFST CLEAR DUMP INCOMPLETE STATUS
SA7 WREM RESET BLOCK STATUS FOR NEXT FILE
SA0 CATH SET CATALOG ADDRESS
RJ CFP COUNT FILE PROCESSED
EQ PPDX RETURN
PRL SPACE 4,20
** PRL - PROCESS DATA READ LIST.
*
* ENTRY (NDLE) = NUMBER OF ELEMENTS IN *DLRB*.
*
* EXIT ALL ENTRIES IN THE DATA READ LIST PROCESSED.
* CATALOG INFORMATION WRITTEN TO OUTPUT FILE AND SUMMARY
* FILE FOR DUMPED FILES.
* (NDLE) = 0.
*
* USES X - 1, 5, 6, 7.
* A - 1, 2, 6.
* B - 2, 3, 5.
*
* CALLS CFD, CFE, DSF, PFC, RPR, RPF, SDL, SDP, UCE, WDB.
*
* MACROS CALLPFU, MOVE, RECALL.
PRL SUBR ENTRY/EXIT
SA1 NDLE
ZR X1,PRLX IF NO READ LIST ENTRIES
* SORT DATA LIST.
RJ SDL SORT DATA LIST
* INITIALIZE *DATA* FET AND CALL *PFU*.
RECALL DATA
SA1 NDLE
SX6 B0+
SA6 DATA+FTRE CLEAR RECALL WORD
SX6 DLRB
LX6 36
BX6 X6+X1 SET DATA LIST ADDRESS AND ENTRY COUNT
SA6 DATA+FTDL
CALLPFU DATA,CTRL READ DATA LIST
SX6 DLRB-1
SA6 PRLA INITIALIZE BUFFER POINTER
* PROCESS DATA READ LIST ENTRY.
PRL1 SA1 PRLA
SX6 X1+B1 ADVANCE TO NEXT ENTRY
SA6 A1
SA1 X6+ GET DATA LIST ELEMENT
ZR X1,PRL4 IF END OF ENTRIES
RJ SDP SET DATA LIST PARAMETERS
* CHECK FILE STATUS.
MOVE NWCE,A0,CATH SAVE CATALOG ENTRY
SB5 B0 SET TO READ ONE WORD
SB3 B1
RJ RPR READ FILE CONTROL WORD
SA1 DBUFH
MX6 12
BX6 X6*X1
ZR X6,PRL3 IF NO ERROR CONDITION AND FILE NOT BUSY
* PROCESS FILE BUSY OR ERROR CONDITION.
SB2 ERSS * BAD SYSTEM SECTOR ...*
LX1 59-50
NG X1,PRL2 IF BAD SYSTEM SECTOR
LX1 59-49-59+50
SB2 ERZL * ZERO LENGTH FILE ...*
NG X1,PRL2 IF ZERO LENGTH DIRECT ACCESS FILE
SB2 CTUU SET UPDATE UTILITY CONTROL DATE FUNCTION
RJ UCE UPDATE CATALOG ENTRY
SB2 ERFB * FILE BUSY ...*
PRL2 SA1 CATH+FCFN SET FILE NAME AND USER INDEX
RJ SFE SEND ERROR MESSAGE
RJ CFE COUNT FILE SKIPPED
EQ PRL1 CHECK NEXT ENTRY
* WRITE CATALOG ENTRY, PERMITS, AND FILE DATA.
PRL3 SX5 CCWC SET CONTROL WORD FOR DATA DUMP
RJ PFC WRITE CATALOG ENTRY
RJ RPF WRITE FILE PERMITS
RJ WDB WRITE DATA BLOCKS
RJ CFD COMPLETE FILE DUMP
EQ PRL1 CHECK NEXT ENTRY
* DROP STAGED FILES IF CATALOG RESCAN.
PRL4 SA1 SCAN
ZR X1,PRL5 IF NOT RESCAN
RJ DSF DROP STAGED FILES
* SET DATA LIST EMPTY.
PRL5 SX6 B0+
SA6 NDLE SET NO ENTRIES IN READ LIST
SA6 DLRB TERMINATE EMPTY LIST
EQ PRLX RETURN
PRLA BSS 1 *DLRB* POINTER
PTF SPACE 4,10
** PTF - PROCESS TAPE RESIDENT FILES.
*
* EXIT TAPE ALTERNATE STORAGE RESIDENT FILES DUMPED.
*
* USES X - 1, 2, 3, 6.
* A - 1, 2, 3, 6.
*
* CALLS IRF, PAT, STL.
*
* MACROS READ, READW, REWIND, WRITER, WRITEW.
PTF SUBR ENTRY/EXIT
SA1 TCRQ
ZR X1,PTFX IF NO TAPE RESIDENT FILES
WRITER TC FLUSH FILE LIST ENTRIES
REWIND TC
RJ STL SORT TAPE COPY FILE LIST
REWIND S3
READ S3
PTF1 READW S3,TCRQ,TCRQL
SA2 TCRQ
SA3 ASTI
BX6 X1
SA6 PTFA SAVE EOR STATUS
MX6 42
NZ X1,PTF2 IF EOR ENCOUNTERED
BX2 X6*X2 TAPE FLAGS AND VSN
BX2 X2-X3
ZR X3,PTF3 IF FIRST ENTRY
ZR X2,PTF3 IF SAME TAPE
PTF2 RJ IRF INITIALIZE RESCAN FILES
RJ PAT PROCESS ALTERNATE STORAGE TAPE
SA1 PTFA
NZ X1,PTFX IF EOR ON REQUEST FILE
PTF3 WRITEW REQS,TCRQ,TCRQL WRITE REQUEST FILE
SA1 TCRQ
MX6 42
BX6 X6*X1
SA6 ASTI SET TAPE IDENTIFIER
EQ PTF1 CHECK NEXT REQUEST
PTFA CON 0 EOR STATUS
RCP SPACE 4,15
** RCP - RECALL *PFU* TO READ DATA FILE.
*
* EXIT DATA FILE BUFFER NOT EMPTY.
* *PFU* CALLED IF BUFFER FOUND EMPTY AND FET NOT BUSY.
* (X2) = FIRST.
* (B4) = OUT.
* (B6) = IN.
* (A2) = ADDRESS OF FIRST IN DATA FET.
*
* USES X - 1, 2, 7.
* A - 1, 2.
* B - 4, 6.
*
* MACROS CALLPFU, RECALL.
RCP SUBR ENTRY/EXIT
RCP1 SA1 DATA CHECK FET STATUS
BX7 X1
SA2 A1+B1 READ FIRST
SA1 A2+B1 READ IN
SB6 X1
SA1 A1+B1 READ OUT
SB4 X1
NE B4,B6,RCPX IF DATA AVAILABLE
LX7 59-0
PL X7,RCP2 IF FET STILL BUSY
CALLPFU A2-B1,CTRL RECALL *PFU*
RCP2 RECALL WAIT FOR *PFU*
EQ RCP1 RECHECK BUFFER
RCW SPACE 4,20
** RCW - READ ARCHIVE FILE BLOCK CONTROL WORD.
*
* EXIT (X7) .NE. 0 IF READ ERROR OR INVALID CONTROL WORD.
* (X6) = BLOCK WORD COUNT IF CONTROL WORD READ AND NO
* ERROR.
* (X3) = CONTROL WORD TYPE CODE IF CONTROL WORD READ
* AND NO ERROR.
* (X4) = CONTROL WORD SUB-TYPE CODE IF CONTROL WORD READ
* AND NO ERROR.
* (X1) = READ STATUS FROM *CWREAD*.
* (CWBF) = ARCHIVE FILE CONTROL WORD.
*
* USES X - 2, 3, 4, 6, 7.
* A - 2.
*
* MACROS CWREAD.
RCW SUBR ENTRY/EXIT
CWREAD AST,CWBF,B1 READ ARCHIVE FILE CONTROL WORD
SA2 CWBF
NZ X7,RCWX IF READ ERROR
NZ X1,RCWX IF EOR, EOF, OR EOI
MX6 -9
MX3 -3
BX6 -X6*X2 BLOCK WORD COUNT
LX2 -9
BX4 -X3*X2 CONTROL WORD SUB-TYPE
LX2 -3
BX3 -X3*X2 CONTROL WORD TYPE
SX2 X3-10B
NG X2,RCWX IF VALID CONTROL WORD TYPE
SX7 1 SET ERROR
EQ RCWX RETURN
RFC SPACE 4,15
** RFC - REQUEST FILE COPY FROM TAPE ALTERNATE STORAGE.
*
* ENTRY (A0) = FWA OF CATALOG ENTRY.
*
* EXIT ENTRY MADE IN TAPE COPY LIST.
*
* USES X - 1, 2, 3, 6, 7.
* A - 1, 2, 3, 7.
*
* CALLS FTR.
*
* MACROS WRITEW.
RFC SUBR ENTRY/EXIT
* SET TAPE REQUEST INFORMATION FOR SORT.
SA1 A0+FCTV GET TAPE ALTERNATE STORAGE INFORMATION
RJ FTR FORMAT TAPE REQUEST PARAMETERS
SA7 TCRQ SET SORT PARAMETERS
* SET FILE NAME AND USER INDEX.
SA1 A0+FCFN
BX7 X1
SA7 A7+B1 SET FILE NAME AND USER INDEX
* SET PFC DISK POINTERS.
SA1 CATS+FTPM GET FIRST TRACK OF CATALOG FILE
SA2 CADA GET CATALOG TRACK AND SECTOR
MX6 12
MX7 -24
LX6 -12
SX3 A0-CSBF
AX3 4 INDEX OF CATALOG ENTRY IN SECTOR
ERRNZ NWCE-20B
BX1 X6*X1 FIRST TRACK
BX2 -X7*X2 CURRENT TRACK AND SECTOR
BX7 X1+X3 MERGE FIRST TRACK AND INDEX
LX2 12
BX7 X7+X2 MERGE CURRENT TRACK/SECTOR
SA7 A7+B1 SET PFC DISK POINTERS
* WRITE REQUEST FILE ENTRY.
WRITEW TC,TCRQ,TCRQL
EQ RFCX RETURN
RFS SPACE 4,20
** RFS - REQUEST FILE STAGING.
*
* ENTRY (A0) = FWA OF CATALOG ENTRY REQUIRING STAGING.
*
* EXIT (RSTS) = CATALOG TRACK AND SECTOR TO BEGIN RESCAN.
* (RSIN) = CATALOG TRACK INDEX TO BEGIN RESCAN.
* FILE STAGING REQUEST ISSUED TO *PFM*.
* ENTRY POSTED IN LIST OF OUTSTANDING FILE STAGING
* REQUESTS (*REQS*).
*
* USES X - 1, 2, 5, 6, 7.
* A - 1, 2, 6, 7.
* B - 2.
*
* CALLS CFE, SPR.
*
* MACROS STAGEPF, WRITEO.
* ISSUE STAGE REQUEST ERROR MESSAGE.
RFS1 SA1 A0+FCFN SET FILE NAME AND USER INDEX
SB2 ERUS * UNABLE TO STAGE FILE ...*
RJ SFE SEND ERROR MESSAGE
RJ CFE COUNT FILE SKIPPED
RFS SUBR ENTRY/EXIT
* INITIATE FILE STAGE.
SB2 SRBK SET REQUEST BLOCK ADDRESS
SX7 B0+
RJ SPR SET *PFM* STAGE REQUEST PARAMETERS
STAGEPF SRFT REQUEST FILE STAGE
SA1 X2 CHECK FOR ERROR
MX6 -8
LX1 -10
BX1 -X6*X1
NZ X1,RFS1 IF ERROR ON STAGE REQUEST
* WRITE FILE INFORMATION TO RESCAN REQUEST FILE.
SA1 CTIN SET INDEX OF ENTRY ON CATALOG TRACK
BX6 X1
WRITEO REQS WRITE CATALOG TRACK INDEX
SA1 A0+FCFN SET FILE NAME AND USER INDEX
BX6 X1
WRITEO REQS
SA1 RSTS
NZ X1,RFSX IF NOT FIRST STAGE REQUEST
SA1 CADA
SA2 CTIN
MX6 -24
MX7 58
BX6 -X6*X1 CATALOG TRACK AND SECTOR
BX7 X7*X2 INDEX OF FIRST ENTRY IN SECTOR
SA6 RSTS SET CATALOG TRACK AND SECTOR FOR RESCAN
SA7 RSIN SET CATALOG TRACK INDEX FOR RESCAN
EQ RFSX 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,CATC,TAPE,O,SU,PFVER,PFMREQ,ACFT)
COMPFET (ACFT,REQS,RESS,RDF,TC)
EQ RIPX RETURN
RLF SPACE 4,15
** RLF - RELEASE LOCK FILES.
*
* ENTRY (LMSK) = LOCK FILE MASK.
* *LFAT* = FWA OF LOCK FILE FET ARGUMENT TABLE.
* *LOCK* = FWA OF LOCK FILE FET.
* (MSSF) = NONZERO, IF *MSS* ENVIRONMENT.
* (ASFF) = NONZERO, IF *MSE* ENVIRONMENT.
*
* EXIT LOCKED FILES RETURNED.
* (LMSK) = 0.
*
* USES X - 0, 1, 2, 3, 6, 7.
* A - 1, 2, 6, 7.
* B - 5, 6.
*
* MACROS CALLPFU, RETURN.
RLF SUBR ENTRY/EXIT
SA1 LMSK
ZR X1,RLFX IF NO FILES LOCKED
SB6 B0 INITIALIZE LOCK INDEX
SA6 RLFA
* RELEASE LOCK FILES.
RLF1 SA1 LMSK
SX2 1
LX2 B6,X2
BX3 X2*X1
ZR X3,RLF2 IF THIS FILE NOT LOCKED
SA1 LFAT+B6 SET FILE NAME
SA2 LOCK
MX0 42
BX6 X0*X1
BX3 -X0*X2
BX6 X3+X6
SA6 A2
RETURN LOCK,R RELEASE LOCK FILE
SA1 RLFA RESTORE LOCK INDEX
SB6 X1+
RLF2 SB6 B6+1 INCREMENT INDEX
SB5 LFATL
GE B6,B5,RLF3 IF ALL LOCK FILES RELEASED
SX6 B6 SAVE LOCK INDEX
SA6 RLFA
EQ RLF1 RELEASE NEXT LOCK FILE
* ISSUE RELEASE NOTICE.
RLF3 SA1 LMSK INDICATE FILES RELEASED
BX6 X1
LX1 0-8 GET *MSE* LOCK MASK
BX6 X6+X1
MX7 -8
BX6 -X7*X6
BX7 X7-X7
SA6 CMSK
SA7 A1+
SA2 MSSF
ZR X2,RLF4 IF NOT *MSS* ENVIRONMENT
CALLPFU LKC1,CTRU RELEASE *MSS* INTERLOCK
RLF4 SA2 ASFF
ZR X2,RLFX IF NOT *MSE* ENVIRONMENT
CALLPFU LKC2,CTRU RELEASE *MSE* INTERLOCK
EQ RLFX RETURN
RLFA BSSZ 1 LOCK INDEX HOLD AREA
RMF SPACE 4,10
** RMF - RETURN MASTER DEVICE FILES.
*
* EXIT CATALOG, PERMITS, AND DATA FILES RETURNED.
*
* MACROS RETURN.
RMF SUBR ENTRY/EXIT
RETURN CATS RETURN CATALOG FILE
RETURN PETS RETURN PERMITS FILE
RETURN DATA RETURN DATA FILE
EQ RMFX RETURN
RPF SPACE 4,20
** RPF - READ PERMIT FILE.
*
* ENTRY CATALOG ENTRY IN *CATH*.
*
* EXIT PERMIT DATA COPIED TO THE ARCHIVE FILE.
* PERMITS LOST FLAG SET IN *FLST* IF ERROR DETECTED IN
* PERMITS.
* (IFST) = 2 IF PERMITS DUMPED.
*
* USES X - 0, 1, 2, 3, 5, 6, 7.
* A - 1, 2, 3, 6, 7.
* B - 2, 3.
*
* CALLS SFE, WDT.
*
* MACROS READ, READW, RECALL, SKIPEI.
* PROCESS ERROR IN PERMIT DATA.
RPF5 SA1 CATH+FCUI
SB2 ERPR * PERMIT READ ERROR ...*
RJ SFE SEND ERROR MESSAGE
SA2 PETS CLEAR FET ERROR STATUS
SX1 36000B
MX6 0 CLEAR DETAILED ERROR CODE
BX7 -X1*X2
SA6 A2+6
SA7 A2
RPF6 SA1 FLST SET PERMITS LOST IN FILE STATUS
SX6 4
BX6 X1+X6
SA6 A1
SA1 RCWD SET READ ERROR CONTROL WORD
SX2 PRCW
SB2 PHBUF SET FWA OF PERMIT DATA
SB3 B0 CLEAR PERMIT DATA WORD COUNT
BX6 X1+X2
EQ RPF8 WRITE *ERROR* CONTROL WORD
* PROCESS END OF PERMIT DATA.
RPF7 SX1 PRCW SET END OF PERMIT CONTROL WORD
SX2 B3 ADD WORD COUNT
BX6 X1+X2
RPF8 SA6 CONTH
RJ WDT WRITE LAST BLOCK OF PERMITS
SX6 2 SET PERMITS DUMPED INCOMPLETE FILE STATUS
SA6 IFST
RPF SUBR
* CHECK FOR PERMITS PRESENT.
SA1 CATH+FCRI
MX0 -24
LX1 24
BX6 -X0*X1 PERMITS FILE RANDOM INDEX
SX7 B0
ZR X6,RPFX IF NO PERMITS
SA6 RPFA SAVE RANDOM INDEX
SA7 RPFC CLEAR LENGTH RETRIEVAL FLAG
* READ PRU OF PERMITS.
RPF1 RECALL PETS REWIND PERMIT FILE
MX0 -18
SA2 PETS+1
BX6 -X0*X2
SA6 A2+B1
SA6 A6+B1
SA1 RPFA GET RANDOM INDEX
SA2 RPFB CHECK FOR PETS FILE LIMIT EXCEEDED
IX2 X1-X2
PL X2,RPF3 IF RANDOM INDEX NOT ON FILE
BX6 X1
SA6 PETS+6
READ PETS,R FILL ONE SECTOR CIRCULAR BUFFER
READW PETS,PHBUF,100B READ PERMIT SECTOR
SB2 PHBUF SET FWA OF PERMITS BUFFER
SB3 B6-B2 SET WORD COUNT IN BUFFER
SX6 B3-NWPH-NWPE CHECK WORD COUNT
NG X6,RPF2 IF INCORRECT WORD COUNT
SX3 NWPE-1
ERRNZ NWPH-NWPE CODE DEPENDS ON VALUE
BX6 X3*X6
NZ X6,RPF2 IF INCORRECT WORD COUNT
SA3 X2 GET FET ERROR STATUS
SX6 36000B
BX2 X6*X3
SA3 B2 GET USER INDEX FROM PERMIT SECTOR
NZ X2,RPF5 IF ERROR ON PERMIT READ
SA2 CATH+FCUI GET USER INDEX FROM CATALOG
LX3 -12
BX6 X2-X3 VALIDATE PERMIT USER INDEX
MX2 -18
BX6 -X2*X6
NZ X6,RPF2 IF NOT CORRECT USER INDEX
NZ X1,RPF7 IF END OF PERMIT DATA
LX3 -24 SET LINKAGE RANDOM INDEX
MX6 -24
BX7 -X6*X3
ZR X7,RPF7 IF END OF PERMIT DATA
SX6 PMCW+100B SET FULL BLOCK PERMIT CONTROL WORD
SA7 RPFA
SA6 CONTH
RJ WDT WRITE ARCHIVE FILE
EQ RPF1 GET NEXT SECTOR
* PROCESS PERMIT FORMAT ERROR.
RPF2 SA1 CATH+FCUI
SB2 ERPF * PERMIT FORMAT ERROR ...*
RJ SFE SEND ERROR MESSAGE
EQ RPF6 PROCESS END OF PERMIT DATA
* PERMIT RANDOM INDEX OUT OF RANGE.
RPF3 SA1 RPFC CHECK LENGTH RETRIEVAL FLAG
NZ X1,RPF4 IF LENGTH RETRIEVAL FLAG SET
SX6 B1 SET LENGTH RETRIEVAL FLAG
SA6 A1
SKIPEI PETS,R SET LAST SECTOR
SA1 PETS+6
AX1 30
BX6 X1
SA6 RPFB
EQ RPF1 TRY AGAIN
RPF4 SA1 CATH+FCUI
SB2 ERPI * PERMIT RANDOM INDEX ERROR ...*
RJ SFE SEND ERROR MESSAGE
EQ RPF6 PROCESS END OF PERMIT DATA
RPFA BSSZ 1 RANDOM INDEX HOLD
RPFB BSSZ 1 PETS FILE LENGTH
RPFC BSSZ 1 LENGTH RETRIEVAL FLAG
RPR SPACE 4,15
** RPR - READ PRU.
*
* ENTRY (B5) = 0 IF ONLY TO READ CONTROL WORD.
* (B5) = INDEX TO START READING DATA IN *DBUFH*.
*
* EXIT CONTROL WORD TRANSFERRED TO *DBUFH*.
* DATA TRANSFERRED IF NOT CONTROL WORD ONLY READ.
* (B5) = INDEX TO READ NEXT PRU IF DATA READ.
*
* USES X - 1, 3, 4, 6.
* A - 1, 6.
* B - 2, 3, 4, 5, 6, 7.
*
* CALLS MMC, RCP.
RPR SUBR ENTRY/EXIT
SA1 DATA+FTLM READ LIMIT
SB7 X1+
* CHECK FOR EMPTY BUFFER.
RJ RCP RECALL *PFU* ON EMPTY BUFFER
SA1 B4+ READ DATA WORD
SB4 B4+B1
BX6 X1
SA6 DBUFH STORE CONTROL WORD
NE B4,B7,RPR1 IF OUT+1 .NE. LIMIT
SB4 X2 SET OUT+1 TO FIRST
RPR1 MX4 -12 EXTRACT WORD COUNT FROM CONTROL WORD
BX3 -X4*X1
LX4 12
SX6 B4
SA6 DATA+FTOT
ZR B5,RPRX IF ONLY READ OF CONTROL WORD
ZR X3,RPRX IF NO DATA TO READ
BX1 -X4*X1
SB3 B4+X3
ZR X1,RPRX IF EOF/EOI
* TRANSFER DATA FROM CIRCULAR BUFFER TO WORKING BUFFER.
RPR2 RJ RCP RECALL *PFU* IF EMPTY BUFFER
SX6 DBUFH+B5 ADDRESS TO TRANSFER TO
LT B3,B7,RPR4 IF NO BUFFER WRAP
* PROCESS FIRST HALF OF BUFFER WRAP.
SX3 B4 ADDRESS TO TRANSFER FROM
SX1 B6-B4
GT B6,B4,RPR3 IF REMAINDER OF BUFFER NOT FULL
SB6 X2 SET NEW OUT
SB3 B3-B7 RESET END OF TRANSFER
SX1 B7-B4 SET WORD COUNT TO END OF BUFFER
SB3 X2+B3
RPR3 SB2 B5+X1 RESET WORKING BUFFER INDEX
SB4 B6
RJ MMC MOVE DATA TO WORKING BUFFER
SX6 B4 RESET OUT
SB5 B2
SA6 DATA+FTOT
EQ RPR2 RECHECK BUFFER
* PROCESS SECOND HALF OF BUFFER WRAP OR NON-WRAP.
RPR4 SX3 B4 ADDRESS TO TRANSFER FROM
SX1 B3-B4 WORDS TO TRANSFER
LT B6,B4,RPR5 IF ALL OF DATA IN BUFFER
GT B6,B3,RPR5 IF ALL OF DATA IN BUFFER
SX1 B6-B4 SET LENGTH TO DATA IN BUFFER
RPR5 SB2 B5+X1 RESET WORKING BUFFER INDEX
SB4 B4+X1 RESET OUT
RJ MMC MOVE DATA TO WORKING BUFFER
SB5 B2 RESTORE B5
SX6 B4 RESET OUT
SA6 DATA+FTOT
NE B3,B4,RPR2 IF NOT ALL DATA TRANSFERRED
EQ RPRX RETURN
SDI SPACE 4,15
** SDI - SET DEVICE INHIBIT DATES.
*
* ENTRY DIFT = ADDRESS OF FET TO SET DEVICE INHIBIT DATES.
* (/COMSPFS/STDT) = START DATE/TIME.
* MSTT = FWA OF MST TABLE.
*
* EXIT DISK SPACE RELEASE INHIBIT DATES SET ON ALL DEVICES
* MARKED AS DUMP COMPLETED IN THE MST TABLE.
*
* USES X - 0, 1, 2, 3, 4, 5, 6.
* A - 1, 3, 4, 6.
* B - 2.
*
* MACROS SETDI.
SDI SUBR ENTRY/EXIT
SA1 CPAR+/COMSPFS/CPSD
SA2 CPAR+/COMSPFS/CPIP
ZR X1,SDIX IF INHIBIT DATE SETTING NOT REQUESTED
NZ X2,SDIX IF PROCESSING INHIBITED
SB2 MSTT INITIALIZE MST TABLE POINTER
SDI1 SA1 B2+B1
SA2 MASK
MX0 -8
BX2 X1*X2
BX2 -X0*X2
ZR X1,SDIX IF MST TABLE EXHAUSTED
ZR X2,SDI2 IF DEVICE NOT DUMPED
SA3 B2 GET DEVICE NUMBER
MX0 -6
BX5 -X0*X3
LX3 5-11 GET EST ORDINAL
MX0 -9
BX3 -X0*X3
SETDI DIFT,X3,MDIT,/COMSPFS/STDT SET MASTER DEVICE DATE
SA4 CPAR+/COMSPFS/CPTD
ZR X4,SDI2 IF NOT TRUE DEVICE DUMP
IX4 X4-X5
NZ X4,SDI2 IF NOT SPECIFIED TRUE DEVICE
SETDI X2,X3,RDIT SET RESIDENT DEVICE INHIBIT DATE
SDI2 SB2 B2+2 INCREMENT MST TABLE POINTER
EQ SDI1 PROCESS NEXT ENTRY
SDL SPACE 4,10
** SDL - SORT DATA LIST.
*
* ENTRY (X1) = NUMBER OF ENTRIES IN LIST.
* *DLRB* = FWA OF LIST.
*
* EXIT LIST SORTED IN *DLRB*.
*
* USES X - 0, 1, 2, 3, 4, 6.
* A - 1, 2, 6.
* B - 3, 4, 5, 6, 7.
SDL SUBR
MX0 -24
SB6 X1 SET ITEM LIMIT
SB4 B0
SB5 B1
LE B6,B5,SDLX IF ONE OR LESS ELEMENTS - RETURN
SDL1 SA1 DLRB+B4 GET ELEMENTS TO SORT
SA2 DLRB+B5
UX3 B7,X1
UX4 B3,X2
BX4 -X0*X4
BX3 -X0*X3
IX3 X4-X3
PL X3,SDL2 IF NO CANGE IN POSITION
PX6 B7,X1 CHANGE POSITIONS - RESORT
SA6 A2
PX6 B3,X2
SA6 A1
SDL2 SB5 B5+B1
GT B6,B5,SDL1 IF MORE ELEMENTS TO COMPARE TO BASE
SB4 B4+B1
SB5 B4+B1
SB7 B6-B1
NE B7,B4,SDL1 IF MORE ELEMENTS TO COMPARE
EQ SDLX RETURN
SDP SPACE 4,10
** SDP - SET DATA READ LIST PARAMETERS.
*
* ENTRY (X1) = DATA LIST ENTRY.
*
* EXIT (A0) = ADDRESS OF CATALOG ENTRY.
* (CADA) = CATALOG ENTRY DISK ADDRESS.
*
* USES X - 1, 6.
* A - 0, 6.
* B - 2.
SDP SUBR ENTRY/EXIT
UX1,B2 X1
SA1 DLDB+B2 GET CATALOG DISK ADDRESS
SX6 B2
LX6 4
ERRNZ NWCE-20B
SA0 DLCB+X6 SET CATALOG ENTRY ADDRESS
BX6 X1
SA6 CADA SET CATALOG ADDRESS
EQ SDPX RETURN
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 MOVE.
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
SA5 IDSA+/COMSPFS/ADER ALERT THE OPERATOR
MOVE 4,MSGI,X5
EQ SRSX RETURN
STL SPACE 4,15
** STL - SORT TAPE COPY LIST.
*
* ENTRY REQUEST FILE *TC* AT BOI.
*
* EXIT SORTED REQUESTS ON FILE *S3*.
*
* USES X - 0, 1, 5, 6.
* A - 0, 5.
* B - 4, 5.
*
* CALLS MSF, ISF, WSB.
*
* MACROS READ, READW, WRITER.
STL SUBR ENTRY/EXIT
READ TC
RJ ISF INITIALIZE SORT FILES
STL1 READW TC,SRTB,SBTCL
SB7 B7-SBTCL
ZR B7,STL2 IF END OF ENTRIES
MX0 60 SET SORT KEY MASK
SX1 B1 SET SORT KEY LENGTH
SB4 1 SET KEY OFFSET
SB5 TCRQL SET ENTRY LENGTH
RJ WSB WRITE SORTED ENTRIES TO FILE
EQ STL1 READ NEXT BUFFER OF ENTRIES
STL2 WRITER S1 FLUSH BUFFER
WRITER S2 FLUSH BUFFER
SX0 TCRQL SET ENTRY LENGTH
SX1 SBTCC SET FULL BLOCK ENTRY COUNT
MX2 60 SET KEY MASK
SB4 B0 SET KEY OFFSET
SB5 1 SET KEY LENGTH
SA0 SW1B SET WORKING BUFFER 1 ADDRESS
SA5 SW2B SET WORKING BUFFER 2 ADDRESS
RJ MSF MERGE SORT FILES
EQ STLX RETURN
TER SPACE 4,15
** TER - TERMINATE ARCHIVE FILE AND RETURN SYSTEM FILES.
*
* EXIT END OF DUMP RECORD AND EOF WRITTEN TO ARCHIVE AND
* VERIFY FILES.
* SYSTEM FILES RETURNED.
* PERMANENT FILE PARAMETERS RESTORED TO ENTRY VALUES.
*
* USES X - 7.
* A - 7.
*
* CALLS FAF.
*
* MACROS ARCHIVE, RETURN, SETPFP.
TER SUBR ENTRY/EXIT
SA1 CPAR+/COMSPFS/CPIP
NZ X1,TER1 IF PROCESSING INHIBITED
SX7 EODC WRITE END OF DUMP CONTROL WORD
SA7 CONTH
ARCHIVE WRITEW,CONTH,B1
ARCHIVE WRITER
ARCHIVE WRITEF WRITE EOF ON ARCHIVE FILE
RJ FAF FLUSH ARCHIVE FILE BUFFERS
RETURN REQS
RETURN RESS
RETURN TC
TER1 SETPFP GPAR RESTORE PERMANENT FILE PARAMETERS
EQ TERX RETURN
UCE SPACE 4,20
** UCE - UPDATE CATALOG ENTRY.
*
* ENTRY (B2) = *PFU* FUNCTION CODE.
* (CADA) = CATALOG ENTRY DISK ADDRESS IN *PFM* FORMAT.
* (FLOK) = *AFLOK*/*TFLOK* SELECTION FLAG.
* CATALOG ENTRY IN *CATH*.
* CATALOG TRACK INTERLOCKED.
*
* EXIT *PFU* CALLED TO UPDATE PFC ENTRY.
* DEVICE ERROR IDLE SET, IF WRITE ERROR ON CATALOG
* FILE AND DATA ON THE FILE HAS BEEN CORRUPTED.
* CATALOG TRACK INTERLOCKED.
*
* USES X - 0, 1, 2, 3, 6, 7.
* A - 1, 3, 6, 7.
*
* CALLS SEI, SFE.
*
* MACROS CALLPFU.
UCE SUBR ENTRY/EXIT
SA1 CATH+FCFN+FCUI* SET FILE NAME AND USER INDEX
BX6 X1
SA6 UULV
SA1 CATH+FCCD GET CREATION DATE/TIME
SA3 FLOK GET FILE LOCK FLAG
MX0 -36
BX6 -X0*X1
BX6 X3+X6
SA6 UULV+1
SA1 CADA GET *PFM* FORMAT CATALOG ADDRESS
SA2 MAEQ
MX6 30
BX7 X6*X1 CATALOG INDEX
MX6 -24
LX7 6
BX6 -X6*X1 TRACK AND SECTOR
LX2 24
BX6 X6+X7 MERGE TRACK/SECTOR AND CATALOG INDEX
BX6 X6+X2 MERGE EST ORDINAL
SA6 UULV+2
CALLPFU UUCW,B2,R CALL *PFU* TO UPDATE PFC
SA1 UUCW
MX0 -12
LX1 -12
BX1 -X0*X1 ERROR CODE
ZR X1,UCEX IF NO ERROR
SA1 CATH+FCUI
SB2 ERCU * CATALOG UPDATE ERROR ...*
RJ SFE SEND ERROR MESSAGE
SA1 UUCW
MX0 -12
LX1 -12
BX1 -X0*X1
SX1 X1-3
NZ X1,UCEX IF NOT WRITE ERROR WITH DATA TRANSFERRED
SB2 ELWC * ERROR IDLE SET - PF CATALOG WRITE ...*
RJ SEI SET ERROR IDLE
EQ UCEX RETURN
WDB SPACE 4,25
** WDB - WRITE DATA BLOCK.
*
* ENTRY (CATH - CATH+NWCE) = CATALOG IMAGE OF FILE BEING
* DUMPED.
* (CPAR+/COMSPFS/CPDN) = MASTER DEVICE NUMBER.
* (FLOK) = *AFLOK*/*TFLOK* SELECTION FLAG.
* (MAEQ) = MASTER DEVICE NUMBER.
* *DATA* FILE POSITIONED AT DATA FOR FILE BEING DUMPED.
*
* EXIT DATA FOR FILE BEING DUMPED COPIED TO THE ARCHIVE FILE.
* *DATA* FILE POSITIONED AT BEGINNING OF NEXT FILE.
* ERROR MESSAGE ISSUED FOR FILE IF IT WAS TOO LONG, TOO
* SHORT OR HAD A MASS STORAGE ERROR.
*
* USES X - 0, 1, 2, 3, 4, 6, 7.
* A - 1, 2, 3, 6, 7.
* B - 2, 3, 5, 6.
*
* CALLS FAF, RPR, SEI, SFE, WDT.
*
* MACROS ARCHIVE.
WDB SUBR
WDB1 BX6 X6-X6
SA6 WDBC
SB5 B1
* READ FILE CONTROL WORD AND DATA.
WDB2 RJ RPR READ PHYSICAL RECORD
* DETERMINE CONTROL WORD TYPE.
WDB3 SA2 WDBE INCREMENT PRU NUMBER
SX3 B1+
SA1 DBUFH GET SECTOR CONTROL WORD
IX6 X2+X3
MX0 -12
BX2 -X0*X1 WORD COUNT
LX1 0-12
SA6 A2
BX3 -X0*X1 NEXT SECTOR LINK
LX1 59-49-0+12
BX7 X2+X3
NG X1,WDB10 IF MASS STORAGE ERROR
SX1 3777B
ZR X7,WDB6 IF EOI SECTOR
BX1 X3-X1
SX7 X2-NWPR
ZR X3,WDB15 IF EOF SECTOR
ZR X1,WDB17 IF SYSTEM SECTOR
NG X7,WDB16 IF EOR SECTOR
* PROCESS FULL SECTOR.
SA1 WREM GET WORDS REMAINING
SB2 X1
SB6 B5
SA1 WDBC GET TOTAL WORD COUNT
IX6 X2+X1
SA6 A1
GT B2,B6,WDB2 GET MORE DATA
SX6 DCWC
SX4 B2-B1
BX6 X6+X4
SA6 CONTH
SB2 DBUFH+1
SB3 X4
SX6 B5
SA6 WDBB
SB6 B5-B3
SX6 B6-B1
SA6 WDBA STORE WORDS LEFT IN WS BUFFER
RJ WDT WRITE ARCHIVE FILE
SA1 WDBA
SB6 X1
SA1 WDBB
SB5 X1
SB2 B1
NG B6,WDB5 IF NO WORDS TO TRANSFER
ZR B6,WDB5 IF NO WORDS TO TRANSFER
SB6 B5-B6
WDB4 SA1 DBUFH+B6
BX6 X1
SA6 DBUFH+B2
SB2 B2+B1
SB6 B6+B1
GT B5,B6,WDB4 IF NOT END OF TRANSFER
WDB5 SX6 B2-B1 SET NEW WORD COUNT
SA6 WDBC
SB5 B2
EQ WDB2 GET MORE DATA
* PROCESS EOI.
WDB6 SX6 DCWC SET EOI
SA1 WDBC
ZR X1,WDB7 IF NO WORDS
IX6 X6+X1
SA6 CONTH
SB2 DBUFH+1
SB3 X1
RJ WDT
WDB7 SA1 CATH+FCLF GET PFC LENGTH (DATA SECTORS)
SA2 WDBE GET ACTUAL LENGTH
MX3 -24
LX1 -36
BX6 -X3*X1
SX1 B1+B1
IX2 X2-X1 SUBTRACT EOI AND SYSTEM SECTOR
IX2 X2-X6 CHECK FOR FILE TOO SHORT
NG X2,WDB8 IF FILE TOO SHORT
SA2 DBUFH CHECK FOR FILE TOO LONG
LX2 59-48
PL X2,WDB9 IF FILE NOT TOO LONG
WDB8 SA1 CATH+FCUI
SB2 ERFL * FILE LENGTH ERROR ...*
RJ SFE SEND ERROR MESSAGE
SA1 LGCW SET LENGTH ERROR CONTROL WORD
BX6 X1
SB3 B0 CLEAR DATA WORD COUNT
SA6 CONTH
SB2 CONTH SET BUFFER ADDRESS
RJ WDT WRITE LENGTH ERROR CONTROL WORD
SA1 FLST SET DATA ERROR IN FILE STATUS
SX6 2
BX6 X1+X6
SA6 A1
SA1 CATH+FCBS
LX1 59-11
NG X1,WDB9 IF DIRECT ACCESS FILE
SB2 ELLI * ERROR IDLE SET - INDIRECT PF LENGTH ...*
RJ SEI SET ERROR IDLE STATUS
* COMPLETE PROCESSING OF FILE.
WDB9 ARCHIVE WRITER WRITE EOR ON ARCHIVE FILES
SX6 B0+ CLEAR FILE LENGTH COUNTER
SX7 BFAC RESET BLOCK STATUS FOR NEXT FILE
SA6 WDBE
SA7 WREM
SA3 FLOK
ZR X3,WDBX IF NOT DESTAGE TO OPTICAL DISK
RJ FAF FLUSH ARCHIVE FILE BUFFERS
EQ WDBX RETURN
* PROCESS READ ERROR.
WDB10 SX6 DCWC
ZR X7,WDB11 IF EOI SECTOR
SX6 DFCW
ZR X3,WDB11 IF EOF SECTOR
SX6 X2+DCWC
SX7 X2-NWPR
ZR X7,WDB11 IF FULL DATA SECTOR
SX6 X2+DSCW
SX1 3777B
BX1 X3-X1
ZR X1,WDB11 IF SYSTEM SECTOR
SX6 X2+DRCW SET EOR CONTROL WORD
WDB11 SA1 WDBC GET GOOD BLOCK WORD COUNT
SA6 WDBD SAVE BAD BLOCK CONTROL WORD
SX7 X1+DCWC BUILD GOOD CONTROL WORD
SB2 DBUFH+1 SET BUFFER ADDRESS
SA7 CONTH
SB3 X1+ SET BUFFER WORD COUNT
ZR X1,WDB12 IF GOOD BLOCK EMPTY
RJ WDT WRITE GOOD BLOCK
WDB12 SA1 RCWD SET BAD BLOCK CONTROL WORD
SA2 WDBD
SA3 WDBC GET GOOD BLOCK WORD COUNT
BX6 X1+X2
MX7 -9
SB2 X3+DBUFH+1 SET BAD BLOCK BUFFER ADDRESS
SA6 CONTH
BX2 -X7*X2 SET BAD BLOCK WORD COUNT
SB3 X2
RJ WDT WRITE BAD BLOCK
SA1 CATH+FCUI
SB2 ERDR * DATA READ ERROR ...*
RJ SFE SEND ERROR MESSAGE
SA1 FLST SET DATA ERROR IN FILE STATUS
SX6 B1+B1
BX6 X1+X6
SA6 A1
SA1 DBUFH GET READ STATUS
MX2 -24
BX6 -X2*X1
LX1 59-48
ZR X6,WDB9 IF EOI SECTOR
NG X1,WDB9 IF FATAL ERROR
EQ WDB1 CHECK NEXT SECTOR
* PROCESS EOF.
WDB15 SX6 DFCW SET EOF CONTROL WORD
SA1 WDBC
IX6 X6+X1
SA6 CONTH
SB3 X1
SB2 DBUFH+1
RJ WDT
EQ WDB1 PROCESS DATA SECTOR
* PROCESS EOR.
WDB16 SX6 DRCW SET EOR CONTROL WORD
SA1 WDBC
IX2 X2+X1
BX6 X6+X2
SA6 CONTH
SB2 DBUFH+1
SB3 X2
RJ WDT
EQ WDB1 PROCESS DATA SECTOR
* PROCESS SYSTEM SECTOR.
WDB17 SX6 DSCW SET SYSTEM SECTOR CONTROL WORD
BX6 X6+X2
SA6 CONTH
SB2 DBUFH+1
SB3 X2
RJ WDT WRITE SYSTEM SECTOR TO ARCHIVE FILE
EQ WDB1 PROCESS FIRST DATA SECTOR
SPACE 4,10
* DATA STORAGE FOR DATA BLOCK WRITE
WDBA BSS 1 WORDS REMAINING HOLD
WDBB BSS 1 TOTAL WORDS READ HOLD
WDBC BSS 1 INTERIM WORDS IN WS HOLD
WDBD BSS 1 BAD DATA CONTROL WORD
WDBE CON 0 PRU COUNTER
WDT SPACE 4,15
** WDT - WRITE DUMP TAPE.
*
* ENTRY (B2) = FWA OF DATA.
* (B3) = NUMBER OF WORDS TO WRITE.
* (CONTH) = CONTROL WORD.
*
* EXIT CONTROL WORD AND DATA WRITTEN.
* WORDS REMAINING IN BLOCK UPDATED.
*
* USES X - 0, 1, 2, 6, 7.
* A - 1, 2, 6, 7.
* B - 2, 3, 5.
*
* CALLS WRT.
WDT SUBR
* CHECK NUMBER OF WORDS TO BE WRITTEN.
WDT1 SA1 WREM
SX2 B3+B1
IX6 X1-X2
NG X6,WDT2 IF WORDS+1 MORE THAN WORDS REMAINING
SA6 A1 RESET WORDS REMAINING
SX6 B2 SET BUFFER ADDRESS
SA6 WDTD
SX6 B3+ SET WORD COUNT
SA6 WDTC
RJ WRT WRITE
EQ WDTX RETURN
* PROCESS BLOCK LARGER THAN 1000B WORDS.
WDT2 IX6 X2-X1 WORDS LEFT FOR NXT BLOCK
SA6 WDTA SAVE WORDS LEFT FOR NEXT BLOCK
SA2 CONTH
BX6 X2
SA6 WDTB SAVE OLD CONTROL WORD
* CLEAR THE EOR/EOF SUB-TYPE CODES (1 AND 2) BUT RETAIN
* THE SYSTEM SECTOR SUB-TYPE CODE (4). SET THE WORD COUNT
* FOR THE FIRST PART OF THE SPLIT.
MX0 49
BX6 X0*X2
SX7 X1-1
BX6 X6+X7
SA6 CONTH
SA7 WDTC SAVE WORDS WRITTEN
SB3 X7
SX6 B2
SA6 WDTD SAVE BUFFER ADDRESS
BX6 X6-X6
SA6 WREM
RJ WRT WRITE
* SET UP TO WRITE BEGINNING OF NEXT BLOCK.
SA1 WDTB GET OLD CONTROL WORD
MX0 51
BX6 X0*X1
SA1 WDTA WORDS FOR NEXT BLOCK
BX6 X6+X1
SA6 CONTH SET UP NEXT CONTROL WORD
SB3 X1
SA1 WDTC
SB5 X1
SA1 WDTD GET BUFFER ADDRESS
SB2 X1
SB2 B2+B5
EQ WDT1 PROCESS NEXT BLOCK
WDTA BSS 1 WORDS IN NEXT BLOCK
WDTB BSS 1 OLD CONTROL WORD
WDTC BSS 1 WORDS WRITTEN
WDTD BSS 1 BUFFER ADDRESS
WRT SPACE 4,20
** WRT - WRITE CONTROL WORD AND DATA.
*
* ENTRY (WDTD) = BUFFER ADDRESS.
* (WDTC) = WORD COUNT FOR NON-EOR WRITE.
* (CONTH) = CONTROL WORD.
*
* EXIT EOR OR CONTROL WORD AND DATA WRITTEN TO ARCHIVE FILE.
*
* USES X - 1, 2, 6.
* A - 1, 2, 6.
* B - 6, 7.
*
* MACROS ARCHIVE.
WRT SUBR
* WRITE CONTROL WORD.
ARCHIVE WRITEW,CONTH,B1 WRITE CONTROL WORD
* WRITE DATA.
SA1 WDTD GET BUFFER ADDRESS
SA2 WDTC
SB6 X1 RESET ADDRESS
SB7 X2 RESET WORD COUNT
ARCHIVE WRITEW,B6,B7 WRITE DATA
SA1 WREM
NZ X1,WRTX IF NOT FULL BLOCK
SX6 BFAC
SA6 A1
EQ WRTX RETURN
TITLE COMMON DECKS.
** COMMON DECKS.
*CALL COMCCCE
*CALL COMCCDD
ERP1$ SET 0 SELECT *COMCCIO* ERROR PROCESSING OPTION
*CALL COMCCIO
*CALL COMCCOD
*CALL COMCCPM
*CALL COMCDXB
*CALL COMCEDT
FCE$ SET 0 SELECT *COMCFCE* UTILITY FORMAT OPTION
*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
LIST X
COM$ EQU 1 ASSEMBLE COMMON ROUTINES
PFD$ EQU 1 ASSEMBLE *PFDUMP*/*PFDM* COMMON ROUTINES
DVA$ EQU 1 ASSEMBLE DEVICE ACCESS ROUTINES
PFR$ EQU 1 ASSEMBLE ARCHIVE FILE READ ROUTINES
PF8$ EQU 1 ASSEMBLE CATALOG CONVERSION ROUTINES
*CALL COMCPFS
LIST *
*CALL COMCPFU
*CALL COMCRDO
*CALL COMCRDW
*CALL COMCSCB
*CALL COMCSFM
*CALL COMCSFN
*CALL COMCSNM
*CALL COMCSYS
*CALL COMCVLC
*CALL COMCWTC
*CALL COMCWTH
*CALL COMCWTO
*CALL COMCWTW
*CALL COMCZTB
TITLE MESSAGES.
** MESSAGES.
MSDU DATA C*DUMPING ??????? !!!!!!*
MSGI DATA 40H THE RIGHT SCREEN LISTS YOUR OPTIONS.
MSGL DATA 40C
MSGS DATA 30CWAITING FOR STAGED FILES
MSGT DATA 40H RESCAN CATALOG TRACK FOR STAGED FILES.
MSGW DATA 40H
MSGAA DATA 40C WAIT FOR ALTERNATE STORAGE INTERLOCK.
SPACE 4,10
* ERROR MESSAGES.
ERCU DATA C* CATALOG UPDATE ERROR, FN=???????, UI=!!!!!!.*
ERDR DATA C* DATA READ ERROR, FN=???????, UI=!!!!!!.*
ERFB DATA C* FILE BUSY, FN=???????, UI=!!!!!!.*
ERFL DATA C* FILE LENGTH ERROR, FN=???????, UI=!!!!!!.*
ERNP DATA C* NO DISK OR ALTERNATE STORAGE POINTERS FOR FILE, FN=?
,??????, UI=!!!!!!.*
ERNT DATA C* FILE NOT FOUND ON ALTERNATE STORAGE TAPE, FN=???????
,, UI=!!!!!!.*
ERPF DATA C* PERMIT FORMAT ERROR, FN=???????, UI=!!!!!!.*
ERPI DATA C* PERMIT RANDOM INDEX ERROR, FN=???????, UI=!!!!!!.*
ERPR DATA C* PERMIT READ ERROR, FN=???????, UI=!!!!!!.*
ERRT DATA C* STAGED FILE RESCAN TERMINATED, FN=???????, UI=!!!!!!
,.*
ERSS DATA C* BAD SYSTEM SECTOR, FN=???????, UI=!!!!!!.*
ERTR DATA C* ALTERNATE STORAGE TAPE READ ERROR, FN=???????, UI=!!
,!!!!.*
ERUS DATA C* UNABLE TO STAGE FILE, FN=???????, UI=!!!!!!.*
ERZL DATA C* ZERO LENGTH FILE, FN=???????, UI=!!!!!!.*
SPACE 4,10
** NORMAL PROCESSING FILE COUNT MESSAGES.
DUMS DATA C* ?????? FILE! DUMPED.*
SEMS DATA C* ?????? FILE! SKIPPED WITH ERRORS.*
DEMS DATA C* ?????? FILE! DUMPED WITH PERMIT/DATA ERRORS.*
POMS DATA C/ ?????? *PFC ONLY* FILE! DUMPED./
STMS DATA C* ?????? DUMPED FILE! STAGED.*
PGMS DATA C* ?????? DUMPED FILE! PURGED.*
NPMS DATA C* ?????? DUMPED FILE! NOT PURGED.*
DSMS DATA C* ?????? DUMPED FILE! DESTAGED.*
NDMS DATA C* ?????? DUMPED FILE! NOT DESTAGED.*
SPACE 4,10
** INHIBITED PROCESSING FILE COUNT MESSAGES.
SDMS DATA C* ?????? FILE! SELECTED FOR DUMP.*
SPMS DATA C/ ?????? FILE! SELECTED FOR *PFC ONLY* DUMP./
RESC SPACE 4,10
* RIGHT SCREEN BUFFER FOR *RESCAN* OPTIONS.
RESC VFD 12/0,36/0,12/0 DISPLAY CONTROL WORD
KDL 28,T,(RESCAN OPTIONS)
KDL 13,H,(ENTER K.RO.)
KDL 13,,(RO)
KDL 26,H,(DESCRIPTION)
KDL 13,K,(GO CONTINUE RESCANNING.)
KDL 13,K,(SKIP SCAN NEXT CATALOG TRACK.)
CON 0 END OF BUFFER
SPACE 4,10
USE LITERALS
TITLE RESERVED LOCATIONS.
** RESERVED LOCATIONS
ASTI CON 0 ALTERNATE STORAGE TAPE IDENTIFIER
CONTH BSSZ 1 CONTROL WORD HOLD
CWBF BSSZ 1 ARCHIVE FILE CONTROL WORD BUFFER
FLOK BSSZ 1 FILE LOCK *AFLOK*/*TFLOK* FLAG
FLSF BSSZ 1 FILE LENGTH NEEDED FOR *LS*/*US* SELECTION
IFST BSSZ 1 INCOMPLETE FILE DUMP STATUS
INCD BSSZ 1 INCREMENTAL DUMP FLAG
NDLE BSSZ 1 NUMBER OF DATA LIST ENTRIES
VSNP BSSZ 1 DESTAGE DUMP VSN POINTER
WREM CON BFAC UNUSED WORDS REMAING IN ARCHIVE FILE BLOCK
* CATALOG HOLD AREA AND RELATED CONTROLS.
CATH BSSZ NWCE CATALOG ENTRY HOLD AREA
* DUMP FILE LABEL BUILD AREA.
DMPLBL VFD 36/0LPFDUMP,24/0 HEADER
VFD 48/0LREEL,12/1
VFD 24/0LMASK,1/1,35/0
BSSZ /COMSPFS/AFLBL-3
* DUMP FILE -- FILE ERROR CONTROL WORDS.
LGCW VFD 42/7HERROR**,3/1,3/3,3/2,9/0
RCWD VFD 42/7HERROR**,3/1,15/0 READ ERROR CONTROL WORD
* *MSS*/*MSE* EXECUTIVE INTERLOCK AND *RDF* WORK AREAS.
CMSK BSSZ 1 SUBFAMILY CONTROL MASK
LMSK BSSZ 1 SUBFAMILY LOCK MASK
LFAT VFD 42/7H"MSFCAT"0,18/LKBUF LOCK FILE FET ARGUMENTS
VFD 42/7H"MSFCAT"1,18/LKBUF+1*NWCE
VFD 42/7H"MSFCAT"2,18/LKBUF+2*NWCE
VFD 42/7H"MSFCAT"3,18/LKBUF+3*NWCE
VFD 42/7H"MSFCAT"4,18/LKBUF+4*NWCE
VFD 42/7H"MSFCAT"5,18/LKBUF+5*NWCE
VFD 42/7H"MSFCAT"6,18/LKBUF+6*NWCE
VFD 42/7H"MSFCAT"7,18/LKBUF+7*NWCE
VFD 42/7H"SFMCAT"0,18/LKBUF+8*NWCE
VFD 42/7H"SFMCAT"1,18/LKBUF+9*NWCE
VFD 42/7H"SFMCAT"2,18/LKBUF+10*NWCE
VFD 42/7H"SFMCAT"3,18/LKBUF+11*NWCE
VFD 42/7H"SFMCAT"4,18/LKBUF+12*NWCE
VFD 42/7H"SFMCAT"5,18/LKBUF+13*NWCE
VFD 42/7H"SFMCAT"6,18/LKBUF+14*NWCE
VFD 42/7H"SFMCAT"7,18/LKBUF+15*NWCE
LFATL EQU *-LFAT LENGTH OF LFAT TABLE.
RDFE BSSZ 1 *RDF* EXTRACT RECORD WRITTEN FLAG
EMSG BSS 3 HOLD FOR SUPPRESSED *PFM* ERROR MESSAGES
SPACE 2,12
** LKC1 - *MSS* STORAGE EXECUTIVE INTERLOCK CONTROL WORD.
** LKC2 - *MSE* STORAGE EXECUTIVE INTERLOCK CONTROL WORD.
*T LKCN 18/ FAM,18/ DM,12/ CODE,6/ AT,5/,1/C
*
* FAM = FAMILY/PACK NAME ADDRESS.
* DM = ACCUMULATED DEVICE MASK ADDRESS.
* CODE = *TDAM* RESPONSE CODE.
* 0 = NORMAL - REQUEST ACCEPTED.
* 4 = EXECUTIVE NOT ACTIVE.
* AT = ALTERNATE STORAGE TYPE CODE.
* *ATMS* = *MSS* SUBSYSTEM.
* *ATAS* = *MSE* SUBSYSTEM.
* C = COMPLETION BIT.
LKC1 VFD 18/FMPN,18/CMSK,12/0,6/ATMS,5/0,1/1
LKC2 VFD 18/FMPN,18/CMSK,12/0,6/ATAS,5/0,1/1
* CATALOG TRACK RESCAN, TAPE ALTERNATE STORAGE COPY DATA AREA.
CTIN BSSZ 1 INDEX OF ENTRY ON CATALOG TRACK
RESE BSSZ TCRQL *RESS* FILE ENTRY WORKING BUFFER
RSIN BSSZ 1 CATALOG TRACK INDEX TO BEGIN RESCAN
RSTS BSSZ 1 CATALOG TRACK AND SECTOR TO BEGIN RESCAN
SCAN BSSZ 1 SCAN MODE (0 = NORMAL SCAN, 1 = RESCAN)
TCRQ BSSZ TCRQL TAPE COPY REQUEST WORKING BUFFER
SPACE 2,13
** UUCW - UTILITY UPDATE CATALOG ENTRY CONTROL WORD.
*
*T UUCW 18/,18/ FWLV,12/ CODE,11/,1/C
*
* FWLV = FWA OF CATALOG ENTRY LOCATION AND VERIFICATION
* INFORMATION.
* CODE = RESPONSE CODE.
* 0 = UPDATE COMPLETED.
* 1 = MASS STORAGE READ ERROR OCCURRED.
* 2 = VERIFICATION ERROR OCCURRED.
* 3 = MASS STORAGE WRITE ERROR OCCURRED AND DATA WAS
* TRANSFERRED TO THE DEVICE.
* 4 = MASS STORAGE WRITE ERROR OCCURRED AND NO DATA
* WAS TRANSFERRED TO THE DEVICE.
* C = COMPLETION BIT.
UUCW VFD 18/0,18/UULV,12/0,11/0,1/1
SPACE 2,13
** UULV - UPDATE CATALOG ENTRY LOCATION/VERIFY INFORMATION.
*
*T UULV 42/ FILE NAME,18/ USERID
*T UULV+1 24/ 0,36/ CDT
*T UULV+2 22/ 0,2/ CO,12/ EQ,12/ TK,12/ SC
*
* CDT = CREATION DATE/TIME.
* CO = CATALOG ENTRY ORDINAL.
* EQ = EST ORDINAL.
* TK = TRACK NUMBER.
* SC = SECTOR NUMBER.
UULV BSSZ 3
TITLE FETS.
** FETS.
T BSS 0 ARCHIVE FILE
TAPE FILEB TBUF,TBUFL,FET=13
ODEB BSSZ ODEBL OPTICAL DISK EXTENSION BUFFER
V BSS 0 VERIFY FILE
PFVER FILEB VBUF,VBUFL,FET=13
R BSS 0 RELEASE DATA FILE
RDF FILEB RBUF,RBUFL,FET=13
CATC BSS 0 *CIR* CATALOGS
ZZZZZG0 FILEB CATB,CATBL,EPR,FET=10
CATS BSS 0 CATALOG TRACKS
ZZZZZG1 FILEB CATB,CATBL,EPR,FET=10
PETS BSS 0 PERMIT ENTRIES
ZZZZZG2 RFILEB PBUF,PBUFL,EPR,FET=10
DATA BSS 0 FILE DATA
ZZZZZG3 FILEB DBUF,DBUFL,FET=10
AST BSS 0 ALTERNATE STORAGE ARCHIVE FILE
ZZZZZG8 FILEB DBUF,DBUFL,EPR,FET=14
DIFT FILEB IBUF,1,(FET=10) FET TO SET DEVICE INHIBIT DATES
DDFT FILEB REQB,REQBL,EPR,FET=16 *DROPDS* *PFM* FET
ORG DDFT+CFPW
VFD 42/0,18/DDEM ERROR MESSAGE RETURN ADDRESS
ORG DDFT+CFSR
VFD 42/0,18/DDBK SPECIAL REQUEST BLOCK ADDRESS
ORG DDFT+16
DDBK BSSZ 4 *PFM* SPECIAL REQUEST BLOCK
DDEM BSSZ 6 *PFM* ERROR MESSAGE BUFFER
SRFT FILEB REQB,REQBL,EPR,UPR,FET=16 STAGE REQUEST *PFM* FET
ORG SRFT+CFPW
VFD 42/0,18/SREM ERROR MESSAGE RETURN ADDRESS
ORG SRFT+CFSR
VFD 42/0,18/SRBK SPECIAL REQUEST BLOCK ADDRESS
ORG SRFT+16
SRBK BSSZ 4 *PFM* SPECIAL REQUEST BLOCK
SREM BSSZ 6 *PFM* ERROR MESSAGE BUFFER
LOCK FILEB LKBUF,LKBUFL,EPR,FET=16 FET TO LOCK FILES
LOCKL EQU *
ORG LOCK+CFPW
VFD 42/0,18/EMSG
ORG LOCKL
PFMREQ BSS 0 POST-PROCESSING *PFM* REQUESTS
ZZZZZG4 FILEB PFRB,PFRBL,FET=10
REQS BSS 0 FILE STAGE REQUESTS
ZZZZZG5 FILEB REQB,REQBL,FET=10
RESS BSS 0 SCREEN RESCAN SELECTION
ZZZZZG6 FILEB RESB,RESBL,FET=10
TC BSS 0 TAPE COPY FILE LIST
ZZZZZG7 FILEB TCLB,TCLBL,FET=10
STAT FILEB 0,0,FET=7 FILE STATUS
TITLE BUFFERS.
** BUFFERS.
PBUF EQU *
PHBUF EQU PBUF+PBUFL
DBUF EQU PHBUF+PHBUFL DATA BUFFER
DBUFH EQU DBUF+DBUFL DATA WORKING STORAGE BUFFER
CATB EQU DBUFH+DBUFHL CATALOG BUFFER
LKBUF EQU CATB+CATBL LOCK FILE BUFFER
IBUF EQU LKBUF+LKBUFL INHIBIT DATE SETTING BUFFER
RBUF EQU IBUF+1 RELEASE DATA FILE BUFFER
RDFH EQU RBUF+RBUFL RELEASE DATA FILE WORKING STORAGE
DLRB SPACE 4,15
** DLRB - DATA LIST REQUEST BUFFER.
*
* ONE ENTRY IN FOLLOWING FORMAT FOR EACH FILE TO BE DUMPED.
*
*T DLRB 12/ 2000B+IN,24/ LF,12/ TK,12/ SC
*
* IN = INDEX INTO CATALOG BUFFER AND DISK ADDRESS BUFFER.
* LF = LENGTH OF FILE (INDIRECT ACCESS ONLY).
* TK = FIRST TRACK OF FILE.
* SC = FIRST SECTOR FOR INDIRECT ACCESS FILES.
* = 1/1,5/0,6/RD FOR DIRECT ACCESS FILES.
* RD = RESIDENCY DEVICE NUMBER.
DLRB EQU RDFH+RDFHL DATA LIST REQUEST BUFFER
DLCB EQU DLRB+DLRBL DATA LIST CATALOG BUFFER
DLDB EQU DLCB+DLCBL DATA LIST CATALOG DISK ADDRESS BUFFER
SPACE 4,10
OUTB EQU DLDB+DLDBL OUTPUT 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
PFRB EQU MS4B+MSFBL *PFMREQ* FILE BUFFER
REQB EQU PFRB+PFRBL *REQS* FILE BUFFER
RESB EQU REQB+REQBL *RESS* FILE BUFFER
TCLB EQU RESB+RESBL *TC* FILE BUFFER
* THE ARCHIVE AND VERIFY FILE BUFFERS MUST BE LAST. FIELD
* LENGTH FOR THE VERIFY BUFFER WILL NOT BE ALLOCATED UNLESS
* THE *VF* PARAMETER IS SPECIFIED.
TBUF EQU TCLB+TCLBL ARCHIVE (TAPE) FILE BUFFER
EBUF EQU TBUF+TBUFL+4 END OF BUFFERS (WITHOUT VERIFY BUFFER)
VBUF EQU TBUF+TBUFL VERIFY FILE BUFFER
EBUFV EQU VBUF+VBUFL+4 END OF BUFFERS (WITH VERIFY BUFFER)
TITLE PRESET MAIN LOOP.
PRS SPACE 4,35
** PRS - PRESET PROGRAM.
*
* ENTRY (CPAR) = CRACKED PARAMETER ARRAY.
* FILES *ZZZZZG0* THROUGH *ZZZZZG9* AND *ZZZZZGA*
* THROUGH *ZZZZZGB* RETUNED BY *PFS*.
* FILE *ZZZZZGB* RETURNED BY *PFS* IF NO FILE
* SELECTIONS.
* FILE *ZZZZZGB* CONTAINS FILE SELECTIONS IF PRESENT.
*
* EXIT (B1) = 1.
* (FMPN) = FAMILY NAME OR PACK NAME.
* (INCD) = 1, IF INCREMENTAL DUMP.
* (CPAR=/COMSPFS/CPCO) = 37777777777777777777B IF OP=Z
* OR DESTAGE DUMP (FORCED DATA DUMP).
* EXECUTION FIELD LENGTH SET.
* ARCHIVE AND ARCHIVE VERIFY FILES OPENED.
* DEVICE VALIDATION AND SELECTION PERFORMED.
* ARCHIVE FILE LABEL WRITTEN.
* MESSAGES PRESET.
* CATALOG IMAGE RECORD WRITTEN IF REQUIRED.
* ACCES LEVEL RANGE VALIDATED IF SECURE SYSTEM.
* OUTPUT FILE AND SUMMARY FILE INITIALIZED.
*
* USES X - 0, 1, 2, 3, 5, 6, 7.
* A - 0, 1, 2, 3, 5, 6, 7.
* B - 1.
*
* CALLS BMT, CAL, CCI, CDR, DSS, GRH, IFL, IOF, LBL, ODV, OSP,
* PFO, PRK, PSI, RPS, SBS, SFN, SFP, SLP, SMP, SOE, SSP.
*
* MACROS MEMORY, MOVE, REPRIEVE.
PRS SUBR
SB1 1
MEMORY CM,,R,EBUF REQUEST REQUIRED MEMORY
REPRIEVE RPVB,SET,277B SET EXTENDED REPRIEVE PROCESSING
SA1 CMUR
NG X1,PRS1 IF *CMU* PRESENT
MOVE MMCL,PRSB,MMC SET UP REGISTER TRANSFER CODE
PRS1 RJ DSS DETERMINE SECURITY STATUS
RJ BMT BUILD MASS STORAGE TABLE
RJ CAL CHECK ACCESS LEVELS
SB2 ERAR * ACCESS LEVEL LIMITS OUT OF RANGE.*
NG X2,ABT IF ACCESS LEVELS NOT WITHIN SYSTEM LIMITS
SX3 PRSC PRESET *K* DISPLAY COORDINATES
RJ PRK
SA1 CPAR+/COMSPFS/CPIP
ZR X1,PRS1.1 IF PROCESSING NOT INHIBITED
SX6 B0+ CLEAR MSS/MSE PROCESSING
SA6 MSSF
SA6 ASFF
EQ PRS3 INITIALIZE DUMP ENVIRONMENT
* OPEN ARCHIVE FILE.
PRS1.1 SA1 CPAR+/COMSPFS/CPTB GET FILE NAME
SA5 TAPE
MX0 42
BX6 X0*X1
BX5 -X0*X5
BX6 X6+X5
SA6 A5 SET FILE NAME IN FET
SX2 A5 SET FET ADDRESS
SA3 PRSK SET OPTICAL DISK EXTENSION BUFFER ADDRESS
RJ SOE SET FET EXTENSION IF OPTICAL DISK FILE
NZ X1,PRS1.2 IF NOT ASSIGNED TO OPTICAL DISK
SA3 TAPE+1 SET RANDOM FLAG IN SET
SX1 B1
LX1 47
BX6 X1+X3
SA6 A3
PRS1.2 SA1 CPAR+/COMSPFS/CPTB GET FILE NAME
SA5 TAPE SET FET ADDRESS
RJ PFO PROCESS ARCHIVE FILE OPENING
SX6 -1
SA6 TAPE+CWSW INITIALIZE CONTROL WORD WRITE STATUS
SA5 TAPE SET FET ADDRESS AND FILE NAME
RJ CDR CHECK DESTAGE REQUIREMENTS
* OPEN VERIFY FILE.
SA1 CPAR+/COMSPFS/CPVF
ZR X1,PRS2 IF NO VERIFY FILE SPECIFIED
SX6 VBUFL SET BUFFER INCREASE VALUE
SA6 BUFI
MEMORY CM,,R,EBUFV INCREASE FL FOR VERIFY FILE BUFFER
SA1 CPAR+/COMSPFS/CPVF
SA5 PFVER SET FET ADDRESS
RJ PFO PROCESS VERIFY FILE OPENING
SX6 -1
SA6 PFVER+CWSW INITIALIZE CONTROL WORD WRITE STATUS
SA5 PFVER SET FET ADDRESS AND FILE NAME
RJ CDR CHECK DESTAGE REQUIREMENTS
* OPEN RELEASE DATA FILE.
PRS2 SA1 CPAR+/COMSPFS/CPRD GET FILE NAME
ZR X1,PRS3 IF NO RELEASE DATA FILE
SA5 RDF SET FET ADDRESS
RJ PFO PROCESS RELEASE DATA FILE OPENING
* INITIALIZE DUMP ENVIRONMENT.
PRS3 SA1 BUFI
SX0 X1+EBUF SET SELECTION BUFFER ADDRESS
RJ RPS READ PERMANENT FILE SELECTIONS
RJ SMK SET FILE SELECTION MASK
RJ SFP SET PERMANENT FILE PARAMETERS
SA1 CPAR+/COMSPFS/CPIP
NZ X1,PRS4 IF PROCESSING INHIBITED
RJ SLP SET LABEL PARAMETERS
RJ LBL GENERATE LABEL
RJ GRH GENERATE RDF HEADER RECORD
PRS4 SA1 CPAR+/COMSPFS/CPOP
SA2 CPAR+/COMSPFS/CPDT
MX7 1
BX6 -X7 UNLIMITED FILE SIZE VALUE
LX1 59-46
BX7 X7*X1
BX7 X7+X2
ZR X7,PRS4.1 IF NOT *OP=Z* OR DESTAGE DUMP
SA6 CPAR+/COMSPFS/CPCO FORCE DUMP OF FILE DATA
PRS4.1 SA1 CPAR+/COMSPFS/CPLS
SA2 CPAR+/COMSPFS/CPUS
NZ X1,PRS4.2 IF LOWER SIZE LIMIT .NE. 0
BX2 X6-X2
ZR X2,PRS4.3 IF UNLIMITED UPPER SIZE LIMIT
PRS4.2 SA6 FLSF FILE LENGTH NEEDED FOR *LS*/*US* SELECTION
* INITIALIZE OUTPUT FILE AND SUMMARY FILE.
PRS4.3 RJ IOF INITIALIZE OUTPUT FILES
RJ OSP OUTPUT SELECTION PARAMETERS
SX6 DSTBUF SET DEVICE STATUS BUFFER ADDRESS
RJ ODV OUTPUT DEVICE STATUS
* GENERATE CIR IF REQUESTED.
PRS5 SA1 CPAR+/COMSPFS/CPOP CHECK IF CIR DESIRED
LX1 2
PL X1,PRS6 IF NO *MODIFICATION DATE* OPTION
SA1 CPAR+/COMSPFS/CPBD
NZ X1,PRS6 IF *BD=YYMMDD* PARAMETER SPECIFIED
SX6 B1 SET INCREMENTAL DUMP FLAG
SA6 INCD
SA1 CPAR+/COMSPFS/CPIP
NZ X1,PRS6 IF PROCESSING INHIBITED
RJ CCI CREATE CATALOG IMAGE
RJ PSI PROCESS SORTED CIR OUTPUT
* SET UP OUTPUT PARAMETERS FOR FILE PROCESSING.
PRS6 RJ IFL INITIALIZE FILE PROCESSING
* INITIALIZE *PFM* POST PROCESSING REQUEST FILE IF PURGE FILES
* AFTER DUMP OR DESTAGE DUMP.
SA1 CPAR+/COMSPFS/CPOP CHECK *PURGE AFTER* OPTION
SA2 CPAR+/COMSPFS/CPDT
SA3 PRSD SELECT *PURGE* PROCESSING
LX1 6
NG X1,PRS7 IF PURGE OPTION SPECIFIED
ZR X2,PRSX IF NOT DESTAGE DUMP
SA3 PRSE SELECT *SETASA* PROCESSOR
PRS7 BX6 X3
SA6 PFRI
SX6 B0+ CLEAR INCREMENTAL DUMP FLAG
SA6 INCD
EQ PRSX RETURN
PRSB BSS 0 CODE TO OVERLAY *MMC*
MOVE HERE
PRSC BSS 0 Y-COORDINATE TABLE
KDL *
PRSD VFD 12/2000B+PRPP,30/0,18/=10HPURGING
PRSE VFD 12/2000B+SAPP,30/0,18/=10HDESTAGING
PRSH DATA 40HFILES DUMPED TO ARCHIVE FILE.
PRSK VFD 36/,6/ODEBL,18/ODEB POINTER TO *OD* EXT. BUFFER
SPACE 4,6
* PRESET FETS.
ODF BSS 0 OPTICAL DISK MOUNT FILE
ZZZZZOD FILEB ODFBUF,ODFBL,FET=10
TITLE PRESET SUBROUTINES.
CDR SPACE 4,15
** CDR - CHECK DESTAGE REQUIREMENTS.
*
* ENTRY (A5) = FET ADDRESS.
* (X5) = FILE NAME.
*
* EXIT (VSNP) = UPDATED ALTERNATE STORAGE VSN POINTER.
* TO *ABT* IF ERROR IN EQUIPMENT TYPE OR VSN FORMAT.
*
* USES X - ALL.
* A - 1, 2, 3, 4, 6, 7.
* B - 2, 7.
*
* CALLS DXB.
*
* MACROS FILINFO, REWIND.
CDR SUBR ENTRY/EXIT
SA2 CPAR+/COMSPFS/CPDT
ZR X2,CDRX IF NOT DESTAGE DUMP
REWIND A5 INSURE FILE AT BOI
MX7 42
SX6 100001B
BX7 X7*X5 ISOLATE FILE NAME
BX6 X6+X7 SET FILE NAME AND BLOCK LENGTH
SA6 CDRA
FILINFO A6 GET FILE STATUS
SA2 CDRA+1 READ DEVICE TYPE
BX0 X2
AX0 48
SX0 X0-2ROD
ZR X0,CDR3 IF OPTICAL DISK DEVICE TYPE *OD*
MX0 -2
LX2 0-25
BX6 -X0*X2
SB2 ERTD * NT/CT/AT TAPE OR OD REQD FOR DESTAGE.*
ZR X6,ABT IF NOT *NT*, *CT*, OR *AT* TAPE
LX2 0-18-0+25 ISOLATE *NT* BIT
BX0 -X0*X2
BX6 X6-X0 CLEAR TAPE DEVICE TYPE IF *NT* TAPE
LX6 55-0 SAVE TAPE DEVICE TYPE
SA6 CDRB
SA3 CDRA+5 READ TAPE FORMAT
MX4 -6
LX3 -6
BX3 -X4*X3
SB2 ERFD * TAPE FORMAT OR LABEL NOT VALID ... *
ZR X3,CDR0 IF *I* FORMAT TAPE
SX3 X3-/COMSMTX/TFLI
NZ X3,ABT IF NOT *LI* FORMAT TAPE
MX3 1 SAVE *LI* FORMAT FLAG
LX3 54-59
BX6 X6+X3
SA6 A6
CDR0 SA4 A3+B1 READ LABEL TYPE
LX4 -12
BX4 -X6*X4
SX4 X4-1
NZ X4,ABT IF NOT STANDARD LABEL TYPE
SA4 A4+B1 READ VSN
MX7 -36
LX4 -24
BX4 -X7*X4
BX1 -X6*X4
ZR X1,CDR2 IF NOT A SIX CHARACTER VSN
SX2 X1-1RB
SX1 X1-1RD
ZR X2,CDR2 IF *B* RADIX
ZR X1,CDR2 IF *D* RADIX
MX0 -24
BX5 -X0*X4 NUMERIC PART OF VSN
SB7 B1 SET DECIMAL CONVERSION
LX5 36
RJ DXB CONVERT NUMERIC PART OF VSN
NZ X4,CDR2 IF NOT ALL NUMERIC CHARACTERS
SA4 CDRA+7 READ VSN
SA2 VSNP
SX1 X6-4095-1
MX7 12 EXTRACT VSN PREFIX
BX4 X7*X4
LX4 -36
NZ X2,CDR1 IF VSN POINTER ALREADY SET
PL X1,CDR2 IF NUMERIC PART OF VSN .GT. 4095
BX6 X4+X6 BUILD PACKED VSN
SX7 B1 SET INITIAL FILE SEQUENCE NUMBER
LX7 24
BX6 X6+X7
SA1 CDRB MERGE TAPE DEVICE TYPE AND FORMAT FLAGS
BX6 X1+X6
SA6 VSNP SET VSN POINTER (PACKED VSN)
EQ CDRX RETURN
* CHECK CORRESPONDING SECONDARY (VERIFY FILE) VSN.
CDR1 MX3 -24 ISOLATE EXISTING PACKED VSN
BX3 -X3*X2
SX1 5000
IX6 X6-X1
NG X6,CDR2 IF VSN SUFFIX .GT. 4095 AND .LT. 5000
BX6 X6+X4 BUILD NEW PACKED VSN FOR COMPARISON
BX6 X6-X3
NZ X6,CDR2 IF SECONDARY VSN DOES NOT CORRESPOND
SA1 CDRB CHECK TAPE DEVICE TYPE AND FORMAT FLAGS
MX3 3
LX3 56-59
BX6 X3*X2
BX6 X6-X1
NZ X6,CDR2 IF DEVICE TYPE & FORMAT DO NOT CORRESPOND
SX7 B1+ SET SECONDARY VSN FLAG IN VSN POINTER
LX7 49-0
BX7 X2+X7
SA7 VSNP
EQ CDRX RETURN
CDR2 SB2 ERVD * VSN NOT VALID FOR DESTAGE.*
EQ ABT ABORT
* CHECK OPTICAL DISK LABEL INFORMATION.
*
* EXPECTS VSN = *AAXXXX*
* PARTITION NAME = *DEFAULT*
* RECORDED FILE NAME = *PFARCHIVE*
* FILE OWNER NAME = *SYSTEMX*
* FILE GROUP NAME = FAMILY
* VERSION = 1 - 4095
CDR3 REWIND ODF,R
READ ODF
CDR4 READW ODF,CDRC,1 SEARCH OPTICAL DISK MOUNT FILE
SA1 A5 COMPARE FILE NAMES
SA2 CDRA
MX0 42
BX6 X1-X2
BX6 X0*X6
ZR X6,CDR5 IF FILE NAMES MATCH
SKIPW ODF,1600B-1 SKIP ENTRY (16 SECTORS)
EQ CDR4 PROCESS NEXT ENTRY
CDR5 SKIPW ODF,10-1
READW ODF,CDRD,1 READ VERSION NUMBER
SKIPW ODF,40B-11
READW ODF,CDRC,16 READ VSN/PARTITION/OWNER INFORMATION
NZ X1,CDR8 IF EOR/EOF ON FILE
SA4 CDRC VERIFY VSN
MX7 -36
LX4 -24
BX3 X7*X4
MX6 -6
NZ X3,CDR2 IF MORE THAN SIX CHARACTERS
BX1 -X6*X4
ZR X1,CDR2 IF LESS THAN SIX CHARACTERS
SX2 X1-1RB
SX1 X1-1RD
ZR X2,CDR2 IF *B* RADIX
ZR X1,CDR2 IF *D* RADIX
MX0 -24
BX5 -X0*X4 NUMERIC PART OF VSN
SB7 B1 SET DECIMAL CONVERSION
LX5 36
RJ DXB CONVERT NUMERIC PART OF VSN
NZ X4,CDR2 IF NOT ALL NUMERIC CHARACTERS
SA4 CDRC GET VSN
SX1 X6-4095-1
MX7 12 EXTRACT VSN PREFIX
BX4 X7*X4
LX4 -36
PL X1,CDR2 IF NUMERIC PART OF VSN .GT. 4095
SX7 ATOD SET OPTICAL DISK STORAGE
BX6 X4+X6 BUILD PACKED VSN
LX7 24+6+6
BX6 X6+X7
SA6 VSNP SET VSN POINTER (PACKED VSN)
SA4 CDRC+2 VERIFY PARTITION NAME
SA1 CDRE
BX6 X1-X4
NZ X6,CDR7 IF NOT *DEFAULT* PARTITION
SA4 CDRC+4 VERIFY RECORDED FILE NAME
SA1 CDRF
BX6 X1-X4
NZ X6,CDR6 IF RECORDED FILE NAME NOT *PFARCHIVE*
SA4 CDRC+8 VERIFY FILE OWNER NAME
SA1 CDRG
BX6 X1-X4
NZ X6,CDR6 IF NOT *SYSTEMX*
SA4 CDRC+12 VERIFY GROUP OWNER NAME
SA1 CDRH
BX6 X1-X4
NZ X6,CDR6 IF GROUP OWNER NAME NOT *NOSARCHIVE*
SA4 A4+B1
NZ X4,CDR6 IF GROUP OWNER INVALID
SA4 CDRD VERIFY VERSION NUMBER
SX7 X4-4096
PL X7,CDR9 IF VERSION NUMBER TOO LARGE
SA1 VSNP SET VERSION NUMBER IN POINTER
LX4 24
BX6 X1+X4
SA6 A1
MX6 1 SET *AFLOK* FLAG
SA6 FLOK
RECALL ODF WAIT NOT BUSY
EQ CDRX RETURN
CDR6 SB2 ERLD * OPTICAL DISK LABEL NOT VALID ...*
EQ ABT ABORT
CDR7 SB2 ERPD * PARTITION NOT VALID FOR DESTAGE.*
EQ ABT ABORT
CDR8 SB2 EROF * INTERNAL ERROR ON FILE ZZZZZOD.*
EQ ABT ABORT
CDR9 SB2 ERND * VERSION NUMBER EXCEEDED FOR DESTAGE.*
EQ ABT ABORT
CDRA BSSZ 5 *FILNFO* CALL BLOCK
VFD 54/0,6/1 TAPE FORMAT KEY
VFD 54/0,6/2 LABEL TYPE KEY
VFD 54/0,6/4 VSN KEY
CDRB CON 0 TAPE DEVICE TYPE AND FORMAT FLAGS
CDRC BSSZ 16 OPTICAL DISK LABEL INFORMATION
CDRD BSSZ 1 VERSION NUMBER
CDRE VFD 60/0LDEFAULT
CDRF VFD 60/0LPFARCHIVE
CDRG VFD 60/0LSYSTEMX
CDRH VFD 60/0LNOSARCHIVE
GRH SPACE 4,15
** GRH - GENERATE *RDF* HEADER RECORD.
*
* ENTRY ARCHIVE FILE LABEL RECORD GENERATED.
* RELEASE DATA FILE (RDF) OPEN.
*
* EXIT HEADER RECORD WRITTEN TO RELEASE DATA FILE,
* IF *RDF* REQUESTED.
*
* USES X - 1, 2, 6.
* A - 6.
*
* MACROS WRITER, WRITEW.
GRH SUBR ENTRY/EXIT
SA1 CPAR+/COMSPFS/CPRD
ZR X1,GRHX IF RDF NOT REQUESTED
SA1 /COMSPFS/STDT SET UP CONTROL WORD
SX2 HCWD
LX1 47-35
BX6 X1+X2
SA6 CONTH
WRITEW RDF,CONTH,B1 WRITE CONTROL WORD
WRITEW X2,DMPLBL,/COMSPFS/AFLBL WRITE DUMP LABEL
WRITER X2,R
EQ GRHX RETURN
LBL SPACE 4,15
** LBL - WRITE PFDUMP ARCHIVE FILE LABEL.
*
* ENTRY (DMPLBL - DMPLBL+/COMSPFS/AFLBL) = LABEL PARAMETERS.
* (FLOK) = *AFLOK*/*TFLOK* SELECTION FLAG.
*
* EXIT ARCHIVE FILE SKIP COUNT PROCESSED.
* ARCHIVE FILE LABEL WRITTEN TO ARCHIVE FILE.
*
* USES X - 0, 1, 2, 6, 7.
* A - 1, 6, 7.
*
* CALS FAF.
*
* MACROS ARCHIVE, SKIPFF.
LBL SUBR ENTRY/EXIT
SA3 CPAR+/COMSPFS/CPSF
ZR X3,LBL1 IF NO FILES TO SKIP
SKIPFF TAPE,X3 SKIP FILES ON ARCHIVE FILE
SA1 CPAR+/COMSPFS/CPVF
ZR X1,LBL1 IF NO VERIFY FILE SPECIFIED
SKIPFF PFVER,X3 SKIP FILES ON ARCHIVE VERIFY FILE
LBL1 SX1 LCWC
SX2 /COMSPFS/AFLBL SET UP CONTROL WORD
BX6 X1+X2
SA1 DMPLBL
MX0 36
BX1 X0*X1
BX6 X6+X1
SA6 CONTH
ARCHIVE WRITEW,CONTH,B1 WRITE CONTROL WORD
ARCHIVE WRITEW,DMPLBL,/COMSPFS/AFLBL WRITE DUMP LABEL
ARCHIVE WRITER
SA1 FLOK
ZR X1,LBLX IF NOT DESTAGE TO OPTICAL DISK
RJ FAF FLUSH ARCHIVE FILE BUFFERS
EQ LBLX RETURN
SLP SPACE 4,15
** SLP - SET LABEL PARAMETERS.
*
* ENTRY (CPAR) = CONVERTED PARAMETER ARRAY.
* (MASK) = FILE SELECTION MASK.
*
* EXIT DUMP PARAMETERS SET IN ARCHIVE FILE LABEL.
*
* USES X - 1, 2, 3, 4, 6, 7.
* A - 1, 2, 3, 6, 7.
* B - 2, 3, 4, 5.
*
* CALLS SFN.
*
* MACROS EDATE, ETIME.
SLP SUBR ENTRY/EXIT
* SET FILE MASK, DATE AND TIME, FAMILY OR PACK NAME, AND
* PREVIOUS VSN.
SA1 MASK SET FILE SELECTION MASK IN LABEL
SA2 DMPLBL+/COMSPFS/MAAL
BX6 X1+X2
SA6 A2
SA1 /COMSPFS/STDT GET DUMP START DATE
AX1 18-0
EDATE X1
SA6 DMPLBL+/COMSPFS/DAAL SET DATE IN LABEL
SA1 /COMSPFS/STDT GET DUMP START TIME
MX2 -18
BX1 -X2*X1
ETIME X1
SA6 DMPLBL+/COMSPFS/TIAL SET TIME IN LABEL
SA1 CPAR+/COMSPFS/CPFN
SA2 CPAR+/COMSPFS/CPPN
BX6 X1
BX7 X2
SA6 DMPLBL+/COMSPFS/FMAL SET FAMILY NAME IN LABEL
SA7 DMPLBL+/COMSPFS/PNAL SET PACK NAME IN LABEL
SA1 CPAR+/COMSPFS/CPPV PUT PREVIOUS VSN IN LABEL
RJ SFN
SA6 DMPLBL+/COMSPFS/PVAL
* SET MASTER DEVICE MASKS AND CATALOG TRACK COUNTS.
* IF FILE STAGING IS NOT SUPPRESSED, THE MASTER DEVICE MAP IS
* NOT WRITTEN BECAUSE FILES COPIED FROM ALTERNATE STORAGE TAPES
* ARE NOT DUMPED IN CATALOG TRACK ORDER.
SA1 CPAR+/COMSPFS/CPOP
LX1 59-47
PL X1,SLPX IF STAGING NOT SUPPRESSED
MX2 -9
MX4 -8
SB4 B0 SHIFT COUNT
SB2 MSTT+1 SET ADDRESS OF MASS STORAGE TABLE
SB3 DMPLBL+/COMSPFS/D0AL DEVICE INFORMATION OFFSET
SB5 60
SLP2 SA3 B2 MASS STORAGE TABLE ENTRY
ZR X3,SLPX IF END OF MASS STORAGE TABLE
BX6 -X4*X3 GET DEVICE MASK
SB2 B2+2 ADVANCE MASS STORAGE TABLE ADDRESS
ZR X6,SLP2 IF NOT MASTER DEVICE
SA3 A3-B1 GET NUMBER OF CATALOG TRACKS
LX6 12
LX3 -15
BX3 -X2*X3
BX6 X6+X3
SA1 B3 STORE DEVICE MASK AND CATALOG TRACKS
LX6 X6,B4
BX6 X6+X1
SA6 A1
SB4 B4+20
LT B4,B5,SLP2 IF MORE ROOM IN LABEL WORD
SB3 B3+B1 ADVANCE POINTER
SB4 B0 RESET SHIFT COUNT
EQ SLP2 GET NEXT ENTRY
TITLE CATALOG IMAGE RECORD SUBROUTINES.
BCL SPACE 4,15
** BCL - BUILD CATALOG LIST.
*
* ENTRY (B2) = NEXT WORD ADDRESS OF CATALOG BUFFER.
* (B3) = NEXT WORD ADDRESS OF WORKING STORAGE BUFFER.
* (B4) = LAST WORD ADDRESS OF CATALOG BUFFER.
*
* EXIT (B2) = NEXT WORD ADDRESS OF CATALOG BUFFER.
* (B3) = NEXT WORD ADDRESS OF WORKING STORAGE BUFFER.
* (B4) = LAST WORD ADDRESS OF CATALOG BUFFER.
* (B5) = NUMBER OF CATALOGS.
*
* USES X - 0, 1, 2, 6.
* A - 1, 2, 6.
* B - 2, 3, 5.
BCL SUBR ENTRY/EXIT
SB5 B0 INITIALIZE NUMBER OF CATALOGS
MX3 -18
BCL1 SX6 B3-DBUFH-776B
PL X6,BCLX IF END OF 1000B WORD BLOCK
SA2 B2
BX6 -X3*X2
ZR X6,BCL3 IF PURGED FILE
SA1 CPAR+/COMSPFS/CPOP
LX1 59-45
NG X1,BCL2 IF OP=Y SELECTED
SA1 B2+FCBR GET BACKUP REQUIREMENT
MX0 -3
LX1 0-54
BX6 -X0*X1
SX6 X6-BRNO
ZR X6,BCL3 IF NO BACKUP REQUIRED
* GENERATE CATALOG IMAGE ENTRY.
BCL2 BX6 X2 STORE WORD IN CATALOG LIST
SA6 B3
SB3 B3+B1
SB5 B5+B1
MX0 18 SET SECOND WORD OF CIR ENTRY
SA1 B2+3
SA2 A1+B1
LX1 6
BX6 X0*X1
BX2 -X0*X2
BX6 X6+X2
SA6 B3
SB3 B3+B1
SB5 B5+B1
BCL3 SB2 B2+NWCE INCREMENT CATALOG BUFFER INDEX
LT B2,B4,BCL1 IF NOT AT END OF CATALOG BUFFER
EQ BCLX RETURN
CCI SPACE 4,20
** CCI - CREATE CATALOG IMAGE.
*
* EXIT CIR WRITTEN TO ARCHIVE FILE.
*
* USES X - ALL.
* A - 1, 2, 3, 4, 5, 6, 7.
* B - 2, 3, 4, 5, 6.
*
* CALLS BCL, CAC, ICI, RCS, SAC, WIB.
*
* MACROS ARCHIVE, CALLPFU, MOVE, PCINT, READCW, RETURN,
* WRITER.
CCI16 RETURN CATC
SA5 IDSA+/COMSPFS/ADMS
MOVE 4,MSGL,X5 CLEAR MESSAGE
CCI SUBR ENTRY/EXIT
SA1 CPAR+/COMSPFS/CPPN PF DESCRIPTION = PACK NAME
MX2 42
BX6 X2*X1
NZ X1,CCI1 IF PACK NAME SPECIFIED
SA1 MSTT PF DESCRIPTION = A FAMILY EQUIPMENT
MX2 -9
AX1 6
BX6 -X2*X1
CCI1 SA6 CDWD SAVE PF DESCRIPTION
* INITIALIZE MESSAGES AND OUTPUT FILES FOR CIR PROCESSING.
RJ ICI INITIALIZE FOR CIR OUTPUT
SA5 IDSA+/COMSPFS/ADMS
MOVE 3,CIRM,X5
EQ CCI3 SEARCH FOR DEVICE
* SEARCH FOR MASTER DEVICE TO PROCESS.
CCI2 PCINT CATC,CTCC CLEAR CATALOG TRACK INTERLOCK
CCI3 SX6 B1 INITIALIZE CATALOG TRACK
SA6 CCTR
SA1 CCIB GET MSTT INDEX
SX6 X1+2
SA6 A1
SA1 MSTT+X1 GET MASS STORAGE TABLE ENTRY
SA2 A1+B1
ZR X1,CCI16 IF END OF MASS STORAGE TABLE
* INITIALIZE FOR CATALOG TRACK PROCESSING.
MX6 -8 GET DEVICE MASK
BX3 -X6*X2
ZR X3,CCI3 IF NOT A MASTER DEVICE
SA4 MASK GET FILE SELECTIION MASK
BX4 X4*X3
ZR X4,CCI3 IF THIS DEVICE NOT BEING DUMPED
MX6 -6
BX6 -X6*X1
SA6 CPAR+/COMSPFS/CPDN SET MASTER DEVICE NUMBER
MX7 -9
LX1 -6
BX6 -X7*X1
SA6 MAEQ
LX1 -9
BX6 -X7*X1
LX3 24 PUT DEVICE MASK IN HEADER
SA6 NCAT
SA1 CIRH GET CATALOG IMAGE HEADER
LX6 36 PUT NUMBER OF CATALOG TRACKS IN HEADER
BX3 X1+X3
BX7 X3+X6
SB2 B0 CLEAR USER INDEX
SA7 CICH SAVE HEADER WORD
CCI4 LX2 -1 POSITION MASK BIT
SB2 B2+B1 ADVANCE USER INDEX
PL X2,CCI4 IF MASK BIT NOT SET
SA1 CDPM SET CATALOG DESCRIPTION PARAMETER
SX7 B2-B1 SET CATALOG DESCRIPTION USER INDEX
BX6 X1
SA7 CDUI
SA6 CATC+FTPM
RJ SAC SET PF ACTIVITY COUNT
CALLPFU CATC,CTCT,R GET CORRECT CATALOG TRACK
SA1 CATC+FTPM GET CATALOG TRACK PARAMETERS
SX2 5 SET FILE STATUS
MX0 -24
BX1 -X0*X1 SET EQ AND FIRST TRACK
MX0 -12
BX7 -X0*X1 SET CURRENT TRACK
LX1 36
BX2 X1+X2 BUILD CATALOG TRACK FST ENTRY
LX7 24
BX6 X2+X7
SA6 A1
RETURN CATC,R RETURN ANY EXISTING CATC
CALLPFU CATC,CTOL,R CREATE CATALOG TRACK FILE
PCINT CATC,CTSC SET CATALOG TRACK INTERLOCK
* INITIALIZE CATALOG TRACK WORKING BUFFER.
CCI5 READCW CATC,17B INITIATE CATALOG READ
BX6 X6-X6 CLEAR EMPTY RECORD FLAG
SA6 EMRF
SX6 DBUFH INITIALIZE CONTROL WORD ADDRESS
SA6 CWAD
SB3 X6+B1 INITIALIZE WORKING STORAGE POINTER
SB5 B0
* READ CATALOG FILE.
CCI6 SX6 B3 SAVE *CIR* BUFFER PARAMETERS
SX7 B5
LX6 18
BX7 X6+X7
SA7 CCIA
CCI6.1 SX6 B0+
SA6 CFTS CLEAR END OF CATALOG TRACK STATUS
SX2 CATC READ BUFFER OF CATALOG ENTRIES
RJ RCS
SA2 CSLW
SX6 B1
SX7 X2 SET LWA+1 OF ENTRIES
ZR X1,CCI6.2 IF ENTRIES READ
NG X1,CCI6.1 IF READ ERROR WITH DATA TRANSFERRED
SA6 CFTS SET END OF CATALOG TRACK
SX7 CSBF SET NO DATA READ
CCI6.2 SX6 CSBF SAVE CATALOG BUFFER PARAMETERS
LX6 18
BX7 X6+X7
SA7 CCIC
SA1 CCIA RESTORE *CIR* BUFFER PARAMETERS
SB5 X1
LX1 -18
SA2 CCIC RESTORE CATALOG BUFFER PARAMETERS
SB3 X1
SB4 X2
LX2 -18
SB2 X2
NE B2,B4,CCI7 IF CATALOG ENTRIES TRANSFERRED
SA1 CFTS
ZR X1,CCI6 IF NOT END OF CATALOG TRACK
SA2 EMRF
NZ X2,CCI8 IF NOT EMPTY RECORD
EQ CCI13 CONTINUE TO NEXT CATALOG TRACK
* BUILD *CIR*.
CCI7 SX6 B1 SET EMPTY RECORD FLAG
SA6 EMRF
RJ BCL BUILD CATALOG LIST
CCI8 SA2 NCTL UPDATE NUMBER OF CATALOGS ON THIS TRACK
SX4 B5
SB5 B0 CLEAR CATALOG COUNT
IX6 X2+X4
SA3 NCTB
SA6 A2
IX6 X3+X4
SA6 A3
SA2 CWAD GET CONTROL WORD ADDRESS
GE B2,B4,CCI9 IF CATALOG BUFFER EMPTY
SX3 CICW SET UP CONTROL WORD
SX7 B5 SAVE *CIR* BUFFER PARAMETER
SA7 CCIA
SX6 B2 SAVE CATALOG BUFFER PARAMETERS
SX7 B4+
LX6 18
BX7 X6+X7
SA7 CCIC
RJ WIB WRITE IMAGE BLOCK
SA1 CCIA RESTORE *CIR* BUFFER PARAMETER
SB5 X1+
SA1 CCIC RESTORE CATALOG BUFFER PARAMETERS
SB4 X1
LX1 -18
SB2 X1
EQ CCI7 LOOP TO FINISH CATALOG BLOCK
CCI9 SX6 B3-DBUFH-776B
PL X6,CCI10 IF END OF 1000B WORD BLOCK
SA1 CFTS
ZR X1,CCI6 IF NOT EOR OR EOF
EQ CCI11 WRITE IMAGE BLOCK
CCI10 SX3 CICW SET CONTROL WORD
SA1 CFTS
ZR X1,CCI12 IF NOT EOR OR EOF
CCI11 SX3 CRWC SET EOR CONTROL WORD
CCI12 SX7 B5 SAVE *CIR* BUFFER PARAMETER
SA7 CCIA
SX6 B2 SAVE CATALOG BUFFER PARAMETERS
SX7 B4+
LX6 18
BX7 X6+X7
SA7 CCIC
RJ WIB WRITE IMAGE BLOCK
SA1 CCIA RESTORE *CIR* BUFFER PARAMETER
SB5 X1+
SA1 CCIC RESTORE CATALOG BUFFER PARAMETERS
SB4 X1
LX1 -18
SB2 X1+
SA1 CFTS
ZR X1,CCI6 IF NOT EOR OR EOF
CCI13 SA2 EMRF
ZR X2,CCI14 IF EMPTY CATALOG TRACK
ARCHIVE WRITER
CCI14 SA2 NCAT CONTINUE TO NEXT CATALOG TRACK
SA3 CCTR
SX6 X3+B1
IX2 X3-X2
PL X2,CCI15 IF END OF CATALOG TRACKS
SA6 A3
* ADVANCE TO NEXT CATALOG TRACK.
PCINT CATC,CTAC ADVANCE CATALOG TRACK
EQ CCI5 LOOP FOR NEXT TRACK
* ADVANCE TO NEXT DEVICE.
CCI15 RJ CAC CLEAR PF ACTIVITY COUNT
EQ CCI2 SEARCH FOR NEXT MASTER DEVICE
CCIA BSSZ 1 CATALOG TRACK WORKING BUFFER INDICES
CCIB CON 0 MSTT LOCATOR
CCIC BSS 1 CATALOG BUFFER PARAMETER SAVE AREA
CDPM VFD 24/0,18/CDWD,18/CDUI CATALOG DESCRIPTION PARAMETER
CDUI BSS 1 CATALOG DESCRIPTION USER INDEX
*T CDWD 42/ PN, 6/, 12/ EQ
* PN = PACKNAME FOR AN AUXILIARY DEVICE.
* = 0 FOR A FAMILY DEVICE.
* EQ = EST ORDINAL OF THE DEVICE.
CDWD BSS 1 CATALOG DESCRIPTION WORD
CFTS CON 0 CATALOG TRACK TERMINATION FLAG
CRIN CON 1 CURRENT RANDOM INDEX
NCTL BSSZ 1 NUMBER OF CATALOGS
NCTB BSSZ 1 NUMBER OF CATALOGS IN BLOCK
EMRF BSSZ 1 EMPTY CATALOG RECORD FLAG
CCTR CON 1 CURRENT CATALOG TRACK
CWAD BSSZ 1 CONTROL WORD ADDRESS
CONT CON CFCW+201B DIRECTORY CONTROL WORD
TCCT BSSZ 1 TOTAL CATALOG COUNT
CDIR BSSZ 200B CATALOG DIRECTORY
CIRM DIS 3,GENERATING CATALOG IMAGE.
CIRH VFD 12/0LCH,48/0 CATALOG IMAGE RECORD HEADER
CICH BSS 1 HEADER WORD WITH MASK
NCAT BSSZ 1 NUMBER OF CATALOG TRACKS
WIB SPACE 4,20
** WIB - WRITE CATALOG IMAGE BLOCK.
*
* ENTRY (X2) = ADDRESS TO STORE CONTROL WORD AT.
* (X3) = CONTROL WORD.
* (NCTB) = WORD COUNT OF BLOCK.
* (CICH) = CATALOG IMAGE HEADER.
* (DBUFH - DBUFH+1000B) = CATALOG IMAGE BLOCK.
*
* EXIT (B3) = NEXT AVAILABLE WORKING STORAGE ADDRESS.
* (NCTB) = 0.
* (CICH) = 0.
* (CWAD) = NEXT CONTROL WORD ADDRESS.
* CATALOG IMAGE BLOCK WRITTEN TO ARCHIVE FILE.
* CATALOG IMAGE DATA WRITTEN TO SELECTED OUTPUT FILES.
*
* USES X - 1, 4, 6, 7.
* A - 1, 4, 6, 7.
* B - 3.
*
* CALLS OCI.
*
* MACROS ARCHIVE.
WIB SUBR ENTRY/EXIT
* SET UP CONTROL WORD.
SA4 NCTB
SA1 CICH
BX6 X3+X4 MERGE CONTROL WORD AND WORD COUNT
BX6 X6+X1 MERGE HEADER IF PRESENT
SA6 X2
* WRITE BLOCK.
SX7 B1 INCLUDE CONTROL WORD IN WORD COUNT
IX4 X4+X7
ARCHIVE WRITEW,DBUFH,X4 WRITE CATALOG IMAGE BLOCK
* WRITE CIR DATA TO OUTPUT FILES.
SA1 NCTB
SX6 DBUFH+1 SET BUFFER ADDRESS
BX7 X1 SET WORD COUNT
RJ OCI OUTPUT CIR ENTRIES
* RESET BLOCK POINTERS.
SX7 B0+
SA7 CICH CLEAR CATALOG IMAGE HEADER
SA7 NCTB CLEAR BLOCK CATALOG COUNT
SX6 DBUFH SET CONTROL WORD ADDRESS
SA6 CWAD
SB3 X6+1 SET WORKING STORAGE ADDRESS
EQ WIBX RETURN
TITLE PRESET MESSAGES.
PRESET SPACE 4,10
** PRESET ERROR MESSAGES.
ERAR DATA C* ACCESS LEVEL LIMITS OUT OF RANGE.*
ERFD DATA C* TAPE FORMAT OR LABEL NOT VALID FOR DESTAGE.*
ERLD DATA C* OPTICAL DISK LABEL NOT VALID FOR DESTAGE.*
ERND DATA C* VERSION NUMBER EXCEEDED FOR DESTAGE.*
EROF DATA C* INTERNAL ERROR ON FILE ZZZZZOD.*
ERPD DATA C* PARTITION NOT VALID FOR DESTAGE.*
ERTD DATA C* NT/CT/AT TAPE OR OD REQUIRED FOR DESTAGE.*
ERVD DATA C* VSN NOT VALID FOR DESTAGE.*
SPACE 4,10
* PRESET RESERVED LOCATIONS.
BUFI CON 0 FL INCREASE FOR VERIFY FILE BUFFER
COMMON SPACE 4,10
** PRESET COMMON DECKS.
*CALL COMCDCP
LIST X
*CALL COMCPFP
LIST *
*CALL COMCRSB
*CALL COMCSKW
*CALL COMCSOE
PRK HERE ASSEMBLE Y-COORDINATE PRESET CODE HERE
SPACE 4,10
* PRESET BUFFERS.
ODFBUF EQU * OPTICAL DISK MOUNT FILE BUFFER *ZZZZZOD*
ESTADD EQU ODFBUF+ODFBL *RSB* PARAMETER WORD FOR EST
ESTBUF EQU ESTADD+1 EST BUFFER
MSTADD EQU ESTBUF+ESMX*ESTE *RSB* PARAMETER WORD FOR MST
MSTBUF EQU MSTADD+1 MST BUFFER
DSTBUF EQU MSTBUF+MSTL DEVICE STATUS BUFFER
PREL EQU DSTBUF+2*MSMX*2 PRESET LWA + 1
ERRNG CATB-PREL PRESET OVERLAYS *CATB*
SPACE 4,10
END