change uint32 from longword to cardinal for posix delphi

[lcore.git] / btime.pas

diff --git a/btime.pas b/btime.pas
index 62b957df864c8f31d33cc2b505f363e4670829ce..6ee3dbb288cce5c30ac20aa33092e4e8a9dc1c57 100644 (file)
--- a/btime.pas
+++ b/btime.pas
@@ -3,65 +3,190 @@
   which is included in the package\r
   ----------------------------------------------------------------------------- }\r
 {\r
   which is included in the package\r
   ----------------------------------------------------------------------------- }\r
 {\r

-this unit returns unix timestamp with seconds and microseconds (as float)\r
-works on windows/delphi, and on freepascal on unix.\r
+this unit has several functions for getting unix and monotonic time and UTC offset on both windows and linux/unix\r
+\r
+this unit aims to work on delphi 6 and later, both x86 and x64, on win95 and later\r
+delphi 5 may work (untested).\r
+as well as freepascal on linux x86 and x64 and freebsd x64 (tested), windows, and other unixes (untested)\r
+\r
+provided functions. all are available on both windows and linux/unix:\r
+- unix timestamp as a (double or extended) float or integer: unixtimefloat, unixtimeint\r
+- monotonic timestamp as float: monotimefloat, wintimefloat (both are equivalent)\r
+- _coarse versions of the floats, which can be faster, and precision in the milliseconds.\r
+- btime_gettime: a unified function like clock_gettime. less reliant on floats.\r
+- tzgetoffset returns the UTC offset (timezone) in seconds\r
+\r
+- on windows, it provides the legacy function gettimeofday (on unix, use the one provided by the OS units)\r
+\r
+other things in the interface are often more implementation specific, there for legacy reasons, and not guaranteed stable\r
+\r
+this unit should be 2038 safe:\r
+- seconds are handled as 64 bits\r
+- on 32 bits linux, it uses clock_gettime64 if available \r
+- for getting the UTC offset on unix, this unit does its own, 64 bits aware, parsing of the zoneinfo file \r
+- tested with clock set after 2038\r

 }\r
 \r
 \r
 unit btime;\r
 }\r
 \r
 \r
 unit btime;\r

+{$ifdef fpc}\r
+  {$mode delphi}\r
+{$endif}\r
+\r
+{$include lcoreconfig.inc}\r

 \r
 interface\r
 \r
 \r
 interface\r
 \r

-{$ifdef win32}\r
+{$ifdef mswindows}\r

 uses\r
   ltimevalstuff;\r
 uses\r
   ltimevalstuff;\r

-{$endif}  \r
+{$endif}\r
+\r
+{$ifdef linux}\r
+uses\r
+  linux,syscall;\r
+{$endif}\r
+\r
+{$ifdef freebsd}\r
+uses\r
+  freebsd;\r
+{$endif}\r
+\r
+{$ifdef FPC_HAS_TYPE_EXTENDED}{$define has_extended}{$endif}\r
+{$ifndef fpc}{$ifdef cpu386}{$define has_extended}{$endif}{$endif}\r

 \r
 type\r
 \r
 type\r

+  {$ifdef has_extended}\r

   float=extended;\r
   float=extended;\r

+  {$else}\r
+  float=double;\r
+  {$endif}\r
+  tunixtimeint=int64;\r

 \r
 const\r
   colorburst=39375000/11;  {3579545.4545....}\r
 \r
 \r
 const\r
   colorburst=39375000/11;  {3579545.4545....}\r
 \r

+  {\r
+  CLOCK_MONOTONIC is the standard monotonic time offered by the OS, it may or may not include suspend time\r
+  CLOCK_BOOTTIME includes suspend time.\r
+  CLOCK_UPTIME excludes suspend time.\r
+  }\r
+\r
+  {$ifdef mswindows}\r
+  CLOCK_REALTIME=0;\r
+  CLOCK_MONOTONIC=1;\r
+  CLOCK_REALTIME_COARSE=2;\r
+  CLOCK_MONOTONIC_COARSE=3;\r
+  CLOCK_BOOTTIME=CLOCK_MONOTONIC;  //GetTickCount\r
+  CLOCK_UPTIME=4;                  //QueryUnbiasedInterruptTime, fallback to QueryPerformanceCounter\r
+  CLOCK_UPTIME_FAST=CLOCK_UPTIME;\r
+  {$endif}\r
+\r
+  {$ifdef linux}\r
+  CLOCK_REALTIME=linux.CLOCK_REALTIME;\r
+  CLOCK_MONOTONIC=linux.CLOCK_MONOTONIC;\r
+  CLOCK_REALTIME_COARSE=linux.CLOCK_REALTIME_COARSE;\r
+  CLOCK_MONOTONIC_COARSE=linux.CLOCK_MONOTONIC_COARSE;\r
+  CLOCK_BOOTTIME=7; //linux.CLOCK_BOOTTIME - constant missing in freepascal\r
+  CLOCK_UPTIME=CLOCK_MONOTONIC;\r
+  CLOCK_UPTIME_FAST=CLOCK_MONOTONIC_COARSE;\r
+  {$endif}\r
+\r
+  {$ifdef freebsd}\r
+  CLOCK_REALTIME=freebsd.CLOCK_REALTIME;\r
+  CLOCK_MONOTONIC=freebsd.CLOCK_MONOTONIC;\r
+  CLOCK_REALTIME_COARSE=freebsd.CLOCK_REALTIME_FAST;\r
+  CLOCK_MONOTONIC_COARSE=freebsd.CLOCK_MONOTONIC_FAST;\r
+  CLOCK_BOOTTIME=CLOCK_MONOTONIC;\r
+  CLOCK_UPTIME=freebsd.CLOCK_UPTIME;\r
+  CLOCK_UPTIME_FAST=freebsd.CLOCK_UPTIME_FAST;\r
+  {$endif}\r
+\r
+  {$ifdef darwin}\r
+  CLOCK_REALTIME=0;      //values taken from darwin libc time.h\r
+  CLOCK_MONOTONIC=6;\r
+  CLOCK_REALTIME_COARSE=CLOCK_REALTIME;   //darwin lacks these or equivalents\r
+  CLOCK_MONOTONIC_COARSE=CLOCK_MONOTONIC;\r
+  CLOCK_BOOTTIME=CLOCK_MONOTONIC;\r
+  CLOCK_UPTIME_RAW=8;\r
+  CLOCK_UPTIME=CLOCK_UPTIME_RAW;\r
+  CLOCK_UPTIME_FAST=CLOCK_UPTIME_RAW;\r
+  {$endif}\r
+\r
+  CLOCK_REALTIME_FAST=CLOCK_REALTIME_COARSE;\r
+  CLOCK_MONOTONIC_FAST=CLOCK_MONOTONIC_COARSE;\r
+\r
+\r

 var\r
   timezone:integer;\r
   timezonestr:string;\r
 var\r
   timezone:integer;\r
   timezonestr:string;\r

-  irctime,unixtime:integer;\r
+  irctime,unixtime:tunixtimeint;\r

   tickcount:integer;\r
   tickcount:integer;\r

-  settimebias:integer;\r
-  performancecountfreq:extended;\r
+  settimebias:tunixtimeint;\r
+  performancecountfreq:int64;\r
+  performancecountstep:float;\r
+\r
+  btimenowin8:boolean;\r

 \r
 function irctimefloat:float;\r
 \r
 function irctimefloat:float;\r

-function irctimeint:integer;\r
+function irctimeint:tunixtimeint;\r

 \r
 \r

+//unix timestamp (UTC) float seconds\r

 function unixtimefloat:float;\r
 function unixtimefloat:float;\r

-function unixtimeint:integer;\r
+function unixtimeint:tunixtimeint;\r
+\r
+//monotonic float seconds\r
+function monotimefloat:float;\r
+\r
+//coarse float seconds - usually faster, but a resolution in the milliseconds\r
+function unixtimefloat_coarse:float;\r
+function monotimefloat_coarse:float;\r
+\r
+//float versions of CLOCK_BOOTTIME and CLOCK_UPTIME\r
+function boottimefloat:float;\r
+function uptimefloat:float;\r

 \r
 \r

+//monotonic (alias, old function name)\r

 function wintimefloat:float;\r
 \r
 function wintimefloat:float;\r
 \r

-procedure settime(newtime:integer);\r
+//get localtime vs UTC offset in seconds\r
+function tzgetoffset:integer;\r
+\r
+procedure settime(newtime:tunixtimeint);\r

 procedure gettimezone;\r
 procedure timehandler;\r
 procedure init;\r
 \r
 procedure gettimezone;\r
 procedure timehandler;\r
 procedure init;\r
 \r

-function timestring(i:integer):string;\r
-function timestrshort(i:integer):string;\r
+function timestring(i:tunixtimeint):string;      // Wednesday August 15 2012 -- 16:21:09 +02:00\r
+function timestrshort(i:tunixtimeint):string;    // Wed Aug 15 16:21:09 2012\r
+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
+procedure beginhightimerrate;\r
+procedure endhightimerrate;\r
+\r
+procedure tzinvalidate;\r

 \r
 \r

-{$ifdef win32}\r
+{$ifdef unix}\r
+function tzgetoffsetforts(ts:tunixtimeint):integer;\r
+{$endif}\r
+\r
+{$ifdef mswindows}\r

 function unixtimefloat_systemtime:float;\r
 {$endif}\r
 \r
 function oletounixfloat(t:float):float;\r
 function unixtimefloat_systemtime:float;\r
 {$endif}\r
 \r
 function oletounixfloat(t:float):float;\r

-function oletounix(t:tdatetime):integer;\r
+function oletounix(t:tdatetime):tunixtimeint;\r

 function unixtoole(i:float):tdatetime;\r
 \r
 function unixtoole(i:float):tdatetime;\r
 \r

-{$ifdef win32}\r
+{$ifdef mswindows}\r

 function mmtimefloat:float;\r
 function mmtimefloat:float;\r

+function mmtimeint64:int64;\r

 function qpctimefloat:float;\r
 {$endif}\r
 \r
 function qpctimefloat:float;\r
 {$endif}\r
 \r

-{$ifdef win32}\r
-procedure gettimeofday(var tv:ttimeval);\r
+{$ifdef mswindows}\r
+function gettimeofday(var tv:ttimeval):integer;\r

 {$endif}\r
 \r
 \r
 {$endif}\r
 \r
 \r


@@ -82,7 +207,7 @@ var
   lastsyncbias:float=0;\r
 \r
   mmtime_last:integer=0;\r
   lastsyncbias:float=0;\r
 \r
   mmtime_last:integer=0;\r

-  mmtime_wrapadd:float;\r
+  mmtime_wrapadd:int64;\r

   mmtime_lastsyncmm:float=0;\r
   mmtime_lastsyncqpc:float=0;\r
   mmtime_drift:float=1;\r
   mmtime_lastsyncmm:float=0;\r
   mmtime_lastsyncqpc:float=0;\r
   mmtime_drift:float=1;\r


@@ -95,12 +220,24 @@ var
   mmtime_prev_lastsyncmm:float;\r
   mmtime_prev_lastsyncqpc:float;\r
 \r
   mmtime_prev_lastsyncmm:float;\r
   mmtime_prev_lastsyncqpc:float;\r
 \r

-implementation\r
+  gettime64_nosupport_cached:boolean;\r
+  coarse_nosupport_cached:boolean;\r
+\r
+type\r
+  //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.\r
+  //tbtimespec can't be changed because it is passed as-is to clock_gettime64\r
+  tbtimespec=packed record\r
+    tv_sec:int64;\r
+    tv_nsec:int64;\r
+  end;\r
+  pbtimespec=^tbtimespec;\r

 \r
 \r

-{$ifdef fpc}\r
-  {$mode delphi}\r
-{$endif}\r

 \r
 \r

+//on unix, btime_gettime is the "inner" function that calls the actual OS/library functions, and other functions in btime call it\r
+//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.\r
+function btime_gettime(clockid:integer;tp:pbtimespec):integer;\r
+\r
+implementation\r

 uses\r
   {$ifdef UNIX}\r
     {$ifdef VER1_0}\r
 uses\r
   {$ifdef UNIX}\r
     {$ifdef VER1_0}\r


@@ -125,9 +262,9 @@ begin
   result := t;\r
 end;\r
 \r
   result := t;\r
 end;\r
 \r

-function oletounix(t:tdatetime):integer;\r
+function oletounix(t:tdatetime):tunixtimeint;\r

 begin\r
 begin\r

-  result := trunc(oletounixfloat(t));\r
+  result := round(oletounixfloat(t));\r

 end;\r
 \r
 function unixtoole(i:float):tdatetime;\r
 end;\r
 \r
 function unixtoole(i:float):tdatetime;\r


@@ -135,63 +272,245 @@ begin
   result := ((i)/86400)+daysdifference;\r
 end;\r
 \r
   result := ((i)/86400)+daysdifference;\r
 end;\r
 \r

+{$ifdef unix}\r
+{-----------------------------------------*nix/freepascal code to read time }\r
+\r
+{$ifdef linux}{$define have_clock_gettime}{$endif}\r
+{$ifdef freebsd}{$define have_clock_gettime}{$endif}\r
+\r
+{$ifdef linux}\r
+  {$ifdef cpu386}{$define use_syscall_gettime64}{$endif}\r
+  {$ifdef cpu32}{$define use_syscall_gettime64}{$endif}\r
+\r
+  {$ifdef use_syscall_gettime64}\r

 const\r
 const\r

-  highdwordconst=65536.0 * 65536.0;\r
+  clock_gettime64=403;\r
+  {$endif}\r
+{$endif} //linux\r
+\r
+\r
+\r
+{$ifdef darwin} {mac OS X}\r
+  type\r
+    tmach_timebase_info = packed record\r
+      numer: cardinal;\r
+      denom: cardinal;\r
+    end;\r
+    pmach_timebase_info = ^tmach_timebase_info;\r
+\r
+    function mach_absolute_time: int64; cdecl; external;\r
+    function mach_timebase_info(info: pmach_timebase_info): integer; cdecl; external;\r
+\r
+  var\r
+    timebase_info: tmach_timebase_info;\r
+{$endif} //darwin\r
+\r
+\r
+function btime_gettime(clockid:integer;tp:pbtimespec):integer;\r
+var\r
+{$ifdef have_clock_gettime}\r
+  ts: ttimespec;\r
+{$endif}\r
+  tv: ttimeval;\r
+{$ifdef darwin}\r
+  nanos:int64;\r
+  nanosf:extended;\r
+{$endif}\r
+\r
+begin\r
+  result := -1; //error\r
+\r
+  {$ifdef darwin}\r
+  if (clockid = CLOCK_MONOTONIC) or (clockid = CLOCK_MONOTONIC_COARSE) then begin\r
+    if timebase_info.denom = 0 then begin\r
+      mach_timebase_info(@timebase_info);\r
+    end;\r
+    if (timebase_info.denom > 0) then begin\r
+      nanos := mach_absolute_time;\r
+      if (nanos > 0) then begin\r
+        result := 0; //indicate success\r
+        if (timebase_info.denom > 10) then begin\r
+          //on powerpc mac, numer and denom are large numbers such as 1000000000 and 33333335, and extended is available\r
+          nanosf := nanos;\r
+          nanosf := (nanosf * timebase_info.numer) / timebase_info.denom;\r
+          nanos := trunc(nanosf);\r
+        end else begin\r
+          //on intel mac, numer and denom are 1 and 1. on apple silicon they are typically 125 and 3, and extended is not available\r
+          nanos := nanos div timebase_info.denom;\r
+          nanos := nanos * timebase_info.numer;\r
+        end;\r
+        tp.tv_sec := nanos div 1000000000;\r
+        tp.tv_nsec := nanos mod 1000000000;\r
+        exit;\r
+      end;\r
+    end;\r
+  end;\r
+  {$endif} //darwin\r
+\r
+  if (coarse_nosupport_cached) then begin\r
+    if (clockid = CLOCK_REALTIME_COARSE) then clockid := CLOCK_REALTIME;\r
+    if (clockid = CLOCK_MONOTONIC_COARSE) then clockid := CLOCK_MONOTONIC;\r
+  end;\r
+\r
+  {$ifdef use_syscall_gettime64}\r
+  //don't do this for monotonic for performance reasons\r
+  //the clock_gettime call below has the potential to be handled by libc, and then it is faster\r
+  //also if it failed, don't call it again to avoid slowdown of doing two calls every time\r
+  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\r
+    result := do_syscall(clock_gettime64,clockid,tsysparam(tp));\r
+\r
+    if ((clockid = CLOCK_REALTIME) or (clockid = CLOCK_REALTIME_COARSE)) and (result <> 0) then gettime64_nosupport_cached := true;\r
+\r
+    if (result = 0) then exit;\r
+  end;\r
+  {$endif}\r
+\r
+  {$ifdef have_clock_gettime}\r
+  result := clock_gettime(clockid, @ts);\r
+  if (result <> 0) then begin\r
+    //fallback\r
+    if (clockid = CLOCK_REALTIME_COARSE) then begin\r
+      coarse_nosupport_cached := true;\r
+      result := clock_gettime(CLOCK_REALTIME, @ts);\r
+    end else\r
+    if (clockid = CLOCK_MONOTONIC_COARSE) then begin\r
+      coarse_nosupport_cached := true;\r
+      result := clock_gettime(CLOCK_MONOTONIC, @ts);\r
+    end;\r
+  end;\r
+  if (result = 0) then begin\r
+    tp.tv_sec := ts.tv_sec;\r
+    tp.tv_nsec := ts.tv_nsec;\r

 \r
 \r

-function utrunc(f:float):integer;\r
-{converts float to integer, in 32 bits unsigned range}\r
+    {$ifndef cpu64}\r
+    if (tp.tv_sec < -1) then inc(tp.tv_sec, $100000000);\r
+    {$endif}\r
+\r
+    exit;\r
+  end;\r
+  {$endif} //have_clock_gettime\r
+\r
+  result := gettimeofday(tv);\r
+  if (result = 0) then begin\r
+    tp.tv_sec := tv.tv_sec;\r
+    tp.tv_nsec := tv.tv_usec * 1000;\r
+\r
+    {$ifndef cpu64}\r
+    if (tp.tv_sec < -1) then inc(tp.tv_sec, $100000000);\r
+    {$endif}\r
+  end;\r
+end;\r
+\r
+\r
+function unixtimefloat:float;\r
+var\r
+  ts:tbtimespec;\r

 begin\r
 begin\r

-  if f >= (highdwordconst/2) then f := f - highdwordconst;\r
-  result := trunc(f);\r
+  btime_gettime(CLOCK_REALTIME, @ts);\r
+  //doing the below as a division causes a bug in fpc 3.2.0 x64, where the result becomes single precision\r
+  result := ts.tv_sec + (ts.tv_nsec * 0.000000001);\r

 end;\r
 \r
 end;\r
 \r

-function uinttofloat(i:integer):float;\r
-{converts 32 bits unsigned integer to float}\r
+\r
+function monotimefloat:float;\r
+var\r
+  ts:tbtimespec;\r

 begin\r
 begin\r

-  result := i;\r
-  if result < 0 then result := result + highdwordconst;\r
+  btime_gettime(CLOCK_MONOTONIC, @ts);\r
+  result := ts.tv_sec + (ts.tv_nsec * 0.000000001);\r

 end;\r
 \r
 end;\r
 \r

-{$ifdef unix}\r
-{-----------------------------------------*nix/freepascal code to read time }\r

 \r
 \r

-function unixtimefloat:float;\r
+function unixtimefloat_coarse:float;\r

 var\r
 var\r

-  tv:ttimeval;\r
+  ts:tbtimespec;\r

 begin\r
 begin\r

-  gettimeofday(tv);\r
-  result := tv.tv_sec+(tv.tv_usec/1000000);\r
+  btime_gettime(CLOCK_REALTIME_COARSE, @ts);\r
+  result := ts.tv_sec + (ts.tv_nsec * 0.000000001);\r

 end;\r
 \r
 end;\r
 \r

-function wintimefloat:extended;\r
+\r
+function monotimefloat_coarse:float;\r
+var\r
+  ts:tbtimespec;\r

 begin\r
 begin\r

-  result := unixtimefloat;\r
+  btime_gettime(CLOCK_MONOTONIC_COARSE, @ts);\r
+  result := ts.tv_sec + (ts.tv_nsec * 0.000000001);\r

 end;\r
 \r
 end;\r
 \r

-function unixtimeint:integer;\r
+\r
+function boottimefloat:float;\r

 var\r
 var\r

-  tv:ttimeval;\r
+  ts:tbtimespec;\r

 begin\r
 begin\r

-  gettimeofday(tv);\r
-  result := tv.tv_sec;\r
+  btime_gettime(CLOCK_BOOTTIME, @ts);\r
+  result := ts.tv_sec + (ts.tv_nsec * 0.000000001);\r

 end;\r
 \r
 end;\r
 \r

-{$else} {delphi 3}\r
+\r
+function uptimefloat:float;\r
+var\r
+  ts:tbtimespec;\r
+begin\r
+  btime_gettime(CLOCK_UPTIME, @ts);\r
+  result := ts.tv_sec + (ts.tv_nsec * 0.000000001);\r
+end;\r
+\r
+\r
+function unixtimeint:tunixtimeint;\r
+var\r
+  ts:tbtimespec;\r
+begin\r
+  btime_gettime(CLOCK_REALTIME,@ts);\r
+  result := ts.tv_sec;\r
+end;\r
+\r
+{------------------------------ end of *nix/freepascal section}\r
+\r
+{$endif}  //unix\r
+\r
+{$ifdef mswindows}\r

 {------------------------------ windows/delphi code to read time}\r
 \r
 \r
 {------------------------------ windows/delphi code to read time}\r
 \r
 \r

-{simulate gettimeofday on windows so one can always use gettimeofday if preferred}\r
+procedure tzinvalidate;\r
+begin\r
+  gettimezone;\r
+end;\r
+\r
+\r
+var\r
+  GetTickCount64:function:int64; stdcall;\r
+  gettickcount64_inited:boolean;\r

 \r
 \r

-procedure gettimeofday(var tv:ttimeval);\r
+procedure init_gettickcount64;\r

 var\r
 var\r

-  e:extended;\r
+  dllhandle:thandle;\r

 begin\r
 begin\r

-  e := unixtimefloat;\r
-  tv.tv_sec := round(int(e));\r
-  tv.tv_usec := trunc(frac(e)*1000000);\r
-  {just in case}\r
-  if (tv.tv_usec < 0) then tv.tv_usec := 0;\r
-  if (tv.tv_usec > 999999) then tv.tv_usec := 999999;\r
+  gettickcount64_inited := true;\r
+  dllhandle := loadlibrary('kernel32.dll');\r
+  if (dllhandle <> 0) then begin\r
+    GetTickCount64 := getprocaddress(dllhandle,'GetTickCount64');\r
+  end;\r
+end;\r
+\r
+\r
+\r
+function mmtimeint64:int64;\r
+var\r
+  i:int64;\r
+begin\r
+  if not gettickcount64_inited then init_gettickcount64;\r
+  if assigned(GetTickCount64) then begin\r
+    result := GetTickCount64;\r
+  end else begin\r
+    i := gettickcount;\r
+    if i < mmtime_last then begin\r
+      mmtime_wrapadd := mmtime_wrapadd + $100000000;\r
+    end;\r
+    mmtime_last := i;\r
+    result := mmtime_wrapadd + i;\r
+  end;\r

 end;\r
 \r
 \r
 end;\r
 \r
 \r


@@ -201,32 +520,54 @@ resolution: 9x: ~55 ms NT: 1/64th of a second
 guarantees: continuous without any jumps\r
 frequency base: same as system clock.\r
 epoch: system boot\r
 guarantees: continuous without any jumps\r
 frequency base: same as system clock.\r
 epoch: system boot\r

-note: if called more than once per 49.7 days, 32 bits wrapping is compensated for and it keeps going on.\r
-note: i handle the timestamp as signed integer, but with the wrap compensation that works as well, and is faster\r

 }\r
 }\r

-\r

 function mmtimefloat:float;\r
 function mmtimefloat:float;\r

-const\r
-  wrapduration=highdwordconst * 0.001;\r

 var\r
 var\r

-  i:integer;\r
+  temp:float;\r

 begin\r
 begin\r

-  i := gettickcount; {timegettime}\r
-  if i < mmtime_last then begin\r
-    mmtime_wrapadd := mmtime_wrapadd + wrapduration;\r
+  result := mmtimeint64 * 0.001;\r
+\r
+  if (ticks_freq <> 0) and ticks_freq_known then begin\r
+    {the value we get is rounded to 1 ms, but the ticks are not a multiple of 1 ms\r
+    this makes the value noisy. use the known ticks frequency to restore the original value}\r
+    temp := int((result / ticks_freq)+0.5) * ticks_freq;\r
+\r
+    {if the known ticks freq is wrong (can happen), disable the un-rounding behavior\r
+    this will be a bit less accurate but it prevents problems}\r
+    if abs(temp - result) > 0.002 then begin\r
+      ticks_freq := 0;\r
+    end else result := temp;\r

   end;\r
   end;\r

-  mmtime_last := i;\r
-  result := mmtime_wrapadd + i * 0.001;\r
+end;\r
+\r
+var\r
+  win_version_known:boolean;\r
+  win_isnt:boolean;\r
+  win_ver_major:integer;\r
+  win_ver_minor:integer;\r

 \r
 \r

-  if (ticks_freq <> 0) and ticks_freq_known then result := int((result / ticks_freq)+0.5) * ticks_freq; //turn the float into an exact multiple of 1/64th sec to improve accuracy of things using this\r
+procedure init_win_version;\r
+var\r
+  o:tosversioninfo;\r
+begin\r
+  if not win_version_known then begin\r
+    win_version_known := true;\r
+    fillchar(o,sizeof(o),0);\r
+    o.dwOSVersionInfoSize := sizeof(o);\r
+    getversionex(o);\r
+    win_isnt := o.dwPlatformId = VER_PLATFORM_WIN32_NT;\r
+    win_ver_major := o.dwMajorVersion;\r
+    win_ver_minor := o.dwMinorVersion;\r
+  end;\r

 end;\r
 \r
 procedure measure_ticks_freq;\r
 var\r
   f,g:float;\r
 end;\r
 \r
 procedure measure_ticks_freq;\r
 var\r
   f,g:float;\r

-  o:tosversioninfo;\r
-  isnt:boolean;\r
-  is9x:boolean;\r
+\r
+  adjust1,adjust2:cardinal;\r
+  adjustbool:longbool;\r
+  win8_or_later:boolean;\r

 begin\r
   if (performancecountfreq = 0) then qpctimefloat;\r
   ticks_freq_known := false;\r
 begin\r
   if (performancecountfreq = 0) then qpctimefloat;\r
   ticks_freq_known := false;\r


@@ -235,47 +576,31 @@ begin
   repeat g := mmtimefloat until g > f;\r
   unsettc;\r
   f := g - f;\r
   repeat g := mmtimefloat until g > f;\r
   unsettc;\r
   f := g - f;\r

-  fillchar(o,sizeof(o),0);\r
-  o.dwOSVersionInfoSize := sizeof(o);\r
-  getversionex(o);\r
-  isnt := o.dwPlatformId = VER_PLATFORM_WIN32_NT;\r
-  is9x := o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS;\r
+\r
+  init_win_version;\r

 \r
   ticks_freq2 := f;\r
   mmtime_synchedqpc := false;\r
 \r
   ticks_freq2 := f;\r
   mmtime_synchedqpc := false;\r

-  {\r
-  NT 64 Hz\r
-  identify mode as: nt64\r
-  QPC rate: either 3579545 or TSC freq\r
-  QPC synched to gettickcount: no\r
-  duration between 2 ticks is constant: yes\r
-  gettickcount tick duration: 64 Hz\r
-  }\r
-  if (f >= 0.014) and (f <= 0.018) and isnt then begin\r
-    ticks_freq_known := true;\r
-    ticks_freq := 1/64;\r
-    mmtime_synchedqpc := false;\r
-  end;\r

 \r
 \r

-  {\r
-  NT 100 Hz\r
-  identify mode as: nt100\r
-  QPC rate: 1193182\r
-  QPC synched to gettickcount: yes\r
-  duration between 2 ticks is constant: no?\r
-  gettickcount tick duration: ~99.85 Hz\r
-  }\r
-  if (performancecountfreq = 1193182) and (f >= 0.008) and (f <= 0.012) and isnt then begin\r
-    ticks_freq_known := true;\r
-    ticks_freq2 := 11949 / (colorburst / 3);\r
-   //  ticks_freq2 := 11949 / 1193182;\r
-    ticks_freq := 0;\r
-    {the ticks freq should be very close to the real one but if it's not exact, it will cause drift and correction jumps}\r
-    mmtime_synchedqpc := true;\r
+  if (win_isnt and (win_ver_major >= 5)) then begin\r
+    {windows 2000 and later: query tick rate from OS in 100 ns units\r
+    typical rates: XP: 156250 or 100144, windows 7: 156001}\r
+    if GetSystemTimeAdjustment(adjust1,adjust2,adjustbool) then begin\r
+      ticks_freq := adjust1 / 10000000.0;\r
+      ticks_freq_known := true;\r
+      mmtime_synchedqpc := false;\r
+\r
+      //windows 8/10/11, 10 MHz time source is invariant TSC. add 64 Hz check for safety.\r
+      //with manifest, windows 10/11 major.minor will be 10.0 \r
+      win8_or_later := ((win_ver_major = 6) and (win_ver_minor >= 2)) or (win_ver_major = 10);\r
+      if (win8_or_later and (performancecountfreq = 10000000) and (adjust1 = 156250)) then begin\r
+        mmtime_synchedqpc := true;\r
+      end;\r
+    end;\r

   end;\r
 \r
   {9x}\r
   end;\r
 \r
   {9x}\r

-  if (performancecountfreq = 1193182) and (g >= 0.050) and (g <= 0.060) then begin\r
+  if (performancecountfreq = 1193182) and (f >= 0.050) and (f <= 0.060) then begin\r

     ticks_freq_known := true;\r
     ticks_freq := 65536 / (colorburst / 3);\r
     mmtime_synchedqpc := true;\r
     ticks_freq_known := true;\r
     ticks_freq := 65536 / (colorburst / 3);\r
     mmtime_synchedqpc := true;\r


@@ -292,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.\r
 epoch: system boot\r
 }\r
 frequency base: on NT, not the system clock, drifts compared to it.\r
 epoch: system boot\r
 }\r

-function qpctimefloat:extended;\r
+function qpctimefloat:float;\r

 var\r
 var\r

-  p:packed record\r
-    lowpart:longint;\r
-    highpart:longint\r
-  end;\r
-  p2:tlargeinteger absolute p;\r
-  e:extended;\r
+  i64:int64;\r

 begin\r
   if performancecountfreq = 0 then begin\r
 begin\r
   if performancecountfreq = 0 then begin\r

-    QueryPerformancefrequency(p2);\r
-    e := p.lowpart;\r
-    if e < 0 then e := e + highdwordconst;\r
-    performancecountfreq := ((p.highpart*highdwordconst)+e);\r
+    QueryPerformancefrequency(performancecountfreq);\r
+    performancecountstep := 1.0 / performancecountfreq;\r

   end;\r
   end;\r

-  queryperformancecounter(p2);\r
-  e := p.lowpart;\r
-  if e < 0 then e := e + highdwordconst;\r
-\r
-  result := ((p.highpart*highdwordconst)+e)/performancecountfreq;\r
+  queryperformancecounter(i64);\r
+  result := i64 * performancecountstep;\r

 end;\r
 \r
 {\r
 end;\r
 \r
 {\r


@@ -322,19 +637,20 @@ frequency base: same as system clock.
 epoch: system boot\r
 }\r
 \r
 epoch: system boot\r
 }\r
 \r

-function mmqpctimefloat:float;\r
+//function mmqpctimefloat:float;\r
+function monotimefloat:float;\r

 const\r
   maxretries=5;\r
   margin=0.002;\r
 var\r
 const\r
   maxretries=5;\r
   margin=0.002;\r
 var\r

-  jump:float;\r
-  mm,f,qpc,newdrift,f1,f2:float;\r
+{  jump:float;}\r
+  mm,f,qpc,newdrift:float;\r

   qpcjumped:boolean;\r
   qpcjumped:boolean;\r

-  a,b,c:integer;\r
-  retrycount:integer;\r
+  a,b:integer;\r
+{  retrycount:integer;}\r

 begin\r
   if not ticks_freq_known then measure_ticks_freq;\r
 begin\r
   if not ticks_freq_known then measure_ticks_freq;\r

-  retrycount := maxretries;\r
+{  retrycount := maxretries;}\r

 \r
   qpc := qpctimefloat;\r
   mm := mmtimefloat;\r
 \r
   qpc := qpctimefloat;\r
   mm := mmtimefloat;\r


@@ -351,7 +667,7 @@ begin
       mmtime_prev_lastsyncqpc := mmtime_lastsyncqpc;\r
 \r
       mm := mmtimefloat;\r
       mmtime_prev_lastsyncqpc := mmtime_lastsyncqpc;\r
 \r
       mm := mmtimefloat;\r

-      dec(retrycount);\r
+    {  dec(retrycount);}\r

       settc;\r
       result := qpctimefloat;\r
       f := mmtimefloat;\r
       settc;\r
       result := qpctimefloat;\r
       f := mmtimefloat;\r


@@ -382,6 +698,7 @@ begin
 {          mmtime_drift := mmtime_drift + mmtime_driftavg[a];}\r
         end;\r
 {        mmtime_drift := mmtime_drift / b;}\r
 {          mmtime_drift := mmtime_drift + mmtime_driftavg[a];}\r
         end;\r
 {        mmtime_drift := mmtime_drift / b;}\r

+        a := 5;\r

         if (b = 1) then a := 5 else if (b = 2) then a := 15 else if (b = 3) then a := 30 else if (b = 4) then a := 60 else if (b = 5) then a := 120 else if (b >= 5) then a := 120;\r
         mmtime_nextdriftcorrection := qpc + a;\r
         if (b >= 2) then warmup_finished := true;\r
         if (b = 1) then a := 5 else if (b = 2) then a := 15 else if (b = 3) then a := 30 else if (b = 4) then a := 60 else if (b = 5) then a := 120 else if (b >= 5) then a := 120;\r
         mmtime_nextdriftcorrection := qpc + a;\r
         if (b >= 2) then warmup_finished := true;\r


@@ -399,124 +716,301 @@ begin
     qpc := qpctimefloat;\r
 \r
     result := (qpc - mmtime_lastsyncqpc) * mmtime_drift + mmtime_lastsyncmm;\r
     qpc := qpctimefloat;\r
 \r
     result := (qpc - mmtime_lastsyncqpc) * mmtime_drift + mmtime_lastsyncmm;\r

-    f := (qpc - mmtime_prev_lastsyncqpc) * mmtime_prev_drift + mmtime_prev_lastsyncmm;\r

 \r
 \r

+    {f := (qpc - mmtime_prev_lastsyncqpc) * mmtime_prev_drift + mmtime_prev_lastsyncmm;\r

     jump := result-f;\r
     jump := result-f;\r

-    {writeln('jump ',formatfloat('0.000000',jump),'   drift ',formatfloat('0.00000000',mmtime_drift),' duration ',formatfloat('0.000',(mmtime_lastsyncqpc-mmtime_prev_lastsyncqpc)),' ',formatfloat('0.00000000',jump/(mmtime_lastsyncqpc-mmtime_prev_lastsyncqpc)));}\r
+    writeln('jump ',formatfloat('0.000000',jump),'   drift ',formatfloat('0.00000000',mmtime_drift),' duration ',formatfloat('0.000',(mmtime_lastsyncqpc-mmtime_prev_lastsyncqpc)),' ',formatfloat('0.00000000',jump/(mmtime_lastsyncqpc-mmtime_prev_lastsyncqpc)));}\r

 \r
     f := result;\r
   end;\r
 \r
   result := f;\r
 \r
 \r
     f := result;\r
   end;\r
 \r
   result := f;\r
 \r

-  if (result < mmtime_lastresult) then result := mmtime_lastresult + 0.000001;\r
+  if (result < mmtime_lastresult) then result := mmtime_lastresult;\r

   mmtime_lastresult := result;\r
 end;\r
 \r
   mmtime_lastresult := result;\r
 end;\r
 \r

-{ free pascals tsystemtime is incomaptible with windows api calls\r
- so we declare it ourselves - plugwash\r
-}\r
-{$ifdef fpc}\r
-type\r
-  TSystemTime = record\r
-     wYear: Word;\r
-     wMonth: Word;\r
-     wDayOfWeek: Word;\r
-     wDay: Word;\r
-     wHour: Word;\r
-     wMinute: Word;\r
-     wSecond: Word;\r
-     wMilliseconds: Word;\r
-  end;\r
- {$endif}\r
-function Date_utc: extended;\r
-var\r
-  SystemTime: TSystemTime;\r
-begin\r
-  {$ifdef fpc}\r
-    GetsystemTime(@SystemTime);\r
-  {$else}\r
-    GetsystemTime(SystemTime);\r
-  {$endif}\r
-  with SystemTime do Result := EncodeDate(wYear, wMonth, wDay);\r
+\r
+function boottimefloat:float;\r
+begin\r
+  result := monotimefloat;\r

 end;\r
 \r
 end;\r
 \r

-function Time_utc: extended;\r

 var\r
 var\r

-  SystemTime: TSystemTime;\r
+  QueryUnbiasedInterruptTime:function(var i:int64):longbool; stdcall;\r
+  unbiasedinterrupttime_inited:boolean;\r
+\r
+\r
+procedure initunbiasedinterrupttime;\r
+var\r
+  dllhandle:thandle;\r

 begin\r
 begin\r

-  {$ifdef fpc}\r
-    GetsystemTime(@SystemTime);\r
-  {$else}\r
-    GetsystemTime(SystemTime);\r
-  {$endif}\r
-  with SystemTime do\r
-    Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);\r
+  unbiasedinterrupttime_inited := true;\r
+  dllhandle := loadlibrary('kernel32.dll');\r
+  if (dllhandle <> 0) then begin\r
+    QueryUnbiasedInterruptTime := getprocaddress(dllhandle,'QueryUnbiasedInterruptTime');\r
+  end;\r

 end;\r
 \r
 end;\r
 \r

-function Now_utc: extended;\r
+function unbiasedtime_100ns:int64;\r

 begin\r
 begin\r

-  Result := round(Date_utc) + Time_utc;\r
+  result := -1;\r
+  if not unbiasedinterrupttime_inited then initunbiasedinterrupttime;\r
+  if assigned(@QueryUnbiasedInterruptTime) then begin\r
+    QueryUnbiasedInterruptTime(result);\r
+  end;\r
+end;\r
+\r
+function uptimefloat:float;\r
+var\r
+  i:int64;\r
+begin\r
+  i := unbiasedtime_100ns;\r
+  if (i > 0) then begin\r
+    result := i * 0.0000001;\r
+    exit;\r
+  end;\r
+  result := qpctimefloat;\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
 end;\r
 \r

+\r
+function win8time_as_unix_100ns:int64;\r
+var\r
+  ft:tfiletime;\r
+  i:int64 absolute ft;\r
+begin\r
+  result := -1;\r
+  if not win8inited then initwin8;\r
+  if assigned(@GetSystemTimePreciseAsFileTime) then begin\r
+    GetSystemTimePreciseAsFileTime(ft);\r
+    //change from windows 1601-01-01 to unix 1970-01-01.\r
+    dec(i, 116444736000000000);\r
+    result := i;\r
+  end;\r
+end;\r
+\r
+\r

 function unixtimefloat_systemtime:float;\r
 function unixtimefloat_systemtime:float;\r

+var\r
+  ft:tfiletime;\r
+  i:int64 absolute ft;\r
+begin\r
+  //result := oletounixfloat(now_utc);\r
+\r
+  //this method gives exactly the same result with extended precision, but is less sensitive to float rounding in theory}\r
+  //result := oletounixfloat(int(date_utc+0.5))+time_utc*86400;\r
+\r
+  //new method that is much faster (22 vs 190 ns)\r
+  GetSystemTimeAsFileTime(ft);\r
+  dec(i, 116444736000000000);\r
+  result := i * 0.0000001;\r
+end;\r
+\r
+\r
+function unixtimefloat_coarse:float;\r

 begin\r
 begin\r

-  {result := oletounixfloat(now_utc);}\r
+  //don't do the coarse method if worse than about 16 ms. on win9x it may be only a 55 ms resolution\r
+  //but i have also seen it is less (like 1 ms)\r
+  //don't call measure_ticks_freq on NT because it is expensive and unnecessary\r
+  init_win_version;\r
+  if not win_isnt then begin\r
+    if not ticks_freq_known then measure_ticks_freq;\r
+  end;\r
+  if win_isnt or (ticks_freq < 0.017) then begin\r
+    result := unixtimefloat_systemtime;\r
+    exit;\r
+  end;\r

 \r
 \r

-  {this method gives exactly the same result with extended precision, but is less sensitive to float rounding in theory}\r
-  result := oletounixfloat(int(date_utc+0.5))+time_utc*86400;\r
+  result := unixtimefloat;\r

 end;\r
 \r
 end;\r
 \r

-function wintimefloat:extended;\r
+function monotimefloat_coarse:float;\r

 begin\r
 begin\r

-  result := mmqpctimefloat;\r
+  init_win_version;\r
+  if not win_isnt then begin\r
+    if not ticks_freq_known then measure_ticks_freq;\r
+  end;\r
+  if win_isnt or (ticks_freq < 0.017) then begin\r
+    result := mmtimeint64 * 0.001;\r
+    exit;\r
+  end;\r
+  result := monotimefloat;\r

 end;\r
 \r
 end;\r
 \r

+\r
+//simulate gettimeofday on windows so one can always use gettimeofday if preferred\r
+function gettimeofday(var tv:ttimeval):integer;\r
+var\r
+  e:float;\r
+  i:int64;\r
+begin\r
+  result := -1;\r
+\r
+  if not btimenowin8 then begin\r
+    i := win8time_as_unix_100ns;\r
+    if (i > 0) then begin\r
+      tv.tv_sec := i div 10000000;\r
+      tv.tv_usec := (i mod 10000000) div 10;\r
+      result := 0;\r
+      exit;\r
+    end;\r
+  end;\r
+\r
+  e := unixtimefloat;\r
+  if (e > 0) then result := 0;\r
+  tv.tv_sec := trunc(e);\r
+  tv.tv_usec := trunc(frac(e)*1000000);\r
+end;\r
+\r
+\r
+function btime_gettime(clockid:integer;tp:pbtimespec):integer;\r
+var\r
+  f:float;\r
+  i:int64;\r
+\r
+{$ifdef cpu386}{$ifdef has_extended}{$define itotp_float}{$endif}{$endif}\r
+procedure i100ns_to_tp_and_success;\r
+{$ifdef itotp_float}\r
+var\r
+  f:float;\r
+{$endif}\r
+begin\r
+  //in 32 bits delphi, float is 10 times faster than int64 here (30 vs 300 ns for the conversion)\r
+  //and with extended available, there is no loss of precision\r
+\r
+  {$ifdef itotp_float}\r
+  f := i / 10000000.0;\r
+  tp.tv_sec := trunc(f);\r
+  tp.tv_nsec := round(frac(f) * 1000000000.0);\r
+  {$else}\r
+  tp.tv_sec := i div 10000000;\r
+  tp.tv_nsec := (i mod 10000000) * 100;\r
+  {$endif}\r
+\r
+  result := 0; //success\r
+end;\r
+\r
+procedure f_to_tp_and_success;\r
+begin\r
+  tp.tv_sec := trunc(f);\r
+  tp.tv_nsec := round(frac(f) * 1000000000.0);\r
+  result := 0; //success\r
+end;\r
+\r
+begin\r
+  result := -1; //error\r
+\r
+  case clockid of\r
+    CLOCK_REALTIME: begin\r
+      //implement this case directly for full precision even without extended floats\r
+      if not btimenowin8 then begin\r
+        i := win8time_as_unix_100ns;\r
+        if (i > 0) then begin\r
+          i100ns_to_tp_and_success;\r
+          exit;\r
+        end;\r
+      end;\r
+      f := unixtimefloat;\r
+      f_to_tp_and_success;\r
+    end;\r
+    CLOCK_MONOTONIC: begin\r
+      f := monotimefloat;\r
+      f_to_tp_and_success;\r
+    end;\r
+    CLOCK_REALTIME_COARSE: begin\r
+      f := unixtimefloat_coarse;\r
+      f_to_tp_and_success;\r
+    end;\r
+    CLOCK_MONOTONIC_COARSE: begin\r
+      f := monotimefloat_coarse;\r
+      f_to_tp_and_success;\r
+    end;\r
+    CLOCK_UPTIME: begin\r
+      i := unbiasedtime_100ns;\r
+      if (i > 0) then begin\r
+        i100ns_to_tp_and_success;\r
+        exit;\r
+      end;\r
+      f := qpctimefloat;\r
+      f_to_tp_and_success;\r
+    end;\r
+  end;\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
 function unixtimefloat:float;\r
 const\r
   margin = 0.0012;\r
 var\r
   f,g,h:float;\r
 begin\r

-  result := wintimefloat+timefloatbias;\r
+  if not btimenowin8 then begin\r
+    result := win8time_as_unix_100ns * 0.0000001;\r
+    if (result > 0) then exit;\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
   f := result-unixtimefloat_systemtime;\r
   if ((f > ticks_freq2+margin) or (f < -margin)) or (timefloatbias = 0) then begin\r

-//    writeln('unixtimefloat init');\r

     f := unixtimefloat_systemtime;\r
     settc;\r
     f := unixtimefloat_systemtime;\r
     settc;\r

-    repeat g := unixtimefloat_systemtime; h := wintimefloat until g > f;\r
+    repeat g := unixtimefloat_systemtime; h := monotimefloat until g > f;\r

     unsettc;\r
     timefloatbias := g-h;\r
     result := unixtimefloat;\r
   end;\r
 \r
     unsettc;\r
     timefloatbias := g-h;\r
     result := unixtimefloat;\r
   end;\r
 \r

-  {for small changes backwards, guarantee no steps backwards}\r
-  if (result <= lastunixtimefloat) and (result > lastunixtimefloat-1.5) then result := lastunixtimefloat + 0.0000001;\r
+  //for small changes backwards, guarantee no steps backwards\r
+  if (result <= lastunixtimefloat) and (result > lastunixtimefloat-1.5) then result := lastunixtimefloat;\r

   lastunixtimefloat := result;\r
 end;\r
 \r
   lastunixtimefloat := result;\r
 end;\r
 \r

-function unixtimeint:integer;\r
+function unixtimeint:tunixtimeint;\r

 begin\r
   result := trunc(unixtimefloat);\r
 end;\r
 \r
 begin\r
   result := trunc(unixtimefloat);\r
 end;\r
 \r

-{$endif}\r
+{$endif}  //mswindows\r

 {-----------------------------------------------end of platform specific}\r
 \r
 {-----------------------------------------------end of platform specific}\r
 \r

+function wintimefloat:float;\r
+begin\r
+  result := monotimefloat;\r
+end;\r
+\r

 function irctimefloat:float;\r
 begin\r
   result := unixtimefloat+settimebias;\r
 end;\r
 \r
 function irctimefloat:float;\r
 begin\r
   result := unixtimefloat+settimebias;\r
 end;\r
 \r

-function irctimeint:integer;\r
+function irctimeint:tunixtimeint;\r

 begin\r
   result := unixtimeint+settimebias;\r
 end;\r
 \r
 \r
 begin\r
   result := unixtimeint+settimebias;\r
 end;\r
 \r
 \r

-procedure settime(newtime:integer);\r
+procedure settime(newtime:tunixtimeint);\r

 var\r
 var\r

-  a:integer;\r
+  a:tunixtimeint;\r

 begin\r
   a := irctimeint-settimebias;\r
   if newtime = 0 then settimebias := 0 else settimebias := newtime-a;\r
 begin\r
   a := irctimeint-settimebias;\r
   if newtime = 0 then settimebias := 0 else settimebias := newtime-a;\r


@@ -528,7 +1022,7 @@ procedure timehandler;
 begin\r
   if unixtime = 0 then init;\r
   unixtime := unixtimeint;\r
 begin\r
   if unixtime = 0 then init;\r
   unixtime := unixtimeint;\r

-  irctime := irctimeint;\r
+  irctime := unixtime+settimebias;\r

   if unixtime and 63 = 0 then begin\r
     {update everything, apply timezone changes, clock changes, etc}\r
     gettimezone;\r
   if unixtime and 63 = 0 then begin\r
     {update everything, apply timezone changes, clock changes, etc}\r
     gettimezone;\r


@@ -539,8 +1033,220 @@ begin
 end;\r
 \r
 \r
 end;\r
 \r
 \r

-procedure gettimezone;\r
+{$ifdef unix}\r
+\r
+var\r
+  tzerror:boolean;\r
+  tzfile:ansistring;\r
+\r
+function tzgetfilename:ansistring;\r
+var\r
+  t:textfile;\r
+  a:integer;\r
+  s,tz,tzdir:ansistring;\r
+  ispath:boolean;\r
+begin\r
+  result := '';\r
+  filemode := 0;\r
+\r
+  tz := getenv('TZ');\r
+\r
+  if (tz <> '') then begin\r
+    ispath := false;\r
+    if (copy(tz,1,1) = ':') then begin\r
+      ispath := true;\r
+      tz := copy(tz,2,99999);\r
+    end;\r
+\r
+    if (copy(tz,1,1) <> '/') then begin\r
+      a := pos(',',tz);\r
+      if (a > 1) and not ispath then begin\r
+        tz := copy(tz,1,a-1);\r
+      end;\r
+\r
+      tzdir := getenv('TZDIR');\r
+      if (tzdir = '') then begin\r
+        tzdir := '/usr/share/zoneinfo/';\r
+      end else begin\r
+        if (copy(tzdir,length(tzdir),1) <> '/') then tzdir := tzdir + '/';\r
+      end;\r
+      tz := tzdir + tz;\r
+    end;\r
+\r
+    assignfile(t,tz);\r
+    {$i-}reset(t);{$i+}\r
+    if (ioresult = 0) then begin\r
+      closefile(t);\r
+      result := tz;\r
+      exit;\r
+    end;\r
+\r
+  end;\r
+\r
+  assignfile(t,'/etc/localtime');\r
+  {$i-}reset(t);{$i+}\r
+  if (ioresult = 0) then begin\r
+    closefile(t);\r
+    result := '/etc/localtime';\r
+    exit;\r
+  end;\r
+end;\r
+\r
+type\r
+  dvar=array[0..65535] of byte;\r
+  pdvar=^dvar;\r
+\r
+var\r
+  tzcache:pdvar;\r
+  tzsize:integer;\r
+\r
+procedure tzinvalidate;\r
+begin\r
+  if assigned(tzcache) then freemem(tzcache);\r
+  tzcache := nil;\r
+  tzsize := 0;\r
+  tzfile := '';\r
+  gettimezone;\r
+end;\r
+\r
+\r
+function tzgetoffsetforts(ts:tunixtimeint):integer;\r

 var\r
 var\r

+  f:file;\r
+  buf:pdvar;\r
+  fs:integer;\r
+  ofs,ofs2:integer;\r
+  mode64:boolean;\r
+  has64:boolean;\r
+  a,index:integer;\r
+  //tzstrofs:integer;\r
+  t:int64;\r
+  tzh_ttisgmtcnt:integer;\r
+  tzh_ttisstdcnt:integer;\r
+  tzh_leapcnt:integer;\r
+  tzh_timecnt:integer;\r
+  tzh_typecnt:integer;\r
+  tzh_charcnt:integer;\r
+\r
+\r
+function getint:integer;\r
+begin\r
+  if (ofs < 0) or ((ofs + 4) > fs) then raise exception.create('getint');\r
+  result := (buf[ofs] shl 24) + (buf[ofs+1] shl 16) + (buf[ofs+2] shl 8) + buf[ofs+3];\r
+  inc(ofs,4);\r
+end;\r
+\r
+function getint64:int64;\r
+begin\r
+  if (ofs < 0) or ((ofs + 8) > fs) then raise exception.create('getint64');\r
+  result := int64(getint) shl 32;\r
+  inc(result,cardinal(getint));\r
+end;\r
+\r
+\r
+function getbyte:byte;\r
+begin\r
+  if (ofs < 0) or ((ofs + 1) > fs) then raise exception.create('getbyte');\r
+  result := buf[ofs];\r
+  inc(ofs);\r
+end;\r
+\r
+begin\r
+  result := 0;\r
+  tzerror := true;\r
+\r
+  if not assigned(tzcache) then begin\r
+\r
+    if (tzfile = '') then tzfile := tzgetfilename;\r
+\r
+    if (tzfile = '') then exit;\r
+\r
+    assignfile(f,tzfile);\r
+    filemode := 0;\r
+    {$i-}reset(f,1);{$i+}\r
+    if (ioresult <> 0) then begin\r
+      exit;\r
+    end;\r
+    tzsize := filesize(f);\r
+    if (tzsize > 65536) then tzsize := 65536;\r
+    getmem(tzcache,tzsize);\r
+    blockread(f,tzcache^,tzsize);\r
+    closefile(f);\r
+  end;\r
+  fs := tzsize;\r
+  buf := tzcache;\r
+  ofs := 0;\r
+  mode64 := false;\r
+\r
+ try\r
+   repeat\r
+     if (getint <> $545a6966) then exit; // 'TZif'\r
+     has64 := getbyte >= $32; //  '2'\r
+\r
+     inc(ofs,15);\r
+\r
+     tzh_ttisgmtcnt := getint;\r
+     tzh_ttisstdcnt := getint;\r
+     tzh_leapcnt := getint;\r
+     tzh_timecnt := getint;\r
+     tzh_typecnt := getint;\r
+     tzh_charcnt := getint;\r
+\r
+     if mode64 or (not has64) then break;\r
+     inc(ofs, 5 * tzh_timecnt + 6 * tzh_typecnt + 8 * tzh_leapcnt + tzh_ttisstdcnt + tzh_ttisgmtcnt + tzh_charcnt);\r
+     mode64 := true;\r
+   until false;\r
+   index := 0;\r
+\r
+   if (tzh_timecnt < 0) or (tzh_timecnt > fs) then raise exception.create('tzh_timecnt');\r
+   ofs2 := ofs;\r
+\r
+   if (tzh_timecnt <> 0) then begin\r
+     for a := 0 to tzh_timecnt -1 do begin\r
+       if mode64 then t := getint64 else t := getint;\r
+       if (t > ts) then begin\r
+         index := a - 1;\r
+         break;\r
+       end;\r
+       if (a = tzh_timecnt -1) and (ts >= t) then index := a;\r
+     end;\r
+     ofs := ofs2 + tzh_timecnt * (1 + ord(mode64)) * 4;\r
+\r
+     if (cardinal(ofs + index) >= fs) or (index < 0) then raise exception.create('index');\r
+     index := buf[ofs+index];\r
+     inc(ofs,tzh_timecnt);\r
+   end else begin\r
+     index := 0;\r
+   end;\r
+\r
+   if (index >= tzh_typecnt) then raise exception.create('type');\r
+   ofs2 := ofs;\r
+  // writeln('ofs2 ',inttohex(ofs2,8));\r
+   inc(ofs,6 * index);\r
+   result := getint;\r
+\r
+   //tzisdst := getbyte;\r
+\r
+  //the abbreviation string\r
+  { tzstrofs := getbyte;\r
+   tzstr := '';\r
+   ofs := ofs2 + 6 * tzh_typecnt;\r
+   inc(ofs, tzstrofs);\r
+\r
+   repeat\r
+     a := getbyte;\r
+     if (a <> 0) then tzstr := tzstr + chr(a);\r
+   until (a = 0); }\r
+\r
+   tzerror := false;\r
+ except\r
+\r
+ end;\r
+end;\r
+\r
+{$endif}  //unix\r
+\r
+function tzgetoffset:integer;\r

   {$ifdef UNIX}\r
     {$ifndef ver1_9_4}\r
       {$ifndef ver1_0}\r
   {$ifdef UNIX}\r
     {$ifndef ver1_9_4}\r
       {$ifndef ver1_0}\r


@@ -548,31 +1254,53 @@ var
       {$endif}\r
     {$endif}\r
     {$ifndef above194}\r
       {$endif}\r
     {$endif}\r
     {$ifndef above194}\r

+var\r

       hh,mm,ss:word;\r
     {$endif}\r
       hh,mm,ss:word;\r
     {$endif}\r

+  {$else}\r
+var\r
+  TimeZoneInfo: TIME_ZONE_INFORMATION;\r
+  tztype:cardinal;\r
+  min:integer;\r

   {$endif}\r
   {$endif}\r

-  l:integer;\r
+\r

 begin\r
   {$ifdef UNIX}\r
     {$ifdef above194}\r
 begin\r
   {$ifdef UNIX}\r
     {$ifdef above194}\r

-      timezone := tzseconds;\r
+      result := tzgetoffsetforts(unixtimeint);\r
+      //freepascal tzseconds is not 2038 safe\r

     {$else}\r
       gettime(hh,mm,ss);\r
     {$else}\r
       gettime(hh,mm,ss);\r

-      timezone := (longint(hh) * 3600 + mm * 60 + ss) - (unixtimeint mod 86400);\r
+      result := (integer(hh) * 3600 + mm * 60 + ss) - (unixtimeint mod 86400);\r

     {$endif}\r
   {$else}\r
     {$endif}\r
   {$else}\r

-  timezone := round((now-now_utc)*86400);\r
+    tztype := GetTimeZoneInformation(TimeZoneInfo);\r
+    min := TimeZoneInfo.Bias;\r
+    case tztype of\r
+      //TIME_ZONE_ID_UNKNOWN: don't add DST\r
+      TIME_ZONE_ID_STANDARD: inc(min, TimeZoneInfo.StandardBias);\r
+      TIME_ZONE_ID_DAYLIGHT: inc(min, TimeZoneInfo.DaylightBias);\r
+    end;\r
+    result := min * -60;\r

   {$endif}\r
 \r
   {$endif}\r
 \r

-  while timezone > 43200 do dec(timezone,86400);\r
-  while timezone < -43200 do inc(timezone,86400);\r
+  while result > (14 * 3600) do dec(result,86400);\r
+  while result < -(14 * 3600) do inc(result,86400);\r
+end;\r
+\r
+\r
+procedure gettimezone;\r
+var\r
+  l:integer;\r
+begin\r
+  timezone := tzgetoffset;\r

 \r
   if timezone >= 0 then timezonestr := '+' else timezonestr := '-';\r
   l := abs(timezone) div 60;\r
   timezonestr := timezonestr + char(l div 600 mod 10+48)+char(l div 60 mod 10+48)+':'+char(l div 10 mod 6+48)+char(l mod 10+48);\r
 end;\r
 \r
 \r
   if timezone >= 0 then timezonestr := '+' else timezonestr := '-';\r
   l := abs(timezone) div 60;\r
   timezonestr := timezonestr + char(l div 600 mod 10+48)+char(l div 60 mod 10+48)+':'+char(l div 10 mod 6+48)+char(l mod 10+48);\r
 end;\r
 \r

-function timestrshort(i:integer):string;\r
+function timestrshort(i:tunixtimeint):string;\r

 const\r
   weekday:array[0..6] of string[4]=('Thu','Fri','Sat','Sun','Mon','Tue','Wed');\r
   month:array[0..11] of string[4]=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');\r
 const\r
   weekday:array[0..6] of string[4]=('Thu','Fri','Sat','Sun','Mon','Tue','Wed');\r
   month:array[0..11] of string[4]=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');\r


@@ -588,7 +1316,7 @@ begin
   inttostr(y);\r
 end;\r
 \r
   inttostr(y);\r
 end;\r
 \r

-function timestring(i:integer):string;\r
+function timestring(i:tunixtimeint):string;\r

 const\r
   weekday:array[0..6] of string[10]=('Thursday','Friday','Saturday','Sunday','Monday','Tuesday','Wednesday');\r
   month:array[0..11] of string[10]=('January','February','March','April','May','June','July','August','September','October','November','December');\r
 const\r
   weekday:array[0..6] of string[10]=('Thursday','Friday','Saturday','Sunday','Monday','Tuesday','Wednesday');\r
   month:array[0..11] of string[10]=('January','February','March','April','May','June','July','August','September','October','November','December');\r


@@ -604,9 +1332,52 @@ begin
   timezonestr;\r
 end;\r
 \r
   timezonestr;\r
 end;\r
 \r

+function timestriso(i:tunixtimeint):string;\r
+var\r
+  y,m,d,h,min,sec,ms:word;\r
+  t:tdatetime;\r
+begin\r
+  t := unixtoole(i+timezone);\r
+  decodedate(t,y,m,d);\r
+  decodetime(t,h,min,sec,ms);\r
+  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);\r
+end;\r
+\r
+function timestrisoutc(i:float):string;\r
+var\r
+  y,m,d,h,min,sec,ms:word;\r
+  t:tdatetime;\r
+  fr:float;\r
+begin\r
+  t := unixtoole(i);\r
+  decodedate(t,y,m,d);\r
+  decodetime(t,h,min,sec,ms);\r
+  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);\r
+  fr := frac(i);\r
+\r
+  result := result + '.'+\r
+  inttostr(trunc(fr*10) mod 10)+\r
+  inttostr(trunc(fr*100) mod 10)+\r
+  inttostr(trunc(fr*1000) mod 10)+\r
+  inttostr(trunc(fr*10000) mod 10)+\r
+  inttostr(trunc(fr*100000) mod 10)+\r
+  inttostr(trunc(fr*1000000) mod 10)+'Z';\r
+\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
 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
   fillchar(mmtime_driftavg,sizeof(mmtime_driftavg),0);\r
   settimebias := 0;\r
   gettimezone;\r