+{\r
+time float: gettickcount\r
+resolution: 9x: ~55 ms NT: 1/64th of a second\r
+guarantees: continuous without any jumps\r
+frequency base: same as system clock.\r
+epoch: system boot\r
+note: if called more than once per 49.7 days, 32 bits wrapping is compensated for and it keeps going on.\r
+note: i handle the timestamp as signed integer, but with the wrap compensation that works as well, and is faster\r
+}\r
+\r
+function mmtimefloat:float;\r
+const\r
+ wrapduration=highdwordconst * 0.001;\r
+var\r
+ i:integer;\r
+begin\r
+ i := gettickcount; {timegettime}\r
+ if i < mmtime_last then begin\r
+ mmtime_wrapadd := mmtime_wrapadd + wrapduration;\r
+ end;\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
+end;\r
+\r
+procedure measure_ticks_freq;\r
+var\r
+ f,g:float;\r
+ o:tosversioninfo;\r
+ isnt:boolean;\r
+ is9x:boolean;\r
+begin\r
+ if (performancecountfreq = 0) then qpctimefloat;\r
+ ticks_freq_known := false;\r
+ settc;\r
+ f := mmtimefloat;\r
+ repeat g := mmtimefloat until g > f;\r
+ unsettc;\r
+ f := g - f;\r
+ fillchar(o,sizeof(o),0);\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
+\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
+ 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
+ end;\r
+\r
+ {9x}\r
+ if (performancecountfreq = 1193182) and (g >= 0.050) and (g <= 0.060) then begin\r
+ ticks_freq_known := true;\r
+ ticks_freq := 65536 / (colorburst / 3);\r
+ mmtime_synchedqpc := true;\r
+ end;\r
+ ticks_freq_known := true;\r
+ if ticks_freq <> 0 then ticks_freq2 := ticks_freq;\r
+// writeln(formatfloat('0.000000',ticks_freq));\r
+end;\r
+\r
+{\r
+time float: QueryPerformanceCounter\r
+resolution: <1us\r
+guarantees: can have forward jumps depending on hardware. can have forward and backwards jitter on dual core.\r
+frequency base: on NT, not the system clock, drifts compared to it.\r
+epoch: system boot\r
+}\r
+function qpctimefloat:extended;\r
+var\r
+ p:packed record\r
+ lowpart:longint;\r
+ highpart:longint\r
+ end;\r
+ p2:tlargeinteger absolute p;\r
+ e:extended;\r
+begin\r
+ if performancecountfreq = 0 then begin\r
+ QueryPerformancefrequency(p2);\r
+ e := p.lowpart;\r
+ if e < 0 then e := e + highdwordconst;\r
+ performancecountfreq := ((p.highpart*highdwordconst)+e);\r
+ end;\r
+ queryperformancecounter(p2);\r
+ e := p.lowpart;\r
+ if e < 0 then e := e + highdwordconst;\r
+\r
+ result := ((p.highpart*highdwordconst)+e)/performancecountfreq;\r
+end;\r
+\r
+{\r
+time float: QPC locked to gettickcount\r
+resolution: <1us\r
+guarantees: continuous without any jumps\r
+frequency base: same as system clock.\r
+epoch: system boot\r
+}\r
+\r
+function mmqpctimefloat:float;\r
+const\r
+ maxretries=5;\r
+ margin=0.002;\r
+var\r
+ jump:float;\r
+ mm,f,qpc,newdrift,f1,f2:float;\r
+ qpcjumped:boolean;\r
+ a,b,c:integer;\r
+ retrycount:integer;\r
+begin\r
+ if not ticks_freq_known then measure_ticks_freq;\r
+ retrycount := maxretries;\r
+\r
+ qpc := qpctimefloat;\r
+ mm := mmtimefloat;\r
+ f := (qpc - mmtime_lastsyncqpc) * mmtime_drift + mmtime_lastsyncmm;\r
+ //writeln('XXXX ',formatfloat('0.000000',qpc-mm));\r
+ qpcjumped := ((f-mm) > ticks_freq2+margin) or ((f-mm) < -margin);\r
+// if qpcjumped then writeln('qpc jumped ',(f-mm));\r
+ if ((qpc > mmtime_nextdriftcorrection) and not mmtime_synchedqpc) or qpcjumped then begin\r
+\r
+ mmtime_nextdriftcorrection := qpc + 1;\r
+ repeat\r
+ mmtime_prev_drift := mmtime_drift;\r
+ mmtime_prev_lastsyncmm := mmtime_lastsyncmm;\r
+ mmtime_prev_lastsyncqpc := mmtime_lastsyncqpc;\r
+\r
+ mm := mmtimefloat;\r
+ dec(retrycount);\r
+ settc;\r
+ result := qpctimefloat;\r
+ f := mmtimefloat;\r
+ repeat\r
+ if f = mm then result := qpctimefloat;\r
+ f := mmtimefloat\r
+ until f > mm;\r
+ qpc := qpctimefloat;\r
+\r
+ unsettc;\r
+ if (qpc > result + 0.0001) then begin\r
+ continue;\r
+ end;\r
+ mm := f;\r
+\r
+ if (mmtime_lastsyncqpc <> 0) and not qpcjumped then begin\r
+ newdrift := (mm - mmtime_lastsyncmm) / (qpc - mmtime_lastsyncqpc);\r
+ mmtime_drift := newdrift;\r
+ { writeln('raw drift: ',formatfloat('0.00000000',mmtime_drift));}\r
+ move(mmtime_driftavg[0],mmtime_driftavg[1],sizeof(mmtime_driftavg[0])*high(mmtime_driftavg));\r
+ mmtime_driftavg[0] := mmtime_drift;\r
+\r
+{ write('averaging drift ',formatfloat('0.00000000',mmtime_drift),' -> ');}\r
+{ mmtime_drift := 0;}\r
+ b := 0;\r
+ for a := 0 to high(mmtime_driftavg) do begin\r
+ if mmtime_driftavg[a] <> 0 then inc(b);\r
+{ mmtime_drift := mmtime_drift + mmtime_driftavg[a];}\r
+ end;\r
+{ mmtime_drift := mmtime_drift / b;}\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
+{ writeln(formatfloat('0.00000000',mmtime_drift));}\r
+ if mmtime_synchedqpc then mmtime_drift := 1;\r
+ end;\r
+\r
+ mmtime_lastsyncqpc := qpc;\r
+ mmtime_lastsyncmm := mm;\r
+ { writeln(formatfloat('0.00000000',mmtime_drift));}\r
+ break;\r
+ until false;\r
+\r
+\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
+ 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
+\r
+ f := result;\r
+ end;\r
+\r
+ result := f;\r
+\r
+ if (result < mmtime_lastresult) then result := mmtime_lastresult + 0.000001;\r
+ mmtime_lastresult := result;\r
+end;\r
+\r
lcore.org gitweb / lcore.git / blobdiff