PFDUMP
          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 
