Some date functions supporting also dates prior to 1970
Re: Some date functions supporting also dates prior to 1970
Hi,
first of all i must say that this one is very nice and mutch better that the native PB date library!
I miss only the ParseDate() function as ParseDate64().
I will be nice if you can add this as well.
Thanks and br,
Nico
first of all i must say that this one is very nice and mutch better that the native PB date library!
I miss only the ParseDate() function as ParseDate64().
I will be nice if you can add this as well.
Thanks and br,
Nico
my live space
Re: Some date functions supporting also dates prior to 1970
I could probably add something similar to ParseDate.nicolaus wrote:I miss only the ParseDate() function as ParseDate64().
I will be nice if you can add this as well.
If you need to parse timestamps in the format of yyyymmddhhmmss it would be faster to create a custom procedure for that.
Maybe this helps
http://www.purebasic.fr/english/viewtop ... 35&t=66420
Last edited by wilbert on Wed Aug 24, 2016 6:30 am, edited 1 time in total.
Windows (x64)
Raspberry Pi OS (Arm64)
Raspberry Pi OS (Arm64)
- Michael Vogel
- Addict
- Posts: 2677
- Joined: Thu Feb 09, 2006 11:27 pm
- Contact:
Re: Some date functions supporting also dates prior to 1970
Maybe a function 'DaysInMonth' could be added which does something like the following...
Code: Select all
Procedure.i MonthLen(date)
date=Date(Year(date),Month(date),28,0,0,0)+864000
ProcedureReturn Day(Date(Year(date),Month(date),1,0,0,0)-86400)
EndProcedure
For i=1 To 12
Debug MonthLen(Date(2016,i,i,0,0,0))
Next i
Re: Some date functions supporting also dates prior to 1970
This should work.Michael Vogel wrote:Maybe a function 'DaysInMonth' could be added
Code: Select all
Procedure DaysInMonth(DateQ.q)
Protected I.DateQInfo : DateQInfo(@I, DateQ)
If I\month < 8
If I\month = 2
ProcedureReturn 28 + IsLeapYear(I\year)
Else
ProcedureReturn 30 + I\month & 1
EndIf
Else
ProcedureReturn 31 - I\month & 1
EndIf
EndProcedure
Windows (x64)
Raspberry Pi OS (Arm64)
Raspberry Pi OS (Arm64)
- Michael Vogel
- Addict
- Posts: 2677
- Joined: Thu Feb 09, 2006 11:27 pm
- Contact:
Re: Some date functions supporting also dates prior to 1970
...wilbert wrote: This should work.
Thanks...
Code: Select all
Procedure DaysInMonth(DateQ.q)
Protected I.DateQInfo : DateQInfo(@I, DateQ)
If I\month = 2
ProcedureReturn 28 + IsLeapYear(I\year)
Else
ProcedureReturn (30 + I\month & 1) ! (I\month>>3)
EndIf
EndProcedure
Re: Some date functions supporting also dates prior to 1970
I thought about something like this but assumed it would be slower.Michael Vogel wrote:Code: Select all
Procedure DaysInMonth(DateQ.q) Protected I.DateQInfo : DateQInfo(@I, DateQ) If I\month = 2 ProcedureReturn 28 + IsLeapYear(I\year) Else ProcedureReturn (30 + I\month & 1) ! (I\month>>3) EndIf EndProcedure
After comparing your code with the existing one, there was no significant difference so I updated the code with your modification since it's a bit shorter.
Thanks.
Windows (x64)
Raspberry Pi OS (Arm64)
Raspberry Pi OS (Arm64)
- Michael Vogel
- Addict
- Posts: 2677
- Joined: Thu Feb 09, 2006 11:27 pm
- Contact:
Re: Some date functions supporting also dates prior to 1970
If you want to speed it up a little bit, you can swap the if-then-else structure - but if someone wants to know the days in february more often, it will be slower again...wilbert wrote:I thought about something like this but assumed it would be slower.
The following code was just for testing - and yes, no one should test with the debugger active (feel free to make your own tests)
Code: Select all
DisableDebugger
Procedure TakesAWhile()
ProcedureReturn Random(1)
EndProcedure
Procedure DaysInMonth(month.i)
If month-2
ProcedureReturn (30 + month & 1) ! (month>>3)
Else
ProcedureReturn 28 + TakesAWhile()
EndIf
EndProcedure
ti-ElapsedMilliseconds()
For i=0 To 999999
For m=1 To 12
z+DaysInMonth(m)
Next m
Next i
ti+ElapsedMilliseconds()
EnableDebugger
Debug ti
Re: Some date functions supporting also dates prior to 1970
@Wilbert
Great and very usefull Work !
Great and very usefull Work !
Re: Some date functions supporting also dates prior to 1970
@wilbert,
I have noticed that some of the functions, one such is WeekISO(), are not Declared but appear to work perfectly, if Declared.
Are these simply omissions or is there some subtle reason why I should not use them?
I have noticed that some of the functions, one such is WeekISO(), are not Declared but appear to work perfectly, if Declared.
Are these simply omissions or is there some subtle reason why I should not use them?
DE AA EB
Re: Some date functions supporting also dates prior to 1970
The conversion to a module was not posted by me.davido wrote:Are these simply omissions or is there some subtle reason why I should not use them?
I see the procedures aren't declared but there's no reason not to use them.
Windows (x64)
Raspberry Pi OS (Arm64)
Raspberry Pi OS (Arm64)
Re: Some date functions supporting also dates prior to 1970
To Wilbert: What do you think of this dll made in asm, here
http://mikhajduk.houa.org/EN/index.php?f=Calendar
http://mikhajduk.houa.org/Calendar/CalendarEN.zip
http://www.purebasic.fr/french/viewtopi ... 12&t=15015
For achive, i put under, the original code from Mikołaj Hajduk.
M.
http://mikhajduk.houa.org/EN/index.php?f=Calendar
http://mikhajduk.houa.org/Calendar/CalendarEN.zip
Few years ago, i made a translation for pb5.31 x86, here:; Calendar functions library written with FASM assembler.
;
; Abilities:
; * works with dates from the interval of 11 million years:
; - from 1 Jan 5843880 BCE to 3 Aug 5915100 for the Julian calendar,
; - from 30 Dec 5844001 BCE to 17 Jan 5915222 for the Gregorian calendar,
; * convenient conversions between Julian and Gregorian calendars for dates
; from supported time interval,
; * calculation of the day of the week for the given date,
; * calculation of the number of the day in the year,
; * determining if the given year is leap in chosen calendar,
; * calculation of the "absolute" day number for the given date (it could be
; used to calculation of the distance between two dates).
;
; (C) Mikołaj Hajduk, 16.06.2008.
http://www.purebasic.fr/french/viewtopi ... 12&t=15015
For achive, i put under, the original code from Mikołaj Hajduk.
Code: Select all
; Calendar functions library written with FASM assembler.
;
; Abilities:
; * works with dates from the interval of 11 million years:
; - from 1 Jan 5843880 BCE to 3 Aug 5915100 for the Julian calendar,
; - from 30 Dec 5844001 BCE to 17 Jan 5915222 for the Gregorian calendar,
; * convenient conversions between Julian and Gregorian calendars for dates
; from supported time interval,
; * calculation of the day of the week for the given date,
; * calculation of the number of the day in the year,
; * determining if the given year is leap in chosen calendar,
; * calculation of the "absolute" day number for the given date (it could be
; used to calculation of the distance between two dates).
;
; (C) Mikołaj Hajduk, 16.06.2008.
;
format PE GUI 4.0 DLL
entry DllEntryPoint
include 'win32a.inc'
; Definitions of the used constants.
;
C1 = 365 ; Number of days in a normal year.
C4 = 4*C1 + 1 ; Number of days in the 4-year cycle (base cycle of the Julian
; calendar).
C100 = 25*C4 - 1 ; Number of days in a "normal" century in the Gregorian calendar
; (i.e. century ending with a normal, 365-day, year).
C400 = 4*C100 + 1 ; Number of days in the complete 400-year cycle of the Gregorian
; calendar.
k = 30
J = 194796 ; The constants J and G are equal to the numbers of the complete years
G = 194800 ; of the Julian and Gregorian calendars respectively contained in the
; time interval given by "Great Cycle" T.
section '.data' data readable writeable
; Table containing lengths of months of a normal year (first 12 elements) and a leap year
; (next 12 elements).
;
MonthLen db 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31
db 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31
; Table containing values of the function 'DaySum' for every pair (month number, leap year flag).
;
DaySum dw 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334
dw 0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335
section '.code' code readable executable
proc DllEntryPoint, hinstDLL, fdwReason, lpvReserved
mov eax, TRUE
ret
endp
; DWORD DayOfWeek(DWORD Y, DWORD M, DWORD D, DWORD Gregorian)
;
; This function calculates the day of the week for the given date. Each day of the week is identified by number:
; 0 - Sunday, 1 - Monday, 2 - Tuesday, 3 - Wednesday, 4 - Thursday, 5 - Friday, 6 - Saturday.
;
; Parameters:
; Y - year,
; M - month,
; D - day,
; Gregorian - chosen calendar (0 - Julian, 1 - Gregorian).
;
; Returned values:
; * 0, 1, ..., 6 if the date is valid,
; * -1 for the invalid parameters.
;
proc DayOfWeek, Y, M, D, Gregorian
pushfd
push ebx edx
stdcall DateToAbsDayNum, [Y], [M], [D], [Gregorian] ; eax := N
test eax, eax
jz .Error
mov ebx, 7 ;
xor edx, edx ;
add eax, 5 ; edx := (eax + 5) mod 7 = (N + 5) mod 7
adc edx, edx ;
div ebx ;
xchg eax, edx ; eax := edx
jmp .End
.Error:
mov eax, -1
.End:
pop edx ebx
popfd
ret
endp
; DWORD IsLeapYear(DWORD Y, DWORD Gregorian)
;
; This function determines if the given year is leap in the chosen calendar.
;
; Parameters:
; Y - year,
; Gregorian - chosen calendar (0 - Julian, 1 - Gregorian).
;
; Returned values:
; * 1 if the year Y is leap, 0 - in opposite case,
; * -1 for the invalid parameters.
;
proc IsLeapYear, Y, Gregorian
pushfd
push ebx edx
.CheckParameters:
test [Gregorian], -2 ; 0 <= Gregorian <= 1
jnz .Error ;
.IsYNegative:
mov eax, [Y] ; eax := Y
test eax, eax
jz .Error
jns .CheckCalendar
; eax < 0 (Y < 0)
;
inc eax ; eax := eax + 1
neg eax ; eax := -eax = -(Y + 1) = -Y - 1 =
; = |Y| - [Y < 0] = Y'
.CheckCalendar:
cmp [Gregorian], 0
je .mod4
.Gregorian:
xor edx, edx ; eax := E(eax / 100) = E(Y' / 100)
mov ebx, 100 ; edx := eax mod 100 = Y' mod 100
div ebx ;
test edx, edx
jz .mod4
mov eax, edx ; eax := edx = Y' mod 100
;
; {(Y' mod 100) mod 4 = Y' mod 4}
.mod4:
shr eax, 1 ; eax := E(eax / 2); CF := eax mod 2
jc .Result ;
shr eax, 1 ; eax := E(eax / 2); CF := eax mod 2
jmp .Result ;
.Error:
mov eax, -1
jmp .End
.Result:
setnc al ; eax := not CF
movzx eax, al ;
.End:
pop edx ebx
popfd
ret
endp
; DWORD MDToDayNum(DWORD M, DWORD D, DWORD LeapYearFlag)
;
; This function calculates the ordinal number of the day in the year.
;
; Parameters:
; M - month,
; D - day,
; LeapYearFlag - flag determining if the year is leap (0 - normal year, 1 - leap year).
;
; Returned values:
; * 1, 2, ..., 365 for the normal year, 1, 2, ..., 366 for the leap year,
; * -1 for the invalid parameters.
;
proc MDToDayNum, M, D, LeapYearFlag
pushfd
push ebx edx
.LeapYearFlag:
test [LeapYearFlag], -2 ; 0 <= LeapYearFlag <= 1
jnz .Error ;
.Month:
cmp [M], 1 ;
jb .Error ; 1 <= M <= 12
cmp [M], 12 ;
ja .Error ;
.Day:
cmp [D], 1 ; D >= 1
jb .Error ;
mov ebx, [LeapYearFlag] ; ebx := LeapYearFlag
lea ebx, [ebx + 2*ebx] ; ebx := 3*ebx = 3*LeapYearFlag
shl ebx, 2 ; ebx := 4*ebx = 12*LeapYearFlag
mov edx, [M] ; eax := MonthLen[M - 1 + 12*LeapYearFlag]
movzx eax, [MonthLen - 1 + ebx + edx] ;
cmp [D], eax ; D <= MonthLen[M - 1 + 12*LeapYearFlag]
ja .Error ;
.CalculateDayNum:
shl ebx, 1 ; ebx := 2*ebx = 24*LeapYearFlag
movzx eax, [DaySum - 2 + ebx + 2*edx] ; eax := DaySum(M, LeapYearFlag)
add eax, [D] ; eax := eax + D = DaySum(M, LeapYearFlag) + D
jmp .End
.Error:
mov eax, -1
.End:
pop edx ebx
popfd
ret
endp
; DWORD DayNumToMD(DWORD n, DWORD LeapYearFlag, DWORD* M, DWORD* D)
;
; This function converts the ordinal number of the day in the year to the adequate month and day numbers.
; The result strongly depends on the flag determining if the year is leap.
;
; Parameters:
; n - number of the day in the year,
; LeapYearFlag - flag determining if the year is leap (0 - normal year, 1 - leap year),
; M - pointer to variable where the calculated month number will be stored,
; D - pointer to variable where the calculated day number will be stored.
;
; Returned values:
; * 0 for the valid parameters (n, LeapYearFlag),
; * -1 in opposite case.
;
proc DayNumToMD, n, LeapYearFlag, M, D
pushfd
push ebx ecx edx
.CheckParameters:
test [LeapYearFlag], -2 ; 0 <= LeapYearFlag <= 1
jnz .Error
cmp [n], 1 ; n >= 1
jb .Error ;
mov eax, 365 ;
add eax, [LeapYearFlag] ; eax := 365 + LeapYearFlag
cmp [n], eax ; n <= eax
ja .Error ;
.CalculateMD:
mov ebx, [LeapYearFlag] ; ebx := LeapYearFlag
lea ebx, [ebx + 2*ebx] ; ebx := 3*ebx = 3*LeapYearFlag
shl ebx, 3 ; ebx := 8*ebx = 24*LeapYearFlag
mov ecx, 12 ;
;
.Loop: ; ecx := max{i; 1 <= i <= 12, DaySum(i, LeapYearFlag) < n} = m
movzx edx, [DaySum - 2 + ebx + 2*ecx] ;
cmp [n], edx ; edx := DaySum(m, LeapYearFlag)
ja .LoopEnd ;
loop .Loop ;
.LoopEnd:
mov eax, [M] ; M := ecx = m
mov [eax], ecx ;
mov ecx, [n] ; ecx := n
sub ecx, edx ; ecx := ecx - edx = n - DaySum(m, LeapYearFlag)
mov eax, [D] ; D := ecx
mov [eax], ecx ;
xor eax, eax
jmp .End
.Error:
mov eax, -1
.End:
pop edx ecx ebx
popfd
ret
endp
; DWORD DateToAbsDayNum(DWORD Y, DWORD M, DWORD D, DWORD Gregorian)
;
; This function calculates the absolute day number for the given date.
;
; Parameters:
; Y - year,
; M - month,
; D - day,
; Gregorian - chosen calendar (0 - Julian, 1 - Gregorian).
;
; Returned values:
; * 1, 2, ..., 2^32-1 for the valid date in the chosen calendar,
; * 0 for the invalid parameters.
;
proc DateToAbsDayNum, Y, M, D, Gregorian
pushfd
push ebx ecx edx
test [Gregorian], -2 ; 0 <= Gregorian <= 1
jnz .Error ;
stdcall IsLeapYear, [Y], [Gregorian] ;
cmp eax, -1 ; eax := IsLeapYear(Y, Gregorian)
je .Error ;
; Y <> 0
mov ebx, eax ; ebx := eax
stdcall MDToDayNum, [M], [D], ebx ;
cmp eax, -1 ; eax := MDToDayNum(M, D, ebx) = n
je .Error ;
mov ecx, [Y] ;
cmp ecx, 0 ; ecx := Y
jg .CalculateDayNum ;
inc ecx ; Y < 0
; ecx := ecx + 1 = Y + 1 = Y + [Y < 0]
.CalculateDayNum:
add ecx, k*J ;
cmp [Gregorian], 0 ; ecx := ecx + kJ + k(G-J)[Gregorian = 1] =
je .Yprim0 ; = Y + [Y < 0] + kJ + k(G-J)[Gregorian = 1] = Y'
add ecx, k*(G-J) ;
.Yprim0:
cmp ecx, 0 ;
jne .YprimPositive ; Y' = 0
sub eax, 364 ; eax := eax - 364 = n - 364
jmp .End ;
.YprimPositive: ; Y' > 0
;
dec ecx ; ecx := ecx - 1 = Y' - 1
mov ebx, eax ; ebx := eax = n
mov eax, 365 ; eax := 365
mul ecx ; eax := 365 * ecx = 365(Y' - 1)
shr ecx, 2 ; ecx := E(ecx / 4) = E((Y' - 1) / 4)
add eax, ecx ; eax := eax + ecx = 365(Y' - 1) + E((Y' - 1) / 4)
add eax, ebx ; eax := eax + ebx = eax + n =
; = 365(Y' - 1) + E((Y' - 1) / 4) + n
cmp [Gregorian], 0
jz .End
.Gregorian:
push eax ; X := eax
xor edx, edx ;
mov eax, ecx ; eax := ecx = E((Y' - 1) / 4)
mov ebx, 25 ;
div ebx ; eax := E(eax / 25) = E(E((Y' - 1) / 4) / 25) =
; = E((Y' - 1) / 100)
mov ecx, eax ; ecx := eax = E((Y' - 1) / 100)
pop eax ; eax := X = 365(Y' - 1) + E((Y' - 1) / 4) + n
sub eax, ecx ; eax := eax - ecx = 365(Y' - 1) + E((Y' - 1) / 4) + n -
; - E((Y' - 1) / 100)
shr ecx, 2 ; ecx : = E(ecx / 4) = E(E((Y' - 1) / 100) / 4) =
; = E((Y' - 1) / 400)
add eax, ecx ; eax := eax + ecx = 365(Y' - 1) + E((Y' - 1) / 4) + n -
; - E((Y' - 1) / 100) + E((Y' - 1) / 400)
add eax, 2 ; eax := eax + 2 = 365(Y' - 1) + E((Y' - 1) / 4) + n -
; - E((Y' - 1) / 100) + E((Y' - 1) / 400) + 2 =
; = N
jmp .End
.Error:
xor eax, eax
.End:
pop edx ecx ebx
popfd
ret
endp
; DWORD AbsDayNumToDate(DWORD N, DWORD Gregorian, DWORD* Y, DWORD* M, DWORD* D)
;
; This function converts the absolute day number N = 1, 2, ..., 2^32-1 to the adequate date (for the chosen calendar).
;
; Parameters:
; N - absolute day number,
; Gregorian - chosen calendar (0 - Julian, 1 - Gregorian),
; Y - pointer to variable where the calculated year number will be stored,
; M - pointer to variable where the calculated month number will be stored,
; D - pointer to variable where the calculated day number will be stored.
;
; Returned values:
; * 0 for the valid parameters (N, Gregorian),
; * -1 in opposite case.
;
proc AbsDayNumToDate, N, Gregorian, Y, M, D
pushfd
push ebx ecx edx
cmp [N], 0 ; N <> 0
je .Error ;
test [Gregorian], -2 ; 0 <= Gregorian <= 1
jnz .Error ;
xor ecx, ecx ; ecx := 0
mov eax, [N] ; eax := N - 1
dec eax ;
cmp [Gregorian], 0
je .Julian
.Gregorian:
cmp eax, 1
ja .NextDays
; 0 <= eax <= 1 (1 <= N <= 2)
mov ebx, [M] ; M := 12
mov dword [ebx], 12 ;
add eax, 30 ; eax := eax + 30 = N - 1 + 30 = N + 29
mov ebx, [D] ; D := eax = N + 29
mov [ebx], eax ;
mov ecx, -k*G - 1 ; ecx := -kG - 1
jmp .ReturnY
.NextDays: ; eax > 1 (N > 2)
sub eax, 2 ; eax := eax - 2 = N - 1 - 2 = N - 3
xor edx, edx ;
mov ebx, C400 ; eax := E(eax / C400) = E((N - 3) / C400)
div ebx ; edx := eax mod C400 = (N - 3) mod C400
lea eax, [eax + 4*eax] ; eax := 5*eax = 5*E((N - 3) / C400)
lea eax, [eax + 4*eax] ; eax := 5*eax = 5*(5*E((N - 3) / C400)) =
; = 25*E((N - 3) / C400)
shl eax, 4 ; eax := 16*eax = 16*(25*E((N - 3) / C400)) =
; = 400*E((N - 3) / C400)
xchg ecx, eax ; ecx := eax = 400*E((N - 3) / C400)
;
xchg eax, edx ; eax := edx = (N - 3) mod C400
;
.Centuries: ;
cmp eax, C100 ;
jb .Julian ;
;
add ecx, 100 ;
sub eax, C100 ;
;
cmp eax, C100 ; (eax, ecx) := P(eax, ecx) =
jb .Julian ; = P((N - 3) mod C400, 400*E((N - 3) / C400)) =
; = (N100, Y100)
add ecx, 100 ;
sub eax, C100 ;
;
cmp eax, C100 ;
jb .Julian ;
;
add ecx, 100 ;
sub eax, C100 ;
.Julian:
; /
; | (N - 1, 0) ; Gregorian = 0
; (N100, Y100) = (eax, ecx) = <
; | P((N - 3) mod C400, 400*E((N - 3) / C400)) ; Gregorian = 1
; \
xor edx, edx ;
mov ebx, C4 ; eax := E(eax / C4) = E(N100 / C4)
div ebx ; edx := eax mod C4 = N100 mod C4
shl eax, 2 ; eax := 4*eax = 4*E(N100 / C4)
add ecx, eax ; ecx := ecx + eax = Y100 + 4*E(N100 / C4)
.Years: ;
inc ecx ;
cmp edx, C1 ;
jb .MD ;
;
sub edx, C1 ;
;
inc ecx ; (edx, ecx) := Q(edx, ecx) =
cmp edx, C1 ; = Q(N100 mod C4, Y100 + 4*E(N100 / C4)) =
jb .MD ; = (N', Y*)
;
sub edx, C1 ;
;
inc ecx ;
cmp edx, C1 ;
jb .MD ;
;
sub edx, C1 ;
;
inc ecx ;
.MD:
inc edx ; edx := edx + 1 = N' + 1
stdcall IsLeapYear, ecx, [Gregorian] ; eax := IsLeapYear(ecx, Gregorian) =
; = IsLeapYear(Y*, Gregorian)
stdcall DayNumToMD, edx, eax, [M], [D] ; eax := DayNumToMD(edx, eax, M, D) =
; = DayNumToMD(N' + 1, IsLeapYear(Y*, Gregorian), M, D)
cmp [Gregorian], 0
je .JulianYears
.GregorianYears: ;
sub ecx, k*(G - J) ;
; ecx := ecx - kJ - k(G - J)[Gregorian = 1] =
.JulianYears: ; = Y* - kJ - k(G - J)[Gregorian = 1] =
sub ecx, k*J ; = Y'
cmp ecx, 0
jg .ReturnY
; ecx <= 0 (Y' <= 0)
dec ecx ; ecx := ecx - 1 = Y' - 1 = Y' - [Y' <= 0]
.ReturnY:
mov eax, [Y] ; Y := ecx
mov [eax], ecx ;
xor eax, eax
jmp .End
.Error:
mov eax, -1
.End:
pop edx ecx ebx
popfd
ret
endp
; DWORD GregorianToJulian(DWORD Yg, DWORD Mg, DWORD Dg, DWORD* Yj, DWORD* Mj, DWORD* Dj)
;
; This function converts the Gregorian date to the adequate Julian date.
;
; Parameters:
; Yg - year of the Gregorian date,
; Mg - month of the Gregorian date,
; Dg - day of the Gregorian date,
; Yj - pointer to variable where the calculated year number of the Julian date will be stored,
; Mj - pointer to variable where the calculated month number of the Julian date will be stored,
; Dj - pointer to variable where the calculated day number of the Julian date will be stored.
;
; Returned values:
; * 0 for the valid Gregorian date,
; * -1 in opposite case.
;
proc GregorianToJulian, Yg, Mg, Dg, Yj, Mj, Dj
.GregorianToNum:
stdcall DateToAbsDayNum, [Yg], [Mg], [Dg], 1
test eax, eax
jz .Error
.NumToJulian:
stdcall AbsDayNumToDate, eax, 0, [Yj], [Mj], [Dj]
jmp .End
.Error:
mov eax, -1
.End:
ret
endp
; DWORD JulianToGregorian(DWORD Yj, DWORD Mj, DWORD Dj, DWORD* Yg, DWORD* Mg, DWORD* Dg)
;
; This function converts the Julian date to the adequate Gregorian date.
;
; Parameters:
; Yj - year of the Julian date,
; Mj - month of the Julian date,
; Dj - day of the Julian date,
; Yg - pointer to variable where the calculated year number of the Gregorian date will be stored,
; Mg - pointer to variable where the calculated month number of the Gregorian date will be stored,
; Dg - pointer to variable where the calculated day number of the Gregorian date will be stored.
;
; Returned values:
; * 0 for the valid Julian date,
; * -1 in opposite case.
;
proc JulianToGregorian, Yj, Mj, Dj, Yg, Mg, Dg
.JulianToNum:
stdcall DateToAbsDayNum, [Yj], [Mj], [Dj], 0
test eax, eax
jz .Error
.NumToGregorian:
stdcall AbsDayNumToDate, eax, 1, [Yg], [Mg], [Dg]
jmp .End
.Error:
mov eax, -1
.End:
ret
endp
section '.edata' export data readable
export 'Calendar.dll',\
AbsDayNumToDate, 'AbsDayNumToDate',\
DateToAbsDayNum, 'DateToAbsDayNum',\
DayNumToMD, 'DayNumToMD',\
DayOfWeek, 'DayOfWeek',\
GregorianToJulian, 'GregorianToJulian',\
IsLeapYear, 'IsLeapYear',\
JulianToGregorian, 'JulianToGregorian',\
MDToDayNum, 'MDToDayNum'
section '.reloc' fixups data discardable
Re: Some date functions supporting also dates prior to 1970
It's a bit hard for me to understand the codeMesa wrote:To Wilbert: What do you think of this dll made in asm, here
At the moment I don't know what is best, all PureBasic code, asm or a lookup table.
Usually I prefer asm for the speed but it is harder to understand the code.
Windows (x64)
Raspberry Pi OS (Arm64)
Raspberry Pi OS (Arm64)
Re: Some date functions supporting also dates prior to 1970
@wilbert,
Thank you.
Thank you.
Code: Select all
; http://www.purebasic.fr/english/viewtopic.php?p=421612#p421612
; By wilbert
DeclareModule QDate
Structure DateQInfo
yday.w ; offset 0 : days since Jan 1 [1-366]
year.w ; offset 2 : year [1600-9999]
month.b ; offset 4 : months [1-12]
day.b ; offset 5 : day of the month [1-31]
hour.b ; offset 6 : hours [0-23]
min.b ; offset 7 : minutes [0-59]
sec.b ; offset 8 : seconds [0-59]
wday.b ; offset 9 : days since Sunday [0-6]
EndStructure
Structure DateQ_CharArray
c.c[0]
EndStructure
Declare.q DateQ(year, month = 1, day = 1, hour = 0, min = 0, sec = 0)
Declare DateQInfo(*Info.DateQInfo, DateQ.q)
Declare IsLeapYear(Year)
Declare YearQ(DateQ.q)
Declare MonthQ(DateQ.q)
Declare DayQ(DateQ.q)
Declare HourQ(DateQ.q)
Declare MinuteQ(DateQ.q)
Declare SecondQ(DateQ.q)
Declare DayOfWeekQ(DateQ.q)
Declare DayOfYearQ(DateQ.q)
Declare.q AddDateQ(DateQ.q, Type, Value)
Declare WeekISO(DateQ.q)
EndDeclareModule
Module QDate
;
; Please don't blame me for using ASM. I know it can easily be done without but that's just the fun part For me :wink:
; You can use these procedures If you need To support dates prior To 1970 Or If you need the speed As they same To be faster compared To the built in routines.
; Dates have To be between 1582/10/15 (-12219292800) And 9999/12/31 (253402300799)
;
; Supported procedures :
; DateQ(year, month, day, hour, min, sec)
; DateQInfo(*Info.DateQInfo, DateQ.q)
;
; AddDateQ(DateQ.q, Type, Value)
; DayFromYMW(Year, Month, Weekday, n)
; DayOfWeekQ(DateQ.q)
; DayOfYearQ(DateQ.q)
; DayQ(DateQ.q)
; FormatDateQ(Mask$, DateQ.q)
; HourQ(DateQ.q)
; IsLeapYear(Year)
; MinuteQ(DateQ.q)
; MonthQ(DateQ.q)
; SecondQ(DateQ.q)
; WeekISO(DateQ.q)
; YearQ(DateQ.q)
Code:
; *** DateQ.pbi v 1.03 2013/08/18 ***
; *** Structures ***
; *** Create lookup tables (about 65 KiB) ***
Global Dim DateQ_LUT.l(16384)
Global Dim DateQ_LUT2.w(2024)
Procedure DateQ_LUT_Init()
Protected.i y, y_, d, d_, w, m
While y < 16384
d = y >> 2 : y_ = d / 25 : d - y_ : y_ >> 2 : d + y_
y + 1
y_ = d - d_ : w + 1 + y_ : d_ = d
If w > 6 : w - 7 : EndIf
DateQ_LUT(y - 1) | y_ << 4
DateQ_LUT(y) = (d + y * 365 + 1) << 8 | w << 5
Wend
y = 0 : y_ = 512
For m = 1 To 12
If m = 2
For d = 1 To 28
w = m | d << 8
DateQ_LUT2(y) = w : y + 1
DateQ_LUT2(y_) = w : y_ + 1
Next
DateQ_LUT2(y_) = 2 | 29 << 8 : y_ + 1
Else
d_ = 30 + (m & 1) ! (m >> 3)
For d = 1 To d_
w = m | d << 8
DateQ_LUT2(y) = w : y + 1
DateQ_LUT2(y_) = w : y_ + 1
Next
EndIf
Next
EndProcedure
DateQ_LUT_Init()
; *** ASM procedures ***
Procedure.q DateQ(year, month = 1, day = 1, hour = 0, min = 0, sec = 0)
!mov ecx, [p.v_year]
!and ecx, 16383
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
!mov rdx, [qdate.a_DateQ_LUT]
!mov eax, [rdx + rcx * 4]
!mov rcx, [p.v_month]
!or rcx, rax
!and rcx, 31
!lea rdx, [dateq_oday_table]
!movsx rcx, word [rdx + rcx * 2]
!shr rax, 8
!add rax, rcx
!add rax, [p.v_day]
!sub rax, 0xafaa9
!imul rax, 86400
!mov rcx, [p.v_hour]
!lea rcx, [rcx + rcx * 4]; *5
!lea rcx, [rcx + rcx * 2]; *3
!sal rcx, 2; *4
!add rcx, [p.v_min]
!lea rcx, [rcx + rcx * 4]; *5
!lea rcx, [rcx + rcx * 2]; *3
!sal rcx, 2; *4
!add rcx, [p.v_sec]
!add rax, rcx
CompilerElse
!mov edx, [qdate.a_DateQ_LUT]
!mov eax, [edx + ecx * 4]
!mov ecx, [p.v_month]
!or ecx, eax
!and ecx, 31
!movsx ecx, word [dateq_oday_table + ecx * 2]
!shr eax, 8
!add eax, ecx
!add eax, [p.v_day]
!sub eax, 0xafaa9
!mov ecx, 86400
!imul ecx
!mov ecx, [p.v_hour]
!lea ecx, [ecx + ecx * 4]; *5
!lea ecx, [ecx + ecx * 2]; *3
!sal ecx, 2; *4
!add ecx, [p.v_min]
!lea ecx, [ecx + ecx * 4]; *5
!lea ecx, [ecx + ecx * 2]; *3
!sal ecx, 2; *4
!add ecx, [p.v_sec]
!add eax, ecx
!adc edx, 0
!sar ecx, 31
!add edx, ecx
CompilerEndIf
ProcedureReturn
!dateq_oday_table:
!dw -31,0,31,59,90,120,151,181,212,243,273,304,334,365,396,-61 ; normal year
!dw -31,0,31,60,91,121,152,182,213,244,274,305,335,366,397,-61 ; leap year
EndProcedure
Procedure DateQInfo(*Info.DateQInfo, DateQ.q)
!mov eax, [p.v_DateQ]
!mov edx, [p.v_DateQ + 4]
; split into date and time
!add eax, 0x79747c00
!adc edx, 0xe
!and edx, 0x7f
!mov ecx, 86400
!div ecx
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
!mov r8, [p.p_Info]
!mov r9, rax
; process the time part
!mov eax, edx
!xor edx, edx
!mov ecx, 60
!div ecx
!mov [r8 + 8], dl
!div cl
!mov [r8 + 6], ax
; process the date part
!mov rax, r9
; guess the year
!mov ecx, 0xb36d83
!mul ecx
!and rdx, 16383
; correct it if wrong
!mov rcx, [qdate.a_DateQ_LUT]
!mov eax, [rcx + rdx * 4 + 4]
!shr rax, 8
!cmp r9, rax
!cmc
!adc rdx, 0
!mov [r8 + 2], dx; year
!mov eax, [rcx + rdx * 4]
; get the other info
!movzx rcx, al
!shr rax, 8
!sub r9, rax
!and r9, 511
!lea rdx, [r9 + 1]
!mov [r8], dx; yday
!mov rdx, rcx
!shl rdx, 5
!and rdx, 512
!or rdx, r9
!mov rax, [qdate.a_DateQ_LUT2]
!mov dx, [rax + rdx * 2]
!mov [r8 + 4], dx; day and month
!mov rax, r9
!shr rcx, 5
!add rax, rcx
!mov cl, 7
!div cl
!mov al, ah
!mov [r8 + 9], al; wday
CompilerElse
!mov ecx, [p.p_Info]
!push edi
!push ebx
!mov edi, ecx
!mov ebx, eax
; process the time part
!mov eax, edx
!xor edx, edx
!mov ecx, 60
!div ecx
!mov [edi + 8], dl
!div cl
!mov [edi + 6], ax
; process the date part
!mov eax, ebx
; guess the year
!mov ecx, 0xb36d83
!mul ecx
!and edx, 16383
; correct it if wrong
!mov ecx, [qdate.a_DateQ_LUT]
!mov eax, [ecx + edx * 4 + 4]
!shr eax, 8
!cmp ebx, eax
!cmc
!adc edx, 0
!mov [edi + 2], dx; year
!mov eax, [ecx + edx * 4]
; get the other info
!movzx ecx, al
!shr eax, 8
!sub ebx, eax
!and ebx, 511
!lea edx, [ebx + 1]
!mov [edi], dx; yday
!mov edx, ecx
!shl edx, 5
!and edx, 512
!or edx, ebx
!mov eax, [qdate.a_DateQ_LUT2]
!mov dx, [eax + edx * 2]
!mov [edi + 4], dx; day and month
!mov eax, ebx
!shr ecx, 5
!add eax, ecx
!mov cl, 7
!div cl
!mov [edi + 9], ah; wday
!pop ebx
!pop edi
CompilerEndIf
EndProcedure
; *** Non ASM procedures ***
Procedure IsLeapYear(Year)
ProcedureReturn DateQ_LUT(Year) >> 4 & 1
EndProcedure
Procedure YearQ(DateQ.q)
Protected I.DateQInfo : DateQInfo(@I, DateQ) : ProcedureReturn I\year
EndProcedure
Procedure MonthQ(DateQ.q)
Protected I.DateQInfo : DateQInfo(@I, DateQ) : ProcedureReturn I\month
EndProcedure
Procedure DayQ(DateQ.q)
Protected I.DateQInfo : DateQInfo(@I, DateQ) : ProcedureReturn I\day
EndProcedure
Procedure HourQ(DateQ.q)
Protected I.DateQInfo : DateQInfo(@I, DateQ) : ProcedureReturn I\hour
EndProcedure
Procedure MinuteQ(DateQ.q)
Protected I.DateQInfo : DateQInfo(@I, DateQ) : ProcedureReturn I\min
EndProcedure
Procedure SecondQ(DateQ.q)
Protected I.DateQInfo : DateQInfo(@I, DateQ) : ProcedureReturn I\sec
EndProcedure
Procedure DayOfWeekQ(DateQ.q)
Protected I.DateQInfo : DateQInfo(@I, DateQ) : ProcedureReturn I\wday
EndProcedure
Procedure DayOfYearQ(DateQ.q)
Protected I.DateQInfo : DateQInfo(@I, DateQ) : ProcedureReturn I\yday
EndProcedure
Procedure.q AddDateQ(DateQ.q, Type, Value)
Protected I.DateQInfo, D.q
Select Type
Case #PB_Date_Year
DateQInfo(@I, DateQ) : I\year + Value
If I\month = 2 And I\yday = 60
If IsLeapYear(I\year) = 0 : I\day = 28 : EndIf
EndIf
DateQ = DateQ(I\year, I\month, I\day, I\hour, I\min, I\sec)
Case #PB_Date_Month
DateQInfo(@I, DateQ) : I\month + Value
While I\month < 1 : I\year - 1 : I\month + 12 : Wend
While I\month > 12 : I\year + 1 : I\month - 12 : Wend
DateQ = DateQ(I\year, I\month, I\day, I\hour, I\min, I\sec)
D = DateQ(I\year, I\month + 1, 0, I\hour, I\min, I\sec)
If DateQ > D : DateQ = D : EndIf
Case #PB_Date_Week : DateQ + Value * 604800
Case #PB_Date_Day : DateQ + Value * 86400
Case #PB_Date_Hour : DateQ + Value * 3600
Case #PB_Date_Minute : DateQ + Value * 60
Case #PB_Date_Second : DateQ + Value
EndSelect
ProcedureReturn DateQ
EndProcedure
Procedure FormatDateQ_Set(*addr.DateQ_CharArray, value, size = 2)
While size
size - 1 : *addr\c[size] = $30 | value % 10 : value / 10
Wend
EndProcedure
Procedure.s FormatDateQ(Mask$, DateQ.q)
Protected *a.DateQ_CharArray = @Mask$
Protected.i r, w, l, I.DateQInfo, c1.c, c2.c, c.c = *a\c[0]
DateQInfo(@I, DateQ)
While c
If c = 37; %
c1 = *a\c[r + 1]
If c1
c1 | 32 : c2 = *a\c[r + 2] | 32
If c1 = c2
Select c1
Case 121; yy
l = 2 : c1 = *a\c[r + 3]
If c1
c1 | 32 : c2 = *a\c[r + 4] | 32
If c1 = 121 And c2 = 121 : l = 4 : EndIf
EndIf
FormatDateQ_Set(@*a\c[w], I\year, l) : w + l : r + l + 1
Case 109; mm
FormatDateQ_Set(@*a\c[w], I\month) : w + 2 : r + 3
Case 100; dd
FormatDateQ_Set(@*a\c[w], I\day) : w + 2 : r + 3
Case 104; hh
FormatDateQ_Set(@*a\c[w], I\hour) : w + 2 : r + 3
Case 105; ii
FormatDateQ_Set(@*a\c[w], I\min) : w + 2 : r + 3
Case 115; ss
FormatDateQ_Set(@*a\c[w], I\sec) : w + 2 : r + 3
Default
*a\c[w] = c : w + 1 : r + 1
EndSelect
EndIf
EndIf
Else
*a\c[w] = c : w + 1 : r + 1
EndIf
c = *a\c[r]
Wend
*a\c[w] = 0
ProcedureReturn Mask$
EndProcedure
Procedure WeekISO(DateQ.q)
Protected.i week1_prev, week1_this, week1_next, y = YearQ(DateQ)
Protected.i d = DateQ / 86400 + $afaa8
week1_prev = DateQ_LUT(y - 1)
week1_prev = (week1_prev >> 8) + 3 - (week1_prev >> 5 & 7 + 2) % 7
week1_this = DateQ_LUT(y)
week1_this = (week1_this >> 8) + 3 - (week1_this >> 5 & 7 + 2) % 7
week1_next = DateQ_LUT(y + 1)
week1_next = (week1_next >> 8) + 3 - (week1_next >> 5 & 7 + 2) % 7
If d < week1_this
ProcedureReturn (d - week1_prev) / 7 + 1
ElseIf d >= week1_next
ProcedureReturn 1
Else
ProcedureReturn (d - week1_this) / 7 + 1
EndIf
EndProcedure
Procedure DayFromYMW(Year, Month, Weekday, n = 1)
Protected I.DateQInfo, D.q = DateQ(Year, Month)
DateQInfo(@I, D)
D = DateQ(I\year, I\month, I\day + (Weekday - I\wday + 7) % 7 + n * 7 - 7)
DateQInfo(@I, D)
If I\month = Month
ProcedureReturn I\day
Else
ProcedureReturn -1
EndIf
EndProcedure
EndModule
Debug QDate::Date())
DE AA EB
Re: Some date functions supporting also dates prior to 1970
This Date module is great, but it doesn't compile with the C backend because it uses ASM. Is there an alternative Date module that doesn't use ASM so I can compile my app with the C backend? Thanks!
Re: Some date functions supporting also dates prior to 1970
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive