.TITLE	FILEINFO_MAR fix file header program
;          *************************************************************
;          *                                                           *
;          *     FILEINFO - Vicki Woolf fix file header program       *
;          *                                                           *
;          *************************************************************


;  VICKI W. WOOLF
;  PROGRAM OF COMPUTER GRAPHICS - CORNELL UNIVERSITY
;  120 RAND HALL   ITHACA    NEW YORK  14853   (607)  256-7444
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;	VW$GET_FID
;
;	DESCRIPTION:	VW$GET_FID accepts a filename and returns
;				  the full name specification, plus
;				  the file id
;			
;
;	ARGUMENTS:	4(AP)	ptr to buffer for FAB,XABs,and NAM
;				blocks.
;			8(AP)	filename (character descriptor)
;			12(AP)	resultant string
;			16(AP)	directory id (3-word array)
;			20(AP)	file id (3-word array)
;				
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

	$dscdef
	$fabdef
	$xabdef
	$xabfhcdef
	$namdef
		
.MACRO	ARGUMENTS	LIST,CHECK=YES,?L1
	$$$ARGUMENTS = 0
	.IRP	ARG,<LIST>
		$$$ARGUMENTS = $$$ARGUMENTS + 4
		ARG = $$$ARGUMENTS
	.ENDR
	$$$ARGUMENTS = $$$ARGUMENTS / 4
	.IF IDENTICAL CHECK,YES
		.IIF GE $$$ARGUMENTS-256, .ERROR $$$ARGUMENTS ; too many args
		CMPB	(AP),#$$$ARGUMENTS
		BEQLU	L1
		MOVL	#SS$_INSFARG,R0
		RET
		L1:
	.ENDC
.ENDM


	arguments    < -
			buffer, -
			filename, -
			full_filename, -
			fullfile_len, -
			directory_id, -
			file_id -
			>



	.psect	vw$getfid_code	exe,rd,nowrt,rel,gbl,con,noshr,nopic
vw$get_fid::	.word	^m<r2,r3,r4,r5,r6,r7>


; validate file descriptor---(from tc$map_file)
;	is file name a string descriptor?
;	start_block > 0
;	num_blocks > 0

10$:	movaq	@filename(ap),r7	; get addr of string descriptor
	cmpb	dsc$b_dtype(r7),-	; correct type?
	#dsc$k_dtype_t
	beqlu	15$			; if negu,no

	movzwl	#99,r0	;
	brw	99$


15$:	movl	buffer(ap),r6		; get addr of fab_buffer_area
	movl	r6,r5			; calculate beginning of name block
	addl 	#fab$k_bln,r5		; buffer area
	$fab_store		-	;
		fab=r6		-	; store filespec and name block
		fna=@dsc$a_pointer(r7)-	; address in FAB.
		fns=dsc$w_length(r7)  -	;
		nam = (r5)
	movb	#fab$c_bid,fab$b_bid(r6); store FAB identifier in FAB.
	movb	#fab$k_bln,fab$b_bln(r6); store FAB length in FAB.
	movl 	r5,r0			; move ptr to name block to r0
	movaq	@full_filename(ap),r7	; point R7 at buffer for resultant
					; string
	$nam_store -			;
		esa = @dsc$a_pointer(r7) -
		ess = dsc$w_length(r7) -; store name block info.
		bln = #nam$k_bln -
		bid = #nam$c_bid 
60$:	$PARSE	fab=(r6)		; parse name string - gets full spec
	blbc	r0,99$			;
	movb	nam$b_esl(r5),@fullfile_len(ap); return length of filespec.
	$SEARCH fab=(r6)		; search - get fid and did
	blbc	r0,99$
	movl	directory_id(ap),r4
	movw	nam$w_did_num(r5),(r4)
	movw	nam$w_did_seq(r5),2(r4)
	movw	nam$w_did_rvn(r5),4(r4)	;  there's a better way, but for now
	movl	file_id(ap),r4
	movw	nam$w_fid_num(r5),(r4)
	movw	nam$w_fid_seq(r5),2(r4)
	movw	nam$w_fid_rvn(r5),4(r4)
	movl	#1,r0			; successful.
	ret

99$:	ret				; failure

	.end