X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/27e903c56380abcb11b5a0b8d7ccab88a14b5cde..7cad80355c81569210547a281e30cd491b5bb353:/btime.pas?ds=inline diff --git a/btime.pas b/btime.pas index c130144..df4f91e 100644 --- a/btime.pas +++ b/btime.pas @@ -12,13 +12,14 @@ unit btime; interface -{$ifdef win32} +{$ifdef mswindows} uses ltimevalstuff; {$endif} type float=extended; + tunixtimeint={$ifdef ver100}longint;{$else}int64;{$endif} const colorburst=39375000/11; {3579545.4545....} @@ -26,41 +27,48 @@ 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} +{$ifdef mswindows} function unixtimefloat_systemtime:float; {$endif} function oletounixfloat(t:float):float; -function oletounix(t:tdatetime):integer; +function oletounix(t:tdatetime):tunixtimeint; function unixtoole(i:float):tdatetime; -{$ifdef win32} +{$ifdef mswindows} function mmtimefloat:float; function qpctimefloat:float; {$endif} -{$ifdef win32} +{$ifdef mswindows} procedure gettimeofday(var tv:ttimeval); {$endif} @@ -108,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} @@ -125,7 +136,7 @@ begin result := t; end; -function oletounix(t:tdatetime):integer; +function oletounix(t:tdatetime):tunixtimeint; begin result := trunc(oletounixfloat(t)); end; @@ -163,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; + + +{$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} + -function unixtimeint:integer; +{$ifndef monotimefloat_implemented} {fallback} + + function monotimefloat:extended; + begin + result := unixtimefloat; + end; + +{$endif} {monotimefloat fallback} + + +function unixtimeint:tunixtimeint; var tv:ttimeval; begin @@ -176,6 +261,8 @@ begin result := tv.tv_sec; end; +{------------------------------ end of *nix/freepascal section} + {$else} {delphi 3} {------------------------------ windows/delphi code to read time} @@ -210,6 +297,7 @@ const wrapduration=highdwordconst * 0.001; var i:integer; + temp:float; begin i := gettickcount; {timegettime} if i < mmtime_last then begin @@ -218,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; @@ -227,6 +325,8 @@ var o:tosversioninfo; isnt:boolean; { is9x:boolean;} + adjust1,adjust2:cardinal; + adjustbool:longbool; begin if (performancecountfreq = 0) then qpctimefloat; ticks_freq_known := false; @@ -243,39 +343,19 @@ begin 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; @@ -410,7 +490,7 @@ begin result := f; - if (result < mmtime_lastresult) then result := mmtime_lastresult + 0.000001; + if (result < mmtime_lastresult) then result := mmtime_lastresult; mmtime_lastresult := result; end; @@ -468,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; @@ -479,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; @@ -496,7 +576,7 @@ begin lastunixtimefloat := result; end; -function unixtimeint:integer; +function unixtimeint:tunixtimeint; begin result := trunc(unixtimefloat); end; @@ -504,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; @@ -573,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'); @@ -589,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'); @@ -605,9 +690,43 @@ 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 + {$ifdef mswindows}timebeginperiod(1);{$endif} //ensure stable unchanging clock fillchar(mmtime_driftavg,sizeof(mmtime_driftavg),0); settimebias := 0; gettimezone;