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

.