X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/055fa6bf18e0733d1bf2f97075d6bb33c76e72b5..19e44013088ff80c11e1d7c045331b96f4dc41f0:/btime.pas diff --git a/btime.pas b/btime.pas index 9bb9550..54deae5 100644 --- a/btime.pas +++ b/btime.pas @@ -12,8 +12,14 @@ unit btime; interface +{$ifdef mswindows} +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} +{$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 win32} +{$ifdef mswindows} function mmtimefloat:float; function qpctimefloat:float; {$endif} +{$ifdef mswindows} +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; + + +{$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; -function unixtimeint:integer; +{$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,21 +480,21 @@ 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; -{ free pascals tsystemtime is incomaptible with windows api calls +{ free pascals tsystemtime is incompatible with windows api calls so we declare it ourselves - plugwash } {$ifdef fpc} @@ -441,24 +548,63 @@ begin result := oletounixfloat(int(date_utc+0.5))+time_utc*86400; end; -function wintimefloat:extended; +function monotimefloat:extended; begin result := mmqpctimefloat; 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 unixtimefloat_win8:float; +var + ft:tfiletime; + i:int64 absolute ft; +begin + 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 - result := wintimefloat+timefloatbias; + if not win8inited then initwin8; + if assigned(@GetSystemTimePreciseAsFileTime) then begin + result := unixtimefloat_win8; + exit; + 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; - 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 +615,7 @@ begin lastunixtimefloat := result; end; -function unixtimeint:integer; +function unixtimeint:tunixtimeint; begin result := trunc(unixtimefloat); end; @@ -477,20 +623,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 +697,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 +713,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,9 +729,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;