Proleptic Gregorian calendar

Share your advanced PureBasic knowledge/code with the community.
wilbert
PureBasic Expert
PureBasic Expert
Posts: 3870
Joined: Sun Aug 08, 2004 5:21 am
Location: Netherlands

Proleptic Gregorian calendar

Post by wilbert »

The code below contains two procedures for a proleptic Gregorian calendar.
This means it treats all dates as if the Gregorian calendar always has existed and always will exist.

I tried to replace most division instructions with a multiply/shift combination to speed things up a bit.
It's not a replacement for the procedures I posted in this other thread
http://www.purebasic.fr/english/viewtop ... 12&t=56031
Mainly because the code is slower and I don't plan to built any procedures around it.
If someone else wants to do that or convert it into a module, feel free to do so.

The code contains no dependancies or lookup tables and should be cross platform compatible.

Code: Select all

; >> Proleptic Gregorian calendar <<

; Years are numbered according to astronomical year numbering
; which means the year 1 is preceded by the year 0.
; So the year 0 is the same as 1 BC, the year -1 as 2 BC etc.

; Supported date range : 
; 08:29:52 UTC,  January 27,  292,277,022,658 BC (-292,277,022,657)
; 15:30:07 UTC,  December 4,  292,277,026,596 AD

; Last modified : August 18, 2017


Structure DateComponents ; (16 bytes, don't alter!)
  year.q                 ; offset  0  : year
  yday.w                 ; offset  8  : day of year [1-366]
  month.b                ; offset 10  : month [1-12]
  day.b                  ; offset 11  : day [1-31]
  wday.b                 ; offset 12  : days since Sunday [0-6]
  hour.b                 ; offset 13  : hours [0-23]
  min.b                  ; offset 14  : minute [0-59]
  sec.b                  ; offset 15  : second [0-59]
EndStructure

Procedure.q DateCompose(year.q, month.i=1, day.i=1, hour.i=0, minute.i=0, second.i=0)
  Protected.q date
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
    !mov rax, [p.v_second]    ; First handle the time
    !mov rcx, [p.v_minute]    ; components and day.
    !mov rdx, [p.v_hour]
    !mov r8, [p.v_day]
    !imul rcx, 60
    !imul rdx, 3600
    !add rax, rcx
    !add rax, rdx
    !imul r8, 86400
    !add rax, r8
    !mov [p.v_date], rax
    !mov r8, 0x5555555555555556
    !mov rax, [p.v_month]     ; Convert the month range
    !mov rcx, rax             ; to [3, 14]
    !cqo
    !add rdx, r8
    !imul rdx
    !sar rdx, 2
    !imul rax, rdx, 12
    !sub rcx, rax
    !cmp rcx, 3
    !sbb rax, rax
    !add rdx, rax
    !and rax, 12
    !add rcx, rax
    !mov rax, rdx
    !add [p.v_year], rax    
  CompilerElse
    !mov ecx, [p.v_second]    ; First handle the time
    !mov eax, [p.v_minute]    ; components and day.
    !mov edx, 60
    !imul edx
    !add eax, ecx
    !adc edx, 0
    !mov [p.v_date], eax
    !mov [p.v_date+4], edx
    !mov eax, [p.v_hour]
    !mov edx, 3600
    !imul edx
    !add [p.v_date], eax
    !adc [p.v_date+4], edx
    !mov eax, [p.v_day]
    !mov edx, 86400
    !imul edx
    !add [p.v_date], eax
    !adc [p.v_date+4], edx
    !mov eax, [p.v_month]     ; Convert the month range
    !mov ecx, eax             ; to [3, 14]
    !cdq
    !add edx, 0x55555556
    !imul edx
    !sar edx, 2
    !imul eax, edx, 12
    !sub ecx, eax
    !cmp ecx, 3
    !sbb eax, eax
    !add edx, eax
    !and eax, 12
    !add ecx, eax
    !mov eax, edx
    !cdq
    !add [p.v_year], eax
    !adc [p.v_year+4], edx
  CompilerEndIf  
  !lea eax, [ecx+1]           ; Calculate the month
  !imul eax, 7835             ; contribution to the date.
  !shr eax, 8
  !sub eax, 719591
  !mov edx, 86400
  !imul edx
  !add [p.v_date], eax        ; Add it to the date.
  !adc [p.v_date+4], edx
  !mov edx, [p.v_year+4]      ; Continue with handling the
  !mov eax, [p.v_year]        ; year.
  !shl edx, 24
  !sar edx, 24
  !mov ecx, 400               ; Split into 400 year
  !idiv ecx                   ; periods to make things
  !mov ecx, edx               ; easier to handle.
  !sar ecx, 31
  !add eax, ecx
  !and ecx, 400
  !add ecx, edx
  !mov edx, 0x5e0c0b3         ; Add the contribution of
  !imul edx                   ; the 400 year periods to
  !shld edx, eax, 7           ; the date.
  !shl eax, 7
  !add [p.v_date], eax
  !adc [p.v_date+4], edx
  !imul eax, ecx, 1461        ; Handle the remaining years
  !shr eax, 2                 ; [0, 399], add to the date
  !imul ecx, 0x28f5d          ; and return the result.
  !shr ecx, 24
  !sub eax, ecx
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
    !imul rax, 86400
    !add rax, [p.v_date]
  CompilerElse
    !mov edx, 86400
    !mul edx
    !add eax, [p.v_date]
    !adc edx, [p.v_date+4]
  CompilerEndIf
  ProcedureReturn  
EndProcedure

Procedure DateDecompose(date.q, *dc.DateComponents)
  Protected.l y2800, y, c
  ; >> 2800 year cycle <<
  !mov eax, [p.v_date]        ; First divide the date 
  !mov edx, [p.v_date+4]      ; by 88.359.465.600 to get
  !shrd eax, edx, 7           ; a 2800 year period and a
  !sar edx, 7                 ; smaller remainder to work
  !mov ecx, 0x292544e5        ; with.
  !idiv ecx
  !sar edx, 31
  !add eax, edx
  !mov [p.v_y2800], eax       ; [tmp store y2800 period]
  !imul ecx
  !shld edx, eax, 7
  !shl eax, 7
  !sub [p.v_date], eax        ; [tmp store remainder]
  !sbb [p.v_date+4], edx
  ; >> split date/time <<
  !mov eax, [p.v_date]        ; Divide the remainder by
  !mov edx, [p.v_date+4]      ; 86400 to get a day number
  !mov ecx, 86400             ; and the time in seconds.
  !div ecx
  ; >> time <<  
  ; hour
  !imul ecx, edx, 0x91a3      ; Divide the time by 3600
  !shr ecx, 27                ; to ge the hour.
  !mov [p.v_date+1], cl
  !imul ecx, 3600
  !sub edx, ecx
  ; min
  !imul ecx, edx, 0x44445     ; Divide the 0-3599
  !shr ecx, 24                ; remaining seconds by 60
  !mov [p.v_date+2], cl       ; to get the minute.
  !imul ecx, 60
  !sub edx, ecx
  ; sec
  !mov [p.v_date+3], dl       ; What's left is the second.
  ; >> date <<
  ; weekday  
  !mov ecx, eax               ; The weekday is easy.
  !add eax, 4                 ; After 2800 years everything
  !mov edx, 0x24924925        ; repeats so we can use the
  !mul edx                    ; smaller date and do
  !imul edx, 7                ; wday = (day number + 4) % 7
  !lea eax, [ecx+4]
  !sub eax, edx
  !mov [p.v_date], al
  ; >> to structure <<        ; [copy time and wday to *date]
  !mov eax, [p.v_date]
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
    !mov rdx, [p.p_dc]
    !mov [rdx+12], eax
  CompilerElse
    !mov edx, [p.p_dc]
    !mov [edx+12], eax
  CompilerEndIf
  ; year (part 1)
  !add ecx, 719162            ; Divide the day number by
  !lea eax, [4*ecx+3]         ; 36524.25 to get the century
  !mov edx, 0xe5ac1af4        ; (within the 2800 year period).
  !mul edx
  !shr edx, 17
  !mov [p.v_c], edx
  !imul edx, 146097
  !shr edx, 2
  !sub ecx, edx
  !lea eax, [4*ecx+3]         ; Divide the remaining days by
  !mov edx, 0x2cdb61          ; 365.25 to get the year within
  !mul edx                    ; the century.
  !mov [p.v_y], edx
  ; day of year
  !imul edx, 1461             ; yday is the remaining days+1
  !shr edx, 2
  !sub ecx, edx
  !lea eax, [ecx+1]
  !mov [p.v_date], eax        ; [tmp store yday]
  ; year (part 2)
  !mov ecx, [p.v_c]           ; Now we combine the 2800 year
  !imul ecx, 100              ; period with the century and
  !mov eax, [p.v_y2800]       ; the last two year digits into
  !add ecx, [p.v_y]           ; one big 64 bit year number.
  !mov edx, 2800
  !imul edx
  !add ecx, 1
  !add eax, ecx
  !adc edx, 0
  ; >> to structure <<        ; [copy year and yday to *date]
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
    !mov rcx, [p.p_dc]
    !mov [rcx], eax
    !mov [rcx+4], edx
    !mov edx, [p.v_date]
    !mov [rcx+8], dx
  CompilerElse
    !mov ecx, [p.p_dc]
    !mov [ecx], eax
    !mov [ecx+4], edx
    !mov edx, [p.v_date]  
    !mov [ecx+8], dx
  CompilerEndIf
  ; leap year check
  !mov eax, [p.v_y]           ; To continue with the month
  !sub eax, 99                ; and day of month, we first
  !sar eax, 31                ; need to find out if it's a
  !or eax, [p.v_c]            ; leap year.
  !and eax, [p.v_y]
  !mov ecx, eax
  !shr ecx, 1
  !and eax, ecx
  !and eax, 1
  ; convert day number
  !sub edx, eax               ; For calculating the month
  !sub edx, 60                ; and day of month, it is
  !sbb ecx, ecx               ; easier to let March 1 be
  !add eax, 365               ; day number 1. So we convert
  !and ecx, eax               ; it before continuing.
  !lea ecx, [ecx+edx+1]
  ; month and day
  !lea eax, [ecx*5-3]         ; m=(5*d-3)/153
  !imul ecx, eax, 0x1ac6
  !shr ecx, 20
  !imul edx, ecx, 153         ; d=(5*d-3)-153*m
  !sub eax, edx
  !add eax, 5                 ; d=(d+5)/5
  !imul eax, 0x33334
  !shr eax, 20
  !add ecx, 3                 ; m+3
  !mov edx, 12                ; if m>12, m-12
  !sub edx, ecx
  !sar edx, 31
  !and edx, 12
  !sub ecx, edx
  ; >> to structure <<        ; [copy month and day to *date]
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
    !mov rdx, [p.p_dc]
    !mov [rdx+10], cl
    !mov [rdx+11], al
  CompilerElse
    !mov edx, [p.p_dc]
    !mov [edx+10], cl
    !mov [edx+11], al
  CompilerEndIf
EndProcedure
Windows (x64)
Raspberry Pi OS (Arm64)
wilbert
PureBasic Expert
PureBasic Expert
Posts: 3870
Joined: Sun Aug 08, 2004 5:21 am
Location: Netherlands

Re: Proleptic Gregorian calendar

Post by wilbert »

Small example

Code: Select all

Dim MonthName.s(12)
Dim Weekday.s(6)

MonthName(1) = "January"
MonthName(2) = "February"
MonthName(3) = "March"
MonthName(4) = "April"
MonthName(5) = "May"
MonthName(6) = "June"
MonthName(7) = "July"
MonthName(8) = "August"
MonthName(9) = "September"
MonthName(10) = "October"
MonthName(11) = "November"
MonthName(12) = "December"

Weekday(0) = "Sunday"
Weekday(1) = "Monday"
Weekday(2) = "Tuesday"
Weekday(3) = "Wednesday"
Weekday(4) = "Thursday"
Weekday(5) = "Friday"
Weekday(6) = "Saturday"

date.q = DateCompose(2100, 12, 25)
DateDecompose(date, @dc.DateComponents)

Debug MonthName(dc\month) +" " + Str(dc\day) + " of the year " + Str(dc\year) + " is a " + Weekday(dc\wday) + "."
Debug "It is day number " + Str(dc\yday) + " of the year."
Windows (x64)
Raspberry Pi OS (Arm64)
User avatar
mk-soft
Always Here
Always Here
Posts: 5393
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Proleptic Gregorian calendar

Post by mk-soft »

Thanks, very small :wink:
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
User avatar
Lunasole
Addict
Addict
Posts: 1091
Joined: Mon Oct 26, 2015 2:55 am
Location: UA
Contact:

Re: Proleptic Gregorian calendar

Post by Lunasole »

Cool thing, sometime very useful
"W̷i̷s̷h̷i̷n̷g o̷n a s̷t̷a̷r"
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5353
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Proleptic Gregorian calendar

Post by Kwai chang caine »

Impossible to understand, but also very nice code :shock:
Works very well, thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
wilbert
PureBasic Expert
PureBasic Expert
Posts: 3870
Joined: Sun Aug 08, 2004 5:21 am
Location: Netherlands

Re: Proleptic Gregorian calendar

Post by wilbert »

Thanks for the feedback.
Kwai chang caine wrote:Impossible to understand, but also very nice code :shock:
The same can be done without asm as well of course only slower to execute (but faster to program). :D
Windows (x64)
Raspberry Pi OS (Arm64)
Little John
Addict
Addict
Posts: 4527
Joined: Thu Jun 07, 2007 3:25 pm
Location: Berlin, Germany

Re: Proleptic Gregorian calendar

Post by Little John »

wilbert wrote:The same can be done without asm as well of course only slower to execute (but faster to program). :D
I did something like that 9 years ago, but didn't know the technical term "Proleptic Gregorian calendar". :-)
wilbert
PureBasic Expert
PureBasic Expert
Posts: 3870
Joined: Sun Aug 08, 2004 5:21 am
Location: Netherlands

Re: Proleptic Gregorian calendar

Post by wilbert »

Little John wrote:I did something like that 9 years ago, but didn't know the technical term "Proleptic Gregorian calendar". :-)
I also didn't know the term until recently :wink:
I know there's more date related code on the forum. The challenge I have set for myself was to support the full 64 bit range. So every possible quad number can be expressed as a date and converted back again to the same unique number.
Totally useless in a lot of cases because you end up with date ranges beyond the estimated time the universe exists but just something I wanted to try for myself.
Windows (x64)
Raspberry Pi OS (Arm64)
Little John
Addict
Addict
Posts: 4527
Joined: Thu Jun 07, 2007 3:25 pm
Location: Berlin, Germany

Re: Proleptic Gregorian calendar

Post by Little John »

wilbert wrote:Totally useless in a lot of cases because you end up with date ranges beyond the estimated time the universe exists
:D
Post Reply