          IDENT  GENCAT,FETS
          TITLE  RAM$GENCAT
          ABS
          ENTRY  GENCAT
          ENTRY  RFL=
          ENTRY  SSM=
          SST
          SYSCOM B1          DEFINE (B1) = 1
          TITLE  CATALOG - CATALOG FILE.
*COMMENT  CATALOG FILE.
          COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
          SPACE  4
***       CATALOG - CATALOG FILES.
*         G. R. MANSFIELD.  70/12/20.
*         J. B. FARR.       79/05/03.  -  ADD *LO* ARGUMENT
          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.
*         COS    CHIPPEWA FORMAT CENTRAL 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.
*
*
*         A RECORD OF *REL* FORMAT WILL HAVE THE ENTRY POINTS LISTED.
*
*         A RECORD OF *TEXT* FORMAT WILL BE LISTED IF THE NAME
*                OF THE RECORD BEGINS WITH *CMRDECK*, *IPRDECK*
*                *LIBDECK*, *CMRDC*, *IPRDC*, OR *LIBDC*.
*                IF *OVERLAY*, THE FIRST LINE ONLY IS LISTED.
*
*         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.
*
*
*         GENCAT(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*.
*
*         U      SELECT DETAILED USER LIBRARY LIST.
*
*         D      DESELECT DETAILED LIST, NORMALLY SELECTED FOR
*                *TXOT*  JOBS.
*
*         R      REWIND  *FNAME*  FILE BEFORE AND AFTER CATALOG.
*
*         CS     DE-SELECT CHARACTER SET LIST FOR OPL/OPLC RECORDS.
*
*         LO=N   PRODUCE OUTPUT AS DESCRIBED ABOVE
*         LO=S   PRODUCE OUTPUT CONTAINING ONLY RECORD
*                NAME AND TYPE (4 PER LINE)
*         LO=D   PRODUCE OUTPUT CONSISTING OF 1 LINE PER
*                NON-EMPTY RECORD IN THE FORM OF A LIBEDIT *BEFORE*
*                DIRECTIVE SUCH THAT THE RECORDS CAN BE SORTED
*                ACCORDING TO RECORD TYPE AND NAME
*
*
*         ASSUMED OPTIONS -
*
*         OPT    VALUE
*
*         FNAME  FILE.
*         N      1.
*         L      OUTPUT.
*         U      *NOT SELECTED*.
*         D      *NOT SELECTED*.
*         R      *NOT SELECTED*.
*         CS     *SELECTED*.
*         LO     N
          SPACE  4,10
***       DAYFILE MESSAGES.
*
*
*         *FL TOO SHORT FOR CATALOG.* = NOT ENOUGH FIELD LENGTH WAS
*                ALLOWED.  (AT LEAST 6200 REQUIRED.)
*
*         *ERROR IN ARGUMENTS.* = ARGUMENT WAS NOT AS SPECIFIED ABOVE.
*
*         *ILLEGAL FILE COUNT.* = FILE COUNT WAS NOT NUMERIC.
*
*         *FILE NAME CONFLICT.* = LIST FILE NAME AND CATALOG FILE
*                NAME WERE THE SAME.
          SPACE  4
****      ASSEMBLY CONSTANTS.


 FBUFL    EQU    4011B       FILE BUFFER LENGTH
 OBUFL    EQU    2001B       OUTPUT BUFFER LENGTH
****
          SPACE  4,10
**        SPECIAL ENTRY POINT.


 SSM=     EQU    0           SUPPRESS DUMPS OF FIELD LENGTH
 OPL      XTEXT  COMCMAC
 OPL      XTEXT  COMSSRT
 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
          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=7
          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,0         USER LIBRARY LIST FLAG
 LN       CON    1           LIBRARY NUMBER

*         LIST DATA.

 SL       CON    0           SHORT LIST FLAG
 LC       CON    LINP+4      LINE COUNT
 PN       CON    1           PAGE NUMBER
 CSM      CON    1           OPL CHARACTER SET LIST FLAG
 TF       CON    0           TERMINAL FLAG
 LO       CON    0           LIST OPTION DESIGNATOR - -1 (LO=D)
*                                                   -  0 (LO=N)
*                                                   -  1 (LO=S)

 TITL     DATA   1H1
          DATA   10HCATALOG OF
          DATA   1H
          DATA   4AFILE
          DATA   5A1
          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   8ALENGTH
          DATA   7ACKSUM
          DATA   7ADATE
 SBTLA    DATA   8ACOMMENTS
          DATA   0
          DATA   2L
 SBTLL    EQU    *-SBTL
          TITLE  MAIN PROGRAM.
 GENCAT   SPACE  4
**        GENCAT - MAIN PROGRAM.


 GENCAT   SB1    1           (B1) = 1
          RJ     PRS         PRESET PROGRAM
          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,CAT0     IF NON-ZERO RECORD
          NG     X1,CAT3     IF EOF
 CAT0     SA2    A4+B1
          SA3    A2+B1       ADVANCE FILE TOTAL
          IX6    X2+X4
          SA6    A2
          IX7    X3+X4
          SA7    A3
          SA1    UL+1
          ZR     X1,CAT2     IF NOT USER LIBRARY
          SA2    TY          CHECK TYPE
          SB2    X2-10B
          NZ     B2,CAT1     IF NOT *OPLD*
          BX6    X6-X6       CLEAR USER LIBRARY
          SA6    A1
          EQ     CAT1


 CAT2     RJ     LRS         LIST RECORD STATUS
          SA1    LO          CHECK LIST OPTION
          NZ     X1,CAT1     IF LO=S OR LO=D
          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
          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     X5,CAT5     IF EOI
          NZ     X6,CAT0.1   IF MORE FILES REQUESTED

 CAT5     BSS    0           PAGE NUMBER CHECK DELETED
 CAT6     WRITER O
          SA1    RW
          ZR     X1,CAT7     IF NO REWIND
          REWIND F
 CAT7     MESSAGE (=C* GENCAT COMPLETE.*)
          ENDRUN

 CATA     DATA   10HCATALOGING
          DATA   0

 CATB     BSS    0
          LOC    0
          EQ     TXT         TEXT
          EQ     CAT1        PP
          EQ     CAT1        COS
          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
          LOC    *O
 EOF      SPACE  4
**        EOF - PROCESS END OF FILE.


 EOF      PS                 ENTRY/EXIT
          SA1    LO          CHECK LIST OPTION
          NZ     X1,EOF3     IF LO=S OR LO=D
          SA2    NSFF        CHECK FOR NONSTANDARD FILE
          ZR     X2,EOF0     IF NOT NONSTANDARD FILE
          BX6    X6-X6
          SX1    EOFB        LIST *EOR MISSING* MESSAGE
          SA6    A2
          RJ     WOF
 EOF0     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
          LX6    12
          MX7    0
          SA6    A7+B1
          SA7    A6+B1
          SX1    SBUF
          RJ     WOF
          SA1    FN          ADVANCE FILE NUMBER
          SX6    LINP        FORCE 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

*         HANDLE EOF/EOI FOR LO=S OR LO=D

 EOF3     BSS    0
          NG     X1,EOF4     IF LO=D
          SA1    NEXTRS
          ZR     X1,EOF4     IF NO LINE TO COMPLETE
          WRITES O,RSBUF,X1  WRITE SHORT LINE
          MX6    0           RESET TO START OF LINE
          SA6    NEXTRS

 EOF4     BSS    0           CLEAR LENGTHS, REC NUM, AND LINE NUM
          MX7    0
          SA7    RL
          SA7    A7+B1
          SX6    B1
          SA7    RN
          SA6    LN
          EQ     EOF         RETURN


 EOFA     DATA   10H* EOF *
          DATA   10H* EOI *

 EOFB     DATA   C+          *EOR MISSING*+
 LRS      SPACE  4
**        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   ALL REGISTERS.
*
*         CALLS  CDD, COD, SFN, WOF.


 LRS      PS                 ENTRY/EXIT
          SA5    LO          CHECK LIST OPTION
          NZ     X5,LRS15    IF LO=S OR LO=D

*         LIST RECORD STATUS   ( LO = N )

          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
          LX6    12
          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     SFN
          SA6    A6+B1
          SA1    TY          SET TYPE
          SB7    X1
          SA2    LRSA+X1
          BX6    X2
          SA6    A6+B1
          SA1    RL          CONVERT LENGTH
          RJ     COD
          LX6    12
          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
          BX7    X7-X7       TRUNCATE COMMENT FIELD
          SA7    SBUF+14B
          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
 LRS5     SX1    SBUF
          RJ     WOF
          EQ     LRS         RETURN


*         PROCESS  *OPL*  AND  *OPLC*  RECORDS.

 LRS5.4   SA1    CSM         CHARACTER SET LIST MODE FLAG
          SA2    B7+LRSA     SET RECORD TYPE
          SA4    =5R         PRESET LIST
          ZR     X1,LRS5.5   IF NO CHARACTER SET LIST SET
          SA3    BUF+16B     CHECK OPL/OPLC CHARACTER SET
          MX7    -12
          BX3    -X7*X3      LOWER 12 BITS OF WORD 14 OF HEADER
          SA4    =5R(64)     PRESET FOR 64 CHARACTER SET
          SB3    X3-64B      CHECK PL CHARACTER SET
          ZR     B3,LRS5.5   IF 64 CHARACTER SET RECORD
          SA4    =5R(63)     SET 63 CHARACTER SET
 LRS5.5   BX6    X2+X4
          SA6    SBUF+2      SET IN OUTPUT LINE
*         EQ     LRS6

 LRS6     SA1    LC          CHECK LINE COUNT
          SX7    X1-LINP+6
          NG     X7,LRS4     IF NOT ROOM FOR 2 LINES
          SX6    LINP        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    LINP        FORCE EJECT
          SA6    LC
          EQ     LRS4        LIST LINE

 LRSA     BSS    0
          LOC    0
          CON    10HTEXT
          VFD    24/4LPP (,24/0,12/2L)
          CON    10HCOS
          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
          LOC    *O

 LRSB     BSS    0
          LOC    0
          EQ     LRS4        TEXT
          EQ     LRS7        PP
          EQ     LRS4        COS
          EQ     LRS6        REL
          EQ     LRS9        OVL
          EQ     LRS14       ULIB
          EQ     LRS5.4      OPL
          EQ     LRS5.4      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
          LOC    *O

 LRSC     CON    10HPPU (    )-6A1

*         CONSTANTS AND DATA FOR LIST OPTIONS S AND D

 RSPLIN   EQU    4             RECORD STATUSES PER LINE
 RSLEN    EQU    18            RECORD STATUS LENGTH
 RSBUFL   EQU    RSPLIN*RSLEN  RECORD STATUS BUFFER LENGTH

 NEXTRS   CON    0           INDEX IN RSBUF FOR NEXT RECORD STATUS
 RSBUF    BSS    0           RECORD STATUS BUFFER (LINE)
          DUP    RSBUFL,1    SPACE FILL BUFFER
          CON    1R

 RTT      BSS    0           RECORD TYPE TABLE
          LOC    0
          CON    4LTEXT
          CON    4LPP
          CON    4LCOS
          CON    4LREL
          CON    4LOVL
          CON    4LULIB
          CON    4LOPL
          CON    4LOPLC
          CON    4LOPLD
          CON    4LABS
          CON    4LPPU
          CON    4L
          CON    4L
          CON    4L
          CON    4LCAP
          CON    4L
          CON    4LPROC
          LOC    *O

 RTDT     BSS    0           RECORD TYPE DIRECTIVE TABLE
          LOC    0
          DIS    ,.*B *,TEXT/RECNAME   A.
          DIS    ,.*B   *,PP/          H.
          DIS    ,.*B  *,COS/          I.
          DIS    ,.*B  *,REL/          D.
          DIS    ,.*B  *,OVL/          E.
          DATA   0,0,0
          DIS    ,.*B  *,OPL/          C.
          DIS    ,.*B *,OPLC/          B.
          DATA   0,0,0
          DIS    ,.*B  *,ABS/          F.
          DIS    ,.*B  *,PPU/          G.
          DATA   0,0,0
          DATA   0,0,0
          DATA   0,0,0
          DIS    ,.*B  *,CAP/          J.
          DATA   0,0,0
          DIS    ,.*B *,PROC/          K.
          LOC    *O


 LRS15    BSS    0           PROCESS SPECIAL LIST OPTION
          SA1    RL
          ZR     X1,LRS      RETURN IF ZERO-LENGTH RECORD
          NG     X5,LRS16    IF LO=D

*         LIST RECORD STATUS  ( LO = S )

          SA1    NM          DOT FILL NAME (ALSO INSERT LEADING SPACE)
          SX2    1R
          BX1    X1+X2
          SB2    -6
          MX0    -6
          SX2    1R.

 LRS15A   BSS    0
          LX1    -6
          SB2    B2+6
          BX3    -X0*X1
          NZ     X3,LRS15B   IF FOUND LAST CHAR IN NAME
          BX1    X1+X2
          EQ     LRS15A

 LRS15B   BSS    0
          LX1    B2
          SA2    NEXTRS      COPY NAME INTO BUFFER
          SB2    X2+RSBUF
          SB3    B2+9

 LRS15C   BSS    0
          LX1    6
          BX6    -X0*X1
          SA6    B2
          SB2    B2+B1
          LE     B2,B3,LRS15C

          SA1    TY          COPY RECORD TYPE TO BUFFER
          SA1    X1+RTT
          SB3    B3+4

 LRS15D   BSS    0
          LX1    6
          BX6    -X0*X1
          SA6    B2
          SB2    B2+B1
          LE     B2,B3,LRS15D

          SA1    NEXTRS      ADVANCE BUFFER INDEX
          SX6    X1+RSLEN
          SB2    X6-RSBUFL
          NZ     B2,LRS15E   IF LINE NOT COMPLETE
          MX6    0           RESET BUFFER INDEX
          SA6    A1
          WRITES O,RSBUF,RSBUFL
          EQ     LRS         RETURN

 LRS15E   BSS    0
          SA6    A1
          EQ     LRS         RETURN

*         LIST RECORD STATUS   ( LO = D )

 LRS16    BSS    0
          SA2    TY          CHECK RECORD TYPE
          SX4    X2
          LX3    X4,B1
          IX4    X4+X3
          SA2    X4+RTDT     FIND RECORD TYPE DIRECTIVE
          ZR     X2,LRS      RETURN IF RECORD TYPE TO BE IGNORED
          SA1    NM          INSERT NAME INTO DIRECTIVE
          RJ     SFN         SPACE FILL NAME
          SA6    A2+B1
          WRITEC O,A2
          EQ     LRS         RETURN
 ABS      SPACE  4
**        ABS - PROCESS ABS ENTRY POINTS.


 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
 ABS2     MX2    42          SPACE FILL NAME
          BX1    X2*X5
          RJ     SFN
          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
          EQ     CAT1        RETURN
 CAP      SPACE  4,5
**        CAP - PROCESS CAPSULE GROUP NAMES.


 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     SFN         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
**        OPL - PROCESS OPL LIST.


 OPL      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
          SX5    X1
          ZR     X5,CAT1     RETURN IF NO MODIFIERS
          SA3    TF          CHECK FOR TERMINAL
          SB7    B0          LINE LENGTH FOR NON - TERMINAL
          ZR     X3,OPL0     IF NOT TERMINAL FILE
          SB7    -6          CHANGE LINE LENGTH FOR TERMINAL FILE
 OPL0     SA2    =1H         CLEAR SCRATCH BUFFER
          SA0    A1+B1       FIRST MODIFIER
          BX6    X2
          SA6    SBUF
          MX0    42
 OPL1     SB6    -12
          ZR     X5,OPL5     IF END OF MODIFIERS
 OPL2     ZR     X5,OPL4     IF END OF TABLE
          SA4    A0          SPACE FILL NAME
          BX1    X0*X4
          RJ     SFN
          LX4    59-16       CHECK YANK BIT
          SA0    A0+B1
          PL     X4,OPL3     IF NOT SET
          SA1    OPLA        ADD ()
          IX6    X6+X1
 OPL3     LX6    -6          STORE NAME
          SA6    SBUF+13+B6
          SB6    B6+B1
          SX5    X5-1        ADVANCE TABLE
          NE     B6,B7,OPL2  LOOP TO END OF LINE
          MX6    0           LIST LINE
          SA6    A6+B1
          SX1    SBUF
          SX2    B0
          RJ     WOF
          EQ     OPL1        LOOP


 OPL4     MX6    0           LIST PARTIAL LINE
          SA6    A6+B1
          SX1    SBUF
          SX2    B0
          RJ     WOF
 OPL5     SA1    LC          CHECK LINE COUNT
          SX7    X1-LINP
          PL     X7,CAT1     IF BOTTOM OF PAGE REACHED
          SX1    =2L
          SX2    B0
          RJ     WOF
          EQ     CAT1        RETURN

 OPLA     VFD    60/3A) (-1H
 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
          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
          ZR     X2,RDR2     IF RECORD TYPE *TEXT*
          SX2    X2-2
          ZR     X2,RDR2     IF RECORD TYPE *COS*
          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
**        REL - PROCESS RELOCATABLE LIST.


 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
 REL2     BX1    X5          SPACE FILL NAME
          RJ     SFN
          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
          EQ     CAT1        RETURN
 TXT      SPACE  4
**        TXT - PROCESS TEXT LIST.


 TXT      SA1    NM          READ NAME
          SA2    TXTA        SET TABLE
          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-TXTA-6-1 SET *OVERLAY* FLAG
          SA6    TXTB
          SA1    =1H
          BX6    X1
          SB2    B0
          SA6    SBUF
          MX0    -12
          SA6    A6+B1
          SA5    RL
          SX7    X5-BUFL
          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    TXTB
          ZR     X2,CAT1     IF *OVERLAY* RECORD
          SB2    B0
          EQ     TXT3        LOOP

 TXT4     SX1    =C*  *
          RJ     WOF
          EQ     CAT1        RETURN

 TXTA     BSS    0
          CON    5LCMRDC+29
          CON    7LCMRDECK+41
          CON    5LIPRDC+29
          CON    7LIPRDECK+41
          CON    5LLIBDC+29
          CON    7LLIBDECK+41
          CON    7LOVERLAY+41
          CON    5LDDSDC+29
          CON    7LDDSDECK+41
          CON    0

 TXTB     CON    0
 ULB      SPACE  4
**        ULB - PROCESS USER LIBRARY.


 ULB      SA1    UL
          NZ     X1,CAT1     IF USER LIBRARY LIST REQUESTED
          SX6    B1          SET NO LIST
          SA6    A1+B1
          EQ     CAT1        RETURN
          TITLE  SUBROUTINES.
 WOF      SPACE  4
**        WOF - WRITE LINE TO OUTPUT.
*
*         ENTRY  (X1) = FWA LINE.
*                (X2) = WORD COUNT.
*
*         USES ALL REGISTERS EXCEPT A0, X0, A5, X5.


 WOF      PS                 ENTRY/EXIT
          SA3    LC          ADVANCE LINE COUNT
          SX6    X3+B1
          SA6    A3
          SX7    X6-LINP+4
          NG     X7,WOF1     IF BOTTOM OF PAGE NOT REACHED
          BX6    X1          SAVE REQUEST
          SA6    WOFA
          SA1    PN          ADVANCE PAGE NUMBER
          SX6    B0          RESET LINE COUNT
          SX7    X1+B1
          SA6    A3
          SA7    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.


 OPL      XTEXT  COMCCDD
 OPL      XTEXT  COMCCOD
 OPL      XTEXT  COMCCPT
 OPL      XTEXT  COMCSFN
 OPL      XTEXT  COMCSRT
 OPL      XTEXT  COMCRDW
 OPL      XTEXT  COMCWTC
 OPL      XTEXT  COMCWTS
 OPL      XTEXT  COMCWTW
 OPL      XTEXT  COMCCIO
 OPL      XTEXT  COMCSYS
 BUFFERS  SPACE  4
**        BUFFERS.


          USE    //
          SEG
 BUFL     EQU    1000B       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
**        PRS - PRESET PROGRAM.


          ORG    BUF
 PRS      PS                 ENTRY/EXIT
          SB1    1
          DATE   DATE
          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

          SA4    PRSH        CHECK LIST OPTION ARGUMENT
          SA3    PRSLO

 PRS1A    BSS    0
          BX5    X3-X4
          BX6    X0*X5
          ZR     X6,PRS1B    IF OPTION FOUND
          SA3    A3+B1
          ZR     X3,PRS4     IF END OF TABLE
          EQ     PRS1A

 PRS1B    BSS    0           SET LIST OPTION CODE
          SX7    X3
          SA7    LO

 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
          SA2    PRSG        SET POINTER TO OUTPUT BUFFER
          MX0    42
          BX1    X0*X1
          LX6    X2
          BX7    X7-X7
          SA6    B1+B1
          SA7    A6+B1
          RJ     SFN
          LX6    -6
          SA6    TITL+2
          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
          NZ     X6,PRS3.1   IF NOT TERMINAL FILE
          SX6    B1          SET SHORT LIST FLAG
          SA6    SL
          SA6    TF          SET TERMINAL FLAG
          SA2    =1H         DELETE EJECT
          BX7    X7-X7
          BX6    X2
          SA7    TITLA
          SA7    SBTLA
          SA6    TITL
 PRS3.1   OPEN   F,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

 PRSA     BSS    0
 L        ARG    O,O         OUTPUT FILE NAME
 N        ARG    PRSD,FC     NUMBER OF FILE TO CATALOG
 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*
 LO       ARG    PRSH,PRSH   LIST OPTION
          ARG

 PRSB     DATA   C* CATALOG ARGUMENT ERROR.*
 PRSC     DATA   C* CATALOG FILE NAME CONFLICT.*

 PRSD     CON    0L999999
 PRSF     CON    0L0

 PRSG     CON    0LOUTPUT+O

 PRSH     CON    0LN

 PRSLO    VFD    42/0LN,18/0
          VFD    42/0LS,18/1
          VFD    42/0LD,18/-1
          CON    0
 CDT      SPACE  4
**        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
          CON    0
          SPACE  4
*         COMMON DECKS.


 OPL      XTEXT  COMCARG
 OPL      XTEXT  COMCDXB
 OPL      XTEXT  COMCLFM
 OPL      XTEXT  COMCSTF
          SPACE  4
          END
