X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/14e470582b4a0ca5567239c1910f7513b2cfbaa1..71f094bad8c68b2a3d096b436dc74cf4d9e2895a:/btime.pas?ds=sidebyside

diff --git a/btime.pas b/btime.pas
index e0b0c4b..8826a4d 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;
@@ -50,10 +56,15 @@ procedure gettimezone;
 procedure timehandler;
 procedure init;
 
-function timestring(i:tunixtimeint):string;
-function timestrshort(i:tunixtimeint):string;
+function timestring(i:tunixtimeint):string;      // Wednesday August 15 2012 -- 16:21:09 +02:00
+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
+
+procedure beginhightimerrate;
+procedure endhightimerrate;
 
-{$ifdef win32}
+{$ifdef mswindows}
 function unixtimefloat_systemtime:float;
 {$endif}
 
@@ -61,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}
 
@@ -103,20 +114,17 @@ var
 
 implementation
 
-{$ifdef fpc}
-  {$mode delphi}
-{$endif}
+
 
 uses
   {$ifdef UNIX}
     {$ifdef VER1_0}
       linux,
     {$else}
+      {$ifdef linux}linux,{$endif} //for clock_gettime
+      {$ifdef freebsd}freebsd,{$endif} //for clock_gettime
       baseunix,unix,unixutil,sockets, {unixutil and sockets needed by unixstuff.inc on some compiler versions}
     {$endif}
-    {$ifdef linux}
-      dl,
-    {$endif}
   {$else}
     windows,unitsettc,mmsystem,
   {$endif}
@@ -136,7 +144,7 @@ end;
 
 function oletounix(t:tdatetime):tunixtimeint;
 begin
-  result := trunc(oletounixfloat(t));
+  result := round(oletounixfloat(t));
 end;
 
 function unixtoole(i:float):tdatetime;
@@ -167,49 +175,37 @@ end;
 function unixtimefloat:float;
 var
   tv:ttimeval;
+  sec:tunixtimeint;
 begin
   gettimeofday(tv);
-  result := tv.tv_sec+(tv.tv_usec/1000000);
+  sec := tv.tv_sec;
+  {$ifndef cpu64}
+  if (sec < -1) then inc(sec,$100000000); //tv_sec is 32 bits. allow -1 for invalid result
+  {$endif}
+  result := sec+(tv.tv_usec/1000000);
 end;
 
-{$ifdef linux}
-  {$define monotimefloat_implemented}
-  const
-    CLOCK_MONOTONIC = 1;
-  type 
-    ptimeval = ^ttimeval;
-    tclock_gettime = function(clk_id: integer; tp: ptimeval): integer; cdecl;
+{$ifdef linux}{$define have_clock_gettime}{$endif}
+{$ifdef freebsd}{$define have_clock_gettime}{$endif}
 
-  var
-    librt_handle:pointer;
-    librt_inited:boolean;
-    clock_gettime: tclock_gettime;
+{$ifdef have_clock_gettime}
+  {$define monotimefloat_implemented}
 
   function monotimefloat:float;
   var
-    ts: ttimeval;
+    ts: ttimespec;
   begin
-    if not librt_inited then begin
-      librt_inited := true;
-      clock_gettime := nil;
-      librt_handle := dlopen('librt.so', RTLD_LAZY);
-      if assigned(librt_handle) then begin
-        clock_gettime := dlsym(librt_handle, 'clock_gettime');
-      end;
-    end;
-    if assigned(clock_gettime) then begin
-      if clock_gettime(CLOCK_MONOTONIC, @ts) = 0 then begin
-        //note this really returns nanoseconds
-        result := ts.tv_sec + ts.tv_usec / 1000000000.0;
-        exit;
-      end;
+    if clock_gettime(CLOCK_MONOTONIC, @ts) = 0 then begin
+      //note this really returns nanoseconds
+      result := ts.tv_sec + ts.tv_nsec / 1000000000.0;
+      exit;
     end;
     //fallback
     result := unixtimefloat;
   end;
 
 
-{$endif} {linux}
+{$endif}
 
 {$ifdef darwin} {mac OS X}
 {$define monotimefloat_implemented}
@@ -254,9 +250,14 @@ end;
 function unixtimeint:tunixtimeint;
 var
   tv:ttimeval;
+  sec:tunixtimeint;
 begin
   gettimeofday(tv);
-  result := tv.tv_sec;
+  sec := tv.tv_sec;
+  {$ifndef cpu64}
+  if (sec < -1) then inc(sec,$100000000); //tv_sec is 32 bits. allow -1 for invalid result
+  {$endif}
+  result := sec;
 end;
 
 {------------------------------ end of *nix/freepascal section}
@@ -492,7 +493,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}
@@ -551,12 +552,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
@@ -688,9 +730,52 @@ begin
   timezonestr;
 end;
 
+function timestriso(i:tunixtimeint):string;
+var
+  y,m,d,h,min,sec,ms:word;
+  t:tdatetime;
+begin
+  t := unixtoole(i+timezone);
+  decodedate(t,y,m,d);
+  decodetime(t,h,min,sec,ms);
+  result := inttostr(y)+'-'+inttostr(m div 10)+inttostr(m mod 10)+'-'+inttostr(d div 10)+inttostr(d mod 10)+' '+inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10);
+end;
+
+function timestrisoutc(i:float):string;
+var
+  y,m,d,h,min,sec,ms:word;
+  t:tdatetime;
+  fr:float;
+begin
+  t := unixtoole(i);
+  decodedate(t,y,m,d);
+  decodetime(t,h,min,sec,ms);
+  result := inttostr(y)+'-'+inttostr(m div 10)+inttostr(m mod 10)+'-'+inttostr(d div 10)+inttostr(d mod 10)+'T'+inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10);
+  fr := frac(i);
+
+  result := result + '.'+
+  inttostr(trunc(fr*10) mod 10)+
+  inttostr(trunc(fr*100) mod 10)+
+  inttostr(trunc(fr*1000) mod 10)+
+  inttostr(trunc(fr*10000) mod 10)+
+  inttostr(trunc(fr*100000) mod 10)+
+  inttostr(trunc(fr*1000000) mod 10)+'Z';
+
+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;