1 { Copyright (C) 2005 Bas Steendijk and Peter Green
\r
2 For conditions of distribution and use, see copyright notice in zlib_license.txt
\r
3 which is included in the package
\r
4 ----------------------------------------------------------------------------- }
\r
6 this unit returns unix timestamp with seconds and microseconds (as float)
\r
7 works on windows/delphi, and on freepascal on unix.
\r
24 colorburst=39375000/11; {3579545.4545....}
\r
29 irctime,unixtime:integer;
\r
31 settimebias:integer;
\r
32 performancecountfreq:extended;
\r
34 function irctimefloat:float;
\r
35 function irctimeint:integer;
\r
37 function unixtimefloat:float;
\r
38 function unixtimeint:integer;
\r
40 function wintimefloat:float;
\r
42 procedure settime(newtime:integer);
\r
43 procedure gettimezone;
\r
44 procedure timehandler;
\r
47 function timestring(i:integer):string;
\r
48 function timestrshort(i:integer):string;
\r
51 function unixtimefloat_systemtime:float;
\r
54 function oletounixfloat(t:float):float;
\r
55 function oletounix(t:tdatetime):integer;
\r
56 function unixtoole(i:integer):tdatetime;
\r
59 function mmtimefloat:float;
\r
60 function qpctimefloat:float;
\r
64 procedure gettimeofday(var tv:ttimeval);
\r
69 mmtime_driftavgsize=32;
\r
71 mmtime_warmupcyclelength=15;
\r
73 //this flag is to be set when btime has been running long enough to stabilise
\r
74 warmup_finished:boolean;
\r
76 timefloatbias:float;
\r
78 ticks_freq2:float=0;
\r
79 ticks_freq_known:boolean=false;
\r
80 lastunixtimefloat:float=0;
\r
81 lastsynctime:float=0;
\r
82 lastsyncbias:float=0;
\r
84 mmtime_last:integer=0;
\r
85 mmtime_wrapadd:float;
\r
86 mmtime_lastsyncmm:float=0;
\r
87 mmtime_lastsyncqpc:float=0;
\r
88 mmtime_drift:float=1;
\r
89 mmtime_lastresult:float;
\r
90 mmtime_nextdriftcorrection:float;
\r
91 mmtime_driftavg:array[0..mmtime_driftavgsize] of float;
\r
92 mmtime_synchedqpc:boolean;
\r
94 mmtime_prev_drift:float;
\r
95 mmtime_prev_lastsyncmm:float;
\r
96 mmtime_prev_lastsyncqpc:float;
\r
109 baseunix,unix,unixutil,sockets, {unixutil and sockets needed by unixstuff.inc on some compiler versions}
\r
112 windows,unitsettc,mmsystem,
\r
116 {$include unixstuff.inc}
\r
120 daysdifference=25569;
\r
122 function oletounixfloat(t:float):float;
\r
124 t := (t - daysdifference) * 86400;
\r
128 function oletounix(t:tdatetime):integer;
\r
130 result := trunc(oletounixfloat(t));
\r
133 function unixtoole(i:integer):tdatetime;
\r
135 result := ((i)/86400)+daysdifference;
\r
139 highdwordconst=65536.0 * 65536.0;
\r
141 function utrunc(f:float):integer;
\r
142 {converts float to integer, in 32 bits unsigned range}
\r
144 if f >= (highdwordconst/2) then f := f - highdwordconst;
\r
145 result := trunc(f);
\r
148 function uinttofloat(i:integer):float;
\r
149 {converts 32 bits unsigned integer to float}
\r
152 if result < 0 then result := result + highdwordconst;
\r
156 {-----------------------------------------*nix/freepascal code to read time }
\r
158 function unixtimefloat:float;
\r
163 result := tv.tv_sec+(tv.tv_usec/1000000);
\r
166 function wintimefloat:extended;
\r
168 result := unixtimefloat;
\r
171 function unixtimeint:integer;
\r
176 result := tv.tv_sec;
\r
180 {------------------------------ windows/delphi code to read time}
\r
183 {simulate gettimeofday on windows so one can always use gettimeofday if preferred}
\r
185 procedure gettimeofday(var tv:ttimeval);
\r
189 e := unixtimefloat;
\r
190 tv.tv_sec := round(int(e));
\r
191 tv.tv_usec := trunc(frac(e)*1000000);
\r
193 if (tv.tv_usec < 0) then tv.tv_usec := 0;
\r
194 if (tv.tv_usec > 999999) then tv.tv_usec := 999999;
\r
199 time float: gettickcount
\r
200 resolution: 9x: ~55 ms NT: 1/64th of a second
\r
201 guarantees: continuous without any jumps
\r
202 frequency base: same as system clock.
\r
204 note: if called more than once per 49.7 days, 32 bits wrapping is compensated for and it keeps going on.
\r
205 note: i handle the timestamp as signed integer, but with the wrap compensation that works as well, and is faster
\r
208 function mmtimefloat:float;
\r
210 wrapduration=highdwordconst * 0.001;
\r
214 i := gettickcount; {timegettime}
\r
215 if i < mmtime_last then begin
\r
216 mmtime_wrapadd := mmtime_wrapadd + wrapduration;
\r
219 result := mmtime_wrapadd + i * 0.001;
\r
221 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
224 procedure measure_ticks_freq;
\r
231 if (performancecountfreq = 0) then qpctimefloat;
\r
232 ticks_freq_known := false;
\r
235 repeat g := mmtimefloat until g > f;
\r
238 fillchar(o,sizeof(o),0);
\r
239 o.dwOSVersionInfoSize := sizeof(o);
\r
241 isnt := o.dwPlatformId = VER_PLATFORM_WIN32_NT;
\r
242 is9x := o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS;
\r
245 mmtime_synchedqpc := false;
\r
248 identify mode as: nt64
\r
249 QPC rate: either 3579545 or TSC freq
\r
250 QPC synched to gettickcount: no
\r
251 duration between 2 ticks is constant: yes
\r
252 gettickcount tick duration: 64 Hz
\r
254 if (f >= 0.014) and (f <= 0.018) and isnt then begin
\r
255 ticks_freq_known := true;
\r
256 ticks_freq := 1/64;
\r
257 mmtime_synchedqpc := false;
\r
262 identify mode as: nt100
\r
264 QPC synched to gettickcount: yes
\r
265 duration between 2 ticks is constant: no?
\r
266 gettickcount tick duration: ~99.85 Hz
\r
268 if (performancecountfreq = 1193182) and (f >= 0.008) and (f <= 0.012) and isnt then begin
\r
269 ticks_freq_known := true;
\r
270 ticks_freq2 := 11949 / (colorburst / 3);
\r
271 // ticks_freq2 := 11949 / 1193182;
\r
273 {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
274 mmtime_synchedqpc := true;
\r
278 if (performancecountfreq = 1193182) and (g >= 0.050) and (g <= 0.060) then begin
\r
279 ticks_freq_known := true;
\r
280 ticks_freq := 65536 / (colorburst / 3);
\r
281 mmtime_synchedqpc := true;
\r
283 ticks_freq_known := true;
\r
284 if ticks_freq <> 0 then ticks_freq2 := ticks_freq;
\r
285 // writeln(formatfloat('0.000000',ticks_freq));
\r
289 time float: QueryPerformanceCounter
\r
291 guarantees: can have forward jumps depending on hardware. can have forward and backwards jitter on dual core.
\r
292 frequency base: on NT, not the system clock, drifts compared to it.
\r
295 function qpctimefloat:extended;
\r
301 p2:tlargeinteger absolute p;
\r
304 if performancecountfreq = 0 then begin
\r
305 QueryPerformancefrequency(p2);
\r
307 if e < 0 then e := e + highdwordconst;
\r
308 performancecountfreq := ((p.highpart*highdwordconst)+e);
\r
310 queryperformancecounter(p2);
\r
312 if e < 0 then e := e + highdwordconst;
\r
314 result := ((p.highpart*highdwordconst)+e)/performancecountfreq;
\r
318 time float: QPC locked to gettickcount
\r
320 guarantees: continuous without any jumps
\r
321 frequency base: same as system clock.
\r
325 function mmqpctimefloat:float;
\r
331 mm,f,qpc,newdrift,f1,f2:float;
\r
334 retrycount:integer;
\r
336 if not ticks_freq_known then measure_ticks_freq;
\r
337 retrycount := maxretries;
\r
339 qpc := qpctimefloat;
\r
341 f := (qpc - mmtime_lastsyncqpc) * mmtime_drift + mmtime_lastsyncmm;
\r
342 //writeln('XXXX ',formatfloat('0.000000',qpc-mm));
\r
343 qpcjumped := ((f-mm) > ticks_freq2+margin) or ((f-mm) < -margin);
\r
344 // if qpcjumped then writeln('qpc jumped ',(f-mm));
\r
345 if ((qpc > mmtime_nextdriftcorrection) and not mmtime_synchedqpc) or qpcjumped then begin
\r
347 mmtime_nextdriftcorrection := qpc + 1;
\r
349 mmtime_prev_drift := mmtime_drift;
\r
350 mmtime_prev_lastsyncmm := mmtime_lastsyncmm;
\r
351 mmtime_prev_lastsyncqpc := mmtime_lastsyncqpc;
\r
356 result := qpctimefloat;
\r
359 if f = mm then result := qpctimefloat;
\r
362 qpc := qpctimefloat;
\r
365 if (qpc > result + 0.0001) then begin
\r
370 if (mmtime_lastsyncqpc <> 0) and not qpcjumped then begin
\r
371 newdrift := (mm - mmtime_lastsyncmm) / (qpc - mmtime_lastsyncqpc);
\r
372 mmtime_drift := newdrift;
\r
373 { writeln('raw drift: ',formatfloat('0.00000000',mmtime_drift));}
\r
374 move(mmtime_driftavg[0],mmtime_driftavg[1],sizeof(mmtime_driftavg[0])*high(mmtime_driftavg));
\r
375 mmtime_driftavg[0] := mmtime_drift;
\r
377 { write('averaging drift ',formatfloat('0.00000000',mmtime_drift),' -> ');}
\r
378 { mmtime_drift := 0;}
\r
380 for a := 0 to high(mmtime_driftavg) do begin
\r
381 if mmtime_driftavg[a] <> 0 then inc(b);
\r
382 { mmtime_drift := mmtime_drift + mmtime_driftavg[a];}
\r
384 { mmtime_drift := mmtime_drift / b;}
\r
385 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
386 mmtime_nextdriftcorrection := qpc + a;
\r
387 if (b >= 2) then warmup_finished := true;
\r
388 { writeln(formatfloat('0.00000000',mmtime_drift));}
\r
389 if mmtime_synchedqpc then mmtime_drift := 1;
\r
392 mmtime_lastsyncqpc := qpc;
\r
393 mmtime_lastsyncmm := mm;
\r
394 { writeln(formatfloat('0.00000000',mmtime_drift));}
\r
399 qpc := qpctimefloat;
\r
401 result := (qpc - mmtime_lastsyncqpc) * mmtime_drift + mmtime_lastsyncmm;
\r
402 f := (qpc - mmtime_prev_lastsyncqpc) * mmtime_prev_drift + mmtime_prev_lastsyncmm;
\r
405 {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
412 if (result < mmtime_lastresult) then result := mmtime_lastresult + 0.000001;
\r
413 mmtime_lastresult := result;
\r
416 { free pascals tsystemtime is incomaptible with windows api calls
\r
417 so we declare it ourselves - plugwash
\r
421 TSystemTime = record
\r
429 wMilliseconds: Word;
\r
432 function Date_utc: extended;
\r
434 SystemTime: TSystemTime;
\r
437 GetsystemTime(@SystemTime);
\r
439 GetsystemTime(SystemTime);
\r
441 with SystemTime do Result := EncodeDate(wYear, wMonth, wDay);
\r
444 function Time_utc: extended;
\r
446 SystemTime: TSystemTime;
\r
449 GetsystemTime(@SystemTime);
\r
451 GetsystemTime(SystemTime);
\r
454 Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);
\r
457 function Now_utc: extended;
\r
459 Result := round(Date_utc) + Time_utc;
\r
462 function unixtimefloat_systemtime:float;
\r
464 {result := oletounixfloat(now_utc);}
\r
466 {this method gives exactly the same result with extended precision, but is less sensitive to float rounding in theory}
\r
467 result := oletounixfloat(int(date_utc+0.5))+time_utc*86400;
\r
470 function wintimefloat:extended;
\r
472 result := mmqpctimefloat;
\r
475 function unixtimefloat:float;
\r
481 result := wintimefloat+timefloatbias;
\r
482 f := result-unixtimefloat_systemtime;
\r
483 if ((f > ticks_freq2+margin) or (f < -margin)) or (timefloatbias = 0) then begin
\r
484 // writeln('unixtimefloat init');
\r
485 f := unixtimefloat_systemtime;
\r
487 repeat g := unixtimefloat_systemtime; h := wintimefloat until g > f;
\r
489 timefloatbias := g-h;
\r
490 result := unixtimefloat;
\r
493 {for small changes backwards, guarantee no steps backwards}
\r
494 if (result <= lastunixtimefloat) and (result > lastunixtimefloat-1.5) then result := lastunixtimefloat + 0.0000001;
\r
495 lastunixtimefloat := result;
\r
498 function unixtimeint:integer;
\r
500 result := trunc(unixtimefloat);
\r
504 {-----------------------------------------------end of platform specific}
\r
506 function irctimefloat:float;
\r
508 result := unixtimefloat+settimebias;
\r
511 function irctimeint:integer;
\r
513 result := unixtimeint+settimebias;
\r
517 procedure settime(newtime:integer);
\r
521 a := irctimeint-settimebias;
\r
522 if newtime = 0 then settimebias := 0 else settimebias := newtime-a;
\r
524 irctime := irctimeint;
\r
527 procedure timehandler;
\r
529 if unixtime = 0 then init;
\r
530 unixtime := unixtimeint;
\r
531 irctime := irctimeint;
\r
532 if unixtime and 63 = 0 then begin
\r
533 {update everything, apply timezone changes, clock changes, etc}
\r
535 timefloatbias := 0;
\r
536 unixtime := unixtimeint;
\r
537 irctime := irctimeint;
\r
542 procedure gettimezone;
\r
558 timezone := tzseconds;
\r
561 timezone := (longint(hh) * 3600 + mm * 60 + ss) - (unixtimeint mod 86400);
\r
564 timezone := round((now-now_utc)*86400);
\r
567 while timezone > 43200 do dec(timezone,86400);
\r
568 while timezone < -43200 do inc(timezone,86400);
\r
570 if timezone >= 0 then timezonestr := '+' else timezonestr := '-';
\r
571 l := abs(timezone) div 60;
\r
572 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);
\r
575 function timestrshort(i:integer):string;
\r
577 weekday:array[0..6] of string[4]=('Thu','Fri','Sat','Sun','Mon','Tue','Wed');
\r
578 month:array[0..11] of string[4]=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
\r
580 y,m,d,h,min,sec,ms:word;
\r
583 t := unixtoole(i+timezone);
\r
584 decodedate(t,y,m,d);
\r
585 decodetime(t,h,min,sec,ms);
\r
586 result := weekday[(i+timezone) div 86400 mod 7]+' '+month[m-1]+' '+inttostr(d)+' '+
\r
587 inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10)+' '+
\r
591 function timestring(i:integer):string;
\r
593 weekday:array[0..6] of string[10]=('Thursday','Friday','Saturday','Sunday','Monday','Tuesday','Wednesday');
\r
594 month:array[0..11] of string[10]=('January','February','March','April','May','June','July','August','September','October','November','December');
\r
596 y,m,d,h,min,sec,ms:word;
\r
599 t := unixtoole(i+timezone);
\r
600 decodedate(t,y,m,d);
\r
601 decodetime(t,h,min,sec,ms);
\r
602 result := weekday[(i+timezone) div 86400 mod 7]+' '+month[m-1]+' '+inttostr(d)+' '+inttostr(y)+' -- '+
\r
603 inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10)+' '+
\r
609 {$ifdef win32}timebeginperiod(1);{$endif} //ensure stable unchanging clock
\r
610 fillchar(mmtime_driftavg,sizeof(mmtime_driftavg),0);
\r
613 unixtime := unixtimeint;
\r
614 irctime := irctimeint;
\r
617 initialization init;
\r