.title	F77Y2K
	.ident	/RT11NZ/
; Y2K patches for RT-11 Fortran-77; this file contains the revised routines
; IDATE and DATE.

; RT-11 Fortran-77 IDATE routine from F77OTS.OBJ, modified for Y2K.
; It is exactly what was in the OTS except for the Y2K corrections added.
; This routine is also called by DATE, so fixing one helps to fix the other 
; (different from RSX).  Nicholas Zymaris, 14-Feb-1999.
;
	.sbttl	idate
; Calling sequence: CALL IDATE(iday,imonth,iyear)
; Returns: integers for those values; year is 2-digit value, and when >99
; it causes DATE to give the familiar 1-JAN-:0 error and obliterates the month
; and year entirely from 2004. on (with idate's year also screwed up).  This
; has been corrected so that a correct 2-digit year is returned to user
; programs as well as to DATE.  Include this file before F77OTS when linking,
; if using either DATE or IDATE.
;
; N.B. It will return 0-99. for the year from 2000. on, unlike the 100-199. of
; the GTIM$ values in RSX.  But one can always use DATE4 to see what century
; it is.
;
; Bug: DATE will think it is back in the 20th century from 2073. on, due to
; the "quick hack" nature of this fix.  There's time to fix it, though; I'd
; hate to muck up the tight code too much with excessive patching.
;
; IDATE will be fine through 2099. A.D.

	.enabl	lsb
idate::	cmpb	#000003,(r5)	; Exactly 3 arguments?
	beq	1$		; Yes, continue
	trap	320		; No, give OTS error
	br	3$		; And continue, skipping routine (non-fatal)
1$:	cmp	-(sp),-(sp)	; Generate parameter block on stack
	mov	sp,r0		; Pointer to this block
	mov	#10400,(r0)	; Set up sys call
	mov	sp,2(r0)
	emt	375		; Do it
	cmp	(sp)+,(sp)+	; Restore stack
	mov	#5000,r0
	emt	374		; .DATE
	mov	#177740,r3	; To mask out all but year
	mov	r0,r2		; Get date word
	beq	2$		; No date? Then don't mask & add offset
	bic	r3,r2		; Isolate year (without epoch bits)
	mov	r0,-(sp)
	bic	#^C140000,r0	; Isolate epoch bits
	swab	r0
	asr	r0		; Shift into place
	add	r0,r2		; And add to year (=years since 1972)
	mov	(sp)+,r0	; Restore R0 for rest of calculations
	bic	#140000,r0	; and make sure epoch bits don't screw it up
	add	#110,r2		; Offset from (19)72.
	cmp	r2,#100.	; Is it 2000. yet?
	blo	2$		; Nope, year is OK
	sub	#100.,r2	; 21st century; fix year through 2099	
2$:	asr	r0		; Calculate month & day...
	asr	r0
	movb	r0,r1
	asr	r1
	asr	r1
	asr	r1
	bic	r3,r1
	swab	r0
	bic	r3,r0
	cmp	(r5)+,r0	; Point to first arg. to return to F77 prog...
	mov	r0,@(r5)+	; month...
	mov	r1,@(r5)+	; day...
	mov	r2,@(r5)+	; year.
3$:	rts	pc		; All done, return.
	.dsabl	lsb

	.sbttl	date
; The RT-11 DATE routine from F77OTS.OBJ, with 4-digit code added.  Uses
; different method than RSX version; relies on IDATE Y2K fix since, unlike the
; RSX version, it calls IDATE to get the date.
;
; Calling sequence:
;
; CHARACTER*9  c
; CHARACTER*11 c4
; CALL DATE(c)		! standard Fortran (e.g. c  -> "14-FEB-99")
; (or)
; CALL DATE4(c4)	! patched Fortran  (e.g. c4 -> "14-FEB-1999")

	.enabl	lsb
date4::	mov	#4,y4		; Indicate 4-digit output wanted
	br	datcom
date::	clr	y4		; only 2 digits to be output
datcom:	cmpb	#1,(r5)		; Common code: check for correct # args
	beq	1$		; Skip trap if so
	trap	320		; Give OTS error
	br	4$ 		; and return since it is nonfatal
1$:	cmp	(r5)+,r0 	; discard the count, knowing it is OK
	mov	(r5),r0		; addr of string to put date into
	tst	-(sp)		; Make arg list to pass to idate
	mov	sp,(sp)		; a place for the year...
	tst	-(sp)
	mov	sp,(sp)		; ...the day...
	tst	-(sp)
	mov	sp,(sp)		; ...and the month.
	mov	#3,-(sp)	; 3 arguments
	mov	sp,r5		; The usual R5 calling sequence
	mov	r0,-(sp)	; Preserve R0 across call...
	jsr	pc,idate	; Get month, day, year (now Y2K-patched)
	mov	(sp)+,r0	; ...Restore R0
	tst	(sp)+		; Eat arg count
	mov	(sp),r1		; Get month
	bne	2$		; Null month? (assume it means null date)
	mov	#10,(sp)	; If so, replace with an 8
6$:	movb	#40,(r0)+	; And output a space...
	dec	(sp)		; Aha!  The SOB! (but without using EIS... ;-)
	bgt	6$		; Just a DEC-ey way of outputting 9 spaces...
	movb	#40,(r0)	; For the null date
	add	#6,sp		; Clean up rest of stack
	br	4$		; And return
2$:	asl	r1		; We have a good month; *2
	add	(sp)+,r1	; *3 (same deal as with RSX version of this)
	mov	(sp)+,r2	; Get day
	jsr	pc,3$		; Convert & output it
	movb	#55,(r0)+	; hyphen
	add	#<months-3>,r1	; offset to month table
	movb	(r1)+,(r0)+	; output the month...
	movb	(r1)+,(r0)+
	movb	(r1)+,(r0)+
	movb	#55,(r0)+	; hyphen
	mov	(sp)+,r2	; get the (2-digit) year
	tst	y4		; How many digits to print?
	beq	3$		; Only 2
	mov	r2,-(sp)	; Save low two digits of year
	mov	#19.,r2		; 1900's, unless ...
	cmp	(sp),#72.	; 0-72. = 21st century (1972. dealt w/ above)
	bhi	7$		; Still 20th century, don't increment century
	inc	r2		; 21st century
7$:	jsr	pc,3$		; Output high two digits of year
	mov	(sp)+,r2	; Restore low two digits of year
3$:	swab	r2		; And output them
5$:	add	#173001,r2	; .byte 1,-10. ... gotta love the tight coding
	bpl	5$		; subtract 10.'s & count 'em in low byte
	add	#35057,r2	; hi := hi+ord("9")+1, lo := lo + ord ("0")-1
	movb	r2,(r0)+	; output low byte (tens)
	swab	r2
	movb	r2,(r0)+	; output high byte (ones)
4$:	rts	pc
months:	.ascii	/JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC/
y4:	.blkw	1		; flag for 2- or 4-digit output
	.end