X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/4782a5c5afee47721cc617daa40dd29828342c2b..85edf7ed5948e0efe59301680f79ea0bac4367e8:/btime.pas?ds=sidebyside

diff --git a/btime.pas b/btime.pas
old mode 100755
new mode 100644
index 3d672c4..ae6ffa5
--- a/btime.pas
+++ b/btime.pas
@@ -7,61 +7,132 @@ this unit returns unix timestamp with seconds and microseconds (as float)
 works on windows/delphi, and on freepascal on unix.
 }
 
+
 unit btime;
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+{$include lcoreconfig.inc}
 
 interface
 
+{$ifdef mswindows}
+uses
+  ltimevalstuff;
+{$endif}  
+
 type
   float=extended;
+  tunixtimeint={$ifdef ver100}longint;{$else}int64;{$endif}
+
+const
+  colorburst=39375000/11;  {3579545.4545....}
 
 var
   timezone:integer;
   timezonestr:string;
-  irctime,unixtime:integer;
+  irctime,unixtime:tunixtimeint;
   tickcount:integer;
-  settimebias:integer;
-  qpcjump:float; {can be read out and reset for debug purpose}
+  settimebias:tunixtimeint;
   performancecountfreq:extended;
+  btimenowin8:boolean;
 
 function irctimefloat:float;
-function irctimeint:integer;
+function irctimeint:tunixtimeint;
 
+//unix timestamp (UTC) float seconds
 function unixtimefloat:float;
-function unixtimeint:integer;
+function unixtimeint:tunixtimeint;
+
+//monotonic float seconds
+function monotimefloat:float;
 
+//monotonic (alias, old function name)
 function wintimefloat:float;
 
-procedure settime(newtime:integer);
+procedure settime(newtime:tunixtimeint);
 procedure gettimezone;
 procedure timehandler;
 procedure init;
 
-function timestring(i:integer):string;
-function timestrshort(i:integer):string;
+function timestring(i:tunixtimeint):string;      // Wednesday August 15 2012 -- 16:21:09 +02:00
+function timestrshort(i:tunixtimeint):string;    // Wed Aug 15 16:21:09 2012
+function timestriso(i:tunixtimeint):string;      // 2012-08-15 16:21:09
+function timestrisoutc(i:float):string;          // 2012-08-15T14:21:09.255553Z
+
+procedure beginhightimerrate;
+procedure endhightimerrate;
+
+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):integer;
-function unixtoole(i:integer):tdatetime;
+function oletounix(t:tdatetime):tunixtimeint;
+function unixtoole(i:float):tdatetime;
+
+{$ifdef mswindows}
+function mmtimefloat:float;
+function qpctimefloat:float;
+{$endif}
+
+{$ifdef mswindows}
+procedure gettimeofday(var tv:ttimeval);
+{$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:float;
+  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;
 
 implementation
 
-{$ifdef fpc}
-  {$mode delphi}
-{$endif}
+
 
 uses
   {$ifdef UNIX}
     {$ifdef VER1_0}
       linux,
     {$else}
-      baseunix,unix,unixutil,{needed for 2.0.2}
+      {$ifdef linux}linux,{$endif} //for clock_gettime
+      {$ifdef freebsd}freebsd,{$endif} //for clock_gettime
+      baseunix,unix,unixutil,sockets, {unixutil and sockets needed by unixstuff.inc on some compiler versions}
     {$endif}
   {$else}
-    windows,
+    windows,unitsettc,mmsystem,
   {$endif}
   sysutils;
 
@@ -77,44 +148,363 @@ begin
   result := t;
 end;
 
-function oletounix(t:tdatetime):integer;
+function oletounix(t:tdatetime):tunixtimeint;
 begin
-  result := trunc(oletounixfloat(t));
+  result := round(oletounixfloat(t));
 end;
 
-function unixtoole(i:integer):tdatetime;
+function unixtoole(i:float):tdatetime;
 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;
+  sec:tunixtimeint;
 begin
   gettimeofday(tv);
-  result := tv.tv_sec+(tv.tv_usec/1000000);
+  sec := tv.tv_sec;
+  {$ifndef cpu64}
+  if (sec < -1) then inc(sec,$100000000); //tv_sec is 32 bits. allow -1 for invalid result
+  {$endif}
+  result := sec+(tv.tv_usec/1000000);
 end;
 
-function wintimefloat:extended;
-begin
-  result := unixtimefloat;
-end;
+{$ifdef linux}{$define have_clock_gettime}{$endif}
+{$ifdef freebsd}{$define have_clock_gettime}{$endif}
+
+{$ifdef have_clock_gettime}
+  {$define monotimefloat_implemented}
+
+  function monotimefloat:float;
+  var
+    ts: ttimespec;
+  begin
+    if clock_gettime(CLOCK_MONOTONIC, @ts) = 0 then begin
+      //note this really returns nanoseconds
+      result := ts.tv_sec + ts.tv_nsec / 1000000000.0;
+      exit;
+    end;
+    //fallback
+    result := unixtimefloat;
+  end;
+
+
+{$endif}
 
-function unixtimeint:integer;
+{$ifdef darwin} {mac OS X}
+{$define monotimefloat_implemented}
+
+  type
+    tmach_timebase_info = packed record
+      numer: longint;
+      denom: longint;
+    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;
+
+  function monotimefloat:float;
+  var
+    i:int64;
+  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;
+  end;
+
+{$endif} {darwin, mac OS X}
+
+
+{$ifndef monotimefloat_implemented} {fallback}
+  
+  function monotimefloat:extended;
+  begin
+    result := unixtimefloat;
+  end;
+
+{$endif} {monotimefloat fallback}
+
+
+function unixtimeint:tunixtimeint;
 var
   tv:ttimeval;
+  sec:tunixtimeint;
 begin
   gettimeofday(tv);
-  result := tv.tv_sec;
+  sec := tv.tv_sec;
+  {$ifndef cpu64}
+  if (sec < -1) then inc(sec,$100000000); //tv_sec is 32 bits. allow -1 for invalid result
+  {$endif}
+  result := sec;
 end;
 
-{$else} {delphi 3}
+{------------------------------ end of *nix/freepascal section}
+
+{$else} {windows}
 {------------------------------ windows/delphi code to read time}
 
-{ free pascals tsystemtime is incomaptible with windows api calls
+
+procedure tzinvalidate;
+begin
+  gettimezone;
+end;
+
+{simulate gettimeofday on windows so one can always use gettimeofday if preferred}
+
+procedure gettimeofday(var tv:ttimeval);
+var
+  e:extended;
+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;
+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
+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;
+
+  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;
+
+procedure measure_ticks_freq;
+var
+  f,g:float;
+  o:tosversioninfo;
+  isnt:boolean;
+{  is9x:boolean;}
+  adjust1,adjust2:cardinal;
+  adjustbool:longbool;
+begin
+  if (performancecountfreq = 0) then qpctimefloat;
+  ticks_freq_known := false;
+  settc;
+  f := mmtimefloat;
+  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;}
+
+  ticks_freq2 := f;
+  mmtime_synchedqpc := false;
+
+  if (isnt and (o.dwMajorVersion >= 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;
+    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:extended;
+var
+  p:packed record
+    lowpart:longint;
+    highpart:longint
+  end;
+  p2:tlargeinteger absolute p;
+  e:extended;
+begin
+  if performancecountfreq = 0 then begin
+    QueryPerformancefrequency(p2);
+    e := p.lowpart;
+    if e < 0 then e := e + highdwordconst;
+    performancecountfreq := ((p.highpart*highdwordconst)+e);
+  end;
+  queryperformancecounter(p2);
+  e := p.lowpart;
+  if e < 0 then e := e + highdwordconst;
+
+  result := ((p.highpart*highdwordconst)+e)/performancecountfreq;
+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;
+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;
+
+{ free pascals tsystemtime is incompatible with windows api calls
  so we declare it ourselves - plugwash
 }
 {$ifdef fpc}
@@ -160,88 +550,84 @@ begin
   Result := round(Date_utc) + Time_utc;
 end;
 
-const
-  highdwordconst=4294967296.0;
+function unixtimefloat_systemtime:float;
+begin
+  {result := oletounixfloat(now_utc);}
 
-function wintimefloat:extended;
-var
-  p:packed record
-    lowpart:longint;
-    highpart:longint
-  end;
-  p2:tlargeinteger absolute p;
-  e:extended;
+  {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;
+end;
+
+function monotimefloat:extended;
 begin
-  if performancecountfreq = 0 then begin
-    QueryPerformancefrequency(p2);
-    e := p.lowpart;
-    if e < 0 then e := e + highdwordconst;
-    performancecountfreq := ((p.highpart*highdwordconst)+e);
-  end;
-  queryperformancecounter(p2);
-  e := p.lowpart;
-  if e < 0 then e := e + highdwordconst;
-  result := ((p.highpart*highdwordconst)+e)/performancecountfreq;
+  result := mmqpctimefloat;
 end;
 
-var
-  classpriority,threadpriority:integer;
 
-procedure settc;
+
 var
-  hprocess,hthread:integer;
-begin
-  hProcess := GetCurrentProcess;
-  hThread := GetCurrentThread;
+  GetSystemTimePreciseAsFileTime:procedure(var v:tfiletime); stdcall;
+  win8inited:boolean;
 
-  ClassPriority := GetPriorityClass(hProcess);
-  ThreadPriority := GetThreadPriority(hThread);
+procedure initwin8;
+var
+  dllhandle:thandle;
 
-  SetPriorityClass(hProcess, REALTIME_PRIORITY_CLASS);
-  SetThreadPriority(hThread, THREAD_PRIORITY_TIME_CRITICAL);
+begin
+  win8inited := true;
+  dllhandle := loadlibrary('kernel32.dll');
+  if (dllhandle <> 0) then begin
+    GetSystemTimePreciseAsFileTime := getprocaddress(dllhandle,'GetSystemTimePreciseAsFileTime');
+  end;
 end;
 
-procedure unsettc;
+
+function unixtimefloat_win8:float;
 var
-  hprocess,hthread:integer;
+  ft:tfiletime;
+  i:int64 absolute ft;
 begin
-  hProcess := GetCurrentProcess;
-  hThread := GetCurrentThread;
-
-  SetPriorityClass(hProcess, ClassPriority);
-  SetThreadPriority(hThread,  ThreadPriority);
+  GetSystemTimePreciseAsFileTime(ft);
+  {change from windows 1601-01-01 to unix 1970-01-01.
+  use integer math for this, to preserve precision}
+  dec(i, 116444736000000000);
+  result := (i / 10000000);
 end;
 
+
+
 function unixtimefloat:float;
+const
+  margin = 0.0012;
 var
   f,g,h:float;
 begin
-  if timefloatbias = 0 then begin
+  if not btimenowin8 then begin
+    if not win8inited then initwin8;
+    if assigned(@GetSystemTimePreciseAsFileTime) then begin
+      result := unixtimefloat_win8;
+      exit;
+    end;  
+  end;
+
+  result := monotimefloat+timefloatbias;
+  f := result-unixtimefloat_systemtime;
+  if ((f > ticks_freq2+margin) or (f < -margin)) or (timefloatbias = 0) then begin
+//    writeln('unixtimefloat init');
+    f := unixtimefloat_systemtime;
     settc;
-    f := now_utc;
-    repeat g := now_utc; h := wintimefloat until g > f;
-    timefloatbias := oletounixfloat(g)-h;
+    repeat g := unixtimefloat_systemtime; h := monotimefloat until g > f;
     unsettc;
-  end;
-  result := wintimefloat+timefloatbias;
-
-  {
-  workaround for QPC jumps
-  (approach 2: always check "hi res" QPC unixtime against the "guaranteed" systemtime one)
-  }
-  f := result-(oletounixfloat(now_utc));
-  if abs(f) > 0.02 then begin
-    f := timefloatbias;
-    timefloatbias := 0;
+    timefloatbias := g-h;
     result := unixtimefloat;
-    qpcjump := qpcjump + f - timefloatbias;
   end;
 
-  if (result <= lastunixtimefloat) then result := lastunixtimefloat + 0.0000001;
+  {for small changes backwards, guarantee no steps backwards}
+  if (result <= lastunixtimefloat) and (result > lastunixtimefloat-1.5) then result := lastunixtimefloat + 0.0000001;
   lastunixtimefloat := result;
 end;
 
-function unixtimeint:integer;
+function unixtimeint:tunixtimeint;
 begin
   result := trunc(unixtimefloat);
 end;
@@ -249,20 +635,25 @@ end;
 {$endif}
 {-----------------------------------------------end of platform specific}
 
+function wintimefloat:float;
+begin
+  result := monotimefloat;
+end;
+
 function irctimefloat:float;
 begin
   result := unixtimefloat+settimebias;
 end;
 
-function irctimeint:integer;
+function irctimeint:tunixtimeint;
 begin
   result := unixtimeint+settimebias;
 end;
 
 
-procedure settime(newtime:integer);
+procedure settime(newtime:tunixtimeint);
 var
-  a:integer;
+  a:tunixtimeint;
 begin
   a := irctimeint-settimebias;
   if newtime = 0 then settimebias := 0 else settimebias := newtime-a;
@@ -285,6 +676,226 @@ begin
 end;
 
 
+{$ifdef unix}
+
+var
+  tzerror:boolean;
+  tzfile:ansistring;
+
+function tzgetfilename:ansistring;
+var
+  t:textfile;
+
+  s,tz,tzdir:ansistring;
+begin
+  result := '';
+  filemode := 0;
+  {$ifdef unix}
+  tz := getenv('TZ');
+
+  if (copy(tz,1,1) = ':') then begin
+    tz := copy(tz,2,99999);
+
+    if (copy(tz,1,1) <> '/') then begin
+      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;
+  {$endif}
+  
+  assignfile(t,'/etc/localtime');
+  {$i-}reset(t);{$i+}
+  if (ioresult = 0) then begin
+    closefile(t);
+    result := '/etc/localtime';
+    exit;
+  end;
+
+  assignfile(t,'/etc/timezone');
+
+  s := '';
+  {$i-}reset(t);{$i+}
+  if (ioresult = 0) then begin
+    readln(t,s);
+    closefile(t);
+    if (s <> '') then begin
+      result := '/usr/share/zoneinfo/'+s;
+      exit;
+    end;
+  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;
+
+   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);
+
+   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;
+
+function tzgetoffset:integer;
+begin
+  tzgetoffsetforts(unixtimeint);
+end;
+
+
+{$endif}
+
+
 procedure gettimezone;
 var
   {$ifdef UNIX}
@@ -301,7 +912,8 @@ var
 begin
   {$ifdef UNIX}
     {$ifdef above194}
-      timezone := tzseconds;
+      timezone := tzgetoffset;
+      //freepascal tzseconds is not 2038 safe
     {$else}
       gettime(hh,mm,ss);
       timezone := (longint(hh) * 3600 + mm * 60 + ss) - (unixtimeint mod 86400);
@@ -310,15 +922,15 @@ begin
   timezone := round((now-now_utc)*86400);
   {$endif}
 
-  while timezone > 43200 do dec(timezone,86400);
-  while timezone < -43200 do inc(timezone,86400);
+  while timezone > 50400 do dec(timezone,86400);
+  while timezone < -50400 do inc(timezone,86400);
 
   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:integer):string;
+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');
@@ -334,7 +946,7 @@ begin
   inttostr(y);
 end;
 
-function timestring(i:integer):string;
+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');
@@ -350,13 +962,59 @@ begin
   timezonestr;
 end;
 
+function timestriso(i:tunixtimeint):string;
+var
+  y,m,d,h,min,sec,ms:word;
+  t:tdatetime;
+begin
+  t := unixtoole(i+timezone);
+  decodedate(t,y,m,d);
+  decodetime(t,h,min,sec,ms);
+  result := inttostr(y)+'-'+inttostr(m div 10)+inttostr(m mod 10)+'-'+inttostr(d div 10)+inttostr(d mod 10)+' '+inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10);
+end;
+
+function timestrisoutc(i:float):string;
+var
+  y,m,d,h,min,sec,ms:word;
+  t:tdatetime;
+  fr:float;
+begin
+  t := unixtoole(i);
+  decodedate(t,y,m,d);
+  decodetime(t,h,min,sec,ms);
+  result := inttostr(y)+'-'+inttostr(m div 10)+inttostr(m mod 10)+'-'+inttostr(d div 10)+inttostr(d mod 10)+'T'+inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10);
+  fr := frac(i);
+
+  result := result + '.'+
+  inttostr(trunc(fr*10) mod 10)+
+  inttostr(trunc(fr*100) mod 10)+
+  inttostr(trunc(fr*1000) mod 10)+
+  inttostr(trunc(fr*10000) mod 10)+
+  inttostr(trunc(fr*100000) mod 10)+
+  inttostr(trunc(fr*1000000) mod 10)+'Z';
+
+end;
+
+procedure beginhightimerrate;
+begin
+  {$ifdef mswindows}timebeginperiod(1);{$endif}
+end;
+
+procedure endhightimerrate;
+begin
+  {$ifdef mswindows}timeendperiod(1);{$endif}
+end;
+
 procedure init;
 begin
-  qpcjump := 0;
+  {$ifdef btimehighrate}beginhightimerrate;{$endif}
+  fillchar(mmtime_driftavg,sizeof(mmtime_driftavg),0);
   settimebias := 0;
   gettimezone;
   unixtime := unixtimeint;
   irctime := irctimeint;
 end;
 
+initialization init;
+
 end.