.TITLE	DIRSFD - SET FILE DATES (REV/CRE/EXP)
	.IDENT	/21MAR82/
	.ENABL	GBL
;
;+
;*****
;
;	DIRSFD.MAC - DETERMINES NEW FILE DATE BASED ON DATE
;	 STRING ENTERED WITH THE "/SETEXPIRATION:", "/SETCREATION:",
;	 OR "/SETREVISION:"  SWITCHES SUPPORTED UNDER THE "DIR" COMMAND.
;
;	 THIS MODULE ASSUMES THE FILE HEADER IS CONTAINED IN 256 WORD
;	 BUFFER AT HDBUF$, WITH THE WRITE ATTRIBUTES QIO SETUP TO
;	 POINT TO CORRECT FILE ID ASSOCIATED WITH THE HEADER.
;	 ALSO MUST HAVE VALID 7 BYTE DATE STRING (NO '-' SEPARATORS)
;	 AT "SDBUF$" IN ASCII FORMAT.
;
;	PAUL SORENSON
;	PULMONARY RESEARCH
;	S3, MAYO CLINIC
;	ROCHESTER, MN 55904
;
;*****
;
;	UPDATE 3/21/82 -- PRS; ORIGINAL EDIT
;
;	UPDATE 4/11/82 -- PRS; EXTEND TO ALLOW SETTING CREATION AND REVISION
;		DATES AS WELL AS EXPIRATION DATES
;
;*****
;-
;
	.MCALL	DIR$,WTSE$S,FHDOF$,QIOW$S

	FHDOF$	DEF$L		;DEFINE FILE HEADER SYMBOLIC OFFSETS

	.PSECT	$CODE1,RO,I,LCL,CON,REL
;
.DRSFD::
	MOV	R0,-(SP)	;SAVE SOME REGISTERS
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	#SDBUF$,R1	;FETCH POINTER TO DESIRED DATE
	TSTB	(R1)		;ANYTHING THERE ?
	BEQ	50$		;BRANCH IF NO, SIMPLE EXIT
10$:
	MOVB	HDBUF$+H.IDOF,R0	;FETCH WORD OFFSET TO ID AREA
	ASL	R0			;MAKE IT BYTE OFFSET
	ADD	#HDBUF$+I.RVNO,R0	;ADD IN BUFFER START ADDRESS + OFFSET
					; TO REV #
	MOV	WRITHD+Q.IOPL+2,R2	;FETCH ADDRESS OF ATTRIBUTE LIST
	ADD	#2,R2			;OFFSET TO POINTER WORD
	MOV	R0,R2			;SET TO POINT TO REV #
	BIT	#SCDSW,SWMS2$		;SETTING CREATION DATE ?
	BEQ	15$			;BRANCH IF NO
	ADD	#<I.CRDT-I.RVNO>,R0	;ADJUST OFFSET TO CREATION DATE
	BR	20$			;DO IT
15$:	BIT	#SRDSW,SWMS2$		;SETTING REVISION DATE ?
	BEQ	18$			;BRANCH IF NO
	ADD	#<I.RVDT-I.RVNO>,R0	;ADJUST OFFSET TO REVISION DATE
	BR	20$			;DO IT
18$:	BIT	#SEDSW,SWMS2$		;SETTING EXPIRATION DATE ?
	BEQ	50$			;BRANCH IF NO, DONE
	ADD	#<I.EXDT-I.RVNO>,R0	;ADJUST OFFSET TO EXPIRATION DATE
20$:
	MOV	#7.,R2			;COPY 7 CHARACTERS
22$:	MOVB	(R1)+,(R0)+
	SOB	R2,22$
25$:	DIR$	#WRITHD			;WRITE THE NEW HEADER
	BCC	30$			;BRANCH IF DIRECTIVE ACCEPTED
	CALL	$ALERR
	BR	25$
30$:
	WTSE$S	#DSKEFN			;WAIT FOR COMPLETION
	CMPB	IOSB$,#IS.SUC		;SUCCESS ?
	BEQ	50$			;BRANCH IF YES
	CMP	IOSB$,#IE.SQC		; FID/SEQ # ERROR ?
	BNE	35$			;BRANCH IF NO
	DIAG	SQCHK			;ISSUE DIAGNOSTIC
	BR	45$
35$:	CMP	IOSB$,#IE.PRI		;PRIVILEGE ERROR ?
	BNE	40$			;BRANCH IF NO
	DIAG	HDPRV			;ISSUE DIAGNOSTIC
	BR	45$
40$:	DIAG	HDWR			;ISSUE DIAGNOSTIC
45$:	SEC				;SHOW PROBLEMS IN CARRY BIT
	BR	51$
50$:
	CLC				;SHOW SUCCESS IN CARRY BIT
51$:	MOV	(SP)+,R2		;RESTORE REGISTERS
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RETURN
	.END	;.DREXD