{ Copyright (C) 2005 Bas Steendijk and Peter Green
  For conditions of distribution and use, see copyright notice in zlib_license.txt
  which is included in the package
  ----------------------------------------------------------------------------- }
{
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}

{$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;
  {$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:int64;
  performancecountstep:float;

  btimenowin8:boolean;

function irctimefloat:float;
function irctimeint:tunixtimeint;

//unix timestamp (UTC) float seconds
function unixtimefloat:float;
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;
procedure init;

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;

procedure tzinvalidate;

{$ifdef unix}
function tzgetoffsetforts(ts:tunixtimeint):integer;
{$endif}

{$ifdef mswindows}
function unixtimefloat_systemtime:float;
{$endif}

function oletounixfloat(t:float):float;
function oletounix(t:tdatetime):tunixtimeint;
function unixtoole(i:float):tdatetime;

{$ifdef mswindows}
function mmtimefloat:float;
function mmtimeint64:int64;
function qpctimefloat:float;
{$endif}

{$ifdef mswindows}
function gettimeofday(var tv:ttimeval):integer;
{$endif}


const
  mmtime_driftavgsize=32;
  mmtime_warmupnum=4;
  mmtime_warmupcyclelength=15;
var
  //this flag is to be set when btime has been running long enough to stabilise
  warmup_finished:boolean;

  timefloatbias:float;
  ticks_freq:float=0;
  ticks_freq2:float=0;
  ticks_freq_known:boolean=false;
  lastunixtimefloat:float=0;
  lastsynctime:float=0;
  lastsyncbias:float=0;

  mmtime_last:integer=0;
  mmtime_wrapadd:int64;
  mmtime_lastsyncmm:float=0;
  mmtime_lastsyncqpc:float=0;
  mmtime_drift:float=1;
  mmtime_lastresult:float;
  mmtime_nextdriftcorrection:float;
  mmtime_driftavg:array[0..mmtime_driftavgsize] of float;
  mmtime_synchedqpc:boolean;

  mmtime_prev_drift:float;
  mmtime_prev_lastsyncmm:float;
  mmtime_prev_lastsyncqpc:float;

  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;


//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}
      linux,
    {$else}
      baseunix,unix,unixutil,sockets, {unixutil and sockets needed by unixstuff.inc on some compiler versions}
    {$endif}
  {$else}
    windows,unitsettc,mmsystem,
  {$endif}
  sysutils;

  {$include unixstuff.inc}


const
  daysdifference=25569;

function oletounixfloat(t:float):float;
begin
  t := (t - daysdifference) * 86400;
  result := t;
end;

function oletounix(t:tdatetime):tunixtimeint;
begin
  result := round(oletounixfloat(t));
end;

function unixtoole(i:float):tdatetime;
begin
  result := ((i)/86400)+daysdifference;
end;

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

{$ifdef linux}{$define have_clock_gettime}{$endif}
{$ifdef freebsd}{$define have_clock_gettime}{$endif}

{$ifdef linux}
  {$ifdef cpu386}{$define use_syscall_gettime64}{$endif}
  {$ifdef cpu32}{$define use_syscall_gettime64}{$endif}

  {$ifdef use_syscall_gettime64}
const
  clock_gettime64=403;
  {$endif}
{$endif} //linux



{$ifdef darwin} {mac OS X}
  type
    tmach_timebase_info = packed record
      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 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;
    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

  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));

    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;


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
  ts:tbtimespec;
begin
  btime_gettime(CLOCK_REALTIME,@ts);
  result := ts.tv_sec;
end;

{------------------------------ end of *nix/freepascal section}

{$endif}  //unix

{$ifdef mswindows}
{------------------------------ windows/delphi code to read time}


procedure tzinvalidate;
begin
  gettimezone;
end;


var
  GetTickCount64:function:int64; stdcall;
  gettickcount64_inited:boolean;

procedure init_gettickcount64;
var
  dllhandle:thandle;
begin
  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;


{
time float: gettickcount
resolution: 9x: ~55 ms NT: 1/64th of a second
guarantees: continuous without any jumps
frequency base: same as system clock.
epoch: system boot
}
function mmtimefloat:float;
var
  temp:float;
begin
  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
    this makes the value noisy. use the known ticks frequency to restore the original value}
    temp := int((result / ticks_freq)+0.5) * ticks_freq;

    {if the known ticks freq is wrong (can happen), disable the un-rounding behavior
    this will be a bit less accurate but it prevents problems}
    if abs(temp - result) > 0.002 then begin
      ticks_freq := 0;
    end else result := temp;
  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;

  adjust1,adjust2:cardinal;
  adjustbool:longbool;
  win8_or_later:boolean;
begin
  if (performancecountfreq = 0) then qpctimefloat;
  ticks_freq_known := false;
  settc;
  f := mmtimefloat;
  repeat g := mmtimefloat until g > f;
  unsettc;
  f := g - f;

  init_win_version;

  ticks_freq2 := f;
  mmtime_synchedqpc := false;

  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;

  {9x}
  if (performancecountfreq = 1193182) and (f >= 0.050) and (f <= 0.060) then begin
    ticks_freq_known := true;
    ticks_freq := 65536 / (colorburst / 3);
    mmtime_synchedqpc := true;
  end;
  ticks_freq_known := true;
  if ticks_freq <> 0 then ticks_freq2 := ticks_freq;
//  writeln(formatfloat('0.000000',ticks_freq));
end;

{
time float: QueryPerformanceCounter
resolution: <1us
guarantees: can have forward jumps depending on hardware. can have forward and backwards jitter on dual core.
frequency base: on NT, not the system clock, drifts compared to it.
epoch: system boot
}
function qpctimefloat:float;
var
  i64:int64;
begin
  if performancecountfreq = 0 then begin
    QueryPerformancefrequency(performancecountfreq);
    performancecountstep := 1.0 / performancecountfreq;
  end;
  queryperformancecounter(i64);
  result := i64 * performancecountstep;
end;

{
time float: QPC locked to gettickcount
resolution: <1us
guarantees: continuous without any jumps
frequency base: same as system clock.
epoch: system boot
}

//function mmqpctimefloat:float;
function monotimefloat:float;
const
  maxretries=5;
  margin=0.002;
var
{  jump:float;}
  mm,f,qpc,newdrift:float;
  qpcjumped:boolean;
  a,b:integer;
{  retrycount:integer;}
begin
  if not ticks_freq_known then measure_ticks_freq;
{  retrycount := maxretries;}

  qpc := qpctimefloat;
  mm := mmtimefloat;
  f := (qpc - mmtime_lastsyncqpc) * mmtime_drift + mmtime_lastsyncmm;
  //writeln('XXXX ',formatfloat('0.000000',qpc-mm));
  qpcjumped := ((f-mm) > ticks_freq2+margin) or ((f-mm) < -margin);
//  if qpcjumped then writeln('qpc jumped ',(f-mm));
  if ((qpc > mmtime_nextdriftcorrection) and not mmtime_synchedqpc) or qpcjumped then begin

    mmtime_nextdriftcorrection := qpc + 1;
    repeat
      mmtime_prev_drift := mmtime_drift;
      mmtime_prev_lastsyncmm := mmtime_lastsyncmm;
      mmtime_prev_lastsyncqpc := mmtime_lastsyncqpc;

      mm := mmtimefloat;
    {  dec(retrycount);}
      settc;
      result := qpctimefloat;
      f := mmtimefloat;
      repeat
        if f = mm then result := qpctimefloat;
        f := mmtimefloat
      until f > mm;
      qpc := qpctimefloat;

      unsettc;
      if (qpc > result + 0.0001) then begin
        continue;
      end;
      mm := f;

      if (mmtime_lastsyncqpc <> 0) and not qpcjumped then begin
        newdrift := (mm - mmtime_lastsyncmm) / (qpc - mmtime_lastsyncqpc);
        mmtime_drift := newdrift;
     {   writeln('raw drift: ',formatfloat('0.00000000',mmtime_drift));}
        move(mmtime_driftavg[0],mmtime_driftavg[1],sizeof(mmtime_driftavg[0])*high(mmtime_driftavg));
        mmtime_driftavg[0] := mmtime_drift;

{        write('averaging drift ',formatfloat('0.00000000',mmtime_drift),' -> ');}
{        mmtime_drift := 0;}
        b := 0;
        for a := 0 to high(mmtime_driftavg) do begin
          if mmtime_driftavg[a] <> 0 then inc(b);
{          mmtime_drift := mmtime_drift + mmtime_driftavg[a];}
        end;
{        mmtime_drift := mmtime_drift / b;}
        a := 5;
        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;
        mmtime_nextdriftcorrection := qpc + a;
        if (b >= 2) then warmup_finished := true;
{        writeln(formatfloat('0.00000000',mmtime_drift));}
       if mmtime_synchedqpc then mmtime_drift := 1;
      end;

      mmtime_lastsyncqpc := qpc;
      mmtime_lastsyncmm := mm;
  {   writeln(formatfloat('0.00000000',mmtime_drift));}
      break;
    until false;


    qpc := qpctimefloat;

    result := (qpc - mmtime_lastsyncqpc) * mmtime_drift + mmtime_lastsyncmm;

    {f := (qpc - mmtime_prev_lastsyncqpc) * mmtime_prev_drift + mmtime_prev_lastsyncmm;
    jump := result-f;
    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)));}

    f := result;
  end;

  result := f;

  if (result < mmtime_lastresult) then result := mmtime_lastresult;
  mmtime_lastresult := result;
end;


function boottimefloat:float;
begin
  result := monotimefloat;
end;

var
  QueryUnbiasedInterruptTime:function(var i:int64):longbool; stdcall;
  unbiasedinterrupttime_inited:boolean;


procedure initunbiasedinterrupttime;
var
  dllhandle:thandle;
begin
  unbiasedinterrupttime_inited := true;
  dllhandle := loadlibrary('kernel32.dll');
  if (dllhandle <> 0) then begin
    QueryUnbiasedInterruptTime := getprocaddress(dllhandle,'QueryUnbiasedInterruptTime');
  end;
end;

function unbiasedtime_100ns:int64;
begin
  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 := -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;

  e := unixtimefloat;
  if (e > 0) then result := 0;
  tv.tv_sec := trunc(e);
  tv.tv_usec := trunc(frac(e)*1000000);
end;


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
  //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
    f := unixtimefloat_systemtime;
    settc;
    repeat g := unixtimefloat_systemtime; h := monotimefloat until g > f;
    unsettc;
    timefloatbias := g-h;
    result := unixtimefloat;
  end;

  //for small changes backwards, guarantee no steps backwards
  if (result <= lastunixtimefloat) and (result > lastunixtimefloat-1.5) then result := lastunixtimefloat;
  lastunixtimefloat := result;
end;

function unixtimeint:tunixtimeint;
begin
  result := trunc(unixtimefloat);
end;

{$endif}  //mswindows
{-----------------------------------------------end of platform specific}

function wintimefloat:float;
begin
  result := monotimefloat;
end;

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

function irctimeint:tunixtimeint;
begin
  result := unixtimeint+settimebias;
end;


procedure settime(newtime:tunixtimeint);
var
  a:tunixtimeint;
begin
  a := irctimeint-settimebias;
  if newtime = 0 then settimebias := 0 else settimebias := newtime-a;

  irctime := irctimeint;
end;

procedure timehandler;
begin
  if unixtime = 0 then init;
  unixtime := unixtimeint;
  irctime := unixtime+settimebias;
  if unixtime and 63 = 0 then begin
    {update everything, apply timezone changes, clock changes, etc}
    gettimezone;
    timefloatbias := 0;
    unixtime := unixtimeint;
    irctime := irctimeint;
  end;
end;


{$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}
        {$define above194}
      {$endif}
    {$endif}
    {$ifndef above194}
var
      hh,mm,ss:word;
    {$endif}
  {$else}
var
  TimeZoneInfo: TIME_ZONE_INFORMATION;
  tztype:cardinal;
  min:integer;
  {$endif}

begin
  {$ifdef UNIX}
    {$ifdef above194}
      result := tzgetoffsetforts(unixtimeint);
      //freepascal tzseconds is not 2038 safe
    {$else}
      gettime(hh,mm,ss);
      result := (integer(hh) * 3600 + mm * 60 + ss) - (unixtimeint mod 86400);
    {$endif}
  {$else}
    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 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;
  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);
end;

function timestrshort(i:tunixtimeint):string;
const
  weekday:array[0..6] of string[4]=('Thu','Fri','Sat','Sun','Mon','Tue','Wed');
  month:array[0..11] of string[4]=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
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 := weekday[(i+timezone) div 86400 mod 7]+' '+month[m-1]+' '+inttostr(d)+' '+
  inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10)+' '+
  inttostr(y);
end;

function timestring(i:tunixtimeint):string;
const
  weekday:array[0..6] of string[10]=('Thursday','Friday','Saturday','Sunday','Monday','Tuesday','Wednesday');
  month:array[0..11] of string[10]=('January','February','March','April','May','June','July','August','September','October','November','December');
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 := weekday[(i+timezone) div 86400 mod 7]+' '+month[m-1]+' '+inttostr(d)+' '+inttostr(y)+' -- '+
  inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10)+' '+
  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 btimehighrate}beginhightimerrate;{$endif}
  fillchar(mmtime_driftavg,sizeof(mmtime_driftavg),0);
  settimebias := 0;
  gettimezone;
  unixtime := unixtimeint;
  irctime := irctimeint;
end;

initialization init;

end.