.title	decnfo
;
;
;	subroutine to return information on a file for directory listings
;
;
;	invocation:
;
;	stat = decnfo(name, date, group, member, protection, eof, free, ftype)
;
;	character name	- zero byte terminated string with file name
;	integer date(2) - quadword for date
;	integer group	- integer for group number
;	integer member	- integer for member number
;	integer protect	- integer to hold protection mask
;	integer eof	- block number containing eof
;	integer free	- first free byte of eof block
;	integer ftype	- file type (ASCII | BINARY)
;
;	function return - OK | ERR
;
;
;	local definitions
;
ok=0			; software tools OK return
err=-3			; software tools ERR return
ascii=12		; software tools ASCII
binary=60		; software tools BINARY
name=4			; ap offset to name of file
date=8			; ap offset to date quadword
group=12
member=16
protection=20
eof=24
free=28
ftype=32
;	local data
;
	.psect	st_decnfo_data	rel,con,gbl,noexe,wrt,rd,pic,noshr,usr,novec,long
xdat:	$xabdat	nxt=xpro
xpro:	$xabpro	nxt=xfhc
xfhc:	$xabfhc
mfab:	$fab	fac=get,-
		fna=buf,-
		shr=<get,upi>,-
		xab=xdat
buf:	.blkb	120
;
;	entry point
;
	.psect	st_pure_code	rel,con,lcl,exe,nowrt,rd,pic,shr,usr,novec,long
	.entry	decnfo	^m<>
	pushal	buf
	pushl	name(ap)
	calls	#2,strcpy	; copy string into buf
	pushal	buf
	calls	#1,upper	; crunch it to upper case
	pushal	buf
	calls	#1,length	; calculate length of string
	movl	r0,r1		; move length to safe place
	$fab_store	fab=mfab,fns=r1	; store length of string
	$open	fab=mfab	; open file to get info
	blbc	r0,error	; low bit clear indicates error
	movq	xab$q_rdt+xdat,@date(ap)	; return revision date
	bneq	gotit
	movq	xab$q_cdt+xdat,@date(ap)	; return creation date
gotit:
	movzwl	xab$w_grp+xpro,@group(ap)	; return group number
	movzwl	xab$w_mbm+xpro,@member(ap)	; return member number
	movzwl	xab$w_pro+xpro,@protection(ap)	; return protection
	movl	xab$l_ebk+xfhc,@eof(ap)		; return eof block
	movzwl	xab$w_ffb+xfhc,@free(ap)	; return free byte
	movl	#ascii,@ftype(ap)		; assume ASCII file
	bitb	#fab$c_var,mfab+fab$b_rfm	; see if variable length recs
	bneq	ischar				; if !=, is ASCII file
	movl	#binary,@ftype(ap)
ischar:
	$close	fab=mfab
	movl	#ok,r0
	ret
error:
	movl	#err,r0
	ret
	.end