rename monotonic time to monotimefloat, added monotonic timefloat for linux and OS...

[lcore.git] / btime.pas

diff --git a/btime.pas b/btime.pas
index 33b32d0c899cde75cf523bb6e9b11cf367463528..e0b0c4bde6059feade1a457b8da0523a6d9b83c5 100644 (file)
--- a/btime.pas
+++ b/btime.pas
@@ -19,6 +19,7 @@ uses
 \r
 type\r
   float=extended;\r
 \r
 type\r
   float=extended;\r

+  tunixtimeint={$ifdef ver100}longint;{$else}int64;{$endif}\r

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


@@ -26,34 +27,39 @@ const
 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
+  settimebias:tunixtimeint;\r

   performancecountfreq:extended;\r
 \r
 function irctimefloat:float;\r
   performancecountfreq:extended;\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
 \r

+//monotonic float seconds\r
+function monotimefloat:float;\r
+\r
+//monotonic (alias, old function name)\r

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

-procedure settime(newtime:integer);\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;\r
+function timestrshort(i:tunixtimeint):string;\r

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

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

 \r
 {$ifdef win32}\r
 function mmtimefloat:float;\r
 \r
 {$ifdef win32}\r
 function mmtimefloat:float;\r


@@ -108,6 +114,9 @@ uses
     {$else}\r
       baseunix,unix,unixutil,sockets, {unixutil and sockets needed by unixstuff.inc on some compiler versions}\r
     {$endif}\r
     {$else}\r
       baseunix,unix,unixutil,sockets, {unixutil and sockets needed by unixstuff.inc on some compiler versions}\r
     {$endif}\r

+    {$ifdef linux}\r
+      dl,\r
+    {$endif}\r

   {$else}\r
     windows,unitsettc,mmsystem,\r
   {$endif}\r
   {$else}\r
     windows,unitsettc,mmsystem,\r
   {$endif}\r


@@ -125,12 +134,12 @@ 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
   result := trunc(oletounixfloat(t));\r
 end;\r
 \r
 begin\r
   result := trunc(oletounixfloat(t));\r
 end;\r
 \r

-function unixtoole(i:integer):tdatetime;\r
+function unixtoole(i:float):tdatetime;\r

 begin\r
   result := ((i)/86400)+daysdifference;\r
 end;\r
 begin\r
   result := ((i)/86400)+daysdifference;\r
 end;\r


@@ -163,12 +172,86 @@ begin
   result := tv.tv_sec+(tv.tv_usec/1000000);\r
 end;\r
 \r
   result := tv.tv_sec+(tv.tv_usec/1000000);\r
 end;\r
 \r

-function wintimefloat:extended;\r
-begin\r
-  result := unixtimefloat;\r
-end;\r
+{$ifdef linux}\r
+  {$define monotimefloat_implemented}\r
+  const\r
+    CLOCK_MONOTONIC = 1;\r
+  type \r
+    ptimeval = ^ttimeval;\r
+    tclock_gettime = function(clk_id: integer; tp: ptimeval): integer; cdecl;\r
+\r
+  var\r
+    librt_handle:pointer;\r
+    librt_inited:boolean;\r
+    clock_gettime: tclock_gettime;\r
+\r
+  function monotimefloat:float;\r
+  var\r
+    ts: ttimeval;\r
+  begin\r
+    if not librt_inited then begin\r
+      librt_inited := true;\r
+      clock_gettime := nil;\r
+      librt_handle := dlopen('librt.so', RTLD_LAZY);\r
+      if assigned(librt_handle) then begin\r
+        clock_gettime := dlsym(librt_handle, 'clock_gettime');\r
+      end;\r
+    end;\r
+    if assigned(clock_gettime) then begin\r
+      if clock_gettime(CLOCK_MONOTONIC, @ts) = 0 then begin\r
+        //note this really returns nanoseconds\r
+        result := ts.tv_sec + ts.tv_usec / 1000000000.0;\r
+        exit;\r
+      end;\r
+    end;\r
+    //fallback\r
+    result := unixtimefloat;\r
+  end;\r

 \r
 \r

-function unixtimeint:integer;\r
+\r
+{$endif} {linux}\r
+\r
+{$ifdef darwin} {mac OS X}\r
+{$define monotimefloat_implemented}\r
+\r
+  type\r
+    tmach_timebase_info = packed record\r
+      numer: longint;\r
+      denom: longint;\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
+\r
+  function monotimefloat:float;\r
+  var\r
+    i:int64;\r
+  begin\r
+    if timebase_info.denom = 0 then begin\r
+      mach_timebase_info(@timebase_info);\r
+    end;\r
+    i := mach_absolute_time;\r
+    result := (i * timebase_info.numer div timebase_info.denom) / 1000000000.0;\r
+  end;\r
+\r
+{$endif} {darwin, mac OS X}\r
+\r
+\r
+{$ifndef monotimefloat_implemented} {fallback}\r
+  \r
+  function monotimefloat:extended;\r
+  begin\r
+    result := unixtimefloat;\r
+  end;\r
+\r
+{$endif} {monotimefloat fallback}\r
+\r
+\r
+function unixtimeint:tunixtimeint;\r

 var\r
   tv:ttimeval;\r
 begin\r
 var\r
   tv:ttimeval;\r
 begin\r


@@ -176,6 +259,8 @@ begin
   result := tv.tv_sec;\r
 end;\r
 \r
   result := tv.tv_sec;\r
 end;\r
 \r

+{------------------------------ end of *nix/freepascal section}\r
+\r

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


@@ -210,6 +295,7 @@ const
   wrapduration=highdwordconst * 0.001;\r
 var\r
   i:integer;\r
   wrapduration=highdwordconst * 0.001;\r
 var\r
   i:integer;\r

+  temp:float;\r

 begin\r
   i := gettickcount; {timegettime}\r
   if i < mmtime_last then begin\r
 begin\r
   i := gettickcount; {timegettime}\r
   if i < mmtime_last then begin\r


@@ -218,7 +304,17 @@ begin
   mmtime_last := i;\r
   result := mmtime_wrapadd + i * 0.001;\r
 \r
   mmtime_last := i;\r
   result := mmtime_wrapadd + i * 0.001;\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
+  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
 \r
 procedure measure_ticks_freq;\r
 end;\r
 \r
 procedure measure_ticks_freq;\r


@@ -226,7 +322,9 @@ var
   f,g:float;\r
   o:tosversioninfo;\r
   isnt:boolean;\r
   f,g:float;\r
   o:tosversioninfo;\r
   isnt:boolean;\r

-  is9x:boolean;\r
+{  is9x:boolean;}\r
+  adjust1,adjust2:cardinal;\r
+  adjustbool:longbool;\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


@@ -239,43 +337,23 @@ begin
   o.dwOSVersionInfoSize := sizeof(o);\r
   getversionex(o);\r
   isnt := o.dwPlatformId = VER_PLATFORM_WIN32_NT;\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
+{  is9x := o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS;}\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 (isnt and (o.dwMajorVersion >= 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
+    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


@@ -327,14 +405,14 @@ const
   maxretries=5;\r
   margin=0.002;\r
 var\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 +429,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 +460,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,17 +478,17 @@ 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


@@ -467,7 +546,7 @@ begin
   result := oletounixfloat(int(date_utc+0.5))+time_utc*86400;\r
 end;\r
 \r
   result := oletounixfloat(int(date_utc+0.5))+time_utc*86400;\r
 end;\r
 \r

-function wintimefloat:extended;\r
+function monotimefloat:extended;\r

 begin\r
   result := mmqpctimefloat;\r
 end;\r
 begin\r
   result := mmqpctimefloat;\r
 end;\r


@@ -478,13 +557,13 @@ const
 var\r
   f,g,h:float;\r
 begin\r
 var\r
   f,g,h:float;\r
 begin\r

-  result := wintimefloat+timefloatbias;\r
+  result := monotimefloat+timefloatbias;\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 := 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

-    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
     unsettc;\r
     timefloatbias := g-h;\r
     result := unixtimefloat;\r


@@ -495,7 +574,7 @@ begin
   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
 begin\r
   result := trunc(unixtimefloat);\r
 end;\r


@@ -503,20 +582,25 @@ end;
 {$endif}\r
 {-----------------------------------------------end of platform specific}\r
 \r
 {$endif}\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


@@ -572,7 +656,7 @@ begin
   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
   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 +672,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