X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/4782a5c5afee47721cc617daa40dd29828342c2b..c04d5150e9097138a24534447acb8aec17acab19:/btime.pas?ds=sidebyside diff --git a/btime.pas b/btime.pas index 3d672c4..4636a9b 100755 --- a/btime.pas +++ b/btime.pas @@ -7,6 +7,7 @@ this unit returns unix timestamp with seconds and microseconds (as float) works on windows/delphi, and on freepascal on unix. } + unit btime; interface @@ -14,13 +15,15 @@ interface type float=extended; +const + colorburst=39375000/11; {3579545.4545....} + var timezone:integer; timezonestr:string; irctime,unixtime:integer; tickcount:integer; settimebias:integer; - qpcjump:float; {can be read out and reset for debug purpose} performancecountfreq:extended; function irctimefloat:float; @@ -39,13 +42,48 @@ procedure init; function timestring(i:integer):string; function timestrshort(i:integer):string; +{$ifdef win32} +function unixtimefloat_systemtime:float; +{$endif} + function oletounixfloat(t:float):float; function oletounix(t:tdatetime):integer; function unixtoole(i:integer):tdatetime; +{$ifdef win32} +function mmtimefloat:float; +function qpctimefloat:float; +{$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 @@ -58,10 +96,10 @@ uses {$ifdef VER1_0} linux, {$else} - baseunix,unix,unixutil,{needed for 2.0.2} + baseunix,unix,unixutil, {needed for 2.0.2} {$endif} {$else} - windows, + windows,unitsettc,mmsystem, {$endif} sysutils; @@ -87,6 +125,23 @@ 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 } @@ -114,6 +169,224 @@ end; {$else} {delphi 3} {------------------------------ windows/delphi code to read time} +{ +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; +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 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 +end; + +procedure measure_ticks_freq; +var + f,g:float; + o:tosversioninfo; + isnt:boolean; + is9x:boolean; +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; + { + 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; + end; + + {9x} + if (performancecountfreq = 1193182) and (g >= 0.050) and (g <= 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,f1,f2:float; + qpcjumped:boolean; + a,b,c: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;} + 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 + 0.000001; + mmtime_lastresult := result; +end; + { free pascals tsystemtime is incomaptible with windows api calls so we declare it ourselves - plugwash } @@ -160,84 +433,39 @@ begin Result := round(Date_utc) + Time_utc; end; -const - highdwordconst=4294967296.0; - -function wintimefloat: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; - -var - classpriority,threadpriority:integer; - -procedure settc; -var - hprocess,hthread:integer; +function unixtimefloat_systemtime:float; begin - hProcess := GetCurrentProcess; - hThread := GetCurrentThread; - - ClassPriority := GetPriorityClass(hProcess); - ThreadPriority := GetThreadPriority(hThread); + {result := oletounixfloat(now_utc);} - SetPriorityClass(hProcess, REALTIME_PRIORITY_CLASS); - SetThreadPriority(hThread, THREAD_PRIORITY_TIME_CRITICAL); + {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; -procedure unsettc; -var - hprocess,hthread:integer; +function wintimefloat:extended; begin - hProcess := GetCurrentProcess; - hThread := GetCurrentThread; - - SetPriorityClass(hProcess, ClassPriority); - SetThreadPriority(hThread, ThreadPriority); + result := mmqpctimefloat; end; function unixtimefloat:float; +const + margin = 0.0012; var f,g,h:float; begin - if timefloatbias = 0 then begin + result := wintimefloat+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 := wintimefloat 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; @@ -352,11 +580,14 @@ end; procedure init; begin - qpcjump := 0; + {$ifdef win32}timebeginperiod(1);{$endif} //ensure stable unchanging clock + fillchar(mmtime_driftavg,sizeof(mmtime_driftavg),0); settimebias := 0; gettimezone; unixtime := unixtimeint; irctime := irctimeint; end; +initialization init; + end.