# PureBasic Forum

 It is currently Wed Jan 20, 2021 4:33 am

 All times are UTC + 1 hour

 Page 1 of 1 [ 5 posts ]
 Print view Previous topic | Next topic
Author Message
 Post subject: Compute Dates on 11 millions yearsPosted: Fri Dec 20, 2013 10:02 am
 Enthusiast

Joined: Fri Feb 24, 2012 10:19 am
Posts: 205
This is just the translation for PB 5.xx of the Mikolaj Hajduk's DLL that you can find at http://mikhajduk.houa.org/EN/index.php?f=Links
(Thank's Miko )

It works on my Windows Xp 32b but i need more tests and no tests have been done on 64b, linux and osx.

 Try to debug in 64b

Code:

; Mesa

; The library contains 8 functions For operations With dates:
;
;     DayOfWeek - calculates the day of the week For the given date,
;     IsLeapYear - determines If the given year is leap IN the chosen calendar,
;     MDToDayNum - calculates the ordinal number of the day IN the year,
;     DayNumToMD - converts the ordinal number of the day IN the year To the adequate month And day numbers,
;     DateToAbsDayNum - calculates the absolute day number For the given date,
;     AbsDayNumToDate - converts the absolute day number To the adequate Date (For the chosen calendar),
;     GregorianToJulian - converts the Gregorian date To the adequate Julian date,
;     JulianToGregorian - converts the Julian date To the adequate Gregorian date.

; 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) Mikolaj Hajduk, 16.06.2008.
; Translation in PureBasic 5.xx by Mesa.

; Definitions of the used constants.
;
; Global C1   = 365         ; Number of days in a normal year.
;
; Global C4   = 4*C1 + 1      ; Number of days in the 4-year cycle (base cycle of the Julian
;             ; calendar).
;
; Global 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).
;
; Global C400   = 4*C100 + 1      ; Number of days in the complete 400-year cycle of the Gregorian
;             ; calendar.
;
; Global k   = 30
;
; Global J   = 194796      ; The constants J and G are equal to the numbers of the complete years
; Global 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

;=============================== Debug =====================================
;Global debugexx ; Use for debugging
; --------debug--------------
; MOV debugexx, eax
; Debug debugexx
; ---------------------------

;=============================== Procedures =================================
; 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
Procedure.l IsLeapYear(year.l, gregorian.l)

EnableASM
; PUSHFD
; PUSH ebx edx

checkparameters:
TEST   gregorian, -2       ; 0 <= Gregorian <= 1
JNZ   l_isleapyear_error

isynegative:
MOV   eax, year               ; eax := Y =year

TEST   eax, eax
JZ   l_isleapyear_error
JNS   l_isleapyear_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   l_isleapyear_mod4

gregorian:
XOR   edx, edx               ; eax := E(eax / 100) = E(Y' / 100)
MOV   ecx, 100               ; edx := eax mod 100 = Y' mod 100
DIV   ecx                    ; div=(edx:eax)/ecx -> Quotient=eax Reste=edx
; Long .l 4 octets -2147483648 à +2 147 483 647

TEST   edx, edx
JZ   l_isleapyear_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   l_isleapyear_result                  ;

SHR   eax, 1                  ; eax := E(eax / 2); CF := eax mod 2
JMP   l_isleapyear_result                  ;

error:
MOV   eax, -1
JMP   l_isleapyear_theend

result:
SETNC   al                  ; eax := not CF
MOVZX   eax, al

theend:
; POP edx ebx
; POPFD

DisableASM

ProcedureReturn
EndProcedure

; 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
Procedure.l MDToDayNum(M.l, D.l, LeapYearFlag.l)

EnableASM

leapyearflag:
TEST   LeapYearFlag, -2            ; 0 <= LeapYearFlag <= 1
JNZ   l_mdtodaynum_error                  ;

month:
CMP   M, 1
JB   l_mdtodaynum_error                  ; 1 <= M <= 12
CMP   M, 12
JA   l_mdtodaynum_error

day:
CMP   D, 1                  ; D >= 1
JB   l_mdtodaynum_error
MOV   eax, LeapYearFlag          ; eax := LeapYearFlag
LEA   eax, [eax + 2*eax]         ; eax := 3*eax = 3*LeapYearFlag
SHL   eax, 2                     ; eax := 4*eax = 12*LeapYearFlag

LEA ecx,[monthlen2] ;eax => MonthLen[M - 1 + 12*LeapYearFlag]
DEC ecx       ; -1
MOV edx, M    ;+M

MOV edx, eax  ; Sauvegarde de 12*LeapYearFlag

MOVZX eax, byte [ecx]

CMP   D, eax               ; D <= MonthLen[M - 1 + 12*LeapYearFlag]
JA   l_mdtodaynum_error                  ;

calculatedaynum:
SHL   edx, 1                  ; edx := 2*edx = 24*LeapYearFlag (2 parce que word et non byte)
;MOVZX eax, [DaySum - 2 + edx + 2*M]
LEA ecx,[daysum2]

DEC ecx       ; -1
DEC ecx       ; -1

MOV edx, M
MOVZX eax, word [ecx]

ADD   eax, D      ; eax := eax + D = DaySum(M, LeapYearFlag) + D
JMP   l_mdtodaynum_theend

error:
MOV   eax, -1

theend:

DisableASM
ProcedureReturn
!monthlen2:
!DB 31,28,31,30,31,30,31,31,30,31,30,31,31,29,31,30,31,30,31,31,30,31,30,31

!daysum2:
!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
EndProcedure
;

; 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
Procedure.l DayNumToMD(n.l, LeapYearFlag.l, M.l, D.l)
Protected tmp.l

EnableASM
checkparameters:
TEST   LeapYearFlag, -2   ; 0 <= LeapYearFlag <= 1
JNZ   l_daynumtomd_error

CMP   n, 1                      ; n >= 1
JB   l_daynumtomd_error   ;Jump short if below (CF=1).

MOV   eax, 365
ADD   eax, LeapYearFlag   ; eax := 365 + LeapYearFlag
CMP   n, eax                 ; n <= eax
JA   l_daynumtomd_error

calculatemd:
MOV   eax, LeapYearFlag   ; eax := LeapYearFlag
LEA   eax, [eax + 2*eax]; eax := 3*eax = 3*LeapYearFlag
SHL   eax, 3                  ; eax := 8*eax = 24*LeapYearFlag

MOV tmp, eax             ; Sauvegarde de 24*LeapYearFlag dans tmp

MOV   ecx, 12                  ;

!@@:                       ; ecx := max{i; 1 <= i <= 12, DaySum(i, LeapYearFlag) < n} = m
LEA eax,[daysum]
DEC eax
DEC eax
MOVZX   edx, word [eax];MOVZX   edx, [DaySum - 2 + ebx + 2*ecx]

CMP   n, edx               ; edx := DaySum(m, LeapYearFlag)
JA   l_daynumtomd_loopend
LOOP   @b ;l_daynumtomd_lloop

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   l_daynumtomd_theend

error:
MOV   eax, -1

theend:

DisableASM

ProcedureReturn
!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
EndProcedure

;
; 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
Procedure.l DateToAbsDayNum( Y.l, M.l, D.l, Gregorian.l)
;PUSHFD
;PUSH   ebx ecx edx
Protected X.l

EnableASM
TEST   Gregorian, -2                  ; 0 <= Gregorian <= 1
JNZ   l_datetoabsdaynum_error

IsLeapYear(Y, Gregorian)
CMP   eax, -1                           ; eax := IsLeapYear(Y, Gregorian)
JE   l_datetoabsdaynum_error

; Y <> 0

;MOV   ebx, eax                      ; ebx := eax
MOV X, eax

MDToDayNum(M, D, X)         ;ebx
CMP   eax, -1                     ; eax := MDToDayNum(M, D, ebx) = n
JE   l_datetoabsdaynum_error

MOV   ecx, Y
CMP   ecx, 0                     ; ecx := Y
JG   l_datetoabsdaynum_calculatedaynum

INC   ecx               ; Y < 0
; ecx := ecx + 1 = Y + 1 = Y + [Y < 0]

calculatedaynum:
;       Global k   = 30
;     Global J   = 194796      ; The constants J and G are equal to the numbers of the complete years
;     Global G   = 194800      ; of the Julian and Gregorian calendars respectively contained in the
; time interval given by "Great Cycle" T.

CMP   Gregorian, 0               ; ecx := ecx + kJ + k(G-J)[Gregorian = 1] =
JE   l_datetoabsdaynum_yprim0   ; = Y + [Y < 0] + kJ + k(G-J)[Gregorian = 1] = Y'
;     Global k   = 30
;     Global J   = 194796      ; The constants J and G are equal to the numbers of the complete years
;     Global G   = 194800      ; of the Julian and Gregorian calendars respectively contained in the
; time interval given by "Great Cycle" T.

yprim0:
CMP   ecx, 0
JNE   l_datetoabsdaynum_yprimpositive         ; Y' = 0
SUB   eax, 364                                 ; eax := eax - 364 = n - 364
JMP   l_datetoabsdaynum_theend

yprimpositive:         ; Y' > 0

DEC   ecx                  ; ecx := ecx - 1 = Y' - 1
MOV X, eax

MOV   eax, 365         ; eax := 365
MUL   ecx                  ; eax := 365 * ecx = 365(Y' - 1);(EDX:EAX <- EAX * r/m32

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, X            ;      = 365(Y' - 1) + E((Y' - 1) / 4) + n

CMP   Gregorian, 0
JZ   l_datetoabsdaynum_theend

gregorian:
MOV X, eax                 ; Sauvegarde de eax

XOR   edx, edx               ;
MOV   eax, ecx               ; eax := ecx = E((Y' - 1) / 4)
MOV   ecx, 25                  ;
DIV   ecx                      ; eax := E(eax / 25) = E(E((Y' - 1) / 4) / 25) =
;      = E((Y' - 1) / 100)
;Unsigned divide EDX:EAX by r/m32, with
;result stored IN EAX <- Quotient, EDX <- Remainder.

MOV   ecx, eax               ; ecx := eax = E((Y' - 1) / 100)
; eax := X = 365(Y' - 1) + E((Y' - 1) / 4) + n
MOV eax, X

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   l_datetoabsdaynum_theend

error:
XOR   eax, eax

theend:

;POP   edx ecx ebx
;POPFD
DisableASM
ProcedureReturn

EndProcedure
;
;
; 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
Procedure AbsDayNumToDate( N.l, Gregorian.l, Y.l, M.l, D.l)
;PUSHFD
;PUSH   ebx ecx edx
Protected.l tmpeax, tmpecx, tmpedx, tmpeflags, tmp

EnableASM
CMP   N, 0                     ; N <> 0 ; l'année  n'existe pas
JE   l_absdaynumtodate_error                     ;

TEST   Gregorian, -2      ; 0 <= Gregorian <= 1
JNZ   l_absdaynumtodate_error                     ;

XOR   ecx, ecx               ; ecx := 0

MOV   eax, N                 ; eax := N - 1
DEC   eax                       ;

CMP   Gregorian, 0
JE   l_absdaynumtodate_julian

gregorian:
CMP   eax, 1
JA   l_absdaynumtodate_nextdays ;Jump short if above (CF=0 and ZF=0).
; 0 <= eax <= 1 (1 <= N <= 2)
MOV   ecx, M               ; M := 12
MOV   dword [ecx], 12               ;

ADD   eax, 30               ; eax := eax + 30 = N - 1 + 30 = N + 29

MOV   ecx, D               ; D := eax = N + 29
MOV   [ecx], eax         ;

MOV   ecx, -5844001   ; -k*G - 1      ; ecx := -kG - 1 = -5844001
;       Global k   = 30
;     Global J   = 194796      ; The constants J and G are equal to the numbers of the complete years
;     Global G   = 194800      ; of the Julian and Gregorian calendars respectively contained in the
; time interval given by "Great Cycle" T.

JMP   l_absdaynumtodate_yearr

nextdays:                       ; eax > 1 (N > 2)
SUB   eax, 2                  ; eax := eax - 2 = N - 1 - 2 = N - 3
XOR   edx, edx               ;
;       Global C1   = 365         ; Number of days in a normal year.
;     Global C4   = 4*C1 + 1   = 1461   ; Number of days in the 4-year cycle (base cycle of the Julian calendar).
;     Global C100   = 25*C4 - 1   = 36524; Number of days in a "normal" century in the Gregorian calendar
;                             ; (i.e. century ending with a normal, 365-day, year).
;     Global C400   = 4*C100 + 1   = 146097   ; Number of days in the complete 400-year cycle of the Gregorian calendar.

MOV   ecx, 146097   ;C400               ; eax := E(eax / C400) = E((N - 3) / C400)
DIV   ecx                  ; 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, 36524    ; C100

JB   l_absdaynumtodate_julian   ;Jump short if below (CF=1).

SUB   eax, 36524    ; C100

CMP   eax, 36524    ; C100            ; (eax, ecx) := P(eax, ecx) =
JB   l_absdaynumtodate_julian      ;             = P((N - 3) mod C400, 400*E((N - 3) / C400)) =
; = (N100, Y100)
SUB   eax, 36524    ; C100

CMP   eax, 36524    ; C100
JB   l_absdaynumtodate_julian

SUB   eax, 36524    ; C100

julian:
;                             /
;                             |  (N - 1, 0)                                 ; Gregorian = 0
; (N100, Y100) = (eax, ecx) = <
;                             |  P((N - 3) mod C400, 400*E((N - 3) / C400)) ; Gregorian = 1
;                             \
MOV tmp, ecx ; PUSH ecx
XOR   edx, edx
MOV   ecx, 1461 ; C4   ; eax := E(eax / C4) = E(N100 / C4)
DIV   ecx            ; edx := eax mod C4 = N100 mod C4
MOV ecx, tmp ; POP ecx

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, 365 ; C1
JB   l_absdaynumtodate_md

SUB   edx, 365 ; C1

INC   ecx                       ; (edx, ecx) := Q(edx, ecx) =
CMP   edx, 365 ; C1               ; = Q(N100 mod C4, Y100 + 4*E(N100 / C4)) =
JB   l_absdaynumtodate_md   ; = (N', Y*)

SUB   edx, 365 ; C1

INC   ecx
CMP   edx, 365 ; C1
JB   l_absdaynumtodate_md

SUB   edx, 365 ; C1

INC   ecx

md:
INC   edx                  ; edx := edx + 1 = N' + 1

;sauvegarde
MOV tmpeax, eax
MOV tmpecx, ecx
MOV tmpedx, edx

IsLeapYear(tmpecx, Gregorian)         ; eax := IsLeapYear(ecx=year, Gregorian) =
; = IsLeapYear(Y*, Gregorian)
MOV tmpeax, eax

;DayNumToMD(n.l, LeapYearFlag.l, M.l, D.l)
DayNumToMD(tmpedx, tmpeax, M, D)

MOV ecx, tmpecx
MOV edx, tmpedx

CMP   Gregorian, 0
JE   l_absdaynumtodate_julianyears

gregorianyears:
SUB   ecx, 120  ;k*(G - J)            ;k*(G - J)=180
; ecx := ecx - kJ - k(G - J)[Gregorian = 1] =
julianyears:      ;      = Y* - kJ - k(G - J)[Gregorian = 1] =
SUB   ecx, 5843880  ;k*J            ; = Y';k*J=5843880

CMP   ecx, 0
JG   l_absdaynumtodate_yearr
; ecx <= 0 (Y' <= 0)

DEC   ecx            ; ecx := ecx - 1 = Y' - 1 = Y' - [Y' <= 0]

yearr:
MOV   eax, Y      ; Y := ecx
MOV   [eax], ecx

XOR   eax, eax
JMP   l_absdaynumtodate_theend

error:
MOV   eax, -1

theend:

;POP   edx ecx ebx
;POPFD

DisableASM
ProcedureReturn

EndProcedure
;
;
; 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.
;
Procedure.l DayOfWeekAsm(Y.l, M.l, D.l, Gregorian.l)
EnableASM
;    PUSHFD
;    PUSH   ebx edx

DateToAbsDayNum(Y, M, D, Gregorian)

TEST   eax, eax
JZ   l_dayofweekasm_error

MOV   ecx, 7                     ;
XOR   edx, edx                  ;
ADD   eax, 5                     ; edx := (eax + 5) mod 7 = (N + 5) mod 7
DIV   ecx

XCHG   eax, edx               ; eax := edx
JMP   l_dayofweekasm_theend

error:
MOV   eax, -1
theend:

DisableASM
ProcedureReturn

;    POP   edx ebx
;    POPFD

EndProcedure
;
;
;
; 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.
;
Procedure.l GregorianToJulian( Yg.l, Mg.l, Dg.l, Yj.l, Mj.l, Dj.l)
Protected tmpeax.l

EnableASM
gregoriantonum:
DateToAbsDayNum( Yg, Mg, Dg, 1)
MOV tmpeax, eax
TEST   eax, eax
JZ   l_gregoriantojulian_error

numtojulian:
AbsDayNumToDate( tmpeax, 0, Yj, Mj, Dj)

JMP   l_gregoriantojulian_theend

error:
MOV   eax, -1

theend:

DisableASM
ProcedureReturn
EndProcedure
;
; 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.
;
Procedure.l JulianToGregorian( Yj.l, Mj.l, Dj.l, Yg.l, Mg.l, Dg.l)
Protected tmpeax.l
EnableASM
juliantonum:
DateToAbsDayNum( Yj, Mj, Dj, 0)
MOV tmpeax, eax
TEST   eax, eax
JZ   l_juliantogregorian_error

numtogregorian:
AbsDayNumToDate( tmpeax, 1, Yg, Mg, Dg)
JMP   l_juliantogregorian_theend

error:
MOV   eax, -1

theend:

DisableASM
ProcedureReturn

EndProcedure

Define.l D, M, Y
D=0
M=0
Y=0

Debug "IsLeapYear(2000,1) should be 1  = is a leap year"
Debug IsLeapYear(2000,1)
Debug "-----------------------------------------------------------"

Debug "MDToDayNum(M, D, LeapYearFlag): MDToDayNum(3, 1, 0)"
Debug MDToDayNum(3, 1, 0)
Debug "MDToDayNum(M, D, LeapYearFlag): MDToDayNum(2, 29, 1)"
Debug MDToDayNum(2, 29, 1)
Debug "-----------------------------------------------------------"

Debug "DayNumToMD(N,LeapYearFlag,@M,@D): DayNumToMD(60,0,@M,@D)"
Debug DayNumToMD(60,0,@M,@D)
Debug D
Debug M
Debug "DayNumToMD(N,LeapYearFlag,@M,@D): DayNumToMD(61,1,@M,@D)"
Debug DayNumToMD(61,1,@M,@D)
Debug D
Debug M
Debug "-----------------------------------------------------------"

Debug "DateToAbsDayNum(Y, M, D, Gregorian): Debug DateToAbsDayNum(2000, 1, 1, 1)"
Debug DateToAbsDayNum( 2000, 1, 1, 1)
Debug "-----------------------------------------------------------"

Debug "AbsDayNumToDate(N, Gregorian, Y, M, D): AbsDayNumToDate(2135207292,1,@Y, @M, @D)"
Debug AbsDayNumToDate(2135207292,1,@Y, @M, @D );:N, Gregorian, Y, M, D
Debug D
Debug M
Debug Y
Debug "-----------------------------------------------------------"

Debug "DayOfWeekAsm(Y, M, D, Gregorian.l): DayOfWeekAsm(2000, 1, 1, 1)"
Debug DayOfWeekAsm(2000, 1, 1, 1)
Debug DayOfWeek(Date(2000, 1, 1, 0, 0, 0))
Debug "-----------------------------------------------------------"

Debug "GregorianToJulian(Yg, Mg, Dg, Yj, Mj, Dj): GregorianToJulian(2000, 1, 1, @Y, @M, @D)"
Debug GregorianToJulian(2000, 1, 1, @Y, @M, @D)
Debug D
Debug M
Debug Y
Debug "-----------------------------------------------------------"

Debug "JulianToGregorian( Yj, Mj, Dj, Yg, Mg, Dg): Debug JulianToGregorian(1999, 12, 19, @Y, @M, @D)"
Debug JulianToGregorian( 1999, 12, 19, @Y, @M, @D)
Debug D
Debug M
Debug Y
Debug "-----------------------------------------------------------"

t1=ElapsedMilliseconds()
For i= 1 To 10000
DayOfWeek(Date(2000, 1, 1, 0, 0, 0))
Next i
t2=ElapsedMilliseconds()
For i= 1 To 10000
DayOfWeekAsm(2000, 1, 1, 1)
Next i
t3=ElapsedMilliseconds()
Debug""
Debug "DayOfWeek with PB in ms"
Debug t2-t1
Debug""
Debug "DayOfWeek with asm in ms"
Debug t3-t2
Debug "DayOfWeek with asm should be much longer but it works from 30 Dec 5 844 001 BCE to 17 Jan 5 915 222 (i hope ;) "

Mesa.

Last edited by Mesa on Fri Dec 20, 2013 3:42 pm, edited 1 time in total.

Top

 Post subject: Re: Compute Dates on 11 millions yearsPosted: Fri Dec 20, 2013 10:43 am

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1807
Location: Uttoxeter, UK
I tried it as follows: Windows 7 64bit PureBasic 5.21LTS

Got the following messagebox:

messagebox wrote:
PureBasic - Assembler error

PureBasic.asm [3251]:
MP8
PureBasic.asm [1503] MP8 [313]:
PUSH ecx
error: illegal instruction.

I hope it helps.

_________________
DE AA EB

Top

 Post subject: Re: Compute Dates on 11 millions yearsPosted: Fri Dec 20, 2013 3:21 pm
 Enthusiast

Joined: Fri Feb 24, 2012 10:19 am
Posts: 205
 ...

Last edited by Mesa on Fri Dec 20, 2013 3:41 pm, edited 1 time in total.

Top

 Post subject: Re: Compute Dates on 11 millions yearsPosted: Fri Dec 20, 2013 3:26 pm

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1807
Location: Uttoxeter, UK
@Mesa,

Tested and got the following message:

MessageBox wrote:
PureBasic.asm [3520]:
MP4
PureBasic.asm [747] MP4 [184]
Loop l_daynumtomd_lloop
error: relative jump out of range.

_________________
DE AA EB

Top

 Post subject: Re: Compute Dates on 11 millions yearsPosted: Fri Dec 20, 2013 3:28 pm
 PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3710
Location: Netherlands
Mesa wrote:
Could you test this code please.

This code could never work on x64 in this form.
If you access memory on x64, you need to use 64 bit registers like
MOVZX eax, byte [rcx]
MOVZX eax, byte [ecx]

_________________
macOS 10.15 Catalina, Windows 10

Top

 Display posts from previous: All posts1 day7 days2 weeks1 month3 months6 months1 year Sort by AuthorPost timeSubject AscendingDescending
 Page 1 of 1 [ 5 posts ]

 All times are UTC + 1 hour

#### Who is online

Users browsing this forum: No registered users and 6 guests

 You cannot post new topics in this forumYou cannot reply to topics in this forumYou cannot edit your posts in this forumYou cannot delete your posts in this forum

Search for:
 Jump to:  Select a forum ------------------ PureBasic    Coding Questions    Game Programming    3D Programming    Assembly Programming    The PureBasic Editor    The PureBasic Form Designer    General Discussion    Feature Requests and Wishlists    Tricks 'n' Tips Bug Reports    Bugs - Windows    Bugs - Linux    Bugs - Mac OSX    Bugs - IDE    Bugs - Documentation OS Specific    AmigaOS    Linux    Windows    Mac OSX Miscellaneous    Announcement    Off Topic Showcase    Applications - Feedback and Discussion    PureFORM & JaPBe    TailBite