/
/ VERSION 5A 4/28/77  PT
/
	SECT8	DATE
	JA	#ST
	EXTERN	#DATE
#XR,	ORG	.+10
	TEXT	+DATE  +
#RET,
#BASE,	ORG	.+3
MONTH,	ORG	.+3
DAY,	ORG	.+3
YEAR,	ORG	.+3
TEMP,	ORG	.+3
DATADR,	0
	JA	#DATE-1		/ADDRESS OF PS8 DATE WORD
	ORG	10*3+#BASE
	FNOP
	JA	#RET
	0
DRTN,	JA	.
	BASE	0
NEWDAT,	0
	CDF 0
	TAD%	BIPCCL
	AND	BITMSK
	CLL RTR
	RTR
	DCA DATEMP
	CDF CIF 0
	JMP% NEWDAT
BIPCCL,	7777
BITMSK,	600
#ST,	STARTD
	0210
	FSTA	DRTN
	0200
	BASE	#BASE
	SETX	#XR
	SETB	#BASE
	LDX	0,1
	FSTA	#BASE
	FLDA%	#BASE,1+
	FSTA	MONTH
	FLDA%	#BASE,1+
	FSTA	DAY
	FLDA%	#BASE,1+
	FSTA	YEAR
	FLDA%	DATADR		/GET THE PS-8 DATE WORD
	FSTA	TEMP		/SAVE IT
	FCLA
	FSTA	TEMP,0		/ZERO EXPONENT AND HIGH HALF OF MANTISSA
	LDX	10,1		/SHIFT COUNT
	FLDA	TEMP		/GET IT BACK
	ALN	1		/ISOLATE THE MONTH
	ATX	1		/SAVE THE MONTH
	LDX	-4,2		/DAY SHIFT COUNT
	FLDA	TEMP		/GET BACK THE DATE
	ALN	2		/SHIFT MONTH BITS INTO
				/HIGH HALF OF MANTISSA
	FSTA	TEMP		/SAVE THIS
	FCLA
	FSTA	TEMP,0		/ISOLATING DAY/YEAR BITS
	FLDA	TEMP		/GET THEM BACK
	LDX	7,2		/NOW ISOLATE DAY
	ALN	2
	ATX	2		/AND SAVE IT IN 2
	FLDA	TEMP		/GET DAY/YEAR BITS
	LDX	-5,3		/PREPARE TO REMOVE DAY BITS
	ALN	3		/BY SHIFTING THEM INTO HIGH HALF OF MANTISSA
	FSTA	TEMP		/SAVE THEM
	FCLA
	FSTA	TEMP,0		/ZERO DAY BITS
	FLDA	TEMP		/RESTORE YEAR BITS
	LDX	11,3		/SHIFT BACK
	ALN	3
	ATX	3		/PUT THEM INTO XR 3
	TRAP4	NEWDAT
	STARTF			/RE-ENTER F MODE
	XTA	1		/GET MONTH
	FSTA%	MONTH		/RETURN IN ARG
	XTA	2		/NOW DAY
	FSTA%	DAY
	ADDX	3662,3		/MAKE IT + 1970
	ADDX	0,3
	DATEMP=.-1
	XTA	3		/NOW YEAR
	FSTA%	YEAR
	JA	DRTN		/RETURN
	END