;
;       NAME:  INTSYS
;
       OBJNAM  .SBR
;
;       FUNCTION:  This routine translates a date in internal (absolute)
;       format into a date in system format.  The bulk of the code in this
;       module is here because AM, while providing a library subroutine to
;       go from system to internal, neglected to provide one to go from
;       internal to system.   Seems like kind of an oversight.
;       Note that dates in absolute format relative to a different starting
;       date than that chosen by AlphaMicro may be decoded by this routine
;       by adding a constant to them prior to calling this routine.  For
;       example, if 1/1/1900 equals day 1, add 2415020 to the number.
;       Note that all dates passed to this routine are assumed to be in
;       this century.
;
;       CALLING SEQUENCE:
;       XCALL INTSYS,INT,SYS  where
;       INT is an internal format date in an F,6 or S type field
;       SYS is a variable of type B,3 or B,4 in which the result is returned
;               in AlphaBasic format
;
;       AUTHOR:  Tom Dahlquist
;
;       PROGRAM HISTORY:
;       09/28/87 Written.
;

       EXTERN  $GTARG

       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...
       JLO     RTN                     ; leave if too small.
       MOVW    TYPE1(A3),D7            ; check type of arg1--
       ANDW    #0F,D7                  ; get rid of extraneous bits...
       CMPW    D7,#4                   ; must be floating point,
       JNE     RTN                     ; leave if not.
       MOVW    TYPE2(A3),D7            ; check type of arg2--
       ANDW    #0F,D7
       CMPW    D7,#6                   ; must be binary.
       JNE     RTN
       CMP     SIZE2(A3),#3            ; check size of arg2--
       BLO     RTN                     ; leave if < 3.

       MOV     #TYPE1,D1               ; D1 = offset in arg list...
       CALL    $GTARG                  ; convert input to long...
       SUB     #2415020.,D1            ; make relative to 1/1/1900
;
;       Convert absolute to MMDDYY.
;
       RADIX   10

ABSMDY: MOV     ADDR2(A3),A6            ; clear returns...
       MOV     A6,A1                   ; A1 -> return variable...
       CLRW    (A6)+
       CLRB    (A6)+
       CMP     SIZE2(A3),#3
       BEQ     1$
       CLRB    @A6
1$:

;       Validity check input.

       TST     D1
       BEQ     RTN                     ; if zero, return...
       CMPW    D1,#36524               ; too big?
       BHI     RTN                     ; back if so.

;       Compute year by dividing by 365.25.

       MOV     D1,D0                   ; move absolute to R0...
       CLR     D4                      ; clear year counter...
       CMPW    D0,#366                 ; someplace in 1900?
       BLO     XYEAR0                  ; skip if so...
       SUBW    #365,D0                 ; decrement for 1900.
       MOV     D0,D1
       MUL     D1,#100                 ; divide by 365.25 and
       DIV     D1,#36525               ; take the integer...
       MOVW    D1,D4                   ; save # of years in D4 and
       INCW    D4                      ; add 1 for 1900.
       MUL     D1,#36525               ; compute # of days in those years
       DIV     D1,#100                 ; so that we can
       SUBW    D1,D0                   ; subtract from total.
       TST     D0                      ; any days left?
       BNE     XYEAR0                  ; br if so, else
       DECW    D4                      ; decrement year and
       MOV     #12,D3                  ; set to 12/31.
       MOV     #31,D0
       BR      ELP3

;       Compute month by successive subtractions.

XYEAR0: MOV     #1,D3                   ; initialize to january...
LP3:    CALL    GETMO                   ; get # of days in month...
       CMP     D1,D0                   ; that many left?
       BGE     ELP3                    ; out if not...
       SUB     D1,D0                   ; else decrement,
       INCW    D3                      ; move to next month,
       BR      LP3                     ; and loop.

;       Return result.

ELP3:   MOVB    D4,2(A1)
       MOVB    D3,@A1
       MOVB    D0,1(A1)
RTN:    RTN

;
;       Compute number of days given month in D3 and year in D4.
;       Return in D1.
;       This routine destroys A2.
;

GETMO:  LEA     A2,DAYS-1               ; get -> days table less 1,
       ADD     D3,A2                   ; get -> # of days...
       CLR     D1
       MOVB    @A2,D1                  ; and get # of days.
       CMPW    D3,#2                   ; february?
       BNE     GMRET                   ; back if not...
       TST     D4                      ; 1900?
       BEQ     GMRET                   ; back if so...
       MOV     D4,D2                   ; else test for leap year...
       ASR     D2,#2
       ASL     D2,#2
       CMP     D2,D4
       BNE     GMRET
       INCW    D1
GMRET:  RTN

;
;       Table of days.
;

DAYS:   BYTE    31,28,31,30,31,30,31,31,30,31,30,31
       END