X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/055fa6bf18e0733d1bf2f97075d6bb33c76e72b5..c1c7500bc32248d67b6cf7903a6db7b15e2cd1c9:/btime.pas?ds=inline

diff --git a/btime.pas b/btime.pas
index 9bb9550..2a4b267 100644
--- a/btime.pas
+++ b/btime.pas
@@ -12,8 +12,14 @@ unit btime;
 
 interface
 
+{$ifdef win32}
+uses
+  ltimevalstuff;
+{$endif}  
+
 type
   float=extended;
+  tunixtimeint={$ifdef ver100}longint;{$else}int64;{$endif}
 
 const
   colorburst=39375000/11;  {3579545.4545....}
@@ -21,40 +27,52 @@ const
 var
   timezone:integer;
   timezonestr:string;
-  irctime,unixtime:integer;
+  irctime,unixtime:tunixtimeint;
   tickcount:integer;
-  settimebias:integer;
+  settimebias:tunixtimeint;
   performancecountfreq:extended;
 
 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
 
 {$ifdef win32}
 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 win32}
 function mmtimefloat:float;
 function qpctimefloat:float;
 {$endif}
 
+{$ifdef win32}
+procedure gettimeofday(var tv:ttimeval);
+{$endif}
+
+
 const
   mmtime_driftavgsize=32;
   mmtime_warmupnum=4;
@@ -98,6 +116,9 @@ uses
     {$else}
       baseunix,unix,unixutil,sockets, {unixutil and sockets needed by unixstuff.inc on some compiler versions}
     {$endif}
+    {$ifdef linux}
+      dl,
+    {$endif}
   {$else}
     windows,unitsettc,mmsystem,
   {$endif}
@@ -115,12 +136,12 @@ begin
   result := t;
 end;
 
-function oletounix(t:tdatetime):integer;
+function oletounix(t:tdatetime):tunixtimeint;
 begin
   result := trunc(oletounixfloat(t));
 end;
 
-function unixtoole(i:integer):tdatetime;
+function unixtoole(i:float):tdatetime;
 begin
   result := ((i)/86400)+daysdifference;
 end;
@@ -153,12 +174,86 @@ begin
   result := tv.tv_sec+(tv.tv_usec/1000000);
 end;
 
-function wintimefloat:extended;
-begin
-  result := unixtimefloat;
-end;
+{$ifdef linux}
+  {$define monotimefloat_implemented}
+  const
+    CLOCK_MONOTONIC = 1;
+  type 
+    ptimeval = ^ttimeval;
+    tclock_gettime = function(clk_id: integer; tp: ptimeval): integer; cdecl;
+
+  var
+    librt_handle:pointer;
+    librt_inited:boolean;
+    clock_gettime: tclock_gettime;
+
+  function monotimefloat:float;
+  var
+    ts: ttimeval;
+  begin
+    if not librt_inited then begin
+      librt_inited := true;
+      clock_gettime := nil;
+      librt_handle := dlopen('librt.so', RTLD_LAZY);
+      if assigned(librt_handle) then begin
+        clock_gettime := dlsym(librt_handle, 'clock_gettime');
+      end;
+    end;
+    if assigned(clock_gettime) then begin
+      if clock_gettime(CLOCK_MONOTONIC, @ts) = 0 then begin
+        //note this really returns nanoseconds
+        result := ts.tv_sec + ts.tv_usec / 1000000000.0;
+        exit;
+      end;
+    end;
+    //fallback
+    result := unixtimefloat;
+  end;
+
 
-function unixtimeint:integer;
+{$endif} {linux}
+
+{$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;
 begin
@@ -166,9 +261,27 @@ begin
   result := tv.tv_sec;
 end;
 
+{------------------------------ end of *nix/freepascal section}
+
 {$else} {delphi 3}
 {------------------------------ windows/delphi code to read time}
 
+
+{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
@@ -184,6 +297,7 @@ const
   wrapduration=highdwordconst * 0.001;
 var
   i:integer;
+  temp:float;
 begin
   i := gettickcount; {timegettime}
   if i < mmtime_last then begin
@@ -192,7 +306,17 @@ begin
   mmtime_last := i;
   result := mmtime_wrapadd + i * 0.001;
 
-  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
+  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;
@@ -200,7 +324,9 @@ var
   f,g:float;
   o:tosversioninfo;
   isnt:boolean;
-  is9x:boolean;
+{  is9x:boolean;}
+  adjust1,adjust2:cardinal;
+  adjustbool:longbool;
 begin
   if (performancecountfreq = 0) then qpctimefloat;
   ticks_freq_known := false;
@@ -213,43 +339,23 @@ begin
   o.dwOSVersionInfoSize := sizeof(o);
   getversionex(o);
   isnt := o.dwPlatformId = VER_PLATFORM_WIN32_NT;
-  is9x := o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS;
+{  is9x := o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS;}
 
   ticks_freq2 := f;
   mmtime_synchedqpc := false;
-  {
-  NT 64 Hz
-  identify mode as: nt64
-  QPC rate: either 3579545 or TSC freq
-  QPC synched to gettickcount: no
-  duration between 2 ticks is constant: yes
-  gettickcount tick duration: 64 Hz
-  }
-  if (f >= 0.014) and (f <= 0.018) and isnt then begin
-    ticks_freq_known := true;
-    ticks_freq := 1/64;
-    mmtime_synchedqpc := false;
-  end;
 
-  {
-  NT 100 Hz
-  identify mode as: nt100
-  QPC rate: 1193182
-  QPC synched to gettickcount: yes
-  duration between 2 ticks is constant: no?
-  gettickcount tick duration: ~99.85 Hz
-  }
-  if (performancecountfreq = 1193182) and (f >= 0.008) and (f <= 0.012) and isnt then begin
-    ticks_freq_known := true;
-    ticks_freq2 := 11949 / (colorburst / 3);
-   //  ticks_freq2 := 11949 / 1193182;
-    ticks_freq := 0;
-    {the ticks freq should be very close to the real one but if it's not exact, it will cause drift and correction jumps}
-    mmtime_synchedqpc := true;
+  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 (g >= 0.050) and (g <= 0.060) then begin
+  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;
@@ -301,14 +407,14 @@ const
   maxretries=5;
   margin=0.002;
 var
-  jump:float;
-  mm,f,qpc,newdrift,f1,f2:float;
+{  jump:float;}
+  mm,f,qpc,newdrift:float;
   qpcjumped:boolean;
-  a,b,c:integer;
-  retrycount:integer;
+  a,b:integer;
+{  retrycount:integer;}
 begin
   if not ticks_freq_known then measure_ticks_freq;
-  retrycount := maxretries;
+{  retrycount := maxretries;}
 
   qpc := qpctimefloat;
   mm := mmtimefloat;
@@ -325,7 +431,7 @@ begin
       mmtime_prev_lastsyncqpc := mmtime_lastsyncqpc;
 
       mm := mmtimefloat;
-      dec(retrycount);
+    {  dec(retrycount);}
       settc;
       result := qpctimefloat;
       f := mmtimefloat;
@@ -356,6 +462,7 @@ begin
 {          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;
@@ -373,17 +480,17 @@ begin
     qpc := qpctimefloat;
 
     result := (qpc - mmtime_lastsyncqpc) * mmtime_drift + mmtime_lastsyncmm;
-    f := (qpc - mmtime_prev_lastsyncqpc) * mmtime_prev_drift + mmtime_prev_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)));}
+    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 + 0.000001;
+  if (result < mmtime_lastresult) then result := mmtime_lastresult;
   mmtime_lastresult := result;
 end;
 
@@ -441,7 +548,7 @@ begin
   result := oletounixfloat(int(date_utc+0.5))+time_utc*86400;
 end;
 
-function wintimefloat:extended;
+function monotimefloat:extended;
 begin
   result := mmqpctimefloat;
 end;
@@ -452,13 +559,13 @@ const
 var
   f,g,h:float;
 begin
-  result := wintimefloat+timefloatbias;
+  result := monotimefloat+timefloatbias;
   f := result-unixtimefloat_systemtime;
   if ((f > ticks_freq2+margin) or (f < -margin)) or (timefloatbias = 0) then begin
 //    writeln('unixtimefloat init');
     f := unixtimefloat_systemtime;
     settc;
-    repeat g := unixtimefloat_systemtime; h := wintimefloat until g > f;
+    repeat g := unixtimefloat_systemtime; h := monotimefloat until g > f;
     unsettc;
     timefloatbias := g-h;
     result := unixtimefloat;
@@ -469,7 +576,7 @@ begin
   lastunixtimefloat := result;
 end;
 
-function unixtimeint:integer;
+function unixtimeint:tunixtimeint;
 begin
   result := trunc(unixtimefloat);
 end;
@@ -477,20 +584,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;
@@ -546,7 +658,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);
 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');
@@ -562,7 +674,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');
@@ -578,6 +690,40 @@ 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 init;
 begin
   {$ifdef win32}timebeginperiod(1);{$endif} //ensure stable unchanging clock