\r
type\r
float=extended;\r
+ tunixtimeint={$ifdef ver100}longint;{$else}int64;{$endif}\r
\r
const\r
colorburst=39375000/11; {3579545.4545....}\r
var\r
timezone:integer;\r
timezonestr:string;\r
- irctime,unixtime:integer;\r
+ irctime,unixtime:tunixtimeint;\r
tickcount:integer;\r
- settimebias:integer;\r
+ settimebias:tunixtimeint;\r
performancecountfreq:extended;\r
\r
function irctimefloat:float;\r
-function irctimeint:integer;\r
+function irctimeint:tunixtimeint;\r
\r
+//unix timestamp (UTC) float seconds\r
function unixtimefloat:float;\r
-function unixtimeint:integer;\r
+function unixtimeint:tunixtimeint;\r
\r
+//monotonic float seconds\r
+function monotimefloat:float;\r
+\r
+//monotonic (alias, old function name)\r
function wintimefloat:float;\r
\r
-procedure settime(newtime:integer);\r
+procedure settime(newtime:tunixtimeint);\r
procedure gettimezone;\r
procedure timehandler;\r
procedure init;\r
\r
-function timestring(i:integer):string;\r
-function timestrshort(i:integer):string;\r
+function timestring(i:tunixtimeint):string;\r
+function timestrshort(i:tunixtimeint):string;\r
\r
{$ifdef win32}\r
function unixtimefloat_systemtime:float;\r
{$endif}\r
\r
function oletounixfloat(t:float):float;\r
-function oletounix(t:tdatetime):integer;\r
+function oletounix(t:tdatetime):tunixtimeint;\r
function unixtoole(i:float):tdatetime;\r
\r
{$ifdef win32}\r
{$else}\r
baseunix,unix,unixutil,sockets, {unixutil and sockets needed by unixstuff.inc on some compiler versions}\r
{$endif}\r
+ {$ifdef linux}\r
+ dl,\r
+ {$endif}\r
{$else}\r
windows,unitsettc,mmsystem,\r
{$endif}\r
result := t;\r
end;\r
\r
-function oletounix(t:tdatetime):integer;\r
+function oletounix(t:tdatetime):tunixtimeint;\r
begin\r
result := trunc(oletounixfloat(t));\r
end;\r
result := tv.tv_sec+(tv.tv_usec/1000000);\r
end;\r
\r
-function wintimefloat:extended;\r
-begin\r
- result := unixtimefloat;\r
-end;\r
+{$ifdef linux}\r
+ {$define monotimefloat_implemented}\r
+ const\r
+ CLOCK_MONOTONIC = 1;\r
+ type \r
+ ptimeval = ^ttimeval;\r
+ tclock_gettime = function(clk_id: integer; tp: ptimeval): integer; cdecl;\r
+\r
+ var\r
+ librt_handle:pointer;\r
+ librt_inited:boolean;\r
+ clock_gettime: tclock_gettime;\r
+\r
+ function monotimefloat:float;\r
+ var\r
+ ts: ttimeval;\r
+ begin\r
+ if not librt_inited then begin\r
+ librt_inited := true;\r
+ clock_gettime := nil;\r
+ librt_handle := dlopen('librt.so', RTLD_LAZY);\r
+ if assigned(librt_handle) then begin\r
+ clock_gettime := dlsym(librt_handle, 'clock_gettime');\r
+ end;\r
+ end;\r
+ if assigned(clock_gettime) then begin\r
+ if clock_gettime(CLOCK_MONOTONIC, @ts) = 0 then begin\r
+ //note this really returns nanoseconds\r
+ result := ts.tv_sec + ts.tv_usec / 1000000000.0;\r
+ exit;\r
+ end;\r
+ end;\r
+ //fallback\r
+ result := unixtimefloat;\r
+ end;\r
+\r
+\r
+{$endif} {linux}\r
+\r
+{$ifdef darwin} {mac OS X}\r
+{$define monotimefloat_implemented}\r
+\r
+ type\r
+ tmach_timebase_info = packed record\r
+ numer: longint;\r
+ denom: longint;\r
+ end;\r
+ pmach_timebase_info = ^tmach_timebase_info;\r
+ \r
+ function mach_absolute_time: int64; cdecl; external;\r
+ function mach_timebase_info(info: pmach_timebase_info): integer; cdecl; external;\r
+\r
+ var\r
+ timebase_info: tmach_timebase_info;\r
+\r
+ function monotimefloat:float;\r
+ var\r
+ i:int64;\r
+ begin\r
+ if timebase_info.denom = 0 then begin\r
+ mach_timebase_info(@timebase_info);\r
+ end;\r
+ i := mach_absolute_time;\r
+ result := (i * timebase_info.numer div timebase_info.denom) / 1000000000.0;\r
+ end;\r
+\r
+{$endif} {darwin, mac OS X}\r
+\r
\r
-function unixtimeint:integer;\r
+{$ifndef monotimefloat_implemented} {fallback}\r
+ \r
+ function monotimefloat:extended;\r
+ begin\r
+ result := unixtimefloat;\r
+ end;\r
+\r
+{$endif} {monotimefloat fallback}\r
+\r
+\r
+function unixtimeint:tunixtimeint;\r
var\r
tv:ttimeval;\r
begin\r
result := tv.tv_sec;\r
end;\r
\r
+{------------------------------ end of *nix/freepascal section}\r
+\r
{$else} {delphi 3}\r
{------------------------------ windows/delphi code to read time}\r
\r
wrapduration=highdwordconst * 0.001;\r
var\r
i:integer;\r
+ temp:float;\r
begin\r
i := gettickcount; {timegettime}\r
if i < mmtime_last then begin\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
+ if (ticks_freq <> 0) and ticks_freq_known then begin\r
+ {the value we get is rounded to 1 ms, but the ticks are not a multiple of 1 ms\r
+ this makes the value noisy. use the known ticks frequency to restore the original value}\r
+ temp := int((result / ticks_freq)+0.5) * ticks_freq;\r
+\r
+ {if the known ticks freq is wrong (can happen), disable the un-rounding behavior\r
+ this will be a bit less accurate but it prevents problems}\r
+ if abs(temp - result) > 0.002 then begin\r
+ ticks_freq := 0;\r
+ end else result := temp;\r
+ end;\r
end;\r
\r
procedure measure_ticks_freq;\r
o:tosversioninfo;\r
isnt:boolean;\r
{ is9x:boolean;}\r
+ adjust1,adjust2:cardinal;\r
+ adjustbool:longbool;\r
begin\r
if (performancecountfreq = 0) then qpctimefloat;\r
ticks_freq_known := false;\r
\r
ticks_freq2 := f;\r
mmtime_synchedqpc := false;\r
- {\r
- NT 5 64 Hz (RTC)\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
- NT 6 64 Hz (HPET?)\r
- identify mode as: nt64\r
- QPC rate: TSC freq / 1000\r
- QPC synched to gettickcount: no\r
- duration between 2 ticks is constant: yes\r
- gettickcount tick duration: ~15.6001007 ms, ~64.102 Hz\r
-\r
- }\r
- if (f >= 0.014) and (f <= 0.018) and isnt then begin\r
- if (performancecountfreq = 3579545) or (performancecountfreq > 50000000) then begin\r
- {typical XP}\r
- ticks_freq := 1/64;\r
- end else begin\r
- {typical windows 7}\r
- ticks_freq := 0.0156001007;\r
- end;\r
- ticks_freq_known := true;\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
+ if (isnt and (o.dwMajorVersion >= 5)) then begin\r
+ {windows 2000 and later: query tick rate from OS in 100 ns units\r
+ typical rates: XP: 156250 or 100144, windows 7: 156001}\r
+ if GetSystemTimeAdjustment(adjust1,adjust2,adjustbool) then begin\r
+ ticks_freq := adjust1 / 10000000.0;\r
+ ticks_freq_known := true;\r
+ mmtime_synchedqpc := false;\r
+ end;\r
end;\r
\r
{9x}\r
result := oletounixfloat(int(date_utc+0.5))+time_utc*86400;\r
end;\r
\r
-function wintimefloat:extended;\r
+function monotimefloat:extended;\r
begin\r
result := mmqpctimefloat;\r
end;\r
var\r
f,g,h:float;\r
begin\r
- result := wintimefloat+timefloatbias;\r
+ result := monotimefloat+timefloatbias;\r
f := result-unixtimefloat_systemtime;\r
if ((f > ticks_freq2+margin) or (f < -margin)) or (timefloatbias = 0) then begin\r
// writeln('unixtimefloat init');\r
f := unixtimefloat_systemtime;\r
settc;\r
- repeat g := unixtimefloat_systemtime; h := wintimefloat until g > f;\r
+ repeat g := unixtimefloat_systemtime; h := monotimefloat until g > f;\r
unsettc;\r
timefloatbias := g-h;\r
result := unixtimefloat;\r
lastunixtimefloat := result;\r
end;\r
\r
-function unixtimeint:integer;\r
+function unixtimeint:tunixtimeint;\r
begin\r
result := trunc(unixtimefloat);\r
end;\r
{$endif}\r
{-----------------------------------------------end of platform specific}\r
\r
+function wintimefloat:float;\r
+begin\r
+ result := monotimefloat;\r
+end;\r
+\r
function irctimefloat:float;\r
begin\r
result := unixtimefloat+settimebias;\r
end;\r
\r
-function irctimeint:integer;\r
+function irctimeint:tunixtimeint;\r
begin\r
result := unixtimeint+settimebias;\r
end;\r
\r
\r
-procedure settime(newtime:integer);\r
+procedure settime(newtime:tunixtimeint);\r
var\r
- a:integer;\r
+ a:tunixtimeint;\r
begin\r
a := irctimeint-settimebias;\r
if newtime = 0 then settimebias := 0 else settimebias := newtime-a;\r
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
end;\r
\r
-function timestrshort(i:integer):string;\r
+function timestrshort(i:tunixtimeint):string;\r
const\r
weekday:array[0..6] of string[4]=('Thu','Fri','Sat','Sun','Mon','Tue','Wed');\r
month:array[0..11] of string[4]=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');\r
inttostr(y);\r
end;\r
\r
-function timestring(i:integer):string;\r
+function timestring(i:tunixtimeint):string;\r
const\r
weekday:array[0..6] of string[10]=('Thursday','Friday','Saturday','Sunday','Monday','Tuesday','Wednesday');\r
month:array[0..11] of string[10]=('January','February','March','April','May','June','July','August','September','October','November','December');\r
lcore.org gitweb / lcore.git / commitdiff