GDIR
.PROC,GDIR. 
REVERT(EX)* FILE GDIRSC NOW LOCAL 
.DATA,GDIRSC
GDIR
          IDENT  GDIR 
          ENTRY  GDIR 
          SST 
          SYSCOM B1          DEFINE (B1) = 1
          TITLE  GDIR   - CATALOG FILE. 
  COMMENT 84/06/12.           GDIR   - GENERATE LIBEDIT DIRECTIVE 
          SPACE  4
****      ASSEMBLY CONSTANTS. 
  
  
 FBUFL    EQU    4011B       FILE BUFFER LENGTH 
 OBUFL    EQU    2001B       OUTPUT BUFFER 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. 
  
  
 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    1           REWIND FLAG
 CW       CON    0           CONTROL WORD FLAG (1 = CONTROL WORDS)
 FC       CON    1           FILE COUNT 
 EF       CON    0           EMPTY FILE FLAG
 NSFF     CON    0           NONSTANDARD FILE FLAG
 RN       CON    0           RECORD NUMBER
 FN       CON    0           NUMBER OF FILES
 CS       CON    0           CHECKSUM 
 RL       CON    0           RECORD LENGTH
          CON    0           ZERO RECORD SUBTOTAL 
          CON    0           FILE LENGTH
 OP       CON    0           CONTROL CARD OPTION
 NM       CON    0           RECORD NAME
 TY       CON    0           RECORD TYPE
 UL       CON    0           USER LIBRARY LIST FLAG 
 LN       CON    1           LIBRARY NUMBER 
  
*         *OP=DIR* COMMON DATA
  
 ST1      DATA   10HZZAABBCCDD DUMMY START CODE TO WORK WITH GENDIR PROC
 TY1      CON    0           RECORD TYPE 1
          DATA   1H/         SLASH
 NM1      CON    0           RECORD NAME 1
          DATA   1H-         DASH 
 TY2      CON    0           RECORD TYPE 2
          DATA   1H/         SLASH
 NM2      CON    0           RECORD NAME 2
 FSTREC   CON    0           FLAG FOR FIRST RECORD
  
 FLS      CON    3           AUTO-FLUSH TABLE 
          CON    0
          CON    0
          TITLE  MAIN PROGRAM.
 GDIR     SPACE  4
**        GDIR    - MAIN PROGRAM. 
* 
*         THIS PROGRAM IS USED TO - 
*         - GENERATE LIBEDIT DIRECTIVES FOR A FILE (WHEN USED IN
*         CONJUNCTION WITH THE *GENDIR2* PROC IN DECKOPL).
*         - PRODUCE A ONE LINE SUMMARY OF THE LENGTH, NUMBER OF 
*         RECORDS AND FILES, AND CHECKSUM FOR A FILE. THE INFORMATION IS
*         COMPATIBLE WITH WHAT THE CATLIST PROGRAM PRODUCES.
* 
*         THE TWO WAYS TO CALL THIS PROGRAM ARE - 
*           GDIR,FILE,OP=DIR. 
*           GDIR,FILE,OP=CKS. 
*         THE GENERATED INFO IS ALWAYS WRITTEN TO THE DAYFILE.
*         AN *L=LISTFILE* PARAMETER MAY BE ADDED TO THE SECOND FORM OF
*         THE PROGRAM CALL TO HAVE THE CHECKSUM/LENGTH INFO WRITTEN 
*         TO A FILE OTHER THAN THE FILE *OUTPUT* WHICH IS THE DEFAULT.
* 
*         THIS PROGRAM IS A HIGHLY MODIFIED VERSION OF THE
*         SYSTEM *CATLIST* COMMAND. 
* 
  
 GDIR     SB1    1           (B1) = 1 
          RJ     PRS         PRESET PROGRAM 
          WRITE  O,*         PRESET *CIO* FUNCTION
          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     SRS
          SA1    TY         PROCESS RECORD TYPES
          MX7    0
          SB7    X1 
          SA7    EF 
          JP     CATB+B7
  
 CAT3     SX1    X1+B1
          BX5    -X1         PROCESS END OF FILE
          SA1    FN          INCREMENT NUMBER OF FILES
          SX7    X1+B1
          SA7    A1 
          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     RJ     LRS         LIST RESULT
 CAT6     WRITER O
          SA1    RW 
          ZR     X1,CAT7     IF NO REWIND 
          REWIND F
 CAT7     MESSAGE (=C* GDIR COMPLETE.*) 
          ENDRUN
  
 CATA     DATA   10HCHECKING
          DATA   0
  
 CATB     BSS    0
          LOC    0
          EQ     CAT1        TEXT 
          EQ     CAT1        PP 
          EQ     CAT1        UNDEFINED RECORD TYPE
          EQ     CAT1        REL
          EQ     CAT1        OVL
          EQ     ULB         ULIB 
          EQ     CAT1        OPL
          EQ     CAT1        OPLC 
          EQ     CAT1        OPLD 
          EQ     CAT1        ABS
          EQ     CAT1        PPU
          EQ     CAT1        UNDEFINED RECORD TYPE
          EQ     CAT1        UNDEFINED RECORD TYPE
          EQ     CAT1        UNDEFINED RECORD TYPE
          EQ     CAT1        CAP
          EQ     CAT1        UNDEFINED RECORD TYPE
          EQ     CAT1        PROC 
          EQ     CAT1        UNDEFINED RECORD TYPE
          EQ     CAT1        UNDEFINED RECORD TYPE
          EQ     CAT1        UNDEFINED RECORD TYPE
          EQ     CAT1        PPL
          LOC    *O 
  
 LRS      SPACE  4
**        LRS - LIST RESULTS
  
 LRS      PS
          SA5    OP          DETERMINE IF ITS *DIR* OR *CKS* MODE 
          MX1    18 
          BX1    X5*X1
          SX4    3RCKS
          LX4    42 
          BX4    X4-X1
          ZR     X4,LRS5     IF *CKS* PARAMETER 
*                            *DIR* PARAMETER
          SB6    B0          COUNTER FOR NUMBER OUTPUT WORDS
          SB7    60          INITIAL BIT POINTER IN OUTPUT WORD 
          SB2    B0          INITIAL WORD COUNT FOR PICKING UP
          SX7    B0          INITIALIZE RESULT WORD 
 LRS1     SA1    ST1+B2      GET DATA WORD
          SB3    60          BIT OFFSET FOR PROCESSING (X1) 
          SB5    B0          60-BIT OFFSET (B3) 
 LRS2     MX0    6           MASK 
          SB4    6           INCREMENT
          LX0    X0,B3       SHIFT MASK TO CORRECT POSITION 
          BX2    X1*X0       GET THE CHARACTER
          LX2    X2,B5       ...TO FIRST CHARACTER POSTION
          ZR     X2,LRS3     IF BINARY ZERO 
          SX3    1R          CREATE A BLANK 
          LX3    54          SHIFT TO UPPER CHAR POSITION 
          BX3    X3-X2
          ZR     X3,LRS3     IF IT IS A BLANK 
          GT     B7,LRS2.1   IF ROOM IN CURRENT WORD
          SA7    SBUF+B6     SAVE CURRENT WORD
          SB6    B6+B1       INCREMENT SAVE WORD POINTER
          SX7    B0          CLEAR X7 
          SB7    60          RESET BYTE SHIFT COUNT IN OUTPUT WORD
 LRS2.1   LX2    X2,B7       SHIFT CHARACTER TO CORRECT SPOT
          BX7    X7+X2       PUT CHARACTER INTO X7
          SB7    B7-B4       SET SHIFT COUNT TO NEXT POSITION 
 LRS3     SB5    B5+B4       INC SHIFT BACK COUNTER AND ... 
          SB3    B3-B4       DECREMENT INPUT BYTE SHIFT FORWARD COUNTER 
          GT     B3,LRS2     IF STILL CHARS TO PROCESS
          SB2    B2+B1       INCREMENT INPUT WORD COUNT 
          SB4    7           END OF LOOP TEST 
          LE     B2,B4,LRS1  IF STILL WORDS TO PROCESS
          SA7    SBUF+B6     SAVE RESIDUAL WORD 
          SX7    B0 
          SB6    B6+B1
          SA7    SBUF+B6
          MESSAGE SBUF+1
          EQ     LRS9        * GO AND WRITE RESULTS 
 LRS5     SA1    =10ARECORDS=    NUMBER OF RECORDS IN FILE
          BX6    X1 
          SA6    SBUF 
          SA1    RN 
          SX2    B1 
          IX1    X1-X2           CORRECT *OFF BY 1* ERROR IN RECORD CNT 
          RJ     CDD
          SA6    SBUF+1 
          SA1    =10ASUM=          NUMBER OF WORDS IN FILE (OCTAL)
          BX6    X1 
          SA6    SBUF+2 
          SA1    RL+2 
          RJ     COD
          SA6    SBUF+3 
          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
          SA5    =6LCKS=            FILE CHECKSUM 
          MX1    24 
          LX1    24 
          BX6    X1*X6
          BX6    X5+X6
          SA6    SBUF+4 
          SA1    FN               NUMBER OF FILES 
          RJ     CDD
          MX1    24 
          LX1    24 
          BX6    X1*X6
          SA1    =6LFILES=              NUMBER OF FILES 
          BX6    X1+X6
          SA6    SBUF+5 
          SX6    B0          PAD WITH ZEROS 
          SA6    SBUF+6 
          MESSAGE SBUF
 LRS9     SX1    SBUF 
          RJ     WOF         WRITE DATA 
          EQ     LRS         RETURN 
  
 SRS      SPACE  4
**        SRS - SAVE RECORD STATUS
  
 SRS      PS                 ENTRY/EXIT 
          SA1    TY          CONVERT TYPE CODE TO LETTERS 
          SA1    SRSA+X1
          SA2    NM 
          BX6    X1 
          BX7    X2 
          SA6    TY2         ALWAYS SAVE CURRENT TYPE IN TY2/NM2
          SA7    NM2
          SA3    FSTREC      GET 1STTIME FLAG 
          NZ     X3,SRS      IF NOT FIRST RECORD
          SA6    TY1         SAVE IN TY1/NM1
          SA7    NM1
          SX6    1           INDICATE HAVE PROCESSED 1ST RECORD 
          SA6    FSTREC 
          EQ     SRS         RETURN 
  
 SRSA     BSS    0
          LOC    0
          CON    10HTEXT
          CON    10HPP
          CON    10H
          CON    10HREL 
          CON    10HOVL 
          CON    10HULIB
          CON    10HOPL 
          CON    10HOPLC
          CON    10HOPLD
          CON    10HABS 
          CON    10HPPU 
          CON    10H
          CON    10H
          CON    10H
          CON    10HCAP 
          CON    10H
          CON    10HPROC
          CON    10H
          CON    10H
          CON    10H
          CON    10HPPL 
          LOC    *O 
 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   10HCHECKING
          DATA   0
 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 
          WRITEC O,X1 
          EQ     WOF         RETURN 
  
          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.
  
  
 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,10 
**        PRS - PRESET PROGRAM. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 4, 5, 6, 7.
*                B - 1, 4, 5, 7.
* 
*         CALLS  ARG, CDT, DXB, ZTB.
* 
*         MACROS ABORT, MESSAGE, OPEN, SETLOF.
  
  
 PRS      PS                 ENTRY/EXIT 
          SB1    1
          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    OP          CHECK *OP* PARAMETER, *CKS* OR *DIR* 
          MX1    18 
          BX1    X5*X1
          SX4    3RDIR
          LX4    42 
          BX4    X4-X1
          ZR     X4,PRS3     IF *DIR* PARAMETER 
          SX4    3RCKS
          LX4    42 
          BX4    X4-X1
          ZR     X4,PRS2.1   IF *CKS* PARAMETER 
          EQ     PRS4        NOT *CKS*, ERROR.
 PRS2.1   SA1    PRSD 
          BX6    X1 
          SA6    FC          SET FILE COUNT TO PROCESS UNTIL EOI
 PRS3     SA1    F           ENTER FILE NAME IN TITLE 
          MX0    42 
          BX1    X0*X1
          RJ     ZTB
          LX6    -6 
          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 
 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 
 OP       ARG    PRSB,OP     OPTION *DIR* OR *CKS*
          ARG 
  
 PRSB     DATA   C* GDIR    ARGUMENT ERROR.*
 PRSC     DATA   C* GDIR    FILE NAME CONFLICT.*
 PRSD     CON    999999 
 PRSG     VFD    12/0,18/FLS,29/0,1/1  AUTO-FLUSH TABLE POINTER 
 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 
          CON    0
          SPACE  4
*         COMMON DECKS. 
  
  
+CALL     COMCARG 
+CALL     COMCCPM 
+CALL     COMCDXB 
+CALL     COMCLFM 
+CALL     COMCSTF 
          SPACE  4
          END   GDIR
*WEOR 
