.TITLE	IDATE
.IDENT	/2910.2/
;
;
;
;	WRITTEN BY	RAY DI MARCO
;			29-OCT-80.
;
;
;	VERSION		291080/02.
;
;
;
;----------------------------------------------------------------------
;
;
;
; THIS ROUTINE PROVIDES DATE AND CHAINING SUPPORT FOR A FORTRAN
; PROGRAM. THE NUMBER OF PARAMETERS IN THE CALLING SEQUENCE
; DETERMINES THE FUNCTION TO BE PREFORMED. THE CALLING SEQUENCES ARE-
;
;	I	= IDATE (0)
;
;		RETURNS DATE IN BINARY IN R0.
;
;	I	= IDATE (ID,IM,IY)
;
;		RETURNS DATE IN BINARY CORRESPONDING TO DAY,MONTH AND YEAR.
;
;	CALL	IDATE (I,ID,IM,IY)
;
;		RETURNS DAY, MONTH AND YEAR CORRESPONDING TO DATE I.
;
;	CALL	IDATE	(0,0,0,0,0)
;
;		CHAINS TO MENU PROGRAM
;
;
.SBTTL	MODIFICATIONS
;
;
; 7-MAR-81	CORRECTION TO 'IDATE (ID,IM,IY)'

;
;
.SBTTL	DECLARATIONS
;
;
.MCALL	.PUSH,.POP,.DATE,.CHAIN			; MACROS USED
;
.GLOBL	IDATE					; ENTRY
;
;
	.PSECT	CODE				; OPEN CODE SECTION
;	------	----
;
;
.SBTTL	ROUTINE	- 'DATA'	...	USED TO RETURN DATE
;
;
;
IDATE:	CMPB	(R5),#3.			; SPECIAL MODE?
	BEQ	100$				; YES -> 100$
	CMPB	(R5),#4				; SPECIAL MODE
	BEQ	200$				; YES -> 200$
	CMPB	(R5),#5				; SPECIAL MODE
	BEQ	300$				; YES -> 300$
;
	.DATE					; RT-11 DATE -> R0
	BIC	#^C37777,R0			; DISCARD HOB
	.PUSH	R1				; SAVE R1
	CLR	R1				; 0 -> R1
	ASHC	#-5,R0				; YEAR -> R1
	ADD	R1,R0				; TRANSFORNED DATA -> R0
	.POP	R1				; RESTORE
	RETURN					; HOME
;
;
100$:	MOV	@6(R5),R0			; YEAR -> R0
	SUB	#72.,R0				; BASE YEAR = 1972
	ASH	#6,R0				; JUSTIFY
	ADD	@4(R5),R0			; ADD IN MONTH
	ASH	#5,R0				; JUSTIFY
	ADD	@2(R5),R0			; ADD IN DAY
	RETURN					; HOME
;
;
200$:	MOV	@2(R5),R1			; DATE -> R1
	MOV	R1,R0				; DATE -> R0
	BIC	#^C31.,R0			; LEAVE DAY ONLE
	MOV	R0,@4(R5)			; SAVE DAY COUNT
	MOV	R1,R0				; DATE -> R0
	ASH	#-5,R0				; RIGHT JUSTIFY MONTH
	BIC	#^C15.,R0			; LEAVE MONTH COUNT
	MOV	R0,@6(R5)			; SAVE MONTH COUNT
	ASH	#-11.,R1			; RIGHT JUSTIFY YEAR
	BIC	#^C31.,R1			; LEAVE YEAR ONLY
	ADD	#72.,R1				; CONVERT
	MOV	R1,@10(R5)			; SAVE YEAR
	RETURN					; HOME
;
;
300$:	MOV	#FILNME,R0			; SOURCE
	MOV	#500,R1				; DESTINATION
	.REPT	4				; --- 4 WORDS ---
		MOV	(R0)+,(R1)+		; COPY
	.ENDR					; --------------
	.CHAIN					; CHAIN TIME
;
;
FILNME:	.RAD50	/DK RDM   SAV/
;
.END