Retro1.org codex

          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