PFAM
          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 
