X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/b3b93191002f92b19c069b9815a8261d6edbc5ec..3dd5a60c6c89a29781e099a9e204b09ffbb2e317:/btime.pas?ds=sidebyside

diff --git a/btime.pas b/btime.pas
index 2a4b267..46cdf48 100644
--- a/btime.pas
+++ b/btime.pas
@@ -9,10 +9,15 @@ works on windows/delphi, and on freepascal on unix.
 
 
 unit btime;
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+{$include lcoreconfig.inc}
 
 interface
 
-{$ifdef win32}
+{$ifdef mswindows}
 uses
   ltimevalstuff;
 {$endif}  
@@ -31,6 +36,7 @@ var
   tickcount:integer;
   settimebias:tunixtimeint;
   performancecountfreq:extended;
+  btimenowin8:boolean;
 
 function irctimefloat:float;
 function irctimeint:tunixtimeint;
@@ -55,7 +61,10 @@ function timestrshort(i:tunixtimeint):string;    // Wed Aug 15 16:21:09 2012
 function timestriso(i:tunixtimeint):string;      // 2012-08-15 16:21:09
 function timestrisoutc(i:float):string;          // 2012-08-15T14:21:09.255553Z
 
-{$ifdef win32}
+procedure beginhightimerrate;
+procedure endhightimerrate;
+
+{$ifdef mswindows}
 function unixtimefloat_systemtime:float;
 {$endif}
 
@@ -63,12 +72,12 @@ function oletounixfloat(t:float):float;
 function oletounix(t:tdatetime):tunixtimeint;
 function unixtoole(i:float):tdatetime;
 
-{$ifdef win32}
+{$ifdef mswindows}
 function mmtimefloat:float;
 function qpctimefloat:float;
 {$endif}
 
-{$ifdef win32}
+{$ifdef mswindows}
 procedure gettimeofday(var tv:ttimeval);
 {$endif}
 
@@ -105,9 +114,7 @@ var
 
 implementation
 
-{$ifdef fpc}
-  {$mode delphi}
-{$endif}
+
 
 uses
   {$ifdef UNIX}
@@ -138,7 +145,7 @@ end;
 
 function oletounix(t:tdatetime):tunixtimeint;
 begin
-  result := trunc(oletounixfloat(t));
+  result := round(oletounixfloat(t));
 end;
 
 function unixtoole(i:float):tdatetime;
@@ -494,7 +501,7 @@ begin
   mmtime_lastresult := result;
 end;
 
-{ free pascals tsystemtime is incomaptible with windows api calls
+{ free pascals tsystemtime is incompatible with windows api calls
  so we declare it ourselves - plugwash
 }
 {$ifdef fpc}
@@ -553,12 +560,53 @@ begin
   result := mmqpctimefloat;
 end;
 
+
+
+var
+  GetSystemTimePreciseAsFileTime:procedure(var v:tfiletime); stdcall;
+  win8inited:boolean;
+
+procedure initwin8;
+var
+  dllhandle:thandle;
+
+begin
+  win8inited := true;
+  dllhandle := loadlibrary('kernel32.dll');
+  if (dllhandle <> 0) then begin
+    GetSystemTimePreciseAsFileTime := getprocaddress(dllhandle,'GetSystemTimePreciseAsFileTime');
+  end;
+end;
+
+
+function unixtimefloat_win8:float;
+var
+  ft:tfiletime;
+  i:int64 absolute ft;
+begin
+  GetSystemTimePreciseAsFileTime(ft);
+  {change from windows 1601-01-01 to unix 1970-01-01.
+  use integer math for this, to preserve precision}
+  dec(i, 116444736000000000);
+  result := (i / 10000000);
+end;
+
+
+
 function unixtimefloat:float;
 const
   margin = 0.0012;
 var
   f,g,h:float;
 begin
+  if not btimenowin8 then begin
+    if not win8inited then initwin8;
+    if assigned(@GetSystemTimePreciseAsFileTime) then begin
+      result := unixtimefloat_win8;
+      exit;
+    end;  
+  end;
+
   result := monotimefloat+timefloatbias;
   f := result-unixtimefloat_systemtime;
   if ((f > ticks_freq2+margin) or (f < -margin)) or (timefloatbias = 0) then begin
@@ -723,10 +771,19 @@ begin
 
 end;
 
+procedure beginhightimerrate;
+begin
+  {$ifdef mswindows}timebeginperiod(1);{$endif}
+end;
+
+procedure endhightimerrate;
+begin
+  {$ifdef mswindows}timeendperiod(1);{$endif}
+end;
 
 procedure init;
 begin
-  {$ifdef win32}timebeginperiod(1);{$endif} //ensure stable unchanging clock
+  {$ifdef btimehighrate}beginhightimerrate;{$endif}
   fillchar(mmtime_driftavg,sizeof(mmtime_driftavg),0);
   settimebias := 0;
   gettimezone;