X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/9763940f8849e5c807566157829a1e6d2c9172ee..1eee6366bbaa10a34232046fee3aa83181bc452f:/btime.pas

diff --git a/btime.pas b/btime.pas
index 14b734e..6ee3dbb 100644
--- a/btime.pas
+++ b/btime.pas
@@ -3,34 +3,130 @@
   which is included in the package
   ----------------------------------------------------------------------------- }
 {
-this unit returns unix timestamp with seconds and microseconds (as float)
-works on windows/delphi, and on freepascal on unix.
+this unit has several functions for getting unix and monotonic time and UTC offset on both windows and linux/unix
+
+this unit aims to work on delphi 6 and later, both x86 and x64, on win95 and later
+delphi 5 may work (untested).
+as well as freepascal on linux x86 and x64 and freebsd x64 (tested), windows, and other unixes (untested)
+
+provided functions. all are available on both windows and linux/unix:
+- unix timestamp as a (double or extended) float or integer: unixtimefloat, unixtimeint
+- monotonic timestamp as float: monotimefloat, wintimefloat (both are equivalent)
+- _coarse versions of the floats, which can be faster, and precision in the milliseconds.
+- btime_gettime: a unified function like clock_gettime. less reliant on floats.
+- tzgetoffset returns the UTC offset (timezone) in seconds
+
+- on windows, it provides the legacy function gettimeofday (on unix, use the one provided by the OS units)
+
+other things in the interface are often more implementation specific, there for legacy reasons, and not guaranteed stable
+
+this unit should be 2038 safe:
+- seconds are handled as 64 bits
+- on 32 bits linux, it uses clock_gettime64 if available 
+- for getting the UTC offset on unix, this unit does its own, 64 bits aware, parsing of the zoneinfo file 
+- tested with clock set after 2038
 }
 
 
 unit btime;
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+{$include lcoreconfig.inc}
 
 interface
 
 {$ifdef mswindows}
 uses
   ltimevalstuff;
-{$endif}  
+{$endif}
+
+{$ifdef linux}
+uses
+  linux,syscall;
+{$endif}
+
+{$ifdef freebsd}
+uses
+  freebsd;
+{$endif}
+
+{$ifdef FPC_HAS_TYPE_EXTENDED}{$define has_extended}{$endif}
+{$ifndef fpc}{$ifdef cpu386}{$define has_extended}{$endif}{$endif}
 
 type
+  {$ifdef has_extended}
   float=extended;
-  tunixtimeint={$ifdef ver100}longint;{$else}int64;{$endif}
+  {$else}
+  float=double;
+  {$endif}
+  tunixtimeint=int64;
 
 const
   colorburst=39375000/11;  {3579545.4545....}
 
+  {
+  CLOCK_MONOTONIC is the standard monotonic time offered by the OS, it may or may not include suspend time
+  CLOCK_BOOTTIME includes suspend time.
+  CLOCK_UPTIME excludes suspend time.
+  }
+
+  {$ifdef mswindows}
+  CLOCK_REALTIME=0;
+  CLOCK_MONOTONIC=1;
+  CLOCK_REALTIME_COARSE=2;
+  CLOCK_MONOTONIC_COARSE=3;
+  CLOCK_BOOTTIME=CLOCK_MONOTONIC;  //GetTickCount
+  CLOCK_UPTIME=4;                  //QueryUnbiasedInterruptTime, fallback to QueryPerformanceCounter
+  CLOCK_UPTIME_FAST=CLOCK_UPTIME;
+  {$endif}
+
+  {$ifdef linux}
+  CLOCK_REALTIME=linux.CLOCK_REALTIME;
+  CLOCK_MONOTONIC=linux.CLOCK_MONOTONIC;
+  CLOCK_REALTIME_COARSE=linux.CLOCK_REALTIME_COARSE;
+  CLOCK_MONOTONIC_COARSE=linux.CLOCK_MONOTONIC_COARSE;
+  CLOCK_BOOTTIME=7; //linux.CLOCK_BOOTTIME - constant missing in freepascal
+  CLOCK_UPTIME=CLOCK_MONOTONIC;
+  CLOCK_UPTIME_FAST=CLOCK_MONOTONIC_COARSE;
+  {$endif}
+
+  {$ifdef freebsd}
+  CLOCK_REALTIME=freebsd.CLOCK_REALTIME;
+  CLOCK_MONOTONIC=freebsd.CLOCK_MONOTONIC;
+  CLOCK_REALTIME_COARSE=freebsd.CLOCK_REALTIME_FAST;
+  CLOCK_MONOTONIC_COARSE=freebsd.CLOCK_MONOTONIC_FAST;
+  CLOCK_BOOTTIME=CLOCK_MONOTONIC;
+  CLOCK_UPTIME=freebsd.CLOCK_UPTIME;
+  CLOCK_UPTIME_FAST=freebsd.CLOCK_UPTIME_FAST;
+  {$endif}
+
+  {$ifdef darwin}
+  CLOCK_REALTIME=0;      //values taken from darwin libc time.h
+  CLOCK_MONOTONIC=6;
+  CLOCK_REALTIME_COARSE=CLOCK_REALTIME;   //darwin lacks these or equivalents
+  CLOCK_MONOTONIC_COARSE=CLOCK_MONOTONIC;
+  CLOCK_BOOTTIME=CLOCK_MONOTONIC;
+  CLOCK_UPTIME_RAW=8;
+  CLOCK_UPTIME=CLOCK_UPTIME_RAW;
+  CLOCK_UPTIME_FAST=CLOCK_UPTIME_RAW;
+  {$endif}
+
+  CLOCK_REALTIME_FAST=CLOCK_REALTIME_COARSE;
+  CLOCK_MONOTONIC_FAST=CLOCK_MONOTONIC_COARSE;
+
+
 var
   timezone:integer;
   timezonestr:string;
   irctime,unixtime:tunixtimeint;
   tickcount:integer;
   settimebias:tunixtimeint;
-  performancecountfreq:extended;
+  performancecountfreq:int64;
+  performancecountstep:float;
+
+  btimenowin8:boolean;
 
 function irctimefloat:float;
 function irctimeint:tunixtimeint;
@@ -42,9 +138,20 @@ function unixtimeint:tunixtimeint;
 //monotonic float seconds
 function monotimefloat:float;
 
+//coarse float seconds - usually faster, but a resolution in the milliseconds
+function unixtimefloat_coarse:float;
+function monotimefloat_coarse:float;
+
+//float versions of CLOCK_BOOTTIME and CLOCK_UPTIME
+function boottimefloat:float;
+function uptimefloat:float;
+
 //monotonic (alias, old function name)
 function wintimefloat:float;
 
+//get localtime vs UTC offset in seconds
+function tzgetoffset:integer;
+
 procedure settime(newtime:tunixtimeint);
 procedure gettimezone;
 procedure timehandler;
@@ -55,6 +162,15 @@ 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;
+
+procedure tzinvalidate;
+
+{$ifdef unix}
+function tzgetoffsetforts(ts:tunixtimeint):integer;
+{$endif}
+
 {$ifdef mswindows}
 function unixtimefloat_systemtime:float;
 {$endif}
@@ -65,11 +181,12 @@ function unixtoole(i:float):tdatetime;
 
 {$ifdef mswindows}
 function mmtimefloat:float;
+function mmtimeint64:int64;
 function qpctimefloat:float;
 {$endif}
 
 {$ifdef mswindows}
-procedure gettimeofday(var tv:ttimeval);
+function gettimeofday(var tv:ttimeval):integer;
 {$endif}
 
 
@@ -90,7 +207,7 @@ var
   lastsyncbias:float=0;
 
   mmtime_last:integer=0;
-  mmtime_wrapadd:float;
+  mmtime_wrapadd:int64;
   mmtime_lastsyncmm:float=0;
   mmtime_lastsyncqpc:float=0;
   mmtime_drift:float=1;
@@ -103,12 +220,24 @@ var
   mmtime_prev_lastsyncmm:float;
   mmtime_prev_lastsyncqpc:float;
 
-implementation
+  gettime64_nosupport_cached:boolean;
+  coarse_nosupport_cached:boolean;
+
+type
+  //i define my own "timespec" and "gettime" because that way, they can be 64 bits even if the real one is 32 bits, and avoid the wrong one being used.
+  //tbtimespec can't be changed because it is passed as-is to clock_gettime64
+  tbtimespec=packed record
+    tv_sec:int64;
+    tv_nsec:int64;
+  end;
+  pbtimespec=^tbtimespec;
 
-{$ifdef fpc}
-  {$mode delphi}
-{$endif}
 
+//on unix, btime_gettime is the "inner" function that calls the actual OS/library functions, and other functions in btime call it
+//on windows, btime_gettime is an "outer" function that calls the other functions. so if not called by the app, it does not add to exe size.
+function btime_gettime(clockid:integer;tp:pbtimespec):integer;
+
+implementation
 uses
   {$ifdef UNIX}
     {$ifdef VER1_0}
@@ -116,9 +245,6 @@ uses
     {$else}
       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}
@@ -138,7 +264,7 @@ end;
 
 function oletounix(t:tdatetime):tunixtimeint;
 begin
-  result := trunc(oletounixfloat(t));
+  result := round(oletounixfloat(t));
 end;
 
 function unixtoole(i:float):tdatetime;
@@ -146,139 +272,245 @@ begin
   result := ((i)/86400)+daysdifference;
 end;
 
-const
-  highdwordconst=65536.0 * 65536.0;
-
-function utrunc(f:float):integer;
-{converts float to integer, in 32 bits unsigned range}
-begin
-  if f >= (highdwordconst/2) then f := f - highdwordconst;
-  result := trunc(f);
-end;
-
-function uinttofloat(i:integer):float;
-{converts 32 bits unsigned integer to float}
-begin
-  result := i;
-  if result < 0 then result := result + highdwordconst;
-end;
-
 {$ifdef unix}
 {-----------------------------------------*nix/freepascal code to read time }
 
-function unixtimefloat:float;
-var
-  tv:ttimeval;
-begin
-  gettimeofday(tv);
-  result := tv.tv_sec+(tv.tv_usec/1000000);
-end;
+{$ifdef linux}{$define have_clock_gettime}{$endif}
+{$ifdef freebsd}{$define have_clock_gettime}{$endif}
 
 {$ifdef linux}
-  {$define monotimefloat_implemented}
-  const
-    CLOCK_MONOTONIC = 1;
-  type 
-    ptimeval = ^ttimeval;
-    tclock_gettime = function(clk_id: integer; tp: ptimeval): integer; cdecl;
+  {$ifdef cpu386}{$define use_syscall_gettime64}{$endif}
+  {$ifdef cpu32}{$define use_syscall_gettime64}{$endif}
 
-  var
-    librt_handle:pointer;
-    librt_inited:boolean;
-    clock_gettime: tclock_gettime;
-
-  function monotimefloat:float;
-  var
-    ts: ttimeval;
-  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;
-    end;
-    //fallback
-    result := unixtimefloat;
-  end;
+  {$ifdef use_syscall_gettime64}
+const
+  clock_gettime64=403;
+  {$endif}
+{$endif} //linux
 
 
-{$endif} {linux}
 
 {$ifdef darwin} {mac OS X}
-{$define monotimefloat_implemented}
-
   type
     tmach_timebase_info = packed record
-      numer: longint;
-      denom: longint;
+      numer: cardinal;
+      denom: cardinal;
     end;
     pmach_timebase_info = ^tmach_timebase_info;
-     
+
     function mach_absolute_time: int64; cdecl; external;
     function mach_timebase_info(info: pmach_timebase_info): integer; cdecl; external;
 
   var
     timebase_info: tmach_timebase_info;
+{$endif} //darwin
 
-  function monotimefloat:float;
-  var
-    i:int64;
-  begin
+
+function btime_gettime(clockid:integer;tp:pbtimespec):integer;
+var
+{$ifdef have_clock_gettime}
+  ts: ttimespec;
+{$endif}
+  tv: ttimeval;
+{$ifdef darwin}
+  nanos:int64;
+  nanosf:extended;
+{$endif}
+
+begin
+  result := -1; //error
+
+  {$ifdef darwin}
+  if (clockid = CLOCK_MONOTONIC) or (clockid = CLOCK_MONOTONIC_COARSE) then begin
     if timebase_info.denom = 0 then begin
       mach_timebase_info(@timebase_info);
     end;
-    i := mach_absolute_time;
-    result := (i * timebase_info.numer div timebase_info.denom) / 1000000000.0;
+    if (timebase_info.denom > 0) then begin
+      nanos := mach_absolute_time;
+      if (nanos > 0) then begin
+        result := 0; //indicate success
+        if (timebase_info.denom > 10) then begin
+          //on powerpc mac, numer and denom are large numbers such as 1000000000 and 33333335, and extended is available
+          nanosf := nanos;
+          nanosf := (nanosf * timebase_info.numer) / timebase_info.denom;
+          nanos := trunc(nanosf);
+        end else begin
+          //on intel mac, numer and denom are 1 and 1. on apple silicon they are typically 125 and 3, and extended is not available
+          nanos := nanos div timebase_info.denom;
+          nanos := nanos * timebase_info.numer;
+        end;
+        tp.tv_sec := nanos div 1000000000;
+        tp.tv_nsec := nanos mod 1000000000;
+        exit;
+      end;
+    end;
   end;
+  {$endif} //darwin
 
-{$endif} {darwin, mac OS X}
+  if (coarse_nosupport_cached) then begin
+    if (clockid = CLOCK_REALTIME_COARSE) then clockid := CLOCK_REALTIME;
+    if (clockid = CLOCK_MONOTONIC_COARSE) then clockid := CLOCK_MONOTONIC;
+  end;
 
+  {$ifdef use_syscall_gettime64}
+  //don't do this for monotonic for performance reasons
+  //the clock_gettime call below has the potential to be handled by libc, and then it is faster
+  //also if it failed, don't call it again to avoid slowdown of doing two calls every time
+  if (not ((clockid = CLOCK_MONOTONIC) or (clockid = CLOCK_MONOTONIC_COARSE) or (clockid = CLOCK_BOOTTIME) or (clockid = CLOCK_UPTIME))) and (not gettime64_nosupport_cached) then begin
+    result := do_syscall(clock_gettime64,clockid,tsysparam(tp));
 
-{$ifndef monotimefloat_implemented} {fallback}
-  
-  function monotimefloat:extended;
-  begin
-    result := unixtimefloat;
+    if ((clockid = CLOCK_REALTIME) or (clockid = CLOCK_REALTIME_COARSE)) and (result <> 0) then gettime64_nosupport_cached := true;
+
+    if (result = 0) then exit;
+  end;
+  {$endif}
+
+  {$ifdef have_clock_gettime}
+  result := clock_gettime(clockid, @ts);
+  if (result <> 0) then begin
+    //fallback
+    if (clockid = CLOCK_REALTIME_COARSE) then begin
+      coarse_nosupport_cached := true;
+      result := clock_gettime(CLOCK_REALTIME, @ts);
+    end else
+    if (clockid = CLOCK_MONOTONIC_COARSE) then begin
+      coarse_nosupport_cached := true;
+      result := clock_gettime(CLOCK_MONOTONIC, @ts);
+    end;
   end;
+  if (result = 0) then begin
+    tp.tv_sec := ts.tv_sec;
+    tp.tv_nsec := ts.tv_nsec;
+
+    {$ifndef cpu64}
+    if (tp.tv_sec < -1) then inc(tp.tv_sec, $100000000);
+    {$endif}
+
+    exit;
+  end;
+  {$endif} //have_clock_gettime
+
+  result := gettimeofday(tv);
+  if (result = 0) then begin
+    tp.tv_sec := tv.tv_sec;
+    tp.tv_nsec := tv.tv_usec * 1000;
+
+    {$ifndef cpu64}
+    if (tp.tv_sec < -1) then inc(tp.tv_sec, $100000000);
+    {$endif}
+  end;
+end;
+
+
+function unixtimefloat:float;
+var
+  ts:tbtimespec;
+begin
+  btime_gettime(CLOCK_REALTIME, @ts);
+  //doing the below as a division causes a bug in fpc 3.2.0 x64, where the result becomes single precision
+  result := ts.tv_sec + (ts.tv_nsec * 0.000000001);
+end;
+
+
+function monotimefloat:float;
+var
+  ts:tbtimespec;
+begin
+  btime_gettime(CLOCK_MONOTONIC, @ts);
+  result := ts.tv_sec + (ts.tv_nsec * 0.000000001);
+end;
+
+
+function unixtimefloat_coarse:float;
+var
+  ts:tbtimespec;
+begin
+  btime_gettime(CLOCK_REALTIME_COARSE, @ts);
+  result := ts.tv_sec + (ts.tv_nsec * 0.000000001);
+end;
+
+
+function monotimefloat_coarse:float;
+var
+  ts:tbtimespec;
+begin
+  btime_gettime(CLOCK_MONOTONIC_COARSE, @ts);
+  result := ts.tv_sec + (ts.tv_nsec * 0.000000001);
+end;
 
-{$endif} {monotimefloat fallback}
+
+function boottimefloat:float;
+var
+  ts:tbtimespec;
+begin
+  btime_gettime(CLOCK_BOOTTIME, @ts);
+  result := ts.tv_sec + (ts.tv_nsec * 0.000000001);
+end;
+
+
+function uptimefloat:float;
+var
+  ts:tbtimespec;
+begin
+  btime_gettime(CLOCK_UPTIME, @ts);
+  result := ts.tv_sec + (ts.tv_nsec * 0.000000001);
+end;
 
 
 function unixtimeint:tunixtimeint;
 var
-  tv:ttimeval;
+  ts:tbtimespec;
 begin
-  gettimeofday(tv);
-  result := tv.tv_sec;
+  btime_gettime(CLOCK_REALTIME,@ts);
+  result := ts.tv_sec;
 end;
 
 {------------------------------ end of *nix/freepascal section}
 
-{$else} {delphi 3}
+{$endif}  //unix
+
+{$ifdef mswindows}
 {------------------------------ windows/delphi code to read time}
 
 
-{simulate gettimeofday on windows so one can always use gettimeofday if preferred}
+procedure tzinvalidate;
+begin
+  gettimezone;
+end;
+
+
+var
+  GetTickCount64:function:int64; stdcall;
+  gettickcount64_inited:boolean;
 
-procedure gettimeofday(var tv:ttimeval);
+procedure init_gettickcount64;
 var
-  e:extended;
+  dllhandle:thandle;
 begin
-  e := unixtimefloat;
-  tv.tv_sec := round(int(e));
-  tv.tv_usec := trunc(frac(e)*1000000);
-  {just in case}
-  if (tv.tv_usec < 0) then tv.tv_usec := 0;
-  if (tv.tv_usec > 999999) then tv.tv_usec := 999999;
+  gettickcount64_inited := true;
+  dllhandle := loadlibrary('kernel32.dll');
+  if (dllhandle <> 0) then begin
+    GetTickCount64 := getprocaddress(dllhandle,'GetTickCount64');
+  end;
+end;
+
+
+
+function mmtimeint64:int64;
+var
+  i:int64;
+begin
+  if not gettickcount64_inited then init_gettickcount64;
+  if assigned(GetTickCount64) then begin
+    result := GetTickCount64;
+  end else begin
+    i := gettickcount;
+    if i < mmtime_last then begin
+      mmtime_wrapadd := mmtime_wrapadd + $100000000;
+    end;
+    mmtime_last := i;
+    result := mmtime_wrapadd + i;
+  end;
 end;
 
 
@@ -288,23 +520,12 @@ resolution: 9x: ~55 ms NT: 1/64th of a second
 guarantees: continuous without any jumps
 frequency base: same as system clock.
 epoch: system boot
-note: if called more than once per 49.7 days, 32 bits wrapping is compensated for and it keeps going on.
-note: i handle the timestamp as signed integer, but with the wrap compensation that works as well, and is faster
 }
-
 function mmtimefloat:float;
-const
-  wrapduration=highdwordconst * 0.001;
 var
-  i:integer;
   temp:float;
 begin
-  i := gettickcount; {timegettime}
-  if i < mmtime_last then begin
-    mmtime_wrapadd := mmtime_wrapadd + wrapduration;
-  end;
-  mmtime_last := i;
-  result := mmtime_wrapadd + i * 0.001;
+  result := mmtimeint64 * 0.001;
 
   if (ticks_freq <> 0) and ticks_freq_known then begin
     {the value we get is rounded to 1 ms, but the ticks are not a multiple of 1 ms
@@ -319,14 +540,34 @@ begin
   end;
 end;
 
+var
+  win_version_known:boolean;
+  win_isnt:boolean;
+  win_ver_major:integer;
+  win_ver_minor:integer;
+
+procedure init_win_version;
+var
+  o:tosversioninfo;
+begin
+  if not win_version_known then begin
+    win_version_known := true;
+    fillchar(o,sizeof(o),0);
+    o.dwOSVersionInfoSize := sizeof(o);
+    getversionex(o);
+    win_isnt := o.dwPlatformId = VER_PLATFORM_WIN32_NT;
+    win_ver_major := o.dwMajorVersion;
+    win_ver_minor := o.dwMinorVersion;
+  end;
+end;
+
 procedure measure_ticks_freq;
 var
   f,g:float;
-  o:tosversioninfo;
-  isnt:boolean;
-{  is9x:boolean;}
+
   adjust1,adjust2:cardinal;
   adjustbool:longbool;
+  win8_or_later:boolean;
 begin
   if (performancecountfreq = 0) then qpctimefloat;
   ticks_freq_known := false;
@@ -335,22 +576,26 @@ begin
   repeat g := mmtimefloat until g > f;
   unsettc;
   f := g - f;
-  fillchar(o,sizeof(o),0);
-  o.dwOSVersionInfoSize := sizeof(o);
-  getversionex(o);
-  isnt := o.dwPlatformId = VER_PLATFORM_WIN32_NT;
-{  is9x := o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS;}
+
+  init_win_version;
 
   ticks_freq2 := f;
   mmtime_synchedqpc := false;
 
-  if (isnt and (o.dwMajorVersion >= 5)) then begin
+  if (win_isnt and (win_ver_major >= 5)) then begin
     {windows 2000 and later: query tick rate from OS in 100 ns units
     typical rates: XP: 156250 or 100144, windows 7: 156001}
     if GetSystemTimeAdjustment(adjust1,adjust2,adjustbool) then begin
       ticks_freq := adjust1 / 10000000.0;
       ticks_freq_known := true;
       mmtime_synchedqpc := false;
+
+      //windows 8/10/11, 10 MHz time source is invariant TSC. add 64 Hz check for safety.
+      //with manifest, windows 10/11 major.minor will be 10.0 
+      win8_or_later := ((win_ver_major = 6) and (win_ver_minor >= 2)) or (win_ver_major = 10);
+      if (win8_or_later and (performancecountfreq = 10000000) and (adjust1 = 156250)) then begin
+        mmtime_synchedqpc := true;
+      end;
     end;
   end;
 
@@ -372,26 +617,16 @@ guarantees: can have forward jumps depending on hardware. can have forward and b
 frequency base: on NT, not the system clock, drifts compared to it.
 epoch: system boot
 }
-function qpctimefloat:extended;
+function qpctimefloat:float;
 var
-  p:packed record
-    lowpart:longint;
-    highpart:longint
-  end;
-  p2:tlargeinteger absolute p;
-  e:extended;
+  i64:int64;
 begin
   if performancecountfreq = 0 then begin
-    QueryPerformancefrequency(p2);
-    e := p.lowpart;
-    if e < 0 then e := e + highdwordconst;
-    performancecountfreq := ((p.highpart*highdwordconst)+e);
+    QueryPerformancefrequency(performancecountfreq);
+    performancecountstep := 1.0 / performancecountfreq;
   end;
-  queryperformancecounter(p2);
-  e := p.lowpart;
-  if e < 0 then e := e + highdwordconst;
-
-  result := ((p.highpart*highdwordconst)+e)/performancecountfreq;
+  queryperformancecounter(i64);
+  result := i64 * performancecountstep;
 end;
 
 {
@@ -402,7 +637,8 @@ frequency base: same as system clock.
 epoch: system boot
 }
 
-function mmqpctimefloat:float;
+//function mmqpctimefloat:float;
+function monotimefloat:float;
 const
   maxretries=5;
   margin=0.002;
@@ -494,75 +730,247 @@ begin
   mmtime_lastresult := result;
 end;
 
-{ free pascals tsystemtime is incompatible with windows api calls
- so we declare it ourselves - plugwash
-}
-{$ifdef fpc}
-type
-  TSystemTime = record
-     wYear: Word;
-     wMonth: Word;
-     wDayOfWeek: Word;
-     wDay: Word;
-     wHour: Word;
-     wMinute: Word;
-     wSecond: Word;
-     wMilliseconds: Word;
-  end;
- {$endif}
-function Date_utc: extended;
-var
-  SystemTime: TSystemTime;
-begin
-  {$ifdef fpc}
-    GetsystemTime(@SystemTime);
-  {$else}
-    GetsystemTime(SystemTime);
-  {$endif}
-  with SystemTime do Result := EncodeDate(wYear, wMonth, wDay);
+
+function boottimefloat:float;
+begin
+  result := monotimefloat;
 end;
 
-function Time_utc: extended;
 var
-  SystemTime: TSystemTime;
+  QueryUnbiasedInterruptTime:function(var i:int64):longbool; stdcall;
+  unbiasedinterrupttime_inited:boolean;
+
+
+procedure initunbiasedinterrupttime;
+var
+  dllhandle:thandle;
 begin
-  {$ifdef fpc}
-    GetsystemTime(@SystemTime);
-  {$else}
-    GetsystemTime(SystemTime);
-  {$endif}
-  with SystemTime do
-    Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);
+  unbiasedinterrupttime_inited := true;
+  dllhandle := loadlibrary('kernel32.dll');
+  if (dllhandle <> 0) then begin
+    QueryUnbiasedInterruptTime := getprocaddress(dllhandle,'QueryUnbiasedInterruptTime');
+  end;
 end;
 
-function Now_utc: extended;
+function unbiasedtime_100ns:int64;
 begin
-  Result := round(Date_utc) + Time_utc;
+  result := -1;
+  if not unbiasedinterrupttime_inited then initunbiasedinterrupttime;
+  if assigned(@QueryUnbiasedInterruptTime) then begin
+    QueryUnbiasedInterruptTime(result);
+  end;
 end;
 
+function uptimefloat:float;
+var
+  i:int64;
+begin
+  i := unbiasedtime_100ns;
+  if (i > 0) then begin
+    result := i * 0.0000001;
+    exit;
+  end;
+  result := qpctimefloat;
+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 win8time_as_unix_100ns:int64;
+var
+  ft:tfiletime;
+  i:int64 absolute ft;
+begin
+  result := -1;
+  if not win8inited then initwin8;
+  if assigned(@GetSystemTimePreciseAsFileTime) then begin
+    GetSystemTimePreciseAsFileTime(ft);
+    //change from windows 1601-01-01 to unix 1970-01-01.
+    dec(i, 116444736000000000);
+    result := i;
+  end;
+end;
+
+
 function unixtimefloat_systemtime:float;
+var
+  ft:tfiletime;
+  i:int64 absolute ft;
+begin
+  //result := oletounixfloat(now_utc);
+
+  //this method gives exactly the same result with extended precision, but is less sensitive to float rounding in theory}
+  //result := oletounixfloat(int(date_utc+0.5))+time_utc*86400;
+
+  //new method that is much faster (22 vs 190 ns)
+  GetSystemTimeAsFileTime(ft);
+  dec(i, 116444736000000000);
+  result := i * 0.0000001;
+end;
+
+
+function unixtimefloat_coarse:float;
+begin
+  //don't do the coarse method if worse than about 16 ms. on win9x it may be only a 55 ms resolution
+  //but i have also seen it is less (like 1 ms)
+  //don't call measure_ticks_freq on NT because it is expensive and unnecessary
+  init_win_version;
+  if not win_isnt then begin
+    if not ticks_freq_known then measure_ticks_freq;
+  end;
+  if win_isnt or (ticks_freq < 0.017) then begin
+    result := unixtimefloat_systemtime;
+    exit;
+  end;
+
+  result := unixtimefloat;
+end;
+
+function monotimefloat_coarse:float;
+begin
+  init_win_version;
+  if not win_isnt then begin
+    if not ticks_freq_known then measure_ticks_freq;
+  end;
+  if win_isnt or (ticks_freq < 0.017) then begin
+    result := mmtimeint64 * 0.001;
+    exit;
+  end;
+  result := monotimefloat;
+end;
+
+
+//simulate gettimeofday on windows so one can always use gettimeofday if preferred
+function gettimeofday(var tv:ttimeval):integer;
+var
+  e:float;
+  i:int64;
 begin
-  {result := oletounixfloat(now_utc);}
+  result := -1;
+
+  if not btimenowin8 then begin
+    i := win8time_as_unix_100ns;
+    if (i > 0) then begin
+      tv.tv_sec := i div 10000000;
+      tv.tv_usec := (i mod 10000000) div 10;
+      result := 0;
+      exit;
+    end;
+  end;
 
-  {this method gives exactly the same result with extended precision, but is less sensitive to float rounding in theory}
-  result := oletounixfloat(int(date_utc+0.5))+time_utc*86400;
+  e := unixtimefloat;
+  if (e > 0) then result := 0;
+  tv.tv_sec := trunc(e);
+  tv.tv_usec := trunc(frac(e)*1000000);
 end;
 
-function monotimefloat:extended;
+
+function btime_gettime(clockid:integer;tp:pbtimespec):integer;
+var
+  f:float;
+  i:int64;
+
+{$ifdef cpu386}{$ifdef has_extended}{$define itotp_float}{$endif}{$endif}
+procedure i100ns_to_tp_and_success;
+{$ifdef itotp_float}
+var
+  f:float;
+{$endif}
 begin
-  result := mmqpctimefloat;
+  //in 32 bits delphi, float is 10 times faster than int64 here (30 vs 300 ns for the conversion)
+  //and with extended available, there is no loss of precision
+
+  {$ifdef itotp_float}
+  f := i / 10000000.0;
+  tp.tv_sec := trunc(f);
+  tp.tv_nsec := round(frac(f) * 1000000000.0);
+  {$else}
+  tp.tv_sec := i div 10000000;
+  tp.tv_nsec := (i mod 10000000) * 100;
+  {$endif}
+
+  result := 0; //success
+end;
+
+procedure f_to_tp_and_success;
+begin
+  tp.tv_sec := trunc(f);
+  tp.tv_nsec := round(frac(f) * 1000000000.0);
+  result := 0; //success
 end;
 
+begin
+  result := -1; //error
+
+  case clockid of
+    CLOCK_REALTIME: begin
+      //implement this case directly for full precision even without extended floats
+      if not btimenowin8 then begin
+        i := win8time_as_unix_100ns;
+        if (i > 0) then begin
+          i100ns_to_tp_and_success;
+          exit;
+        end;
+      end;
+      f := unixtimefloat;
+      f_to_tp_and_success;
+    end;
+    CLOCK_MONOTONIC: begin
+      f := monotimefloat;
+      f_to_tp_and_success;
+    end;
+    CLOCK_REALTIME_COARSE: begin
+      f := unixtimefloat_coarse;
+      f_to_tp_and_success;
+    end;
+    CLOCK_MONOTONIC_COARSE: begin
+      f := monotimefloat_coarse;
+      f_to_tp_and_success;
+    end;
+    CLOCK_UPTIME: begin
+      i := unbiasedtime_100ns;
+      if (i > 0) then begin
+        i100ns_to_tp_and_success;
+        exit;
+      end;
+      f := qpctimefloat;
+      f_to_tp_and_success;
+    end;
+  end;
+end;
+
+
+
 function unixtimefloat:float;
 const
   margin = 0.0012;
 var
   f,g,h:float;
 begin
+  if not btimenowin8 then begin
+    result := win8time_as_unix_100ns * 0.0000001;
+    if (result > 0) then exit;
+  end;
+
   result := monotimefloat+timefloatbias;
   f := result-unixtimefloat_systemtime;
   if ((f > ticks_freq2+margin) or (f < -margin)) or (timefloatbias = 0) then begin
-//    writeln('unixtimefloat init');
     f := unixtimefloat_systemtime;
     settc;
     repeat g := unixtimefloat_systemtime; h := monotimefloat until g > f;
@@ -571,8 +979,8 @@ begin
     result := unixtimefloat;
   end;
 
-  {for small changes backwards, guarantee no steps backwards}
-  if (result <= lastunixtimefloat) and (result > lastunixtimefloat-1.5) then result := lastunixtimefloat + 0.0000001;
+  //for small changes backwards, guarantee no steps backwards
+  if (result <= lastunixtimefloat) and (result > lastunixtimefloat-1.5) then result := lastunixtimefloat;
   lastunixtimefloat := result;
 end;
 
@@ -581,7 +989,7 @@ begin
   result := trunc(unixtimefloat);
 end;
 
-{$endif}
+{$endif}  //mswindows
 {-----------------------------------------------end of platform specific}
 
 function wintimefloat:float;
@@ -614,7 +1022,7 @@ procedure timehandler;
 begin
   if unixtime = 0 then init;
   unixtime := unixtimeint;
-  irctime := irctimeint;
+  irctime := unixtime+settimebias;
   if unixtime and 63 = 0 then begin
     {update everything, apply timezone changes, clock changes, etc}
     gettimezone;
@@ -625,8 +1033,220 @@ begin
 end;
 
 
-procedure gettimezone;
+{$ifdef unix}
+
+var
+  tzerror:boolean;
+  tzfile:ansistring;
+
+function tzgetfilename:ansistring;
+var
+  t:textfile;
+  a:integer;
+  s,tz,tzdir:ansistring;
+  ispath:boolean;
+begin
+  result := '';
+  filemode := 0;
+
+  tz := getenv('TZ');
+
+  if (tz <> '') then begin
+    ispath := false;
+    if (copy(tz,1,1) = ':') then begin
+      ispath := true;
+      tz := copy(tz,2,99999);
+    end;
+
+    if (copy(tz,1,1) <> '/') then begin
+      a := pos(',',tz);
+      if (a > 1) and not ispath then begin
+        tz := copy(tz,1,a-1);
+      end;
+
+      tzdir := getenv('TZDIR');
+      if (tzdir = '') then begin
+        tzdir := '/usr/share/zoneinfo/';
+      end else begin
+        if (copy(tzdir,length(tzdir),1) <> '/') then tzdir := tzdir + '/';
+      end;
+      tz := tzdir + tz;
+    end;
+
+    assignfile(t,tz);
+    {$i-}reset(t);{$i+}
+    if (ioresult = 0) then begin
+      closefile(t);
+      result := tz;
+      exit;
+    end;
+
+  end;
+
+  assignfile(t,'/etc/localtime');
+  {$i-}reset(t);{$i+}
+  if (ioresult = 0) then begin
+    closefile(t);
+    result := '/etc/localtime';
+    exit;
+  end;
+end;
+
+type
+  dvar=array[0..65535] of byte;
+  pdvar=^dvar;
+
+var
+  tzcache:pdvar;
+  tzsize:integer;
+
+procedure tzinvalidate;
+begin
+  if assigned(tzcache) then freemem(tzcache);
+  tzcache := nil;
+  tzsize := 0;
+  tzfile := '';
+  gettimezone;
+end;
+
+
+function tzgetoffsetforts(ts:tunixtimeint):integer;
 var
+  f:file;
+  buf:pdvar;
+  fs:integer;
+  ofs,ofs2:integer;
+  mode64:boolean;
+  has64:boolean;
+  a,index:integer;
+  //tzstrofs:integer;
+  t:int64;
+  tzh_ttisgmtcnt:integer;
+  tzh_ttisstdcnt:integer;
+  tzh_leapcnt:integer;
+  tzh_timecnt:integer;
+  tzh_typecnt:integer;
+  tzh_charcnt:integer;
+
+
+function getint:integer;
+begin
+  if (ofs < 0) or ((ofs + 4) > fs) then raise exception.create('getint');
+  result := (buf[ofs] shl 24) + (buf[ofs+1] shl 16) + (buf[ofs+2] shl 8) + buf[ofs+3];
+  inc(ofs,4);
+end;
+
+function getint64:int64;
+begin
+  if (ofs < 0) or ((ofs + 8) > fs) then raise exception.create('getint64');
+  result := int64(getint) shl 32;
+  inc(result,cardinal(getint));
+end;
+
+
+function getbyte:byte;
+begin
+  if (ofs < 0) or ((ofs + 1) > fs) then raise exception.create('getbyte');
+  result := buf[ofs];
+  inc(ofs);
+end;
+
+begin
+  result := 0;
+  tzerror := true;
+
+  if not assigned(tzcache) then begin
+
+    if (tzfile = '') then tzfile := tzgetfilename;
+
+    if (tzfile = '') then exit;
+
+    assignfile(f,tzfile);
+    filemode := 0;
+    {$i-}reset(f,1);{$i+}
+    if (ioresult <> 0) then begin
+      exit;
+    end;
+    tzsize := filesize(f);
+    if (tzsize > 65536) then tzsize := 65536;
+    getmem(tzcache,tzsize);
+    blockread(f,tzcache^,tzsize);
+    closefile(f);
+  end;
+  fs := tzsize;
+  buf := tzcache;
+  ofs := 0;
+  mode64 := false;
+
+ try
+   repeat
+     if (getint <> $545a6966) then exit; // 'TZif'
+     has64 := getbyte >= $32; //  '2'
+
+     inc(ofs,15);
+
+     tzh_ttisgmtcnt := getint;
+     tzh_ttisstdcnt := getint;
+     tzh_leapcnt := getint;
+     tzh_timecnt := getint;
+     tzh_typecnt := getint;
+     tzh_charcnt := getint;
+
+     if mode64 or (not has64) then break;
+     inc(ofs, 5 * tzh_timecnt + 6 * tzh_typecnt + 8 * tzh_leapcnt + tzh_ttisstdcnt + tzh_ttisgmtcnt + tzh_charcnt);
+     mode64 := true;
+   until false;
+   index := 0;
+
+   if (tzh_timecnt < 0) or (tzh_timecnt > fs) then raise exception.create('tzh_timecnt');
+   ofs2 := ofs;
+
+   if (tzh_timecnt <> 0) then begin
+     for a := 0 to tzh_timecnt -1 do begin
+       if mode64 then t := getint64 else t := getint;
+       if (t > ts) then begin
+         index := a - 1;
+         break;
+       end;
+       if (a = tzh_timecnt -1) and (ts >= t) then index := a;
+     end;
+     ofs := ofs2 + tzh_timecnt * (1 + ord(mode64)) * 4;
+
+     if (cardinal(ofs + index) >= fs) or (index < 0) then raise exception.create('index');
+     index := buf[ofs+index];
+     inc(ofs,tzh_timecnt);
+   end else begin
+     index := 0;
+   end;
+
+   if (index >= tzh_typecnt) then raise exception.create('type');
+   ofs2 := ofs;
+  // writeln('ofs2 ',inttohex(ofs2,8));
+   inc(ofs,6 * index);
+   result := getint;
+
+   //tzisdst := getbyte;
+
+  //the abbreviation string
+  { tzstrofs := getbyte;
+   tzstr := '';
+   ofs := ofs2 + 6 * tzh_typecnt;
+   inc(ofs, tzstrofs);
+
+   repeat
+     a := getbyte;
+     if (a <> 0) then tzstr := tzstr + chr(a);
+   until (a = 0); }
+
+   tzerror := false;
+ except
+
+ end;
+end;
+
+{$endif}  //unix
+
+function tzgetoffset:integer;
   {$ifdef UNIX}
     {$ifndef ver1_9_4}
       {$ifndef ver1_0}
@@ -634,24 +1254,46 @@ var
       {$endif}
     {$endif}
     {$ifndef above194}
+var
       hh,mm,ss:word;
     {$endif}
+  {$else}
+var
+  TimeZoneInfo: TIME_ZONE_INFORMATION;
+  tztype:cardinal;
+  min:integer;
   {$endif}
-  l:integer;
+
 begin
   {$ifdef UNIX}
     {$ifdef above194}
-      timezone := tzseconds;
+      result := tzgetoffsetforts(unixtimeint);
+      //freepascal tzseconds is not 2038 safe
     {$else}
       gettime(hh,mm,ss);
-      timezone := (longint(hh) * 3600 + mm * 60 + ss) - (unixtimeint mod 86400);
+      result := (integer(hh) * 3600 + mm * 60 + ss) - (unixtimeint mod 86400);
     {$endif}
   {$else}
-  timezone := round((now-now_utc)*86400);
+    tztype := GetTimeZoneInformation(TimeZoneInfo);
+    min := TimeZoneInfo.Bias;
+    case tztype of
+      //TIME_ZONE_ID_UNKNOWN: don't add DST
+      TIME_ZONE_ID_STANDARD: inc(min, TimeZoneInfo.StandardBias);
+      TIME_ZONE_ID_DAYLIGHT: inc(min, TimeZoneInfo.DaylightBias);
+    end;
+    result := min * -60;
   {$endif}
 
-  while timezone > 43200 do dec(timezone,86400);
-  while timezone < -43200 do inc(timezone,86400);
+  while result > (14 * 3600) do dec(result,86400);
+  while result < -(14 * 3600) do inc(result,86400);
+end;
+
+
+procedure gettimezone;
+var
+  l:integer;
+begin
+  timezone := tzgetoffset;
 
   if timezone >= 0 then timezonestr := '+' else timezonestr := '-';
   l := abs(timezone) div 60;
@@ -723,10 +1365,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 mswindows}timebeginperiod(1);{$endif} //ensure stable unchanging clock
+  {$ifdef btimehighrate}beginhightimerrate;{$endif}
   fillchar(mmtime_driftavg,sizeof(mmtime_driftavg),0);
   settimebias := 0;
   gettimezone;