;* Updated on 16-Oct-89 at 9:03 PM by Ami Bar-Yadin; edit time: 0:06:03 *;
; Dates operations
VMAJOR=1
VMINOR=2
VEDIT=107.
;
; [107] 16-Oct-89 Ami Bar-Yadin
; A bug in Function 8 ($IDTIM interface) was accidentaly discovered
;
; (C)1988 By Ami Bar-Yadin.
; AMUS ID: AMI/AM
;
;-All commercial rights reserved, etc.
;-No warranties and/or guarranties of any kind, etc.
;-Not responsible for damages resulting from the use of this program, etc.
;-My employer (United Fashions) has nothing to do with this program and
; should not be blamed for it.
;
; I can be reached at:
; United Fashions of Texas, Inc.
; 200 Ash Ave.
; McAllen, TX 78501
; (512) 631-2277/2276
; 8am-6pm
;
;
; Date formats:
; ASCII ADATE,S,8 ("01/05/83") S,8
;
; Seperated XDATE X,{3..7}
; MONTH,B,1
; DAY,B,1
; YEAR,B,1
; DOW,B,1 1=MON..7=SUN
; YWEEK,B,1 Week of year 1-52
; MWEEK,B,1 Week of month 1-5
; MDAYS,B,1 Days in month 1-31
;
; Internal IDATE,B,4 True Julian B,4
; AlphaBASE BDATE,B,3 Same as seperated X,3 above
; 16 bit CDATE,B,2 Century Julian B,2
; Julian JDATE,F Yearly Julian F
; (assuming current year)
;
;
; SPECIAL CASE:
; ============
; A floating point 0 will be converted to today's date on input.
; For example:
; XCALL DATES,1,RESULT,0,A$
; Will return A$ with today's date.
; However:
; XCALL DATES,1,RESULT,TODAY,F
; (Where TODAY is todays date in any format)
; Will ALWAYS return a non-zero.
;
;
; FUNCTIONS:
; 1 XCALL DATES,1,RESULT,date,date
; Convert from any format to any format
; XCALL DATES,1,RESULT,ADATE,SDATE
; will convert an ASCII date to standard date
;
; 2 XCALL DATES,2,RESULT,date1,date2,days
; Will compute date2 = date1 + days
;
; 3 XCALL DATES,3,RESULT,date1,date2,days
; Will compute days = date1 - date2
;
; 4 XCALL DATES,4,RESULT,date1,date2
; Will compute date given year, week, and DOW
; date1 given as BDATE,X,5 or X,6
;
; 5 XCALL DATES,5,RESULT,date1,date2
; Will compute date given year, month, week and DOW
; date1 given as BDATE,X,6
;
; 6 XCALL DATES,6,RESULT,date1,date2
; Will compute date2=last day of month in date1
;
; 7 XCALL DATES,7,RESULT,DATE,TIME,FLAGS,OUTPUT UFFER or FILE#
; (interface) $ODTIM: Output Date and Time (Time last)
; Entry: D3=Date, D4=time (0=use sys)(separated), D5=format flags,A2->out
; Return: A2->nxt char (if used)
;
; 8 XCALL DATES,8,RESULT,INPUT,FLAGS,OUTPUT DATE,OUTPUT TIME
; (interface) $IDTIM: Input Date and/or Time (if both, time must be first)
; Entry: A2->Input string, D5(bit 0)=1:no date,(bit 1)=1:no time
; Return: D3=date (separated), D4=time (separated), A2->nxt chr
; N set:error
;
; 9 XCALL DATES,9,RESULT,DATE,LODATE,HIDATE,DATEOK
; Check if DATE is between LODATE and HIDATE (inclusive)
; ie. DATEOK is <>0 if LODATE <= DATE <= HIDATE
; NOTE: DATEOK must be a floating point variable.
;
;
; RESULT (F) CODES:
; 0 ALL OK
; 1 FUNCTION NUMBER OUT OF RANGE (1..9)
; 2 ERROR IN CONVERSION OF INPUT DATE
; 3 INVALID FORMAT FOR DATE
; 4 IMPROPER NUMBER/TYPE OF PARAMETERS
; 5 INVALID FORMAT FOR DAYS
; 6 ERROR LOCATING FILE CHANNEL
;
; SOME BASIC XCALL INTERFACING MACROS
;
; Move the type field from the Nth parameter block off the
; BASIC XCALL parameters list into DEST
;
DEFINE BTYPE N,DEST
1$$ = 2+^D10*<N-1>
CLR DEST
MOVW 1$$(A3),DEST
ENDM
;
;
; Move the address field from the Nth parameter block off the
; BASIC XCALL parameters list into DEST
;
DEFINE BADRS N,DEST
1$$ = 4+^D10*<N-1>
MOVL 1$$(A3),DEST
ENDM
;
;
; Move the size field from the Nth parameter block off the
; BASIC XCALL parameters list into DEST
;
DEFINE BSIZE N,DEST
1$$ = 8+^D10*<N-1>
MOVL 1$$(A3),DEST
ENDM
;
DATES:
MOV SP,A5 ; SAVE STACK POINTER
CALL SETUP
CALL GETFUN ; GET FUNCTION VALUE (D0) 1..9
DEC D0 ; adjust to 0..8
CMP D0,#8.
BHI 30$
ASL D0,#1
LEA A6,FTBL
CLR D7
MOVW 0(A6)[~D0],D7
ADD D7,A6
JMP @A6
30$:
MOV #1,D1
EXIT: BADRS 2,A0 ; SET RESULT CODE
FLTOF D1,@A0
MOV A5,SP
RTN
CONVRT:
MOV #4,D1
CMPW @A3,#4
JNE EXIT
CALL GETIDT ; CONVERT DATE1 TO INTERNAL FORMAT (D2)
CALL PUTIDT ; CONVERT INTERNAL (D2) TO DATE2
CLR D1
BR EXIT ; SET RESULT AND EXIT
COMPDT:
MOV #4,D1
CMPW @A3,#5
JNE EXIT
CALL GETIDT ; CONVERT DATE1 TO INTERNAL FORMAT (D2)
CALL GETDAY ; GET NUMBER OF DAYS (D3)
ADD D3,D2 ; D2=D2+D3
CALL PUTIDT
CLR D1
BR EXIT
COMPDY:
MOV #4,D1
CMPW @A3,#5
JNE EXIT
CALL GETIDT
CALL GETID2 ; GET 2ND DATE (D3)
SUB D3,D2
CALL PUTDAY ; SET NO OF DAYS (D2)
CLR D1
BR EXIT
COMPEM:
MOV #4,D1
CMPW @A3,#4
JNE EXIT
CALL GETIDT ; CONVERT DATE1 TO INTERNAL FORMAT (D2)
MOV D2,D7
CALL DITOS ; CONVERT TO SEPERATE FORMAT
ADD #000010000,D7 ; MONTH=MONTH+1
AND #000FFFFFF,D7 ; DAY=0
CALL $DSTOI ; CONVERT BACK TO INTERNAL
MOV D7,D2
CALL PUTIDT ; CONVERT INTERNAL (D2) TO DATE2
CLR D1
JMP EXIT ; SET RESULT AND EXIT
IODTIM:
; 7 XCALL DATES,7,RESULT,DATE,TIME,FLAGS[,BUFFER or FILE#]
; (interface) $ODTIM: Output Date and Time (Time last)
; Entry: D3=Date, D4=time (0=use sys)(separated), D5=format flags,A2->out
; Return: A2->nxt char (if used)
;
MOV #4,D1 ; ISSUE ERROR IF LESS THAN FIVE
CMPW @A3,#5
JLO EXIT
CMPW @A3,#6 ; OR MORE THAN SIX ARGUMENTS
JHI EXIT
CALL GETIDT ; CONVERT DATE1 TO INTERNAL FORMAT (D2)
MOV D2,D7
CALL DITOS ; CONVERT TO SEPERATE FORMAT
PUSH D7
MOV D2,D7
SUB #CNTURY,D7
DIV D7,#7
SWAP D7
AND #0FF,D7 ; MASK ALL BUT DOW
MOVB D7,3(SP) ; SET DOW
BADRS 4,A2
BTYPE 4,D0
BSIZE 4,D5
CALL GETNUM ;GET TIME ARG (D4)
TST D3 ; if time=0
BNE 10$
GTIMES D3 ; get system time
10$: PUSH D3
BTYPE 5,D0
BSIZE 5,D5
CALL GETNUM ;GET FILE CHANNEL NUMBER
MOV D3,D1
CALL $FLSET ;FIND FILE'S DDB
BEQ 20$ ;EVERYTHING'S OK, PROCEED
MOV #6,D1 ;ERROR #6 BAD CHANNEL NUMBER
JMP EXIT ;ABORT WITH ERROR
20$: POP D5 ;LOAD ARGS INTO PROPER REGISTERS
POP D4 ; D3=DATE, D4=TIME, D5=FLAGS
POP D3
CALL $ODTIM
CLR D1 ;$ODTIM HAS NO ERROR CONDITIONS
JMP EXIT ;RETURN TO CALLER
IIDTIM:
; 8 XCALL DATES,7,RESULT,INPUT,FLAGS,OUTPUT DATE,OUTPUT TIME
; (interface) $IDTIM: Input Date and/or Time (if both, time must be first)
; Entry: A2->Input string, D5(bit 0)=1:no date,(bit 1)=1:no time
; Return: D3=date (separated), D4=time (separated), A2->nxt chr
; N set:error
; OUTPUT DATE AND TIME MUST BE B,4
;
;
;
MOV #4,D1 ; ISSUE ERROR IF NOT SIX ARGUMENTS
CMPW @A3,#6
JNE EXIT
CLR D1 ;EVERYTHING OK
JMP EXIT ;RETURN TO CALLER
1$: MOV #2,D1
JMP EXIT
RNGEDT:
; 9 XCALL DATES,9,RESULT,DATE,LODATE,HIDATE,DATEOK
; Check if DATE is between LODATE and HIDATE (inclusive)
; ie. DATEOK is <>0 if LODATE <= DATE <= HIDATE
;
BADRS 3,A2 ; get DATE
BTYPE 3,D0
BSIZE 3,D5
CALL GETDAT
PUSH D2 ; save DATE
PUTIDT:
; CONVERT INTERNAL (D2) TO DATE2
SAVE A2,D0,D2,D3,D4,D5
BADRS 4,A2
BTYPE 4,D5
BSIZE 4,D0
CMP D5,#2
JEQ PTDASC
CMP D5,#4
JEQ PTDF
CMP D5,#6
JEQ PTDB
MOV #3,D1
TST D5
JNE EXIT
; UNFORMATTED (X), 1ST 3 BYTES ARE ALWAYS: MONTH,DAY,YEAR
PTDX: MOV D2,D7
CALL DITOS
MOV D7,D3
PUSH D6 ; # OF DAYS IN MONTH
MOVB D7,2(A2) ; SET YEAR
SWAP D7
MOVB D7,@A2 ; SET MONTH
RORW D7,#8
MOVB D7,1(A2) ; SET DAY
CMP D0,#4
JLO PTDEXT
MOV D2,D7
SUB #CNTURY,D7
DIV D7,#7
SWAP D7
AND #0FF,D7 ; MASK ALL BUT DOW
INCB D7 ; (PUT DOW IN 1..7 RANGE)
MOVB D7,3(A2) ; SET DOW
CMP D0,#5
JLO PTDEXT
;YWEEK=INT((NOW-START+START'DOW)/7)+1
MOV D3,D7
AND #0000FFFF,D7
OR #01010000,D7 ; SET MONTH AND DAY=01/01
CALL $DSTOI ; D7=START
MOV D2,D5 ; D5=NOW
SUB D7,D5
SUB #CNTURY,D7
DIV D7,#7
SWAP D7
AND #0FF,D7 ; MASK ALL BUT DOW
ADD D7,D5
DIV D5,#7
INCB D5
MOVB D5,4(A2)
CMP D0,#6
BLO PTDEXT
;MWEEK=INT((NOW-START+START'DOW)/7)+1
MOV D3,D7
AND #00FFFFFF,D7
OR #01000000,D7 ; SET DAY=01
CALL $DSTOI ; D7=START
MOV D2,D5 ; D5=NOW
SUB D7,D5
SUB #CNTURY,D7
DIV D7,#7
SWAP D7
AND #0FF,D7 ; MASK ALL BUT DOW
ADD D7,D5
DIV D5,#7
MOVB D5,5(A2)
; TSTB D7
; BEQ 1$
INCB 5(A2)
1$:
CMP D0,#7
BLO PTDEXT
;MDAYS
MOV @SP,D6
MOVB D6,6(A2)
PTDEXT: POP
CLR D1
REST A2,D0,D2,D3,D4,D5
RTN
PTDASC: MOV D2,D7
CALL DITOS
MOV D7,D3
MOV #840.,D5
CALL $ODTIM
CMP D0,#8
BLE PTDEXT
CLRB @A2
JMP PTDEXT
PTDB: CMP D0,#3
JEQ PTDX ; B,3 SAME AS X,3
MOV A2,D3
BTST #0,D3
JNE ADRERR
CMP D0,#4
BEQ PTDB4
; ASSUME B,2 FORMAT
MOV D2,D3
SUB #CNTURY,D3
MOVW D3,@A2 ; SET DAYS
JMP PTDEXT
PTDB4: MOV D2,D3
SWAP D3 ; TO FIT BASIC'S B,4 FORMAT
MOV D3,@A2
JMP PTDEXT
PTDF: MOV D2,D7
CALL DITOS
AND #0000FFFF,D7
OR #01010000,D7 ; SET MONTH AND DAY=01/01
CALL $DSTOI
MOV D2,D3
SUB D7,D3
INC D3
FLTOF D3,@A2
JMP PTDEXT
GETDAY:
; GET NUMBER OF DAYS (D3)
SAVE A2,D0,D5
BADRS 5,A2
BTYPE 5,D0
BSIZE 5,D5
CALL GETNUM
REST A2,D0,D5
RTN
GETNUM:
CMP D0,#4 ;CHECK IF ARG IS FLOATING POINT
BNE 1$
FFTOL @A2,D3 ;CONVERT FLOATING POINT ARG
BR 3$ ;BRANCH TO ROUTINE EXIT
1$: MOV #5,D1 ;(ASSUME ERROR#5)
CMP D0,#6 ;CHECK IF ARG IS BINARY
JNE EXIT ;ABORT PROGRAM WITH ERROR IF IMPROPER TYPE
CMP D5,#5 ;CHECK LENGTH OF ARG IN BYTES
JEQ EXIT ;ABORT PROGRAM WITH ERROR IF TOO LONG
ADD D5,A2 ;COMPUTE POINTER TO BYTE PAST ARG
CLR D3 ;CLEAR DESTINATION
2$: LSL D3,#8 ;PREPEARE FOR NEXT BYTE
MOVB -(A2),D3 ;LOAD NEXT BYTE
SOB D5,2$ ;LOOP UNTIL DONE
3$: CLR D1 ;NO ERRORS
RTN
PUTDAY:
; SET NUMBER OF DAYS (D2)
SAVE A2,D0,D2,D5
BADRS 5,A2
BTYPE 5,D0
BSIZE 5,D5
CALL PUTNUM
REST A2,D0,D2,D5
RTN
