;
; NAME: SYSINT
;
OBJNAM .SBR
;
; FUNCTION: This module accepts as input a date field (in
; AlphABasic format) and returns the internal (absolute) format
; in a floating point.
; Note that the results of this conversion may be converted to be
; relative to a different starting date than that chosen by
; AlphaMicro. For example, to make 1/1/1900 the first day, subtract
; the constant 2415020 from the returned result.
; NOTE: the routine $DSTOI apparently translates any date prior to
; 3/1/1900 incorrectly (it returns a result which is well past the
; end of the 20th century).
;
; CALLING SEQUENCE:
; XCALL SYSINT,SYS,INT where
; SYS is date in AlphaBasic format (B,3 or B,4)
; INT is a date in internal format (F,6)
;
; AUTHOR: Tom Dahlquist
;
; PROGRAM HISTORY:
; 09/28/87 Written.
;
EXTERN $DSTOI
SEARCH SYS
SEARCH SYSSYM
;
; This is a map of the parameters passed by AlphaBasic XCALL.
;
ASECT
.=0
XCALL:
NUMARG: WORD 0
TYPE1: WORD 0
ADDR1: LWORD 0
SIZE1: LWORD 0
TYPE2: WORD 0
ADDR2: LWORD 0
SIZE2: LWORD 0
PSECT
RADIX 16
VMAJOR=1
VMINOR=0
PHDR -1,0,PH$REE!PH$REU
CMPW @A3,#2 ; check # of args...
BLO RTN ; leave if too small.
MOVW TYPE1(A3),D7 ; check type of arg1--
ANDW #0F,D7 ; get rid of extraneous bits...
CMPW D7,#6 ; must be binary,
BNE RTN ; leave if not.
CMP SIZE1(A3),#3 ; check size of arg1--
BLO RTN ; leave if < 3.
MOVW TYPE2(A3),D7 ; check type of arg2--
ANDW #0F,D7
CMPW D7,#4 ; must be floating point.
BNE RTN
MOV ADDR1(A3),A6 ; A6 -> input value...
MOVB 1(A6),D7 ; get day...
LSLW D7,#8. ; shift left one byte...
MOVB @A6,D7 ; move in day...
LSL D7,#8. ; shift left one word...
LSL D7,#8.
MOVB 2(A6),D7 ; and move in year.
CALL $DSTOI ; and convert to internal.
MOV ADDR2(A3),A6 ; A6 -> return value area...
FLTOF D7,@A6 ; store return value.
RTN: RTN
END
