C        PROGRAM DIRECT.FT
C        -----------------
C
        SUBROUTINE DIRECT(FFILE,EEXT,IFLAG)
C
C
C
C        P.F.LEMKIN
C        NATIONAL INSTITUTES OF HEALTH
C        BETHESDA,MARYLAND    20014
C
C	APRIL 4, 1972
C	REVISED DECEMBER 5, 1972
C
C
C
C        INTRODUCTION
C        --------
C       "DIRECT" BUILD A STACK OF NAMES IF AN INCOMPLETE FILE NAME OR
C       "*" EXTENSION OR FILE NAME WAS SPECIFIED.
C       THERE ARE THREE  CASES "*.*", "F.*", AND "*.E" .
C	THE ABOVE APPLIES ONLY FOR "SAV"E OR "APP"END COMMANDS.
C	FOR "RES"TORE, AND "COP"Y THE '*' IS COPIED INTO THE STACK AND
C	INTERPRETED AT RUN TIME TO MEAN ALL FILES, EXTENSIONS
C	OR BOTH (F.*, *.E, OR *.*) FROM THE MAGTAPE.
C
C
C
C	ARGUMENTS
C	=========
C	FFILE - THE FILE NAME TO BE MATCHED AGAINST THE DIRECTORY.
C	EEXT  - THE EXTENSION NAME TO BE MATCHED AGAINST THE DIRECTORY.
C	IFLAG - SET BY DIRECT TO 0 IF EITHER FFILE OR EEXT WAS
C		A "*". THIS MEANS THAT SOME FILE NAMES MAY HAVE
C		BEEN PUSHED INTO THE DIRECTORY.
C		IF NEITHER FFILE NOR EEXT WAS A "*", IFLAG=-1.
C
C
C
S        ABSYM  SYSHLR  7607
C
	COMMON IPNT,STACK,RES,SAV,DIR,HEL,APP,ISTACK,COP,LPTDEV
	COMMON SAVEF,KDEV,ITIME,IBUF,MAX,T,IDYLM,IBKNMB,ISTBLK,ICREATION
	DIMENSION FFF(2),III(6),STACK(241,2),IBUF(256),ISTACK(241,6)
	DIMENSION ITIME(2),Q(2),KT(6),IT(3),IDYLM(3)
	EQUIVALENCE (FFF(1),III(1)),(TTT,IT(1)),(KT(1),Q(1))
C
C
C
C        0. INITALIZE
C
	FFF(1)=FFILE
	FFF(2)=EEXT
	ISTBLK=56
	TTT=0
S	TAD (5200 /'*@'
S	DCA \IT /SAVE IT
	T=TTT
	JT=IT(1)
	JF1=III(1)
	JF2=III(4)
	IPSW=-1
C
C
C
C
C
C
C
C
C
C	1.1  TEST IF ANY OF THE CASES HOLD, IF NOT RETURN WITH
C	    THE IFLAG=-1, ELSE SET IFLAG=0 AND CONTINUE.
C	(IF THE EXTENSION WAS "*", THEN JEX=0, ELSE JEX=-1.)
C	(IF THE FILE NAME WAS "*", THEN JFL=0, ELSE JFL=-1.)
	JFL=-1
	JEX=-1
	DO 1021 ITST=1,3
	IF(JF1-JT)101,1021,101
1021	CONTINUE
	JFL=0
101	IF(JF2-JT)102,1022,102
1022	JEX=0
	GOTO 110
C
C
C
C
C	1.1.1.2 TEST IF IT WAS A JFL (*.--) BEFORE GIVE UP.
102	IF(JFL)1023,110,1023
C
C
C
C	1.1.2 NOT A "*" TYPE FILE NAME.
1023	IFLAG=-1
	GOTO 114
C
C
C
C	1.1.3 YES A * TYPE FILE NAME
C	TEST IF IT IS A *.*. IF SO RESET THE STACK TO EMPTY.
110	IF(JFL+JEX)1100,1200,1100
1200	IPNT=1
1100	IFLAG=0
C
C
C
C
C	1.1.4 TEST WHETHER IT IS A "RES"TORE.
C	IF SO, PUSH IT AND RETURN, ELSE CONTINUE
C	THIS WILL LEAVE THE INTERPRETATION OF * UNTIL
C	LATER...
114	IF(SAVEF-RES)115,1101,115
115	IF(SAVEF-COP)1102,1101,1102
1101	CALL PUSH(FFILE,EXTT)
	RETURN
C
C
C
C
C        1.2.1 READ IN THE DIRECTORY
1102	DO 200 I=1,6
S	TAD \I
S	DCA ISB /SET UP THE STARTING BLOCK NUMBER
S        CPAGE 13
S        6202  /CIF 0
S        JMS SYSHLR   /SYSHLR IS THE SYSTEM DEVICE HANDLER
S        0210  /READ 1 BLOCK INTO FIELD 1*
S        \IBUF   /POINTER TO BUFFER WHICH IS IN COMMON
SISB,	0       /START @BLOCK #1
        GOTO 11
        GOTO 20
C
C
C
C	1.2.2 BAD SYS: READ OF THE DIRECTORY.
11        WRITE(KDEV,12)
12        FORMAT('SYS: DIR FAILURE')
	CALL EXIT
C
C
C
C
C
C        2. SEARCH A MAX. OF 6 SEGIMENTS.
C	THE INFORMATION ABOUT SEGMENT ENTRIES IS AT THE BEGINNING
C	AT THE SEGMENT. SEE THE SECTION A-1 ON FILE DIRECTORIES
C	IN THE PS/8 SOFTWARE SUPPORT MANUAL FOR DETAILS.
20      JP=6
	JXX=0
        NENTRY = -IBUF(1)
        NXTSG = IBUF(3)
        NDRWDS = -IBUF(5)
C
C
C
C
C
C	@@PAGE
C					##PAGE 2
C        3. SEARCH "NENTRY" ENTRIES
        DO 300 J=1,NENTRY
C
C
C
C
C        4. TEST FOR ONE OF THE THREE FILE TYPES:
C                1. *.*
C                2. F.*
C                3. *.E
C	JP IS THE POINTER TO THE J'TH FILE NAME IN THE CURRENT
C	SEGMENT. 
C	JXX IS THE INCREMENT FOR THE NEXT FILE NAME POINTER.
        JP=JP+JXX
C
C
C
C
C	4.0.1 COPY IT INTO Q(.)
	DO 401 K=1,4
401	KT(K)=IBUF(K-1+JP)
C
C
C
C
C	4.0.2 TEST IF THE FILE NAME ENTRY IS "EMPTY".
	IF(KT(1))402,403,402
C
C
C
C
C	4.0.2.1 IT IS A PERMANENT ENTRY. UPDATE THE IBKNMB, ICREATION.
402	JXX=5+NDRWDS
	IBKNMB=-IBUF(JP+4+NDRWDS)
	ICREATION=IBUF(JP+4)
	GOTO 1401
C
C
C
C
C	4.0.2.2 IT IS AN EMPTY FILE
403	JXX=2
	IBKNMB=-IBUF(JP+1)
C
C
C
C        4.1.0 IS IT A CASE OF "*.*"?
1401	IF(JFL+JEX)42,412,42
C
C
C
C
C        4.1.1   YES, PUSH  ALL NAMES.
412	GOTO 433
C
C
C
C
C	4.2.0.1 TEST IF IT IS AN EXACT MATCH ON "F.E".
C	IF IT IS A MATCH, GO PUSH IT AND LEAVE...
42	DO 425 JAT=1,4
	IF(KT(JAT)-III(JAT))420,425,420
425	CONTINUE
	CALL PUSH(Q(1),Q(2))
	IPSW=0
	GOTO 100
C
C
C
C
C
C        4.2.0.2 IS IT A CASE OF    F.* ?
420	IF(JEX)43,421,43
C
C
C
C
C
C        4.2.1   YES, F.* IS MATCHED FOR SPECIFIC FILE NAMES FOR
C	ALL EXTENSIONS.
421	DO 424 JAT=1,3
	IF(KT(JAT)-III(JAT))43,424,43
424	CONTINUE
423	GOTO 433
C
C
C
C
C
C        4.3.0 IS IT A CASE OF    *.E ?
43	IF(JFL)300,431,300
C
C
C
C
C        4.3.1.  YES, "*.E" IIS MATCHED FOR A SPECIFIC EXTENSION
C	 FOR ALL FILE NAMES.
431	IF(KT(4)-III(4))300,433,300
433	CONTINUE
	 CALL PUSH(Q(1),Q(2))
	IPSW=0
300        ISTBLK=ISTBLK+IBKNMB
C
C
C
C
C
C        5. NOW CHECK IF DONE, IF NXTSG=0
        IF(NXTSG)200,100,200
200        CONTINUE
C
C
C
C
C	6. CHECK IF NO FILE WA FOUND I.E. NO "*" OR "F.E".
100	IF(IPSW)1998,1999,1998
1998	WRITE(KDEV,1997)(FFF(I),I=1,2)
1997	FORMAT('FILE: ',A6,'.',A2,'  NOT ON SYS:')
1999	RETURN
        END