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