Retro1.org codex

          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