Retro1.org codex

          IDENT  PFLIST1,/COMSPFS/OVLA,PFS,01,00 
          TITLE  PFLIST - LIST PF UTILITY SUMMARY FILE.
          ABS
          SST
          SYSCOM B1
          SPACE  4
*COMMENT  PFLIST - LIST PF UTILITY SUMMARY FILE.
          COMMENT  COPYRIGHT CONTROL SYSTEMS INC.  1996.
          SPACE  4
***       PFLIST - LIST PF UTILITY SUMMARY FILE.
*
*         G. S. YODER        96/04/24.
          SPACE  4
***       *PFLIST* IS A PERMANENT FILE UTILITY PROGRAM WHICH GENERATES
*         AN OUTPUT LISTING FROM A SUMMARY FILE PRODUCED BY ANOTHER
*         PERMANENT FILE UTILITY.  *PFLIST* MAY BE CALLED FROM *PFS* OR
*         DIRECTLY BY A COMMAND.
          SPACE  4
***       DAYFILE MESSAGES.
*
*         INFORMATIVE.
*
*         * PFLIST COMPLETE.* = PROGRAM COMPLETE.
*
*         FATAL SYSTEM ERRORS.
*
*         * PFLIST ABORTED.* = ERROR FLAG DETECTED ON CONTROL POINT.
*
*         * FORMAT ERROR IN SUMMARY FILE.*
          SPACE  4
*         COMMON DECKS.
 
 
*CALL     COMCMAC
*CALL     COMCCMD
*CALL     COMSMLS
*CALL     COMSRPV
*CALL     COMSPFM
          LIST   X
*CALL     COMSPFS
          LIST   *
*CALL     COMSPFU
*CALL     COMSPRD
*CALL     COMSSFM
*CALL     COMSVER
          TITLE  ASSEMBLY CONSTANTS.
*         ASSEMBLY CONSTANTS.
 
 
 DBUFL    EQU    1000B       SUMMARY FILE DATA BLOCK BUFFER LENGTH
 MSFBL    EQU    10001B      *COMCMSF* SORT FILES BUFFER LENGTH
 OUTBL    EQU    10001B      OUTPUT FILE BUFFER LENGTH
 PFLBL    EQU    1001B       PROCESSED FILES FILE BUFFER LENGTH
 SABFL    EQU    1000B       SUMMARY FILE ASSEMBLY BUFFER LENGTH
 SRTBL    EQU    20000B      SORT BUFFER LENGTH
 SUIBL    EQU    10001B      SUMMARY INPUT FILE BUFFER LENGTH
 SUMBL    EQU    0           SUMMARY FILE BUFFER LENGTH
 
 
*         *COMSPFS* EQUIVALENCES.
 
 CPAR     EQU    /COMSPFS/CPL
 IDSA     EQU    /COMSPFS/PADR
          TITLE  RESERVED LOCATIONS AND FETS.
          SPACE  4
          ORG    /COMSPFS/OVLA
          SPACE  4
**        RESERVED LOCATIONS.
 
 
*         SUMMARY FILE DATA BLOCK STATUS.
 
 BLCW     CON    0           BLOCK CONTROL WORD
 BLTY     CON    0           TYPE OF DATA BLOCK IN BUFFER
          SPACE  4
**        FETS.
 
 
 SI       BSS    0           SUMMARY INPUT FILE
 SUMMARY  FILEB  SUIB,SUIBL,FET=10D
          SPACE  4
**        OPERATOR AND DAYFILE MESSAGES.
 
 
 MSFP     DATA   C* ?????? FILE! PROCESSED.*
 BLNK     DATA   30H
          SPACE  4
**        ERROR MESSAGES.
 
 
 ERAN     DATA   C* SF EXCEDES NUMBER OF ARCHIVE FILES.*
 ERDS     DATA   C* DEVICE STATUS BLOCK MISSING.*
 ERFE     DATA   C* FORMAT ERROR IN SUMMARY FILE.*
          TITLE  MAIN ROUTINES.
 PFS      SPACE  4,10
**        MAIN PROGRAM.
*
*         CALLS  CFP, CSC, ICI, OAL, OCH, OCI, PRS, RDB, SPA.
*
*         EXIT   TO *ABT* IF FATAL ERROR.
 
 
 PFS      BSS    0           ENTRY
          RJ     PRS         PRESET PROGRAM
 
*         LOCATE ARCHIVE LABEL BLOCK IF SKIP COUNT SPECIFIED.
 
          SA5    CPAR+/COMSPFS/CPSF
          ZR     X5,PFS3     IF NO ARCHIVE FILES TO SKIP
 PFS1     SA1    BLTY        GET BLOCK TYPE
          SX1    X1-/COMSPFS/AFSB
          NZ     X1,PFS2     IF NOT ARCHIVE LABEL BLOCK
          ZR     X5,PFS5     IF BLOCK FOUND
          SX5    X5-1        COUNT BLOCK
 PFS2     RJ     RDB         READ DATA BLOCK
          PL     X6,PFS1     IF NOT EOR
          SB2    ERAN        * SF EXCEDES NUMBER OF ARCHIVE FILES.*
          EQ     ABT         ABORT
 
*         READ SUMMARY FILE BLOCK AND CHECK FOR SORTED OUTPUT.
 
 PFS3     RJ     RDB
          ZR     X2,PFS4     IF BLOCK TYPE IS SAME AS PREVIOUS
          RJ     CSO         CHECK FOR SORTED OUTPUT
 
*         EXECUTE BLOCK TYPE PROCESSOR.
 
 PFS4     NG     X6,END      IF EOR, EOF, OR EOI ENCOUNTERED
          SA1    TSIP+X6     GET PROCESSOR ADDRESS
          SB2    X1
          JP     B2          ENTER BLOCK TYPE PROCESSOR
 
*         PROCESS ARCHIVE LABEL BLOCK.
 
 PFS5     SA1    CPAR+/COMSPFS/CPNB
          SA2    PFSA
          IX1    X2-X1
          ZR     X1,END      IF ARCHIVE FILE COUNT REACHED
          SX6    X2+B1
          SA6    PFSA        COUNT ARCHIVE FILE PROCESSED
          MOVE   3,DBUF,AFIB SET ARCHIVE FILE LABEL INFORMATION
          RJ     OAL         OUTPUT ARCHIVE FILE LABEL INFORMATION
          EQ     PFS3        READ NEXT BLOCK
 
*         PROCESS CATALOG IMAGE RECORD BLOCK.
 
 PFS6     ZR     X2,PFS7     IF LAST BLOCK WAS CIR BLOCK
          RJ     ICI         INITIALIZE FOR CIR PROCESSING
 PFS7     SA1    BLCW
          SX6    DBUF        SET CIR BUFFER POINTER
          SX7    X1          SET WORD COUNT
          RJ     OCI         OUTPUT CATALOG IMAGE BLOCK
          EQ     PFS3        READ NEXT BLOCK
 
*         PROCESS CATALOG ENTRIES BLOCK.
 
 PFS8     SA0    DBUF-NWCE-1 INITIALIZE ENTRY ADDRESS
          ZR     X2,PFS9     IF LAST BLOCK WAS CATALOG ENTRIES
          RJ     IFL         INITIALIZE FOR FILE PROCESSING
 PFS9     SA2    BLCW
          SA0    A0+NWCE+1   ADVANCE ENTRY ADDRESS
          SB2    X2+DBUF
          SB2    A0-B2
          PL     B2,PFS3     IF BLOCK ALL PROCESSED
          SB4    A0          SET CATALOG ADDRESS
          RJ     CSC         CHECK SELECTION CRITERIA
          ZR     X6,PFS9     IF NOT TO PROCESS FILE
          SA1    B4+NWCE
          BX7    X1
          SA7    FLST        SET FILE STATUS
          RJ     CFP         COUNT FILE PROCESSED
          EQ     PFS9        PROCESS NEXT ENTRY
 
 
 PFSA     CON    0           ARCHIVE FILES PROCESSED COUNT
 TSIP     SPACE  4,10
*         TABLE OF SUMMARY INPUT FILE BLOCK PROCESSORS.
 
 TSIP     IVFD               START OF TABLE
          IVFD   /COMSPFS/SYSB,(60/SER)    SYSTEM
          IVFD   /COMSPFS/DSSB,(60/PFS3)   DEVICE STATUS
          IVFD   /COMSPFS/AFSB,(60/PFS5)   ARCHIVE FILE
          IVFD   /COMSPFS/CISB,(60/PFS6)   CIR
          IVFD   /COMSPFS/CESB,(60/PFS8)   CATALOG ENTRIES
          IVFD   /COMSPFS/MXSB,(60/PFS3)   UNIDENTIFIED
          IVFD   /COMSPFS/MXSB+1
 CSO      SPACE  4,15
**        CSO - CHECK FOR SORTED OUTPUT.
*
*         ENTRY  (X3) = PREVIOUS BLOCK TYPE.
*                (X6) = CURRENT BLOCK TYPE.
*
*         EXIT   (X6) = CURRENT BLOCK TYPE.
*                (X2) .NE. 0 (NON-MATCHING BLOCK TYPE).
*
*         USES   X - 1, 2, 6.
*                A - 1.
*
*         CALLS  PSF, PSI.
 
 
 CSO      SUBR               ENTRY/EXIT
          SX1    X3-/COMSPFS/CISB
          NZ     X1,CSO1     IF PREVIOUS BLOCK NOT CIR ENTRIES
          RJ     PSI         PROCESS SORTED CIR ENTRIES
          EQ     CSO2        RESET BLOCK STATUS
 
 CSO1     SX1    X3-/COMSPFS/CESB
          NZ     X1,CSOX     IF PREVIOUS BLOCK NOT CATALOG ENTRIES
          RJ     PSF         PROCESS SORTED CATALOG ENTRIES
 CSO2     SA1    BLTY
          SX2    B1          INDICATE NON-MATCHING BLOCK TYPE
          SX6    X1          RESET BLOCK TYPE
          EQ     CSOX        RETURN
          TITLE  SUBROUTINES.
 APR      SPACE  4,10
**        APR - ABORT PROCESSOR.
 
 
 APR      SUBR               ENTRY/EXIT
          EQ     APRX        RETURN
 IFM      SPACE  4,10
**        IFM - ISSUE FILE COUNT MESSAGES.
*
*         EXIT   FILE COUNT MESSAGES ISSUED TO DAYFILE.
*
*         USES   X - 1, 5, 6.
*                A - 1, 5.
*
*         CALLS  IFC.
 
 
 IFM      SUBR               ENTRY/EXIT
          SA5    IFMA
          RJ     IFC         ISSUE FILE COUNT MESSAGES
          EQ     IFMX        RETURN
 
 
 IFMA     BSS    0           *PFLIST* MESSAGE TABLE
          VFD    1/1,1/1,22/0,18/MSFP,18/PRFC
          CON    0           END OF TABLE
 RDB      SPACE  4,20
**        RDB - READ DATA BLOCK FROM SUMMARY FILE.
*
*         EXIT   (X6) = BLOCK TYPE IF BLOCK READ.
*                (X6) = -1 IF EOR, EOF, OR EOI ENCOUNTERED ON READ OF
*                       BLOCK CONTROL WORD.
*                (X2) = 0 IF BLOCK TYPE SAME A PREVIOUS BLOCK TYPE.
*                (X2) .NE. 0 IF BLOCK TYPE NOT SAME AS PREVIOUS.
*                (X3) = PREVIOUS BLOCK TYPE.
*                (BLCW) = BLOCK CONTROL WORD IF BLOCK READ.
*                (BLTY) = BLOCK TYPE IF BLOCK READ.
*                (BLTY) = -1 IF EOR, EOF, OR EOI ENCOUNTERED ON READ OF
*                         BLOCK CONTROL WORD.
*                DATA BLOCK READ TO *DBUF* IF NO ERROR.
*                TO *SER* IF ERROR IN SUMMARY FILE BLOCK.
*
*         USES   X - 1, 2, 3, 6.
*                A - 1, 2, 3, 6.
*
*         MACROS READW.
 
 
 RDB      SUBR               ENTRY/EXIT
 
*         READ BLOCK CONTROL WORD AND DATA.
 
          READW  SI,BLCW,1   READ BLOCK CONTROL WORD
          SA3    BLCW
          SX6    -1          SET EOR, EOF, EOI STATUS
          NZ     X1,RDB2     IF EOR, EOF, OR EOI ENCOUNTERED
          SX1    X3-DBUFL-1
          SX6    X3
          BX1    -X1+X6
          NG     X1,SER      IF BAD BLOCK LENGTH
          READW  X2,DBUF,X3  READ DATA BLOCK
          NZ     X1,SER      IF INCOMPLETE READ
 
*         IDENTIFY BLOCK TYPE.
 
          SA1    BLCW
          SA2    TSBI-1
          MX6    42
          BX1    X6*X1       BLOCK IDENTIFIER
 RDB1     SA2    A2+B1       GET NEXT ENTRY
          SX6    A2-TSBI     SET BLOCK TYPE
          BX3    X2-X1
          ZR     X2,RDB2     IF END OF ENTRIES
          NZ     X3,RDB1     IF NO MATCH
 RDB2     SA3    BLTY
          SA6    A3          SET NEW BLOCK TYPE
          IX2    X6-X3       SET NEW BLOCK TYPE STATUS
          EQ     RDBX        RETURN
 RIP      SPACE  4,10
**        RIP - REPRIEVE INTERRUPT PROCESSOR.
*
*         EXIT   BUSY FETS SET COMPLETE TO ALLOW TERMINATION
*                  PROCESSING.
*
*         MACROS COMPFET.
 
 
 RIP      SUBR               ENTRY/EXIT
          COMPFET  (O,SU)
          EQ     RIPX        RETURN
 SER      SPACE  4,10
**        SER - PROCESS SUMMARY FILE ERROR.
*
*         EXIT   TO *ABT*.
*
*         USES   B - 2.
 
 
 SER      BSS    0           ENTRY
          SB2    ERFE        * FORMAT ERROR IN SUMMARY FILE.*
          EQ     ABT         ABORT
          SPACE  4
**        COMMON DECKS.
 
 
*CALL     COMCCDD
*CALL     COMCCIO
*CALL     COMCCOD
*CALL     COMCCPM
*CALL     COMCDXB
*CALL     COMCEDT
 FCE$     EQU    0
*CALL     COMCFCE
 CHDR1    EQU    /COMCFCE/CHDR1
 GMS$     EQU    1           USE SORT KEY MASK
 MWK$     EQU    1           ALLOW MULTIPLE WORD SORT KEYS
*CALL     COMCGMS
*CALL     COMCJCR
*CALL     COMCLFM
*CALL     COMCMSF
*CALL     COMCMVE
          LIST   X
*CALL     COMCPFS
          LIST   *
*CALL     COMCPFU
*CALL     COMCRDW
*CALL     COMCSCB
*CALL     COMCSFN
*CALL     COMCSNM
*CALL     COMCSYS
*CALL     COMCVDT
*CALL     COMCWTC
*CALL     COMCWTH
*CALL     COMCWTO
*CALL     COMCWTW
*CALL     COMCZTB
          TITLE  BUFFERS.
          USE    LITERALS
          SPACE  4
**        BUFFERS.
 
 
*         BUFFERS USED BY PRESET.
 
 DBUF     BSSZ   DBUFL       SUMMARY FILE DATA BLOCK BUFFER
 SUIB     BSSZ   SUIBL       SUMMARY INPUT FILE BUFFER
 OUTB     BSSZ   OUTBL       OUTPUT FILE
 
*         BUFFERS OVERLAYING PRESET.
 
 SUMB     EQU    OUTB+OUTBL  SUMMARY FILE (NOT USED)
 PFLB     EQU    SUMB+SUMBL  PROCESSED FILES FILE
 MS1B     EQU    PFLB+PFLBL  SORT FILE 1
 MS2B     EQU    MS1B+MSFBL  SORT FILE 2
 MS3B     EQU    MS2B+MSFBL  SORT FILE 3
 MS4B     EQU    MS3B+MSFBL  SORT FILE 4
 SRTB     EQU    MS3B        SORT BUFFER (OVERLAYS *MS3B* AND *MS4B*)
          ERRNG  MSFBL*2-SRTBL  SORT BUFFER OVERFLOW
 EBUF     EQU    MS4B+MSFBL+5  END OF BUFFERS
          TITLE  PFLIST PRESET.
 PRS      SPACE  4,15
**        PRS - PRESET PROGRAM.
*
*         EXIT   FILES INITIALIZED.
*                MESSAGES INITIALIZED.
*                SUMMARY FILE SYSTEM BLOCK PROCESSED.
*                SUMMARY FILE DEVICE STATUS BLOCK PROCESSED IF PRESENT.
*
*         USES   A - 1, 2, 6, 7.
*                X - 0, 1, 2, 3, 5, 6, 7.
*                B - 2, 3, 5, 7.
*
*         CALLS  IOF, ODV, RPS, RDB, SCB, SNM, ZTB.
*
*         MACROS MEMORY, MOVE, REPRIEVE, READ, READW.
 
 
 PRS      SUBR               ENTRY/EXIT
          SB1    1
          MEMORY CM,,R,EBUF  REQUEST REQUIRED MEMORY
          REPRIEVE  RPVB,SET,277B  SET EXTENDED REPRIEVE PROCESSING
 
*         READ USER AND FILE NAME SELECTIONS.
 
          SX0    EBUF        SET SELECTION BUFFER ADDRESS
          RJ     RPS         READ PERMANENT FILE SELECTIONS
 
*         INITIALIZE SUMMARY INPUT FILE FET AND READ PREFIX TABLE.
 
          SA1    SI          SET FILE NAME IN FET
          SA2    CPAR+/COMSPFS/CPSI
          MX6    -18
          BX6    -X6*X1
          BX6    X2+X6
          SA6    A1
          READ   SI
          READW  SI,DBUF,15  READ PREFIX TABLE
          NZ     X1,SER      IF INCOMPLETE READ
          SA1    DBUF
          SA2    PRSA
          BX1    X1-X2
          NZ     X1,SER      IF NOT PREFIX TABLE
 
*         PROCESS SYSTEM BLOCK.
 
          RJ     RDB         READ SYSTEM BLOCK
          SA1    BLCW
          SX6    X6-/COMSPFS/SYSB
          NZ     X6,SER      IF NOT SYSTEM BLOCK
          SX1    X1-13B
          NZ     X1,SER      IF NOT CORRECT WORD COUNT FOR SYSTEM BLOCK
          MOVE   2,PRSB,PGSC SET SUMMARY FILE CREATION TEXT IN PAGE TITL
          SA1    DBUF+1
          RJ     ZTB         ENSURE BLANK FILL
          SA6    PGSC+2      SET SUMMARY FILE CREATION DATE
          SA1    DBUF+2
          RJ     ZTB         ENSURE BLANK FILL
          SA6    PGSC+3
          SA1    DBUF        GET UTILITY NAME
          MX6    42
          BX1    X6*X1
          SA2    TUTA
 PRS1     SA2    A2+B1
          ZR     X2,SER      IF END OF UTILITY NAMES
          BX3    X6*X2       UTILITY NAME
          BX3    X1-X3
          NZ     X3,PRS1     IF NO MATCH ON UTILITY NAME
          LX2    59-0
          SX6    A2-TUTA
          SA6    OFUC        SET UTILITY CODE
          PL     X2,PRS3     IF UTILITY DOES NOT SUPPORT DEVICE BLOCK
 
*         PROCESS DEVICE STATUS BLOCK.
 
          RJ     RDB         READ BLOCK
          SB2    ERDS        * DEVICE STATUS BLOCK MISSING.*
          SX6    X6-/COMSPFS/DSSB
          NZ     X6,ABT      IF NOT DEVICE STATUS BLOCK
          SA1    DBUF+2
          SA2    DBUF
          MX6    -6
          MX7    42
          BX1    -X6*X1      EXTRACT DEVICE NUMBER OF FIRST DEVICE
          BX7    X7*X2
          SX3    OFFN        SELECT FAMILY NAME
          NZ     X1,PRS2     IF FAMILY DEVICE
          SX3    OFPN        SELECT PACK NAME
 PRS2     SA7    X3          SET FAMILY OR PACK NAME
          SA1    DBUF+1
          BX6    X1
          SA6    OFUN        SET USER NAME IF AUXILIARY DEVICE
          RJ     IOF         INITIALIZE OUTPUT FILES
          SA1    BLCW
          SX6    0           SET END OF DEVICE ENTRIES
          SA6    DBUF+X1
          SX6    DBUF+2      SET DEVICE STATUS ADDRESS
          RJ     ODV         OUTPUT DEVICE STATUS
          EQ     PRS4        CHECK ARCHIVE FILE COUNT
 
*         INITIALIZE OUTPUT FILES.
 
 PRS3     RJ     IOF         INITIALIZE OUTPUT FILES
 PRS4     SA1    CPAR+/COMSPFS/CPNB
          NZ     X1,PRSX     IF ARCHIVE FILE COUNT SPECIFIED
          SX6    B1
          SA6    A1          SET ARCHIVE FILE COUNT = 1
          EQ     PRSX        RETURN
 
 
 PRSA     VFD    12/7700B,12/16B,36/0
 PRSB     DATA   20HSUMMARY FILE CREATED
 TUTA     SPACE  4,10
**        TUTA - TABLE OF UTILITY ATTRIBUTES.
 
 
 TUTA     IVFD               TABLE OF UTILITY NAMES
          IVFD   /COMSPFS/LDUT,(42/0LPFLOAD,18/1)
          IVFD   /COMSPFS/DUUT,(42/0LPFDUMP,18/1)
          IVFD   /COMSPFS/CAUT,(42/0LPFCAT,18/1)
          IVFD   /COMSPFS/ATUT,(42/0LPFATC,18/0)
          IVFD   /COMSPFS/COUT,(42/0LPFCOPY,18/0)
          IVFD   /COMSPFS/RLUT,(42/0LPFREL,18/1)
          IVFD   /COMSPFS/LIUT,(42/0LPFLIST,18/0)
          IVFD   /COMSPFS/RSUT,(42/0LPFRES,18/0)
          IVFD   /COMSPFS/MXUT,(60/0)
          IVFD   /COMSPFS/MXUT+1
 
          SPACE  4
**        PRESET COMMON DECKS.
 
 
          LIST   X
*CALL     COMCPFP
          LIST   *
 
 
          ERRPL  *-EBUF-1    PRESET OVERFLOWS INTO BUFFERS
          SPACE  4
          END