;****************************************************************************
;*									    *
;*				    DATE2				    *
;*   Converts between a "mm/dd/yyyy" string and 2-byte packed format date   *
;*									    *
;****************************************************************************
;Copyright (C) 1988 UltraSoft Corporation.  All Rights Reserved.
;
;Written by: David Pallmann		Freeware donated to AMUS
;
;Edit History:
;1.0(100)  14-Jul-88  created. /DFP
;1.0(101)  30-Nov-88  include XCALL offsets in-line. /DFP
;
;----------------------------------------------------------------------------
;
;    This subroutine allows BASIC programs to store dates in 2-byte
;    binary variables.  DATE2.SBR converts in either direction between
;    string and binary formats.
;
;    The binary format used is:
;
;		+---------------+---------------+
;		|Y|Y|Y|Y|Y|Y|Y|M|M|M|M|D|D|D|D|D|
;		+---------------+---------------+
;
;    The string format used is:
;
;		mm/dd/yy			07/16/1988
;
;
;    Example of usage:
;
;	MAP1 SDATE,S,10			! string date
;	MAP1 BDATE,B,2			! binary date
;
;	SDATE = "07/16/1988"
;	XCALL DATE2, SDATE, BDATE	! convert string to binary
;
;	BDATE = 45296
;	XCALL DATE2, BDATE, SDATE	! convert binary to string
;
;    Restrictions:
;
;	Only valid dates between 1900 and 2027 may be stored.
;
;----------------------------------------------------------------------------

	OBJNAM	.SBR

	VMAJOR=1
	VMINOR=0
	VSUB=0
	VEDIT=101.
	VWHO=0

	ASMMSG	"== Binary Date Subroutine =="
	SEARCH	SYS
	SEARCH	SYSSYM

;XCALL Argument List - indexed by A3

	.OFINI
	.OFDEF	COUNT,2
	.OFDEF	TYPE1,2
	.OFDEF	ADDR1,4
	.OFDEF	SIZE1,4
	.OFDEF	TYPE2,2
	.OFDEF	ADDR2,4
	.OFDEF	SIZE2,4
	.OFDEF	TYPE3,2
	.OFDEF	ADDR3,4
	.OFDEF	SIZE3,4
	.OFDEF	TYPE4,2
	.OFDEF	ADDR4,4
	.OFDEF	SIZE4,4
	.OFDEF	TYPE5,2
	.OFDEF	ADDR5,4
	.OFDEF	SIZE5,4
	.OFDEF	TYPE6,2
	.OFDEF	ADDR6,4
	.OFDEF	SIZE6,4
	.OFDEF	TYPE7,2
	.OFDEF	ADDR7,4
	.OFDEF	SIZE7,4
	.OFDEF	TYPE8,2
	.OFDEF	ADDR8,4
	.OFDEF	SIZE8,4
	.OFDEF	TYPE9,2
	.OFDEF	ADDR9,4
	.OFDEF	SIZE9,4
	.OFSIZ	XCSIZE

        UNFORMATTED=0
        STRING=2
        FLOAT=4
        BINARY=6

	.OFINI
	.OFDEF	MONTH,	4		; month
	.OFDEF	DAY,	4		; day
	.OFDEF	YEAR,	4		; year
	.OFSIZ	MEMSIZ

	PHDR	-1,0,PH$REE!PH$REU

CLEAR:	MOV	A4,A6
	MOV	#MEMSIZ-1,D6
10$:	CLRB	(A6)+
	DBF	D6,10$

CHECK:	CMPW	COUNT(A3),#2
	JNE	CNTERR

CHECK1:	CMPW	TYPE1(A3),#STRING
	BNE	CHECK2
	CMPW	TYPE2(A3),#BINARY
	BNE	CHECK2
	CMP	SIZE1(A3),#10.
	JLO	SIZERR
	CMP	SIZE2(A3),#2
	JEQ	S.TO.B
	JMP	SIZERR

CHECK2:	CMPW	TYPE1(A3),#BINARY
	JNE	TYPERR
	CMPW	TYPE2(A3),#STRING
	JNE	TYPERR
	CMP	SIZE1(A3),#2
	JNE	SIZERR
	CMP	SIZE2(A3),#10.
	JHIS	B.TO.S
	JMP	SIZERR

;*********************************
;*  STRING TO BINARY CONVERSION  *
;*********************************

S.TO.B:

;scan date string

	MOV	ADDR1(A3),A2		; point to date string
	GTDEC				; get month
	MOV	D1,MONTH(A4)		; store month
	CMP	D1,#1			; 
	JLO	DATERR			; 
	CMP	D1,#12.			; 
	JHI	DATERR			; 

	CMPB	(A2)+,#'/		; bypass slash
	JNE	FMTERR			;  not present
	GTDEC				; get day
	MOV	D1,DAY(A4)		; store day
	CMP	D1,#1			; 
	JLO	DATERR			; 
	CMP	D1,#31.			; 
	JHI	DATERR			; 

	CMPB	(A2)+,#'/		; bypass slash
	JNE	FMTERR			;  not present
	GTDEC				; get year
	MOV	D1,YEAR(A4)		; store year
	CMP	D1,#1900.		; 
	JLO	DATERR			; 
	CMP	D1,#2027.		; 
	JHI	DATERR			; 

;create binary date
;
;	+---------------+---------------+
;	|Y|Y|Y|Y|Y|Y|Y|M|M|M|M|D|D|D|D|D|
;	+---------------+---------------+

	CLR	D2

	MOV	YEAR(A4),D1		; get year
	SUB	#1900.,D1		; normalize to 1900
	ROL	D1,#8.
	ROL	D1,#1			; shift year 9 bits left
	ADD	D1,D2

	MOV	MONTH(A4),D1		; get month
	ROL	D1,#5			; shift month 5 bits left
	ADD	D1,D2

	MOV	DAY(A4),D1
	ADD	D1,D2

	MOV	ADDR2(A3),A6
	MOVW	D2,@A6

	RTN

;*********************************
;*  BINARY TO STRING CONVERSION  *
;*********************************

B.TO.S:	CLR	D2
	MOV	ADDR1(A3),A6
	MOVW	@A6,D2

	MOV	D2,D1
	AND	#^B<0000000000011111>,D1
	MOV	D1,DAY(A4)

	MOV	D2,D1
	ROR	D1,#5
	AND	#^B<0000000000001111>,D1
	MOV	D1,MONTH(A4)

	MOV	D2,D1
	ROR	D1,#8.
	ROR	D1,#1
	AND	#^B<0000000001111111>,D1
	MOV	D1,YEAR(A4)

;create string date
;
;	MM/DD/YYYY

	MOV	ADDR2(A3),A2
	MOV	MONTH(A4),D1
	DCVT	2,OT$MEM

	MOVB	#'/,(A2)+

	MOV	DAY(A4),D1
	DCVT	2,OT$MEM

	MOVB	#'/,(A2)+

	MOV	YEAR(A4),D1
	ADD	#1900.,D1
	DCVT	4,OT$MEM

	CMP	SIZE2(A4),#10.
	BEQ	10$
	CLRB	@A2
10$:
	RTN

CNTERR:	TYPESP	?Argument count
	BR	ERROR

TYPERR:	TYPESP	?Argument type
	BR	ERROR

SIZERR:	TYPESP	?Argument size
	BR	ERROR

FMTERR:	TYPESP	?Date format
	BR	ERROR

DATERR:	TYPE	?Invalid date (
	MOV	ADDR1(A3),A6
	TTYL
	TYPESP	)

ERROR:	TYPECR	error in DATE2.SBR
	EXIT

	END

.