.TITLE	DATE
	.VERSION	1
/ +++
/
/ DATE Y1A
/
/ (c) 1990 by Johnny Billquist
/ All rights reserved
/
/ Id.  Programmer
/ BQT  Johnny Billquist
/
/ Ver  Date               By   Comment
/ Y1A  2-May-1990 01:00   BQT  Initial coding
/
/ ---
	.ENTRY	$BDATD	/ Binary date to decimal.
/	.ENTRY	$DDATB	/ Decimal date to binary.
/
	.RSECT	DATE
/
$BDATD,	0
	DCA	BDAT	/ Save binary date.
	TAD I	$BDATD	/ Get destination pointer.
	ISZ	$BDATD
	DCA	DP
	RDF		/ Get destination and return field.
	TAD	(CDF
	DCA	DF
	TAD	DF
	TAD	(2
	DCA	RF

	CDF	10	/ Get current year.
	TAD I	(7666
	SNA		/ No date set. Return fail.
	JMP	RF

	AND	(7	/ Mask year.
	DCA	CY	/ Save current year.

	CDF	0	/ Get extended date bits.
	TAD I	(7777
	CDF	.
	AND	(600	/ Mask away extended year.
	CLL RTL		/ Move extended year to AC6-8
	BSW
	TAD	(70.	/ Add base offset.
	DCA	OY	/ Save year offset.

	TAD	OY	/ Calculate current year.
	TAD	CY
	DCA	CY

	TAD	BDAT	/ Get binary year.
	AND	(7
	TAD	OY
	DCA	BY

	TAD	CY	/ Check if binary year > current year.
	CIA
	TAD	BY
	SMA SZA CLA

	TAD	(-10	/ If so, substract eight years from binary year.
	TAD	BY	/ Get binary year.
	JMS	OUT	/ Output it.

 	TAD	BDAT	/ Get month.
	AND	(7400
	CLL RTR
	BSW
	JMS	OUT

	TAD	BDAT	/ Get date.
	AND	(370
	CLL RTR;RAR
	JMS	OUT

	ISZ	$BDATD	/ Bump for success.
RF:	HLT		/ Return field.
	JMP I	$BDATD	/ Return.
/
BDAT:	0
CY:	0
OY:	0
BY:	0
DP,	0
/
OUT,	0
LOOP:	TAD	(-10.
	ISZ	LC
	SMA
	JMP	LOOP
	TAD	(72
	DCA	UNO
	CMA
	TAD	LC
	TAD	(60
	JMS	OUTC
	TAD	UNO
	JMS	OUTC
	DCA	LC
	JMP I	OUT
/
LC:	0
UNO:	0
/
OUTC,	0
DF,	HLT
	DCA I	DP
	CDF	.
	ISZ	DP
	JMP I	OUTC
/
	$