C        PROGRAM MDIRECT.FT
C        -----------------
C
        SUBROUTINE MDIRECT(KDEVICE,KFILE,NSTACK,NPTR)
C
C
C
C        P.F.LEMKIN
C        NATIONAL INSTITUTES OF HEALTH
C        BETHESDA,MARYLAND    20014
C
C	AUG 12, 1976 - ADDED QUESTION
C	AUG 11, 1976
C	AUG 10, 1976
C	AUGUST 4, 1976
C
C
C
C        INTRODUCTION
C        --------
C       "MDIRECT" 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	ENTRIES ARE PUSHED AS 4 WORD FIELDS (FILE&EXT) ONTO "NSTACK"
C	WITH THE NUMBER OF ENTRIES RETURNED IN ARGUMENT "NPTR".
C
C
C
C	ARGUMENTS
C	=========
C	KDEVICE - THE OS8 FILE STRUCTURED DEVICE TO BE SEARCHED
C	KFILE[1:4] - THE FILE NAME TO BE MATCHED AGAINST
C			 THE DIRECTORY.
C	NSTACK[1:964] - THE 241X4 ENTRY STACK OF FILE NAMES 
C			SUCCESSFULLY MATCHED
C	NPTR - THE NUMBER OF ENTRIES IN NSTACK.
C
C
C	.COMPILE MDIRECT.RL < MDIRECT.FT
C
C
C	SABER OPDEFS
C	------------
S	OPDEF TADI 1400
S	OPDEF DCAI 3400
S	OPDEF MQL 7421
S	OPDEF MQA 7501
C
C
C
C
	DIMENSION IPATTERN(4), III(4), IBUF(256), JFILE(4), IT(4)
	EQUIVALENCE (III(4),IEXT), (JFILE(4),JEXT)
	EQUIVALENCE (IPATTERN(4),IPEXT)
C
C
C
C        [1] INITALIZE
C
C	ZERO THE STACK
S	TAD \NSTACK# /SAVE PTR
S	DCA \J
	DO 99 I=1,964
S	DCA I \NSTACK
S	INC \NSTACK#
99	CONTINUE
S	TAD \J /RESTORE PTR
S	DCA \NSTACK#
	NPTR=0
C
	ISTBLK=56
S	TAD (5200 /'*@'
S	DCA \ISTAR /SAVE IT
C
C	COPY THE FILE NAME TO LOCAL ARRAY
	DO 100 I=1,4
	J=KFILE
S	INC \KFILE#
100	III(I)=J
C
C	[1.1] TEST IF NAME IS NULL THEN RETURN IMMEDIATEDLY
S	TAD \III /FIRST 2 CHARS
S	SZA CLA
S	JMP \104 /NON-NULL
	RETURN
C
C
C	[1.2]  TEST IF ANY OF THE CASES HOLD, IF NOT RETURN WITH
C	(IF THE EXTENSION WAS "*", THEN JEX=1, ELSE JEX=0.)
C	(IF THE FILE NAME WAS "*", THEN JFIRST=1, ELSE JFIRST=0.)
104	JFIRST=0
	JEX=0
C
	IF (III-ISTAR)101,102,101
102	JFIRST=1
C
101	IF (IEXT-ISTAR)200,103,200
103	JEX=1
C
C
C
C        [2] READ IN THE DIRECTORY FROM DIRECTORY DEVICE
C	FETCH THE HANDLER
200	LDEVICE=KDEVICE
	IF (MIO(LDEVICE,0,0,15)) 210,201,210
C
201	DO 299 MSEGMENT=1,6
C
C	[2.1] SET PTR TO NEXT DIRECTORY SEG BLOCK
	IF (MIO(MSEGMENT,0,0,10)) 210,202,210
C
C	READ IN SEG BLOCK
202	IF (MIO(1,IBUF,0,6)) 210,220,210
C
C
C
C	[2.1.1] BAD DEV: READ OF THE DIRECTORY.
210        WRITE(1,211)
211        FORMAT('DEV: DIR FAILURE')
	CALL EXIT
C
C
C        [2.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 OS/8 SOFTWARE SUPPORT MANUAL FOR DETAILS.
220      JP=6
	JXX=0
C
C	GET THE # ENTRIES IN THIS SEGMENT
        NENTRY = -IBUF
C
C	GET THE NEXT SEGMENT EXISTS SWITCH (EXISTS IF .NEQ.0 )
        NXTSG = IBUF(3)
C
C
C	GET THE NUMBER OF ADDITIONAL ENTRY WORDS (DATE ETC)/ENTRY
        NDRWDS = -IBUF(5)
C
C
C
C
C
C        [2.2.1]. SEARCH "NENTRY" ENTRIES
        DO 288 JENTRY=1,NENTRY
C
C
C        [2.2.2] TEST FOR ONE OF THE FOUR FILE TYPES:
C                1. *.*
C                2. F.*
C                3. *.E
C		 4. F.E
C
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	[2.2.3] COPY DIRECTORY ENTRY IBUF[JP:JP+4] INTO JFILE[1:4].
S	CLA CMA /-1 FOR AUTOINDEX
S	TAD PJFILE /PTR TO \JFILE
S	DCA 12
S	CLA CMA /-1 FOR AUTOINDEX
S	TAD (-1 /FOR (JP-1)
S	TAD \JP
S	TAD PIBUF /PTR TO IBUF(JP)
S	DCA 11
C
	DO 221 K=1,4
C	**** 	JFILE(K)=IBUF(K-1+JP)
S	TADI 11 /IBUF(K-1+JP)
S	DCAI 12 /JFILE(K)
221	CONTINUE
C
C
C	[2.2.4] TEST IF THE FILE NAME ENTRY IS "EMPTY" (=0).
	IF (JFILE)222,223,222
C
C
C
C
C	[2.2.5] IT IS A PERMANENT ENTRY. UPDATE THE IBKNMB, ICREATION.
222	JXX=5+NDRWDS
C	****NOTE: GET THE NUMBER OF BLOCKS IN FILE BUT NOT USED
	GOTO 224
C
C
C
C	[2.2.6] IT IS AN EMPTY FILE, RESET PTR AND GET NEXT ENTRY.
223	JXX=2
	GOTO 288
C
C
C        [2.2.7] IF IS IT A CASE OF "*.*" 
C		THEN PUSH ALL NAMES AT [2.2.12]
224	IF (JFIRST+JEX - 2)228,234,228
C
C
C        [2.2.8] NOT *.*.  FILL IN "?" CHARS IN THE PATTERN (III)
C	FROM CORRESPONDING CHARS IN
C	THE INSTANCE (IBUF(JP:JP+4)) BEFORE CONTINUEING.
C	 IS IT A CASE OF    F.* ?
228	CONTINUE
	CALL QUESTION(III,JFILE,IPATTERN)
C
C
C	[2.2.9] CHECK F.-  . IF *.- THEN GO CHECK E ELSE CHECK F.
	IF(JFIRST-1)229,232,229
C
C	CHECK F.
S \229,	CLA CMA
S	TAD PJFILE
S	DCA 11 /AUTO INDEX PTR TO JFILE
C
S	CLA CMA
S	TAD PIPATTERN
S	DCA 12 /AUTOINDEX PTR TO IPATTERN
C
	DO 230 I=1,3
S	TADI 11 /JFILE(I)
S	CIA
S	TADI 12 /IPATTERN(I)
S	SZA CLA
S	JMP \288 /NO MATCH ON F.
230	CONTINUE
C	FALL THROUGH IF F. IS OK.
C
C
C	[2.2.10] CHECK E.  IF -.* THEN STACK IT ELSE CHECK E.
C		THEN  GO STACK IT AT [2.2.12].
232	CONTINUE
	IF(JEX-1)233,234,233
C
C
C       [2.2.11]   TEST IF .E MATCHES THEN CASE OF *.E.
233	CONTINUE
	IF (IPEXT-JEXT)288,234,288
C
C
C	[2.2.12] STACK THE ENTRY
S \234,	JMS STACKIT
C
C
C	[2.2.13] COMPUTE THE ABSOLUTE BLOCK POINTER (***NOT USED ***)
288	ISTBLK=ISTBLK+IBKNMB
C
C
C       [2.3] NOW CHECK IF DONE, IF NXTSG=0
        IF (NXTSG)299,300,299
299        CONTINUE
C
C	[3] DONE, RETURN
300	RETURN
C	*********************************************
C	*SUBROUTINE     S T A C K I T
C	*********************************************
C	PUSH JFILE[1:4]==>NSTACK AND INCR NPTR;
C
S	CPAGE 3
S RSTACKIT,	JMP I STACKIT
S STACKIT,	0 /ENTRY
S	CLA CMA
S	TAD PJFILE
S	DCA 11 /AUTO INDEX PTR TO JFILE
C
	DO 1800 I=1,4
C	PUSH INTO STACK SUPPLIED WITH CALL
S	TAD I 11
S	DCA \JTEMP
	NSTACK=JTEMP
S	INC \NSTAC# /FIX UP THE PTR
1800	CONTINUE
C
	NPTR=NPTR+1
C
C	TEST IF NPTR>240 (MAX NUMBER FILES AND STACK SIZE)
	IF(NPTR-240)1801,1801,1802
C
C	OVERFLOW ERROR PRINT MESSAGE AND SALVALGE THE STACK
1802	WRITE(1,1803)
1803	FORMAT('DIRECT "*" OVERFLOW')
	NPTR=240
	RETURN
S\1801,	JMP RSTACKIT
C
C
C
C	******POINTERS*****
S PIBUF,	\IBUF
S PIPATTERN,	\IPATTERN
S PIII,	\III
S PJFILE,	\JFILE
        END
 