CATALOG 
          IDENT  CATALOG,FETS 
          ABS 
          ENTRY  CATALOG
          ENTRY  RFL= 
          ENTRY  SSM= 
          SST 
          SYSCOM B1          DEFINE (B1) = 1
          TITLE  CATALOG - CATALOG FILE.
*COMMENT  CATALOG - CATALOG FILE. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4
***       CATALOG - CATALOG FILES.
*         G. R. MANSFIELD.  70/12/20. 
          SPACE  4
***              CATALOG LISTS PERTINENT INFORMATION ABOUT EACH RECORD
*         OF A BINARY MEDIUM. 
* 
*         THIS INFORMATION INCLUDES - 
* 
*         1)  THE RECORD NUMBER COUNTING FROM THE BEGINNING OF THE FILE.
*         2)  THE NAME FROM THE FIRST WORD OF THE RECORD OR THE SECOND
*                WORD OF THE  *77*  TABLE IF IT IS PRESENT. 
*         3)  THE RECORD TYPE.
*         4)  LENGTH OF THE PARTICULAR RECORD ( EXCLUDING THE  *77* 
*                TABLE ). 
*         5)  CHECKSUM OF THE RECORD, EXCLUDING *77* TABLE, IF PRESENT. 
*         6)  CONTENTS OF THE  *77*  TABLE, IF ANY. 
*         7)  OTHER PERTINENT INFORMATION, ACCORDING TO RECORD TYPE.
* 
* 
*         THE FOLLOWING RECORD TYPES ARE RECOGNIZED.
* 
*         TYPE   DESCRIPTION
* 
*         TEXT   UNIDENTIFIED AS ANY OTHER TYPE.
*         PP     6000, CYBER 72/73/74, CYBER 170 PP PROGRAM.
*         REL    RELOCATABLE CENTRAL PROGRAM. 
*         OVL    ABSOLUTE OVERLAY PROGRAM, NO ENTRY POINTS DEFINED. 
*         ULIB   USER LIBRARY TYPE RECORD.
*         OPL    MODIFY PROGRAM LIBRARY DECK RECORD.
*         OPLC   MODIFY PROGRAM LIBRARY COMMON DECK RECORD. 
*         OPLD   MODIFY PROGRAM LIBRARY DIRECTORY.
*         ABS    ABSOULTE OVERLAY PROGRAM, WITH ENTRY POINTS DEFINED. 
*         PPU    7600, CYBER 76 TYPE PPU PROGRAM. 
*         CAP    FAST DYNAMIC LOAD CAPSULE. 
*         PROC   PROCEDURE TYPE RECORD. 
*         PPL    16-BIT PP PROGRAM. 
* 
* 
*         A RECORD OF *REL* FORMAT WILL HAVE THE ENTRY POINTS LISTED. 
* 
*         A RECORD OF *TEXT* FORMAT WILL BE LISTED IN ITS ENTIRETY IF 
*                THE *T* OPTION IS ENABLED AND IT IS A DEADSTART RECORD 
*                (APRDECK, CMRDECK, EQPDECK, IPRDECK, OR LIBDECK).
* 
*         A RECORD OF *TEXT* FORMAT WILL HAVE ITS FIRST LINE LISTED IF
*                ITS NAME IS *OVERLAY*, REGARDLESS OF THE *T* OPTION. 
* 
*         A RECORD OF *OPL* OR *OPLC* FORMAT WILL HAVE THE MODIFIERS
*                AND THEIR  *YANK*  STATUS LISTED.  IF SELECTED THE 
*                CHARACTER SET OF THE INDIVIDUAL OPL/OPLC WILL BE 
*                LISTED IMMEDIATELY FOLLOWING THE RECORD TYPE.
* 
*         A RECORD OF *ULIB* FORMAT WILL SUPPRESS LISTING OF FOLLOWING
*                RECORDS IN *REL* FORMAT UNLESS -U- OPTION IS USED. 
          SPACE  4
***       CONTROL CARD CALL.
* 
* 
*         CATALOG (FNAME,P1,P2,...,PN)
* 
*         FNAME  NAME OF FILE TO BE CATALOGED.
* 
*         *PN*  ONE OF THE FOLLOWING -
* 
*         N      CATALOG TO EOI.
*         N=0    CATALOG TO EMPTY FILE. 
*         N=X    CATALOG  *X*  FILES. 
* 
*         L=LFN  LIST OUTPUT ON FILE  *LFN*.
* 
*         T      SELECT DETAILED *TEXT* RECORD LIST.
* 
*         U      SELECT DETAILED USER LIBRARY LIST. 
* 
*         D      DESELECT DETAILED LIST.  THE DETAILED LIST IS
*                AUTOMATICALLY DESELECTED IF THE OUTPUT FILE IS 
*                ASSIGNED TO A TERMINAL.
* 
*         R      REWIND  *FNAME*  FILE BEFORE AND AFTER CATALOG.
* 
*         CS     DE-SELECT CHARACTER SET LIST FOR OPL/OPLC RECORDS. 
* 
* 
*         ASSUMED OPTIONS - 
* 
*         OPT    VALUE
* 
*         FNAME  FILE.
*         N      1. 
*         L      OUTPUT.
*         T      *NOT SELECTED*.
*         U      *NOT SELECTED*.
*         D      *NOT SELECTED*.
*         R      *NOT SELECTED*.
*         CS     *SELECTED*.
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
* 
*         * CATALOG ARGUMENT ERROR.* - THE CONTROL STATEMENT IS 
*         SYNTACTICALLY INCORRECT.
* 
*         * CATALOG COMPLETE.* - INFORMATIVE MESSAGE INDICATING THAT
*         CATALOGING IS COMPLETE. 
* 
*         * CATALOG FILE NAME CONFLICT.* - THE NAME OF THE FILE TO BE 
*         CATALOGED AND THE NAME OF THE FILE TO RECEIVE OUTPUT ARE
*         THE SAME. 
          SPACE  4
****      ASSEMBLY CONSTANTS. 
  
  
FETODL    EQU    16 
 FBUFL    EQU    30061B      FILE BUFFER LENGTH 
 OBUFL    EQU    2001B       OUTPUT BUFFER LENGTH 
****
          SPACE  4,10 
**        SPECIAL ENTRY POINT.
  
  
 SSM=     EQU    0           SUPPRESS DUMPS OF FIELD LENGTH 
 READW    SPACE  4
**        READW - REDEFINE READ WORDS MACRO TO USE CONTROL WORDS. 
  
  
          PURGMAC READW 
  
 READW    MACRO F,S,N 
          R=     B6,S 
          R=     B7,N 
          R=     X2,F 
          RJ     RDA
          ENDM
          SPACE  4
*CALL     COMCCMD 
*CALL     COMCMAC 
*CALL     COMSSRT 
          TITLE  STORAGE ASSIGNMENT.
**        FETS. 
  
  
          ORG    110B 
 FETS     BSS    0
  
 O        BSS    0
 OUTPUT   FILEC  OBUF,OBUFL,FET=7,EPR 
  
          CON    0           WORDS REMAINING IN BLOCK (F) 
          CON    0           EOR FLAG 
 F        BSS    0
FILE      FILEB  FBUF,FBUFL,(FET=10)
FETOD     BSSZ   FETODL 
          SPACE  4
*         COMMON DATA.
  
  
 RW       CON    0           REWIND FLAG
 CW       CON    0           CONTROL WORD FLAG (1 = CONTROL WORDS)
 FC       CON    0L1         FILE COUNT 
 EF       CON    0           EMPTY FILE FLAG
 NSFF     CON    0           NONSTANDARD FILE FLAG
 RN       CON    0           RECORD NUMBER
 FN       CON    1           FILE NUMBER
 CS       CON    0           CHECKSUM 
 RL       CON    0           RECORD LENGTH
          CON    0           ZERO RECORD SUBTOTAL 
          CON    0           FILE LENGTH
 NM       CON    0           RECORD NAME
 TY       CON    0           RECORD TYPE
 UL       CON    0           USER LIBRARY LIST FLAG 
 LN       CON    1           LIBRARY NUMBER 
  
*         LIST DATA.
  
 SL       CON    0           SHORT LIST FLAG
 LC       CON    99999,0     LINE COUNT 
 LL       EQU    LC+1        LINE LIMIT 
 PD       CON    0           PRINT DENSITY FORMAT CONTROL 
 PN       CON    1           PAGE NUMBER
 CSM      CON    1           OPL CHARACTER SET LIST FLAG
 TF       CON    0           TERMINAL FLAG
  
 PGEJ     DATA   1L1         PAGE EJECT 
  
 TITL     DATA   1H1
          DATA   10HCATALOG OF
          DATA   1H 
          DATA   4AFILE 
          DATA   6A1
          DATA   10H
 TITLA    DATA   10H
 DATE     DATA   1H 
 TIME     DATA   1H 
          DATA   4APAGE 
 PAGE     DATA   8L 
 TITLL    EQU    *-TITL 
  
  
 SBTL     DATA   6AREC
          DATA   4HNAME 
          DATA   5HTYPE 
          DATA   6ALENGTH 
          DATA   7ACKSUM
          DATA   7ADATE 
 SBTLA    DATA   8ACOMMENTS 
          DATA   0
          DATA   2L 
 SBTLL    EQU    *-SBTL 
  
 FLS      CON    3           AUTO-FLUSH TABLE 
          CON    0
          CON    0
          TITLE  MAIN PROGRAM.
 CATALOG  SPACE  4
**        CATALOG - MAIN PROGRAM. 
  
  
 CATALOG  SB1    1           (B1) = 1 
          RJ     PRS         PRESET PROGRAM 
          WRITE  O,*         PRESET *CIO* FUNCTION
          SA3    TF 
          WRITEW O,PD,X3     CONDITIONALLY WRITE FORMAT EFFECTOR
          SA1    RW 
          ZR     X1,CAT0.1   IF NO REWIND 
          REWIND F
  
 CAT0.1   SA1    CW 
          ZR     X1,CAT1.1   IF NOT CONTROL WORDS 
          MX6    1           SET FIRST READ FLAG
          SA6    F-2
          READCW F,17B
          JP     CAT1.2 
  
 CAT1     SA1    CW 
          NZ     X1,CAT1.2   IF CONTROL WORDS 
 CAT1.1   READ   F
 CAT1.2   BSS    0
          SA1    RN          ADVANCE RECORD NUMBER
          SX6    X1+B1
          MX7    0           CLEAR LENGTH 
          SA6    A1 
          SA7    RL 
          SA7    CS          CLEAR CHECKSUM 
          RJ     RDR         READ RECORD
          SA4    RL          ADVANCE SUBTOTAL 
          NZ     X4,CAT1.3   IF NONZERO RECORD
          NG     X1,CAT3     IF EOF 
 CAT1.3   SA2    A4+B1
          SA3    A2+B1       ADVANCE FILE TOTAL 
          IX6    X2+X4
          SA6    A2 
          IX7    X3+X4
          SA7    A3+
          BX6    X6-X6
          SA2    TY          CHECK TYPE 
          SB2    X2-ODRT
          SA1    ULBA 
          NZ     B2,CAT1.4   IF NOT *OPLD*
          SA6    ULBB        CLEAR *SEARCHING FOR OPLD* FLAG
          ZR     X1,CAT2     IF LISTING USER LIBRARY
          SA6    A1+         CLEAR USER LIBRARY FLAG
          EQ     CAT1        READ NEXT RECORD 
  
 CAT1.4   NZ     X1,CAT1     IF NO LIST OF USER LIBRARY SET 
  
 CAT2     RJ     LRS         LIST RECORD STATUS 
          SA1    TY          PROCESS OTHER LIST 
          MX7    0           CLEAR EOF FLAG 
          SB7    X1 
          SA7    EF 
          JP     CATB+B7
  
 CAT3     SX1    X1+B1
          BX5    -X1         PROCESS END OF FILE
          RJ     EOF
          NZ     X5,CAT5     IF EOI 
          SA1    FC          CHECK FILE COUNT 
          NZ     X1,CAT4     IF NOT EMPTY FILE REQUEST
          SA2    EF          CHECK EOF
          NZ     X2,CAT5     IF EMPTY FILE
          SX6    X2+B1       SET EOF FLAG 
          SA6    A2 
          JP     CAT0.1 
  
 CAT4     SX2    1           DECREMENT FILE COUNT 
          IX6    X1-X2
          SA6    A1 
          NZ     X6,CAT0.1   IF MORE FILES REQUESTED
  
 CAT5     SA1    PN          CHECK PAGE NUMBER
          LX1    59 
          NG     X1,CAT6     IF PAGE NUMBER EVEN
          WRITEC O,PGEJ      PAGE EJECT 
 CAT6     WRITER O
          SA1    RW 
          ZR     X1,CAT7     IF NO REWIND 
          REWIND F
 CAT7     MESSAGE (=C* CATALOG COMPLETE.*)
          ENDRUN
  
 CATA     DATA   10HCATALOGING
          DATA   0
  
 CATB     BSS    0
          LOC    0
          EQ     TXT         TEXT 
          EQ     CAT1        PP 
          EQ     TXT         UNDEFINED RECORD TYPE
          EQ     REL         REL
          EQ     CAT1        OVL
          EQ     ULB         ULIB 
          EQ     OPL         OPL
          EQ     OPL         OPLC 
          EQ     CAT1        OPLD 
          EQ     ABS         ABS
          EQ     CAT1        PPU
          EQ     TXT         UNDEFINED RECORD TYPE
          EQ     TXT         UNDEFINED RECORD TYPE
          EQ     TXT         UNDEFINED RECORD TYPE
          EQ     CAP         CAP
          EQ     TXT         UNDEFINED RECORD TYPE
          EQ     TXT         PROC 
          EQ     TXT         UNDEFINED RECORD TYPE
          EQ     TXT         UNDEFINED RECORD TYPE
          EQ     TXT         UNDEFINED RECORD TYPE
          EQ     CAT1        PPL
          LOC    *O 
 EOF      SPACE  4
**        EOF - PROCESS END OF FILE.
  
  
 EOF      PS                 ENTRY/EXIT 
          SA2    ULBB 
          ZR     X2,EOF0     IF *OPLD* FOUND
          BX6    X6-X6
          SA6    A2          CLEAR *SEARCHING FOR OPLD* FLAG
          SX1    EOFC        LIST *OPLD MISSING* MESSAGE
          SA6    ULBA        CLEAR USER LIBRARY FLAG
          RJ     WOF
 EOF0     SA2    NSFF        CHECK FOR NONSTANDARD FILE 
          ZR     X2,EOF0.1   IF NOT NONSTANDARD FILE
          BX6    X6-X6
          SX1    EOFB        LIST *EOR MISSING* MESSAGE 
          SA6    A2 
          RJ     WOF
 EOF0.1   SX1    =C*  *      LIST BLANK LINE
          RJ     WOF
          ZR     X5,EOF1     IF EOF 
          SA1    =10H 
          BX6    X1 
          EQ     EOF2 
  
 EOF1     SA1    RN          CONVERT RECORD NUMBER
          RJ     CDD
 EOF2     LX6    18 
          SA6    SBUF 
          SA1    X5+EOFA
          SA2    =6ASUM = 
          BX6    X1 
          LX7    X2 
          SA6    A6+B1
          SA7    A6+B1
          SA1    RL+2        CONVERT TOTAL LENGTH 
          RJ     COD
          MX7    0
          SA6    A7+B1
          SA7    A6+B1
          SX1    SBUF 
          RJ     WOF
          SA1    FN          ADVANCE FILE NUMBER
          SX6    99999       FORCE PAGE EJECT 
          SX7    X1+B1
          SA6    LC 
          SA7    A1 
          SX1    X1+B1       CONVERT NUMBER 
          RJ     CDD
          LX6    5*6
          SX7    B0          CLEAR LENGTHS
          SA6    TITL+4 
          SA7    RL+1 
          SA7    A7+B1
          SX6    B1          RESET LIBRARY NUMBER 
          SA7    RN          CLEAR RECORD NUMBER
          SA6    LN 
          EQ     EOF         RETURN 
  
  
 EOFA     DATA   10H* EOF * 
          DATA   10H* EOI * 
  
 EOFB     DATA   C+          *EOR MISSING*+ 
 EOFC     DATA   C+          *OPLD MISSING*+
 LRS      SPACE  4,20 
**        LRS - LIST RECORD STATUS. 
* 
*         ENTRY  (BUF) = FIRST BLOCK OF RECORD. 
*                (NM) = RECORD NAME.
*                (TY) = RECORD TYPE.
*                (RN) = RECORD NUMBER.
*                (RL) = RECORD LENGTH.
*                (CS) = CHECK SUM.
*                (LN) = LIBRARY NUMBER. 
* 
*         EXIT   (LN) = (LN)+1 IF ZERO LENGTH RECORD ENCOUNTERED. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 3, 6, 7. 
* 
*         CALLS  CDD, COD, CPT, WOF, ZTB. 
  
  
 LRS      PS                 ENTRY/EXIT 
          SA1    RN          CONVERT RECORD NUMBER
          RJ     CDD
          LX6    18 
          SA6    SBUF 
          SA1    RL          CHECK RECORD LENGTH
          NZ     X1,LRS1     IF NOT ZERO RECORD 
  
*         PROCESS ZERO LENGTH RECORD. 
  
          SA1    =4H(00)     ENTER ZERO RECORD
          SA2    =6ASUM = 
          BX6    X1 
          LX7    X2 
          SA6    A6+B1
          SA7    A6+B1
          SA1    RL+1        ENTER SUBTOTAL 
          RJ     COD
          SA6    A7+B1
          MX7    0           CLEAR SUBTOTAL 
          SA7    A1 
          SA2    =9ALIBRARY = 
          SA1    LN          INCREMENT LIBRARY NUMBER 
          BX6    X2 
          SX7    X1+B1
          SA6    A6+B1
          SA7    A1 
          RJ     CDD         DISPLAY LIBRARY NUMBER 
          LX6    6
          SA6    A6+B1
          BX7    X7-X7       TERMINATE LINE 
          SA7    A6+B1
          SX1    SBUF 
          RJ     WOF
          SX1    =C*  * 
          RJ     WOF
          EQ     LRS         RETURN 
  
 LRS1     SA1    NM          SPACE FILL NAME
          RJ     ZTB
          SA6    A6+B1
          SA1    TY          SET TYPE 
          SB7    X1 
          SA2    LRSA+X1
          BX6    X2 
          SA6    A6+B1
          SA1    RL          CONVERT LENGTH 
          RJ     COD
          SA6    A6+B1
  
*         PROCESS CHECKSUM. 
  
          SA2    CS          FOLD CHECKSUM
          MX3    -12
          BX1    -X3*X2 
          AX2    12 
          BX6    -X3*X2 
          IX1    X1+X6
          AX2    12 
          BX6    -X3*X2 
          IX1    X1+X6
          AX2    12 
          BX6    -X3*X2 
          IX1    X1+X6
          AX2    12 
          BX6    -X3*X2 
          IX1    X1+X6
          IX7    X1+X3
          BX4    -X3*X7 
          SX1    X4+10000B
          RJ     COD
          SX2    1R -1R1
          LX2    24 
          IX6    X6+X2
          LX6    12 
          SA6    A6+B1
  
*         COPY 7700 TABLE.
  
          SA1    BUF
          RJ     CPT
          JP     B7+LRSB     PROCESS TYPE 
  
 LRS4     SA1    SL          CHECK SHORT LIST FLAG
          ZR     X1,LRS5     IF NOT SET 
          SX6    B0+         TERMINATE LIST 
          SA6    SBUF+6 
          EQ     LRS5.1      WRITE OUTPUT LINE
  
 LRS5     SA2    SBUF+13     INSURE END OF LINE 
          MX0    2*6
          BX6    X0*X2
          SA6    A2+
 LRS5.1   SX1    SBUF 
          RJ     WOF
          EQ     LRS         RETURN 
  
  
*         PROCESS  *OPL*  AND  *OPLC*  RECORDS. 
  
 LRS5.2   SA1    CSM         CHARACTER SET LIST MODE FLAG 
          SA2    B7+LRSA     SET RECORD TYPE
          SA4    =5R         PRESET LIST
          ZR     X1,LRS5.4   IF NO CHARACTER SET LIST SET 
          SA3    BUF+16B     CHECK OPL/OPLC CHARACTER SET 
          MX7    -6 
          BX4    -X7*X3      LOWER 6 BITS OF HEADER+16B 
          SB3    X4-63B      CHECK PL CHARACTER SET 
          EQ     B3,B1,LRS5.3  IF 64 CHARACTER SET
          SB3    0           SET 63 CHARACTER SET ORDINAL 
 LRS5.3   AX3    5           EXTRACT ASCII FLAG * 2 
          MX4    -6 
          LX4    1
          BX3    -X4*X3 
          SX3    X3+B3
          SA4    X3+LRSCS    LIST RECORD STATUS (CHARACTER SET) 
 LRS5.4   BX6    X2+X4
          SA6    SBUF+2      SET IN OUTPUT LINE 
*         EQ     LRS6 
  
 LRS6     SA1    LC          CHECK LINE COUNT 
          SX1    X1+2 
          SA2    A1+B1       GET LINE LIMIT 
          IX7    X1-X2
          NG     X7,LRS4     IF ROOM FOR TWO LINES
          SX6    99999       FORCE EJECT
          SA6    A1 
          EQ     LRS4 
  
*         PROCESS PP LOAD ADDRESS.
  
 LRS7     SA2    BUF+B3      FIRST WORD OF PROGRAM
          SX3    10000B 
          AX2    24          SET LOAD ADDRESS 
          SX4    X2 
          SA5    LRSA+B7
          ZR     X4,LRS8     IF LOCATION FREE 
          SX4    X4+5 
 LRS8     IX1    X4+X3       CONVERT LOAD ADDRESS 
          MX0    -24
          RJ     COD
          BX3    -X0*X6      MERGE WITH TYPE
          LX3    12 
          BX6    X5+X3
          SA6    SBUF+2 
          EQ     LRS4        LIST LINE
  
*         PROCESS OVERLAY LEVEL NUMBERS.
  
 LRS9     SA2    BUF+B3      EXTRACT LEVEL NUMBERS FROM 5000 TABLE
          LX2    24 
          MX0    -12
          SX1    X2+10000B   CONVERT LEVEL NUMBERS
          RJ     COD
          SA1    LRSA+B7     MERGE LEVEL AND TYPE 
          BX2    -X0*X6 
          LX2    6
          IX1    X1+X2
          AX6    12 
          BX2    -X0*X6 
          LX2    24 
          IX6    X1+X2
          SA6    SBUF+2 
          EQ     LRS4        LIST LINE
  
*         PROCESS PPU NUMBER. 
  
 LRS11    SA2    BUF+B3      FIRST WORD OF PROGRAM
          LX2    24 
          SB6    X2-100B
          SA5    LRSA+B7
          NG     B6,LRS12    IF PPU @ 77
          SA5    LRSC 
 LRS12    SX1    X2+10000B   CONVERT PPU NUMBER 
          RJ     COD
          LX6    6
          PL     B6,LRS13    IF PPU > 77
          LX6    12 
 LRS13    IX6    X6+X5
          SA6    SBUF+2 
          EQ     LRS4        LIST LINE
  
*         PROCESS USER LIBRARY. 
  
 LRS14    SA1    UL 
          ZR     X1,LRS4     IF NO USER LIBRARY LIST
          SX6    99999       FORCE PAGE EJECT 
          SA6    LC 
          EQ     LRS4        LIST LINE
  
*         PROCESS PPL LOAD ADDRESS. 
  
 LRS15    SA2    BUF+B3      FIRST WORD OF PROGRAM
          SX3    B1+
          LX3    3*5
          MX4    -16
          AX2    16          SET LOAD ADDRESS 
          BX4    -X4*X2 
          SA5    LRSA+B7
          IX1    X4+X3       CONVERT LOAD ADDRESS 
          MX0    -6*5 
          RJ     COD
          SA1    SBUF+3      GET LENGTH 
          BX3    -X0*X6      MERGE WITH TYPE
          BX6    X5+X3
          SX3    1R)&1R      INSERT RIGHT PAREN 
          SA6    A1-B1
          LX3    -6 
          BX6    X1-X3
          SA6    A1 
          EQ     LRS4        LIST LINE
  
 LRSA     BSS    0
          LOC    0
          CON    10HTEXT
          VFD    24/4LPP (,24/0,12/2L)
          CON    10H
          CON    10HREL 
          VFD    24/4LOVL ,12/0,6/1L,,12/0,6/1L 
          CON    10HULIB
          CON    5LOPL
          CON    5LOPLC 
          CON    10HOPLD
          CON    10HABS 
          CON    8HPPU (  )-8A100 
          CON    10H
          CON    10H
          CON    10H
          CON    10HCAP 
          CON    10H
          CON    10HPROC
          CON    10H
          CON    10H
          CON    10H
          CON    5LPPL (
          LOC    *O 
  
 LRSB     BSS    0
          LOC    0
          EQ     LRS4        TEXT 
          EQ     LRS7        PP 
          EQ     LRS4        UNDEFINED RECORD TYPE
          EQ     LRS6        REL
          EQ     LRS9        OVL
          EQ     LRS14       ULIB 
          EQ     LRS5.2      OPL
          EQ     LRS5.2      OPLC 
          EQ     LRS4        OPLD 
          EQ     LRS6        ABS
          EQ     LRS11       PPU
          EQ     LRS4        UNDEFINED RECORD TYPE
          EQ     LRS4        UNDEFINED RECORD TYPE
          EQ     LRS4        UNDEFINED RECORD TYPE
          EQ     LRS6        CAP
          EQ     LRS4        UNDEFINED RECORD TYPE
          EQ     LRS4        PROC 
          EQ     LRS4        UNDEFINED RECORD TYPE
          EQ     LRS4        UNDEFINED RECORD TYPE
          EQ     LRS4        UNDEFINED RECORD TYPE
          EQ     LRS15       PPL
          LOC    *O 
  
 LRSC     CON    10HPPU (    )-6A1
  
 LRSCS    CON    5R(63)      DISPLAY CODE        63 CHARACTER SET 
          CON    5R(64)      DISPLAY CODE        64 CHARACTER SET 
          CON    5R(A63)     6/12 ASCII CODE     63 CHARACTER SET 
          CON    5R(A64)     6/12 ASCII CODE     64 CHARACTER SET 
 LRSD     CON    0
          DATA   C* MORE ENTRY POINTS NOT LISTED* 
 ABS      SPACE  4,10 
**        ABS - PROCESS ABS ENTRY POINTS. 
* 
*         ENTRY  (BUF) = FIRST BLOCK OF RECORD. 
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 1, 2, 5, 6, 7. 
*                B - 2, 7.
* 
*         CALLS  CDD, COD, WOF, ZTB.
  
  
 ABS      SA1    BUF         CHECK FIRST WORD 
          LX1    18 
          MX2    -12
          SX6    X1-770000B 
          NZ     X6,CAT1     RETURN IF NO 7700 TABLE
          LX1    6           SKIP 7700 TABLE
          SB2    X1+B1
          SA1    A1+B2
          LX1    12 
          BX3    -X2*X1 
          SX6    X3-5100B 
          LX1    -12
          SB7    B1+         SET INDEX TO ENTRY POINTS
          ZR     X6,ABS1     IF 5100 TABLE
          SX6    X3-5300B 
          BX1    -X1
          ZR     X6,ABS1     IF 5300 TABLE
          BX1    -X1
          SX6    X3-5400B 
          SB7    8
          NZ     X6,CAT1     IF NOT 5400 TABLE
 ABS1     SX0    X1          SET ENTRY COUNT
          ZR     X0,CAT1     IF NO ENTRIES
          SA5    A1+B7       FIRST ENTRY POINT NAME 
          SA2    =1H         CLEAR SCRATCH BUFFER 
          BX6    X2 
          MX7    0
          SA6    SBUF 
          SA7    SBUF+3 
          SX2    BUF+BUFL    CALCULATE MAXIMUM ENTRY POINT COUNT
          SX3    A5 
          IX3    X2-X3
          IX2    X0-X3
          NG     X2,ABS2     IF NO EXCESS ENTRY POINTS
          BX0    X3          SET MAXIMUM ENTRY POINT COUNT
          BX1    X2          ADD UNLISTED ENTRY POINT COUNT TO MESSAGE
          RJ     CDD
          SA6    LRSD 
 ABS2     MX2    42          SPACE FILL NAME
          BX1    X2*X5
          RJ     ZTB
          LX6    -6 
          BX1    -X2*X5 
          SA6    SBUF+1 
          RJ     COD         CONVERT ENTRY POINT ADDRESS
          LX6    18 
          SA6    SBUF+2 
          SX1    SBUF        LIST ENTRY 
          RJ     WOF
          SA5    A5+B1       NEXT ENTRY 
          SX0    X0-1 
          NZ     X0,ABS2     IF NOT END OF ENTRIES
          SA1    LRSD 
          ZR     X1,CAT1     IF NO EXCESS ENTRY POINTS
          SX1    LRSD        ISSUE EXCESS ENTRY POINT MESSAGE 
          RJ     WOF
          SX6    B0+
          SA6    LRSD 
          EQ     CAT1        RETURN 
 CAP      SPACE  4,10 
**        CAP - PROCESS CAPSULE GROUP NAMES.
* 
*         ENTRY  (BUF) = FIRST BLOCK OF RECORD. 
* 
*         USES   X - 0, 1, 2, 6.
*                A - 1, 6.
*                B - 2. 
* 
*         CALLS  WOF, ZTB.
  
  
 CAP      SA1    BUF         CHECK FIRST WORD 
          LX1    18 
          MX2    -12
          SX6    X1-770000B 
          NZ     X6,CAT1     IF NO 7700 TABLE 
          LX1    6           SKIP 7700 TABLE
          SB2    X1+2 
          MX0    42 
          SA1    A1+B2
          BX1    X0*X1
          RJ     ZTB         SPACE FILL NAME
          LX6    -6 
          SA6    CAPA+1 
          SX1    CAPA        LIST GROUP NAME
          RJ     WOF
          EQ     CAT1        RETURN 
  
 CAPA     DIS    2, 
          DATA   C* (GROUP NAME)* 
 OPL      SPACE  4,10 
**        OPL - PROCESS OPL LIST. 
* 
*         ENTRY  (BUF) = FIRST BLOCK OF RECORD. 
*                (TF) = TERMINAL FLAG.
* 
*         USES   X - ALL. 
*                A - 0, 1, 2, 3, 4, 6.
*                B - 2, 6, 7. 
* 
*         CALLS  WOF, ZTB.
  
  
 OPL      SA1    BUF         CHECK FIRST WORD 
          LX1    18 
          SB7    B0 
          SB2    X1-770000B 
          NZ     B2,CAT1     RETURN IF NO 7700 TABLE
          LX1    6           SKIP 7700 TABLE
          SB2    X1+B1
          SA1    A1+B2
          SX5    X1 
          ZR     X5,CAT1     RETURN IF NO MODIFIERS 
          SB6    BUFL 
          SB5    X5+20B 
          LE     B5,B6,OPL1  IF BUFFER NOT FULL 
          SX5    BUFL-20B    SET NUMBER OF MODIFIERS TO MAXIMUM 
          SX7    B1+         SET BUFFER FULL FLAG 
          SA7    OPLB 
 OPL1     SA3    TF          CHECK FOR TERMINAL 
          NZ     X3,OPL2     IF NOT TERMINAL FILE 
          SB7    -6          CHANGE LINE LENGTH FOR TERMINAL FILE 
 OPL2     SA2    =1H         CLEAR SCRATCH BUFFER 
          SA0    A1+B1       FIRST MODIFIER 
          BX6    X2 
          SA6    SBUF 
          MX0    42 
 OPL3     SB6    -12
          ZR     X5,OPL7     IF END OF MODIFIERS
 OPL4     ZR     X5,OPL6     IF END OF TABLE
          SA4    A0          SPACE FILL NAME
          BX1    X0*X4
          RJ     ZTB
          LX4    59-16       CHECK YANK BIT 
          SA0    A0+B1
          PL     X4,OPL5     IF NOT SET 
          SA1    OPLA        ADD () 
          IX6    X6+X1
 OPL5     LX6    -6          STORE NAME 
          SA6    SBUF+13+B6 
          SB6    B6+B1
          SX5    X5-1        ADVANCE TABLE
          NE     B6,B7,OPL4  IF NOT END OF LINE 
          MX6    0           LIST LINE
          SA6    A6+B1
          SX1    SBUF 
          RJ     WOF
          EQ     OPL3        LOOP 
  
  
 OPL6     MX6    0           LIST PARTIAL LINE
          SA6    A6+B1
          SX1    SBUF 
          RJ     WOF
 OPL7     SA3    OPLB 
          ZR     X3,OPL8     IF BUFFER NOT FULL 
          SX1    =C*  * 
          RJ     WOF
          SX1    OPLC        * ADDITIONAL MODIFIERS NOT LISTED *
          RJ     WOF
          SX7    B0+         CLEAR BUFFER FULL FLAG 
          SA7    OPLB 
 OPL8     SA1    LC          CHECK LINE COUNT 
          SA3    A1+B1
          IX7    X1-X3
          PL     X7,CAT1     IF BOTTOM OF PAGE REACHED
          SX1    =2L
          RJ     WOF
          EQ     CAT1        RETURN 
  
 OPLA     VFD    60/3A) (-1H
 OPLB     CON    0           FULL BUFFER FLAG 
 OPLC     DATA   5H 
          DATA   C$*** ADDITIONAL MODIFIERS NOT LISTED ***$ 
 RDA      SPACE  4
**        RDA - READ DATA.
*         PROCESSES CALLS TO READ WORDS (RDW=). 
*         DEBLOCKS DATA IF CONTROL WORD READS.
  
*         ENTRY/EXIT CONDITIONS ARE IDENTICAL WITH THOSE FOR COMCRDW. 
  
  
 RDA5     SX6    B5-B7       UPDATE WORDS REMAINING 
          SA6    A1 
  
 RDA6     RJ     RDW=        READ WORDS 
  
 RDA      PS                 ENTRY/EXIT 
          SA1    CW          CHECK IF CONTROL WORDS LEGAL 
          ZR     X1,RDA6     IF CONTROL WORD READS NOT LEGAL
          SA0    B6 
 RDA1     SA1    X2-2        GET NUMBER OF WORDS BEFORE CONTROL WORD
          SB5    X1+
          PL     X1,RDA2     IF NOT FIRST READ
          SX7    B7+         SET WORDS NEEDED 
          SA7    RDAA 
          JP     RDA4 
  
 RDA2     GE     B5,B7,RDA5  IF ENOUGH DATA TO FILL BUFFER
          SA3    X2-1        CHECK EOR FLAG 
          PL     X3,RDA3     IF NOT EOR ON FILE 
          MX6    1           SET NEW READ FLAG
          SB7    B5+B1       SET WORDS TO READ
          SA6    A3 
          SA6    A1 
          RJ     RDW=        READ WORDS 
          SA1    B6-B1       CHECK CONTROL WORD 
          AX1    48 
          SX6    X1-17B 
          MX1    -1 
          SB6    B6-B1       BACK UP LAST WORD ADDRESS
          ZR     X6,RDA      IF *EOF* CONTROL WORD
          SX1    B6          SET *EOR* INDICATION 
          JP     RDA         RETURN 
  
 RDA3     SX6    B7-B5       SAVE ADDITIONAL WORDS NEEDED 
          SA6    RDAA 
          SB7    B5+B1       SET WORDS TO TRANSFER
          RJ     RDW=        READ WORDS 
          SB7    A0-B6
          ZR     B7,RDA      IF EOR, RETURN 
          SB6    B6-1        BACK UP OVER LAST CONTROL WORD 
 RDA4     SB7    B1          READ CONTROL WORD
          RJ     RDW= 
          NG     X1,RDA      IF EOF/EOI 
          SB6    B6-B1       BACK UP WORKING BUFFER 
          SA1    B6          CONTROL WORD 
          SX7    5
          SX4    X1+4        ROUND UP 
          AX1    36          EXTRACT BLOCK SIZE 
          SX3    X1 
          IX7    X4/X7       WORDS IN BLOCK 
          IX6    X7-X3       SAVE EOR FLAG
          SA7    X2-2        STORE WORD COUNT 
          SA6    X2-1        EOR FLAG 
          SA1    RDAA        RESET WORDS NEEDED 
          SB7    X1 
          JP     RDA1        LOOP 
  
 RDAA     CON    0
 RDR      SPACE  4
**        RDR - READ RECORD.
* 
*         EXIT   (X1) = -1 IF EOF.
*                (RL) = RECORD LENGTH.
*                (CS) = CHECK SUM.
*                (TY) = RECORD TYPE.
*                (NM) = RECORD NAME.
*                (NSFF) .NE. 0, IF NONSTANDARD RECORD ENCOUNTERED 
*                     (DATA WITH NO EOR). 
* 
*         USES   A - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4. 
*                X - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  SRT. 
* 
*         MACROS MESSAGE, READW.
  
  
 RDR      PS                 ENTRY/EXIT 
          READW  F,BUF,BUFL 
          BX6    X1          SAVE STATUS
          SA6    RDRA 
          SB2    B6-BUF 
          SX1    B6          LWA+1 OF DATA FOR SRT CALL 
          NZ     B2,RDR0     IF DATA TRANSFERRED
          PL     X6,RDR0     IF NOT EOF/EOI 
          SX1    BUF
 RDR0     SX2    BUF
          RJ     SRT
          SA6    TY          SET TYPE 
          SA7    NM          SET NAME 
          LX7    -6          ENTER NAME N MESSAGE 
          SX3    1R          ENTER NAME IN MESSAGE
          LX3    59-5 
          BX7    X3+X7
          SA7    RDRB+1 
          MESSAGE A7-B1,1    ISSUE CONSOLE MESSAGE
          SA1    RDRA 
          SB2    BUFL 
          SB3    BUF
          ZR     X1,RDR1     IF NOT EOR/EOF 
          SB2    B6-BUF 
          ZR     B2,RDR      RETURN IF ZERO LENGTH RECORD 
          PL     X1,RDR1     IF NOT NONSTANDARD RECORD
          SX6    B1+         SET NONSTANDARD FILE FLAG
          SA6    NSFF 
 RDR1     SA2    TY          EXCLUDE RECORD TYPES WITHOUT 7700 TABLE
          SX2    X2 
          ERRNZ  TXRT        CODE ASSUMES VALUE 
          ZR     X2,RDR2     IF RECORD TYPE *TEXT*
          SA2    B3          CHECK FIRST WORD 
          LX2    18 
          SX6    X2-770000B 
          NZ     X6,RDR2     IF NO 7700 TABLE 
          LX2    6           SKIP 7700 TABLE
          SB4    X2+B1
          SB3    B3+B4
          SB2    B2-B4
          LE     B2,RDR      IF 77 TABLE ONLY OR ERROR IN LENGTH
  
 RDR2     SA2    RL          ADVANCE RECORD LENGTH
          SA3    CS          ADVANCE CHECKSUM 
          SX7    B2 
          SA4    B3 
          BX6    X3 
          IX7    X2+X7
 RDR3     BX6    X6-X4
          SB2    B2-B1
          SA4    A4+B1
          LX6    1
          NZ     B2,RDR3
          SA6    A3 
          SA7    A2 
          NZ     X1,RDR      RETURN IF EOR/EOF
          READW  F,SBUF,SBUFL 
          SB2    SBUFL
          SB3    SBUF 
          ZR     X1,RDR2     IF NOT EOR/EOF 
          SB2    B6-SBUF
          PL     X1,RDR4     IF NOT NONSTANDARD RECORD
          SX6    B1+         SET NONSTANDARD FILE FLAG
          SA6    NSFF 
 RDR4     NZ     B2,RDR2     IF NOT EMPTY BUFFER
          EQ     RDR         RETURN 
  
 RDRA     DATA   0
  
 RDRB     DATA   10HCATALOGING
          DATA   0
 REL      SPACE  4,10 
**        REL - PROCESS RELOCATABLE LIST. 
* 
*         ENTRY  (BUF) = FIRST BLOCK OF RECORD. 
* 
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 1, 2, 5, 6, 7. 
*                B - 2. 
* 
*         CALLS  CDD, WOF, ZTB. 
  
  
 REL      SA1    BUF         CHECK FIRST WORD 
          LX1    18 
          SB2    X1-770000B 
          NZ     B2,CAT1     RETURN IF NO 7700 TABLE
          LX1    6           SKIP 7700 TABLE
          SB2    X1+B1
          SA1    A1+B2
          LX1    12 
          SB2    X1-7000B 
          NZ     B2,REL1     IF NOT 7000 TABLE
          LX1    12          SKIP 7000 TABLE
          SB2    X1+B1
          SA1    A1+B2
          LX1    12 
 REL1     SB2    X1-3400B 
          NZ     B2,CAT1     RETURN IF NO 3400 TABLE
          LX1    12          SKIP 3400 TABLE
          SB2    X1+B1
          SA1    A1+B2
          LX1    12 
          SB2    X1-3600B 
          NZ     B2,CAT1     RETURN IF NO 3600 TABLE
          LX1    12 
          SX0    X1-1 
          SA5    A1+B1       FIRST ENTRY POINT
          SA2    =1H         CLEAR SCRATCH BUFFER 
          BX6    X2 
          MX7    0
          SA6    SBUF 
          SA7    SBUF+2 
          SX2    BUF+BUFL    CALCULATE MAXIMUM ENTRY POINT COUNT
          SX7    A5 
          IX7    X2-X7
          IX2    X0-X7
          NG     X2,REL2     IF NO EXCESS ENTRY POINTS
          SX0    X7-1        SET MAXIMUM ENTRY POINT COUNT
          SX1    X2+1        ADD UNLISTED ENTRY POINT COUNT TO MESSAGE
          LX1    -1 
          RJ     CDD
          SA6    LRSD 
 REL2     BX1    X5          SPACE FILL NAME
          RJ     ZTB
          LX6    -6 
          SA6    SBUF+1 
          SX1    SBUF        LIST ENTRY POINT 
          RJ     WOF
          SA5    A5+2        NEXT ENTRY POINT 
          SX0    X0-2 
          PL     X0,REL2     LOOP FOR ALL ENTRY POINTS
          SA1    LRSD 
          ZR     X1,CAT1     IF NO EXCESS ENTRY POINTS
          SX1    LRSD        ISSUE EXCESS ENTRY POINT MESSAGE 
          RJ     WOF
          SX6    B0+
          SA6    LRSD 
          EQ     CAT1        RETURN 
 TXT      SPACE  4
**        TXT - PROCESS TEXT LIST.
  
  
 TXT      SA1    NM          READ NAME
          SA2    TXTB        SET TABLE ADDRESS FOR *OVERLAY* ONLY 
          SA3    TXTD 
          ZR     X3,TXT0     IF NOT LISTING *TEXT* RECORDS
          SA2    TXTA        SET TABLE ADDRESS FOR ALL TEXT RECORDS 
 TXT0     MX4    1
          SB2    X2 
          MX0    42 
          BX6    X0*X2
 TXT1     AX3    X4,B2       SET MASK 
          BX7    X1-X6
          BX6    X3*X7
          SA2    A2+B1
          ZR     X6,TXT2     IF MATCH ON NAME 
          ZR     X2,CAT1     IF END OF TABLE
          SB2    X2 
          BX6    X0*X2
          EQ     TXT1        LOOP 
  
 TXT2     SA0    BUF
          SX6    A2-TXTB-1   SET *OVERLAY* FLAG 
          SA6    TXTC 
          SA1    =1H
          BX6    X1 
          SB2    B0 
          SA6    SBUF 
          MX0    -12
          SA6    A6+B1
          SA5    RL 
          SX7    X5-BUFL
          SA7    TXTE 
          MI     X7,TXT3     IF LESS THAN FULL BUFFER OF TEXT 
          SX5    BUFL        RESET LENGTH OF RECORD 
 TXT3     SX5    X5-1 
          NG     X5,TXT4     IF END OF COPY 
          SA1    A0          MOVE WORD
          LX6    X1 
          SA6    SBUF+2+B2
          SA0    A0+B1
          BX7    -X0*X1 
          SB2    B2+B1
          NZ     X7,TXT3     LOOP TO END OF LINE
          SX1    SBUF        LIST LINE
          RJ     WOF
          SA2    TXTC 
          ZR     X2,CAT1     IF *OVERLAY* RECORD
          SB2    B0 
          EQ     TXT3        LOOP 
  
 TXT4     SA1    TXTE 
          NG     X1,TXT5     IF NOT FULL BUFFER 
          SX1    =C*  * 
          RJ     WOF
          SX1    TXTF        * ADDITIONAL TEXT NOT LISTED * 
          RJ     WOF
 TXT5     SX1    =C*  * 
          RJ     WOF
          EQ     CAT1        RETURN 
  
  
  
****      TABLE OF SPECIAL *TEXT* RECORD NAMES. 
* 
*         IF THE *T* OPTION IS SELECTED, THE ENTIRE TABLE WILL BE 
*         SEARCHED.  OTHERWISE, ONLY *OVERLAY* WILL BE RECOGNIZED.
* 
*         ENTRY FORMAT -
* 
*T        42/ SPECIAL RECORD NAME SKELETON, 18/ BITS-1 IN MASK
* 
*         TABLE IS TERMINATED BY A ZERO WORD. 
  
  
 TXTA     BSS    0
  
*         PATTERNS SEARCHED IF *T* OPTION ENABLED.
  
          VFD    42/0LAPRD,18/24-1     *APRDECK* PATTERNS 
          VFD    42/0LAPR0,18/24-1
          VFD    42/0LCMRD,18/24-1     *CMRDECK* PATTERN
          VFD    42/0LEQPD,18/24-1     *EQPDECK* PATTERN
          VFD    42/0LIPRD,18/24-1     *IPRDECK* PATTERN
          VFD    42/0LLIBD,18/24-1     *LIBDECK* PATTERN
  
*         UNCONDITIONALLY SEARCHED PATTERNS.
  
 TXTB     VFD    42/0LOVERLAY,18/42-1  *OVERLAY* PATTERN
  
          CON    0           END OF TABLE 
****
  
 TXTC     CON    0           *OVERLAY* RECORD FLAG
 TXTD     CON    0           LIST *TEXT* RECORDS FLAG 
 TXTE     CON    0           BUFFER FULL FLAG 
 TXTF     DATA   20H
          DATA   C$*** ADDITIONAL TEXT NOT LISTED ***$
 ULB      SPACE  4
**        ULB - PROCESS USER LIBRARY. 
  
  
 ULB      SA1    UL 
          SX6    B1+
          SA6    ULBB        SET *SEARCHING FOR OPLD* FLAG
          NZ     X1,CAT1     IF USER LIBRARY LIST REQUESTED 
          SA6    ULBA        SET NO LIST
          EQ     CAT1        RETURN 
  
 ULBA     CON    0           *USER LIBRARY FOUND AND NO ULIB LIST* FLAG 
 ULBB     CON    0           *SEARCHING FOR OPLD* FLAG
          TITLE  SUBROUTINES. 
 WOF      SPACE  4
**        WOF - WRITE LINE TO OUTPUT. 
* 
*         ENTRY  (X1) = FWA LINE. 
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 2, 3, 6, 7. 
* 
*         CALLS  CDD. 
* 
*         MACROS WRITEC.
  
  
 WOF      PS                 ENTRY/EXIT 
          SA3    LC          ADVANCE LINE COUNT 
          SX6    X3+B1
          SA6    A3 
          SA2    A3+B1       GET LINE LIMIT 
          IX7    X6-X2
          NG     X7,WOF1     IF BOTTOM OF PAGE NOT REACHED
          SX6    3           RESET LINE COUNT 
          BX7    X1          SAVE REQUEST 
          SA6    A3 
          SA1    PN          ADVANCE PAGE NUMBER
          SA7    WOFA 
          SX6    X1+B1
          SA6    A1 
          RJ     CDD         CONVERT PAGE NUMBER
          MX1    48 
          LX6    18          STORE PAGE NUMBER
          BX6    X1*X6
          SA6    PAGE 
          WRITEC O,TITL 
          WRITEC X2,SBTL
          WRITEC X2,(=C*  *)
          SA1    WOFA        RESTORE REQUEST
 WOF1     WRITEC O,X1 
          SA1    SL          CHECK LIST FLAG
          ZR     X1,WOF      RETURN IF NOT SHORT LIST 
          MX6    0           CLEAR LINE COUNT 
          SA6    LC 
          EQ     WOF         RETURN 
  
 WOFA     CON    0
          SPACE  4
*         COMMON DECKS. 
  
  
*CALL     COMCCDD 
*CALL     COMCCOD 
*CALL     COMCCPT 
*CALL     COMCSRT 
*CALL     COMCRDW 
*CALL     COMCWTC 
*CALL     COMCWTW 
*CALL     COMCCIO 
*CALL     COMCSYS 
*CALL COMCZTB 
 BUFFERS  SPACE  4
**        BUFFERS.
  
  
          USE    // 
          SEG 
 BUFL     EQU    10002B      WORKING BUFFER 
 SBUFL    EQU    100B        SCRATCH BUFFER 
  
 BUF      BSS    BUFL 
 SBUF     BSS    SBUFL
 FBUF     BSS    FBUFL
 OBUF     BSS    OBUFL
 RFL=     BSS    0
 PRS      SPACE  4,10 
**        PRS - PRESET PROGRAM. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 4, 5, 6, 7.
*                B - 1, 4, 5, 7.
* 
*         CALLS  ARG, CDT, DXB, STF, ZTB. 
* 
*         MACROS ABORT, CLOCK, DATE, GETPP, MESSAGE, OPEN, SETLOF.
  
  
          ORG    BUF
 PRS      PS                 ENTRY/EXIT 
          SB1    1
          DATE   DATE 
          GETPP  OBUF,LL,PD  GET PAGE SIZE PARAMETERS 
          CLOCK  TIME 
          SA1    ACTR        CHECK ARGUMENT COUNT 
          SB4    X1 
          MX0    42 
          ZR     B4,PRS2     IF NO ARGUMENTS
          SA4    ARGR        SET FILE NAME
          BX6    X0*X4
          ZR     X6,PRS1     IF FILE NAME BLANK 
          SX2    3
          IX6    X6+X2
          SA6    F
 PRS1     SB4    B4-B1
          ZR     B4,PRS2     IF END OF ARGUMENTS
          SA4    A4+B1       PROCESS SPECIAL ARGUMENTS
          SB5    PRSA 
          RJ     ARG
          NZ     X1,PRS4     IF ARGUMENT ERROR
 PRS2     SA5    FC          CHECK FILE COUNT 
          ZR     X5,PRS3     IF NO CONVERSION REQUIRED
          SB7    B1 
          RJ     DXB
          SA6    FC 
          NZ     X4,PRS4     IF CONVERSION ERROR
 PRS3     SA1    F           ENTER FILE NAME IN TITLE 
          MX0    42 
          BX1    X0*X1
          RJ     ZTB
          LX6    -6 
          SA6    TITL+2 
          MX1    1           SET FLUSH BIT IN FET 
          SA2    O           SET UP AUTO-FLUSH TABLE
          LX1    36-59
          SA4    A2+B1
          SX3    O
          BX7    X4+X1
          SA7    A4 
          BX2    X0*X2
          BX6    X2+X3
          SA6    FLS+1
          SETLOF PRSG 
          SA1    O           CHECK FILE NAMES 
          SA2    F
          BX6    X1-X2
          BX7    X0*X6
          ZR     X7,PRS5     IF SAME NAME 
          SX2    O           CHECK IF TERMINAL FILE 
          RJ     STF
          SA6    TF 
          NZ     X6,PRS3.1   IF NOT TERMINAL FILE 
          SX6    B1          SET SHORT LIST FLAG
          SA6    SL 
          SA2    =1H         DELETE EJECT 
          BX7    X7-X7
          BX6    X2 
          SA7    TITLA
          SA7    SBTLA
          SA7    PGEJ 
          SA6    TITL 
 PRS3.1   SX2    F           ADDRESS OF FET 
          SA3    PRSH        ADDRESS OF OD FET EXTENSION AND LENGTH 
          RJ     SOE         SET FET EXTENSION IF OPTICAL DISK FILE 
          OPEN   X2,READNR,R CHECK IF CONTROL WORDS MAY BE USED 
          SA1    F+1
          RJ     CDT         CHECK DEVICE TYPE
          ZR     X7,PRS      IF CONTROL WORDS NOT ALLOWABLE 
          SX7    1           SET CONTROL WORDS LEGAL
          SA7    CW          SET CONTROL WORD FLAG
          EQ     PRS         RETURN 
  
 PRS4     MESSAGE PRSB
          ABORT 
  
 PRS5     MESSAGE PRSC
          ABORT 
*CALL     COMCSOE 
  
 PRSA     BSS    0
 L        ARG    O,O         OUTPUT FILE NAME 
 N        ARG    PRSD,FC     NUMBER OF FILE TO CATALOG
 T        ARG    -*,TXTD     LIST *TEXT* RECORDS OPTION 
 U        ARG    -*,UL       LIST  *ULIB*  OPTION 
 D        ARG    PRSF,SL     DE-SELECT DETAILED LIST OPTION 
 R        ARG    -*,RW       REWIND BEFORE AND AFTER
 CS       ARG    -=0,CSM     LIST CHARACTER SET FOR *OPL* AND *OPLC*
          ARG 
  
 PRSB     DATA   C* CATALOG ARGUMENT ERROR.*
 PRSC     DATA   C* CATALOG FILE NAME CONFLICT.*
  
 PRSD     CON    0L999999 
 PRSF     CON    0L0
  
 PRSG     VFD    12/0,18/FLS,29/0,1/1  AUTO-FLUSH TABLE POINTER 
 PRSH     VFD    36/,6/FETODL,18/FETOD POINTER TO EXTENSION BUFFER
 CDT      SPACE  4,15 
**        CDT - CHECK DEVICE TYPE.
* 
*         ENTRY  (X1) = (FET+1).
* 
*         EXIT   (X7)= 0 IF CONTROL WORD READ/WRITE NOT SUPPORTED ON
*                 DEVICE. 
* 
*         USES   B - NONE.
*                A - 2. 
*                X - 0,1,2,6,7. 
* 
*         CALLS  NONE.
  
  
 CDT2     LX1    12          CHECK *TT* 
          BX6    -X0*X1 
          SX7    X6-2RTT
  
 CDT      PS                 ENTRY/EXIT 
          MX0    -12
          PL     X1,CDT2     IF ALLOCATABLE 
          LX1    12 
          SA2    CDTA        SEARCH DEVICE TABLE
          SX7    0           ASSUME NO FIND 
 CDT1     ZR     X2,CDT      RETURN - IF NOT FOUND
          BX6    X1-X2
          AX2    12 
          BX6    X2*X6
          SA2    A2+B1
          NZ     X6,CDT1     IF NOT MATCH 
          SX7    1           INDICATE CONTROL WORD POSSIBLE 
          JP     CDT         RETURN 
  
 CDTA     VFD    36/,12/7703B,12/4002B
          VFD    36/,12/7703B,12/4102B
          VFD    36/,12/7777B,12/2RMT+4000B 
          VFD    36/,12/7777B,12/2RNT+4000B 
          VFD    36/,12/7777B,12/2RCT+4000B 
          VFD    36/,12/7777B,12/2RAT+4000B 
          CON    0
          SPACE  4
*         COMMON DECKS. 
  
  
*CALL     COMCARG 
*CALL     COMCCPM 
*CALL     COMCDXB 
*CALL     COMCLFM 
*CALL     COMCSTF 
          SPACE  4
          END 
