PureBasic

Forums PureBasic
Nous sommes le Ven 20/Sep/2019 2:30

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 4 messages ] 
Auteur Message
 Sujet du message: Toute la DLL de Mikolaj Hajduk traduite en ASM pour PB 5.2x
MessagePosté: Jeu 19/Déc/2013 19:14 
Hors ligne

Inscription: Mer 14/Sep/2011 16:59
Messages: 904
Ce code fonctionne sous Xp 32b, reste à vérifier pour les autres plateformes.
Ne fonctionne pas sur du 64b.

Code:
;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:
;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 édition par Mesa le Mer 19/Fév/2014 16:41, édité 2 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Toute la DLL de Mikolaj Hajduk traduite en ASM pour PB 5
MessagePosté: Ven 20/Déc/2013 14:36 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 25/Avr/2008 11:14
Messages: 1336
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Toute la DLL de Mikolaj Hajduk traduite en ASM pour PB 5
MessagePosté: Sam 21/Déc/2013 11:17 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 25/Avr/2008 11:14
Messages: 1336
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:
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 "-----------------------------------------------------------"


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Toute la DLL de Mikolaj Hajduk traduite en ASM pour PB 5
MessagePosté: Sam 21/Déc/2013 14:22 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 25/Avr/2008 11:14
Messages: 1336
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:
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 "-----------------------------------------------------------"




Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 4 messages ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 1 invité


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  
cron

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye