;*************************** AMUS Program Label ******************************
; Filename: DAY.M68                                         Date: 02/15/89
; Category: SBR          Hash Code: 750-377-447-771      Version: 1.0
; Initials: UWL/AM       Name: ED SCHRAYER
; Company: UNITED WIRE                             Telephone #:(212) 691-4100
; Related Files: NONE
; Min. Op. Sys.: AMOS/L /32                    Expertise Level: BEG
; Special: 
; Description: Find out what day of the week is is. Mulit-format.
; 
; 
;*****************************************************************************
;Copyright (C) 1989  All Rights Reserved.
;
;Written by: Ed Schrayer
;
;
;	USAGE :		XCALL MONTH, DAY, YEAR, RETURN-CODE
;
;				 OR 
;
;			XCALL DAY, DATE, RETURN-CODE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;		DATE CAN BE   M,D,Y  AS BINARY FIELDS
;			OR  MMDDYY  OR  MM/DD/YY AS STRING FIELDS
;
;		RTN.CODE CAN BE BINARY, FLOAT, OR STRING
;
;
;	WHEN XCALL IS MADE, IF RETURN-CODE < 8,  THE DAY OF THE WEEK WILL
;		BE RETURNED IN A NUMBER FORM, AND NO TYPING TO THE SCREEN
;		WILL OCCUR.
;
;	IF RTN.CODE=8 WHEN CALL IS MADE, THE DAY OF THE WEEK WILL BE RETURNED
;		IN A NUMBER FORM   *AND*   THE DAY OF THE WEEK WILL BE
;		TYPED AT THE CURRENT CURSOR POSTION.     e.g. <WED>
;
;	IF RTN.CODE=9 WHEN CALL IS MADE, THE DAY OF THE WEEK WILL BE RETURNED
;		IN A NUMBER FORM   *AND*   THE DAY OF THE WEEK WILL BE
;		TYPED AT THE CURRENT CURSOR POSTION.     e.g. <WEDNESDAY>
;
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;  11/20/88 E.S. NEW
;
        OBJNAM  .SBR

        SEARCH  SYS
        SEARCH  SYSSYM
        SEARCH  TRM

;XCALL ARG LIST -> 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
	.OFSIZ	ARGSIZ

        .OFINI
        .OFDEF  SM,4
        .OFDEF  SD,4
        .OFDEF  SY,4
        .OFSIZ  DSIZ
;				DO NOT PUT COMMENTS INTO THE MACRO AREA
DEFINE	DAYOUT
	PUSH	A2
	CLR	D1
	CMP	D2,#9.
	BEQ	10$$
	CMP	D2,#8.
	BNE	30$$
	SUB	#5,D2
10$$:	MOV	D0,D3
	MUL	D3,#10.
	SUB	#10.,D3
	ADD	D3,A2
20$$:	MOVB	(A2)+,D1
	TTY
	DEC	D2
	CMP	D2,#0
	BNE	20$$
30$$:	POP	A2
	ENDM

        VMAJOR=1
        VMINOR=0

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

; CHECK ARGS HERE
	CMMW    COUNT(A3),#4
	JEQ	12$
	CMMW	COUNT(A3),#2
	JNE     BADCNT
;
; STRING WAS INPUT
	CMPW	TYPE1(A3),#2		; IS THIS A STRING INPUT ?
	JNE	TYPERR
	CMP	SIZE1(A3),#6		; IF 6 BYTES LONG, NO ERROR CHECK
	BEQ	10$
	CMP	SIZE1(A3),#8.		; IF 8 BYTES LONG, CHECK FOR '/'
	JNE	SIZERR

	MOV	ADDR1(A3),A2
	ADD	#2,A2
	CMPB	@A2,#'/
	JNE	RANGE
	ADD	#3,A2
	CMPB	@A2,#'/
	JNE	RANGE
;
	MOV	ADDR1(A3),A2		; SHIFT 8 BYTE FORMAT INTO 6
	MOVB	3(A2),2(A2)
	MOVB	4(A2),3(A2)
	MOVB	6(A2),4(A2)
	MOVB	7(A2),5(A2)
;
;
; PROTECT A3=ARG LIST
;	  A4=IMPURE
;
;
10$:	MOV	ADDR1(A3),A2		; A2 HAS THE STRING ADDR
	MOVW	@A2,D1
	LEA	A2,BUFFER
	MOV	#0,@A2
	MOVW	D1,@A2
	CLR	D1
	GTDEC
	MOV	D1,SM(A4)

	MOV	ADDR1(A3),A2		; A2 HAS THE STRING ADDR
	ADD	#2,A2

	MOVW	@A2,D1
	LEA	A2,BUFFER
	MOV	#0,@A2
	MOVW	D1,@A2
	CLR	D1
	GTDEC
	MOV	D1,SD(A4)

	MOV	ADDR1(A3),A2		; A2 HAS THE STRING ADDR
	ADD	#4,A2

	MOVW	@A2,D1
	LEA	A2,BUFFER
	MOV	#0,@A2
	MOVW	D1,@A2
	CLR	D1
	GTDEC
	MOV	D1,SY(A4)
;
; SEE IF WE NEED TO RESTORE THE 8 BYTE INPUT FORMAT
;
	CMP	SIZE1(A3),#8.		; IF 6 BYTES, DO NOT BYPASS '/'
	JNE	14$

	MOV	ADDR1(A3),A2		; SHIFT 8 BYTE FORMAT INTO 6
	MOVB	5(A2),7(A2)
	MOVB	4(A2),6(A2)
	MOVB	#'/,5(A2)
	MOVB	3(A2),4(A2)
	MOVB	2(A2),3(A2)
	MOVB	#'/,2(A2)
	JMP	14$
;
; HANDLE BINARY INPUT HERE
;
12$:	CMP	SIZE1(A3),#1		; 1ST ARG IS 1 BYTE IN SIZE
	JNE	SIZERR
	CMPW	TYPE1(A3),#6
	JNE	TYPERR
	CMP	SIZE2(A3),#1		; 2ND ARG IS 1 BYTE IN SIZE
	JNE	SIZERR
	CMPW	TYPE2(A3),#6
	JNE	TYPERR
	CMP	SIZE3(A3),#1		; 3RD ARG IS 1 BYTE IN SIZE
	JNE	SIZERR
	CMPW	TYPE3(A3),#6
	JNE	TYPERR
;
; LOAD UP THE BINARY ARGS
;
	CLR	D1
	MOV	ADDR1(A3),A0
	MOVB	@A0,D1
        MOV     D1,SM(A4)

	CLR	D1
	MOV	ADDR2(A3),A0
	MOVB	@A0,D1
        MOV     D1,SD(A4)

	CLR	D1
	MOV	ADDR3(A3),A0
	MOVB	@A0,D1
        MOV     D1,SY(A4)

14$:	CMP     SM(A4),#1
        JLT     RANGE
        CMP     SM(A4),#12.
        JGT     RANGE

        CMP     SD(A4),#1
        JLT     RANGE
        CMP     SD(A4),#31.
        JGT     RANGE
;
;
; CALC THE DATING FORMAT HERE
;
	MOV	SY(A4),D0
	MUL	D0,#1461.	; (4 * 365.25)
	MOV	#4.,D1		; SET UP A DIVISOR OF 4
	DIV	D0,D1		; DIVIDE TO GET NON INTEGER
	AND	#^H0FFFF,D0	; CLEAR REMAINDER
	MOV	D0,D5		; D5 IS THE ACCUM - YEARS ARE DONE

	MOV	SM(A4),D0	;
	DEC	D0		; COUNT ONLY THE MONTHS THAT HAVE PASSED
	BEQ	20$
	ADD	D0,D0		; DOUBLE D0 - WE'RE LOOKING AT WORDS
	LEA	A6,OFFSET	; LOAD ADDR OF OFFSET TABLE
	ADD	D0,A6
	CLR	D0
	MOVW	@A6,D0
	ADD	D0,D5		; D5 IS THE ACCUM - MONTHS ADDED TO ACCUM

20$:	MOV	SD(A4),D0
	ADD	D0,D5		; DAYS ARE NOW ADDED TO THE ACCUM

	MOV	SY(A4),D0	; D0 = YEAR
	MOV	#4.,D1		; D1 = 4
	DIV	D0,D1		; DIVIDE YEAR/4
	CLRW	D0		; CLR THE INTEGER
	SWAP	D0		; MOVE REMAINDER INTO LOW ORDER

	CMP	D0,#0		; DOES (YR/4)=INT(YR/4)
	BNE	30$		; NOT A LEAP YEAR - GET OUT OF HERE

	MOV	SM(A4),D0	; D0 = MONTH
	CMP	D0,#2		; FEB ?
	JGT	30$		; JMP IF AFTER FEB
	DEC	D5		; ELSE TAKE AWAY THE EXTRA DAY

30$:	MOV	D5,D0		; COPY ACCUM TO D0
	MOV	D5,D3		; AND D3
	MOV	#7.,D1		; MOV #7 INTO D1
	DIV	D0,D1		; D0 = DAYS / 7
	AND	#^H0FFFF,D0	; CLEAR REMAINDER
	MUL	D0,#10.		; D0=ACCUM/7 * 10

	MUL	D3,#10.		; DAYS * 10
	DIV	D3,D1		; D3 = DAYS*10 / 7
	AND	#^H0FFFF,D3	; CLEAR REMAINDER

	SUB	D0,D3
	MOV	D3,D0

	INC	D0		; REALIGN REMAINDER FOR CONVERSION
	CMP	D0,#4.
	JLO	DAYFND
	DEC	D0
	CMP	D0,#7.
	JLO	DAYFND
	DEC	D0
;
;
; DO WE WANT TO SEND THE DAY TO THE TERMINAL ?
;
DAYFND:
	LEA	A2,DAYMSG		; GET DAYS LIST INTO A2

	CMMW	COUNT(A3),#2		; 2 ARGS INPUT ?
	JEQ	100$			; YES - RESPOND IN 2ND ARG
	MOV	ADDR4(A3),A0		; A0 POINTS TO OUTPUT ADDRESS

	CMPW	TYPE4(A3),#6		; IS THE RETURN ARG BINARY?
	BNE	10$
	CLR	D2
	MOVB	@A0,D2			; D2 HAS THE REQUESTED CODE INPUT
	DAYOUT

	MOVB	D0,@A0			; 4TH ARG GETS RESPONSE
        RTN

10$:	CMPW	TYPE4(A3),#4		; IS THE RETURN ARG FLOATING PT.?
	BNE	20$
	CMP	SIZE4(A3),#6
	JNE	SIZERR

	PUSH	A0
	CLR	D2
	FFTOL	@A0,D2			; D2 IS INPUT REQUEST
	POP	A0			; KEEP A2 SAFE - RESTORE IT HERE
	DAYOUT

	FLTOF	D0,@A0			; 4TH ARG GETS RESPONSE
        RTN

20$:	CMPW	TYPE4(A3),#2		; WE BETTER BE LEFT WITH A STRING
	JNE	SIZERR
	MOV	ADDR4(A3),A2		; A2 IS THE INPUT/OUTPUT BYTE
	CLR	D2			; USE D2 AS TEMP REG TO TEST
	MOVB	@A2,D2			; THE INCOMING REQUEST
	SUB	#48.,D2			; IS INCOMING A '8'
	DAYOUT

	MOV	D0,D1			; GET READY FOR DCVT CALL
	DCVT	1,OT$MEM
	RTN

100$:	MOV	ADDR2(A3),A0		; A0 POINTS TO OUTPUT ADDRESS

	CMPW	TYPE2(A3),#6		; IS THE RETURN ARG BINARY?
	BNE	110$
	CLR	D2
	MOVB	@A0,D2			; D2 HAS THE REQUESTED CODE INPUT
	DAYOUT

	MOVB	D0,@A0			; 4TH ARG GETS RESPONSE
        RTN

110$:	CMPW	TYPE2(A3),#4		; IS THE RETURN ARG FLOATING PT.?
	BNE	120$
	CMP	SIZE2(A3),#6
	JNE	SIZERR

	PUSH	A0
	CLR	D2
	FFTOL	@A0,D2			; D2 IS INPUT REQUEST
	POP	A0			; KEEP A2 SAFE - RESTORE IT HERE
	DAYOUT

	FLTOF	D0,@A0			; 4TH ARG GETS RESPONSE
        RTN

120$:	CMPW	TYPE2(A3),#2		; WE BETTER BE LEFT WITH A STRING
	JNE	SIZERR
	MOV	ADDR2(A3),A2		; A2 IS THE INPUT/OUTPUT BYTE
	CLR	D2			; USE D2 AS TEMP REG TO TEST
	MOVB	@A2,D2			; THE INCOMING REQUEST
	SUB	#48.,D2			; #56.= '8
	DAYOUT

	MOV	D0,D1			; GET READY FOR DCVT CALL
	DCVT	1,OT$MEM
	RTN
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


OFFSET:	WORD	0
	WORD	31.
	WORD	59.
	WORD	90.
	WORD	120.
	WORD	151.
	WORD	181.
	WORD	212.
	WORD	243.
	WORD	273.
	WORD	304.
	WORD	334.

BUFFER:	BLKB	4
DAYMSG:	BYTE	'S,'U,'N,'D,'A,'Y,0 ,0 ,0,0,'M,'O,'N,'D,'A,'Y,0 ,0 ,0 ,0
	BYTE	'T,'U,'E,'S,'D,'A,'Y,0 ,0,0,'W,'E,'D,'N,'E,'S,'D,'A,'Y,0
	BYTE	'T,'H,'U,'R,'S,'D,'A,'Y,0,0,'F,'R,'I,'D,'A,'Y,0 ,0 ,0 ,0
	BYTE	'S,'A,'T,'U,'R,'D,'A,'Y,0,0
	EVEN
RANGE:  TYPESP  ?Invalid DATE submitted to DAY.SBR - Hit <CR> 
	KBD
        RTN
BADCNT: TYPESP  ?Invalid NUMBER of arguments in DAY.SBR - Hit <CR> 
	KBD
        RTN
SIZERR: TYPESP  ?Invalid SIZE of arguments in DAY.SBR - Hit <CR> 
	KBD
        RTN
TYPERR: TYPESP  ?Invalid TYPE of arguments in DAY.SBR - Hit <CR> 
	KBD
        RTN

        END

.