.TITLE	DIR

;This subroutine is part of the DEFAULT package.

;Author:	Dr. David J. SLATER
;		ManTech International
;		2320 Mill Road
;		Alexandria, VA 22314
;		(703) 838-5600

	.SBTTL RMS DECLARATIONS
	.PSECT RMS_VARS
	$RMSDEF
SAVE_FAB:
	$FAB	FNM=<T.DAT.*>,-
		NAM=NAM
SAVE_NAM:
	$NAM	ESA=EX_STR_AREA,-
		ESS=255,-
		RSA=RES_STR_AREA,-
		RSS=255
	.SBTTL BUFFERS
	.PSECT BUFFERS

FAB:
	.BLKB	300

NAM:
	.BLKB	300


EX_STR_AREA:
	.BLKB	255
RES_STR_AREA:
	.BLKB	255

DIRECTORY_NAME:
	.BLKB	64

STAR_POINT_DIR:
	.ASCII	/*.DIR/


	.SBTTL	PROGRAM
	.PSECT	PROGRAM

	.ENTRY	DIR,^M<R10,R9,R7>

	;SET UP FAB

	MOVC3	#FAB$K_BLN,SAVE_FAB,FAB
	MOVAL	DIRECTORY_NAME,FAB+FAB$L_FNA
	
	;SET UP NAM

	MOVC3	#NAM$K_BLN,SAVE_NAM,NAM

	;PUT FILE NAME IN FAB

	MOVL	4(AP),R10		;ADDRESS OF DIRECTORY DESCRIPTOR
	MOVZWL	0(R10),R9		;LENGTH
	LOCC	#^A/ /,R9,@4(R10)
	SUBL2	R0,R9
	MOVC3	R9,@4(R10),DIRECTORY_NAME
	MOVC3	#5,STAR_POINT_DIR,DIRECTORY_NAME(R9)
	ADDL3	#5,R9,FAB+FAB$B_FNS	;SET UP FILE LENGTH

;	PARSE (SET UP FOR SEARCH)


	$PARSE	FAB=FAB

;	SET UP ADDRESSING FOR FORTRAN CHARACTER ARRAY

	MOVL	8(AP),R10
	MOVZWL	0(R10),R9
	MOVL	4(R10),R7

SEARCH:
	$SEARCH	FAB=FAB
	
	CMPL	R0,#RMS$_NORMAL
	BEQLU	10$
	JMP	ERROR_CHECK

10$:

;	MOVE NAME INTO ARRAY

	MOVZBW	NAM+NAM$B_RSL,R8

	MOVC5	R8,RES_STR_AREA,#^A/ /,R9,0(R7)

	ADDL2	R9,R7
	MOVB	#^A/ /,0(R7)
	BRW	SEARCH

	.SUBTITLE	ERROR_CHECK

ERROR_CHECK:

	CMPL	R0,#RMS$_NMF		;NO MORE FILES
	BNEQU	20$
	MOVL	#4,R0
	RET

20$:
	MOVL	#RMS$_NORMAL,R0
	RET
	.END