Retro1.org codex

          IDENT  PFAM1,/COMSPFS/OVLA,PFA,01,00 
          TITLE  PFAM - PERMANENT FILE ARCHIVE MANAGEMENT UTILITIES.
          ABS
          SST
          SYSCOM B1
          SPACE  4,10
*COMMENT  PFAM - PERM FILE ARCHIVE MANAGEMENT UTILITIES.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4,10
***       PFAM - PERMANENT FILE ARCHIVE MANAGEMENT UTILITIES.
*
*         G. S. YODER        87/02/20.
*         P. C. SMITH        87/04/08.
          SPACE  4,10
***       *PFAM* CONTAINS UTILITIES FOR MANAGING ARCHIVE FILES CREATED
*         BY *PFDUMP*.  THESE UTILITIES MAY BE CALLED THROUGH THE *PFS*
*         COMMAND OR DIRECTLY BY UTILITY NAME.
*
*         THE FOLLOWING UTILITIES RESIDE IN *PFAM* -
*
*         PFATC  - CATALOG ARCHIVE FILE.
*         PFCOPY - COPY FILES FROM ARCHIVE FILE.
*         PFRES  - RESTORE FILES FROM TAPE ALTERNATE STORAGE TO DISK
*                  RESIDENCE.
***       MESSAGE LEGEND.
*
*         THE FOLLOWING LEGEND DEFINES PARAMETERS THAT ARE USED IN MANY
*         OF THE UTILITY ERROR MESSAGES.  THE DESCRIPTIVE CHARACTER
*         STRINGS DEFINED HERE ARE REPLACED BY THEIR ACTUAL VALUE WHEN
*         A PARTICULAR MESSAGE IS ISSUED.
*
*         FFFFFFF  = FAMILY NAME.
*         MMMMMM   = NUMBER OF FILES.
*         NNNNNNN  = PERMANENT FILE NAME.
*         UUUUUU   = USER INDEX.
          SPACE  4,10
***       OPERATOR MESSAGES.
*
*         *CATALOGING NNNNNNN UUUUUU*
*                FILE FFFFFFF ON USER INDEX UUUUUU ON THE ARCHIVE FILE
*                IS BEING PROCESSED BY *PFATC*.
*
*         *COPYING NNNNNNN UUUUUU*
*                FILE FFFFFFF ON USER INDEX UUUUUU ON THE ARCHIVE FILE
*                IS BEING PROCESSED BY *PFCOPY*.
*
*         *RESTORING NNNNNNN UUUUUU*
*                *PFRES* IS RESTORING THE DATA FOR PERMENENT FILE
*                NNNNNNN CATALOGED ON USER INDEX UUUUUU.
*
*         *SKIPPING NNNNNNN UUUUUU*
*                FILE NNNNNNN ON USER INDEX UUUUUU ON THE ARCHIVE FILE
*                WAS NOT SELECTED FOR PROCESSING BY *PFATC*, *PFCOPY*
*                OR *PFRES*.
          SPACE  4,10
***       INFORMATIVE DAYFILE MESSAGES.
*
*         * FILE NAME CHANGED TO ZZZZZLF.*
*                THE NAME OF THE FILE BEING COPIED WAS THE SAME AS THE
*                SPECIFIED OUTPUT FILE.  THE LOGICAL FILE NAME WAS
*                CHANGED TO PREVENT A CONFLICT.
*
*         * FILE NAME CHANGED TO ZZZZZSF.*
*                THE NAME OF THE FILE BEING COPIED WAS THE SAME AS THE
*                SPECIFIED SUMMARY FILE.  THE LOCAL FILE NAME WAS
*                CHANGED TO PREVENT A CONFLICT.
*
*         * FILE NAME CHANGED TO ZZZZZTF.*
*                THE NAME OF THE FILE BEING COPIED WAS THE SAME AS THE
*                SPECIFIED ARCHIVE FILE.  THE LOCAL FILE NAME WAS
*                CHANGED TO PREVENT A CONFLICT.
*
*         * PFATC COMPLETE.*
*               *PFATC* TERMINATED WITHOUT FATAL ERRORS.
*
*         * PFCOPY COMPLETE.*
*               *PFCOPY* TERMINATED WITHOUT FATAL ERRORS.
*
*         * PFRES COMPLETE.*
*               *PFRES* TERMINATED WITHOUT FATAL ERRORS.
*
*         * MMMMMM FILES CATALOGED.*
*                MMMMMM FILES WERE CATALOGED BY *PFATC*.
*
*         * MMMMMM FILES COPIED.*
*                MMMMMM FILES WERE COPIED BY *PFCOPY.*
*
*         * MMMMMM FILES RESTORED.*
*                MMMMMM FILES WERE RESTORED BY *PFRES.*
          SPACE  4
***       NON-FATAL ERROR MESSSAGES.
*
*         * ARCHIVE FILE BLOCK ERROR, FN=NNNNNNN, UI=UUUUUU.*
*                A PFC, PERMIT, OR DATA BLOCK WAS DETECTED WITH AN
*                INCORRECT SUB-TYPE, AN INCORRECT LENGTH FOR THE BLOCK
*                TYPE, OR INCORRECT CONTENTS FOR THE BLOCK TYPE.  ALSO
*                ISSUED WHEN PERMIT OR DATA BLOCKS WERE PRESENT OR
*                MISSING WHEN THEY SHOULD NOT BE BASED ON INFORMATION
*                IN THE PFC BLOCK OR WHEN A BLOCK OF UNKNOWN TYPE IS
*                ENCOUNTERED.
*
*         * ARCHIVE FILE BLOCK ERROR, FN=NNNNNNN, UI=UUUUUU,
*           FM=FFFFFFF.*
*                A PFC, PERMIT, OR DATA BLOCK WAS DETECTED WITH AN
*                INCORRECT SUB-TYPE, AN INCORRECT LENGTH FOR THE BLOCK
*                TYPE, OR INCORRECT CONTENTS FOR THE BLOCK TYPE.  ALSO
*                ISSUED WHEN PERMIT OR DATA BLOCKS WERE PRESENT OR
*                MISSING WHEN THEY SHOULD NOT BE BASED ON INFORMATION
*                IN THE PFC BLOCK OR WHEN A BLOCK OF UNKNOWN TYPE IS
*                ENCOUNTERED.
*
*         * ARCHIVE FILE READ ERROR, FN=NNNNNNN, UI=UUUUUU.*
*                A READ ERROR OCCURRED ON THE ARCHIVE FILE WHILE
*                PROCESSING THE INDICATED FILE.
*
*         * ARCHIVE FILE READ ERROR, FN=NNNNNNN, UI=UUUUUU,
*           FM=FFFFFFF.*
*                A READ ERROR OCCURRED ON THE ARCHIVE FILE WHILE
*                PROCESSING THE INDICATED FILE.
*
*         * FILE VERIFICATION ERROR, FN=NNNNNNN, UI=UUUUUU, FM=FFFFFFF.*
*                WHEN STAGING THE INDICATED FILE, THE PFC ON THE
*                ALTERNATE STORAGE TAPE DID NOT MATCH THE PFC OF THE
*                FILE TO BE STAGED.
*
*         * NO DEVICE FOR FILE ACCESS LEVEL, FN=NNNNNNN, UI=UUUUUU.*
*                NO TEMPORARY FILE DEVICE WAS AVAILABLE THAT WILL ALLOW
*                THE SECURITY ACCESS LEVEL OF THE INDICATED FILE TO
*                RESIDE THERE.
*
*         * NO DEVICE FOR FILE ACCESS LEVEL, FN=NNNNNNN, UI=UUUUUU,
*           FM=FFFFFFF.*
*                NO DEVICE COULD BE FOUND THAT WILL ALLOW THE SECURITY
*                ACCESS LEVEL OF THE INDICATED FILE TO RESIDE THERE.
*
*         * NO FILES TO RESTORE.*
*                *PFRES* WAS INITIATED, BUT NO STAGE REQUESTS WERE
*                 PENDING.
*
*         * PFM ERROR ENCOUNTERED, FN=NNNNNNN, UI=UUUUUU, FM=FFFFFFF.
*                *PFM* WAS NOT ABLE TO RESTORE THE INDICATED FILE TO
*                DISK RESIDENCE.
*
*         * STAGE ABANDONED, FN=NNNNNNN, UI=UUUUUU, FM=FFFFFFF.*
*                THE STAGE REQUEST FOR THE INDICATED FILE WAS ABANDONED
*                BECAUSE IT HAD BEEN RETRIED UNSUCCESSFULLY THE MAXIMUM
*                NUMBER OF TIMES.
          SPACE  4,10
***       FATAL ERROR MESSAGES.
*
*         * ARCHIVE FILE LABEL READ ERROR.*
*                A READ ERROR OCCURRED WHEN READING THE ARCHIVE FILE
*                LABEL.
*
*         * INCORRECT CATALOG SIZE.*
*                THE ARCHIVE TAPE WHICH WAS ASSIGNED TO *PFRES* AS A
*                STAGING TAPE WAS DUMPED WITH 8-WORD PFC-S.
*
*         * PREMATURE EOF DETECTED.*
*                END OF FILE DETECTED BEFORE END OF DUMP CONTROL WORD.
*
*         * STAGING TAPE NOT ASSIGNED.*
*                A FILE OTHER THAN A TAPE WAS ASSIGNED TO *PFRES* AS A
*                STAGING TAPE.
*
*         * STAGING TAPE VSN ERROR.  VSN = VVVVVV.*
*                THE TAPE ASSIGNED TO *PFRES* AS A STAGING TAPE HAD A
*                VSN WHICH WAS NOT LEGAL FOR A STAGING TAPE.
          SPACE  4,10
***       ACCOUNT FILE MESSAGES.
*
*         *STAS, FILENAM, USERIN, FAMPACK, VSNVSN, R.*
*                INDICATES THE ABANDONMENT OF A STAGE REQUEST FOR
*                FILE *FILENAM*, OF USER INDEX *USERIN*, ON FAMILY/PACK
*                *FAMPACK*, FROM VSN *VSNVSN*, AFTER *R* RETRIES.
*
*         *STES, FILENAM, USERIN, FAMPACK, VSNVSN, R.*
*                INDICATES THE SUCCESSFUL COMPLETION OF A STAGE REQUEST
*                FOR FILE *FILENAM*, OF USER INDEX *USERIN*, ON
*                FAMILY/PACK *FAMPACK*, FROM VSN *VSNVSN*, AFTER *R*
*                RETRIES.
*                INDICATES THE SUCCESSFUL COMPLETION OF A STAGE REQUEST
*                FOR FILE *FILENAM*, OF USER INDEX *USERIN*, ON
*                FAMILY/PACK *FAMPACK*, FROM VSN *VSNVSN*, AFTER *R*
*                RETRIES.
*
*         *STTA, FAMPACK, VSNVSN, NNNN.*
*                INDICATES THAT FOR FAMILY/PACK *FAMPACK* STAGING VSN
*                *VSNVSN* HAS BEEN ASSIGNED TO RESTORE *NNNN* FILES.
                 SPACE 4,10
*         COMMON DECKS.
 
 
*CALL     COMCMAC
*CALL     COMCCMD
*CALL     COMSMLS
          QUAL   MTX
          LIST   X
*CALL     COMSMTX
          LIST   *
          QUAL   *
*CALL     COMSPFM
          LIST   X
*CALL     COMSPFS
          LIST   *
*CALL     COMSPFU
*CALL     COMSPRD
*CALL     COMSRPV
*CALL     COMSSFM
*CALL     COMSSSD
          TITLE  ASSEMBLY CONSTANTS.
*CALL     COMSVER
*         ASSEMBLY CONSTANTS.
 
 
 CWSW     EQU    5           CONTROL WORD STATUS WORD
 MEMI     EQU    1000B       CM FL INCREMENT TO REQUEST
 SSLN     EQU    100B        SYSTEM SECTOR LENGTH
 
*         BUFFER LENGTHS.
 
 CATHL    EQU    NWCE        CATALOG ENTRY HOLD BUFFER LENGTH
 DBUFL    EQU    2001B       ARCHIVE DATA BLOCK WORKING BUFFER LENGTH
 MBUFL    EQU    6001B       MAIN BUFFER LENGTH
 MSFBL    EQU    10001B      *COMCMSF* SORT FILES BUFFER LENGTH
 OUTBL    EQU    10001B      OUTPUT FILE BUFFER LENGTH
 PFLBL    EQU    1001B       PROCESSED FILES FILE BUFFER LENGTH
 QBUFL    EQU    1000B       STAGE REQUEST QUEUE BUFFER LENGTH
 RBUFL    EQU    1001B       STAGE REQUEST FILE BUFFER LENGTH
 SABFL    EQU    1000B       SUMMARY FILE ASSEMBLY BUFFER LENGTH
 SBUFL    EQU    1001B       SCRATCH STAGE REQUEST FILE BUFFER LENGTH
 SRTBL    EQU    20000B      SORT BUFFER LENGTH
 SUMBL    EQU    1001B       SUMMARY FILE BUFFER LENGTH
 TBUFL    EQU    30061B      ARCHIVE FILE BUFFER LENGTH
 ODEBL    EQU    20B         OPTICAL DISK EXTENSION BUFFER LENGTH
 
 
*         *COMSPFS* EQUIVALENCES.
 
 
 CPAR     EQU    /COMSPFS/CPL
 IDSA     EQU    /COMSPFS/PADR
          TITLE  RESERVED LOCATIONS AND FETS.
          ORG    /COMSPFS/OVLA
          SPACE  4,10
*         DATA LOCATIONS.
 
 
 CIPF     CON    0           CIR BLOCK PROCESSED FLAG
 CAPF     CON    0           CATALOG BLOCK PROCESSED FLAG
 EFPF     CON    0           EOF JUST PROCESSED FLAG
 FPRF     CON    0           FILE BEING PROCESSED FLAG
 NSSR     CON    0           NUMBER OF STAGE REQUESTS SELECTED
 MSTAT    CON    0           MEMORY STATUS
 PVSN     CON    0           PACKED VSN OF STAGING TAPE
 SRFF     CON    1           STAGE REQUEST FILE ATTACHED (*PFRES*)
 SRQF     CON    QBUF        FWA OF STAGE REQUEST QUEUE
 SRQL     CON    0           LENGTH OF STAGE REQUEST QUEUE
 SRQN     CON    0           NUMBER OF ENTRIES OF STAGE REQUEST QUEUE
 STRA     CON    0           ADDRESS OF STAGE REQUEST BEING PROCESSED
 SVSN     CON    0           STAGING TAPE VSN
          SPACE  4,10
*         FETS.
 
 
 T        BSS    0           ARCHIVE FILE
 TAPE     FILEB  TBUF,TBUFL,EPR,FET=13D
 
 ODEB     BSSZ   ODEBL       OPTICAL DISK EXTENSION BUFFER
 
 F        BSS    0           LOCAL/MASTER FILE
 FILEA    FILEB  MBUF,MBUFL,FET=16D
 .SRB     BSS    0
          ORG    F+CFPW
          VFD    42/0,18/EMBF  ERROR MESSAGE BUFFER ADDRESS
          ORG    F+CFSR
          VFD    42/0,18/SRB SPECIAL REQUEST BLOCK ADDRESS
          ORG    .SRB
 
 SRB      BSSZ   4           SPECIAL REQUEST BLOCK
 EMBF     BSSZ   6           ERROR MESSAGE BUFFER
          SPACE  4,10
*         INFORMATIONAL MESSAGES.
 
 
 MSCA     DATA   10HCATALOGING
 MSCP     DATA   10HCOPYING
 MSRS     DATA   10HRESTORING
 MSSK     DATA   10HSKIPPING
 BLNK     DATA   30H
          SPACE  4,10
*         FILE COUNT MESSAGES.
 
 
 MSFA     DATA   C* ?????? FILE! CATALOGED.*
 MSFO     DATA   C* ?????? FILE! COPIED.*
 MSFR     DATA   C* ?????? FILE! RESTORED.*
          SPACE  4,10
*         ERROR MESSAGES.
 
 
 ERAB     DATA   C* ARCHIVE FILE BLOCK ERROR, FN=???????, UI=!!!!!!.*
 ERAL     DATA   C* ARCHIVE FILE LABEL READ ERROR.*
 ERAR     DATA   C* ARCHIVE FILE READ ERROR, FN=???????, UI=!!!!!!.*
 ERFL     DATA   C* FILE NAME CHANGED TO ZZZZZLF.*
 ERFS     DATA   C* FILE NAME CHANGED TO ZZZZZSF.*
 ERFT     DATA   C* FILE NAME CHANGED TO ZZZZZTF.*
 ERFV     DATA   C* FILE VERIFICATION ERROR, FN=???????, UI=!!!!!!, FM=+
,++++++.*
 ERIC     DATA   C* INCORRECT CATALOG SIZE.*
 ERDA     DATA   C* NO DEVICE FOR FILE ACCESS LEVEL, FN=???????, UI=!!!!
,!!.*
 ERNR     DATA   C* NO FILES TO RESTORE.*
 ERNT     DATA   C* STAGING TAPE NOT ASSIGNED.*
 ERPE     DATA   C* PREMATURE EOF DETECTED.*
 ERPF     DATA   C* PFM ERROR ENCOUNTERED, FN=???????, UI=!!!!!!, FM=+++
,++++.*
 ERRA     DATA   C* NO DEVICE FOR FILE ACCESS LEVEL, FN=???????, UI=!!!!
,!!, FM=+++++++.*
 ERRB     DATA   C* ARCHIVE FILE BLOCK ERROR, FN=???????, UI=!!!!!!, FM=
,+++++++.*
 ERRR     DATA   C* ARCHIVE FILE READ ERROR, FN=???????, UI=!!!!!!, FM=+
,++++++.*
 ERSA     DATA   C* STAGE ABANDONED, FN=???????, UI=!!!!!!, FM=+++++++.*
 ERVE     DATA   C* STAGING TAPE VSN ERROR.  VSN = $$$$$$.*
          TITLE  MAIN ROUTINES.
 PFA      SPACE  4,10
**        PFAM - MAIN PROGRAM.
*
*         EXIT   TO *AFL* TO READ ARCHIVE FILE.
*
*         USES   X - 1.
*                A - 1.
*
*         CALLS  PRS.
*
*         MACROS SKIPFF.
 
 
 PFA      BSS    0           ENTRY
          RJ     PRS         PRESET PROGRAM
          SA1    CPAR+/COMSPFS/CPSF
          ZR     X1,AFL      IF NO FILES TO SKIP
          SKIPFF TAPE,X1,R   SKIP NUMBER OF FILES
*         EQ     AFL         PROCESS ARCHIVE FILE LABEL
 AFL      SPACE  4,20
**        AFL - PROCESS ARCHIVE FILE LABEL.
*
*         EXIT   ARCHIVE LABEL PROCESSED IF FOUND.
*                TO *CUP* IF NO READ ERROR ON LABEL READ.
*                TO *ABT* IF READ ERROR ON LABEL READ.
*                TO *TER* IF EOI AND IF EOF JUST PROCESSED.
*                TO *ABT* IF EOI NOT PRECEDED BY EOF.
*                TO *EAF* IF LAST ARCHIVE FILE AND NO FILES SELECTED.
*
*         USES   X - 0, 2, 1, 3, 5.
*                A - 0, 2, 1, 3, 5.
*                B - 2.
*
*         CALLS  PLP, SER.
*
*         MACROS MOVE, READ, READW, RECALL.
 
 
 AFL      BSS    0           ENTRY
          READ   TAPE,R
          SA3    TAPE
          LX3    59-11
          PL     X3,AFL1     IF NO ERROR
          SB2    ERAL        * ARCHIVE FILE LABEL READ ERROR.*
          EQ     ABT         ABORT
 
 AFL1     LX3    59-9-59+11
          PL     X3,AFL1.1   IF NOT AT EOI
          SA1    EFPF
          NZ     X1,TER      IF EOF JUST PROCESSED
          SB2    ERPE        * PREMATURE EOF DETECTED.*
          EQ     ABT         ABORT
 
 AFL1.1   SX6    B0+         CLEAR *EOF JUST PROCESSED* FLAG
          SA6    EFPF
          SA1    TAPE+3      CHECK IF LABEL
          SA1    X1
          MX0    -3
          AX1    12
          BX1    -X0*X1
          ZR     X1,AFL2     IF DUMP ARCHIVE LABEL
          SA0    B0+         SET LABEL NOT FOUND
          SX1    X1-1
          ZR     X1,AFL3     IF CATALOG CONTROL WORD
          RJ     SER         SKIP TO END OF RECORD
          SA0    B0+         SET LABEL NOT FOUND
          EQ     AFL3        CLEAR MESSAGE AREAS
 
 AFL2     READW  TAPE,DBUF,B1  READ LABEL CONTROL WORD
          SA1    DBUF        GET CONTROL WORD
          MX0    -9
          BX5    -X0*X1
          READW  TAPE,DBUF,X5  READ LABEL
          SA0    DBUF        SET LABEL BUFFER ADDRESS
 AFL3     RJ     PLP         PROCESS LABEL PARAMETERS
          RECALL TAPE
          SA5    IDSA+/COMSPFS/ADMS  CLEAR MESSAGE AREAS
          MOVE   3,BLNK,X5
          SA5    IDSA+/COMSPFS/ADER  CLEAR MESSAGE AREAS
          MOVE   3,BLNK,X5
          SA1    AFDM        GET ARCHIVE FILE DEVICE MASK
          SA2    FLSM        GET REMAINING FILE SELECTIONS MASK
          BX1    X1*X2
          ZR     X1,EAF      IF LAST ARCHIVE FILE AND NO FILES SELECTED
*         EQ     CUP         CALL UTILITY PROCESSOR
 CUP      SPACE  4,15
**        CUP - CALL UTILITY PROCESSOR.
*
*         ENTRY  ARCHIVE FILE POSITIONED FOR READ OF CONTROL WORD.
*
*         EXIT   TO *ATC* IF *PFATC*.
*                TO *COP* IF *PFCOPY*.
*                TO *RES* IF *PFRES*.
*
*         USES   X - 1, 2.
*                A - 1.
 
 
 CUP      BSS    0           ENTRY
          SA1    /COMSPFS/UTLC  CHECK UTILITY CODE
          SX2    X1-/COMSPFS/ATUT
          ZR     X2,ATC      IF *PFATC*
          SX2    X1-/COMSPFS/COUT
          ZR     X2,COP      IF *PFCOPY*
          EQ     RES         PROCESS *PFRES*
 ATC      SPACE  4,10
**        ATC - *PFATC* MAIN LOOP.
*
*         USES   X - 1, 2, 4, 6.
*                A - 0, 1, 4, 6.
*
*         CALLS  CFB, CFC, CSP, DFN, OCD, OCI, PPE, RCW, SER.
*
*         MACROS READW, SKIPW.
 
 
 ATC      BSS    0           ENTRY
 
*         CHECK CONTROL WORD.
 
 ATC1     SX6    B0+
          SA6    FPRF        CLEAR FILE PROCESSING FLAG
          RJ     RCW         READ CONTROL WORD
          NG     X3,ATC1     IF EOR
          SX1    X2-1
          ZR     X1,ATC5     IF PF CATALOG ENTRY
          SX1    X2-5
          ZR     X1,ATC3     IF CIR
 ATC2     SKIPW  TAPE,X5     SKIP BLOCK
          RJ     SER         SKIP TO EOR
          EQ     ATC1        READ CONTROL WORD
 
*         PROCESS CATALOG IMAGE RECORD BLOCK.
 
 ATC3     ZR     X5,ATC1     IF EMPTY BLOCK
          RJ     CFB         CHECK FOR FIRST BLOCK
          READW  TAPE,DBUF,X5  READ CATALOG IMAGE BLOCK
          RJ     PPE         PROCESS PARITY ERROR
          NZ     X6,ATC1     IF PARITY ERROR
          SX6    DBUF        SET CIR BUFFER POINTER
          BX7    X5          SET WORD COUNT
          RJ     OCI         OUTPUT CATALOG IMAGE BLOCK
          EQ     ATC1        READ CONTROL WORD
 
*         PROCESS CATALOG BLOCK.
 
 ATC5     RJ     CFB         CHECK IF FIRST CATALOG BLOCK
          RJ     CFC         CHECK FILES PROCESSED COUNT
          RJ     CSP         CHECK SELECTION PARAMETERS
          ZR     X6,ATC7     IF NOT TO PROCESS FILE
          SA6    FPRF        SET FILE PROCESSING FLAG
          SA1    CATH        SET FILE NAME AND USER INDEX
          SA2    MSCA        *CATALOGING ...*
          RJ     DFN         DISPLAY MESSAGE
          RJ     VPD         VERIFY PERMIT AND DATA BLOCKS
          SA0    CATH        SET CATALOG ENTRY ADDRESS
          RJ     CFP         COUNT FILE PROCESSED
          EQ     ATC1        CHECK NEXT CONTROL WORD
 
 ATC7     SA1    CATH        SET FILE NAME AND USER INDEX
          SA2    MSSK        *SKIPPING ...*
          RJ     DFN         DISPLAY MESSAGE
          RJ     SER         SKIP TO END OF RECORD
          EQ     ATC1        CHECK NEXT CONTROL WORD
 COP      SPACE  4,10
**        COP - *PFCOPY* MAIN LOOP.
*
*         USES   X - 1, 2, 6, 7.
*                A - 0, 1, 2, 6, 7.
*
*         CALLS  CCB, CFB, CFC, CFP, PDB, PPB, RCW, SER.
*
*         MACROS MESSAGE, SKIPW.
 
 
 COP      BSS    0           ENTRY
 
*         CHECK NEXT CONTROL WORD.
 
 COP1     SX6    B0+
          SA6    FPRF        CLEAR FILE PROCESSING FLAG
          RJ     CFC         CHECK FILE SELECTION COUNT
          RJ     RCW         READ CONTROL WORD
          NG     X3,COP1     IF EOR
          SX1    X2-1
          ZR     X1,COP3     IF CATALOG CONTROL WORD
          SKIPW  TAPE,X5     SKIP BLOCK
          RJ     SER         SKIP TO EOR
          EQ     COP1        CHECK NEXT CONTROL WORD
 
 COP3     RJ     CFB         CHECK IF FIRST CATALOG BLOCK
          RJ     CCB         PROCESS CATALOG BLOCK
          NZ     X6,COP1     IF FILE NOT TO BE PROCESSED
          RJ     PPB         PROCESS PERMIT BLOCK
          NZ     X6,COP1     IF PARITY ERROR
          RJ     PDB         PROCESS DATA BLOCK
          ZR     X6,COP4     IF NO ERROR
          RETURN F,R         RETURN LOCAL FILE
          EQ     COP1        CHECK NEXT FILE
 
 COP4     SA0    CATH        SET CATALOG ENTRY ADDRESS
          RJ     CFP         COUNT FILE PROCESSED
          EQ     COP1        CHECK NEXT FILE
 RES      SPACE  4,10
**        RES - *PFRES* MAIN LOOP.
*
*         EXIT   TO *TER* WHEN NO REQUESTS LEFT TO PROCESS.
*
*         USES   X - 0, 1, 2, 4, 5, 6, 7.
*                A - 0, 1, 2, 5, 6, 7.
*                B - 2, 5.
*
*         CALLS  CAR, CFP, CLC, PDB, PPE, RCB, RCW, SER, STE.
*
*         MACROS EESET, MESSAGE, SKIPW, UNLOAD.
 
 
 RES      BSS    0           ENTRY
 
*         CHECK NEXT FILE ON TAPE.
 
 RES1     SX6    B0+         CLEAR FILE PROCESSING FLAG
          SA6    FPRF
          RJ     RCW         READ CONTROL WORD
          NG     X3,RES1     IF EOR
          SX1    X2-1
          ZR     X1,RES3     IF CATALOG CONTROL WORD
          SX1    X2-5
          NZ     X1,RES2     IF NOT CATALOG IMAGE RECORD
          SKIPW  TAPE,X5     SKIP CIR BLOCK
          RJ     SER         SKIP TO EOR
          EQ     RES1        CHECK NEXT CONTROL WORD
 
 RES2     RJ     STE         SKIP TAPE ERROR
          EQ     RES1        CHECK NEXT CONTROL WORD
 
 RES3     RJ     RCB         PROCESS CATALOG BLOCK
          NZ     X6,RES1     IF FILE NOT TO BE PROCESSED
 
*         SKIP PERMIT BLOCKS, IF PRESENT.
 
 RES4     RJ     RCW         READ CONTROL WORD
          BX0    X3
          SX4    X2-3
          ZR     X4,RES6     IF DATA BLOCK
          SX4    X2-2
          ZR     X4,RES5     IF PERMIT BLOCK
          SA5    STRA
          SB2    ERRB        * ARCHIVE FILE BLOCK ERROR ...*
          RJ     SRE         SEND ERROR MESSAGE
          RJ     STE         SKIP TAPE ERROR
          EQ     RES7        PROCESS ERROR
 
 RES5     ZR     X5,RES4     IF ZERO WORD COUNT
          SKIPW  TAPE,X5     SKIP PERMIT BLOCK
          RJ     PPE         PROCESS PARITY ERROR
          NZ     X6,RES7     IF PARITY ERROR
          EQ     RES4        CHECK NEXT BLOCK
 
*         PROCESS DATA BLOCK.
 
 RES6     RJ     PDB         PROCESS DATA BLOCK
          ZR     X6,RES8     IF NO ERROR
 RES7     UNLOAD F           RETURN LOCAL FILE
          EQ     RES9        CHECK FOR ADDITIONAL REQUESTS
 
*         COMPLETE STAGE PROCESS.
 
 RES8     RJ     CLC         CONNECT LOCAL FILE TO CATALOG ENTRY
          NZ     X6,RES7     IF ERROR
          UNLOAD F           RELEASE FILE
          SA1    STRA        INDICATE FILE STAGED
          SA2    X1+3        GET EVENT
          MX6    -21
          BX1    -X6*X2
          EESET  X1          ISSUE EVENT
          SB5    -ISMA       ISSUE *STES* MESSAGE
          SA5    STRA
          RJ     ISM
          SA1    STRA        INDICATE STAGE REQUEST PROCESSED
          BX6    X6-X6
          SA6    X1
          SA6    A1
          SA0    CATH        SET CATALOG ENTRY ADDRESS
          RJ     CFP         COUNT FILE PROCESSED
 RES9     RJ     CAR         CHECK FOR ADDITIONAL REQUESTS
          ZR     X6,TER      IF NO REQUESTS LEFT TO PROCESS
          EQ     RES1        CHECK NEXT FILE
 EAF      SPACE  4,20
**        EAF - END PROCESSING ON CURRENT ARCHIVE FILE.
*
*         ENTRY  PROCESSING COMPLETE ON CURRENT ARCHIVE FILE.
*
*         EXIT   TO *EOF*.
*                ARCHIVE FILE POSITIONED TO START OF NEXT FILE.
*
*         USES   X - 1, 6, 7.
*                A - 1.
*
*         MACROS RECALL, SKIPFF.
 
 
 EAF      BSS    0           ENTRY
          RECALL TAPE
          SA1    X2+B1       REWIND BUFFER
          SX6    X1
          SA6    A1+B1
          SA6    A6+B1
          SA1    X2          CHECK FOR EOF/EOI ON ARCHIVE FILE
          SX6    30B
          BX7    X6*X1
          BX6    X7-X6
          ZR     X6,EOF      IF AT EOF/EOI
          SKIPFF X2,B1,R     SKIP TO EOF
*         EQ     EOF         PROCESS END OF FILE
 EOF      SPACE  4,15
**        EOF - PROCESS END OF FILE ON ARCHIVE FILE.
*
*         ENTRY  END OF FILE ENCOUNTERED ON ARCHIVE FILE.
*
*         EXIT   TO *AFL* IF MORE FILES TO PROCESS.
*                  BLOCK PROCESSED FLAGS RESET.
*                  (EFPF) NONZERO.
*                TO *TER* IF NO MORE FILES TO PROCESS.
*
*         USES   X - 1, 6.
*                A - 1, 6.
*
*         CALLS  PSF.
 
 
 EOF      BSS    0           ENTRY
          SA1    CAPF
          ZR     X1,EOF1     IF CATALOG BLOCK NOT PROCESSED
          RJ     PSF         PROCESS SORTED FILE LIST AND STATISTICS
 EOF1     SA1    TAPE        CHECK FOR *EOI*
          LX1    59-9
          NG     X1,TER      IF *EOI* ENCOUNTERED
          SA1    CPAR+/COMSPFS/CPNB  CHECK IF NUMBER OF FILES SPECIFIED
          ZR     X1,TER      IF NOT SPECIFIED
          SX6    X1-1
          ZR     X6,TER      IF NUMBER SPECIFIED PROCESSED
          SA6    A1
          BX6    X6-X6       RESET BLOCK PROCESSED FLAGS
          SA6    CIPF
          SA6    CAPF
          SX6    B1+         SET *EOF JUST PROCESSED* FLAG
          SA6    EFPF
          EQ     AFL         PROCESS NEXT ARCHIVE FILE
 TER      SPACE  4,20
**        TER - PERFORM TERMINATION.
*
*         EXIT   TO *AFL* IF MORE STAGE REQUESTS TO PROCESS FOR *PFRES*.
*                TO *END* IF OVERLAY PROCESSING COMPLETE.
*                LOCAL FILE AND TAPE RETURNED (*PFRES*).
*                UNPROCESSED STAGE REQUESTS REQUEUED.
*
*         USES   X - 1, 2, 3, 6.
*                A - 1, 2, 6.
*                B - 2, 5.
*
*         CALLS  CAR, RUR, TCM.
*
*         MACROS MESSAGE, MOVE, RETURN, REWIND.
 
 
 TER      BSS    0           ENTRY
          SA1    /COMSPFS/UTLC
          SX1    X1-/COMSPFS/RSUT
          NZ     X1,TER3     IF NOT *PFRES*
 
*         IF STAGE REQUESTS REMAIN, REWIND TAPE AND READ FROM BEGINNING
*         (UNLESS NO NEW REQUESTS HAVE BEEN RECEIVED AND NO FILES HAVE
*         BEEN STAGED SINCE THE LAST ENTRY TO *TER*).
 
          RJ     CAR         CHECK FOR ADDITIONAL STAGE REQUESTS
          ZR     X6,TER2     IF NO MORE STAGE REQUESTS TO BE PROCESSED
          SA1    SRQN
          SA2    TERA
          BX6    X1
          SA6    A2          SAVE NUMBER OF REQUESTS RECEIVED
          IX3    X1-X2
          SA1    NSSR
          SA2    TERB
          BX6    X1
          SA6    A2          SAVE NUMBER OF REQUESTS SELECTED
          NZ     X3,TER1     IF MORE REQUESTS RECEIVED SINCE LAST CALL
          IX1    X1-X2
          ZR     X1,TER2     IF NO MORE FILES STAGED SINCE LAST CALL
 TER1     REWIND TAPE,R
          RJ     CAR         CHECK FOR ADDITIONAL STAGE REQUESTS
          EQ     AFL         PROCESS ADDITIONAL STAGE REQUESTS
 
 TER2     RJ     /MTX/TCM    TERMINATE CONNECTION WITH *MAGNET*
          RJ     RUR         REQUEUE UNPROCESSED STAGE REQUESTS
          RETURN F,R
          RETURN T,R
 
*         PROCESS *PFATC* OR *PFCOPY* TERMINATION.
 
 TER3     EQ     END         TERMINATE
 
 
 TERA     CON    0           STAGE REQUESTS RECEIVED BEFORE PRIOR CALL
 TERB     CON    0           STAGE REQUESTS SELECTED BEFORE PRIOR CALL
          TITLE  PRIMARY SUBROUTINES.
 CCB      SPACE  4,15
**        CCB - *PFCOPY* PROCESS CATALOG BLOCK.
*
*         ENTRY  (X3) = CATALOG BLOCK CONTROL WORD SUB-TYPE CODE.
*                (X5) = CATALOG BLOCK WORD COUNT.
*
*         EXIT   (X6) .NE. 0, IF FILE NOT TO BE PROCESSED.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6.
*
*         CALLS  ALD, CSP, CFE, DFN, SER, SFE.
*
*         MACROS MESSAGE, RECALL, RETURN, WRITER, WRITEW.
 
 
 CCB      SUBR               ENTRY/EXIT
          RJ     CSP         CHECK SELECTION PARAMETERS
          ZR     X6,CCB1     IF FILE NOT TO BE COPIED
          SA1    FLST
          LX1    59-0
          NG     X1,CCB1     IF *PFC ONLY* FILE
          SA6    FPRF        SET FILE PROCESSING FLAG
          EQ     CCB3        SET FILE NAME IN FET
 
*         SET SKIPPING FN UI MESSAGE.
 
 CCB1     SA1    CATH        SET FILE NAME AND USER INDEX
          SA2    MSSK        *SKIPPING ...*
          RJ     DFN         DISPLAY MESSAGE
 CCB2     RJ     SER         SKIP TO EOR
          SX6    B1          INDICATE FILE NOT TO BE PROCESSED
          EQ     CCBX        RETURN
 
*         SET FILE NAME IN FET.
 
 CCB3     RECALL FILEA
          SA3    CPAR+/COMSPFS/CPMF  CHECK IF MASTER FILE SPECIFIED
          NZ     X3,CCB7     IF MASTER FILE SPECIFIED
          SA4    FILEA       SET FILE NAME IN FET
          MX0    42
          BX7    -X0*X4      SAVE CODE AND STATUS
          SA3    CATH
          BX1    X0*X3
          SA2    CPAR+/COMSPFS/CPTB
          BX2    X2-X1
          NZ     X2,CCB4     IF NOT ARCHIVE FILE NAME
          MESSAGE  ERFT      * FILE NAME CHANGED TO ZZZZZTF.*
          SA1    =0LZZZZZTF
          EQ     CCB6        CHANGE NAME IN FET
 
 CCB4     SA2    CPAR+/COMSPFS/CPLB
          BX2    X2-X1
          NZ     X2,CCB5     IF NOT OUTPUT FILE NAME
          MESSAGE  ERFL      * FILE NAME CHANGED TO ZZZZZLF.*
          SA1    =0LZZZZZLF
          EQ     CCB6        CHANGE FILE NAME IN FET
 
 CCB5     SA2    CPAR+/COMSPFS/CPSU
          BX2    X2-X1
          NZ     X2,CCB6     IF NOT SUMMARY FILE NAME
          MESSAGE  ERFS      * FILE NAME CHANGED TO ZZZZZSF.*
          SA1    =0LZZZZZSF
 CCB6     BX6    X7+X1
          SA6    A4
          RETURN FILEA,R
          RJ     ALD         ASSIGN MASS STORAGE DEVICE
          ZR     X6,CCB7     IF DEVICE ASSIGNED
          SA1    CATH        SET FILE NAME AND USER INDEX
          SA2    MSSK        *SKIPPING ...*
          RJ     DFN         DISPLAY MESSAGE
          SA1    CATH+FCUI
          SB2    ERDA        * NO DEVICE FOR FILE ACCESS LEVEL ...*
          RJ     SFE         SEND ERROR MESSAGE
          RJ     CFE         COUNT FILE SKIPPED
          EQ     CCB2        SKIP FILE
 
*         SET COPYING FN UI MESSAGE.
 
 CCB7     SA1    CATH        SET FILE NAME AND USER INDEX
          SA2    MSCP        *COPYING ...*
          RJ     DFN         DISPLAY MESSAGE
 
*         WRITE CATALOG PREFACE RECORD IF SELECTED.
 
          SA1    CPAR+/COMSPFS/CPOP
          LX1    59-50
          PL     X1,CCB8     IF NO PREFACE RECORDS REQUESTED
          WRITEW FILEA,CATH,NWCE
          WRITER FILEA,R
 CCB8     BX6    X6-X6       INDICATE FILE TO BE PROCESSED
          EQ     CCBX
 CFB      SPACE  4,20
**        CFB - CHECK FOR FIRST BLOCK OF TYPE ON CURRENT ARCHIVE FILE.
*
*         ENTRY  (X2) = BLOCK TYPE (MUST BE 1 OR 5).
*                     = 1 IF CATALOG ENTRY.
*                     = 5 IF *CIR* ENTRY.
*                (X3) = BLOCK CONTROL WORD SUB-TYPE.
*                (X5) = BLOCK WORD COUNT.
*
*         EXIT   (CIPF) .NE. 0 IF *CIR* BLOCK.
*                (CAPF) .NE. 0 IF CATALOG BLOCK.
*                (X3) = BLOCK CONTROL WORD SUB-TYPE.
*                (X5) = BLOCK WORD COUNT.
*
*         USES   X - 2, 3, 5, 6, 7.
*                A - 3, 5, 6, 7.
*
*         CALLS  ICI, IFP, PSI.
 
 
 CFB      SUBR               ENTRY/EXIT
          SX2    X2-5
          SX1    CIPF
          ZR     X2,CFB1     IF *CIR* TYPE
          SX1    CAPF
 CFB1     SA1    X1
          NZ     X1,CFBX     IF NOT FIRST BLOCK
          SX6    B1          SET FIRST BLOCK FOUND
          SA6    A1+
          BX6    X3
          BX7    X5
          SA6    CFBA        SAVE BLOCK SUB-TYPE
          SA7    CFBB        SAVE WORD COUNT
          NZ     X2,CFB2     IF NOT CIR BLOCK
          RJ     ICI         INITIALIZE CIR OUTPUT
          EQ     CFB4        RESET BLOCK PARAMETERS
 
 CFB2     SA1    CIPF
          ZR     X1,CFB3     IF CIR NOT PROCESSED
          RJ     PSI         PROCESS SORTED CIR OUTPUT
 CFB3     RJ     IFL         INITIALIZE CATALOG OUTPUT
 CFB4     SA3    CFBA        RESTORE SUB-TYPE
          SA5    CFBB        RESTORE WORD COUNT
          EQ     CFBX        RETURN
 
 CFBA     CON    0           BLOCK SUB-TYPE
 CFBB     CON    0           BLOCK WORD COUNT
 PDB      SPACE  4,20
**        PDB - PROCESS DATA BLOCK.
*
*         ENTRY  NON-PERMIT CONTROL WORD READ.
*                (X3) = CONTROL WORD SUB-TYPE.
*                     = -1, IF EOR WAS ENCOUNTERED.
*                (DBUF) = CONTROL WORD.
*
*         EXIT   (X6) .NE. 0, IF READ ERROR OR ARCHIVE FILE ERROR.
*                DATA BLOCK PROCESSED.
*
*         USES   X - 0, 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
*
*         CALLS  PPE, RCW, STE.
*
*         MACROS MESSAGE, READW, RECALL, SETFS, WRITE, WRITEF, WRITER,
*                WRITEW.
 
 
 PDB      SUBR               ENTRY/EXIT
          RECALL FILEA
          BX6    X6-X6       CLEAR EOF FLAG
          SX7    B1          SET FILE PROCESSED FLAG
          SA6    PDBA
          SX6    SSLN        INITIALIZE REMAINING SYSTEM SECTOR LENGTH
          SA6    PDBD
          EQ     PDB2        PROCESS SYSTEM SECTOR
 
*         READ CONTROL WORD.
 
 PDB1     RJ     RCW         READ CONTROL WORD
 PDB2     NG     X3,PDB12    IF EOR
          SA1    DBUF        CHECK DATA CONTROL WORD
          AX1    12
          MX0    -3
          BX1    -X0*X1
          SX1    X1-3
          ZR     X1,PDB5     IF DATA BLOCK
 
*         PROCESS ERROR IN ARCHIVE FILE.
 
 PDB3     SA1    /COMSPFS/UTLC
          SX1    X1-/COMSPFS/RSUT
          ZR     X1,PDB4     IF *PFRES*
          SA1    CATH+FCUI
          SB2    ERAB        * ARCHIVE FILE BLOCK ERROR... *
          RJ     SFE         SEND ERROR MESSAGE
          EQ     PDB4.1      SKIP TAPE ERROR
 
 PDB4     SA5    STRA
          SB2    ERRB        * ARCHIVE FILE BLOCK ERROR... *
          RJ     SRE         SEND ERROR MESSAGE
 PDB4.1   RJ     STE         SKIP TAPE ERROR
          SX6    B1          INDICATE ERROR
          EQ     PDBX        RETURN
 
*         READ DATA.
 
 PDB5     BX0    X3
          BX6    X3          SAVE DATA MARK
          SA6    PDBC
          ZR     X5,PDB10    IF ZERO WORD COUNT
          READW  TAPE,DBUF,X5
          RJ     PPE         PROCESS PARITY ERROR
          NZ     X6,PDBX     IF PARITY ERROR
 
*         SKIP OVER SYSTEM SECTOR.
 
          SA1    PDBD        GET REMAINING SYSTEM SECTOR LENGTH
          SX2    X0-4
          BX6    X1+X2
          ZR     X6,PDB3     IF EXTRA SYSTEM SECTOR (NOT AT BOI)
          ZR     X2,PDB7     IF SYSTEM SECTOR
          ZR     X1,PDB9     IF SYSTEM SECTOR ALREADY PROCESSED
          SX7    X1-SSLN
          NZ     X7,PDB3     IF SYSTEM SECTOR TRUNCATED
          SA7    PDBD        CLEAR REMAINING SYSTEM SECTOR LENGTH
          EQ     PDB9        WRITE DATA SECTOR
 
 PDB7     IX7    X1-X5
          NG     X7,PDB3     IF SYSTEM SECTOR TOO LONG
          SA7    A1          UPDATE REMAINING SYSTEM SECTOR LENGTH
          EQ     PDB1        BYPASS SYSTEM SECTOR
 
*         WRITE DATA.
 
 PDB9     WRITEW FILEA,DBUF,X5
 
*         PROCESS DATA MARK.
 
 PDB10    ZR     X0,PDB1     IF NO DATA MARK
          SX2    X0-4
          ZR     X2,PDB1     IF SYSTEM SECTOR
          SX0    X0-1
          NZ     X0,PDB11    IF END OF FILE
          WRITER FILEA,R
          EQ     PDB1        READ NEXT CONTROL WORD
 
 PDB11    WRITEF FILEA,R
          SX6    B1+         SET EOF FLAG
          SA6    PDBA
          EQ     PDB1        READ NEXT CONTROL WORD
 
*         PROCESS FILES WITH NO EOF.
 
 PDB12    SETFS  FILEA,0     CLEAR SPECIAL FILE STATUS
          SA1    PDBA        CHECK EOF FLAG
          NZ     X1,PDB13    IF EOF FLAG SET
          SA1    PDBC        CHECK LAST DATA MARK
          NZ     X1,PDB13    IF EOR, RETURN
          WRITE  FILEA,R
          SA1    FILEA+2     CHECK FOR EMPTY BUFFER
          SA2    A1+B1
          IX7    X1-X2       IN - OUT
          ZR     X7,PDB13    IF BUFFER FLUSHED, RETURN
          WRITER FILEA,R
 PDB13    BX6    X6-X6       INDICATE NO ERROR
          EQ     PDBX        RETURN
 
 
 PDBA     CON    0           EOF FLAG
 PDBC     CON    0           LAST DATA MARK
 PDBD     CON    0           REMAINING SYSTEM SECTOR LENGTH
 PPB      SPACE  4,20
**        PPB - PROCESS PERMIT BLOCK (*PFCOPY*).
*
*         ENTRY  CATALOG BLOCK PROCESSED.
*
*         EXIT   (X6) .NE. 0, IF PARITY ERROR.
*                PERMIT BLOCK PROCESSED.
*                NON-PERMIT CONTROL WORD READ.
*                (X3) = CONTROL WORD SUB-TYPE.
*                     = -1, IF EOR WAS ENCOUNTERED.
*
*         USES   X - 0, 1, 4, 6.
*                A - 1, 6.
*
*         CALLS  PPE, RCW.
*
*         MACROS READW, RECALL, WRITER, WRITEW.
 
 
 PPB      SUBR               ENTRY/EXIT
          RECALL F
          SX6    B0+         CLEAR PERMIT FLAG
          SA6    PPBA
 
*         CHECK IF PERMIT BLOCK.
 
 PPB1     RJ     RCW         READ CONTROL WORD
          BX0    X3
          SX4    X2-2
          ZR     X4,PPB3     IF PERMIT BLOCK
          SA1    PPBA
          NZ     X1,PPB2     IF PERMITS EXIST
 
*         WRITE ZERO LENGTH RECORD IF PREFACE RECORDS REQUESTED.
 
          SA1    CPAR+/COMSPFS/CPOP
          LX1    59-50
          PL     X1,PPB2     IF NO PREFACE RECORD
          WRITER FILEA,R
 PPB2     BX6    X6-X6       INDICATE NO ERROR
          EQ     PPBX        RETURN
 
*         READ PERMIT INFORMATION.
 
 PPB3     ZR     X5,PPB1     IF ZERO WORD COUNT
          SX6    B1          SET PERMIT FLAG
          SA6    PPBA
          READW  TAPE,DBUF,X5 READ PERMIT BLOCK
          RJ     PPE         PROCESS PARITY ERROR
          NZ     X6,PPBX     IF PARITY ERROR
 
*         WRITE PERMIT PREFACE RECORD.
 
          SA1    CPAR+/COMSPFS/CPOP
          LX1    59-50
          PL     X1,PPB1     IF NO PREFACE RECORD REQUESTED
          WRITEW FILEA,DBUF,X5
          ZR     X0,PPB1     IF NO DATA MARK
          WRITER FILEA,R
          EQ     PPB1        READ NEXT CONTROL WORD
 
 
 PPBA     BSSZ   1           PERMIT FLAG
 RCB      SPACE  4,20
**        RCB - *PFRES* PROCESS CATALOG BLOCK.
*
*         ENTRY  (X3) = CATALOG BLOCK CONTROL WORD SUB-TYPE CODE.
*                (X5) = CATALOG BLOCK WORD COUNT.
*
*         EXIT   (X6) = 0, IF FILE IS TO BE PROCESSED.
*                (CATH) = CATALOG ENTRY FOR FILE.
*                TO *ABT* IF INCORRECT CATALOG SIZE.
*                TO *TER* IF FILE SKIPPED AND NO MORE REQUESTS.
*
*         USES   X - 0, 1, 2, 5, 6.
*                A - 1, 5, 6.
*                B - 2.
*
*         CALLS  ALD, APD, CAR, CSR, DFN, PPE, SEM, SRE, SSR, VCE.
*
*         MACROS RECALL, RETURN, WRITER, WRITEW.
 
 
 RCB      SUBR               ENTRY/EXIT
          SX1    X5-NWCE
          ZR     X1,RCB1     IF CORRECT SIZE CATALOG ENTRY
          SB2    ERIC        * INCORRECT CATALOG SIZE.*
          EQ     ABT         ABORT
 
 RCB1     SX0    X3          SAVE *PFC ONLY* STATUS
          READW  TAPE,CATH,X5  READ CATALOG ENTRY
          RJ     PPE         PROCESS PARITY ERROR
          NZ     X6,RCB3     IF PARITY ERROR ON CATALOG READ
          NZ     X0,RCB4     IF NOT *PFC ONLY* FILE
 
*         SKIP FILE.
 
 RCB2     SA1    CATH        SET FILE NAME AND USER INDEX
          SA2    MSSK        *SKIPPING ...*
          RJ     DFN         DISPLAY MESSAGE
          RJ     SER         SKIP TO EOR
          RJ     CAR         CHECK FOR ADDITIONAL STAGE REQUESTS
          ZR     X6,TER      IF NO REQUESTS REMAIN TO BE PROCESSED
 RCB3     SX6    B1          INDICATE THAT FILE IS NOT TO BE PROCESSED
          EQ     RCBX        RETURN
 
*         CHECK IF FILE IS TO BE STAGED.
 
 RCB4     RJ     CSR         CHECK FOR STAGE REQUEST FOR THIS FILE
          ZR     X6,RCB2     IF NO STAGE REQUEST FOR THIS FILE
          RJ     VCE         VERIFY CATALOG ENTRY FIELDS
          NZ     X6,RCB2     IF ACTIVE PFC DOES NOT MATCH PFC ON TAPE
 
*         SET UP TO STAGE FILE.
 
          SX6    1
          SA6    FPRF        SET FILE PROCESSING FLAG
          RJ     SSR         SETUP *PFM* SPECIAL REQUEST BLOCK
          SA1    CATH+FCBS
          LX1    59-11
          PL     X1,RCB5     IF INDIRECT ACCESS FILE
          RJ     APD         ASSIGN PERMANENT FILE DEVICE
          ZR     X6,RCB7     IF DEVICE ASSIGNED
          EQ     RCB6        PROCESS NO DEVICE FOUND
 
 RCB5     RJ     ALD         ASSIGN LOCAL FILE DEVICE
          ZR     X6,RCB7     IF DEVICE ASSIGNED
 RCB6     SA5    STRA
          SB2    ERRA        * NO DEVICE FOR FILE ACCESS LEVEL ...*
          RJ     SRE         SEND ERROR MESSAGE
          EQ     RCB2        SKIP FILE
 
*         SET *RESTORING FN UI* MESSAGE.
 
 RCB7     SA1    STRA        SET FILE NAME AND USER INDEX
          SA1    X1+2
          SA2    MSRS        *RESTORING ...*
          RJ     DFN         DISPLAY MESSAGE
          BX6    X6-X6       INDICATE THAT FILE IS TO BE PROCESSED
          EQ     RCBX        RETURN
 RCW      SPACE  4,25
**        RCW - READ CONTROL WORD.
*
*         EXIT   (X2) = CONTROL WORD TYPE.
*                (X3) = CONTROL WORD SUB-TYPE.
*                     = -1, IF EOR.
*                (DBUF) = CONTROL WORD.
*                (X5) = WORD COUNT.
*                TO *EAF* IF END OF DUMP CONTROL WORD.
*                TO *CUP* IF PARITY ERROR.
*                TO *ABT* IF EOF BEFORE END OF DUMP CONTROL WORD.
*
*         USES   X - 0, 1, 2, 3, 5.
*                A - 1.
*                B - 2.
*
*         CALLS  PPE.
*
*         MACROS MESSAGE, READ, READW.
 
 
 RCW      SUBR               ENTRY/EXIT
          READW  TAPE,DBUF,B1
          RJ     PPE         PROCESS PARITY ERROR
          NZ     X6,CUP      IF PARITY ERROR
          SB2    ERPE        * PREMATURE EOF DETECTED.*
          NG     X1,ABT      IF EOF
          ZR     X1,RCW1     IF NOT EOR
 
*         PROCESS END OF RECORD.
 
          READ   TAPE
          RJ     PPE         PROCESS PARITY ERROR
          SX3    -1          SET EOR
          ZR     X6,RCWX     IF NO PARITY ERROR
          EQ     CUP         CALL UTILITY PROCESSOR
 
*         BREAK UP CONTROL WORD.
 
 RCW1     SA1    DBUF        BREAK APART CONTROL WORD
          MX0    -9
          BX5    -X0*X1      MASK OFF WORD COUNT
          AX0    6
          AX1    9
          BX3    -X0*X1      MASK OFF SUB-TYPE CODE
          AX1    3
          BX2    -X0*X1      MASK OFF TYPE CODE
          SX1    X2-7
          ZR     X1,EAF      IF END OF ARCHIVE FILE CONTROL WORD
          EQ     RCWX        RETURN
 VPD      SPACE  4,20
**        VPD - VERIFY PERMIT AND DATA BLOCKS.
*
*         ENTRY  CATALOG ENTRY IN *CATH*.
*
*         EXIT   PERMIT OR DATA ERROR FLAGS SET IN *FLST* IF ERROR
*                  BLOCKS PRESENT ON ARCHIVE FILE.
*                ERROR MESSAGES ISSUED IF FILE PERMITS OR DATA
*                  UNREADABLE OR LOGIGAL ERROR IN PERMIT OR DATA
*                  BLOCKS.
*
*         USES   X - 1, 2, 4, 6, 7.
*                A - 1, 2, 6, 7.
*
*         CALLS  RCW, SFE, STE.
*
*         MACROS READW.
 
 
 VPD      SUBR               ENTRY/EXIT
 
*         CHECK CONSISTENCY OF PFC AND PERMITS BLOCKS.
 
          RJ     RCW         READ CONTROL WORD
          SA1    CATH+FCRI   GET PERMITS RANDOM INDEX
          SX7    X2-2        CHECK FOR PERMITS BLOCK
          MX6    -24
          LX1    24
          BX1    -X6*X1
          NZ     X1,VPD1     IF PERMITS IN CATALOG
          NG     X3,VPD4     IF EOR ON ARCHIVE FILE
          NZ     X7,VPD4     IF NOT PERMITS BLOCK
          EQ     VPD9        PROCESS ARCHIVE FILE ERROR
 
 VPD1     NG     X3,VPD9     IF EOR ON ARCHIVE FILE
          NZ     X7,VPD9     IF NOT PERMITS BLOCK
 
*         CHECK FOR ERROR STATUS IN PERMITS BLOCKS.
 
 VPD2     SA1    DBUF
          MX6    -3
          LX1    -15
          BX6    -X6*X1
          ZR     X6,VPD3     IF NOT ERROR BLOCK
          SA1    FLST        SET PERMIT ERROR IN FILE STATUS
          SX6    4
          BX6    X1+X6
          SA6    A1
 VPD3     READW  TAPE,DBUF,X5  READ PERMITS BLOCK
          RJ     PPE         PROCESS PARITY ERROR
          NZ     X6,VPDX     IF PARITY ERROR
          RJ     RCW         READ NEXT CONTROL WORD
          NG     X3,VPD4     IF EOR ON ARCHIVE FILE
          SX7    X2-2
          ZR     X7,VPD2     IF PERMITS BLOCK
 
*         CHECK CONSISTENCY OF PFC AND DATA BLOCKS.
 
 VPD4     SA1    FLST        GET *PFC ONLY* FLAG
          LX1    59-0
          PL     X1,VPD5     IF NOT *PFC ONLY* FILE
          NG     X3,VPDX     IF EOR ON ARCHIVE FILE
          EQ     VPD9        PROCESS ARCHIVE FILE ERROR
 
 VPD5     NG     X3,VPD9     IF EOR ON ARCHIVE FILE
          SX7    X2-3
          NZ     X7,VPD9     IF NOT DATA BLOCK
 
*         CHECK FOR ERROR STATUS IN DATA BLOCKS.
 
 VPD6     SA1    DBUF
          SA2    VPDA
          MX6    42
          MX7    -3
          BX6    X6*X1
          LX1    -15
          BX6    X6-X2
          BX7    -X7*X1      EXTRACT ERROR TYPE
          NZ     X6,VPD8     IF NOT ERROR BLOCK
          SA1    FLST
          SX6    10B         SET TRUNCATED FILE
          ZR     X7,VPD7     IF TRUNCATED FILE ERROR
          SX6    2           SET ERROR IN DATA
 VPD7     BX6    X1+X6
          SA6    FLST
 VPD8     READW  TAPE,DBUF,X5  READ DATA BLOCK
          RJ     PPE         PROCESS PARITY ERROR
          NZ     X6,VPDX     IF PARITY ERROR
          RJ     RCW         READ NEXT CONTROL WORD
          NG     X3,VPDX     IF EOR ON ARCHIVE FILE
          SX7    X2-3
          ZR     X7,VPD6     IF DATA BLOCK
 
*         PROCESS ARCHIVE FILE ERROR.
 
 VPD9     BX7    X3          SAVE EOR STATUS
          SA7    VPDB
          SA1    CATH+FCUI
          SB2    ERAB        * ARCHIVE FILE BLOCK ERROR ...*
          RJ     SFE         SEND ERROR MESSAGE
          SA3    VPDB
          NG     X3,VPDX     IF EOR ON ARCHIVE FILE
          RJ     STE         SKIP TO END OF RECORD
          EQ     VPDX        RETURN
 
 
 VPDA     VFD    42/7LERROR**,18/0
 VPDB     CON    0           ARCHIVE FILE EOR STATUS
          TITLE  GENERAL SUBROUTINES.
 APR      SPACE  4,15
**        APR - ABORT PROCESSOR.
*
*         ENTRY  CONTROL POINT OR PROGRAM FATAL ERROR DETECTED.
*
*         EXIT   FILES RETURNED (*PFRES*).
*                UNPROCESSED STAGE REQUESTS FOR THIS VSN REQUEUED
*                  (*PFRES).
*
*         USES   X - 1.
*                A - 1.
*
*         CALLS  CAR, RUR, /MTX/TCM.
*
*         MACROS RETURN.
 
 
 APR      SUBR   0           ENTRY/EXIT
          SA1    /COMSPFS/UTLC
          SX1    X1-/COMSPFS/RSUT
          NZ     X1,APRX     IF NOT *PFRES*
 
*         PROCESS *PFRES* ABORT.  GET ANY ADDITIONAL STAGE REQUESTS FOR
*         THIS VSN FROM *MAGNET*, THEN TERMINATE CONNECTION AND REQUEUE
*         UNPROCESSED REQUESTS.
 
 APR1     RJ     CAR         GET ADDITIONAL REQUESTS FOR THIS VSN
          GT     B6,B0,APR1  IF ADDITIONAL REQUEST FOUND
          RJ     /MTX/TCM    TERMINATE CONNECTION WITH *MAGNET*
          RJ     RUR         REQUEUE UNPROCESSED STAGE REQUESTS
          RETURN F,R         RETURN LOCAL FILE
          RETURN T,R         RETURN TAPE
          SA1    SRFF
          ZR     X1,APRX     IF STAGE REQUEST FILE NOT ATTACHED
          RETURN R,R         RETURN STAGE REQUEST FILE
          EQ     APRX        RETURN
 ALD      SPACE  4,15
**        ALD - ASSIGN LOCAL FILE DEVICE.
*
*         ENTRY  (CATH) = PFC ENTRY.
*                (SYSS) = SYSTEM SECURITY MODE.
*
*         EXIT   (X6) = 0, IF DEVICE FOUND FOR FILE.
*
*         USES   X - 0, 1, 6.
*                A - 1.
*
*         CALLS  SAF.
*
*         MACROS RECALL, REQUEST, SETFET.
 
 
 ALD      SUBR               ENTRY/EXIT
          RECALL F
          SX6    B0+         SET NO ERROR
          SA1    SYSS
          ZR     X1,ALDX     IF NOT SECURED SYSTEM
          RJ     SAF         SET ACCESS LEVEL IN FET
          SETFET F,ERP=E,DTY==2RMS  SET ERROR PROCESSING, DEVICE TYPE
          REQUEST  F,U,N
          SETFET F,ERP=0     CLEAR ERROR PROCESSING
          SA1    F           RETURN ERROR STATUS
          LX1    -10
          MX0    -8
          BX6    -X0*X1
          EQ     ALDX        RETURN
 APD      SPACE  4,15
**        APD - ASSIGN PERMANENT FILE DEVICE.
*
*         ENTRY  (CATH) = PFC ENTRY.
*                (SYSS) = SYSTEM SECURITY MODE.
*
*         EXIT   (X6) = 0, IF DEVICE FOUND FOR FILE.
*
*         USES   X - 0, 1, 6.
*                A - 1.
*
*         CALLS  SAF.
*
*         MACROS ASSIGNPF, RECALL, SETFET.
 
 
 APD      SUBR               ENTRY/EXIT
          RECALL F
          SA1    SYSS
          ZR     X1,APD1     IF NOT SECURED SYSTEM
          RJ     SAF         SET ACCESS LEVEL IN FET
 APD1     SETFET F,ERP=UE,DTY=0 SET ERROR PROCESSING, CLEAR DEVICE TYPE
          SX6    SRSY*10000B *SET SYSTEM SECTOR* SPECIAL REQUEST
          SA6    F+8
          ASSIGNPF  F
          SETFET F,ERP=0     CLEAR ERROR PROCESSING
          BX6    X6-X6       CLEAR SPECIAL REQUEST
          SA6    F+8
          SA1    F           RETURN ERROR STATUS
          LX1    -10
          MX0    -8
          BX6    -X0*X1
          EQ     APDX        RETURN
 ARQ      SPACE  4,15
**        ARQ - ADD STAGE REQUEST TO QUEUE.
*
*         ENTRY  (B6) = FWA OF REQUEST TO ENTER.
*
*         EXIT   STAGE REQUEST ADDED TO QUEUE, IF NOT DUPLICATE.
*                FIELD LENGTH INCREASED IF NECESSARY.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 5, 7.
*
*         MACROS MEMORY, MOVE.
 
 
 ARQ      SUBR               ENTRY/EXIT
          SA3    SRQL
          SA2    SRQF
          SB7    X3+B1       VSN / SEQUENCE NUMBER WORD OF QUEUE ENTRY
          SA4    B6+B1       VSN / SEQUENCE NUMBER OF NEW REQUEST
          SB5    /MTX/PFTBL  LENGTH OF STAGE REQUEST
          MX0    -42
 ARQ1     SB7    B7-B5       CHECK PREVIOUS ENTRY
          NG     B7,ARQ2     IF NO MORE ENTRIES
          SA1    X2+B7
          BX6    X1-X4
          BX6    -X0*X6
          NZ     X6,ARQ1     IF VSN / SEQUENCE NUMBER DO NOT MATCH
          EQ     ARQX        DUPLICATE REQUEST (IGNORE)
 
 ARQ2     IX3    X2+X3       ADD REQUEST TO QUEUE
          MOVE   B5,B6,X3
          SA1    SRQN        UPDATE NUMBER OF ENTRIES
          SX6    X1+B1
          SA6    A1
          SA1    SRQL        UPDATE LENGTH
          SX6    X1+B5
          SA6    A1
          SA1    SRQF        CHECK REMAINING AVAILABLE MEMORY
          SX6    X6+2*/MTX/PFTBL+8
          IX1    X1+X6
          SA2    MSTAT
          AX2    30
          IX3    X2-X1
          PL     X3,ARQX     IF ENOUGH MEMORY FOR TWO MORE REQUESTS
          MEMORY CM,MSTAT,R,X1+MEMI  INCREASE FIELD LENGTH
          EQ     ARQX        RETURN
 CAR      SPACE  4,15
**        CAR - CHECK FOR ADDITIONAL STAGE REQUESTS.
*
*         CALLS *GSR* IF FOUR SECONDS HAVE ELAPSED SINCE LAST CALL,
*         OR IF NO MORE REQUESTS REMAIN TO BE PROCESSED.
*
*         EXIT   (B6) .GT. 0, IF NEW REQUEST FOUND.
*                (X6) = 0, IF NO REQUESTS LEFT TO PROCESS.
*
*         USES   X - 1, 2, 3, 6.
*                A - 1, 2, 6.
*
*         CALLS  ARQ, GSR.
*
*         MACROS RTIME.
 
 
 CAR2     SA1    NSSR        RETURN NUMBER OF REQUESTS LEFT TO PROCESS
          SA2    SRQN
          IX6    X2-X1
 
 
 CAR      SUBR               ENTRY/EXIT
          SA1    NSSR        NUMBER OF REQUESTS SELECTED
          SA2    SRQN        NUMBER OF ENTRIES IN TABLE
          IX1    X2-X1       NUMBER OF FILES YET TO BE PROCESSED
          ZR     X1,CAR1     IF ALL FILES PROCESSED (IMMEDIATE CHECK)
          RTIME  CARA+1      GET CURRENT TIME
          SA1    CARA
          SA2    CARA+1
          IX1    X2-X1
          AX1    36
          SX3    X1-4
          BX6    X2
          NG     X3,CARX     IF NOT 4 SECONDS SINCE LAST *GSR* CALL
          SA6    A1          UPDATE TIME
 CAR1     RJ     /MTX/GSR    SEE IF MORE REQUESTS
          LE     B6,B0,CAR2  IF NO REQUESTS
          RJ     ARQ         ADD REQUEST
          EQ     CAR1        GET NEXT REQUEST
 
 
 CARA     BSSZ   2           ENTRY TIME VALUES
 CFC      SPACE  4,10
**        CFC - CHECK FILES PROCESSED COUNT.
*
*         EXIT   TO CALLER IF NO FILE SELECTIONS OR ALL SELECTED FILES
*                  NOT PROCESSED.
*                TO *TER* IF ALL SELECTED FILES PROCESSED.
*
*         USES   X - 1, 2.
*                A - 1, 2.
 
 
 CFC      SUBR               ENTRY/EXIT
          SA1    /COMSPFS/FISP
          SA2    /COMSPFS/NFIS
          ZR     X1,CFCX     IF NO USER INDEX/FILE NAME SELECTIONS
          NZ     X2,CFCX     IF ALL SPECIFIED FILES NOT PROCESSED
          EQ     TER         TERMINATE
 CLC      SPACE  4,15
**        CLC - CONNECT LOCAL FILE TO CATALOG ENTRY.
*
*         EXIT   (X6) .NE. 0, IF ERROR.
*
*         USES   X - 1, 5, 6.
*                A - 1, 5.
*
*         CALLS  SRE.
*
*         MACROS MESSAGE, RECALL, ROLLOUT, SETDA, SETFET, UREPLAC.
 
 
 CLC7     SETFET F,ERP=0     CLEAR ERROR PROCESSING
          BX6    X6-X6       INDICATE NO ERROR
 
 
 CLC      SUBR               ENTRY/EXIT
          SETFET F,ERP=UE    SET *EP* AND *UP*
 CLC1     SA1    CATH+FCBS
          LX1    59-11
          PL     X1,CLC2     IF INDIRECT ACCESS FILE
          SETDA  F           SET DISK ADDRESS FOR DIRECT ACCESS FILE
          EQ     CLC3        CHECK *PFM* STATUS
 
 CLC2     UREPLAC  F         UTILITY-REPLACE INDIRECT ACCESS FILE
          RECALL X2
 CLC3     SA1    X2          CHECK FOR *PFM* ERROR
          MX6    -8
          LX1    -10
          BX6    -X6*X1
          ZR     X6,CLC7     IF NO ERROR
 
*         PFM ERROR ENCOUNTERED.  IF ERROR IS THE RESULT OF SYSTEM
*         ACTIVITY, DELAY AND RETRY.  IF ERROR COULD BE THE RESULT
*         OF THE USER MODIFYING OR DELETING THE FILE, ABANDON STAGE
*         WITH NO MESSAGE.  OTHERWISE, ISSUE ERROR MESSAGE AND
*         ABANDON STAGE.
 
 CLC4     SX1    X6-/ERRMSG/INA
          ZR     X1,CLC5     IF *INTERLOCK NOT AVAILABLE*
          SX1    X6-/ERRMSG/PFA
          ZR     X1,CLC6     IF *PF UTILITY ACTIVE*
          SX1    X6-/ERRMSG/FNF
          ZR     X1,CLC7     IF *FILE NOT FOUND*
          SX1    X6-/ERRMSG/ICU
          ZR     X1,CLC7     IF *INVALID CATALOG UPDATE*
          SX1    X6-/ERRMSG/PVE
          ZR     X1,CLC7     IF *PFC VERIFICATION ERROR*
          SA5    STRA        SET STAGE REQUEST ADDRESS
          SB2    ERPF        * PFM ERROR ENCOUNTERED ...*
          RJ     SRE         SEND ERROR MESSAGE
          MESSAGE  EMBF,,R   SEND *PFM* ERROR MESSAGE TO SYSTEM DAYFILE
          SX6    B1          INDICATE ERROR
          EQ     CLCX        RETURN ERROR STATUS
 
*         PROCESS *INTERLOCK NOT AVAILABLE.*
 
 CLC5     RECALL             GIVE UP CPU
          EQ     CLC1        TRY AGAIN
 
*         PROCESS *PF UTILITY ACTIVE.*
 
 CLC6     ROLLOUT            WAIT FOR UTILITY
          RECALL
          EQ     CLC1        TRY AGAIN
 CSP      SPACE  4,25
**        CSP - CHECK SELECTION PARAMETERS.
*
*         ENTRY  (X3) = CATALOG BLOCK CONTROL WORD SUB-TYPE CODE.
*                (X5) = CATALOG BLOCK WORD COUNT.
*
*         EXIT   (X6) .NE. 0 IF FILE TO BE PROCESSED.
*                CATALOG ENTRY CONVERTED TO 16 WORD FORMAT IF 8 WORD
*                  FORMAT.
*                (FLST) = 0 IF NOT *PFC* ONLY FILE
*                (FLST) = 59/0, 1/1 IF *PFC ONLY* FILE.
*                (NFIS) = UPDATED FILE SELECTION COUNT.
*                TO *CUP* IF PARITY ERROR ON CATALOG READ.
*                TO *EAF* IF ALL SELECTED FILES PROCESSED.
*
*         USES   X - 1, 2, 4, 5, 6, 7.
*                A - 1, 2, 5, 6, 7.
*
*         CALLS  CCE, CSC, PPE.
*
*         MACROS READW.
 
 
 CSP      SUBR               ENTRY/EXIT
          BX6    X6-X6
          NZ     X3,CSP1     IF NOT *PFC ONLY* FILE
          SX6    B1          SET *PFC ONLY* FILE FLAG
 CSP1     SA6    FLST        INITIALIZE FILE STATUS
          BX6    X5          SAVE WORD COUNT
          SA6    CSPA
          READW  TAPE,CATH,X5  READ CATALOG ENTRY
          RJ     PPE         PROCESS PARITY ERROR
          NZ     X6,CUP      IF PARITY ERROR ON CATALOG READ
 
*         CHECK FORMAT OF CATALOG ENTRY.
 
          SA5    CSPA        RESTORE WORD COUNT
          SX1    X5-NWCE
          ZR     X1,CSP2     IF CORRECT SIZE CATALOG ENTRY
          SX4    CATH
          RJ     CCE         CONVERT CATALOG ENTRY TO 16 WORD FORMAT
 
*         CHECK SELECTIVE PARAMETERS.
 
 CSP2     SA5    MXDC
          SA1    CATH+FCUI
          ZR     X5,CSP3     IF NO DEVICE POSITION INFORMATON
          MX2    -3
          BX2    -X2*X1      SUBFAMILY INDEX
          SA2    SFDT+X2
          LX1    -3
          SX6    X2+         CATALOG TRACK MASK
          BX2    -X6*X2      ARCHIVE FILE DEVICE ORDINAL
          BX1    X6*X1       CATALOG TRACK
          BX6    X2+X1
          IX6    X5-X6
          NG     X6,EAF      IF BEYOND HIGHEST SELECTED USER INDEX
 CSP3     SB4    CATH        SET CATALOG ADDRESS
          RJ     CSC         CHECK SELECTION CRITERIA
          ZR     X6,CSPX     IF FILE NOT TO BE PROCESSED
          ZR     B6,CSPX     IF FILE NAME NOT FOUND
          SA1    B6+         READ FILE NAME SELECTION
          SA2    /COMSPFS/NFIS
          SX7    B1
          LX7    17-0
          BX7    X1+X7       MARK FILE NAME FOUND
          SA7    A1
          SX7    X2-1        DECREMENT SELECTION COUNT
          SA7    A2+
          EQ     CSPX        RETURN
 
 
 CSPA     BSS    1           SAVE AREA FOR WORD COUNT
 CSR      SPACE  4,15
**        CSR - CHECK FOR STAGE REQUEST FOR THIS FILE.
*
*         ENTRY  (CATH) = CATALOG ENTRY FOR CURRENT FILE ON TAPE.
*
*         EXIT   (X6) = 0, IF NO STAGE REQUEST FOUND FOR THIS FILE.
*                (X6) = (STRA) = ADDRESS OF STAGE REQUEST, IF FOUND.
*                (NSSR) INCREMENTED IF STAGE REQUEST FOUND.
*
*         USES   X - 0, 1, 2, 3, 6.
*                A - 1, 2, 3, 6.
*                B - 4, 5.
 
 
 CSR      SUBR               ENTRY/EXIT
          SA1    SRQF
          SA2    SRQL
          SA3    CATH+FCTV   VSN / SEQUENCE NUMBER OF FILE ON TAPE
          SB4    X1
          SB5    X2
          MX0    -42
          BX6    X6-X6
 CSR1     SB5    B5-/MTX/PFTBL  CHECK PREVIOUS ENTRY
          NG     B5,CSRX     IF ALL ENTRIES CHECKED
          SA1    B4+B5
          ZR     X1,CSR1     IF ENTRY ALREADY PROCESSED
          SA2    A1+B1       VSN / SEQUENCE NUMBER FROM STAGE REQUEST
          NG     X2,CSR1     IF ENTRY ALREADY SELECTED
          BX7    X2-X3
          BX7    -X0*X7
          NZ     X7,CSR1     IF NOT A MATCH
          MX7    1           SET *ENTRY ALREADY SELECTED* FLAG
          BX7    X2+X7
          SA7    A2
          SA2    NSSR        INCREMENT NUMBER OF REQUESTS SELECTED
          SX7    X2+B1
          SA7    A2
          SX6    A1          SAVE ADDRESS OF STAGE REQUEST
          SA6    STRA
          EQ     CSRX        RETURN
 IFM      SPACE  4,10
**        IFM - ISSUE FILE COUNT MESSAGES.
*
*         EXIT   FILE COUNT MESSAGES ISSUED TO DAYFILE.
*
*         USES   X - 1, 5, 6.
*                A - 1, 5.
*
*         CALLS  IFC.
 
 
 IFM      SUBR               ENTRY/EXIT
          SA1    /COMSPFS/UTLC
          SA5    IFMC
          SX6    X1-/COMSPFS/RSUT
          ZR     X6,IFM1     IF *PFRES*
          SA5    IFMB
          SX6    X1-/COMSPFS/COUT
          ZR     X6,IFM1     IF *PFCOPY*
          SA5    IFMA
 IFM1     RJ     IFC         ISSUE FILE COUNT MESSAGES
          EQ     IFMX        RETURN
 
 
 IFMA     BSS    0           *PFATC* MESSAGE TABLE
          VFD    1/1,1/1,22/0,18/MSFA,18/PRFC
          CON    0           END OF TABLE
 
 IFMB     BSS    0           *PFCOPY* MESSAGE TABLE
          VFD    1/1,1/1,22/0,18/MSFO,18/PRFC
          CON    0           END OF TABLE
 
 IFMC     BSS    0           *PFRES*  MESSAGE TABLE
          VFD    1/1,1/1,22/0,18/MSFR,18/PRFC
          CON    0           END OF TABLE
 ISM      SPACE  4,20
**        ISM - ISSUE STATISTICAL MESSAGE.
*
*         ENTRY  (X5) = FWA OF STAGE REQUEST.
*                (B5) = NEGATIVE ADDRESS OF MESSAGE TEMPLATE.
*
*         EXIT   MESSAGE ISSUED TO ACCOUNT FILE.
*
*         USES   X - 0, 1, 6.
*                A - 1.
*                B - 2, 3, 5.
*
*         CALLS  CDD, COD, SNM.
*
*         MACROS MESSAGE.
 
 
 ISM      SUBR               ENTRY/EXIT
          SA1    X5+2        GET PERMANENT FILE NAME
          MX0    42
          BX1    X0*X1
          SB3    ISMB
          SB2    1R#
          RJ     SNM         SET PERMANENT FILE NAME INTO MESSAGE
          SA1    X5+2        GET USER INDEX
          BX1    -X0*X1
          RJ     COD         CONVERT TO OCTAL DISPLAY
          SB2    B2-B1
          MX1    1           GENERATE CHARACTER MASK
          AX1    B2
          BX1    X1*X4       REMOVE SPACES SPACES
          SB5    ISMB
          SB2    1R$
          RJ     SNM         SET USER INDEX INTO MESSAGE
          SA1    X5+4        GET FAMILY/PACK NAME
          BX1    X0*X1
          SB2    1R&
          RJ     SNM         SET FAMILY/PACK NAME INTO MESSAGE
          SA1    SVSN        GET VSN
          SB2    1R-
          RJ     SNM         SET VSN INTO MESSAGE
          SA1    X5+7        GET RETRY COUNT
          AX1    36
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          MX0    -6          MASK TO ONE DIGIT
          BX1    -X0*X6
          LX1    -6          LEFT JUSTIFY
          SB2    1R=
          RJ     SNM         SET RETRY COUNT INTO MESSAGE
          MESSAGE  ISMB,5,R  ISSUE STATISTICAL MESSAGE TO ACCOUNT FILE
          EQ     ISMX        RETURN
 
 
 ISMA     DATA   C*STES, #######, $$$$$$, &&&&&&&, ------, =.*
*         DATA   C*STES, FILENAM, USERIN, FAMPACK, VSNVSN, R.*
 ISMAL    EQU    *-ISMA      LENGTH OF MESSAGE
 ISMB     BSS    ISMAL       MESSAGE ASSEMBLY BUFFER
 ISMC     DATA   C*STAS, #######, $$$$$$, &&&&&&&, ------, =.*
*         DATA   C*STAS, FILENAM, USERIN, FAMPACK, VSNVSN, R.*
          ERRNZ  *-ISMC-ISMAL  MESSAGE TEMPLATES MUST BE SAME LENGTH
 PPE      SPACE  4,20
**        PPE - PROCESS PARITY ERROR.
*
*         ENTRY  WHENEVER INPUT FILE IS READ.
*                (STRA) = ADDRESS OF STAGE REQUEST, IF STAGING FILE.
*
*         EXIT   (X6) = NON-ZERO, IF PARITY ERROR.
*
*         USES   X - 1, 3, 5, 6.
*                A - 1, 3, 5, 6.
*
*         CALLS  SFE, SRE, STE.
 
 
 PPE      SUBR               ENTRY/EXIT
          BX6    X6-X6
          SA3    TAPE
          LX3    59-11
          PL     X3,PPEX     IF NO ERROR
          SA1    FPRF
          ZR     X1,PPE2     IF NO FILE BEING PROCESSED
          SA1    /COMSPFS/UTLC
          SX1    X1-/COMSPFS/RSUT
          ZR     X1,PPE1     IF *PFRES*
          SA1    CATH+FCUI
          SB2    ERAR        * ARCHIVE FILE READ ERROR ...*
          RJ     SFE         SEND ERROR MESSAGE
          EQ     PPE2        SKIP TAPE ERROR
 
 PPE1     SA5    STRA        SET STAGE REQUEST ADDRESS
          SB2    ERRR        * ARCHIVE FILE READ ERROR ...*
          RJ     SRE         SEND ERROR MESSAGE
          SA1    STRA
          SA1    X1+7        SET *SELECT BACKUP VSN* BIT
          SX6    B1
          LX6    39-0
          BX6    X1+X6
          SA6    A1
 PPE2     RJ     STE         SKIP TAPE ERROR
          SX6    B1
          EQ     PPEX        RETURN
 RIP      SPACE  4,10
**        RIP - REPRIEVE INTERRUPT PROCESSOR.
*
*         EXIT   BUSY FETS SET COMPLETE TO ALLOW TERMINATION
*                  PROCESSING.
*
*         MACROS COMPFET.
 
 
 RIP      SUBR               ENTRY/EXIT
          SA1    /COMSPFS/UTLC
          SX1    X1-/COMSPFS/RSUT
          ZR     X1,RIP1     IF *PFRES*
          COMPFET  (O,SU)
          EQ     RIPX        RETURN
 
 RIP1     COMPFET  (F,T,R)
          EQ     RIPX        RETURN
 RUR      SPACE  4,20
**        RUR - REQUEUE UNPROCESSED STAGE REQUESTS.
*
*         EXIT   UNPROCESSED STAGE REQUESTS REQUEUED.
*                STAGE REQUESTS AT RETRY LIMIT ABANDONED, WITH
*                  ACCOUNT FILE AND DAYFILE/ERRLOG MESSAGES ISSUED.
*
*         USES   X - 1, 2, 5, 6, 7.
*                A - 1, 2, 6.
*                B - 5.
*
*         CALLS  ISM, /MTX/RSR, SEM.
 
 
 RUR      SUBR               ENTRY/EXIT
          SA1    SRQL        SET UP INDEX
          BX6    X1
          SA6    RURA
 RUR1     SA1    RURA        CHECK PREVIOUS ENTRY
          SX6    X1-/MTX/PFTBL
          SA6    A1
          NG     X6,RURX     IF NO MORE ENTRIES TO CHECK
          SA2    SRQF
          IX2    X2+X6
          SA1    X2          GET ENTRY
          ZR     X1,RUR1     IF ENTRY NOT UNPROCESSED
          SA2    A1+B1       CLEAR *REQUEST SELECTED* FLAG IN ENTRY
          MX6    -59
          BX6    -X6*X2
          SA6    A2
          SA2    A1+7        CHECK RETRY COUNT
          MX6    -3
          LX2    -36
          BX6    -X6*X2
          SX7    X6-/MTX/SRRM
          NG     X7,RUR2     IF MORE RETRIES ALLOWED
          SB5    -ISMC       ISSUE *STAS* MESSAGE TO ACCOUNT FILE
          SX5    A1          SET STAGE REQUEST ADDRESS
          RJ     ISM
          SB2    ERSA        * STAGE ABANDONED ...*
          RJ     SRE         SEND ERROR MESSAGE
          EQ     RUR1        CHECK NEXT QUEUE ENTRY
 
 RUR2     SX7    X6-7
          ZR     X7,RUR3     IF RETRY COUNT ALREADY AT MAXIMUM
          SX6    B1          INCREMENT RETRY COUNT
          IX6    X2+X6
          LX6    36
          SA6    A2
 RUR3     RJ     /MTX/RSR    REQUEUE STAGE REQUEST
          EQ     RUR1        CHECK NEXT QUEUE ENTRY
 
 
 RURA     CON    0           INDEX OF CURRENT ENTRY
 SAF      SPACE  4,10
**        SAF - SET ACCESS LEVEL IN FET.
*
*         ENTRY  (CATH) = CATALOG ENTRY FOR FILE (FROM TAPE).
*                (STRA) = ADDRESS OF STAGE REQUEST FOR FILE (*PFRES*).
*
*         EXIT   ACCESS LEVEL SET IN FET.
*
*         USES   X - 0, 1, 2, 6.
*                A - 1, 2, 6.
 
 
 SAF      SUBR               ENTRY/EXIT
          SA2    CATH+FCAL   GET ACCESS LEVEL FROM CATALOG ENTRY
          SA1    /COMSPFS/UTLC  CHECK UTILITY CODE
          SX1    X1-/COMSPFS/RSUT
          NZ     X1,SAF1     IF NOT *PFRES*
          SA1    STRA        GET ACCESS LEVEL FROM STAGE REQUEST
          SA2    X1
          LX2    36-51
 SAF1     MX0    -3
          LX0    36
          BX2    -X0*X2      FILE ACCESS LEVEL
          SA1    F+4
          BX1    X0*X1
          BX6    X1+X2       SET ACCESS LEVEL IN FET
          SA6    A1
          EQ     SAFX        RETURN
 SER      SPACE  4,10
**        SER - SKIP TO EOR.
*
*         EXIT   ARCHIVE FILE POSITIONED AT PHYSICAL EOR.
*
*         CALLS  PPE, RCW.
*
*         MACROS SKIPW.
 
 
 SER      SUBR               ENTRY/EXIT
 SER1     RJ     RCW         READ CONTROL WORD
          NG     X3,SERX     IF EOR
          ZR     X5,SER1     IF ZERO WORD COUNT
          SKIPW  TAPE,X5     SKIP WORDS
          RJ     PPE         PROCESS PARITY ERROR
          ZR     X6,SER1     IF NO ERROR
          EQ     SERX
 SRE      SPACE  4,15
**        SRE - SEND STAGE REQUEST ERROR MESSAGE.
*
*         ENTRY  (X5) = STAGE REQUEST ADDRESS.
*                (B2) = ERROR MESSAGE SKELETON ADDRESS.
*
*         EXIT   MESSAGE ISSUED.
*
*         USES   X - 1, 6.
*                A - 1.
*                B - 2, 5.
*
*         CALLS  SEM, SFU, SNM.
 
 
 SRE      SUBR               ENTRY/EXIT
          SA1    X5+2        GET FILE NAME AND USER INDEX
          RJ     SFU         SET FILE NAME AND USER INDEX IN MESSAGE
          SA1    X5+4
          MX6    42
          BX1    X6*X1       FAMILY NAME
          SB2    1R+
          SB5    MSGB
          RJ     SNM         SET FAMILY NAME IN MESSAGE
          SB2    MSGB        SET MESSAGE ADDRESS
          RJ     SEM         SEND ERROR MESSAGE
          EQ     SREX        RETURN
 SSR      SPACE  4,10
**        SSR - SETUP *PFM* SPECIAL REQUEST BLOCK.
*
*         ENTRY  (STRA) = ADDRESS OF STAGE REQUEST ENTRY.
*
*         EXIT   *PFM* SPECIAL REQUEST BLOCK BUILT.
*
*         USES   X - 1, 3, 6, 7.
*                A - 1, 3, 6.
 
 
 SSR      SUBR               ENTRY/EXIT
          SA3    STRA        GET STAGE REQUEST
          SA1    X3          SET PEO, DN, TRACK AND SECTOR
          MX6    -32
          BX6    -X6*X1
          SA6    SRB+0
          SA1    A1+B1       SET ALTERNATE STORAGE INFORMATION
          MX6    -42
          SX7    B1
          BX6    -X6*X1
          LX7    42-0        SET TAPE ALTERNATE STORAGE BIT
          BX6    X6+X7
          SA6    A6+B1
          SA1    X3+5        SET CREATION DATE AND TIME
          MX6    -36
          BX6    -X6*X1
          SA6    A6+B1
          SA1    A1-B1       SET FAMILY AND USER INDEX
          MX7    42
          BX6    X7*X1
          SA1    X3+2
          BX7    -X7*X1
          BX6    X6+X7
          SA6    A6+B1
          EQ     SSRX        RETURN
 STE      SPACE  4,10
**        STE - SKIP TAPE ERROR.
*
*         ENTRY  PARITY ERROR ENCOUNTERED.
*
*         EXIT   EOR DETECTED.
*                TO *EAF* IF EOF DETECTED.
*
*         MACROS READ, READW, RECALL.
 
 
 STE      SUBR               ENTRY/EXIT
 STE1     RECALL TAPE
          READW  TAPE,DBUF,DBUFL
          NG     X1,EAF      IF EOF ENCOUNTERED
          ZR     X1,STE1     IF NOT EOR
          READ   TAPE,R
          EQ     STEX        RETURN
 VCE      SPACE  4,15
**        VCE - VERIFY CATALOG ENTRY FIELDS.
*
*         ENTRY  (STRA) = ADDRESS OF STAGE REQUEST ENTRY.
*                (CATH) = CATALOG ENTRY FROM TAPE.
*
*         EXIT   (X6) = 0, IF STAGE REQUEST MATCHES PFC ON TAPE.
*
*         USES   X - 1, 2, 5, 6.
*                A - 1, 2, 5, 6.
*
*         CALLS  SRE.
 
 
 VCE      SUBR               ENTRY/EXIT
          SA1    STRA        GET STAGE REQUEST ADDRESS
          SA1    X1+5        VERIFY CREATION DATE AND TIME
          SA2    CATH+FCCD
          BX1    X1-X2
          MX2    -36
          BX6    -X2*X1
          ZR     X6,VCEX     IF CREATION DATE AND TIME MATCHES
          SA5    STRA        SET STAGE REQUEST ADDRESS
          SB2    ERFV        * FILE VERIFICATION ERROR ...*
          RJ     SRE         SEND STAGE REQUEST ERROR MESSAGE
          SX6    B1          INDICATE ERROR
          EQ     VCEX        RETURN
          SPACE  4,10
*         COMMON DECKS.
 
 
 FCE$     EQU    0
*CALL     COMCCCE
*CALL     COMCCDD
*CALL     COMCCIO
*CALL     COMCCOD
*CALL     COMCCPM
*CALL     COMCDXB
*CALL     COMCEDT
*CALL     COMCFCE
 GMS$     EQU    1           USE SORT KEY MASK
 MWK$     EQU    1           ALLOW MULTIPLE WORD SORT KEYS
*CALL     COMCGMS
*CALL     COMCJCR
*CALL     COMCLFM
*CALL     COMCMSF
*CALL     COMCMVE
*CALL     COMCPFM
 COM$     EQU    1           ASSEMBLE COMMON ROUTINES
 PFA$     EQU    1           ASSEMBLE ARCHIVE FILE ROUTINES
          LIST   X
*CALL     COMCPFS
          LIST   *
*CALL     COMCPFU
*CALL     COMCRDW
*CALL     COMCSCB
*CALL     COMCSFN
*CALL     COMCSKW
*CALL     COMCSNM
*CALL     COMCSYS
          LIST   X
          QUAL   MTX
 QUAL$    EQU    1
*CALL     COMCSRI
          QUAL   *
          LIST   *
*CALL     COMCVDT
*CALL     COMCWTC
*CALL     COMCWTH
*CALL     COMCWTO
*CALL     COMCWTW
*CALL     COMCZTB
          TITLE  BUFFERS.
          USE    LITERALS
          SPACE  4,10
*         BUFFERS.
 
 
 MBUF     EQU    *           MAIN BUFFER
 CATH     EQU    MBUF+MBUFL  CATALOG ENTRY HOLD BUFFER
 DBUF     EQU    CATH+CATHL  ARCHIVE DATA BLOCK WORKING BUFFER
 TBUF     EQU    DBUF+DBUFL  ARCHIVE FILE BUFFER
 OUTB     EQU    TBUF+TBUFL  OUTPUT FILE BUFFER
 SUMB     EQU    OUTB+OUTBL  SUMMARY FILE BUFFER
 PFLB     EQU    SUMB+SUMBL  PROCESSED FILES FILE BUFFER
 MS1B     EQU    PFLB+PFLBL  SORT FILE 1
 MS2B     EQU    MS1B+MSFBL  SORT FILE 2
 MS3B     EQU    MS2B+MSFBL  SORT FILE 3
 MS4B     EQU    MS3B+MSFBL  SORT FILE 4
 SRTB     EQU    MS3B        SORT BUFFER (OVERLAYS *MS3B* AND *MS4B*)
          ERRNG  MSFBL*2-SRTBL  SORT BUFFER OVERFLOW
 EBUF     EQU    MS4B+MSFBL+5  END OF BUFFERS
 
*         *PFRES* BUFFERS OVERLAY BUFFERS FROM *SUMB* TO *SRTB*.
 
 RBUF     EQU    SUMB        STAGE REQUEST FILE BUFFER (*PFRES* PRESET)
 SBUF     EQU    RBUF+RBUFL  SCRATCH FILE BUFFER (*PFRES* PRESET)
 QBUF     EQU    SBUF+SBUFL  STAGE REQUEST QUEUE (*PFRES* PRESET)
 EBUFP    EQU    QBUF+QBUFL  END OF BUFFERS (*PFRES* PRESET)
          TITLE  PRESET.
 PRS      SPACE  4,20
**        PRS - PRESET PROGRAM.
*
*         ENTRY  FILES *ZZZZZG0* THROUGH *ZZZZZG8* RETURNED BY *PFS*.
*                FILE *ZZZZZG9* RETURNED BY *PFS* IF NO FILE
*                  SELECTIONS.
*                FILE *ZZZZZG9* CONTAINS FILE SELECTIONS IF PRESENT.
*
*         EXIT   FILE NAMES SET IN FETS.
*                SECURITY PROCESSING BIT SET IN FET, IF NEEDED.
*                (SYSS) = SYSTEM SECURITY MODE.
*
*         USES   X - 0, 1, 2, 5, 6.
*                A - 0, 1, 2, 5, 6.
*
*         CALLS  FSR, IOF, ITA, PFO, RPS, RST, SSS.
*
*         MACROS MACHID, MEMORY, REPRIEVE, SETFET.
 
 
 PRS      SUBR               ENTRY/EXIT
          SB1    1
          MEMORY CM,,R,EBUF  REQUEST REQUIRED MEMORY
          REPRIEVE  RPVB,SET,277B
          RJ     SSS         SET SECURED SYSTEM STATUS
          SA1    SYSS
          ZR     X1,PRS1     IF NOT SECURED SYSTEM
          SA1    F+1         SET SECURITY PROCESSING BIT IN FET
          SX6    B1
          LX6    39-0
          BX6    X1+X6
          SA6    A1
 
*         SET UTILITY NAME IN MESSAGES.
 
 PRS1     SA1    /COMSPFS/UTLC  CHECK UTILITY CODE
          SX1    X1-/COMSPFS/RSUT
          NZ     X1,PRS2     IF NOT *PFRES*
 
*         PROCESS *PFRES*.
 
          MEMORY CM,MSTAT,R,EBUFP  REQUEST ADDITIONAL MEMORY
          MACHID PRSA        GET MACHINE ID
          SA1    PRSA
          SA2    R           SET MACHINE ID INTO *STRQID* FET
          LX1    24
          BX6    X1+X2
          SA6    A2
          RJ     RST         REQUEST STAGING TAPE
          RJ     FSR         FIND STAGE REQUESTS
          RJ     ITA         ISSUE TAPE ASSIGNED MESSAGE
          EQ     PRSX        RETURN
 
*         INITIALIZE OUTPUT FILE AND SUMMARY FILE.
 
 PRS2     RJ     IOF         INITIALIZE OUTPUT FILES
 
*         INITIALIZE ARCHIVE FILE.
 
          SA1    CPAR+/COMSPFS/CPTB  SET ARCHIVE FILE NAME
          SA2    TAPE
          MX6    -18
          BX6    -X6*X2
          BX6    X6+X1
          SA6    A2
          SX2    TAPE        SET OPTICAL DISK EXTENSION BUFFER
          SA3    PRSB
          RJ     SOE         SET FET EXTENSION IF OPTICAL DISK FILE
          OPEN   TAPE,READNR,R
 
*         INITIALIZE *PFCOPY* MASTER FILE.
 
          SA1    CPAR+/COMSPFS/CPMF  CHECK IF MASTER FILE SPECIFIED
          ZR     X1,PRS3     IF MASTER FILE NOT SPECIFIED
          SA5    FILEA
          RJ     PFO         OPEN MASTER FILE
          SETFET SU,ERP=0    CLEAR USER ERROR PROCESSING
 
*         READ FILE NAME AND USER INDEX SELECTIONS.
 
 PRS3     SX0    EBUF        SET SELECTION BUFFER ADDRESS
          RJ     RPS         READ PERMANENT FILE SELECTIONS
          EQ     PRSX        RETURN
 
 
 PRSA     CON    0           MACHINE ID WORD
 PRSB     VFD    36/,6/ODEBL,18/ODEB  POINTER TO *OD* EXT. BUFFER
          TITLE  PRESET SUBROUTINES.
 FSR      SPACE  4,20
**        FSR - FIND STAGE REQUESTS.
*         READ STAGE REQUESTS FROM REQUEST FILE AND REPACK FILE.
*         READ ADDITIONAL STAGE REQUESTS FROM *MAGNET*-S FL.
*
*         ENTRY  STAGE REQUEST FILE ATTACHED (BY *RESEX*).
*
*         EXIT   STAGE REQUESTS QUEUED IN *QBUF*.
*                SELECTED REQUESTS DELETED FROM STAGE REQUEST FILE.
*                STAGE REQUEST FILE RETURNED.
*                TO *ABT* IF NO STAGE REQUESTS FOR ASSIGNED VSN.
*
*         USES   X - 0, 1, 2, 6.
*                A - 1, 2, 5, 6.
*                B - 2, 6.
*
*         CALLS  ARQ, GSR.
*
*         MACROS MEMORY, MESSAGE, MOVE, READEI, READW, REWIND, RTIME,
*                UNLOAD, WRITE, WRITER, WRITEW.
 
 
 FSR      SUBR               ENTRY/EXIT
          REWIND R
          READEI X2          INITIATE READ
          WRITE  S,*
          SA5    PVSN        GET VSN ASSIGNED TO THIS JOB
 
*         READ NEXT ENTRY FROM REQUEST FILE.
 
 FSR1     READW  R,FSRA,/MTX/PFTBL
          NZ     X1,FSR3     IF END OF REQUEST FILE
          SA1    FSRA        CHECK FUNCTION CODE
          AX1    54
          SX1    X1-1
          NZ     X1,FSR1.1   IF NOT TAPE STAGE REQUEST
          SA1    FSRA+1      COMPARE VSN REQUIRED
          BX2    X1-X5
          MX0    -24
          BX2    -X0*X2
          ZR     X2,FSR2     IF VSN MATCHES VSN ASSIGNED TO THIS JOB
 FSR1.1   WRITEW S,FSRA,/MTX/PFTBL  WRITE UNSELECTED REQ TO SCRATCH
          EQ     FSR1        READ NEXT REQUEST
 
 FSR2     SB6    FSRA
          RJ     ARQ         ADD REQUEST TO QUEUE
          EQ     FSR1        READ NEXT REQUEST
 
*         COPY SCRATCH FILE (UNSELECTED REQUESTS) BACK TO REQUEST FILE.
 
 FSR3     WRITER S           FLUSH BUFFER
          REWIND X2
          READEI X2
          REWIND R,R
          WRITE  X2,*
 FSR4     READW  S,FSRA,/MTX/PFTBL
          NZ     X1,FSR5     IF END OF FILE
          WRITEW R,FSRA,/MTX/PFTBL
          EQ     FSR4        COPY NEXT REQUEST
 
 FSR5     WRITER R           FLUSH BUFFER
          UNLOAD X2,R        RETURN BOTH FILES
          UNLOAD S,R
          BX6    X6-X6       INDICATE STAGE REQUEST FILE RETURNED
          SA6    SRFF
 
*         MOVE REQUEST QUEUE DOWN (ON TOP OF *RBUF*/*SBUF*).
 
          SA5    SRQL        GET NUMBER OF WORDS IN CURRENT QUEUE
          ZR     X5,FSR6     IF NO REQUESTS
          MOVE   X5,QBUF,RBUF
 FSR6     SX6    RBUF        UPDATE QUEUE POINTER
          SA6    SRQF
 
*         PROCESS REQUESTS PENDING IN *MAGNET*.
 
 FSR7     RJ     /MTX/GSR    GET STAGE REQUEST
          LE     B6,B0,FSR8  IF NO REQUEST
          RJ     ARQ         ADD REQUEST TO QUEUE
          EQ     FSR7        GET NEXT REQUEST
 
 FSR8     RTIME  CARA        INITIALIZE STARTING TIME
          SA1    SRQL        CHECK IF ANY REQUESTS FOUND
          ZR     X1,FSR9     IF NO REQUESTS FOUND
          MEMORY CM,MSTAT,R,RBUF+X1+MEMI  REDUCE FIELD LENGTH
          EQ     FSRX        RETURN
 
 FSR9     SB2    ERNR        * NO FILES TO RESTORE.*
          EQ     ABT         ABORT
 
 
 FSRA     BSS    /MTX/PFTBL  STAGE REQUEST BUFFER
 ITA      SPACE  4,15
**        ITA - ISSUE TAPE ASSIGNED MESSAGE.
*
*         ENTRY  (SRQF) = POINTER TO FWA OF STAGE REQUEST QUEUE.
*                (SRQN) = NUMBER OF RESTORE REQUESTS.
*                (SVSN) = STAGING TAPE VSN.
*
*         USES   X - 0, 1, 2, 6.
*                A - 1, 2.
*                B - 2, 3, 5.
*
*         CALLS  CDD, SNM.
*
*         MACROS MESSAGE.
 
 
 ITA      SUBR               ENTRY/EXIT
          MX0    42
          SB3    ITAB
          SB5    -ITAA
          SA1    SRQF
          SA2    X1+4        GET FAMILY/PACK NAME
          BX1    X0*X2
          SB2    1R$
          RJ     SNM         SET FAMILY/PACK NAME INTO MESSAGE
          SA1    SVSN        GET VSN
          SB5    ITAB
          SB2    1R-
          RJ     SNM         SET VSN INTO MESSAGE
          SA1    SRQN        GET NUMBER OF ENTRIES IN REQUEST QUEUE
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          MX0    -24         MASK TO FOUR DIGITS
          BX1    -X0*X6
          LX1    -24         LEFT JUSTIFY
          SB2    1R=
          RJ     SNM         SET NUMBER OF ENTRIES INTO MESSAGE
          MESSAGE  ITAB,5    ISSUE STAGING TAPE ASSIGNED MESSAGE
          EQ     ITAX        RETURN
 
 
 ITAA     DATA   C*STTA, $$$$$$$, ------, ====.*
*         DATA   C*STTA, FAMPACK, VSNVSN, NNNN.*
 ITAAL    EQU    *-ITAA      LENGTH OF MESSAGE
 ITAB     BSS    ITAAL       MESSAGE ASSEMBLY BUFFER
 RST      SPACE  4,20
**        RST - REQUEST STAGING TAPE.
*
*         EXIT   STAGING TAPE ASSIGNED.
*                (SVSN) = VSN OF STAGING TAPE.
*                (PVSN) = PACKED VSN OF STAGING TAPE.
*                STAGE REQUEST FILE ATTACHED (BY *RESEX*).
*                TO *ABT* IF IMPROPER TAPE ASSIGNED.
*
*         USES   X - 0, 1, 2, 5, 6, 7
*                A - 1, 2, 6.
*                B - 2, 5, 6, 7.
*
*         CALLS  DXB, SNM.
*
*         MACROS FILINFO, LABEL, MOVE, UNLOAD.
 
 
 RST      SUBR               ENTRY/EXIT
          SA1    TAPE        SET FILE NAME IN *FILINFO* BLOCK
          SA2    RSTA
          MX7    42
          BX1    X7*X1
          BX2    -X7*X2
          BX6    X1+X2
          SA6    RSTA
          UNLOAD TAPE,R
          MOVE   5,TAPE,RSTB COPY FET FIELDS
          LABEL  RSTB        REQUEST STAGING TAPE
          FILINFO  RSTA
          SA1    RSTA+1      CHECK TAPE FILE FLAG
          LX1    59-24
          NG     X1,RST1     IF TAPE FILE
          SB2    ERNT        * STAGING TAPE NOT ASSIGNED.*
          EQ     ABT         ABORT
 
 RST1     SA1    RSTA+5      GET VSN OF TAPE
          MX0    36
          BX6    X0*X1
          SA6    SVSN        SAVE VSN
          LX0    6
          BX0    -X0*X6      VERIFY SIX CHARACTER VSN
          NZ     X0,RST3     IF SIX CHARACTER VSN
 RST2     SA1    SVSN        SET VSN IN DAYFILE MESSAGE
          SB2    1R$
          SB5    ERVE
          RJ     SNM
          SB2    ERVE        * STAGING TAPE VSN ERROR. VSN = $.*
          EQ     ABT         ABORT
 
 RST3     SA1    SVSN        BUILD PACKED VSN
          MX5    24
          LX1    12
          SB7    B1          SET DECIMAL CONVERSION
          BX5    X5*X1
          RJ     DXB         CONVERT VSN SUFFIX TO BINARY
          NZ     X4,RST2     IF ERROR IN CONVERSION (NOT PROPER VSN)
          SX7    X6-5000
          NG     X7,RST5     IF NOT BACKUP VSN
          SX6    X7          USE PRIMARY VSN FOR COMPARISON PURPOSES
 RST5     SA1    SVSN        GET VSN PREFIX
          MX2    12
          BX1    X2*X1
          LX1    -36
          BX6    X1+X6
          SA6    PVSN        SAVE PACKED VSN
          EQ     RSTX        RETURN
 
 
 RSTA     VFD    42/0,6/6,12/1  *FILINFO* BLOCK
          BSSZ   4
          VFD    54/,6/4
 
 RSTB     FILEB  TBUF,TBUFL,FET=16B  FET FOR *LABEL*
          ORG    RSTB+10B    PO=R,LB=KL,NO UNLOAD
          VFD    6/20B,3/0,3/0,12/50B,6/0,6/0,24/0
          BSSZ   RSTB+16B-*
          SPACE  4,10
*         PRESET DATA LOCATIONS.
 
 
 R        BSS    0           STAGE REQUEST FILE
 STRQ     FILEB  RBUF,RBUFL,FET=6
 
 S        BSS    0           SCRATCH STAGE REQUEST FILE
 ZZZZZG4  FILEB  SBUF,SBUFL,FET=6
 
          SPACE  4,10
*         PRESET COMMON DECKS.
 
 
          LIST   X
*CALL     COMCPFP
          LIST   *
*CALL     COMCSOE
          SPACE  4,10
          ERRPL  *-TBUF-1    PRESET OVERFLOWS INTO BUFFERS
          SPACE  4,10
          END