\r
\r
unit btime;\r
+{$ifdef fpc}\r
+ {$mode delphi}\r
+{$endif}\r
+\r
+{$include lcoreconfig.inc}\r
\r
interface\r
\r
-{$ifdef win32}\r
+{$ifdef mswindows}\r
uses\r
ltimevalstuff;\r
{$endif} \r
tickcount:integer;\r
settimebias:tunixtimeint;\r
performancecountfreq:extended;\r
+ btimenowin8:boolean;\r
\r
function irctimefloat:float;\r
function irctimeint:tunixtimeint;\r
procedure timehandler;\r
procedure init;\r
\r
-function timestring(i:tunixtimeint):string;\r
-function timestrshort(i:tunixtimeint):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
+procedure beginhightimerrate;\r
+procedure endhightimerrate;\r
\r
-{$ifdef win32}\r
+{$ifdef mswindows}\r
function unixtimefloat_systemtime:float;\r
{$endif}\r
\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
{$ifdef VER1_0}\r
linux,\r
{$else}\r
+ {$ifdef linux}linux,{$endif} //for clock_gettime\r
+ {$ifdef freebsd}freebsd,{$endif} //for clock_gettime\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
\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
function unixtimefloat:float;\r
var\r
tv:ttimeval;\r
+ sec:tunixtimeint;\r
begin\r
gettimeofday(tv);\r
- result := tv.tv_sec+(tv.tv_usec/1000000);\r
+ sec := tv.tv_sec;\r
+ {$ifndef cpu64}\r
+ if (sec < -1) then inc(sec,$100000000); //tv_sec is 32 bits. allow -1 for invalid result\r
+ {$endif}\r
+ result := sec+(tv.tv_usec/1000000);\r
end;\r
\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
+{$ifdef linux}{$define have_clock_gettime}{$endif}\r
+{$ifdef freebsd}{$define have_clock_gettime}{$endif}\r
\r
- var\r
- librt_handle:pointer;\r
- librt_inited:boolean;\r
- clock_gettime: tclock_gettime;\r
+{$ifdef have_clock_gettime}\r
+ {$define monotimefloat_implemented}\r
\r
function monotimefloat:float;\r
var\r
- ts: ttimeval;\r
+ ts: ttimespec;\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
+ if clock_gettime(CLOCK_MONOTONIC, @ts) = 0 then begin\r
+ //note this really returns nanoseconds\r
+ result := ts.tv_sec + ts.tv_nsec / 1000000000.0;\r
+ exit;\r
end;\r
//fallback\r
result := unixtimefloat;\r
end;\r
\r
\r
-{$endif} {linux}\r
+{$endif}\r
\r
{$ifdef darwin} {mac OS X}\r
{$define monotimefloat_implemented}\r
function unixtimeint:tunixtimeint;\r
var\r
tv:ttimeval;\r
+ sec:tunixtimeint;\r
begin\r
gettimeofday(tv);\r
- result := tv.tv_sec;\r
+ sec := tv.tv_sec;\r
+ {$ifndef cpu64}\r
+ if (sec < 0) then inc(sec,$100000000); //tv_sec is 32 bits\r
+ {$endif}\r
+ result := sec;\r
end;\r
\r
{------------------------------ end of *nix/freepascal section}\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 := 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
+ if not btimenowin8 then begin\r
+ if not win8inited then initwin8;\r
+ if assigned(@GetSystemTimePreciseAsFileTime) then begin\r
+ result := unixtimefloat_win8;\r
+ exit;\r
+ end; \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
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
+procedure beginhightimerrate;\r
+begin\r
+ {$ifdef mswindows}timebeginperiod(1);{$endif}\r
+end;\r
+\r
+procedure endhightimerrate;\r
+begin\r
+ {$ifdef mswindows}timeendperiod(1);{$endif}\r
+end;\r
+\r
procedure init;\r
begin\r
- {$ifdef win32}timebeginperiod(1);{$endif} //ensure stable unchanging clock\r
+ {$ifdef btimehighrate}beginhightimerrate;{$endif}\r
fillchar(mmtime_driftavg,sizeof(mmtime_driftavg),0);\r
settimebias := 0;\r
gettimezone;\r
lcore.org gitweb / lcore.git / blobdiff