Toute la DLL de Mikolaj Hajduk traduite en ASM pour PB 5.2x

Pour discuter de l'assembleur
Mesa
Messages : 1093
Inscription : mer. 14/sept./2011 16:59

Toute la DLL de Mikolaj Hajduk traduite en ASM pour PB 5.2x

Message par Mesa »

Ce code fonctionne sous Xp 32b, reste à vérifier pour les autres plateformes.
Ne fonctionne pas sur du 64b.

Code : Tout sélectionner

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

; Mesa http://www.purebasic.fr/french/viewtopic.php?f=12&t=14145
; 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						;
  
  lloop:							  ; 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	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
									;                             \
    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
		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 ;) "
[Edition 19/02/2014]
Ci-dessous la même chose mais avec l'écriture de PB (p.v_ ,...)

Code : Tout sélectionner

;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 
	;PUSH edx 
	 
	checkparameters: 
	TEST  dword[p.v_gregorian], -2       ; 0 <= Gregorian <= 1 
	JNZ   l_isleapyear_error                   
	 
	isynegative: 
	MOV   eax, [p.v_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  dword[p.v_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 
	;POP 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, [p.v_M]    ;+M 
	ADD ecx, edx 
	ADD ecx, eax  ;+12*LeapYearFlag 
	 
	MOV edx, eax  ; Sauvegarde de 12*LeapYearFlag 
	 
	MOVZX eax, byte [ecx] 
	 
	CMP  [p.v_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, [p.v_M]
	ADD ecx, edx  ;+M 
	ADD ecx, edx  ;+M 
	MOVZX eax, word [ecx] 
	 
	ADD   eax, [p.v_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	dword[p.v_LeapYearFlag], -2	; 0 <= LeapYearFlag <= 1 
  JNZ	l_daynumtomd_error
  
  CMP	dword[p.v_n], 1			; n >= 1
  JB	l_daynumtomd_error	;Jump short if below (CF=1).				
  
  MOV	eax, 365					
  ADD	eax, [p.v_LeapYearFlag]	; eax := 365 + LeapYearFlag
  CMP	n, eax					  ; n <= eax
  JA	l_daynumtomd_error						
  
  calculatemd:
  MOV	eax, [p.v_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, [p.v_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, [p.v_M]				  ; M := ecx = m
  MOV	[eax], ecx				
  
  MOV	ecx, [p.v_n]				  ; ecx := n
  SUB	ecx, edx			  ; ecx := ecx - edx = n - DaySum(m, LeapYearFlag)
  
  MOV	eax, [p.v_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	dword[p.v_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 [p.v_X], eax
	
	MDToDayNum(M, D, X)			;ebx
	CMP	eax, -1							; eax := MDToDayNum(M, D, ebx) = n
	JE	l_datetoabsdaynum_error							

	MOV	ecx, [p.v_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	dword[p.v_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 [p.v_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, [p.v_X]				;      = 365(Y' - 1) + E((Y' - 1) / 4) + n

		CMP	dword[p.v_Gregorian], 0
		JZ	l_datetoabsdaynum_theend

	gregorian:
	MOV [p.v_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, [p.v_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	dword[p.v_N], 0							; N <> 0 ; l'année  n'existe pas
	JE	l_absdaynumtodate_error							;

	TEST	dword[p.v_Gregorian], -2		; 0 <= Gregorian <= 1
	JNZ	l_absdaynumtodate_error							;

	XOR	ecx, ecx					; ecx := 0
	
	MOV	eax, [p.v_N]					  ; eax := N - 1
	DEC	eax							  ;

	CMP	dword[p.v_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, [p.v_M]					; M := 12								
		MOV	dword [ecx], 12					;

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

		MOV	ecx, [p.v_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 [p.v_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, [p.v_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 [p.v_tmpeax], eax
		MOV [p.v_tmpecx], ecx
		MOV [p.v_tmpedx], edx

		IsLeapYear(tmpecx, Gregorian)			; eax := IsLeapYear(ecx=year, Gregorian) =
		                                  ; = IsLeapYear(Y*, Gregorian)
    MOV [p.v_tmpeax], eax

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

		MOV ecx, [p.v_tmpecx] 
		MOV edx, [p.v_tmpedx]
		
		CMP	dword[p.v_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, [p.v_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 [p.v_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 [p.v_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


;-Tests
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 ;) "


M.
Dernière modification par Mesa le mer. 19/févr./2014 16:41, modifié 2 fois.
Avatar de l’utilisateur
kernadec
Messages : 1594
Inscription : ven. 25/avr./2008 11:14

Re: Toute la DLL de Mikolaj Hajduk traduite en ASM pour PB 5

Message par kernadec »

bonjour Mesa
merci pour le partage. :D

quand je l'utilise ton code tel qu'il est avec la version PB5.00 et XP32 SP3
il dit avoir une erreur de label avec "error:"
Sinon avec PB5.20lts XP32 Sp3 le code fonctionne.
tu as mis PB 5.xx dans le titre :wink:

je n'ai pas eu le temps pour le moment de l’intégrer dans mon code "calculatrice de jours"

Cordialement
Avatar de l’utilisateur
kernadec
Messages : 1594
Inscription : ven. 25/avr./2008 11:14

Re: Toute la DLL de Mikolaj Hajduk traduite en ASM pour PB 5

Message par kernadec »

Bonjour Mesa
Quand j'ai voulu utiliser l'ensemble des procédures dans mon code Calculatrice, j'ai rencontre ce problème.

voici le test avec une date qui appelle toutes les procédures, bref... c'est pas la fin du monde :mrgreen:

Cordialement

Code : Tout sélectionner

Define.l D, M, Y, gregorian, LeapYearFlag, N

D = 21
M = 12
Y = 2013
gregorian = 1

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

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

Debug "MDToDayNum(M, D, LeapYearFlag): MDToDayNum(3, 1, 0)"
N = MDToDayNum( M, D, LeapYearFlag )
Debug N
;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( N, LeapYearFlag, M, D )
Debug D
Debug M
Debug " bug  DayNumToMD(N,LeapYearFlag,@M,@D): DayNumToMD(60,0,@M,@D)"
Debug DayNumToMD( N, LeapYearFlag,@M,@D )
Debug D
Debug M
Debug "-----------------------------------------------------------"

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

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

Yg.l=Y:Mg.l=M:Dg.l=D

Debug "GregorianToJulian(Yg, Mg, Dg, Yj, Mj, Dj): GregorianToJulian(2000, 1, 1, @Y, @M, @D)"
Debug GregorianToJulian( Yg, Mg, Dg, Yj, Mj, Dj )
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( Yj, Mj, Dj, Yg, Mg, Dg )
Debug D
Debug M
Debug Y
Debug "-----------------------------------------------------------"
Avatar de l’utilisateur
kernadec
Messages : 1594
Inscription : ven. 25/avr./2008 11:14

Re: Toute la DLL de Mikolaj Hajduk traduite en ASM pour PB 5

Message par kernadec »

bonjour Mesa
j'ai trouvé d' où vient l'erreur... :D
il faut simplement utiliser les adresses variables pour les appels de certaines procédures.
exemple qui fonctionne maintenant... :mrgreen:

En tout cas encore MERCI Mesa pour tout ce travail :D

Cordialement
[réédit] je n'avais pas vu que tu avais corrigé cela dans ton premier post :oops:

Code : Tout sélectionner

Define.l D, M, Y, gregorian, LeapYearFlag, N

D = 21
M = 12
Y = 2013
gregorian = 1

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

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

Debug "MDToDayNum(M, D, LeapYearFlag): MDToDayNum(3, 1, 0)"
   N = MDToDayNum( M, D, LeapYearFlag )
Debug n
;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( N, LeapYearFlag, M, D )
;Debug D
;Debug M
Debug " bug  DayNumToMD(N,LeapYearFlag,@M,@D): DayNumToMD(60,0,@M,@D)"
Debug DayNumToMD( N, LeapYearFlag,@M,@D )
Debug D
Debug M
Debug "-----------------------------------------------------------"

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

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

Yg.l=Y:Mg.l=M:Dg.l=D

Debug "GregorianToJulian(Yg, Mg, Dg, Yj, Mj, Dj): GregorianToJulian(2000, 1, 1, @Y, @M, @D)"
Debug GregorianToJulian( Yg, Mg, Dg, @Yj,@ Mj, @Dj )
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( Yj, Mj, Dj, @Yg, @Mg, @Dg )
Debug D
Debug M
Debug Y
Debug "-----------------------------------------------------------"


Mesa
Messages : 1093
Inscription : mer. 14/sept./2011 16:59

Re: Toute la DLL de Mikolaj Hajduk traduite en ASM pour PB 5

Message par Mesa »

Mise à jour pour pb 5.7x

Code : Tout sélectionner

;http://mikhajduk.houa.org/EN/index.php?f=Links 
	 
	; Mesa http://www.purebasic.fr/french/viewtopic.php?f=12&t=14145 
	; 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   ll_isleapyear_error                    
			 
			isynegative:  
			MOV   eax, year               ; eax := Y =year  
			 
			TEST   eax, eax   
			JZ   ll_isleapyear_error          
			JNS   ll_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   ll_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   ll_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   ll_isleapyear_result                  ;  
			 
			SHR   eax, 1                  ; eax := E(eax / 2); CF := eax mod 2  
			JMP   ll_isleapyear_result                  ;  
			 
			error:  
			MOV   eax, -1  
			JMP   ll_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   ll_mdtodaynum_error                  ;  
			 
			month:  
			CMP   M, 1                    
			JB   ll_mdtodaynum_error                  ; 1 <= M <= 12  
			CMP   M, 12                    
			JA   ll_mdtodaynum_error                    
			 
			day:  
			CMP   D, 1                  ; D >= 1  
			JB   ll_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   ll_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   ll_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   ll_daynumtomd_error 
		 
		CMP   n, 1                      ; n >= 1 
		JB   ll_daynumtomd_error   ;Jump short if below (CF=1).  
		 
		MOV   eax, 365                
		ADD   eax, LeapYearFlag   ; eax := 365 + LeapYearFlag 
		CMP   n, eax                 ; n <= eax 
		JA   ll_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                  ; 
		 
		lloop:                       ; 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   ll_daynumtomd_loopend             
		LOOP   ll_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   ll_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   ll_datetoabsdaynum_error       
	 
			IsLeapYear(Y, Gregorian)          
			CMP   eax, -1                           ; eax := IsLeapYear(Y, Gregorian) 
			JE   ll_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   ll_datetoabsdaynum_error                      
	 
			MOV   ecx, Y                   
			CMP   ecx, 0                     ; ecx := Y 
			JG   ll_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   ll_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   ll_datetoabsdaynum_yprimpositive         ; Y' = 0 
					SUB   eax, 364                                 ; eax := eax - 364 = n - 364 
					JMP   ll_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   ll_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   ll_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   ll_absdaynumtodate_error                     ; 
	 
			TEST   Gregorian, -2      ; 0 <= Gregorian <= 1 
			JNZ   ll_absdaynumtodate_error                     ; 
	 
			XOR   ecx, ecx               ; ecx := 0 
			 
			MOV   eax, N                 ; eax := N - 1 
			DEC   eax                       ; 
	 
			CMP   Gregorian, 0 
			JE   ll_absdaynumtodate_julian 
	 
			gregorian: 
			CMP   eax, 1    
			JA   ll_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   ll_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   ll_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   ll_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   ll_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 
																			; \ 
			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 
					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   ll_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   ll_absdaynumtodate_md   ; = (N', Y*) 
																			 
							SUB   edx, 365 ; C1  
																					 
							INC   ecx                
							CMP   edx, 365 ; C1  
							JB   ll_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   ll_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   ll_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   ll_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   ll_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   ll_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   ll_gregoriantojulian_error 
		 
		numtojulian: 
		AbsDayNumToDate( tmpeax, 0, Yj, Mj, Dj) 
		 
		JMP   ll_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   ll_juliantogregorian_error 
		 
		numtogregorian: 
		AbsDayNumToDate( tmpeax, 1, Yg, Mg, Dg) 
		JMP   ll_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
Messages : 1093
Inscription : mer. 14/sept./2011 16:59

Re: Toute la DLL de Mikolaj Hajduk traduite en ASM pour PB 5

Message par Mesa »

code mis à jour avec la syntaxe pb, pb5.7x

Code : Tout sélectionner

;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  
			;PUSH edx  
			 
			checkparameters:  
			TEST  dword[p.v_gregorian], -2       ; 0 <= Gregorian <= 1  
			JNZ   ll_isleapyear_error                    
			 
			isynegative:  
			MOV   eax, [p.v_year]               ; eax := Y =year  
			 
			TEST   eax, eax   
			JZ   ll_isleapyear_error          
			JNS   ll_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  dword[p.v_gregorian], 0    
			JE   ll_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   ll_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   ll_isleapyear_result                  ;  
			 
			SHR   eax, 1                  ; eax := E(eax / 2); CF := eax mod 2  
			JMP   ll_isleapyear_result                  ;  
			 
			error:  
			MOV   eax, -1  
			JMP   ll_isleapyear_theend  
			 
			result:  
			SETNC   al                  ; eax := not CF  
			MOVZX   eax, al                    
			 
			theend:  
			;POP edx  
			;POP 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   ll_mdtodaynum_error                  ;  
			 
			month:  
			CMP   M, 1                    
			JB   ll_mdtodaynum_error                  ; 1 <= M <= 12  
			CMP   M, 12                    
			JA   ll_mdtodaynum_error                    
			 
			day:  
			CMP   D, 1                  ; D >= 1  
			JB   ll_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, [p.v_M]    ;+M  
			ADD ecx, edx  
			ADD ecx, eax  ;+12*LeapYearFlag  
			 
			MOV edx, eax  ; Sauvegarde de 12*LeapYearFlag  
			 
			MOVZX eax, byte [ecx]  
			 
			CMP  [p.v_D], eax               ; D <= MonthLen[M - 1 + 12*LeapYearFlag]  
			JA   ll_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, [p.v_M] 
			ADD ecx, edx  ;+M  
			ADD ecx, edx  ;+M  
			MOVZX eax, word [ecx]  
			 
			ADD   eax, [p.v_D]     ; eax := eax + D = DaySum(M, LeapYearFlag) + D  
			JMP   ll_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   dword[p.v_LeapYearFlag], -2   ; 0 <= LeapYearFlag <= 1  
		JNZ   ll_daynumtomd_error 
		 
		CMP   dword[p.v_n], 1         ; n >= 1 
		JB   ll_daynumtomd_error   ;Jump short if below (CF=1).  
		 
		MOV   eax, 365                
		ADD   eax, [p.v_LeapYearFlag]   ; eax := 365 + LeapYearFlag 
		CMP   n, eax                 ; n <= eax 
		JA   ll_daynumtomd_error                   
		 
		calculatemd: 
		MOV   eax, [p.v_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, [p.v_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   ll_daynumtomd_loopend             
		LOOP   @b ;ll_daynumtomd_lloop  
		 
		loopend: 
		MOV   eax, [p.v_M]              ; M := ecx = m 
		MOV   [eax], ecx             
		 
		MOV   ecx, [p.v_n]              ; ecx := n 
		SUB   ecx, edx           ; ecx := ecx - edx = n - DaySum(m, LeapYearFlag) 
		 
		MOV   eax, [p.v_D]              ; D := ecx 
		MOV   [eax], ecx             
		 
		XOR   eax, eax 
		 
		JMP   ll_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   dword[p.v_Gregorian], -2                  ; 0 <= Gregorian <= 1 
			JNZ   ll_datetoabsdaynum_error       
	 
			IsLeapYear(Y, Gregorian)          
			CMP   eax, -1                           ; eax := IsLeapYear(Y, Gregorian) 
			JE   ll_datetoabsdaynum_error       
	 
																										; Y <> 0 
	 
			;MOV ebx, eax ; ebx := eax  
			MOV [p.v_X], eax 
			 
			MDToDayNum(M, D, X)         ;ebx 
			CMP   eax, -1                     ; eax := MDToDayNum(M, D, ebx) = n 
			JE   ll_datetoabsdaynum_error                      
	 
			MOV   ecx, [p.v_Y]                   
			CMP   ecx, 0                     ; ecx := Y 
			JG   ll_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   dword[p.v_Gregorian], 0               ; ecx := ecx + kJ + k(G-J)[Gregorian = 1] = 
					JE   ll_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   ll_datetoabsdaynum_yprimpositive         ; Y' = 0 
					SUB   eax, 364                                 ; eax := eax - 364 = n - 364 
					JMP   ll_datetoabsdaynum_theend                   
	 
			yprimpositive:         ; Y' > 0 
																	 
					DEC   ecx                  ; ecx := ecx - 1 = Y' - 1  
					MOV [p.v_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, [p.v_X]            ; = 365(Y' - 1) + E((Y' - 1) / 4) + n 
	 
					CMP   dword[p.v_Gregorian], 0 
					JZ   ll_datetoabsdaynum_theend 
	 
			gregorian: 
			MOV [p.v_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, [p.v_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   ll_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   dword[p.v_N], 0                     ; N <> 0 ; l'année n'existe pas 
			JE   ll_absdaynumtodate_error                     ; 
	 
			TEST   dword[p.v_Gregorian], -2      ; 0 <= Gregorian <= 1 
			JNZ   ll_absdaynumtodate_error                     ; 
	 
			XOR   ecx, ecx               ; ecx := 0 
			 
			MOV   eax, [p.v_N]                 ; eax := N - 1 
			DEC   eax                       ; 
	 
			CMP   dword[p.v_Gregorian], 0 
			JE   ll_absdaynumtodate_julian 
	 
			gregorian: 
			CMP   eax, 1    
			JA   ll_absdaynumtodate_nextdays ;Jump short if above (CF=0 and ZF=0). 
																						; 0 <= eax <= 1 (1 <= N <= 2) 
					MOV   ecx, [p.v_M]               ; M := 12  
					MOV   dword [ecx], 12               ; 
	 
					ADD   eax, 30               ; eax := eax + 30 = N - 1 + 30 = N + 29  
	 
					MOV   ecx, [p.v_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   ll_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   ll_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   ll_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   ll_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 [p.v_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, [p.v_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   ll_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   ll_absdaynumtodate_md   ; = (N', Y*) 
																			 
							SUB   edx, 365 ; C1  
																					 
							INC   ecx                
							CMP   edx, 365 ; C1  
							JB   ll_absdaynumtodate_md                
																			 
							SUB   edx, 365 ; C1  
																			 
							INC   ecx                
	 
			md: 
					INC   edx                  ; edx := edx + 1 = N' + 1 
			 
					;sauvegarde 
					MOV [p.v_tmpeax], eax 
					MOV [p.v_tmpecx], ecx 
					MOV [p.v_tmpedx], edx 
	 
					IsLeapYear(tmpecx, Gregorian)         ; eax := IsLeapYear(ecx=year, Gregorian) = 
																						; = IsLeapYear(Y*, Gregorian) 
			MOV [p.v_tmpeax], eax 
	 
					;DayNumToMD(n.l, LeapYearFlag.l, M.l, D.l) 
			DayNumToMD(tmpedx, tmpeax, M, D) 
	 
					MOV ecx, [p.v_tmpecx]  
					MOV edx, [p.v_tmpedx] 
					 
					CMP   dword[p.v_Gregorian], 0 
					JE   ll_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   ll_absdaynumtodate_yearr 
																				; ecx <= 0 (Y' <= 0) 
	 
							DEC   ecx            ; ecx := ecx - 1 = Y' - 1 = Y' - [Y' <= 0] 
	 
					yearr: 
							MOV   eax, [p.v_Y]      ; Y := ecx 
							MOV   [eax], ecx             
	 
					XOR   eax, eax 
					JMP   ll_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   ll_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   ll_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 [p.v_tmpeax], eax 
		TEST   eax, eax 
		JZ   ll_gregoriantojulian_error 
		 
		numtojulian: 
		AbsDayNumToDate( tmpeax, 0, Yj, Mj, Dj) 
		 
		JMP   ll_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 [p.v_tmpeax], eax 
		TEST   eax, eax 
		JZ   ll_juliantogregorian_error 
		 
		numtogregorian: 
		AbsDayNumToDate( tmpeax, 1, Yg, Mg, Dg) 
		JMP   ll_juliantogregorian_theend 
		 
		error: 
		MOV   eax, -1 
		 
		theend: 
		 
		DisableASM 
		ProcedureReturn 
	 
	EndProcedure 
	 
	 
	;-Tests 
	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 ;) " 
M.
Répondre