Compute Dates on 11 millions years

Bare metal programming in PureBasic, for experienced users
Mesa
Enthusiast
Enthusiast
Posts: 345
Joined: Fri Feb 24, 2012 10:19 am

Compute Dates on 11 millions years

Post by Mesa »

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 :wink: )

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

[Edit] Try to debug in 64b

Code: Select all

;http://mikhajduk.houa.org/EN/index.php?f=Links

; Mesa 
; Kernadec http://www.purebasic.fr/french/viewtopic.php?f=3&t=14026

; 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 
	ADD ecx, edx 
	ADD ecx, eax  ;+12*LeapYearFlag 
	 
	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 
	ADD ecx, edx  ;+24*LeapYearFlag 
	 
	MOV edx, M 
	ADD ecx, edx  ;+M 
	ADD ecx, 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
  ADD eax, tmp
  ADD eax, ecx 
  ADD eax, ecx 
  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.						
	ADD	ecx, 5843880; k*J					
	
		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'
		ADD	ecx, 120; k*(G-J)					; 
;     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).
								
			ADD	ecx, 100				
			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)
			ADD	ecx, 100				
			SUB	eax, 36524    ; C100				
									
			CMP	eax, 36524    ; C100				
			JB	l_absdaynumtodate_julian					
 									
			ADD	ecx, 100				
			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
	ADC	edx, edx						;
	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.
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Compute Dates on 11 millions years

Post by davido »

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
Mesa
Enthusiast
Enthusiast
Posts: 345
Joined: Fri Feb 24, 2012 10:19 am

Re: Compute Dates on 11 millions years

Post by Mesa »

[Edit] ...
Last edited by Mesa on Fri Dec 20, 2013 3:41 pm, edited 1 time in total.
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Compute Dates on 11 millions years

Post by davido »

@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
wilbert
PureBasic Expert
PureBasic Expert
Posts: 3870
Joined: Sun Aug 08, 2004 5:21 am
Location: Netherlands

Re: Compute Dates on 11 millions years

Post by wilbert »

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]
instead of
MOVZX eax, byte [ecx]
Windows (x64)
Raspberry Pi OS (Arm64)
Post Reply