;     FILE NAME:  DIRTEST.MAR
;        AUTHOR:  Pulled off USENET    entered by: R.W.MCDOUGALL
; CREATION DATE:  08/06/86
; REVISION DATE:  11/23/86 SWC made callable from high level language
;      LOCATION:  HSTC
;    MAIN FRAME:  VAX 11/780 
;        SYSTEM:  VAX/VMS V4.4
;      LANGUAGE:  VAX MACRO ASSEMBLER
;   DESCRIPTION:  RMS CALL TO CHECK IF A FILE IS A 'Directory File'
;-------------------------------------------------------------------------
	.Title  DirTest - See if a file is a directory
	.Ident  /01.000/
	.Default Displacement,Word
	
	.Library "SYS$LIBRARY:LIB.MLB"	;Get $FCHDEF from here

	.NoCross

	$IODEF 				;Define I/O function codes
	$RMSDEF				;Define RMS status codes
	$SSDEF				;Define system service codes
	$FIBDEF				;Define File Information Block offsets
	$FCHDEF	  			;Define file characteristics bits
	$ATRDEF				;Define file attributes

	.Cross

	.Psect	DATA	NOEXE,RD,WRT,PIC,NOSHR,PAGE

; FAB to open the file

INFAB:		$FAB	FOP=<UFO>,-	;Just open the file for me.
		NAM=NAM			;Need a name block
NAM:		$NAM			;Here it is

; FIB descriptor and FIB

FIB_DESC:	.Long	FIB_END-FIB	;Length of the FIB
		.Address FIB		;Address of the FIB

FIB:		.Long	0		;FIB$L_ACCTL and FIB$B_WSIZE
FID:		.Blkw	3		;FIB$W_FID:  File ID
DID:		.Blkw	3		;FIB$W_DID:  Directory ID
		.Blkl			;FIB$L_WCC:  Wildcard context
		.Word	FIB$M_FINDFID	;FIB$W_NMCTL:  File name control bits
FIB_END:				;Mark the end of the FIB
; Attribute descriptor list
ATTR_LIST:	.Word	ATR$S_UCHAR,ATR$C_UCHAR ;4 byte file characteristics
		.Address UCHAR		;Put 'em here
		.Long	0		;That's all

UCHAR:		.Blkl			;Will receive the file attributes
IOSB:		.Blkq			;I/O status for IO$_ACCESS
IODSB:		.Blkq			;I/O status for IO$_DEACCESS

	.Psect	CODE	EXE,RD,NOWRT,PIC,SHR,PAGE

	.Entry	DIRTEST,0

	$FAB_STORE -			; store the...
		FAB = INFAB,-		; ...filename...
		FNA = @8(AP), -		; ...and filename size...
		FNS = 4(AP)		; ...in the FAB (INFAB)
	$OPEN	FAB=INFAB			;Open the file
	BLBS	R0,11$			;Oh well.
	BRW	10$
; Copy the FID and DID into the FIB (how's that for alphabet soup?)

11$:	MOVL	NAM+NAM$W_FID,FID	;Copy the
	MOVW	NAM+NAM$W_FID+4,FID+4	; FID
	MOVL	NAM+NAM$W_DID,DID	;Copy the
	MOVW	NAM+NAM$W_DID+4,DID+4	; DID
	MOVAL	ATTR_LIST,R1		;Address the attribute control list
	$QIOW_S	CHAN=INFAB+FAB$L_STV,-	;Do some I?O on this channel
		FUNC=#IO$_ACCESS,-	;Access the file
		IOSB=IOSB,-		;I/O status here
		P1=FIB_DESC,-		;Here's the FIB
		P5=R1			;Return these attriutes
	MOVZWL	IOSB,R0			;Get the status from the XQP
	BLBC	R0,10$			;Eeek!
	$dassgn_s	chan=infab+fab$l_stv	;FIX
	BLBC	R0,10$			;Eeek!
	CLRL	R0			;Presume it's not a directory
	BBC	#FCH$V_DIRECTORY,UCHAR,10$ ;Branch if we were correct
	MOVL	#-1,R0			;Else it is.

10$:	RET				;Back to DCL (cleanup done by rundown)
	
	.End