\r
\r
unit btime;\r
-\r
+{$ifdef fpc}\r
+ {$mode delphi}\r
+{$endif}\r
interface\r
\r
-{$ifdef win32}\r
+{$ifdef mswindows}\r
uses\r
ltimevalstuff;\r
{$endif} \r
\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; // Wednesday August 15 2012 -- 16:21:09 +02:00\r
+function timestrshort(i:tunixtimeint):string; // Wed Aug 15 16:21:09 2012\r
+function timestriso(i:tunixtimeint):string; // 2012-08-15 16:21:09\r
+function timestrisoutc(i:float):string; // 2012-08-15T14:21:09.255553Z\r
\r
-{$ifdef win32}\r
+{$ifdef mswindows}\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
+{$ifdef mswindows}\r
function mmtimefloat:float;\r
function qpctimefloat:float;\r
{$endif}\r
\r
-{$ifdef win32}\r
+{$ifdef mswindows}\r
procedure gettimeofday(var tv:ttimeval);\r
{$endif}\r
\r
\r
implementation\r
\r
-{$ifdef fpc}\r
- {$mode delphi}\r
-{$endif}\r
+\r
\r
uses\r
{$ifdef UNIX}\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
+ result := round(oletounixfloat(t));\r
end;\r
\r
function unixtoole(i:float):tdatetime;\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
-function unixtimeint:integer;\r
+{$endif} {darwin, mac OS X}\r
+\r
+\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 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
+ 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
- if (performancecountfreq = 1193182) and (g >= 0.050) and (g <= 0.060) then begin\r
+ if (performancecountfreq = 1193182) and (f >= 0.050) and (f <= 0.060) then begin\r
ticks_freq_known := true;\r
ticks_freq := 65536 / (colorburst / 3);\r
mmtime_synchedqpc := true;\r
\r
result := f;\r
\r
- if (result < mmtime_lastresult) then result := mmtime_lastresult + 0.000001;\r
+ if (result < mmtime_lastresult) then result := mmtime_lastresult;\r
mmtime_lastresult := result;\r
end;\r
\r
-{ free pascals tsystemtime is incomaptible with windows api calls\r
+{ free pascals tsystemtime is incompatible with windows api calls\r
so we declare it ourselves - plugwash\r
}\r
{$ifdef fpc}\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
\r
+\r
+\r
+var\r
+ GetSystemTimePreciseAsFileTime:procedure(var v:tfiletime); stdcall;\r
+ win8inited:boolean;\r
+\r
+procedure initwin8;\r
+var\r
+ dllhandle:thandle;\r
+\r
+begin\r
+ win8inited := true;\r
+ dllhandle := loadlibrary('kernel32.dll');\r
+ if (dllhandle <> 0) then begin\r
+ GetSystemTimePreciseAsFileTime := getprocaddress(dllhandle,'GetSystemTimePreciseAsFileTime');\r
+ end;\r
+end;\r
+\r
+\r
+function unixtimefloat_win8:float;\r
+var\r
+ ft:tfiletime;\r
+ i:int64 absolute ft;\r
+begin\r
+ GetSystemTimePreciseAsFileTime(ft);\r
+ {change from windows 1601-01-01 to unix 1970-01-01.\r
+ use integer math for this, to preserve precision}\r
+ dec(i, 116444736000000000);\r
+ result := (i / 10000000);\r
+end;\r
+\r
+\r
+\r
function unixtimefloat:float;\r
const\r
margin = 0.0012;\r
var\r
f,g,h:float;\r
begin\r
- result := wintimefloat+timefloatbias;\r
+ if not win8inited then initwin8;\r
+ if assigned(@GetSystemTimePreciseAsFileTime) then begin\r
+ result := unixtimefloat_win8;\r
+ exit;\r
+ end;\r
+\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
timezonestr;\r
end;\r
\r
+function timestriso(i:tunixtimeint):string;\r
+var\r
+ y,m,d,h,min,sec,ms:word;\r
+ t:tdatetime;\r
+begin\r
+ t := unixtoole(i+timezone);\r
+ decodedate(t,y,m,d);\r
+ decodetime(t,h,min,sec,ms);\r
+ 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);\r
+end;\r
+\r
+function timestrisoutc(i:float):string;\r
+var\r
+ y,m,d,h,min,sec,ms:word;\r
+ t:tdatetime;\r
+ fr:float;\r
+begin\r
+ t := unixtoole(i);\r
+ decodedate(t,y,m,d);\r
+ decodetime(t,h,min,sec,ms);\r
+ 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);\r
+ fr := frac(i);\r
+\r
+ result := result + '.'+\r
+ inttostr(trunc(fr*10) mod 10)+\r
+ inttostr(trunc(fr*100) mod 10)+\r
+ inttostr(trunc(fr*1000) mod 10)+\r
+ inttostr(trunc(fr*10000) mod 10)+\r
+ inttostr(trunc(fr*100000) mod 10)+\r
+ inttostr(trunc(fr*1000000) mod 10)+'Z';\r
+\r
+end;\r
+\r
+\r
procedure init;\r
begin\r
- {$ifdef win32}timebeginperiod(1);{$endif} //ensure stable unchanging clock\r
+ {$ifdef mswindows}timebeginperiod(1);{$endif} //ensure stable unchanging clock\r
fillchar(mmtime_driftavg,sizeof(mmtime_driftavg),0);\r
settimebias := 0;\r
gettimezone;\r
lcore.org gitweb / lcore.git / blobdiff