;* Converts between a "mm/dd/yyyy" string and 2-byte packed format date *

;****************************************************************************
;* *
;* 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