replace internal uses of gettimeofday with monotonic time where appropriate. make...

[lcore.git] / btime.pas

diff --git a/btime.pas b/btime.pas
index 2a4b2676797170cd5bdeab82b962d73f38ece945..a3428e8546c6e39d0a52e1b2d92ee0e1d352df8e 100644 (file)
--- a/btime.pas
+++ b/btime.pas
@@ -9,10 +9,15 @@ works on windows/delphi, and on freepascal on unix.
 \r
 \r
 unit btime;\r
+{$ifdef fpc}\r
+  {$mode delphi}\r
+{$endif}\r
+\r
+{$include lcoreconfig.inc}\r
 \r
 interface\r
 \r
-{$ifdef win32}\r
+{$ifdef mswindows}\r
 uses\r
   ltimevalstuff;\r
 {$endif}  \r
@@ -31,6 +36,7 @@ var
   tickcount:integer;\r
   settimebias:tunixtimeint;\r
   performancecountfreq:extended;\r
+  btimenowin8:boolean;\r
 \r
 function irctimefloat:float;\r
 function irctimeint:tunixtimeint;\r
@@ -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\r
 function timestrisoutc(i:float):string;          // 2012-08-15T14:21:09.255553Z\r
 \r
-{$ifdef win32}\r
+procedure beginhightimerrate;\r
+procedure endhightimerrate;\r
+\r
+{$ifdef mswindows}\r
 function unixtimefloat_systemtime:float;\r
 {$endif}\r
 \r
@@ -63,12 +72,12 @@ function oletounixfloat(t:float):float;
 function oletounix(t:tdatetime):tunixtimeint;\r
 function unixtoole(i:float):tdatetime;\r
 \r
-{$ifdef win32}\r
+{$ifdef mswindows}\r
 function mmtimefloat:float;\r
 function qpctimefloat:float;\r
 {$endif}\r
 \r
-{$ifdef win32}\r
+{$ifdef mswindows}\r
 procedure gettimeofday(var tv:ttimeval);\r
 {$endif}\r
 \r
@@ -105,20 +114,17 @@ var
 \r
 implementation\r
 \r
-{$ifdef fpc}\r
-  {$mode delphi}\r
-{$endif}\r
+\r
 \r
 uses\r
   {$ifdef UNIX}\r
     {$ifdef VER1_0}\r
       linux,\r
     {$else}\r
+      {$ifdef linux}linux,{$endif} //for clock_gettime\r
+      {$ifdef freebsd}freebsd,{$endif} //for clock_gettime\r
       baseunix,unix,unixutil,sockets, {unixutil and sockets needed by unixstuff.inc on some compiler versions}\r
     {$endif}\r
-    {$ifdef linux}\r
-      dl,\r
-    {$endif}\r
   {$else}\r
     windows,unitsettc,mmsystem,\r
   {$endif}\r
@@ -138,7 +144,7 @@ end;
 \r
 function oletounix(t:tdatetime):tunixtimeint;\r
 begin\r
-  result := trunc(oletounixfloat(t));\r
+  result := round(oletounixfloat(t));\r
 end;\r
 \r
 function unixtoole(i:float):tdatetime;\r
@@ -169,49 +175,37 @@ end;
 function unixtimefloat:float;\r
 var\r
   tv:ttimeval;\r
+  sec:tunixtimeint;\r
 begin\r
   gettimeofday(tv);\r
-  result := tv.tv_sec+(tv.tv_usec/1000000);\r
+  sec := tv.tv_sec;\r
+  {$ifndef cpu64}\r
+  if (sec < -1) then inc(sec,$100000000); //tv_sec is 32 bits. allow -1 for invalid result\r
+  {$endif}\r
+  result := sec+(tv.tv_usec/1000000);\r
 end;\r
 \r
-{$ifdef linux}\r
-  {$define monotimefloat_implemented}\r
-  const\r
-    CLOCK_MONOTONIC = 1;\r
-  type \r
-    ptimeval = ^ttimeval;\r
-    tclock_gettime = function(clk_id: integer; tp: ptimeval): integer; cdecl;\r
+{$ifdef linux}{$define have_clock_gettime}{$endif}\r
+{$ifdef freebsd}{$define have_clock_gettime}{$endif}\r
 \r
-  var\r
-    librt_handle:pointer;\r
-    librt_inited:boolean;\r
-    clock_gettime: tclock_gettime;\r
+{$ifdef have_clock_gettime}\r
+  {$define monotimefloat_implemented}\r
 \r
   function monotimefloat:float;\r
   var\r
-    ts: ttimeval;\r
+    ts: ttimespec;\r
   begin\r
-    if not librt_inited then begin\r
-      librt_inited := true;\r
-      clock_gettime := nil;\r
-      librt_handle := dlopen('librt.so', RTLD_LAZY);\r
-      if assigned(librt_handle) then begin\r
-        clock_gettime := dlsym(librt_handle, 'clock_gettime');\r
-      end;\r
-    end;\r
-    if assigned(clock_gettime) then begin\r
-      if clock_gettime(CLOCK_MONOTONIC, @ts) = 0 then begin\r
-        //note this really returns nanoseconds\r
-        result := ts.tv_sec + ts.tv_usec / 1000000000.0;\r
-        exit;\r
-      end;\r
+    if clock_gettime(CLOCK_MONOTONIC, @ts) = 0 then begin\r
+      //note this really returns nanoseconds\r
+      result := ts.tv_sec + ts.tv_nsec / 1000000000.0;\r
+      exit;\r
     end;\r
     //fallback\r
     result := unixtimefloat;\r
   end;\r
 \r
 \r
-{$endif} {linux}\r
+{$endif}\r
 \r
 {$ifdef darwin} {mac OS X}\r
 {$define monotimefloat_implemented}\r
@@ -256,9 +250,14 @@ end;
 function unixtimeint:tunixtimeint;\r
 var\r
   tv:ttimeval;\r
+  sec:tunixtimeint;\r
 begin\r
   gettimeofday(tv);\r
-  result := tv.tv_sec;\r
+  sec := tv.tv_sec;\r
+  {$ifndef cpu64}\r
+  if (sec < 0) then inc(sec,$100000000); //tv_sec is 32 bits\r
+  {$endif}\r
+  result := sec;\r
 end;\r
 \r
 {------------------------------ end of *nix/freepascal section}\r
@@ -494,7 +493,7 @@ begin
   mmtime_lastresult := result;\r
 end;\r
 \r
-{ free pascals tsystemtime is incomaptible with windows api calls\r
+{ free pascals tsystemtime is incompatible with windows api calls\r
  so we declare it ourselves - plugwash\r
 }\r
 {$ifdef fpc}\r
@@ -553,12 +552,53 @@ begin
   result := mmqpctimefloat;\r
 end;\r
 \r
+\r
+\r
+var\r
+  GetSystemTimePreciseAsFileTime:procedure(var v:tfiletime); stdcall;\r
+  win8inited:boolean;\r
+\r
+procedure initwin8;\r
+var\r
+  dllhandle:thandle;\r
+\r
+begin\r
+  win8inited := true;\r
+  dllhandle := loadlibrary('kernel32.dll');\r
+  if (dllhandle <> 0) then begin\r
+    GetSystemTimePreciseAsFileTime := getprocaddress(dllhandle,'GetSystemTimePreciseAsFileTime');\r
+  end;\r
+end;\r
+\r
+\r
+function unixtimefloat_win8:float;\r
+var\r
+  ft:tfiletime;\r
+  i:int64 absolute ft;\r
+begin\r
+  GetSystemTimePreciseAsFileTime(ft);\r
+  {change from windows 1601-01-01 to unix 1970-01-01.\r
+  use integer math for this, to preserve precision}\r
+  dec(i, 116444736000000000);\r
+  result := (i / 10000000);\r
+end;\r
+\r
+\r
+\r
 function unixtimefloat:float;\r
 const\r
   margin = 0.0012;\r
 var\r
   f,g,h:float;\r
 begin\r
+  if not btimenowin8 then begin\r
+    if not win8inited then initwin8;\r
+    if assigned(@GetSystemTimePreciseAsFileTime) then begin\r
+      result := unixtimefloat_win8;\r
+      exit;\r
+    end;  \r
+  end;\r
+\r
   result := monotimefloat+timefloatbias;\r
   f := result-unixtimefloat_systemtime;\r
   if ((f > ticks_freq2+margin) or (f < -margin)) or (timefloatbias = 0) then begin\r
@@ -723,10 +763,19 @@ begin
 \r
 end;\r
 \r
+procedure beginhightimerrate;\r
+begin\r
+  {$ifdef mswindows}timebeginperiod(1);{$endif}\r
+end;\r
+\r
+procedure endhightimerrate;\r
+begin\r
+  {$ifdef mswindows}timeendperiod(1);{$endif}\r
+end;\r
 \r
 procedure init;\r
 begin\r
-  {$ifdef win32}timebeginperiod(1);{$endif} //ensure stable unchanging clock\r
+  {$ifdef btimehighrate}beginhightimerrate;{$endif}\r
   fillchar(mmtime_driftavg,sizeof(mmtime_driftavg),0);\r
   settimebias := 0;\r
   gettimezone;\r