COMCPFS 
COMMON
          CTEXT  COMCPFS - PF UTILITY SUBROUTINES.
          SPACE  4,10 
          IF     -DEF,QUAL$ 
          QUAL   COMCPFS
          ENDIF 
          BASE   D
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
***       COMCPFS - PF UTILITY SUBROUTINES. 
* 
*         S. D. PAINTER      81/06/24.
*         R. C. SCHMITTER    82/10/08.
*         G. S. YODER        86/10/10.
          SPACE  4,10 
**        *COMCPFS* CONTAINS COMMON ROUTINES THAT ARE USED BY 
*         THE PERMANENT FILE UTILITIES.  THIS DECK REQUIRES 
*         THE PRESENCE OF *COMSPFM* AND *COMSPFS*.
          TITLE  COMCPFS - FILE SELECTION ROUTINES. 
 CSC      SPACE  4,25 
**        CSC - CHECK SELECTION CRITERIA. 
* 
*         NOTE - FOR *OP=M*, THE FILE WILL BE SELECTED IF THE 
*         UTILITY CONTROL DATE AND TIME MEETS THE CRITERIA.  IF NOT,
*         THE FILE WILL STILL BE SELECTED IF THE CONTROL MODIFICATION 
*         DATE AND TIME MEETS THE CRITERIA AND IS MORE RECENT THAN
*         THE UTILITY CONTROL DATE AND TIME.
* 
*         ENTRY  (B4) = FWA OF PF CATALOG ENTRY.
* 
*         EXIT   (X6) = 0, IF FILE DOES NOT MEET SELECTION CRITERIA.
*                (X6) = 1, IF FILE MEETS SELECTION CRITERIA.
*                IF FILE IS NOT SELECTED, (X7) CONTAINS THE REASON. 
*                            (X7) = 0, IF REASON IS NOT DATE/TIME.
*                            (X7) = 1, IF REASON IS DATE/TIME.
*                (B7) = 0 IF CONTROL MODIFICATION DATE NOT CHECKED. 
*                (B7) = 1 IF CONTROL MODIFICATION DATE WAS CHECKED. 
*                (B6) = ADDRESS OF FILE NAME, IF MATCH FOUND. 
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4.
*                B - 6, 7.
  
  
 CSC15    SX6    B0+         SET FILE NOT SELECTED
          SX7    B0+         SET REASON NOT DATE/TIME 
  
 CSC      SUBR               ENTRY/EXIT 
          SA1    /COMSPFS/FISP
          BX6    X6-X6       SET FILE NOT SELECTED
          SB6    B0          CLEAR FILE NAME ADDRESS
          ZR     X1,CSC2     IF NO USER INDEX OR FILE NAME SELECTIONS 
          SA1    X1-1 
          SA3    B4+FCFN     GET NAME AND USER INDEX OF FILE
          MX7    -18
          BX4    -X7*X3      USER INDEX OF FILE 
 CSC1     SA1    A1+1        READ NEXT SELECTION
          ZR     X1,CSC15    IF END OF SELECTIONS 
          BX2    X1-X4
          BX1    X1-X3
          ZR     X2,CSC2     IF ALL FILES FOR USER INDEX SELECTED 
          NZ     X1,CSC1     IF FILE NOT SELECTED BY NAME 
          SB6    A1+         SET ADDRESS OF FILE NAME SELECTION 
 CSC2     SA1    CPAR+/COMSPFS/CPDA 
          SA2    A1+B1
          BX6    X1+X2
          ZR     X6,CSC2.3   IF NO DISK RESIDENCE SELECTION CRITERIA
          SA3    B4+FCBT     GET TRACK POINTER
          SA4    B4+FCDN     GET DEVICE NUMBER
          SX7    X1 
          LX3    59-23
          LX7    59-0 
          BX3    X3-X7
          ZR     X7,CSC2.0   IF NO ALL RESIDENT/NON-RESIDENT SELECTION
          PL     X3,CSC2.3   IF MATCH ON RESIDENCY CRITERION
          EQ     CSC15       SET FILE NOT SELECTED
  
 CSC2.0   MX6    -6 
          LX4    -36
          BX6    -X6*X4      RESIDENCY DEVICE NUMBER
          LX4    59-5 
          NZ     X6,CSC2.1   IF FILE DOES NOT RESIDE ON MASTER DEVICE 
          SA3    CPAR+/COMSPFS/CPDN 
          SX6    X3+         SET MASTER DEVICE NUMBER 
 CSC2.1   SB7    X6 
          PL     X4,CSC2.2   IF DEVICE NUMBER IN FIRST WORD 
          BX1    X2 
 CSC2.2   LX1    B7 
          PL     X1,CSC15    IF NO DEVICE SELECTION 
 CSC2.3   SA1    CPAR+/COMSPFS/CPCA 
          ZR     X1,CSC4     IF NO CARTRIDGE STORAGE SELECTION
          SA2    B4+FCAA
          MX6    -36
          BX6    -X6*X2 
          LX2    59-48
          SX7    B1+B1
          ZR     X6,CSC3     IF FILE NOT ON CARTRIDGE ALTERNATE STORAGE 
          NG     X2,CSC3     IF CARTRIDGE STORAGE COPY OBSOLETE 
          SX7    B1+
 CSC3     IX7    X7-X1
          NZ     X7,CSC15    IF RESIDENCY DOES NOT MATCH SELECTION
 CSC4     SA1    CPAR+/COMSPFS/CPTA 
          SA2    CPAR+/COMSPFS/CPTA+1 
          BX6    X1+X2
          ZR     X6,CSC7     IF NO TAPE STORAGE SELECTION CRITERIA
          MX7    -24
          SA3    B4+FCTV
          SX6    B1 
          BX3    -X7*X3 
          NZ     X3,CSC5     IF FILE RESIDES ON TAPE ALTERNATE STORAGE
          SX6    2
 CSC5     IX6    X1-X6
          ZR     X6,CSC7     IF MATCH ON GENERAL RESIDENCY CRITERION
 CSC6     ZR     X2,CSC15    IF END OF VSN POINTER LIST 
          BX6    X3-X2
          SA2    A2+B1
          NZ     X6,CSC6     IF VSN NOT SELECTED
 CSC7     SA1    /COMSPFS/TCNS
          ZR     X1,CSC7.3   IF NO CHARGE OR PROJECT NUMBER SELECTIONS
          SA4    B4+FCCN
          SA2    B4+FCP1
          SA3    B4+FCP2
          BX6    X2 
          BX7    X3 
          NZ     X4,CSC7.1   IF CHARGE NUMBER NOT NULL
          SX4    1           SET FOR NULL SELECTION 
 CSC7.1   NZ     X6,CSC7.2   IF PROJECT NUMBER NOT NULL 
          SX6    1           SET FOR NULL SELECTION 
 CSC7.2   ZR     X1,CSC15    IF END OF SELECTIONS 
          BX2    X1-X4
          SA1    A1+3 
          NZ     X2,CSC7.2   IF NOT SAME CHARGE NUMBER
          NG     X2,CSC7.2   IF NOT SAME CHARGE NUMBER
          SA2    A1-2 
          SA3    A1-1 
          ZR     X2,CSC7.3   IF ALL PROJECT NUMBERS SELECTED
          BX2    X2-X6
          BX3    X3-X7
          NZ     X2,CSC7.2   IF NOT SAME PROJECT NUMBER 
          NG     X2,CSC7.2   IF NOT SAME PROJECT NUMBER 
          NZ     X3,CSC7.2   IF NOT SAME PROJECT NUMBER 
          NG     X3,CSC7.2   IF NOT SAME PROJECT NUMBER 
 CSC7.3   SA1    CPAR+/COMSPFS/CPOP  CHECK FOR IAPF/DAPF SPECIFIED
          SA2    B4+FCBT
          LX2    59-11
          NG     X2,CSC8     IF FILE IS DIRECT ACCESS 
          LX1    59-55
          PL     X1,CSC9     IF *OP=D* NOT SPECIFIED
          EQ     CSC15       SET FILE NOT SELECTED
  
 CSC8     LX1    59-56
          NG     X1,CSC15    IF *OP=I* SPECIFIED
 CSC9     SA2    CPAR+/COMSPFS/CPLA 
          ZR     X2,CSC10    IF SECURITY ACCESS LEVEL NOT SPECIFIED 
          SA1    CPAR+/COMSPFS/CPUA 
          SA3    B4+FCAL     GET FILE ACCESS LEVEL
          MX7    -3 
          BX2    -X7*X2 
          BX1    -X7*X1 
          AX3    36 
          BX3    -X7*X3 
          IX2    X3-X2
          IX1    X1-X3
          NG     X2,CSC15    IF ACCESS LEVEL OUT OF RANGE 
          NG     X1,CSC15    IF ACCESS LEVEL OUT OF RANGE 
 CSC10    SA2    CPAR+/COMSPFS/CPLS 
          SA1    CPAR+/COMSPFS/CPUS 
          SA3    B4+FCLF     GET FILE LENGTH
          MX7    -24
          LX3    -36
          BX3    -X7*X3 
          IX2    X3-X2
          IX1    X1-X3
          NG     X2,CSC15    IF FILE LENGTH .LT. LOWER SIZE LIMIT 
          NG     X1,CSC15    IF FILE LENGTH .GT. UPPER SIZE LIMIT 
          SX6    B1          SET FILE SELECTED
  
*         CHECK DATE/TIME INTERVAL. 
  
          SB7    B0          SET CONTROL DATE NOT CHECKED 
          SA2    CPAR+/COMSPFS/CPOP 
          SX1    B1 
          MX7    3
          LX1    44-0 
          BX7    X7+X1
          BX2    X7*X2
          ZR     X2,CSCX     IF NO DATE OPTIONS SPECIFIED 
          MX7    -36
          SA3    CPAR+/COMSPFS/CPAD  AFTER DATE/TIME
          SA4    CPAR+/COMSPFS/CPBD  BEFORE DATE/TIME 
          BX3    -X7*X3 
          BX4    -X7*X4 
          SX1    B4+FCCD     CREATION DATE
          NG     X2,CSC11    IF CREATION DATE SPECIFIED 
          LX2    59-58
          SX1    B4+FCAD     ACCESS DATE
          NG     X2,CSC11    IF ACCESS DATE SPECIFIED 
          LX2    59-44-59+58
          SX1    B4+FCMD     DATA MODIFICATION DATE 
          NG     X2,CSC11    IF DATA MODIFICATION DATE SPECIFIED
          SX1    B4+FCUD     UTILITY CONTROL DATE 
 CSC11    SA1    X1+         READ DATE AND TIME 
 CSC12    BX1    -X7*X1 
          IX7    X1-X3
          NG     X7,CSC13    IF DATE NOT IN INTERVAL
          IX7    X4-X1
          ZR     X4,CSCX     IF NO BEFORE DATE SPECIFIED
          PL     X7,CSCX     IF DATE IN INTERVAL
 CSC13    NG     X2,CSC14    IF NOT *OP=M*
          SA2    B4+FCKD     CONTROL MODIFICATION DATE
          MX7    -36
          BX2    -X7*X2 
          IX7    X1-X2
          SB7    B1          SET CONTROL MODIFICATION DATE CHECKED
          PL     X7,CSC14    IF CONTROL MODIFICATION NOT MORE RECENT
          BX1    X2 
          MX2    1           CLEAR *OP=M* 
          MX7    -36
          EQ     CSC12       CHECK CONTROL MODIFICATION 
  
 CSC14    BX6    X6-X6       SET FILE NOT SELECTED
          SX7    B1          SET REASON IS DATE/TIME
          EQ     CSCX        RETURN 
 SUM      SPACE  4,10 
**        SUM - SET COMPOSITE USER INDEX MASK.
* 
*         ENTRY  (X1) = ADDRESS OF FILE NAME AND USER INDEX SELECTIONS
*                       TABLE.
* 
*         EXIT   (X4) = COMPOSITE USER INDEX MASK.
* 
*         USES   X - 1, 2, 3, 4, 7. 
*                A - 1. 
*                B - 2. 
  
  
 SUM      SUBR               ENTRY/EXIT 
          SA1    X1          GET FIRST ENTRY
          SX4    B0          INITIALIZE USER INDEX MASK 
          MX7    -3 
          SX3    B1 
 SUM1     ZR     X1,SUMX     IF END OF SELECTIONS 
          BX2    -X7*X1      SUBFAMILY INDEX
          LX1    59-17
          SB2    X2 
          NG     X1,SUM1     IF ENTRY NOT SELECTED
          LX2    B2,X3
          BX4    X4+X2       ACCUMULATE USER INDEX MASK 
          SA1    A1+B1       GET NEXT ENTRY 
          EQ     SUM1        CHECK END OF SELECTIONS
          TITLE  COMCPFS - COMMON ERROR AND TERMINATION ROUTINES. 
 ABT      SPACE  4,15 
**        ABT - ABORT PROCESSOR.
* 
*         ENTRY  (B2) = ERROR MESSAGE ADDRESS IF .NE. 0.
*                (B2) = 0 IF NO ERROR MESSAGE.
* 
*         EXIT   ERROR MESSAGE ISSUED TO DAYFILE. 
*                UTILITY SPECIFIC ABORT PROCESSING AND COMMON MAIN
*                  TERMINATION PROCESSING COMPLETE. 
*                TO *END* TO ABORT JOB. 
* 
*         USES   X - 6. 
*                A - 6. 
* 
*         CALLS  APR, SEM.
  
  
 ABT      BSS    0           ENTRY
          SX6    1
          SA6    ABTF        SET ABORT FLAG 
          SA6    DINF        DISABLE INTERRUPTS 
          ZR     B2,ABT1     IF NO MESSAGE
          RJ     SEM         SEND ERROR MESSAGE 
 ABT1     RJ     APR         EXECUTE ABORT PROCESSOR
*         EQ     END         TERMINATE
 END      SPACE  4,15 
**        END - PERFORM TERMINATION PROCESSING. 
* 
*         EXIT   SUMMARY FILE FLUSHED IF SELECTED.
*                FLAG BITS SET IN PROCESSING STATUS REGISTER IF 
*                  SPECIFIED. 
* 
*         USES   X - 1, 2, 3, 4, 6. 
*                A - 1, 3, 6. 
*                B - 2, 5.
* 
*         CALLS  FAB, GJR, IFM, SJR, SNM, SWR.
* 
*         MACROS ABORT, ENDRUN, REPRIEVE, MESSAGE, WRITER.
  
  
 END      BSS    0           ENTRY
          SX6    1
          SA6    DINF        DISABLE INTERRUPTS DURING TERMINATION
  
*         FLUSH OUTPUT FILE.
  
          SA1    O
          AX1    18 
          ZR     X1,END1     IF NO OUTPUT FILE
          WRITER O           FLUSH OUTPUT FILE
  
*         FLUSH SUMMARY FILE. 
  
 END1     SA1    CPAR+/COMSPFS/CPSU 
          ZR     X1,END2     IF NO SUMMARY FILE 
          RJ     FAB         FLUSH ASSEMBLY BUFFER
          WRITER SU          WRITE END OF RECORD
  
*         SET PROCESSING STATUS REGISTER. 
  
 END2     SA1    CPAR+/COMSPFS/CPPS 
          ZR     X1,END5     IF STATUS REGISTER NOT SPECIFIED 
          RJ     GJR         GET JOB CONTROL REGISTERS
          SA1    CPAR+/COMSPFS/CPPS 
          SX2    B0          INITIALIZE STATUS
          SA3    PSAC-1 
          MX6    1
 END3     SA3    A3+B1
          LX6    1
          SX4    A3-PSAC-PSACL+1
          ZR     X3,END4     IF ZERO FILE COUNT 
          BX2    X2+X6       MERGE STATUS BIT 
 END4     NZ     X4,END3     IF NOT LAST ACCUMULATOR
          RJ     SWR         SET WORKING REGISTER VALUE 
          RJ     SJR         RESET JOB CONTROL REGISTERS
  
*         ISSUE TERMINATION MESSAGES. 
  
 END5     RJ     IFM         ISSUE FILE COUNT MESSAGES
          SA1    /COMSPFS/UTLN
          SB2    1R?
          SB5    MECM        SET MESSAGE ADDRESS
          RJ     SNM         SET UTILITY NAME IN MESSAGE
          MESSAGE  MECM      * PFUUUUU COMPLETE.* 
  
*         DETERMINE IF JOB TO BE ABORTED. 
  
          SA1    RPVB+/COMSRPV/OSEF 
          MX6    -12
          BX1    -X6*X1 
          ZR     X1,END7     IF NO REPRIEVED ERROR
          SX1    X1-TIET
          ZR     X1,END7     IF USER BREAK ONE
          REPRIEVE  RPVB,RESET,0  RESET SYSTEM ERROR
  
 END7     REPRIEVE  RPVB,SET,0  DISABLE REPRIEVE PROCESSING 
          SA1    ABTF 
          ZR     X1,END8     IF NO ABORT
          ABORT 
  
 END8     ENDRUN
 RPV      SPACE  4,20 
**        RPV - REPRIEVE SYSTEM ERROR.
* 
*         EXIT   TO *ABT* IF INTERRUPTS NOT DISABLED. 
*                TO POINT OF INTERRUPT IN INTERRUPT HANDLER MODE IF 
*                  INTERRUPTS DISABLED.  THE SYSTEM ERROR CAUSING THE 
*                  REPRIEVE WILL BE RESET TO ABORT THE JOB WHEN 
*                  TERMINATION (NORMAL OR ABORT) PROCESSING IS
*                  COMPLETE.
*                (ABTF) .NE. 0. 
* 
*         USES   X - 1, 5, 6. 
*                A - 1, 6.
* 
*         CALLS  RIP. 
* 
*         MACROS REPRIEVE.
  
  
 RPV      BSS    0           ENTRY
          SA1    DINF 
          SX6    1
          SA6    ABTF        SET ABORT FLAG 
          ZR     X1,RPV1     IF INTERRUPTS NOT DISABLED 
          REPRIEVE  RPVB,IRESUME,277B  RESUME PROCESSING
  
 RPV1     BX6    X6-X6       CLEAR REPRIEVED SYSTEM REQUEST 
          SA6    RPVB+/COMSRPV/PRAR 
          RJ     RIP         EXECUTE REPRIEVE INTERRUPT PROCESSOR 
          SB2    EREF        * ERROR FLAG TERMINATION.* 
          EQ     ABT         ABORT UTILITY
          SPACE  4,10 
**        TERMINATION CONTROL DATA. 
  
  
 ABTF     CON    0           ABORT FLAG 
 DINF     CON    0           DISABLE INTERRUPTS FLAG
  
 RPVB     RPVBLK RPV         REPRIEVE BLOCK 
          SPACE  4,10 
*         MESSAGES. 
  
 EREF     DATA   C* ERROR FLAG TERMINATION.*
 MECM     DATA   C* ??????? COMPLETE.*
          TITLE  COMCPFS - MESSAGE GENERATION ROUTINES. 
 CFE      SPACE  4,10 
**        CFE - COUNT FILE SKIPPED WITH ERROR.
* 
*         EXIT   FILES SKIPPED WITH ERRORS COUNT INCREMENTED. 
* 
*         USES   X - 1, 6.
*                A - 1, 6.
  
  
 CFE      SUBR               ENTRY/EXIT 
          SA1    SEFC 
          SX6    B1 
          IX6    X6+X1
          SA6    A1          COUNT FILE NOT PROCESSED 
          EQ     CFEX        RETURN 
 IFC      SPACE  4,25 
**        IFC - ISSUE FILE COUNT MESSAGES.
* 
*         ENTRY  (A5) = ADDRESS OF FIRST MESSAGE CONTROL TABLE ENTRY. 
*                (X5) = FIRST MESSAGE CONTROL TABLE ENTRY.
* 
*         EXIT   FILE COUNT MESSAGES ISSUED TO DAYFILE. 
* 
*         USES   X - 1, 5, 6. 
*                A - 1, 5.
*                B - 2, 3, 5. 
* 
*         CALLS  CDD, SNM.
* 
*         MACROS MESSAGE. 
* 
*         MESSAGE CONTROL TABLE FORMAT -
* 
*         1/ ZR,1/ SS,22/ ,18/ MS,18/ CT
* 
*         ZR = ISSUE MESSAGE IF COUNT = 0.
*         SS = SUPRESS LEADING SPACES IN CONVERTED COUNT. 
*         MS = ADDRESS OF MESSAGE.
*         CT = ADDRESS OF COUNT.
  
  
 IFC      SUBR               ENTRY/EXIT 
 IFC1     ZR     X5,IFCX     IF NO MORE MESSAGES
          SA1    X5+         GET FILE COUNT 
          NZ     X1,IFC2     IF COUNT .NE. 0
          PL     X5,IFC6     IF NOT TO ISSUE MESSAGE
 IFC2     RJ     CDD         CONVERT COUNT
          LX5    59-58
          MX1    1
          SB3    60 
          NG     X5,IFC4     IF TO SUPRESS LEADING SPACES 
          SB2    36          SET FIELD WIDTH
 IFC4     SB3    B3-B2
          SB2    B2-1 
          LX6    B3 
          AX1    B2 
          LX5    -19
          BX1    X1*X6
          SB5    X5          MESSAGE ADDRESS
          SB2    1R?
          RJ     SNM         SET COUNT IN MESSAGE 
          LX5    18 
          SA2    X5          RESET COUNT
          SX1    1RS
          LX1    -6 
          SX6    1
          IX6    X2-X6
          NZ     X6,IFC5     IF COUNT .NE. 1
          SX1    0
 IFC5     SB2    1R!
          RJ     SNM         SET SINGULAR OR PLURAL MESSAGE 
          MESSAGE  B5 
 IFC6     SA5    A5+B1       GET NEXT ADDRESS 
          EQ     IFC1        PROCESS NEXT MESSAGE 
 SDE      SPACE  4,15 
**        SDE - SEND FILE ERROR MESSAGE WITH DEVICE NUMBER. 
* 
*         ENTRY  (X1) = FILE NAME AND USER INDEX. 
*                (X2) = DEVICE NUMBER.
*                (B2) = MESSAGE TEMPLATE ADDRESS. 
* 
*         EXIT   ERROR MESSAGE ISSUED.
* 
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 2. 
* 
*         CALLS  COD, SEM, SNM. 
  
  
 SDE      SUBR               ENTRY/EXIT 
          SX6    X2+
          SA6    SDEA        SAVE DEVICE NUMBER 
          RJ     SFU         SET FILE NAME AND USER INDEX 
          SA1    SDEA 
          RJ     COD         CONVERT DEVICE NUMBER
          SB2    B2-B1
          MX6    1
          AX6    B2          SET DIGITS MASK
          BX1    X6*X4       REMOVE TRAILING BLANKS 
          SB2    1R+
          RJ     SNM         SET DEVICE NUMBER IN MESSAGE 
          SB2    MSGB        SET MESSAGE ADDRESS
          RJ     SEM         SEND ERROR MESSAGE 
          EQ     SDEX        RETURN 
  
  
 SDEA     CON    0           DEVICE NUMBER
 SEM      SPACE  4,15 
**        SEM - SEND ERROR MESSAGE. 
* 
*         ENTRY  (B2) = MESSAGE ADDRESS.
* 
*         EXIT   MESSAGE SENT TO DAYFILE. 
*                IF *LO=E*, MESSAGE SENT TO OUTPUT FILE.
* 
*         USES   X - 1, 6.
*                A - 1. 
* 
*         CALLS  ALN. 
* 
*         MACROS MESSAGE, MOVE, WRITEC, WRITEH. 
  
  
 SEM      SUBR               ENTRY/EXIT 
          SX1    B2-MSGB
          ZR     X1,SEM1     IF MESSAGE ALREADY IN BUFFER 
          MOVE   8,B2,MSGB   MOVE MESSAGE TO BUFFER 
 SEM1     MESSAGE  MSGB      ISSUE DAYFILE MESSAGE
          SA1    CPAR+/COMSPFS/CPLO 
          LX1    59-57
          PL     X1,SEMX     IF LO = E NOT SPECIFIED
          SA1    O
          AX1    18 
          ZR     X1,SEMX     IF OUTPUT FILE NOT INITIALIZED 
          SX6    2           ALLOCATE TWO LINES 
          RJ     ALN
          WRITEH O,BLAN,1    WRITE MESSAGE TO OUTPUT FILE 
          WRITEC X2,MSGB
          EQ     SEMX        RETURN 
 SFE      SPACE  4,10 
**        SFE - SEND ERROR MESSAGE WITH FILE NAME AND USER INDEX. 
* 
*         ENTRY  (X1) = FILE NAME AND USER INDEX. 
*                (B2) = MESSAGE TEMPLATE ADDRESS. 
* 
*         USES   B - 2. 
* 
*         CALLS  SEM, SFU.
  
  
 SFE      SUBR               ENTRY/EXIT 
          RJ     SFU         SET FILE NAME AND USER INDEX 
          SB2    MSGB        SET MESSAGE ADDRESS
          RJ     SEM         SEND ERROR MESSAGE 
          EQ     SFEX        RETURN 
 SFU      SPACE  4,15 
**        SFU - SET FILE NAME AND USER INDEX IN MESSAGE.
* 
*         ENTRY  (B2) = MESSAGE TEMPLATE ADDRESS. 
*                (X1) = FILE NAME AND USER INDEX. 
* 
*         EXIT   MESSAGE WITH FILE NAME AND USER INDEX IN *MSGB*. 
*                (B5) = *MSGB*. 
* 
*         USES   X - 1, 6, 7. 
*                A - 1. 
*                B - 2, 3, 5. 
* 
*         CALLS  COD, SNM.
  
  
 SFU      SUBR               ENTRY/EXIT 
          MX6    -18
          BX7    -X6*X1      USER INDEX 
          BX1    X6*X1       FILE NAME
          SB5    -B2         SET TEMPLATE ADDRESS 
          SA7    SFUA        SAVE USER INDEX
          SB2    1R?
          SB3    MSGB        SET ASSEMBLY AREA ADDRESS
          RJ     SNM         SET FILE NAME IN MESSAGE 
          SA1    SFUA 
          RJ     COD         CONVERT USER INDEX 
          SB2    B2-B1
          MX6    1
          AX6    B2          SET DIGITS MASK
          BX1    X6*X4       REMOVE TRAILING BLANKS 
          SB2    1R!
          SB5    MSGB 
          RJ     SNM         SET USER INDEX IN MESSAGE
          EQ     SFUX        RETURN 
  
  
 SFUA     CON    0           USER INDEX 
          SPACE  4,10 
*         MESSAGE CONTROL FLAGS AND EDIT STRING BUFFER. 
  
  
 MSGB     BSSZ   9           MESSAGE ASSEMBLY BUFFER
          TITLE  COMCPFS - OUTPUT AND SUMMARY FILE MAIN ROUTINES. 
          SPACE  4,10 
**        ASSEMBLY CONSTANTS. 
  
  
 NWCI     EQU    2           NUMBER OF WORDS IN CIR ENTRY 
 CFP      SPACE  4,20 
**        CFP - COUNT FILE PROCESSED. 
* 
*         ENTRY  (A0) = CATALOG ENTRY ADDRESS.
*                (FLST) = FILE STATUS WORD. 
* 
*         EXIT   FILE COUNTS UPDATED. 
*                CATALOG DATA WRITTEN TO OUTPUT FILE IF UNSORTED OUTPUT 
*                  SELECTED.
*                CATALOG DATA WRITTEN TO SUMMARY FILE IF SELECTED.
*                CATALOG DATA WRITTEN TO SORT INPUT FILE IF SORTED OR 
*                  STATISTICAL OUTPUT SELECTED. 
* 
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 6.
* 
*         CALLS  MWA. 
* 
*         MACROS WRITEW.
  
  
 CFP      SUBR               ENTRY/EXIT 
  
*         UPDATE FILE COUNTS. 
  
          SA1    FLST 
          SA2    PRFC 
          SA3    POFC 
          SX7    B1 
          MX4    -2 
          LX1    59-0 
          IX6    X2+X7       COUNT FILE PROCESSED 
          BX4    -X4*X1      EXTRACT FILE PROCESSING ERROR FLAGS
          SA6    A2 
          PL     X1,CFP1     IF NOT PFC ONLY FILE 
          IX6    X3+X7       COUNT PFC ONLY FILE
          SA6    A3 
 CFP1     ZR     X4,CFP2     IF NO PROCESSING ERRORS
          SA2    PEFC 
          IX6    X2+X7       COUNT PROCESSING ERROR 
          SA6    PEFC 
  
*         WRITE SUMMARY FILE. 
  
 CFP2     SA1    CPAR+/COMSPFS/CPSU 
          ZR     X1,CFP3     IF NO SUMMARY FILE 
          SX2    A0          SET DATA ADDRESS 
          SX1    NWCE        SET WORD COUNT 
          SX0    X1+B1       ALLOCATE ENTRY PLUS CONTROL WORD 
          RJ     MWA         MOVE CATALOG ENTRY TO ASSEMBLY BUFFER
          SX1    B1          SET WORD COUNT 
          SX2    FLST        SET STATUS WORD ADDRESS
          SX0    B0          SET CONTINUATION STATUS
          RJ     MWA         MOVE STATUS WORD TO ASSEMBLY BUFFER
  
*         WRITE PROCESSED FILE LIST.
  
 CFP3     SA1    CPAR+/COMSPFS/CPLO 
          SA2    A0+FCUI
          SX6    4400B
          LX6    48 
          BX1    X6*X1
          ZR     X1,CFPX     IF *T* OR *S* LIST OPTION NOT SELECTED 
          LX2    -18         POSITION USER INDEX FOR SORT 
          BX6    X2 
          SA6    A2 
          WRITEW PF,A0,NWCE  WRITE CATALOG ENTRY
          WRITEW X2,FLST,1   WRITE STATUS WORD
          WRITEW X2,PRFC,1   WRITE SEQUENCE NUMBER
          SA2    A0+FCUI
          SX6    1
          SA6    FPSF        SET FILE PROCESSED 
          LX2    18 
          BX6    X2          RESTORE FILE NAME AND USER INDEX 
          SA6    A2 
          EQ     CFPX        RETURN 
 OAL      SPACE  4,20 
**        OAL - OUTPUT ARCHIVE FILE LABEL PARAMETERS. 
* 
*         ENTRY  ARCHIVE FILE LABEL PARAMETERS IN *AFIB*. 
* 
*         EXIT   ARCHIVE FILE INFORMATION SET IN OUTPUT FILE PAGE 
*                  TITLE. 
*                ARCHIVE FILE BLOCK WRITTEN TO SUMMARY FILE IF
*                  SELECTED.
* 
*         USES   X - 0, 1, 2, 5, 6. 
*                A - 1, 2, 5, 6.
*                B - 2, 3, 5, 7.
* 
*         CALLS  FAB, SCB, SNM, ZTB.
* 
*         MACROS EDATE, ETIME, MOVE.
  
  
 OAL      SUBR               ENTRY/EXIT 
  
*         SET INFORMATION IN OUTPUT FILE PAGE TITLE.
  
          SA1    AFIB 
          SA2    A1+B1
          BX1    X1+X2       SET FAMILY OR PACK NAME
          ZR     X1,OAL2     IF ARCHIVE FILE LABEL NOT FOUND
          SB5    -AFSB
          ZR     X2,OAL1     IF PACK NAME NOT PRESENT 
          SB5    -AFSC
 OAL1     SB2    1R?
          SB3    PGAF 
          RJ     SNM         SET FAMILY OR PACK NAME
          SA1    PGAF+1      BLANK FILL FAMILY OR PACK NAME 
          RJ     ZTB
          SA6    PGAF+1 
          SA5    AFIB+2      GET ARCHIVE FILE CREATION DATE AND TIME
          MX1    -18
          BX1    -X1*X5 
          ETIME  X1 
          SB7    AFSA        SET BUFFER ADDRESS 
          SB3    AFSE        SET DESCRIPTOR ADDRESS 
          RJ     SCB         SET LABEL DATE 
          AX5    18 
          BX1    X5 
          EDATE  X1 
          SB3    AFSF        SET DESCRIPTOR ADDRESS 
          RJ     SCB         SET LABEL TIME 
          MOVE   5,AFSA,PGAC MOVE PARAMETERS TO PAGE TITLE
          EQ     OAL3        WRITE SUMMARY FILE 
  
 OAL2     MOVE   8,AFSD,PGTB+1  SET LABEL NOT FOUND MESSAGE 
  
*         WRITE SUMMARY FILE. 
  
 OAL3     SA1    CPAR+/COMSPFS/CPSU 
          ZR     X1,OALX     IF SUMMARY FILE NOT SELECTED 
          RJ     FAB         FLUSH ASSEMBLY BUFFER
          SA1    TSBI+/COMSPFS/AFSB  SET ARCHIVE FILE BLOCK TYPE
          BX6    X1 
          SA6    CFBI 
          SX1    3           SET BLOCK WORD COUNT 
          SX2    AFIB        SET DATA ADDRESS 
          SX0    3           SET NUMBER OF WORDS TO ALLOCATE
          RJ     MWA         MOVE DATA TO ASSEMBLY BUFFER 
          EQ     OALX        RETURN 
 OCI      SPACE  4,15 
**        OCI - OUTPUT CATALOG IMAGE ENTRIES. 
* 
*         ENTRY  (X6) = ADDRESS OF CIR ENTRIES BUFFER.
*                (X7) = WORD COUNT OF CIR ENTRIES IN BUFFER.
* 
*         EXIT   CATALOG IMAGE RECORD DATA WRITTEN TO SUMMARY FILE AND
*                  SORT INPUT FILE IF SELECTED. 
* 
*         USES   X - 0, 1, 2, 6, 7. 
*                A - 1, 2, 6, 7.
*                B - 3, 6, 7. 
* 
*         CALLS  MWA. 
* 
*         MACROS WRITEW.
  
  
 OCI      SUBR               ENTRY/EXIT 
          ZR     X7,OCIX     IF NO ENTRIES
          SA6    OCIA        SAVE BUFFER ADDRESS
          IX7    X6+X7       SET BUFFER LWA+1 
          SA7    OCIB 
  
*         WRITE CATALOG IMAGES TO SUMMARY FILE IF SELECTED. 
  
          SA1    CPAR+/COMSPFS/CPSU 
          ZR     X1,OCI1     IF NO SUMMARY FILE 
          SA1    OCIB 
          SA2    OCIA        SET BUFFER ADDRESS 
          IX1    X1-X2       SET WORD COUNT 
          ERRNG  SABFL-1000B BUFFER SIZE LESS THAN MAXIMUM BLOCK LENGTH 
          BX0    X1          SET WORDS TO ALLOCATE
          RJ     MWA         MOVE DATA TO CIR BLOCK 
  
*         WRITE CIR ENTRIES TO FILE LIST IF CIR LIST SELECTED.
  
 OCI1     SA1    CPAR+/COMSPFS/CPLO 
          LX1    59-58
          PL     X1,OCIX     IF NO CIR SORT REQUIRED
          SA1    OCIA 
          SA2    OCIB 
          SB2    42          SET SHIFT COUNT FOR USER INDEX SORT
          SB3    X1 
          SB6    X1          SET BUFFER FWA 
          SB7    X2          SET BUFFER LWA+1 
 OCI2     SA2    B3 
          LX6    B2,X2       POSITION USER INDEX FOR SORT 
          SA6    A2+
          SB3    B3+NWCI
          LT     B3,B7,OCI2  IF NOT END OF BUFFER 
          SB7    B7-B6       SET WORD COUNT 
          WRITEW PF,B6,B7    WRITE CIR ENTRIES
          SX6    1
          SA6    FPSF        SET FILES PROCESSED
          EQ     OCIX        RETURN 
  
  
 OCIA     CON    0           BUFFER ADDRESS 
 OCIB     CON    0           BUFFER LWA+1 
          TITLE  COMCPFS - SORTED AND STATISTICAL OUTPUT MAIN ROUTINES. 
          SPACE  4,10 
**        ASSEMBLY CONSTANTS. 
  
  
 NWCS     EQU    NWCE+2      LENGTH OF CATALOG ENTRY WITH STATUS WORDS
 SBCEC    EQU    SRTBL/NWCS  MAXIMUM CATALOG ENTRIES IN SORT BUFFER 
 SBCIC    EQU    SRTBL/NWCI  MAXIMUM CIR ENTRIES IN SORT BUFFER 
 SBCEL    EQU    SBCEC*NWCS  MAXIMUM LENGTH OF CATALOG ENTRIES
 SBCIL    EQU    SBCIC*NWCI  MAXIMUM LENGTH OF CIR ENTRIES
 OSF      SPACE  4,15 
**        OSF - OUTPUT SORTED FILE LIST.
* 
*         ENTRY  SORTED CATALOG ENTRIES ON FILE *S3*. 
* 
*         EXIT   SORTED FILE LIST GENERATED IF SELECTED.
* 
*         USES   X - 1, 2, 6. 
*                A - 0, 1  6. 
* 
*         CALLS  RPP, WCO.
* 
*         MACROS READ, READW, REWIND. 
  
  
 OSF      SUBR               ENTRY/EXIT 
          SA1    CPAR+/COMSPFS/CPLO 
          PL     X1,OSFX     IF FILE LIST NOT SELECTED
          SX2    FLTX 
          SX6    CES
          RJ     RPP         RESET PAGE PARAMETERS
          REWIND S3 
          READ   S3 
          SA0    SW1B        SET CATALOG ENTRY ADDRESS
 OSF1     READW  S3,A0,NWCS  READ CATALOG ENTRY AND STATUS
          NZ     X1,OSFX     IF END OF ENTRIES
          SA1    A0+FCUI
          LX1    18          RESTORE FILE NAME AND USER INDEX 
          BX6    X1 
          SA6    A1          RESTORE FILE NAME AND USER INDEX 
          RJ     WCO         WRITE CATALOG ENTRY DATA TO OUTPUT FILE
          EQ     OSF1        READ NEXT ENTRY
 OTS      SPACE  4,15 
**        OTS - OUTPUT TAPE ALTERNATE STORAGE STATISTICS. 
* 
*         ENTRY  CATALOG ENTRIES ON FILE *S3* SORTED BY TAPE ALTERNATE
*                  STORAGE TYPE AND VSN.
* 
*         EXIT   TAPE ALTERNATE STORAGE STATISTICS OUTPUT COMPLETE. 
* 
*         USES   X - 1, 2, 3, 4, 5, 6, 7. 
*                A - 1, 2, 3, 5, 6, 7.
* 
*         CALLS  ALN, CDD, CFS, IFS, RPP, ZTB.
* 
*         MACROS READ, READW, REWIND, WRITEH. 
  
  
 OTS      SUBR               ENTRY/EXIT 
  
*         INITIALIZE PAGE TITLE.
  
          REWIND S3 
          READ   S3 
          SX2    TSTX 
          SX6    TSS
          RJ     RPP         RESET PAGE PARAMETERS
          SX6    B0+
          SA6    OTSA        INITIALIZE VSN POINTER 
  
*         CHECK NEXT ENTRY. 
  
 OTS1     READW  S3,SW1B,1   READ ENTRY 
          BX6    X1 
          SA6    OTSB        SAVE EOR STATUS
          SA5    OTSA 
          SA2    SW1B 
          SA3    TSKM 
          NZ     X6,OTS2     IF END OF ENTRIES
          BX6    X3*X2       TAPE IDENTIFIER FROM CURRENT ENTRY 
          BX2    X5-X6
          ZR     X2,OTS5     IF SAME TAPE AS PREVIOUS ENTRY 
          SA6    A5+         SET TAPE IDENTIFIER
          ZR     X5,OTS4     IF FIRST ENTRY 
  
*         OUTPUT STATISTICS FOR PREVIOUS VSN. 
  
 OTS2     LX5    59-56
          SX1    2RAT        SET ACS CARTRIDGE TAPE 
          LX4    X5,B1
          NG     X5,OTS3     IF ACS CARTRDIGE TAPE
          SX1    2RCT        SET CARTRIDGE TAPE 
          NG     X4,OTS3     IF CARTRIDGE TAPE
          SX1    2RNT        SET NINE TRACK TAPE
 OTS3     LX5    56-56-59+56
          RJ     ZTB         BLANK FILL TAPE TYPE 
          SA6    COBF+0      SET TAPE IDENTIFIER
          MX6    -12
          BX1    -X6*X5      VSN SEQUENCE NUMBER
          SX1    X1+10000D   ADD BIAS TO FORCE LEADING ZEROES 
          RJ     CDD         CONVERT SEQUENCE NUMBER
          MX7    -12
          LX7    12 
          BX7    -X7*X5      VSN PREFIX 
          MX1    -24
          LX7    12 
          BX1    -X1*X6 
          BX1    X7+X1       MERGE PREFIX AND SEQUENCE NUMBER 
          RJ     ZTB         BLANK FILL VSN 
          SA6    COBF+1      SET VSN
          SA5    OTSC        SET CONTROL TABLE ADDRESS
          RJ     CFS         CONVERT FILE STATISTICS
          SX6    1
          RJ     ALN         ALLOCATE ONE LINE
          WRITEH O,COBF,4    WRITE VSN STATISTICS 
          SA1    OTSB 
          NZ     X1,OTSX     IF END OF ENTRIES
 OTS4     RJ     IFS         INITIALIZE STATISTICS FOR NEXT VSN 
  
*         ACCUMULATE TAPE ALTERNATE STORAGE STATISTICS. 
  
 OTS5     SA1    SW1B 
          SA2    NFIL+2 
          SA3    NSEC+2 
          SX6    B1 
          MX7    -24
          LX1    -24
          BX7    -X7*X1      FILE LENGTH
          IX6    X2+X6       ACCUMULATE TOTAL FILES 
          IX7    X3+X7       ACCUMULATE TOTAL SECTORS 
          SA6    A2 
          SA7    A3 
          EQ     OTS1        READ NEXT ENTRY
  
  
 OTSA     CON    0           PREVIOUS TAPE INDENTIFIER
 OTSB     CON    0           READ EOR STATUS
  
 OTSC     BSS    0           START OF FILE STATISTICS CONVERSIONS 
          VFD    30/COBF+2,30/NFIL+2  TOTAL FILES 
          VFD    30/COBF+3,30/NSEC+2  TOTAL SECTORS 
          CON    0           END OF CONVERSIONS 
 OUS      SPACE  4,15 
**        OUS - OUTPUT USER STATISTICS. 
* 
*         ENTRY  CATALOG ENTRIES ON FILE *S3* SORTED BY USER INDEX AND
*                  FILE NAME. 
* 
*         EXIT   USER SORTED STATISTICS OUTPUT COMPLETE.
* 
*         USES   X - 1, 2, 3, 5, 6. 
*                A - 1, 2, 5, 6.
* 
*         CALLS  AFS, ALN, CFS, COD, IFS, RPP, SID. 
* 
*         MACROS READ, READW, REWIND, WRITEH. 
  
  
 OUS      SUBR               ENTRY/EXIT 
  
*         INITIALIZE PAGE TITLE.
  
          SA1    CPAR+/COMSPFS/CPLO 
          LX1    59-56
          PL     X1,OUSX     IF *S* LIST OPTION NOT SELECTED
          REWIND S3 
          READ   S3 
          SX2    USTX 
          SX6    USS
          RJ     RPP         RESET PAGE PARAMETERS
          SX6    0
          SA6    OUSA        CLEAR PREVIOUS ENTRY USER INDEX
  
*         CHECK NEXT CATALOG ENTRY. 
  
 OUS1     READW  S3,SW1B,NWCS  READ ENTRY 
          BX6    X1 
          SA6    OUSB        SAVE EOR STATUS
          SA1    OUSA 
          SA2    SW1B+FCUI
          NZ     X6,OUS2     IF END OF ENTRIES
          LX2    18 
          SX6    X2          USER INDEX FROM CURRENT ENTRY
          BX2    X1-X6
          SA6    A1+         SET USER INDEX 
          ZR     X2,OUS4     IF SAME USER INDEX AS PREVIOUS ENTRY 
          ZR     X1,OUS3     IF FIRST ENTRY 
  
*         OUTPUT STATISTICS FOR PREVIOUS USER INDEX.
  
 OUS2     RJ     COD         CONVERT USER INDEX FOR OUTPUT
          SA6    COBF+0 
          RJ     SID         SUM INDIRECT AND DIRECT FILE STATISTICS
          SA1    NSEC+2      COMPUTE AVERAGE FILE SIZE
          SA2    NFIL+2 
          IX6    X1/X2
          SA6    AVFS        SET AVERAGE FILE SIZE
          SA5    OUSC        SET CONTROL TABLE ADDRESS
          RJ     CFS         CONVERT FILE STATISTICS
          SX6    1
          RJ     ALN         ALLOCATE ONE LINE
          WRITEH O,COBF,12   WRITE USER STATISTICS
          SA1    OUSB        GET EOR STATUS 
          NZ     X1,OUSX     IF END OF ENTRIES
 OUS3     RJ     IFS         INITIALIZE FILE STATISTICS FOR NEXT USER 
  
*         ACCUMULATE FILE STATISTICS. 
  
 OUS4     RJ     AFS         ACCUMULATE FILE STATISTICS 
          EQ     OUS1        READ NEXT ENTRY
  
  
 OUSA     CON    0           PREVIOUS ENTRY USER INDEX
 OUSB     CON    0           READ EOR STATUS
  
 OUSC     BSS    0           START OF FILE STATISTIC CONVERSIONS
          VFD    30/COBF+1,30/NFIL+2  TOTAL FILES 
          VFD    30/COBF+2,30/NSEC+2  TOTAL SECTORS 
          VFD    30/COBF+3,30/AVFS    AVERAGE FILE SIZE 
          VFD    30/COBF+4,30/NFIL+0  INDIRECT ACCESS FILES 
          VFD    30/COBF+5,30/NFIL+1  DIRECT ACCESS FILES 
          VFD    30/COBF+6,30/DFIL    DISK RESIDENT FILES 
          VFD    30/COBF+7,30/DSEC    DISK RESIDENT SECTORS 
          VFD    30/COBF+8,30/CFIL    CARTRIDGE RESIDENT FILES
          VFD    30/COBF+9,30/CSEC    CARTRIDGE RESIDENT SECTORS
          VFD    30/COBF+10,30/TFIL   TAPE RESIDENT FILES 
          VFD    30/COBF+11,30/TSEC   TAPE RESIDENT SECTORS 
          CON    0           END OF CONVERSIONS 
 PSF      SPACE  4,15 
**        PSF - PROCESS SORTED FILE OUTPUT. 
* 
*         ENTRY  CATALOG ENTRIES ON FILE *PF* IF SORTED FILE LIST 
*                  SELECTED.
* 
*         EXIT   SORTED FILE LIST OUTPUT COMPLETE.
* 
*         USES   X - 1, 2, 6, 7.
*                A - 0, 1, 2, 6, 7. 
* 
*         CALLS  OSF, OUS, OTS, SCE, SDT. 
* 
*         MACROS READ, READW, REWIND, WRITER. 
  
  
 PSF3     RJ     SDT         RESET DEFAULT PAGE TITLE 
  
 PSF      SUBR               ENTRY/EXIT 
  
*         CHECK  FOR SORTED OUTPUT. 
  
          SA1    FPSF 
          ZR     X1,PSFX     IF NO FILES PROCESSED FOR SORTED OUTPUT
          WRITER PF          FLUSH FILE LIST FILE 
  
*         PROCESS SORTED FILE LIST AND USER STATISTICS. 
  
          RJ     SCE         SORT CATALOG ENTRIES BY USER AND FILE NAME 
          RJ     OSF         LIST FILES BY USER INDEX AND FILE NAME 
          RJ     OUS         OUTPUT USER STATISTICS 
  
*         PROCESS TAPE ALTERNATE STORAGE STATISTICS.
  
 PSF2     SA1    CPAR+/COMSPFS/CPLO 
          LX1    59-56
          PL     X1,PSF3     IF STATISTICS NOT SELECTED 
          RJ     STD         SORT TAPE ALTERNATE STORAGE DATA 
          ZR     X1,PSF3     IF NO ALTERNATE STORAGE DATA 
          RJ     OTS         OUTPUT TAPE ALTERNATE STORAGE STATISTICS 
          EQ     PSF3        RETURN 
 PSI      SPACE  4,15 
**        PSI - PROCESS SORTED CIR OUTPUT.
* 
*         ENTRY  CIR ENTRIES ON FILE *PF* IF SORTED CIR LIST SELECTED.
* 
*         EXIT   SORTED CIR LIST OUTPUT COMPLETE. 
* 
*         USES   X - 1, 2, 6. 
*                A - 1, 6.
* 
*         CALLS  FCI,  ISF, RPP, SDT. 
* 
*         MACROS READ, READW, REWIND, WRITER. 
  
  
 PSI4     RJ     SDT         RESET DEFAULT PAGE TITLE 
  
 PSI      SUBR               ENTRY/EXIT 
          SA1    FPSF 
          ZR     X1,PSIX     IF NO FILES PROCESSED FOR SORTED OUTPUT
  
*         SORT CIR ENTRIES. 
  
          WRITER PF          FLUSH FILE LIST FILE 
          REWIND PF 
          READ   PF 
          RJ     ISF         INITIALIZE SORT FILES
 PSI1     READW  PF,SRTB,SBCIL
          SB7    B7-SBCIL 
          ZR     B7,PSI2     IF END OF ENTRIES
          MX0    60          SET SORT KEY MASK
          SX1    B1          SET SORT KEY LENGTH
          SB4    1           SET KEY OFFSET 
          SB5    NWCI        SET ENTRY LENGTH 
          RJ     WSB         WRITE SORTED ENTRIES TO FILE 
          EQ     PSI1        READ NEXT BUFFER OF ENTRIES
  
 PSI2     WRITER S1 
          WRITER S2 
          SX0    NWCI        SET ENTRY LENGTH 
          SX1    SBCIC       SET FULL BLOCK ENTRY COUNT 
          MX2    60          SET SORT KEY MASK
          SB4    B0          SET KEY OFFSET 
          SB5    1           SET KEY LENGTH 
          SA0    SW1B        SET WORKING BUFFER 1 ADDRESS 
          SA5    SW2B        SET WORKING BUFFER 2 ADDRESS 
          RJ     MSF         MERGE SORT FILES 
  
*         OUTPUT SORTED CIR ENTRIES.
  
          SX2    CITX        SET CIR TITLE TEXT 
          SX6    CIS         SET CIR SUBHEADER
          RJ     RPP         RESET PAGE PARAMETERS
          SX6    O           SET OUTPUT FILE FET ADDRESS
          SA6    OFFA 
          REWIND S3 
          READ   S3 
 PSI3     READW  S3,SW1B,NWCI  READ CIR ENTRY 
          NZ     X1,PSI4     IF EOR ENCOUNTERED 
          SA1    SW1B 
          LX1    18 
          BX6    X1          RESTORE FILE NAME AND USER INDEX 
          SA6    A1 
          SX6    A1          SET ENTRY ADDRESS
          RJ     FCI         FORMAT AND OUTPUT CIR ENTRY
          EQ     PSI3        READ NEXT ENTRY
 SCE      SPACE  4,15 
**        SCE - SORT CATALOG ENTRIES. 
* 
*         ENTRY  UNSORTED CATALOG ENTRIES ON FILE *PF*. 
* 
*         EXIT   SORTED CATALOG ENTRIES ON FILE *S3*. 
* 
*         USES   X - 0, 1, 2, 3, 6. 
*                A - 0, 1, 2, 3, 5, 6, 7. 
*                B - 4, 5, 7. 
* 
*         CALLS  ISF, MSF, WSB. 
* 
*         MACROS READ, READW, REWIND, WRITER. 
  
  
 SCE      SUBR               ENTRY/EXIT 
          REWIND PF 
          READ   PF 
          RJ     ISF         INITIALIZE SORT FILES
 SCE1     READW  PF,SRTB,SBCEL
          SB7    B7-SBCEL 
          ZR     B7,SCE2     IF END OF ENTRIES
          MX0    60          SET KEY MASK 
          SX1    B1          SET SORT KEY LENGTH
          SB4    1           SET KEY OFFSET 
          SB5    NWCS        SET ENTRY LENGTH 
          RJ     WSB         WRITE SORTED ENTRIES TO FILE 
          EQ     SCE1        READ NEXT BUFFER OF ENTRIES
  
 SCE2     WRITER S1          FLUSH BUFFER 
          WRITER S2          FLUSH BUFFER 
          SX0    NWCS        SET ENTRY LENGTH 
          SX1    SBCEC       SET FULL BLOCK ENTRY COUNT 
          MX2    60          SET KEY MASK 
          SB4    B0          SET KEY OFFSET 
          SB5    1           SET KEY LENGTH 
          SA0    SW1B        SET WORKING BUFFER 1 ADDRESS 
          SA5    SW2B        SET WORKING BUFFER 2 ADDRESS 
          RJ     MSF         MERGE SORT FILES 
          EQ     SCEX        RETURN 
 STD      SPACE  4,15 
**        STD - SORT TAPE ALTERNATE STORAGE DATA. 
* 
*         ENTRY  PROCESSED CATALOG ENTRIES ON FILE *PF*.
* 
*         EXIT   (X1) = 0 IF NO TAPE ALTERNATE STORAGE DATA.
*                (X1) = 1 IF ALTERNATE  STORAGE DATA TO PROCESS.
*                SORTED TAPE ALTERNATE STORAGE DATA ON FILE *S3*. 
* 
*         USES   X - 0, 1, 2, 3, 6. 
*                A - 0, 1, 2, 3, 5, 6, 7. 
*                B - 4, 5, 7. 
* 
*         CALLS  ISF, MSF, WSB. 
* 
*         MACROS READ, READW, REWIND, WRITER. 
  
  
 STD      SUBR               ENTRY/EXIT 
          REWIND PF 
          READ   PF 
          RJ     ISF         INITIALIZE SORT FILES
          SX6    B0+
          SA6    STDC        CLEAR DATA FLAG
  
*         WRITE DATA ENTRIES TO SORT FILES. 
  
 STD1     SX6    SRTB 
          SA6    STDA        INITIALIZE SORT BUFFER POINTER 
 STD2     READW  PF,SW1B,NWCS  READ CATALOG ENTRY AND STATUS
          SA2    SW1B+FCTV
          BX6    X1 
          SA6    STDB        SAVE EOR STATUS
          NZ     X1,STD3     IF END OF ENTRIES
          ZR     X2,STD2     IF FILE NOT ON TAPE ALTERNATE STORAGE
          SA3    SW1B+FCLF
          SA4    STDA 
          MX6    36 
          LX6    24 
          BX2    X6*X2       ALTERNATE STORAGE FLAGS AND VSN IDENTIFIER 
          LX3    -12
          BX3    -X6*X3      FILE LENGTH
          BX6    X2+X3       MERGE VSN, FLAGS, AND FILE LENGTH
          SA6    X4+         SET ALTERNATE STORAGE DATA IN SORT BUFFER
          SX6    X4+1        ADVANCE BUFFER INDEX 
          SA6    STDC        INDICATE DATA PRESENT
          SA6    A4+
          SX1    X6-SRTB-SRTBL
          NG     X1,STD2     IF SORT BUFFER NOT FULL
 STD3     SA4    STDA 
          SA2    TSKM 
          SX6    X4-SRTB
          ZR     X6,STD4     IF NO ENTRIES IN BUFFER
          SX1    B1          SET SORT KEY LENGTH
          SB4    B1          SET KEY OFFSET 
          SB5    B1          SET ENTRY LENGTH 
          BX0    X2          SET KEY MASK 
          SB6    X4          SET LWA+1 OF ENTRIES 
          RJ     WSB         WRITE SORTED ENTRIES TO FILE 
          SA1    STDB 
          ZR     X1,STD1     IF NOT END OF ENTRIES
  
*         MERGE SORT FILES. 
  
 STD4     SA1    STDC 
          ZR     X1,STDX     IF NO DATA PRESENT 
          WRITER S1          FLUSH BUFFER 
          WRITER S2          FLUSH BUFFER 
          SA2    TSKM        SET KEY MASK 
          SX0    1           SET ENTRY LENGTH 
          SX1    SRTBL       SET FULL BLOCK ENTRY COUNT 
          SB4    B0          SET KEY OFFSET 
          SB5    B1          SET KEY LENGTH 
          SA0    SW1B        SET WORKING BUFFER 1 ADDRESS 
          SA5    SW2B        SET WORKING BUFFER 2 ADDRESS 
          RJ     MSF         MERGE SORT FILES 
          SX1    B1          INDICATE DATA PRESENT
          EQ     STDX        RETURN 
  
  
 STDA     CON    0           SORT BUFFER INDEX
 STDB     CON    0           EOR STATUS 
 STDC     CON    0           DATA PRESENT FLAG
          SPACE  4,10 
**        GLOBAL DATA.
  
  
 SFFA     CON    S1          SORT FILE FET ADDRESS
 TSKM     DATA   06000000000077777777B  TAPE ALTERNATE STORAGE KEY MASK 
          TITLE  COMCPFS - SORTED AND STATISTICAL OUTPUT SUBROUTINES. 
 AFS      SPACE  4,20 
**        AFS - ACCUMULATE FILE STATISTICS. 
* 
*         ENTRY  CATALOG ENTRY IN *SW1B*. 
* 
*         EXIT   (NFIL+0) UPDATED IF INDIRECT ACCESS FILE.
*                (NFIL+1) UPDATED IF DIRECT ACCESS FILE.
*                (NSEC+0) UPDATED IF INDIRECT ACCESS FILE.
*                (NSEC+1) UPDATED IF DIRECT ACCESS FILE.
*                (DFIL) UPDATED IF FILE DISK RESIDENT.
*                (DSEC) UPDATED IF FILE DISK RESIDENT.
*                (CFIL) UPDATED IF FILE CARTRIDGE RESIDENT. 
*                (CSEC) UPDATED IF FILE CARTRIDGE RESIDENT. 
*                (TFIL) UPDATED IF FILE TAPE RESIDENT.
*                (TSEC) UPDATED IF FILE TAPE RESIDENT.
* 
*         USES   X - 1, 2, 3, 4, 5, 6, 7. 
*                A - 1, 2, 3, 6, 7. 
  
  
 AFS      SUBR               ENTRY/EXIT 
          SA1    SW1B+FCLF+FCBT*0+FCBS*0
          MX6    -1 
          LX1    0-11 
          BX6    -X6*X1      DIRECT/INDIRECT ACCESS FILE STATUS 
          LX1    0-36-0+11
          SA2    NFIL+X6     GET FILE COUNT 
          SA3    NSEC+X6     GET SECTOR COUNT 
          MX5    -24
          SX4    B1 
          BX5    -X5*X1      FILE LENGTH
          LX1    59-23-0+36-60
          IX6    X2+X4       ACCUMULATE INDIRECT/DIRECT FILES 
          IX7    X3+X5       ACCUMULATE INDIRECT/DIRECT SECTORS 
          SA6    A2 
          SA7    A3 
          PL     X1,AFS1     IF FILE NOT DISK RESIDENT
          SA2    DFIL 
          SA3    DSEC 
          IX6    X2+X4       ACCUMULATE DISK RESIDENT FILES 
          IX7    X3+X5       ACCUMULATE DISK RESIDENT SECTORS 
          SA6    A2 
          SA7    A3 
 AFS1     SA1    SW1B+FCAA
          MX6    -36
          BX6    -X6*X1 
          LX1    59-48
          ZR     X6,AFS2     IF FILE NOT CARTRIDGE RESIDENT 
          NG     X1,AFS2     IF CARTRIDGE COPY OBSOLETE 
          SA2    CFIL 
          SA3    CSEC 
          IX6    X2+X4       ACCUMULATE CARTRIDGE RESIDENT FILES
          IX7    X3+X5       ACCUMULATE CARTRIDGE RESIDENT SECTORS
          SA6    A2+
          SA7    A3+
 AFS2     SA1    SW1B+FCTV
          MX6    -24
          BX6    -X6*X1 
          ZR     X6,AFSX     IF FILE NOT TAPE RESIDENT
          SA2    TFIL 
          SA3    TSEC 
          IX6    X2+X4       ACCUMULATE TAPE RESIDENT FILES 
          IX7    X3+X5       ACCUMULATE TAPE RESIDENT SECTORS 
          SA6    A2 
          SA7    A3 
          EQ     AFSX        RETURN 
 CFS      SPACE  4,15 
**        CFS - CONVERT FILE STATISTICS FOR OUTPUT. 
* 
*         ENTRY  (A5) = ADDRESS OF FIRST CONVERSION TABLE ENTRY.
*                (X5) = FIRST CONVERSION TABLE ENTRY. 
*                CONVERSION TABLE ENTRY FORMAT -
*                  30/ CONVERTED VALUE ADDRESS, 30/ STATISTIC ADDRESS 
*                CONVERSION TABLE TERMINATED WITH ZERO WORD.
* 
*         EXIT   FILE STATISTICS CONVERTED FOR OUTPUT.
* 
*         USES   X - 1, 5.
*                A - 1, 5, 6. 
* 
*         CALLS  CDD. 
  
  
 CFS      SUBR               ENTRY/EXIT 
 CFS1     SA1    X5 
          RJ     CDD         CONVERT VALUE
          AX5    30          SET CONVERTED VALUE ADDRESS
          SA6    X5          STORE CONVERTED VALUE
          SA5    A5+1 
          NZ     X5,CFS1     IF MORE ENTRIES
          EQ     CFSX        RETURN 
 IFS      SPACE  4,10 
**        IFS - INITIALIZE FILE STATISTICS AREA.
* 
*         EXIT   FILE STATISTICS CLEARED. 
* 
*         USES   X - 1, 2, 6. 
*                A - 1, 6.
  
  
 IFS      SUBR               ENTRY/EXIT 
          SA1    FSTA 
          SX6    0
 IFS1     SA6    A1 
          SA1    A1+B1
          SX2    A1-FSTA-FSTAL
          NZ     X2,IFS1     IF MORE TO CLEAR 
          EQ     IFSX        RETURN 
 SID      SPACE  4,15 
**        SID - SUM INDIRECT AND DIRECT ACCESS FILE COUNTS. 
* 
*         ENTRY  (NFIL+0) = INDIRECT ACCESS FILE COUNT. 
*                (NFIL+1) = DIRECT ACCESS FILE COUNT. 
*                (NSEC+0) = INDIRECT ACCESS SECTOR COUNT. 
*                (NSEC+1) = DIRECT ACCESS SECTOR COUNT. 
* 
*         EXIT   (NFIL+2) = TOTAL FILE COUNT. 
*                (NSEC=2) = TOTAL SECTOR COUNT. 
* 
*         USES   X - 1, 2, 6. 
*                A - 1, 2, 6. 
  
  
 SID      SUBR               ENTRY/EXIT 
          SA1    NFIL+0 
          SA2    NFIL+1 
          IX6    X1+X2
          SA6    A2+B1       SET TOTAL FILE COUNT 
          SA1    NSEC+0 
          SA2    NSEC+1 
          IX6    X1+X2
          SA6    A2+B1       SET TOTAL SECTOR COUNT 
          EQ     SIDX        RETURN 
 TSS      SPACE  4,10 
**        TSS - WRITE TAPE ALTERNATE STORAGE STATISTICS SUBHEADER.
* 
*         ENTRY  (X2) = OUTPUT FILE FET ADDRESS.
* 
*         EXIT   TO SHR.
*                (X6) = SUBHEADER LINE COUNT. 
* 
*         USES   X - 6. 
* 
*         MACROS WRITEH.
  
  
 TSS      BSS    0           ENTRY
          WRITEH X2,TSSA,4   WRITE TAPE ALTERNATE STORAGE SUBHEADER 
          WRITEH X2,BLAN,1
          SX6    2           SET LINE COUNT 
          EQ     SHR         RETURN 
 USS      SPACE  4,10 
**        USS - WRITE USER STATISTICS SUBHEADER.
* 
*         ENTRY  (X2) = OUTPUT FILE FET ADDRESS.
* 
*         EXIT   TO SHR.
*                (X6) = SUBHEADER LINE COUNT. 
* 
*         USES   X - 6. 
* 
*         MACROS WRITEH.
  
  
 USS      BSS    0           ENTRY
          WRITEH X2,USSA,12  WRITE USER STATISTICS SUBHEADER
          WRITEH X2,USSB,12 
          WRITEH X2,USSC,12 
          WRITEH X2,BLAN,1
          SX6    4           SET LINE COUNT 
          EQ     SHR         RETURN 
          SPACE  4,10 
**        FILE STATISTICS AREA. 
  
  
 FSTA     BSS    0           START OF FILE STATISTICS AREA
  
 NFIL     CON    0           INDIRECT ACCESS FILES
          CON    0           DIRECT ACCESS FILES
          CON    0           TOTAL FILES
 NSEC     CON    0           INDIRECT ACCESS SECTORS
          CON    0           DIRECT ACCESS SECTORS
          CON    0           TOTAL SECTORS
  
 AVFS     CON    0           AVERAGE FILE SIZE
  
 DFIL     CON    0           DISK RESIDENT FILES
 DSEC     CON    0           DISK RESIDENT SECTORS
  
 CFIL     CON    0           CARTRIDGE RESIDENT FILES 
 CSEC     CON    0           CARTRIDGE RESIDENT SECTORS 
  
 TFIL     CON    0           TAPE RESIDENT FILES
 TSEC     CON    0           TAPE RESIDENT SECTORS
  
 FSTAL    EQU    *-FSTA      LENGTH OF FILE STATISTICS AREA 
          SPACE  4,10 
*         TAPE ALTERNATE STORAGE STATISTICS SUBHEADER.
  
 TSSA     DATA   50H      TYPE       VSN     FILES   SECTORS
          SPACE  4,10 
**        USER STATISTICS PAGE SUBHEADER. 
  
  
 USSA     DATA   50H      USER     TOTAL     TOTAL   AVERAGE  INDIRECT
          DATA   50H    DIRECT      DISK      DISK CARTRIDGE CARTRIDGE
          DATA   20H      TAPE      TAPE
 USSB     DATA   50H     INDEX     FILES   SECTORS   SECTORS    ACCESS
          DATA   50H    ACCESS  RESIDENT  RESIDENT  RESIDENT  RESIDENT
          DATA   20H  RESIDENT  RESIDENT
 USSC     DATA   50H                                PER FILE     FILES
          DATA   50H     FILES     FILES   SECTORS     FILES   SECTORS
          DATA   20H     FILES   SECTORS
          TITLE  COMCPFS - OUTPUT FILE GENERAL SUBROUTINES. 
          SPACE  4,10 
*         *COMCFCE* EQUIVALENCES. 
  
  
 CHDR1    EQU    /COMCFCE/CHDR1  CATALOG ENTRY SUBHEADER WORD 1 
 CHDR2    EQU    /COMCFCE/CHDR2  CATALOG ENTRY SUBHEADER WORD 2 
 CHDR3    EQU    /COMCFCE/CHDR3  CATALOG ENTRY SUBHEADER WORD 3 
 CHDR4    EQU    /COMCFCE/CHDR4  CATALOG ENTRY SUBHEADER WORD 4 
 FCELL    EQU    /COMCFCE/FCELL  LENGTH OF FIRST THREE LINES
 FCELB    EQU    /COMCFCE/FCELB  LENGTH OF FOURTH LINE
 ACMD     EQU    /COMCFCE/ACMD   DIRECT/INDIRECT FILE TYPE
 NMPS     EQU    /COMCFCE/NMPS   FILE NUMBER LINE DEFINITION
 FNPS     EQU    /COMCFCE/FNPS   FILE NAME LINE DEFINITION
 AMPS     EQU    /COMCFCE/AMPS   FILE TYPE LINE DEFINITION
 LEPS     EQU    /COMCFCE/LEPS   FILE LENGTH LINE DEFINITION
 CDPS     EQU    /COMCFCE/CDPS   CREATION DATE LINE DEFINITION
 CTPS     EQU    /COMCFCE/CTPS   CREATION TIME LINE DEFINITION
 ALN      SPACE  4,20 
**        ALN - ALLOCATE LINES. 
* 
*         ENTRY  (X6) = NUMBER OF LINES REQUIRED. 
*                (OFFA) = OUTPUT FILE FET ADDRESS.
*                (PSPA) = PAGE SUBHEADER PROCESSOR ADDRESS. 
* 
*         EXIT   (PGLC) = UPDATED LINE COUNT. 
*                (PAGE) = UPDATED PAGE NUMBER IF NEW PAGE.
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 2, 3, 6, 7. 
*                B - 2. 
* 
*         CALLS  CDD, SPECIFIED PAGE SUBHEADER PROCESSOR. 
* 
*         MACROS WRITEH.
  
  
 ALN2     SA7    PGLC        SET LINE COUNT 
  
 ALN      SUBR               ENTRY/EXIT 
 ALN1     SA1    PGLC 
          SA2    PGLL 
          IX7    X1+X6       ADVANCE LINES ON PAGE
          IX2    X2-X7
          PL     X2,ALN2     IF ROOM ON CURRENT PAGE
          SA1    PAGE 
          SX6    X6+3        COUNT TITLE AND REQUIRED LINES 
          SA6    PGLC        SET LINE COUNT 
          SX6    X1+B1
          SA6    A1 
          RJ     CDD         SET PAGE NUMBER IN PAGE TITLE
          LX6    24 
          SA6    PGPN+1 
          SA2    OFFA        SET FET ADDRESS
          WRITEH X2,PGTA,PGTAL  WRITE PAGE TITLE
          WRITEH X2,PGTB,PGTBL
          WRITEH X2,BLAN,1
          SA1    PSPA 
          ZR     X1,ALNX     IF NO SUBHEADER PROCESSOR
          SB2    X1+         SET SUBHEADER PROCESSOR ENTRY ADDRESS
          JP     B2          EXECUTE SUBHEADER PROCESSOR
 SHR      BSS    0           DEFINE SUBHEADER PROCESSOR RETURN
          EQ     ALN1        ADVANCE LINE COUNT 
 CES      SPACE  4,10 
**        CES - WRITE CATALOG ENTRY SUBHEADER.
* 
*         ENTRY  (X2) = OUTPUT FILE FET ADDRESS.
* 
*         EXIT   TO SHR.
*                (X6) = SUBHEADER LINE COUNT. 
* 
*         MACROS WRITEH.
  
  
 CES      BSS    0           ENTRY
          WRITEH X2,CHDR1,FCELL  WRITE CATALOG ENTRY SUBHEADER
          WRITEH X2,CHDR2,FCELL 
          WRITEH X2,CHDR3,FCELL 
          WRITEH X2,CHDR4,FCELB 
          SX6    4           SET LINE COUNT 
          EQ     SHR         RETURN 
 CIS      SPACE  4,10 
**        CIS - WRITE CIR ENTRY SUBHEADER.
* 
*         ENTRY  (X2) = OUTPUT FILE FET ADDRESS.
* 
*         EXIT   TO SHR.
*                (X6) = SUBHEADER LINE COUNT. 
* 
*         MACROS WRITEH.
  
  
 CIS      BSS    0           ENTRY
          WRITEH X2,CISA,7   WRITE CIR SUBHEADER
          WRITEH X2,CISB,7
          SX6    2           SET LINE COUNT 
          EQ     SHR         RETURN 
 FAB      SPACE  4,15 
**        FAB - FLUSH SUMMARY FILE ASSEMBLY BUFFER. 
* 
*         ENTRY  (SABF) = FWA SUMMARY FILE ASSEMBLY BUFFER. 
*                (SABI) = SUMMARY FILE ASSEMBLY BUFFER IN 
*                  POINTER. 
*                (CFBI) = CONTROL WORD BLOCK INDENTIFIER. 
* 
*         EXIT   DATA IN ASSEMBLY BUFFER WRITTEN TO FILE. 
* 
*         USES   X - 1, 2, 3, 6.
*                A - 1, 3, 6. 
*                B - 7. 
* 
*         MACROS WRITEW.
  
  
 FAB      SUBR               ENTRY/EXIT 
          SA3    SABI 
          SA1    CFBI 
          SX2    X3-SABF     SET BLOCK WORD COUNT 
          ZR     X2,FABX     IF ASSEMBLY BUFFER EMPTY 
          BX6    X1+X2       BLOCK CONTROL WORD 
          SB7    X2+B1       SET WORD COUNT TO WRITE
          SA6    SBCW 
          WRITEW SU,SBCW,B7  WRITE CONTROL WORD AND BLOCK 
          SX6    SABF        RESET IN POINTER 
          SA6    SABI 
          EQ     FABX        RETURN 
 FCI      SPACE  4,15 
**        FCI - FORMAT CIR ENTRY FOR OUTPUT.
* 
*         ENTRY  (X6) = FWA OF CIR ENTRY. 
*                (OFFA) = OUTPUT FILE FET ADDRESS.
* 
*         EXIT   ENTRY WRITTEN TO OUTPUT FILE.
* 
*         USES   X - 1, 2, 5, 6.
*                A - 1, 6.
* 
*         CALLS  ALN, CDD, COD, SFN.
* 
*         MACROS EDATE, ETIME, WRITEH.
  
  
 FCI      SUBR               ENTRY/EXIT 
          SA6    FCIA        SAVE CIR ENTRY ADDRESS 
          SA1    CENN        INCREMENT CATALOG ENTRY NUMBER 
          SX6    X1+B1
          SA6    A1 
          SX6    2           ALLOCATE LINES FOR ENTRY 
          RJ     ALN
          SA1    CENN        OUTPUT ENTRY NUMBER
          RJ     CDD
          LX6    12 
          SA6    COBF 
          SA1    FCIA        GET FILE NAME AND USER INDEX 
          SA1    X1 
          MX6    42 
          BX5    -X6*X1 
          BX1    X6*X1
          RJ     SFN         SPACE FILL FILE NAME 
          SA6    COBF+B1     SET FILE NAME
          BX1    X5 
          RJ     COD         CONVER USER INDEX
          LX6    12 
          SA6    COBF+2      SET USER INDEX 
          SA1    FCIA        GET ACCESS COUNT AND DEVICE NUMBER 
          SA1    X1+B1
          MX2    18 
          BX5    X2*X1       ACCESS COUNT 
          LX5    18 
          LX1    18 
          MX2    6
          BX1    X2*X1       DEVICE NUMBER
          LX1    6
          ZR     X1,FCI2     IF DEVICE NUMBER NOT AVAILABLE 
          RJ     COD         CONVERT DEVICE NUMBER
          LX6    24 
          SA6    COBF+6      SET DEVICE NUMBER
          EQ     FCI3        CONVERT ACCESS COUNT 
  
 FCI2     SA1    BLAN        SET BLANK DEVICE NUMBER
          BX6    X1 
          SA6    COBF+6 
 FCI3     BX1    X5 
          RJ     COD         CONVERT ACCESS COUNT 
          LX6    12 
          SA6    COBF+3      SET ACCESS COUNT 
          SA1    FCIA        GET ACCESS DATE AND TIME 
          SA1    X1+B1
          MX2    -18
          BX5    -X2*X1      ACCESS TIME
          AX1    18 
          BX1    -X2*X1      ACCESS DATE
          EDATE  X1          EDIT ACCESS DATE 
          SA6    COBF+4      SET ACCESS DATE
          BX1    X5 
          ETIME  X1          EDIT ACCESS TIME 
          SA6    COBF+5      SET ACCESS TIME
          SA2    OFFA        SET FET ADDRESS
          WRITEH X2,BLAN,1   WRITE CIR ENTRY INFORMATION
          WRITEH X2,COBF,7
          EQ     FCIX        RETURN 
  
  
 FCIA     CON    0           CIR ENTRY ADDRESS
 ICI      SPACE  4,15 
**        ICI - INITIALIZE CATALOG IMAGE RECORD PROCESSING PARAMETERS.
* 
*         EXIT   OUTPUT FILE HEADERS SET FOR CATALOG IMAGE RECORD 
*                  PROCESSING.
*                SUMMARY FILE SET FOR CATALOG IMAGE RECORD PROCESSING.
* 
*         USES   X - 1, 6.
*                A - 6. 
* 
*         CALLS  FAB. 
* 
*         MACROS REWIND.
  
  
 ICI      SUBR               ENTRY/EXIT 
          RJ     FAB         FLUSH ASSEMBLY BUFFER
          SA1    TSBI+/COMSPFS/CISB  SET CIR BLOCK TYPE 
          BX6    X1 
          SA6    CFBI 
          REWIND PF          REWIND PROCESSED CIR ENTRIES FILE
          SX6    B0+
          SA6    FPSF        CLEAR FILES PROCESSED
          EQ     ICIX        RETURN 
 IFL      SPACE  4,15 
**        IFL - INITIALIZE FILE PROCESSING PARAMETERS.
* 
*         EXIT   OUTPUT FILE HEADERS SET FOR FILE PROCESSING. 
*                SUMMARY FILE SET FOR FILE PROCESSING.
* 
*         USES   X - 1, 6.
*                A - 6. 
* 
*         CALLS  FAB. 
* 
*         MACROS REWIND.
  
  
 IFL      SUBR               ENTRY/EXIT 
          RJ     FAB         FLUSH ASSEMBLY BUFFER
          SA1    TSBI+/COMSPFS/CESB   SET CATALOG ENTRIES BLOCK TYPE
          BX6    X1 
          SA6    CFBI 
          REWIND PF          REWIND PROCESSED CATALOG ENTRIES FILE
          SX6    B0+
          SA6    FPSF        CLEAR FILES PROCESSED
          EQ     IFLX        RETURN 
 MWA      SPACE  4,25 
**        MWA - MOVE WORDS TO BLOCK ASSEMBLY AREA.
* 
*         ENTRY  (X1) = WORD COUNT. 
*                (X2) = ADDRESS OF DATA TO ENTER INTO BLOCK.
*                (X0) = WORDS TO ALLOCATE FOR NEW ENTRY.
*                (X0) = 0, IF NOT NEW ENTRY.
*                (SABF) = SUMMARY FILE ASSEMBLY BUFFER FWA. 
*                (SABI) = SUMMARY FILE ASSEMBLY BUFFER IN POINTER.
*                (CFBI) = BLOCK CONTROL WORD IDENTIFIER.
* 
*         EXIT   DATA ENTERED IN ASSEMBLY AREA. 
*                BLOCK WRITTEN TO FILE IF NOT ROOM FOR NEW ENTRY (X0
*                  .GT. WORDS REMAINING IN BLOCK).
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 2, 3, 6, 7. 
* 
*         CALLS  FAB. 
* 
*         MACROS MOVE.
  
  
 MWA      SUBR               ENTRY/EXIT 
          SA3    SABI 
          BX6    X1          SAVE WORD COUNT
          BX7    X2          SAVE DATA ADDRESS
          SA6    MWAA 
          SA7    MWAB 
          ZR     X0,MWA1     IF NOT START OF NEW ENTRY
          IX6    X3+X0
          SX6    X6-SABF-SABFL-1
          NG     X6,MWA1     IF ROOM IN CURRENT BLOCK FOR ENTRY 
          RJ     FAB         FLUSH ASSEMBLY BUFFER
          SA1    MWAA        RESTORE WORD COUNT 
          SA2    MWAB        RESTORE DATA ADDRESS 
          SA3    SABI        RESTORE IN POINTER 
 MWA1     MOVE   X1,X2,X3    MOVE DATA TO BLOCK ASSEMBLY AREA 
          SA1    MWAA        UPDATE IN POINTER
          SA3    SABI 
          IX6    X1+X3
          SA6    A3 
          EQ     MWAX        RETURN 
  
  
 MWAA     CON    0           WORD COUNT 
 MWAB     CON    0           DATA ADDRESS 
 RPP      SPACE  4,20 
**        RPP - RESET PAGE HEADER PARAMETERS. 
* 
*         ENTRY  (X2) = ADDRESS OF PAGE TITLE TEXT. 
*                (X6) = 0 IF NO PAGE SUBHEADER DEFINED. 
*                (X6) = PAGE SUBHEADER PROCESSOR ENTRY ADDRESS IF .NE.
*                         0.
* 
*         EXIT   NEW MAIN TITLE SET.
*                (PSPA) = 0 IF NO PAGE SUBHEADER DEFINED. 
*                (PSPA) = PAGE SUBHEADER PROCESSOR ADDRESS IF SUBHEADER 
*                           DEFINED.
*                (PGLC) = 99999 
*                (CENN) = 0.
* 
*         USES   X - 6, 7.
*                A - 6, 7.
* 
*         MACROS MOVE.
  
  
 RPP      SUBR               ENTRY/EXIT 
          SA6    PSPA        SET PAGE SUBHEADER PROCESSOR ADDRESS 
          MOVE   PGTXL,X2,PGTX  SET TITLE TEXT
          SX6    99999
          SX7    B0+
          SA6    PGLC        RESET LINES ON PAGE
          SA7    CENN        RESET CATALOG ENTRY NUMBER 
          EQ     RPPX        RETURN 
 SDT      SPACE  4,10 
**        SDT - SET DEFAULT PAGE TITLE. 
* 
*         EXIT   DEFAULT PAGE TITLE SET UP. 
* 
*         USES   X - 2, 6.
* 
*         CALLS  RPP. 
  
  
 SDT      SUBR               ENTRY/EXIT 
          SX6    B0          SET NO SUBHEADER 
          SX2    DFTX        SET DEFAULT TITLE
          RJ     RPP         RESET PAGE PARAMETERS
          EQ     SDTX        RETURN 
 WCO      SPACE  4,15 
**        WCO - WRITE CATALOG ENTRY DATA TO OUTPUT FILE.
* 
*         ENTRY  (A0) = ADDRESS OF CATALOG ENTRY AND STATUS WORDS.
*                (CENN) = CATALOG ENTRY NUMBER. 
*                (OFFA) = FILE *O* FET ADDRESS. 
* 
*         EXIT   CATALOG DATA WRITTEN TO OUTPUT FILE. 
* 
*         USES   X - 0, 1, 2, 6, 7. 
*                A - 1, 2, 6, 7.
* 
*         CALLS  ALN, CDD.
* 
*         MACROS EDCAT, MOVE, WRITEH. 
  
  
 WCO      SUBR               ENTRY/EXIT 
          SX6    5           SET LENGTH OF CATALOG DATA 
          RJ     ALN         ALLOCATE LINES 
          SA1    CENN 
          SX7    X1+B1       ADVANCE ENTRY NUMBER 
          SA7    A1 
          EDCAT  A0,COBF,X7,1,1,1  FORMAT CATALOG ENTRY FOR OUTPUT
          SA1    A0+NWCE+1   GET PROCESSING SEQUENCE NUMBER 
          RJ     CDD         CONVERT SEQUENCE NUMBER
          SA1    A0+NWCE     GET FILE STATUS
          LX6    12 
          MX7    -2 
          SA6    COBF+9      SET SEQUENCE NUMBER
          LX1    59-0 
          BX7    -X7*X1      ARCHIVE FILE ERROR FLAGS 
          PL     X1,WCO1     IF NOT *PFC ONLY* FILE 
          SA2    WCOA 
          BX6    X2 
          SA6    COBF+10     SET *PFC ONLY* MESSAGE 
 WCO1     ZR     X7,WCO2     IF NO ERRORS 
          LX2    B1,X7
          IX2    X7+X2       ERROR MESSAGE OFFSET 
          MOVE   3,WCOB-3+X2,COBF+FCELL+10
 WCO2     WRITEH O,BLAN,1 
          WRITEH X2,COBF,FCELL
          WRITEH X2,COBF+FCELL,FCELL
          WRITEH X2,COBF+2*FCELL,FCELL
          WRITEH X2,COBF+3*FCELL,FCELB
          EQ     WCOX        RETURN 
  
  
 WCOA     DATA   10HPFC ONLY. 
 WCOB     DATA   30HPFDUMP DATA ERRORS. 
          DATA   30HPFDUMP PERMIT ERRORS. 
          DATA   30HPFDUMP DATA AND PERMIT ERRORS.
          SPACE  4,10 
*         CATALOG OUTPUT FILE BUFFERS.
  
 COBF     BSSZ   4*FCELL     CATALOG OUTPUT BUFFER
  
 BLAN     DATA   10H
 CENN     CON    0           CATALOG ENTRY NUMBER 
 FPSF     CON    0           FILES PROCESSED FOR SORTED OUTPUT FLAG 
 OFFA     CON    O           OUTPUT FILE FET ADDRESS
 PAGE     CON    1           PAGE NUMBER
 PGLC     CON    9999        PAGE LINE COUNT
 PGLL     CON    0           PAGE LINE LIMIT
 PSPA     CON    0           PAGE SUBHEADER PROCESSOR ADDRESS 
  
  
*         ARCHIVE FILE INFORMATION BLOCK. 
  
 AFIB     BSSZ   3           ARCHIVE FILE INFORMATION BLOCK.
  
*         ARCHIVE FILE SUBTITLE PARAMETERS. 
  
 AFSA     DATA   50H  ARCHIVE FILE CREATED YY/MM/DD. HH.MM.SS.  ARCHIV
 AFSB     DATA   C*E FAMILY ???????.* 
 AFSC     DATA   C*E PACK NAME ???????.*
 AFSD     DATA   80H  ARCHIVE FILE LABEL NOT FOUND. 
  
 AFSE     CFORM  22,10       LOCATION OF DATE FIELD IN *AFSA* 
 AFSF     CFORM  32,10       LOCATION OF TIME FIELD IN *AFSA* 
  
  
*         PAGE TITLE FIRST LINE.
  
 PGTA     BSS    0
 PGTX     DATA   50H
 PGTXL    EQU    *-PGTX 
 PGFM     DATA   20H
 PGUT     DATA   20H
 PGSD     DATA   10H YY/MM/DD.
 PGST     DATA   10H HH.MM.SS.
 PGPN     DATA   20H      PAGE
 PGTAL    EQU    *-PGTA 
  
*         PAGE TITLE SECOND LINE. 
  
 PGTB     BSS    0
 PGAC     DATA   50H
 PGAF     DATA   40H
 PGSC     DATA   40H
 PGTBL    EQU    *-PGTB 
  
*         MAIN PROGRAM PAGE TITLE TEXT AREA.
  
 MTTA     BSS    0
 FLTX     DATA   50H
 CITX     DATA   50H
 USTX     DATA   50H
 TSTX     DATA   50H
 DFTX     DATA   50H
 MTTAL    EQU    *-MTTA 
  
*         CATALOG IMAGE RECORD SUBHEADER. 
  
 CISA     DIS    5,             FILE      USER     ACCESS      LAST A 
          DIS    2,CCESS       DEVICE 
 CISB     DIS    5,             NAME      INDEX    COUNT     DATE 
          DIS    2,   TIME     NUMBER 
          SPACE  4,10 
*         SUMMARY FILE DATA LOCATIONS AND ASSEMBLY BUFFER.
  
 TSBI     IVFD               TABLE OF SUMMARY FILE BLOCK IDENTIFIERS
          IVFD   /COMSPFS/SYSB,(60/0LSYSTEM)   SYSTEM 
          IVFD   /COMSPFS/DSSB,(60/0LDEVSTAT)  DEVICE STATUS
          IVFD   /COMSPFS/AFSB,(60/0LARCFILE)  ARCHIVE FILE 
          IVFD   /COMSPFS/CISB,(60/0LCIR)      CIR
          IVFD   /COMSPFS/CESB,(60/0LCATE)     CATALOG ENTRIES
          IVFD   /COMSPFS/MXSB,(60/0)          TERMINATOR WORD
          IVFD   /COMSPFS/MXSB+1
  
 CFBI     DATA   0LSYSTEM    BLOCK CONTROL WORD IDENTIFIER
  
 SABI     CON    SABF        ASSEMBLY BUFFER IN POINTER 
  
 SBCW     BSSZ   1           BLOCK CONTROL WORD 
  
 SABF     BSSZ   SABFL       SUMMARY FILE BLOCK ASSEMBLY BUFFER 
          SPACE  4,10 
**        OUTPUT FILE FETS. 
  
  
 O        BSS    0           OUTPUT FILE
 OUTPUT   FILEB  OUTB,OUTBL,FET=10
  
 SU       BSS    0           SUMMARY FILE 
 SUMMARY  FILEB  SUMB,SUMBL,FET=10
  
 PF       BSS    0           PROCESSED FILES LIST 
 ZZZZZGA  FILEB  PFLB,PFLBL,FET=10
          TITLE  COMCPFS - MERGE SORT INTERFACE ROUTINES. 
 ISF      SPACE  4,10 
**        ISF - INITIALIZE SORT FILES.
* 
*         EXIT   SORT FILES INITIALIZED FOR WRITE.
* 
*         USES   X - 6. 
*                A - 6. 
* 
*         MACROS WRITE. 
  
  
 ISF      SUBR               ENTRY/EXIT 
          REWIND S1 
          REWIND S2 
          WRITE  S1,* 
          WRITE  S2,* 
          SX6    S1 
          SA6    SFFA        SET SORT FILE FET ADDRESS
          EQ     ISFX        RETURN 
 WSB      SPACE  4,20 
**        WSB - SORT ENTRIES AND WRITE SORT BUFFER TO FILE. 
* 
*         ENTRY  (X0) = SORT KEY MASK.
*                (X1) = LENGTH OF SORT KEY. 
*                (B4) = FIRST WORD OF KEY (FIRST WORD OF ENTRY = 1).
*                (B5) = ENTRY LENGTH. 
*                (B6) = LWA+1 OF ENTRIES IN *SRTB*. 
* 
*         EXIT   OUTPUT FILE FET POINTERS SWAPPED IF OUTPUT WRITTEN.
* 
*         USES   X - 2, 5, 6. 
*                A - 2, 6.
*                B - 2, 3, 7. 
* 
*         CALLS  GMS. 
* 
*         MACROS WRITEW.
  
  
 WSB      SUBR               ENTRY/EXIT 
  
*         SORT ENTRIES IN BUFFER. 
  
          SB3    SRTB 
          SX5    B6-B3       LENGTH OF ENTRIES IN SORT BUFFER 
          SX2    B5          SET ENTRY LENGTH 
          IX2    X5/X2       COUNT OF ENTRIES IN BUFFER 
          SB6    X2          SET ENTRY COUNT
          SB2    B0          SET CHARACTER SORT 
          SB3    B0          SET ASCENDING SORT 
          SB7    SRTB        SET BUFFER ADDRESS 
          RJ     GMS         SORT TABLE 
  
*         TOGGLE OUTPUT FET POINTERS AND WRITE BLOCK. 
  
          SA2    SFFA        GET FET ADDRESS
          SX6    S1&S2
          BX6    X2-X6       SET NEXT FET ADDRESS 
          SA6    A2          UPDATE CURRENT SORT FILE 
          WRITEW X2,SRTB,X5  WRITE BLOCK TO SORT FILE 
          EQ     WSBX        RETURN 
          SPACE  4,10 
**        SORT WORKING BUFFERS. 
  
  
 SW1B     BSSZ   NWCS        WORKING BUFFER 1 
 SW2B     BSSZ   NWCS        WORKING BUFFER 2 
          TITLE  COMCPFS - COMMON GENERAL SUBROUTINES.
 DFN      SPACE  4,15 
**        DFN - DISPLAY FILE NAME AND USER INDEX IN STATUS MESSAGE. 
* 
*         ENTRY  (X1) = FILE NAME AND USER INDEX. 
*                (X2) = MESSAGE VERB LEFT JUSTIFIED WITH BLANK FILL.
* 
*         EXIT   FILE NAME AND USER INDEX OF FILE BEING PROCESSED 
*                  DISPLAYED ON THE *B* AND *K* DISPLAYS. 
* 
*         USES   X - 1, 2, 3, 6.
*                A - 3, 6.
* 
*         CALLS  COD, SFN.
* 
*         MACROS MESSAGE, MOVE. 
  
  
 DFN      SUBR               ENTRY/EXIT 
          BX6    X2 
          SA6    MSGB        SET MESSAGE VERB 
          MX6    -18
          BX2    -X6*X1      USER INDEX 
          BX1    X6*X1       FILE NAME
          RJ     SFN         SPACE FILL FILE NAME 
          LX6    -6 
          SA6    A6+1        SET FILE NAME
          BX1    X2 
          RJ     COD         CONVERT USER INDEX 
          LX6    24 
          SA6    A6+B1       SET USER INDEX 
          SX6    B0 
          SA6    A6+B1       TERMINATE MESSAGE
          MESSAGE  MSGB,1    DISPLAY MESSAGE ON *B* DISPLAY 
          SA3    IDSA+/COMSPFS/ADMS 
          MOVE   3,MSGB,X3   SET MESSAGE IN *K* DISPLAY 
          EQ     DFNX        RETURN 
          SPACE  4,10 
**        GLOBAL DATA LOCATIONS.
  
  
*         FILE COUNT ACCUMULATORS.  THE ORDER OF THE LOCATIONS FROM 
*         *PSAC* TO *PSACL* MUST MATCH THE ORDER OF THE FLAGS IN THE
*         PROCESSING STATUS JOB CONTROL REGISTER AND CANNOT BE CHANGED. 
  
 PSAC     BSS    0           START OF FILE COUNT ACCUMULATORS 
 PRFC     CON    0           FILES PROCESSED COUNT
 PEFC     CON    0           PROCESSED WITH ERRORS FILE COUNT 
 SEFC     CON    0           SKIPPED WITH ERRORS FILE COUNT 
 POFC     CON    0           PFC ONLY FILE COUNT
 STFC     CON    0           COUNT OF DUMPED FILES STAGED 
 PPFC     CON    0           FILES POST PROCESSED 
 NPFC     CON    0           FILES NOT POST PROCESSED 
 PSACL    EQU    *-PSAC      LENGTH OF ACCUMULATORS FOR STATUS FLAGS
  
 FLST     CON    0           FILE STATUS WORD 
 SYSS     CON    0           SYSTEM SECURITY MODE 
          SPACE  4,10 
 PFA$     IF     DEF,PFA$ 
          TITLE  COMCPFS - PFLOAD/PFAM ARCHIVE FILE ROUTINES. 
 BST      SPACE  4,15 
**        BST - BUILD SUBFAMILY DEVICE TABLE. 
* 
*         ENTRY  (A0) = ADDRESS OF ARCHIVE FILE LABEL.
* 
*         EXIT   MASTER DEVICE INDICES AND CATALOG TRACK MASKS SET IN 
*                  *SFDT*.
* 
* 
*         USES   X - 1, 4, 6. 
*                A - 1, 6.
*                B - 2, 3, 4. 
  
  
 BST      SUBR               ENTRY/EXIT 
          SB2    10B         INITIALIZE SUBFAMILY INDEX 
 BST1     SB2    B2-1        DECREMENT SUBFAMILY INDEX
          NG     B2,BSTX     IF ALL SUBFAMILIES PROCESSED 
          SA1    A0+/COMSPFS/D0AL-1 
          SX4    10000B 
          SB3    10B         INITIALIZE DEVICE ORDINAL
          LX4    X4,B2       SET SUBFAMILY MASK BIT 
 BST2     SA1    A1+B1       GET DEVICE DESCRIPTIONS FROM ARCHIVE LABEL 
          SB4    3
          LX1    20 
 BST3     SB3    B3-B1       DECREMENT ARCHIVE FILE DEVICE ORDINAL
          SB4    B4-B1
          NG     B3,BST1     IF ALL DEVICES CHECKED 
          ZR     B4,BST2     IF END OF DEVICES IN WORD
          LX1    -20
          BX6    X4*X1
          ZR     X6,BST3     IF NOT MASTER DEVICE FOR SUBFAMILY 
          MX6    -12
          BX6    -X6*X1      NUMBER OF CATALOG TRACKS 
          SX1    B3+
          SX6    X6-1        CATALOG TRACK MASK 
          LX1    24          ARCHIVE FILE DEVICE ORDINAL
          BX6    X1+X6
          SA6    SFDT+B2     SET DEVICE ORDINAL AND CATALOG TRACK MASK
          EQ     BST1        PROCESS NEXT SUBFAMILY 
 PLP      SPACE  4,15 
**        PLP - PROCESS ARCHIVE FILE LABEL PARAMETERS.
* 
*         ENTRY  (A0) = ADDRESS OF ARCHIVE FILE LABEL IF LABEL FOUND. 
*                (A0) = 0 IF ARCHIVE FILE LABEL NOT FOUND.
* 
*         EXIT   ARCHIVE FILE LABEL PARAMETERS SET IN *AFIB*. 
*                (AFDM) = ARCHIVE FILE DUMP MASK IF LAST ARCHIVE FILE.
*                DEVICE POSITION AND CATALOG TRACK INFORMATION SET FROM 
*                  ARCHIVE LABEL IF LAST ARCHIVE FILE AND USER INDEX
*                  SELECTIONS ARE PRESENT.
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
* 
*         CALLS  BST, OAL, REC, SUM, VDT. 
  
  
*         OUTPUT ARCHIVE FILE LABEL PARAMETERS. 
  
 PLP6     RJ     OAL         OUTPUT ARCHIVE LABEL PARAMETERS
  
 PLP      SUBR               ENTRY/EXIT 
  
*         BUILD ARCHIVE FILE IDENTIFIER BLOCK.
  
          SX1    A0+
          ZR     X1,PLP1     IF ARCHIVE FILE LABEL NOT FOUND
          SA1    A0+/COMSPFS/FMAL  SET FAMILY OR PACK NAME
          SA2    A0+/COMSPFS/PNAL 
          MX7    42 
          BX6    X7*X1
          BX7    X7*X2
          SA6    AFIB 
          SA7    A6+B1
          SA1    A0+/COMSPFS/TIAL 
          SA2    A0+/COMSPFS/DAAL 
          BX6    X1          SAVE TIME
          SA6    PLPA 
          RJ     REC         REMOVE EDIT CHARACTERS FROM DATE 
          SX2    B0+         SET DATE CONVERSION
          RJ     VDT         CONVERT DATE TO PACKED FORMAT
          NG     X6,PLP1     IF ERROR IN DATE 
          LX6    18 
          SA6    AFIB+2 
          SA2    PLPA 
          RJ     REC         REMOVE EDIT CHARACTERS FROM TIME 
          SX2    B1+         SET TIME CONVERSION
          RJ     VDT         CONVERT TIME TO PACKED FORMAT
          NG     X6,PLP1     IF ERROR IN TIME 
          SA1    AFIB+2      MERGE PACKED DATE AND TIME 
          BX6    X6+X1
          SA6    A1 
          EQ     PLP2        PROCESS DEVICE PARAMETERS
  
 PLP1     SX6    B0          CLEAR ALL INFORMATION IN BLOCK 
          SA6    AFIB 
          SA6    A6+B1
          SA6    A6+B1
          EQ     PLP6        OUTPUT LABEL PARAMETERS
  
*         PROCESS *PFDUMP* DEVICE PARAMETERS.  IF A SUBFAMILY USER
*         INDEX IS SELECTED, NO DEVICE POSITION WILL BE SET SINCE 
*         *MSS* AND *MSE* CATALOGS ARE NOT DUMPED IN DEVICE ORDER.
  
 PLP2     SA1    CPAR+/COMSPFS/CPNB 
          SX1    X1-2 
          PL     X1,PLP6     IF NOT LAST ARCHIVE FILE 
          SA1    /COMSPFS/FISP
          ZR     X1,PLP3     IF NO FILE SELECTIONS
          RJ     SUM         SET MASK FOR REMAINING FILE SELECTIONS 
          SX6    X4+
          SA6    FLSM        SET FILE SELECTION MASK
 PLP3     SA1    A0+/COMSPFS/MAAL 
          MX6    -8 
          BX6    -X6*X1 
          SA6    AFDM        SET DUMP MASK
          LX1    59-35
          PL     X1,PLP6     IF DEVICE INFORMATION NOT PRESENT
          SA1    /COMSPFS/FISP
          ZR     X1,PLP6     IF NO USER INDEX SELECTIONS
          RJ     BST         BUILD SUBFAMILY DEVICE TABLE 
          SA1    /COMSPFS/FISP
          SB5    X1          SET SELECTIONS TABLE ADDRESS 
          SX5    B0          INITIALIZE DEVICE PARAMETERS 
 PLP4     SA1    B5          GET NEXT ENTRY 
          SX7    377770B
          BX6    X5 
          ZR     X1,PLP5     IF END OF ENTRIES
          BX6    X7*X1
          LX1    59-17
          SX6    X6-SBUI
          NG     X1,PLP4     IF PROCESSED FILE NAME ENTRY 
          ZR     X6,PLP6     IF SUBFAMILY USER INDEX
          LX1    18 
          MX2    -3 
          BX2    -X2*X1      SUBFAMILY
          SA2    SFDT+X2
          LX1    -3 
          SX3    X2          CATALOG TRACK MASK 
          BX1    X3*X1       CATALOG TRACK
          BX2    -X3*X2      ARCHIVE FILE DEVICE ORDINAL
          BX2    X2+X1       DEVICE ORDINAL AND CATALOG TRACK 
          SB5    B5+B1       ADVANCE ENTRY ADDRESS
          IX1    X5-X2
          PL     X1,PLP4     IF PREVIOUS UI POSITION NOT BEFORE CURRENT 
          BX5    X2          UPDATE DEVICE PARAMETERS 
          EQ     PLP4        GET NEXT ENTRY 
  
 PLP5     SA6    MXDC        SET MAXIMUM DEVICE AND CATALOG TRACK 
          EQ     PLP6        OUTPUT LABEL PARAMETERS
  
  
 PLPA     CON    0           ARCHIVE FILE TIME
 REC      SPACE  4,10 
**        REC - REMOVE EDIT CHARACTERS FROM DATE OR TIME. 
* 
*         ENTRY  (X2) = DATE IN YY/MM/DD. FORMAT OR TIME IN HH.MM.SS. 
*                       FORMAT. 
* 
*         EXIT   (X1) = DATE IN YYMMDD FORMAT OR TIME IN HHMMSS FORMAT
*                       (LEFT JUSTIFIED). 
* 
*         USES   X - 1, 2, 6, 7.
  
  
 REC      SUBR               ENTRY/EXIT 
          MX6    12 
          LX2    6
          BX1    X6*X2       YY OR HH 
          LX2    6
          LX6    -12
          BX7    X6*X2
          BX1    X1+X7       YYMM OR HHMM 
          LX2    6
          LX6    -12
          BX7    X6*X2
          BX1    X1+X7       YYMMDD OR HHMMSS 
          EQ     RECX        RETURN 
 SFDT     SPACE  4,10 
**        SFDT - SUBFAMILY MASTER DEVICE TABLE. 
* 
*         INDEXED BY SUBFAMILY (BITS 0 - 2 OF USER INDEX).
* 
*         ENTRY FORMAT -
* 
*         24/ 0,12/ DO,24/ CTM. 
* 
*         DO = MASTER DEVICE ORDINAL ON ARCHIVE FILE (ORDER IN WHICH
*              FILES CATALOGED ON DEVICE WERE DUMPED).
*         CTM = CATALOG TRACK MASK. 
  
  
 SFDT     BSSZ   10B         SUBFAMILY DEVICE TABLE 
          SPACE  4,10 
  
  
 AFDM     CON    377B        ARCHIVE FILE DUMP MASK 
 FLSM     CON    377B        FILE SELECTIONS MASK 
 MXDC     CON    0           MAXIMUM DEVICE AND CATALOG TRACK SELECTED
 PFA$     ENDIF 
          SPACE  4,10 
 PFR$     IF     DEF,PFR$ 
          TITLE  COMCPFS - ARCHIVE FILE READ ROUTINES.
 CWR      SPACE  4,60 
**        CWR - CONTROL WORD READ WORDS.
* 
*         ENTRY  (X2) = FET ADDRESS.
*                (B6) = FWA OF WORKING BUFFER.
*                (B7) = WORD COUNT OF WORKING BUFFER. 
*                (X2+CWSW) = 0 FOR FIRST CALL.
*                          = CONTENTS AT EXIT FROM PREVIOUS CALL, 
*                            OTHERWISE. 
* 
*         EXIT   (X1) = 0 FOR TRANSFER COMPLETE.
*                     = (B6) FOR EOR DETECTED ON FILE.
*                     = -1 FOR EOF DETECTED ON FILE.
*                     = -2 FOR EOI DETECTED ON FILE.
*                (X2) = FET ADDRESS.
*                (X7) = 0 IF NO ERROR DETECTED. 
*                     = ERROR CODE FROM FET IF ERROR DETECTED.
*                (B6) = ADDRESS PLUS ONE OF LAST WORD TRANSFERRED TO
*                       WORKING BUFFER. 
*                (B7) = WORD COUNT REMAINING TO BE TRANSFERRED. 
* 
*                *CWSW* IS A STATUS WORD USED BY *CWR* TO UNPACK
*                CONTROL WORD BLOCKS.  THIS WORD SHOULD BE CLEARED BY 
*                THE CALLER BEFORE THE FIRST CALL TO *CWR*.  WHEN AN
*                EOR/EOF TERMINATION STATUS IS INDICATED BY *CWR* AS A
*                RESULT OF DETECTING A SHORT BLOCK IN THE BUFFER, 
*                *CWSW* WILL BE NON-ZERO.  SUBSEQUENT CALLS TO *CWR*
*                WILL THEN CONTINUE TO INDICATE EOR/EOF TERMINATION 
*                STATUS UNTIL *CWSW* IS AGAIN CLEARED BY THE CALLER.
*                THUS THE CLEARING OF *CWSW* IS ANALOGOUS TO THE USE
*                OF THE *READ* MACRO TO ADVANCE PAST EOR/EOF WHEN 
*                USING *CIO* BUFFER READ OPERATIONS.
* 
*                BEFORE THE FIRST CALL TO *CWR* OR FOLLOWING THE
*                DETECTION OF EOF/EOI IN THE FET STATUS FIELD, THE
*                *READCW* MACRO MUST BE ISSUED TO INITIATE A CONTROL
*                WORD READ OPERATION.  IF THE READ IS TO EOF
*                (*READCW   FET,17B*), AN EOF TERMINATION STATUS
*                INDICATES THAT AN EOF WAS DETECTED IN THE FET AND A
*                NEW READ MUST BE ISSUED IN ADDITION TO CLEARING *CWSW* 
*                IN ORDER TO ADVANCE PAST EOF.  IF THE READ IS TO EOI 
*                (*READCW   FET,0*), AN EOF TERMINATION STATUS
*                INDICATES THAT AN EOF BLOCK WAS DETECTED IN THE BUFFER 
*                AND THAT ONLY *CWSW* NEED BE CLEARED TO ADVANCE PAST 
*                EOF. 
* 
*                NOTE THAT THE FIRST TIME (X7) INDICATES AN ERROR, NO 
*                BAD DATA WILL BE TRANSFERRED TO THE WORKING BUFFER.
*                SUBSEQUENT CALLS WILL CONTINUE TO INDICATE THE ERROR 
*                BY THE (X7) AND WILL TRANSFER BAD DATA IF AVAILABLE. 
*                IN ALL ERROR CASES (X1) WILL INDICATE EOR/EOF/EOI
*                STATUS AND (B6) AND (B7) WILL INDICATE WORKING BUFFER
*                STATUS AS FOR NON-ERROR CASES.  IN ERROR CASES,
*                HOWEVER, EVEN THOUGH (X1) MAY BE ZERO INDICATING 
*                TRANSFER COMPLETE, (B6) OR (B7) MUST BE ANALYZED TO
*                DETERMINE HOW MUCH DATA WAS ACTUALLY TRANSFERRED TO
*                THE WORKING BUFFER.
* 
*         USES   X - 1, 3, 4, 6, 7. 
*                A - 1, 3, 4, 6, 7. 
*                B - 5, 6, 7. 
* 
*         MACROS READW, RECALL. 
  
  
*         SET ERROR STATUS CODE.
  
 CWR11    PL     X3,CWRX     IF CURRENT BLOCK NOT BAD 
          BX4    X1          SAVE TERMINATION STATUS
          RECALL X2          WAIT FOR FILE NOT BUSY 
          SA1    X2          GET ERROR CODE FROM FET
          SX3    36000B 
          BX7    X3*X1
          SX1    X4          RESTORE TERMINATION STATUS 
          LX7    -10
  
 CWR      SUBR               ENTRY/EXIT 
  
*         TRANSFER DATA TO WORKING BUFFER.
  
 CWR1     SA3    X2+CWSW     GET CONTROL WORD STATUS
          BX7    X7-X7       CLEAR ERROR STATUS 
          SX1    B0          SET TRANSFER COMPLETE STATUS 
          ZR     B7,CWR11    IF WORKING BUFFER FULL 
          SB5    X3-1 
          LE     B5,CWR3     IF CURRENT BLOCK EMPTY 
          SX6    B7-B5       SET REMAINING WORKING BUFFER LENGTH
          GE     B7,B5,CWR2  IF BLOCK WILL FIT IN BUFFER
          BX6    X6-X6
          SB5    B7          SET TO FILL BUFFER 
 CWR2     SA6    CWRA        SAVE REMAINING WORKING BUFFER LENGTH 
          SX1    B5          UPDATE BLOCK WORD COUNT
          IX7    X3-X1
          SA7    A3 
          READW  X2,B6,B5    TRANSFER DATA TO WORKING BUFFER
          SA1    CWRA        RESTORE WORKING BUFFER LENGTH
          SB7    B7+X1
          EQ     CWR1        FILL REMAINDER OF WORKING BUFFER 
  
*         SAVE WORKING BUFFER PARAMETERS. 
  
 CWR3     SX6    B7          SAVE WORKING BUFFER LENGTH 
          SX7    B6          SAVE WORKING BUFFER ADDRESS
          SA6    CWRA 
          SA7    A6+B1
          LX3    -18
          ZR     B5,CWR9     IF SECOND CONTROL WORD LEFT
  
*         PROCESS FIRST CONTROL WORD. 
  
 CWR4     SA4    CWRC 
          PL     X4,CWR5     IF LAST BLOCK NOT BAD
          RECALL X2 
          SA3    X2          CLEAR ERROR STATUS 
          SX6    36000B 
          BX6    -X6*X3 
          SA6    A3 
 CWR5     READW  X2,CWRB,1   READ FIRST CONTROL WORD
          SA3    CWRA        RESTORE WORKING BUFFER LENGTH
          SA4    A3+B1       RESTORE WORKING BUFFER ADDRESS 
          SB5    B7          SAVE TRANSFER COMPLETE STATUS
          SB7    X3 
          SB6    X4 
          NZ     B5,CWR7     IF CONTROL WORD NOT READ 
          SA1    CWRB        BLOCK SIZE = BYTE COUNT / 5
          SX6    5
          SX3    X1 
          PX3    X3 
          PX6    X6 
          NX6    X6 
          FX7    X3/X6
          UX7,B5 X7 
          LX7    X7,B5
          MX4    1           SAVE ERROR FLAG
          BX3    X4*X1
          LX1    -36         GET PRU SIZE 
          SX6    X7+B1       ALLOW FOR SECOND CONTROL WORD
          SX1    X1 
          IX7    X7-X1       CHECK FOR SHORT BLOCK
          BX6    X3+X6
          ZR     X7,CWR6     IF FULL BLOCK
          LX4    18-59       SET SHORT BLOCK FLAG 
          BX6    X6+X4
 CWR6     SA4    X2+CWSW     GET OLD STATUS WORD
          SA6    CWRC 
          SA6    A4          SAVE NEW STATUS WORD 
          BX6    X4-X6
          PL     X6,CWR1     IF NO CHANGE IN BLOCK STATUS 
          BX1    X1-X1       SET TRANSFER COMPLETE STATUS 
          EQ     CWR11       GET ERROR STATUS 
  
*         PROCESS EOF/EOI AND FET ERROR CODE STATUS.
  
 CWR7     SX3    X1+3 
          ZR     X3,CWR8     IF READ ERROR
          BX7    X7-X7       CLEAR ERROR STATUS 
          EQ     CWRX        RETURN 
  
 CWR8     BX6    X6-X6       CLEAR STATUS WORD
          BX1    X1-X1
          SA6    X2+CWSW
          EQ     CWRX        RETURN 
  
*         PROCESS SECOND CONTROL WORD.
  
 CWR9     SX4    X3-2 
          PL     X4,CWR10    IF SECOND CONTROL WORD ALREADY READ
          READW  X2,CWRB,1   READ SECOND CONTROL WORD 
          SA3    X2+CWSW     CHECK SHORT BLOCK STATUS 
          LX3    -18
          SX6    X3 
          ZR     X6,CWR4     IF NOT SHORT BLOCK 
          SA4    B6-B1       GET END OF RECORD LEVEL NUMBER 
          IX3    X3+X6
          AX4    48 
          IX6    X3+X4       SAVE LEVEL NUMBER IN STATUS WORD 
          LX6    18 
          SA6    A3 
 CWR10    SB5    X4-17B 
          SA4    CWRA        RESTORE WORKING BUFFER LENGTH
          LX3    18 
          SA1    A4+B1       RESTORE WORKING BUFFER ADDRESS 
          SB7    X4 
          BX7    X7-X7       CLEAR ERROR STATUS 
          SB6    X1 
          NZ     B5,CWR11    IF NOT LEVEL 17B END OF RECORD 
          SX1    -B1         SET EOF STATUS 
          EQ     CWR11       SET ERROR STATUS CODE
  
  
 CWRA     BSSZ   2           WORKING BUFFER PARAMETER STORAGE 
 CWRB     CON    0           CONTROL WORD BUFFER
 CWRC     CON    0           STATUS WORD FROM LAST BLOCK
 PFR$     ENDIF 
          SPACE  4,10 
 DVA$     IF     DEF,DVA$ 
          TITLE  COMCPFS - PERMANENT FILE DEVICE ACCESS ROUTINES. 
 SEI      SPACE  4,15 
**        SEI - SET ERROR IDLE STATUS ON MASTER DEVICE. 
* 
*         ENTRY  (B2) = ERROR LOG MESSAGE ADDRESS.
*                (MAEQ) = MASTER DEVICE EST ORDINAL.
* 
*         EXIT   ERROR IDLE STATUS SET ON MASTER DEVICE.
*                ERROR IDLE MESSAGE ISSUED TO ERROR LOG.
* 
*         USES   X - 1, 4, 6. 
*                A - 1, 6.
*                B - 2, 3, 5. 
* 
*         CALLS  COD, SNM.
* 
*         MACROS CALLPFU, MESSAGE.
  
  
 SEI      SUBR               ENTRY/EXIT 
          SA1    MAEQ        GET MASTER DEVICE EST ORDINAL
          SX6    1           SET COMPLETION STATUS
          LX1    48 
          BX6    X1+X6
          SA6    SEIA 
          CALLPFU  A6,CTEI,R SET ERROR IDLE STATUS
          SA1    MAEQ 
          SX1    X1+1000B    FORCE CONVERSION OF LEADING ZEROES 
          SB5    -B2         SET TEMPLATE ADDRESS FOR *SNM* 
          RJ     COD         CONVERT EST ORDINAL
          MX6    18 
          LX4    6
          BX1    X6*X4       EST ORDINAL
          SB2    1R?
          SB3    MSGB        SET ASSEMBLY ADDRESS 
          RJ     SNM         SET EST ORDINAL IN MESSAGE 
          MESSAGE  MSGB,4    ISSUE ERROR LOG MESSAGE
          EQ     SEIX        RETURN 
  
  
 SEIA     BSS    1           *PFU* PARAMETER WORD 
          SPACE  4,10 
*         ERROR LOG MESSAGES. 
  
  
 ELWC     DATA   C*EQ??? ERROR IDLE SET - PF CATALOG WRITE ERROR.*
 ELLI     DATA   C*EQ??? ERROR IDLE SET - INDIRECT PF LENGTH ERROR.*
 ELWP     DATA   C*EQ??? ERROR IDLE SET - PF PERMITS WRITE ERROR.*
          SPACE  4,10 
*         GLOBAL DATA LOCATIONS.
  
  
 FMPN     BSSZ   1           FAMILY NAME OR PACK NAME 
 MASK     BSSZ   1           FILE SELECTION MASK
 SXUF     BSSZ   1           *SYSTEMX* ONLY UI ON SUBFAMILY 7 FLAG
          SPACE  4,10 
*         *GETPFP*, *SETPFP* PARAMETER BLOCKS.
  
  
 SPAR     BSSZ   3           MODIFIED PERMANENT FILE PARAMETERS 
 GPAR     BSSZ   3           ORIGINAL PERMANENT FILE PARAMETERS 
          SPACE  4,10 
*         CATALOG FILE PARAMETER WORDS. 
  
  
*T PDWD   42/ PN, 6/, 12/ EQ
*         PN = PACKNAME FOR AN AUXILIARY DEVICE.
*            = 0 FOR A FAMILY DEVICE. 
*         EQ = EST ORDINAL OF A FAMILY DEVICE.
*            = 0 FOR AN AUXILIARY DEVICE. 
  
 PDWD     BSS    1           PF DESCRIPTION WORD
 MSTT     SPACE  4,20 
**        MSTT - TABLE OF MST INFORMATION.
* 
*         2 WORD ENTRIES, TERMINATED WITH A PAIR OF ZERO WORDS. 
* 
*T MSTT   12/ DATA,12/ CATS,12/ PETS,9/ NCTR,9/ EQ,6/ DN
*T MSTT+1 12/ MSTA,12/ SL,6/ AL,12/ MN,1/,1/0,8/ SM,8/ DM 
* 
*         DATA = FIRST TRACK OF INDIRECT DATA CHAIN.
*         CATS = FIRST CATALOG TRACK. 
*         PETS = FIRST TRACK OF PERMIT CHAIN. 
*         NCTR = NUMBER OF CATALOG TRACKS.
*         EQ = EST ORDINAL OF DEVICE. 
*         DN = DEVICE NUMBER. 
*         MSTA = MST ADDRESS / 10B
*         SL = SECTOR LIMIT.
*         AL = ACCESS LEVEL LIMITS. 
*         MN = EQUIPMENT MNEMONIC.
*         SM = SECONDARY MASK (DIRECT ACCESS FILES).
*         DM = DEVICE MASK (INDIRECT ACCESS FILES AND CATALOGS).
  
  
 MSTT     BSSZ   2*MSMX+2    MST TABLE
 TMDA     SPACE  4,10 
**        TMDA - TABLE OF MASTER DEVICE ADDRESSES.
* 
*         INDEXED BY SUBFAMILY (LOWER 3 BITS OF USER INDEX).
* 
*T TMDA   60/ *MSTT* ADDRESS OF MASTER DEVICE 
  
  
 TMDA     BSSZ   8
          SPACE  4,10 
*         *MSS*/*MSE* ENVIRONMENT FLAGS.
  
  
 ASFF     BSSZ   1           *MSE* ENVIRONMENT FLAG 
 MSSF     BSSZ   1           *MSS* ENVIRONMENT FLAG 
 DVA$     ENDIF 
          SPACE  4,10 
 PFD$     IF     DEF,PFD$ 
          TITLE  COMCPFS - *PFDUMP*/*PFDM* CATALOG FILE ACCESS ROUTINES.
 PCI      SPACE  4,15 
**        PCI - PROCESS CATALOG TRACK INTERLOCK.
* 
*         ENTRY  (X6) = ADDRESS OF FET TO PROCESS INTERLOCK WITH. 
*                (X7) = *PFU* FUNCTION CODE TO PROCESS INTERLOCK WITH.
* 
*         EXIT   *PFU* CALLED TO PROCESS INTERLOCK. 
*                INTERLOCK MESSAGE POSTED AT LINE 2 OF THE CONTROL
*                POINT AND ON THE *K* DISPLAY BEFORE INTERLOCKING 
*                AND CLEARED AFTER. 
* 
*         USES   X - 1, 2, 3. 
*                A - 1, 2, 3, 6, 7. 
* 
*         MACROS CALLPFU, MESSAGE, MOVE, RECALL.
  
  
 PCI      SUBR               ENTRY/EXIT 
          SA6    PCIA        SAVE FET ADDRESS 
          SA7    PCIB        SAVE *PFU* FUNCTION CODE 
          RECALL X6          WAIT FOR FET NON BUSY
          SA3    IDSA+/COMSPFS/ADM1 
          MOVE   4,MEWC,X3   *WAIT FOR CATALOG INTERLOCK.*
          MESSAGE  MEWC,2,R 
          SA2    PCIA        GET FET ADDRESS
          SA1    PCIB        GET *PFU* FUNCTION CODE
          CALLPFU  X2,X1,R   PROCESS CATALOG TRACK INTERLOCK
          SA3    IDSA+/COMSPFS/ADM1 
          MOVE   4,MENL,X3   CLEAR INTERLOCK MESSAGE
          MESSAGE  (=C**),2,R 
          EQ     PCIX        RETURN 
  
  
 PCIA     BSS    1           TEMPORARY FET ADDRESS STORAGE
 PCIB     BSS    1           TEMPORARY *PFU* FUNCTION CODE STORAGE
 RCS      SPACE  4,20 
**        RCS - READ CATALOG SECTOR.
* 
*         ENTRY  (X2) = FET ADDRESS.
* 
*         EXIT   (X1) = 0 IF SECTOR READ WITHOUT ERROR. 
*                (X1) .GT. 0 IF EOR, EOF, OR EOI ENCOUNTERED OR READ
*                     ERROR WITH NO DATA TRANSFERRED. 
*                (X1) .LT. 0 IF SECTOR READ WITH ERROR IN DATA. 
*                CATALOG ENTRIES IN *CSBF* IF DATA READ.
*                (CSTC) = CATALOG SECTOR TRAILING CONTROL WORD IF DATA
*                         READ. 
*                (CSLW) = LWA+1 OF LAST ENTRY IN *CSBF* IF DATA READ. 
* 
*         USES   X - 1, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 2, 6, 7. 
* 
*         CALLS  SFE. 
* 
*         MACROS RECALL, READW. 
  
  
 RCS      SUBR               ENTRY/EXIT 
          READW  X2,RCSA,1   READ LEADING CONTROL WORD
          SX4    B1          PRESET FATAL ERROR 
          SX6    X1          SAVE STATUS
          SX1    X1+3 
          SB2    ERCR        * CATALOG READ ERROR ...*
          ZR     X1,RCS1     IF READ ERROR
          NZ     X6,RCSX     IF EOR, EOF, OR EOI
          SA3    RCSA 
          SX6    5
          SX3    X3          SECTOR LENGTH IN BYTES 
          IX3    X3/X6       SECTOR LENGTH IN WORDS 
          MX6    -4 
          SX7    CSBF+X3
          BX6    -X6*X3 
          ERRNZ  NWCE-20B 
          SB2    ERCB        * CATALOG SECTOR BAD ...*
          NZ     X6,RCS1     IF LENGTH NOT MULTIPLE OF *NWCE* 
          SA7    CSLW        SET LWA+1 OF ENTRIES IN *CSBF* 
          READW  X2,CSBF,X3  READ DATA
          READW  X2,CSTC,1   READ TRAILING CONTROL WORD 
*         SX1    B0          SET READ COMPLETE STATUS 
          SA4    RCSA 
          PL     X4,RCSX     IF NO ERROR IN SECTOR DATA 
          SB2    ERCR        * CATALOG READ ERROR ...*
  
*         CLEAR ERROR CODE IN FET.
  
 RCS1     RECALL X2          WAIT *CIO* COMPLETE
          SA1    X2 
          SX6    36000B 
          BX6    -X6*X1      CLEAR ERROR CODE IN FET STATUS 
          SX7    B0 
          SA6    X2 
          SA7    X2+6        CLEAR DETAILED ERROR CODE
  
*         ISSUE ERROR MESSAGE.
  
          BX6    X4 
          SA6    RCSB        SAVE FATAL ERROR STATUS
          SA1    PDUI 
          RJ     SFE         SEND ERROR MESSAGE 
          SA1    RCSB        GET ERROR STATUS 
          EQ     RCSX        RETURN 
  
  
 RCSA     CON    0           LEADING CONTROL WORD 
 RCSB     CON    0           FATAL ERROR STATUS 
          SPACE  4,10 
*         CATALOG FILE STATUS DATA AND BUFFERS. 
  
 CSBF     BSSZ   100B        CATALOG SECTOR BUFFER
  
 CSLW     CON    0           LWA+1 OF LAST ENTRY IN *CSBF*
 CSTC     CON    0           CATALOG SECTOR TRAILING CONTROL WORD 
          SPACE  4,10 
*         ERROR MESSAGES. 
  
  
 ERCR     DATA   C* CATALOG READ ERROR, UI=!!!!!!.* 
 ERCB     DATA   C* CATALOG SECTOR BAD, UI=!!!!!!.* 
          SPACE  4,10 
          TITLE  COMCPFS - *PFM* SPECIAL REQUEST ROUTINES.
 PFR      SPACE  4,15 
**        PFR - PROCESS *PFM* REQUESTS. 
* 
*         ENTRY  *PFMREQ* = *PFM* REQUEST FILE FET. 
* 
*         EXIT   *PFM* REQUESTS PROCESSED.
*                (PPFC) = COUNT OF REQUESTS WITH NO ERROR.
*                *PFMREQ* FILE RETURNED.
* 
*         USES   X - 1, 2, 6. 
*                A - 1, 2, 6. 
*                B - 2. 
* 
*         CALLS  DFN. 
* 
*         MACROS DROPDS, READ, READW, RETURN, REWIND, SETASA, WRITER. 
  
  
 PFR6     RETURN X2          RETURN REQUEST FILE
  
 PFR      SUBR               ENTRY/EXIT 
          SA1    PFRI 
          ZR     X1,PFRX     IF NO REQUESTS 
          WRITER PFMREQ      FLUSH REQUEST FILE 
          REWIND X2 
          READ   X2 
  
*         READ NEXT REQUEST AND DISPLAY FILE NAME.
  
 PFR1     READW  PFMREQ,PFRP,PFRPL  READ *PFM* REQUEST
          NZ     X1,PFR6     IF END OF REQUESTS 
          SA2    PFRI 
          SA1    PFRF 
          SA2    X2          SET MESSAGE VERB 
          RJ     DFN         DISPLAY FILE PROCESSING MESSAGE
          SA1    PFRI 
          UX1    B2,X1
          SA2    PFRA+B2     GET PROCESSOR ADDRESS
          SB2    X2+
          JP     B2          PROCESS REQUEST
  
*         SET TAPE ALTERNATE STORAGE POINTERS.
  
 PFR2     SETASA PFMR 
          EQ     PFR5        CHECK ERROR STATUS 
  
*         DROP DISK SPACE.
  
 PFR3     DROPDS PFMR 
          EQ     PFR5        CHECK ERROR STATUS 
  
*         PURGE FILE. 
  
 PFR4     PURGE  PFMR 
*         EQ     PFR5        CHECK ERROR STATUS 
  
*         CHECK ERROR STATUS. 
  
 PFR5     SA1    X2+         GET ERROR CODE FROM FET
          SX1    X1 
          AX1    10 
          NZ     X1,PFR1     IF *PFM* ERROR 
          SA1    PPFC        COUNT FILE PROCESSED 
          SX6    B1 
          IX6    X1+X6
          SA6    PPFC 
          EQ     PFR1        PROCESS NEXT FILE
  
  
 PFRA     BSS    0           TABLE OF *PFM* REQUEST PROCESSORS
          LOC    0
 SAPP     CON    PFR2        *SETASA* PROCESSOR 
 DDPP     CON    PFR3        *DROPDS* PROCESSOR 
 PRPP     CON    PFR4        *PURGE* PROCESSOR
 MXPP     BSS    0           MAXIMUM *PFM* PROCESSOR + 1
          LOC    *O 
 SCA      SPACE  4,10 
**        SCA - SET CATALOG DISK ADDRESS. 
* 
*         ENTRY  (A0) = ADDRESS OF CATALOG ENTRY IN *CSBF*. 
*                (CSTC) = CATALOG SECTOR TRAILING CONTROL WORD. 
* 
*         EXIT   (A0) = CATALOG ENTRY ADDRESS.
*                (CADA) = DISK ADRESS OF CATALOG ENTRY FORMATTED FOR
*                       *PFM* SPECIAL REQUEST BLOCK.
* 
*         USES   X - 1, 2, 6. 
*                A - 1, 2.
  
  
 SCA      SUBR               ENTRY/EXIT 
          SA1    CSTC 
          SA2    CPAR+/COMSPFS/CPDN 
          SX6    A0-CSBF     OFFSET IN BUFFER 
          MX7    -24
          AX6    4           INDEX IN SECTOR
          ERRNZ  NWCE-20B 
          LX6    30 
          BX1    -X7*X1      CATALOG TRACK AND SECTOR 
          LX2    24 
          BX6    X6+X1       MERGE INDEX AND TRACK/SECTOR 
          BX6    X6+X2       MERGE MASTER DEVICE NUMBER 
          SA6    CADA        SET CATALOG DISK ADDRESS 
          EQ     SCAX        RETURN 
 SPR      SPACE  4,15 
**        SPR - SET *PFM* REQUEST PARAMETERS. 
* 
*         ENTRY  (B2) = *PFM* SPECIAL REQUEST BLOCK ADDRESS.
*                (A0) = CATALOG ENTRY ADDRESS.
*                (X7) = SPECIAL REQUEST BLOCK WORD 1. 
*                (CADA) = CATALOG DISK ADDRESS (REQUEST BLOCK WORD 0).
*                (FMPN) = FAMILY OR PACK NAME.
* 
*         EXIT   (A0) = CATALOG ENTRY ADDRESS.
*                *PFM* SPECIAL REQUEST BLOCK BUILT. 
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                A - 1, 2, 3, 4, 6, 7.
  
  
 SPR      SUBR               ENTRY/EXIT 
          SA4    CADA        GET CATALOG DISK ADDRESS 
          SA1    A0+FCUI     GET FILE NAME AND USER INDEX 
          SA2    A0+FCCD     GET CREATION DATE AND TIME 
          SA3    FMPN        GET FAMILY OR PACK NAME
          BX6    X4 
          SA7    B2+B1       SET SPECIAL REQUEST BLOCK WORD 1 
          SA6    B2+         SET CATALOG DISK ADDRESS 
          MX0    -36
          MX7    -18
          BX1    -X7*X1      ISOLATE USER INDEX 
          BX6    -X0*X2 
          SA2    B2+2        GET OPTICAL DISK ADDRESS 
          BX2    X0*X2
          BX6    X2+X6       MERGE ADDRESS AND CREATION DATE/TIME 
          SA6    A2          SET CREATION DATE AND TIME 
          BX7    X3+X1       MERGE FAMILY/PACK NAME AND USER INDEX
          SA7    B2+3        SET FAMILY/PACK NAME AND USER INDEX
          EQ     SPRX        RETURN 
 WPR      SPACE  4,15 
**        WPR - WRITE *PFM* REQUEST PARAMETERS TO *PFMREQ* FILE.
* 
*         ENTRY  (A0) = CATALOG ENTRY ADDRESS.
*                (X7) = SPECIAL REQUEST BLOCK WORD 1. 
*                (CADA) = CATALOG ENTRY DISK ADDRESS PARAMETERS.
*                (PFRI) = PROCESSOR INDEX, FILE COUNTS POINTER, AND 
*                  MESSAGE POINTER (SEE *PFRP* DOCUMENTATION).
* 
*         EXIT   (A0) = CATALOG ENTRY ADDRESS.
*                *PFM* REQUEST PARAMETERS WRITTEN TO REQUEST FILE.
* 
*         CALLS  SPR. 
* 
*         MACROS WRITEW.
  
  
 WPR      SUBR               ENTRY/EXIT 
          SB2    PFRS        SET SPECIAL REQUEST BLOCK ADDRESS
          RJ     SPR         SET *PFM* REQUEST
          SA1    A0+FCFN     SET FILE NAME AND USER INDEX 
          BX6    X1 
          SA6    PFRF 
          WRITEW PFMREQ,PFRP,PFRPL  WRITE REQUEST FILE ENTRY
          EQ     WPRX        RETURN 
          SPACE  4,10 
*         GLOBAL DATA.
  
  
 CADA     CON    0           CATALOG DISK ADDRESS 
 PFMR     SPACE  4,10 
*         PFMR - *PFM* REQUEST FET. 
  
  
 PFMR     FILEB  PFRB,PFRBL,EPR,FET=16
          ORG    PFMR+CFPW
          VFD    42/0,18/PFRE          ERROR MESSAGE RETURN ADDRESS 
          ORG    PFMR+CFSR
          VFD    42/0,18/PFRS          SPECIAL REQUEST BLOCK ADDRESS
          ORG    PFMR+16
 PFRP     SPACE  4,10 
*         PFRP - *PFM* REQUEST PARAMETERS BLOCK.
  
  
 PFRP     BSS    0           *PFM* REQUEST PARAMETERS 
 PFRI     VFD    12/0        2000B + INDEX INTO *PFRA*
          VFD    30/0 
          VFD    18/0        MESSAGE POINTER
 PFRF     VFD    42/0        FILE NAME
          VFD    18/0        USER INDEX 
 PFRS     BSSZ   4           *PFM* SPECIAL REQUEST BLOCK
 PFRPL    EQU    *-PFRP      REQUEST BLOCK LENGTH 
  
 PFRE     BSSZ   3           *PFM* ERROR MESSAGE
          TITLE  COMCPFS - *PFDUMP*/*PFDM* GENERAL SUBROUTINES. 
 CAC      SPACE  4,15 
**        CAC - CLEAR PF ACTIVITY COUNT.
* 
*         ENTRY  (ACFL) = 1 IF ACTIVITY COUNT SET.
*                       = 0 IF ACTIVITY COUNT ALREADY CLEAR.
*                (MAEQ) = MASTER DEVICE EST ORDINAL.
* 
*         EXIT   (ACFL) = 0.
*                *PFU* CALLED TO CLEAR PF ACTIVITY COUNT IF NOT ALREADY 
*                CLEAR. 
* 
*         USES   X - 1, 3, 6. 
*                A - 1, 3, 6. 
* 
*         MACROS CALLPFU, MESSAGE, MOVE.
  
  
 CAC      SUBR               ENTRY/EXIT 
          SA1    ACFL        CHECK ACTIVITY COUNT FLAG
          SX6    ACFL        SET ACTIVITY COUNT FLAG ADDRESS
          ZR     X1,CACX     IF ACTIVITY COUNT ALREADY CLEAR
          SA1    MAEQ        SET MASTER DEVICE EST ORDINAL
          LX1    -12
          BX6    X1+X6       MERGE WITH FET ADDRESS 
          SA6    ACFT+FTPM
          SA3    IDSA+/COMSPFS/ADM1  *K* DISPLAY MESSAGE ADDRESS
          MOVE   4,MECP,X3   *CLEARING PF ACTIVITY COUNT.*
          MESSAGE  MECP,2,R 
          CALLPFU  ACFT,CTDA,R  DECREMENT PF ACTIVITY COUNT 
          SA3    IDSA+/COMSPFS/ADM1  *K* DISPLAY MESSAGE ADDRESS
          MOVE   4,MENL,X3   CLEAR MESSAGE
          MESSAGE (=C**),2,R
          EQ     CACX        RETURN 
 CBR      SPACE  4,20 
**        CBR - CHECK BACKUP REQUIREMENT. 
* 
*         ENTRY  (A0) = CATALOG ENTRY ADDRESS.
* 
*         EXIT   (X6) = EFFECTIVE BACKUP REQUIREMENT. 
*                (X7) = 0 IF BACKUP REQUIREMENT NOT MET BY ALTERNATE
*                  STORAGE COPIES.
*                (X7) = 1 IF BACKUP REQUIREMENT MET BY ALTERNATE
*                  STORAGE COPIES.
*                (B2) = NUMBER OF COPIES OF FILE DATA ON ALTERNATE
*                  STORAGE MEDIA. 
*                (B3) .NE. 0 IF FILE RESIDES ON TAPE ALTERNATE STORAGE. 
*                (B3) = 0 IF FILE DOES NOT RESIDE ON TAPE ALTERNATE 
*                  STORAGE. 
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 2.
*                B - 2, 3.
  
  
 CBR      SUBR               ENTRY/EXIT 
  
*         DETERMINE NUMBER OF ALTERNATE STORAGE COPIES. 
  
          SA2    A0+FCTV     GET TAPE ALTERNATE STORAGE POINTERS
          SA1    A0+FCAA     GET CARTRIDGE ALTERNATE STORAGE POINTERS 
          SB2    B0          SET NO ALTERNATE STORAGE COPIES
          SB3    B0          SET NOT TAPE RESIDENT
          MX7    -36
          BX6    -X7*X2 
          ZR     X6,CBR2     IF NO TAPE ALTERNATE STORAGE COPIES
          SX6    B1 
          LX2    0-49 
          SB3    B1          INDICATE TAPE RESIDENT 
          BX6    X6*X2       SECONDARY VSN FLAG 
          SB2    X6+1        NUMBER OF TAPE ALTERNATE STORAGE COPIES
 CBR2     BX7    -X7*X1 
          ZR     X7,CBR3     IF NO CARTRIDGE ALTERNATE STORAGE COPY 
          LX1    59-48
          NG     X1,CBR3     IF CARTRIDGE COPY IS OBSOLETE
          SB2    B2+1        COUNT CARTRIDGE COPY 
  
*         DETERMINE BACKUP REQUIREMENT. 
  
 CBR3     SA1    A0+FCBR     GET BACKUP REQUIREMENT CODE
          SA2    CPAR+/COMSPFS/CPOP 
          SX6    BRAL        SET BACKUP REQUIREMENT = YES 
          MX3    -3 
          LX1    -54
          LX2    59-45
          BX3    -X3*X1 
          SX7    B0+         SET NOT BACKED UP ON ALTERNATE STORAGE 
          NG     X2,CBR4     IF *OP=Y* SELECTED 
          SX6    X3+         SET BACKUP REQUIREMENT FROM PFC ENTRY
  
*         DETERMINE IF BACKUP REQUIREMENT IS MET. 
*         *BR=Y* REQUIRES TWO ALTERNATE STORAGE COPIES. 
*         *BR=MD* REQUIRES ONE ALTERNATE STORAGE COPY.
*         *BR=N* IS TREATED THE SAME AS *BR=MD* FOR THIS TEST.
  
 CBR4     ZR     B2,CBRX     IF NO ALTERNATE STORAGE COPIES 
          SX1    X6-BRAL
          GT     B2,B1,CBR5  IF MORE THAN ONE ALTERNATE STORAGE COPY
          ZR     X1,CBRX     IF BACKUP REQUIREMENT = YES
 CBR5     SX7    1           SET FILE BACKED UP ON ALTERNATE STORAGE
          EQ     CBRX        RETURN 
 CDS      SPACE  4,10 
**        CDS - CHECK DEVICE STATUS.
* 
*         ENTRY  (X1) = DEVICE NUMBER.
* 
*         EXIT   (X6) = EST ORDINAL IF DEVICE FOUND.
*                (X6) = 0 IF DEVICE NOT FOUND.
* 
*         USES   X - 2, 6.
*                A - 2. 
  
  
 CDS2     SX6    B0+         SET DEVICE NOT FOUND 
  
 CDS      SUBR               ENTRY/EXIT 
          SA2    MSTT-2      SET MASS STORAGE TABLE ADDRESS 
 CDS1     SA2    A2+2        GET MASS STORAGE TABLE ENTRY 
          MX6    -6 
          BX6    -X6*X2      DEVICE NUMBER
          ZR     X2,CDS2     IF END OF MASS STORAGE TABLE 
          IX6    X1-X6
          LX2    -6 
          NZ     X6,CDS1     IF NOT CORRECT DEVICE
          MX6    -9 
          BX6    -X6*X2      SET EST ORDINAL
          EQ     CDSX        RETURN 
 OCF      SPACE  4,10 
**        OCF - OPEN CATALOG FILE.
* 
*         EXIT   NEW CATALOG FILE OPENED. 
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 6.
* 
*         MACROS CALLPFU. 
  
  
 OCF      SUBR               ENTRY/EXIT 
          SX6    PDWD        SET DEVICE OR PACKNAME POINTER 
          SX7    PDUI        SET USER INDEX POINTER 
          LX6    18 
          BX6    X6+X7
          SA6    CATS+FTPM   SET *PFU* PARAMETER WORD 
          CALLPFU  CATS,CTCT,R  GET CATALOG TRACK PARAMETERS
          SA1    CATS+FTPM
          SX2    5           SET INITIAL FILE STATUS
          MX6    -24
          BX1    -X6*X1      SET EQ AND FIRST TRACK 
          MX6    -12
          BX6    -X6*X1      SET CURRENT TRACK
          LX1    36 
          BX2    X2+X1       BUILD CATALOG TRACK FST ENTRY
          LX6    24 
          BX6    X2+X6
          SA6    A1 
          CALLPFU  CATS,CTOL,R  OPEN FILE 
          EQ     OCFX        RETURN 
 PCF      SPACE  4,20 
**        PCF - POSITION CATALOG FILE.
* 
*         ENTRY  (X5) = NEW CATALOG TRACK IF .GE. 0.
*                (X5) = -1 IF TO CLEAR CATALOG TRACK STATUS.
*                (CTRK) = OLD CATALOG TRACK IF .GE. 0.
*                (CTRK) = -1 IF NO OLD CATALOG TRACK. 
*                OLD CATALOG TRACK INTERLOCKED IF CTRK .GE. 0.
* 
*         EXIT   (X5) = NEW CATALOG TRACK IF .GE. 0.
*                (X5) = -1 IF CATALOG TRACK STATUS CLEARED. 
*                (CTRK) = NEW CATALOG TRACK IF .GE. 0.
*                (CTRK) = -1 IF CATALOG TRACK STATUS CLEARED. 
*                NEW CATALOG TRACK INTERLOCKED. 
*                OLD CATALOG TRACK INTERLOCK CLEARED. 
* 
*         USES   X - 0, 1, 2, 6, 7. 
*                A - 1, 2, 6, 7.
* 
*         MACROS CALLPFU, PCINT.
  
  
 PCF1     NG     X2,PCFX     IF NO OLD CATALOG TRACK
          PCINT  CATS,CTCC   CLEAR OLD CATALOG TRACK INTERLOCK
  
 PCF      SUBR               ENTRY/EXIT 
          SA2    CTRK 
          SA1    PDUI 
          BX6    X5 
          SA6    A2          UPDATE CATALOG TRACK 
          NG     X5,PCF1     IF CLEARING CATALOG TRACK STATUS 
          MX7    -3 
          BX7    -X7*X1 
          LX6    3
          BX7    X7+X6       SET NEW CATALOG TRACK
          SA7    A1 
          SX6    A1 
          SX7    PDWD 
          LX7    18 
          BX7    X6+X7
          SA7    CATS+FTPM   SET PF DESCRIPTION POINTERS
          BX0    X2          SAVE OLD CATALOG TRACK STATUS
          CALLPFU  CATS,CTPC,R  POSITION CATALOG FILE TO NEW TRACK
          PL     X0,PCFX     IF OLD CATALOG TRACK ON ENTRY
          PCINT  CATS,CTSC   SET NEW CATALOG TRACK INTERLOCK
          EQ     PCFX        RETURN 
 SAC      SPACE  4,15 
**        SAC - SET PF ACTIVITY COUNT.
* 
*         ENTRY  (ACFL) = 0.
*                (MAEQ) = MASTER DEVICE EST ORDINAL.
* 
*         EXIT   (ACFL) = 1.
*                *PFU* CALLED TO SET PF ACTIVITY COUNT. 
* 
*         USES   X - 3, 6.
*                A - 3, 6.
* 
*         MACROS CALLPFU, MESSAGE, MOVE.
  
  
 SAC      SUBR               ENTRY/EXIT 
          SA3    MAEQ        SET MASTER DEVICE EST ORDINAL
          SX6    ACFL        SET ACTIVITY COUNT FLAG ADDRESS
          LX3    -12
          BX6    X3+X6       MERGE WITH FET ADDRESS 
          SA6    ACFT+FTPM
          SA3    IDSA+/COMSPFS/ADM1  *K* DISPLAY MESSAGE ADDRESS
          MOVE   4,MESP,X3   *SETTING PF ACTIVITY COUNT.* 
          MESSAGE  MESP,2,R 
          CALLPFU  ACFT,CTIA,R  INCREMENT PF ACTIVITY COUNT 
          SA3    IDSA+/COMSPFS/ADM1  *K* DISPLAY MESSAGE ADDRESS
          MOVE   4,MENL,X3   CLEAR SETTING MESSAGE
          MESSAGE  (=C**),2,R 
          EQ     SACX        RETURN 
 SFL      SPACE  4,20 
**        SFL - SET FILE LENGTH.
* 
*         ENTRY  (A0) = CATALOG ENTRY ADDRESS.
*                (FLCF) .NE. 0 IF CORRECT FILE LENGTH IN CATALOG ENTRY. 
* 
*         EXIT   (A0) = CATALOG ENTRY ADDRESS.
*                (X6) .NE. 0 IF NO ERROR. 
*                (X6) = 0 IF NON-MASTER DEVICE NOT FOUND. 
*                FILE LENGTH SET IN PFC ENTRY IF NO ERROR.
*                (FLCF) .NE. 0 IF CORRECT FILE LENGTH IN CATALOG ENTRY
*                  AND NO ERROR.
* 
*         USES   X - 0, 1, 2, 4, 5, 6, 7. 
*                A - 1, 2, 4, 6, 7. 
*                B - 2, 3.
* 
*         CALLS  CDS, CFE, SDE. 
* 
*         MACROS CALLPFU. 
  
  
 SFL      SUBR               ENTRY/EXIT 
          SA1    FLCF 
          NZ     X1,SFL3     IF FILE LENGTH ALREADY CORRECT 
          SA4    A0+FCLF
          SA1    A0+FCDN
          SA2    MAEQ 
          MX7    24 
          MX0    -12
          BX7    X7*X4
          LX4    59-11
          PL     X4,SFL3     IF INDIRECT ACCESS FILE
          BX5    -X0*X4      FIRST TRACK
          LX4    12 
          NZ     X7,SFL2     IF FILE LENGTH PRESENT IN CATALOG ENTRY
          LX1    -36
          MX7    -6 
          BX1    -X7*X1      RESIDENCY DEVICE 
          BX7    X2          MASTER EQUIPMENT 
          ZR     X1,SFL1     IF FILE RESIDES ON MASTER DEVICE 
          RJ     CDS         CHECK DEVICE STATUS
          BX7    X6 
          NZ     X6,SFL1     IF DEVICE FOUND
          BX2    X1          SET DEVICE NUMBER
          SA1    A0+FCFN     GET FILE NAME AND USER INDEX 
          SB2    ERDN        * DEVICE NOT FOUND ...*
          RJ     SDE         ISSUE ERROR MESSAGE
          RJ     CFE         COUNT FILE SKIPPED 
          SX6    B0          SET DEVICE NOT FOUND 
          EQ     SFLX        RETURN 
  
 SFL1     LX7    48 
          BX7    X7+X5       MERGE EQUIPMENT AND TRACK
          SA7    CATS+FTPM
          CALLPFU  CATS,CTFL,R  GET FILE LENGTH FROM TRT
          SA1    CATS+FTPM
          MX7    -24
          BX7    -X7*X1 
          ZR     X7,SFL3     IF ZERO LENGTH 
          LX7    36 
          BX4    X4+X7       MERGE FILE LENGTH
 SFL2     SX1    B1          SUBTRACT EOI SECTOR FROM LENGTH
          LX1    36 
          IX7    X4-X1
          SA7    A4          SET FILE LENGTH
 SFL3     SX6    1           SET FILE LENGTH CORRECT FLAG AND STATUS
          SA6    FLCF 
          EQ     SFLX        RETURN 
 SNC      SPACE  4,15 
**        SNC - SET NEXT CATALOG TRACK. 
* 
*         ENTRY  (MSTA) = CURRENT MASTER DEVICE *MSTT* ADDRESS. 
*                (CTRK) = CURRENT CATALOG TRACK IF .GE. 0.
*                (CTRK) = -1 IF NO CATALOG TRACKS PROCESSED ON DEVICE.
*                (SXUF) .NE. 0 IF ONLY PROCESSING *SYSTEMX* FILES ON
*                  SUBFAMILY 7. 
* 
*         EXIT   (X5) = NEXT CATALOG TRACK IF .GE. 0. 
*                (X5) = -1 IF END OF CATALOG TRACKS TO PROCESS. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4.
*                B - 2. 
  
  
 SNC      SUBR               ENTRY/EXIT 
          SA1    /COMSPFS/FISP
          SA2    CTRK        GET CURRENT CATALOG TRACK
          SA3    MSTA        GET CURRENT *MSTT* POINTER 
          SA3    X3+
          SA4    A3+B1
          MX6    -9 
          LX3    -15
          BX3    -X6*X3 
          SX3    X3-1        NUMBER OF CATALOG TRACKS - 1 
          NZ     X1,SNC2     IF USER INDEX SELECTIONS PRESENT 
          LX4    59-7 
          PL     X4,SNC1     IF NOT *SYSTEMX* MASTER DEVICE 
          SA4    SXUF 
          NZ     X4,SNC5     IF PROCESSING *SYSTEMX* FILES ONLY 
  
*         ADVANCE CATALOG TRACK.
  
 SNC1     SX5    X2+B1       ADVANCE CATALOG TRACK
          BX2    -X3*X5 
          ZR     X2,SNCX     IF NOT END OF CATALOG TRACKS 
          SX5    -B1         SET END OF CATALOG TRACKS
          EQ     SNCX        RETURN 
  
*         SET CATALOG TRACK FROM USER INDEX SELECTIONS. 
  
 SNC2     SA1    X1          GET FIRST ENTRY
          MX6    -8 
          BX4    -X6*X4      DEVICE MASK
          MX7    -3 
          SX0    1
          SX5    1000B
 SNC3     BX6    -X7*X1 
          LX1    -3 
          SB2    X6          USER INDEX MASTER DEVICE POINTER 
          BX6    X3*X1       USER INDEX CATALOG TRACK 
          LX1    B2,X0
          BX1    X4*X1
          ZR     X1,SNC4     IF NOT CURRENT MASTER DEVICE 
          IX1    X2-X6
          PL     X1,SNC4     IF CATALOG TRACK ALREADY PROCESSED 
          IX1    X6-X5
          PL     X1,SNC4     IF THIS TRACK NOT LOWER THAN PREVIOUS
          SX5    X6+         UPDATE CATALOG TRACK 
 SNC4     SA1    A1+1        GET NEXT ENTRY 
          NZ     X1,SNC3     IF MORE SELECTIONS TO CHECK
          SX1    X5-1000B 
          NZ     X1,SNCX     IF NEW CATALOG TRACK FOUND 
          SX5    -B1         SET END OF CATALOG TRACKS
          EQ     SNCX        PROCESS END OF CATALOG TRACKS
  
*         SET *SYSTEMX* USER INDEX CATALOG TRACK. 
  
 SNC5     BX5    X3          SET *SYSTEMX* CATALOG TRACK
          ZR     X2,SNCX     IF TRACK NOT ALREADY PROCESSED 
          SX5    -B1         SET END OF CATALOG TRACKS
          EQ     SNCX        RETURN 
 SND      SPACE  4,20 
**        SND - SET NEXT DEVICE.
* 
*         ENTRY  (MSTA) = 0 IF FIRST CALL.
*                       = *MSTT* ADDRESS OF LAST DEVICE IF .NE. 0.
* 
*         EXIT   (X1) .NE. 0 IF DEVICE SELECTED.
*                (X1) = 0 IF END OF DEVICES.
*                (MSTA) = *MSTT* ADDRESS OF NEXT DEVICE.
*                (MSTA) = *MSTT* LWA+1 IF END OF DEVICES. 
*                (PDUI) = CATALOG DESCRIPTION USER INDEX. 
*                (MAEQ) = MASTER DEVICE EST ORDINAL.
*                (CPAR+/COMSPFS/CPDN) = MASTER DEVICE NUMBER. 
*                PF ACTIVITY COUNT ON PREVIOUS DEVICE IS DECREMENTED. 
*                PF ACTIVITY COUNT IS INCREMENTED ON NEXT DEVICE. 
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 4, 6, 7. 
*                B - 2, 3.
* 
*         CALLS  CAC, SAC.
  
  
 SND      SUBR               ENTRY/EXIT 
          SA1    MSTA        SET ADDRESS OF MASS STORAGE TABLE
          SX7    MSTT 
          ZR     X1,SND1     IF FIRST CALL
          RJ     CAC         CLEAR PF ACTIVITY COUNT
          SA1    MSTA 
          SX7    X1+2        SET NEXT *MSTT* ADDRESS
 SND1     SA4    MASK        GET FILE SELECTION MASK
          MX6    -8 
  
*         DETERMINE NEXT DEVICE.
  
 SND2     SA1    X7          GET FIRST WORD OF *MSTT* ENTRY 
          SA2    X7+B1       GET DEVICE MASK
          SA7    MSTA        UPDATE *MSTT* ENTRY ADDRESS
          SX7    X7+2        ADVANCE ENTRY ADDRESS
          ZR     X1,SNDX     IF END OF DEVICES
          BX3    -X6*X2      DEVICE MASK
          BX3    X4*X3
          ZR     X3,SND2     IF NO SELECTED FILES CATALOGED ON DEVICE 
  
*         SET DEVICE PARAMETERS AND INCREMENT PF ACTIVITY COUNT.
  
          SB2    47 
          NX3    X3,B3       SET USER INDEX FOR CATALOG ACCESS
          SX7    B2-B3
          SA7    PDUI 
          MX3    -6 
          BX6    -X3*X1      MASTER DEVICE NUMBER 
          SA6    CPAR+/COMSPFS/CPDN  SET MASTER DEVICE NUMBER 
          MX3    -9 
          LX1    -6 
          BX7    -X3*X1      MASTER DEVICE EST ORDINAL
          SA7    MAEQ        SET MASTER DEVICE EST ORDINAL
          RJ     SAC         SET PF ACTIVITY COUNT
          SX1    B1          SET DEVICE SELECTED
          EQ     SNDX        RETURN 
          SPACE  4,10 
*         ERROR MESSAGES. 
  
  
 ERDN     DATA   C* DEVICE NOT FOUND, FN=???????, UI=!!!!!!, DN=++.*
          SPACE  4,10 
*         STATUS MESSAGES.
  
  
 MEWC     DATA   40C WAIT FOR CATALOG INTERLOCK.
 MESP     DATA   40C SETTING PF ACTIVITY COUNT. 
 MECP     DATA   40C CLEARING PF ACTIVITY COUNT.
 MENL     DATA   40C
          TITLE  COMCPFS - *PFDUMP*/*PFDM* DATA AREA. 
          SPACE  4,10 
*         GLOBAL DATA LOCATIONS.
  
  
 FLCF     BSSZ   1           FILE LENGTH CORRECT FLAG 
 CTRK     CON    -1          CURRENT CATALOG TRACK
 MAEQ     BSSZ   1           MASTER DEVICE EST ORDINAL
 MSTA     BSSZ   1           *MSTT* ADDRESS OF DEVICE BEING PROCESSED 
          SPACE  4,10 
*         CATALOG FILE PARAMETER WORDS. 
  
 PDUI     BSS    1           PF DESCRIPTION USER INDEX
          SPACE  4,10 
*         PERMANENT FILE ACTIVITY CONTROL FLAGS.
  
  
 ACFT     FILEB  0,0,(FET=10)  FET TO CONTROL PF ACTIVITY COUNT 
 ACFL     CON    0           PF ACTIVITY FLAG (CLEAR=0, SET=1)
 PFD$     ENDIF 
          SPACE  4,10 
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 ABT      EQU    /COMCPFS/ABT 
 ALN      EQU    /COMCPFS/ALN 
 CES      EQU    /COMCPFS/CES 
 CFE      EQU    /COMCPFS/CFE 
 CFP      EQU    /COMCPFS/CFP 
 CIS      EQU    /COMCPFS/CIS 
 CSC      EQU    /COMCPFS/CSC 
 DFN      EQU    /COMCPFS/DFN 
 END      EQU    /COMCPFS/END 
 FAB      EQU    /COMCPFS/FAB 
 FCI      EQU    /COMCPFS/FCI 
 ICI      EQU    /COMCPFS/ICI 
 IFC      EQU    /COMCPFS/IFC 
 IFL      EQU    /COMCPFS/IFL 
 ISF      EQU    /COMCPFS/ISF 
 MWA      EQU    /COMCPFS/MWA 
 OAL      EQU    /COMCPFS/OAL 
 OCI      EQU    /COMCPFS/OCI 
 PSF      EQU    /COMCPFS/PSF 
 PSI      EQU    /COMCPFS/PSI 
 RPP      EQU    /COMCPFS/RPP 
 SDE      EQU    /COMCPFS/SDE 
 SDT      EQU    /COMCPFS/SDT 
 SEM      EQU    /COMCPFS/SEM 
 SFE      EQU    /COMCPFS/SFE 
 SFU      EQU    /COMCPFS/SFU 
 SHR      EQU    /COMCPFS/SHR 
 SUM      EQU    /COMCPFS/SUM 
 WCO      EQU    /COMCPFS/WCO 
 WSB      EQU    /COMCPFS/WSB 
 ABTF     EQU    /COMCPFS/ABTF
 AFIB     EQU    /COMCPFS/AFIB
 AFSA     EQU    /COMCPFS/AFSA
 AFSB     EQU    /COMCPFS/AFSB
 AFSC     EQU    /COMCPFS/AFSC
 AFSD     EQU    /COMCPFS/AFSD
 AFSE     EQU    /COMCPFS/AFSE
 AFSF     EQU    /COMCPFS/AFSF
 BLAN     EQU    /COMCPFS/BLAN
 CFBI     EQU    /COMCPFS/CFBI
 COBF     EQU    /COMCPFS/COBF
 DINF     EQU    /COMCPFS/DINF
 FLST     EQU    /COMCPFS/FLST
 MSGB     EQU    /COMCPFS/MSGB
 NPFC     EQU    /COMCPFS/NPFC
 O        EQU    /COMCPFS/O 
 OFFA     EQU    /COMCPFS/OFFA
 PAGE     EQU    /COMCPFS/PAGE
 PEFC     EQU    /COMCPFS/PEFC
 PF       EQU    /COMCPFS/PF
 PGFM     EQU    /COMCPFS/PGFM
 PGLL     EQU    /COMCPFS/PGLL
 PGSC     EQU    /COMCPFS/PGSC
 PGSD     EQU    /COMCPFS/PGSD
 PGST     EQU    /COMCPFS/PGST
 PGTXL    EQU    /COMCPFS/PGTXL 
 PGUT     EQU    /COMCPFS/PGUT
 POFC     EQU    /COMCPFS/POFC
 PPFC     EQU    /COMCPFS/PPFC
 PRFC     EQU    /COMCPFS/PRFC
 MTTA     EQU    /COMCPFS/MTTA
 MTTAL    EQU    /COMCPFS/MTTAL 
 RPVB     EQU    /COMCPFS/RPVB
 SEFC     EQU    /COMCPFS/SEFC
 STFC     EQU    /COMCPFS/STFC
 SU       EQU    /COMCPFS/SU
 SW1B     EQU    /COMCPFS/SW1B
 SW2B     EQU    /COMCPFS/SW2B
 SYSS     EQU    /COMCPFS/SYSS
 TSBI     EQU    /COMCPFS/TSBI
 PFA$     IF     DEF,PFA$ 
 PLP      EQU    /COMCPFS/PLP 
 AFDM     EQU    /COMCPFS/AFDM
 FLSM     EQU    /COMCPFS/FLSM
 MXDC     EQU    /COMCPFS/MXDC
 SFDT     EQU    /COMCPFS/SFDT
 PFA$     ENDIF 
 DVA$     IF     DEF,DVA$ 
 SEI      EQU    /COMCPFS/SEI 
 ASFF     EQU    /COMCPFS/ASFF
 ELWC     EQU    /COMCPFS/ELWC
 ELLI     EQU    /COMCPFS/ELLI
 ELWP     EQU    /COMCPFS/ELWP
 FMPN     EQU    /COMCPFS/FMPN
 MASK     EQU    /COMCPFS/MASK
 GPAR     EQU    /COMCPFS/GPAR
 MSSF     EQU    /COMCPFS/MSSF
 MSTT     EQU    /COMCPFS/MSTT
 PDWD     EQU    /COMCPFS/PDWD
 SPAR     EQU    /COMCPFS/SPAR
 SXUF     EQU    /COMCPFS/SXUF
 TMDA     EQU    /COMCPFS/TMDA
 DVA$     ENDIF 
 PFR$     IF     DEF,PFR$ 
 CWR      EQU    /COMCPFS/CWR 
 PFR$     ENDIF 
 PFD$     IF     DEF,PFD$ 
 CAC      EQU    /COMCPFS/CAC 
 CBR      EQU    /COMCPFS/CBR 
 CDS      EQU    /COMCPFS/CDS 
 OCF      EQU    /COMCPFS/OCF 
 PCF      EQU    /COMCPFS/PCF 
 PCI      EQU    /COMCPFS/PCI 
 PFR      EQU    /COMCPFS/PFR 
 RCS      EQU    /COMCPFS/RCS 
 SAC      EQU    /COMCPFS/SAC 
 SCA      EQU    /COMCPFS/SCA 
 SFL      EQU    /COMCPFS/SFL 
 SNC      EQU    /COMCPFS/SNC 
 SND      EQU    /COMCPFS/SND 
 SPR      EQU    /COMCPFS/SPR 
 WPR      EQU    /COMCPFS/WPR 
 ACFT     EQU    /COMCPFS/ACFT
 CADA     EQU    /COMCPFS/CADA
 CSBF     EQU    /COMCPFS/CSBF
 CSLW     EQU    /COMCPFS/CSLW
 CSTC     EQU    /COMCPFS/CSTC
 CTRK     EQU    /COMCPFS/CTRK
 DDPP     EQU    /COMCPFS/DDPP
 ERDN     EQU    /COMCPFS/ERDN
 FLCF     EQU    /COMCPFS/FLCF
 MAEQ     EQU    /COMCPFS/MAEQ
 MSTA     EQU    /COMCPFS/MSTA
 PDUI     EQU    /COMCPFS/PDUI
 PFRI     EQU    /COMCPFS/PFRI
 PFRS     EQU    /COMCPFS/PFRS
 PRPP     EQU    /COMCPFS/PRPP
 SAPP     EQU    /COMCPFS/SAPP
 PFD$     ENDIF 
 QUAL$    ENDIF 
          ENDX
