It is currently Sat Feb 24, 2018 9:15 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 9 posts ] 
Author Message
 Post subject: Proleptic Gregorian calendar
PostPosted: Fri Aug 18, 2017 12:25 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3036
Location: Netherlands
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
viewtopic.php?f=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:
; >> 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

_________________
MacOS 10.13 High Sierra, PB 5.60 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: Proleptic Gregorian calendar
PostPosted: Fri Aug 18, 2017 12:25 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3036
Location: Netherlands
Small example

Code:
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."

_________________
MacOS 10.13 High Sierra, PB 5.60 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: Proleptic Gregorian calendar
PostPosted: Fri Aug 18, 2017 2:24 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 1124
Location: Germany
Thanks, very small :wink:

_________________
My Projects OOP-BaseClass / OOP-BaseClassDispatch / Event-Designer /
PB v3.30 / v5.60 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: Proleptic Gregorian calendar
PostPosted: Fri Aug 18, 2017 6:02 pm 
Offline
Addict
Addict
User avatar

Joined: Mon Oct 26, 2015 2:55 am
Posts: 892
Location: Ukraine
Cool thing, sometime very useful

_________________
Time beyond time

Like a copyleft notify: all the source code created by me and posted on Purebasic official forums is free to use and modification in all possible (and several impossible) ways for anyone, without asking my permission


Top
 Profile  
Reply with quote  
 Post subject: Re: Proleptic Gregorian calendar
PostPosted: Sat Aug 19, 2017 11:18 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4032
Location: Lyon - France
Impossible to understand, but also very nice code :shock:
Works very well, thanks for sharing 8)

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
 Post subject: Re: Proleptic Gregorian calendar
PostPosted: Sun Aug 20, 2017 12:35 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3036
Location: Netherlands
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

_________________
MacOS 10.13 High Sierra, PB 5.60 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: Proleptic Gregorian calendar
PostPosted: Sun Aug 20, 2017 1:18 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Jun 07, 2007 3:25 pm
Posts: 3145
Location: Berlin, Germany
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". :-)

_________________
Please excuse my flawed English. My native language is PureBasic.
Search
RSBasic's backups


Top
 Profile  
Reply with quote  
 Post subject: Re: Proleptic Gregorian calendar
PostPosted: Sun Aug 20, 2017 1:50 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3036
Location: Netherlands
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.

_________________
MacOS 10.13 High Sierra, PB 5.60 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: Proleptic Gregorian calendar
PostPosted: Sun Aug 20, 2017 3:23 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Jun 07, 2007 3:25 pm
Posts: 3145
Location: Berlin, Germany
wilbert wrote:
Totally useless in a lot of cases because you end up with date ranges beyond the estimated time the universe exists

:D

_________________
Please excuse my flawed English. My native language is PureBasic.
Search
RSBasic's backups


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 9 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 4 guests


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

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye