.TITLE  FILATR  File Attributes

; This program will get file attributes of a specified file.
; Currently it gets the size and date of a file.
; It is called as follows:
;
;            CALL FILATR( FILENAME, ITMLST)
;
; FILENAME - Character string containing the file specification of the
;            file to get information about.  Passed by descriptor
;            (Fortran default).
;
; ITMLST   - Item list specifying which information about the device is to 
;            be returned.  The itmlst argument is the address of a list of
;            item descriptors, each of which describes an item of information.
;            The list of item descriptors is terminated by a longword 0.  The
;            following diagram depicts the format of a single item descriptor.
;
;            ---------------------------------------------------------
;            |        item code          |      buffer length        |
;            ---------------------------------------------------------
;            |                   buffer address                      |
;            ---------------------------------------------------------
;            |               return length address                   |
;            ---------------------------------------------------------
;
;            The address of the item list is passed by reference.  The item
;            list is constructed as a standard VMS item_list_3 itmlst.
;
;  buffer length - length (in bytes) of buffer
;
;  item code     - 1 = get file size (EOF)
;                - 2 = get file date (CDT)
;                - 3 = get file size (ALQ)
;
;  buffer address - address of buffer to write information
;
;  return length address - address to write the length (in bytes) of information
;                          returned in the buffer.
;
;Comments
;  EOF:  The file size returned is the number of blocks used.
;  CDT:  The date is returned as an ASCII string of the form
;         dd-mmm-yyyy hh:mm:ss.cc .  The full length is 23 characters.  If 
;         the user's buffer is less than 23 characters the date will be 
;         truncated.  If the user's buffer is longer than 23 characters, the
;         remaining characters are padded with blanks.
;  ALQ:  The file size returned is the number of blocks allocated.
;
;  Jim Balster 27-APR-1989 Add ALQ
;  David Deley  September, 1987
;

	.PSECT	DATA	WRT,NOEXE
	
	.DISABLE	GLOBAL
	$DSCDEF
	$RMSDEF
	$SSDEF

ERROR=2					;Error status message
DATLEN=23				;Length of date dd-mmm-yyyy hh:mm:ss.cc

INFAB:		$FAB -			;FILE ACCESS BLOCK
		FAC = <GET>,-		;Access types
		SHR = <GET,PUT,UPD,DEL>-;Allow read/write sharing
		XAB = INXAB1		;Extended access block
INXAB1:		$XABFHC -		;File header characteristics
		NXT = INXAB2		;Next xab is INXAB2
INXAB2:		$XABDAT			;Date/time XAB

FILE_SIZE:	.BLKL	1		;File size
FILE_SIZE_A:    .ADDRESS  FILE_SIZE	;Address of file size
FILE_DATE:	.BLKQ	0		;File creation date
FILE_DATE_A:	.ADDRESS  FILE_DATE	;Address of expiration file_date
FILDAT_STR:	.BLKB	DATLEN		;File date string
FILDAT_STRD:	.WORD	DATLEN		;File date string descriptor
		.BYTE	DSC$K_DTYPE_T
		.BYTE	DSC$K_CLASS_S
		.ADDRESS  FILDAT_STR

;----------------------------------------------------------------------
; call FILATR( filename,ITMLST)

	.PSECT	CODE,NOWRT,EXE
	.ENTRY	   FILATR,^M<R2,R3,R4,R5,R9>

	MOVL	   4(AP),R0		  ;Move file name descriptor address to R0
	MOVB	   (R0),INFAB+FAB$B_FNS	  ;Move file name size to FAB
	MOVL	   4(R0),INFAB+FAB$L_FNA  ;Move file name address to FAB

OPEN:	$OPEN	   FAB=INFAB		;Open data.dat file
	BLBS	   R0,CLOSE		;Branch if OK
	RET				;Else return with error status in R0

CLOSE:	$CLOSE	  FAB=INFAB		;Close input
	BLBS	  R0,INIT		;Branch if OK
	RET				;Else return with error status in R0

INIT:	MOVL	8(AP),R9		;Initialize.  Move address of start of itmlst to R9
	BNEQ	DOITM			;If code not zero then do it
	RET				;Else return, nothing to do

DOITM:	MOVZWL	2(R9), R2		;Get item code
	CASEL	R2, #1, #2		;Case item code
1$:	.WORD	GETSIZ-1$,-		; 1 = return file EOF
		GETDAT-1$,-		; 2 = return file CDT
		GETSIZ-1$		; 3 = return file ALQ
	MOVL	#ERROR,R0		;Illegal item code, put error status in R0
	BRW	NXTITM			; and continue to next item.

; For the following code sections the address of the itemblock is in R9.

GETSIZ:	CMPB	#1,R2			;EOF or ALQ?
	BEQL	EOF
	MOVL	INXAB1+XAB$L_HBK,@4(R9) ;Move file size to location specified in R2
	BRB	SIZ$
EOF:	MOVL	INXAB1+XAB$L_EBK,@4(R9) ;Move file size to location specified in R2
SIZ$:	TSTW	INXAB1+XAB$W_FFB	;First free byte = 0?
	BNEQ	NXTITM			;If not, EBK = Blocks in use.
	DECL	@4(R9)			;Else don't count last block
	TSTL	8(R9)			;See if there is a return address for the length
	BEQL	NXTITM			;Branch if RETADR = 0
	MOVL	#4,@8(R9)		;Else size returned was one longword
	BRW	NXTITM			;Process next item in item list

GETDAT:	$ASCTIM_S -			;Convert binary time to ASCII string
		timbuf=FILDAT_STRD, -
		timadr=INXAB2+XAB$Q_CDT
	BNEQ	10$			;Branch if no error
	BRW	NXTITM			; else leave error status in R0 and get next item
10$:	MOVZWL	(R9), R3		;Move str-dst len to R3
	MOVC5	#DATLEN, -		;Move date to user's string
		FILDAT_STR, -
		#^A" ", -
		R3, -
		@4(R9)
	TSTL	8(R9)			;See if there is a return address for the length
	BEQL	NXTITM			;Branch if RETADR = 0
	SUBL3	R0,#DATLEN,@8(R9)	;Size returned
	BRW	NXTITM			;Get next item in itemlist

;End of item code sections.  Now prepare for next item in itemlist.

NXTITM:
	ADDL2	#12,R9			;Move address pointer to next item block
	TSTL	(R9)			;0 if at end of item list
	BNEQ	DOITM			;Do next item if not at end of list yet.
	MOVL	#SS$_NORMAL, R0		;Else move normal status to R0
	RET				;and return
	
	.END