.TITLE	DAYWEK

;+
; DAYWEK is a fortran callable routine to identify the day of the
; week for a date given in the format dd:mm:yy, and to return the
; day as a string containing the current day of week.  The string
; buffer must be at least 10 bytes long (to store "Wednesday" plus
; a terminating <NULL>).
;
; NOTE:  The date is limited to valid system dates, so the year
;        should not be before 1972 or after 2003.
;
; Input parameters:	month, day, year	(Integer*2)
; Output parameter:	daystr			(10 characters min.)
;
; The calling sequence is:
;	CALL	DAYWEK ( month , day , year , daystr )
;
; Actions:
;	Computes a day count factor that is then divided by the
;	day per week value.  The remainder is then converted to
;	a pointer and the string corresponding to the day of the
;	week name is copied into user's buffer.  On return,
;	R0, R1, R2, and R5 are destroyed.
;
;-

.DAYWE==1

.PSECT	SYS$I	I,LCL,REL,CON

DAYWEK::
	TST	(R5)+
	MOV	@(R5)+,R2	; copy month
	DEC	R2		; make it 0-based
	ASL	R2		; multiply by two for word offset
	MOV	@(R5)+,R1	; copy day
	MOV	@(R5)+,R0	; copy year
	MOV	@R5,R5		; copy address of string buffer
;
	SUB	#72.,R0		; subtract 72 from year
	BIC	#^C37,R0	; make sure there are only 5 bits
	MOV	R0,-(SP)	; save the munged year
	DEC	R0		; decrement munged year
	ASR	R0		; divide it by two
	ASR	R0		; ... by four
	ADD	@SP,R0		; add the munged year to the year/4
	INC	R0		; and increment it
	ADD	R1,R0		; Add that value to the day of month
	BIT	#3,(SP)+	; Is it a multiple of 4 (leap year)?
	BNE	10$		; If not, skip around

; Leap year;  special treatment for months past February

	CMP	#2,R2		; Is the month past February?
	ADC	R0		; If so, add the carry to R0

10$:	ADD	DAYMON(R2),R0	; add the num of days since 1/1 to R0
20$:	SUB	#7,R0		; subtract days per week from R5
	BPL	20$		; and continue until it goes negative
	ASL	R0		; multiply remainder by two
	MOV	DAYMON(R0),R0	; now point to correspondent string
30$:	MOVB	(R0)+,(R5)+	; copy day name to user's buffer
	BNE	30$		;   until <NULL> byte

	RETURN

; Translation and pointer tables

	.WORD	DY5		; Saturday
	.WORD	DY6		; Sunday
	.WORD	DY0		; Monday
	.WORD	DY1		; Tuesday
	.WORD	DY2		; Wednesday
	.WORD	DY3		; Thursday
	.WORD	DY4		; Friday
DAYMON:	.WORD	-1		; January	31 days
	.WORD	30.		; February	28 days
	.WORD	58.		; March		31 days
	.WORD	89.		; April		30 days
	.WORD	119.		; May		31 days
	.WORD	150.		; June		30 days
	.WORD	180.		; July		31 days
	.WORD	211.		; August	31 days
	.WORD	242.		; September	30 days
	.WORD	272.		; October	31 days
	.WORD	303.		; November	30 days
	.WORD	333.		; December	31 days

.nlist	bin
DY0:	.ASCIZ	\Monday\
DY1:	.ASCIZ	\Tuesday\
DY2:	.ASCIZ	\Wednesday\
DY3:	.ASCIZ	\Thursday\
DY4:	.ASCIZ	\Friday\
DY5:	.ASCIZ	\Saturday\
DY6:	.ASCIZ	\Sunday\
.list	bin
	.even

	.END
