which is included in the package\r
----------------------------------------------------------------------------- }\r
{\r
-this unit returns unix timestamp with seconds and microseconds (as float)\r
-works on windows/delphi, and on freepascal on unix.\r
+this unit has several functions for getting unix and monotonic time and UTC offset on both windows and linux/unix\r
+\r
+this unit aims to work on delphi 6 and later, both x86 and x64, on win95 and later\r
+delphi 5 may work (untested).\r
+as well as freepascal on linux x86 and x64 and freebsd x64 (tested), windows, and other unixes (untested)\r
+\r
+provided functions. all are available on both windows and linux/unix:\r
+- unix timestamp as a (double or extended) float or integer: unixtimefloat, unixtimeint\r
+- monotonic timestamp as float: monotimefloat, wintimefloat (both are equivalent)\r
+- _coarse versions of the floats, which can be faster, and precision in the milliseconds.\r
+- btime_gettime: a unified function like clock_gettime. less reliant on floats.\r
+- tzgetoffset returns the UTC offset (timezone) in seconds\r
+\r
+- on windows, it provides the legacy function gettimeofday (on unix, use the one provided by the OS units)\r
+\r
+other things in the interface are often more implementation specific, there for legacy reasons, and not guaranteed stable\r
+\r
+this unit should be 2038 safe:\r
+- seconds are handled as 64 bits\r
+- on 32 bits linux, it uses clock_gettime64 if available \r
+- for getting the UTC offset on unix, this unit does its own, 64 bits aware, parsing of the zoneinfo file \r
+- tested with clock set after 2038\r
}\r
\r
\r
{$ifdef mswindows}\r
uses\r
ltimevalstuff;\r
-{$endif} \r
+{$endif}\r
+\r
+{$ifdef linux}\r
+uses\r
+ linux,syscall;\r
+{$endif}\r
+\r
+{$ifdef freebsd}\r
+uses\r
+ freebsd;\r
+{$endif}\r
+\r
+{$ifdef FPC_HAS_TYPE_EXTENDED}{$define has_extended}{$endif}\r
+{$ifndef fpc}{$ifdef cpu386}{$define has_extended}{$endif}{$endif}\r
\r
type\r
+ {$ifdef has_extended}\r
float=extended;\r
- tunixtimeint={$ifdef ver100}longint;{$else}int64;{$endif}\r
+ {$else}\r
+ float=double;\r
+ {$endif}\r
+ tunixtimeint=int64;\r
\r
const\r
colorburst=39375000/11; {3579545.4545....}\r
\r
+ {\r
+ CLOCK_MONOTONIC is the standard monotonic time offered by the OS, it may or may not include suspend time\r
+ CLOCK_BOOTTIME includes suspend time.\r
+ CLOCK_UPTIME excludes suspend time.\r
+ }\r
+\r
+ {$ifdef mswindows}\r
+ CLOCK_REALTIME=0;\r
+ CLOCK_MONOTONIC=1;\r
+ CLOCK_REALTIME_COARSE=2;\r
+ CLOCK_MONOTONIC_COARSE=3;\r
+ CLOCK_BOOTTIME=CLOCK_MONOTONIC; //GetTickCount\r
+ CLOCK_UPTIME=4; //QueryUnbiasedInterruptTime, fallback to QueryPerformanceCounter\r
+ CLOCK_UPTIME_FAST=CLOCK_UPTIME;\r
+ {$endif}\r
+\r
+ {$ifdef linux}\r
+ CLOCK_REALTIME=linux.CLOCK_REALTIME;\r
+ CLOCK_MONOTONIC=linux.CLOCK_MONOTONIC;\r
+ CLOCK_REALTIME_COARSE=linux.CLOCK_REALTIME_COARSE;\r
+ CLOCK_MONOTONIC_COARSE=linux.CLOCK_MONOTONIC_COARSE;\r
+ CLOCK_BOOTTIME=7; //linux.CLOCK_BOOTTIME - constant missing in freepascal\r
+ CLOCK_UPTIME=CLOCK_MONOTONIC;\r
+ CLOCK_UPTIME_FAST=CLOCK_MONOTONIC_COARSE;\r
+ {$endif}\r
+\r
+ {$ifdef freebsd}\r
+ CLOCK_REALTIME=freebsd.CLOCK_REALTIME;\r
+ CLOCK_MONOTONIC=freebsd.CLOCK_MONOTONIC;\r
+ CLOCK_REALTIME_COARSE=freebsd.CLOCK_REALTIME_FAST;\r
+ CLOCK_MONOTONIC_COARSE=freebsd.CLOCK_MONOTONIC_FAST;\r
+ CLOCK_BOOTTIME=CLOCK_MONOTONIC;\r
+ CLOCK_UPTIME=freebsd.CLOCK_UPTIME;\r
+ CLOCK_UPTIME_FAST=freebsd.CLOCK_UPTIME_FAST;\r
+ {$endif}\r
+\r
+ {$ifdef darwin}\r
+ CLOCK_REALTIME=0; //values taken from darwin libc time.h\r
+ CLOCK_MONOTONIC=6;\r
+ CLOCK_REALTIME_COARSE=CLOCK_REALTIME; //darwin lacks these or equivalents\r
+ CLOCK_MONOTONIC_COARSE=CLOCK_MONOTONIC;\r
+ CLOCK_BOOTTIME=CLOCK_MONOTONIC;\r
+ CLOCK_UPTIME_RAW=8;\r
+ CLOCK_UPTIME=CLOCK_UPTIME_RAW;\r
+ CLOCK_UPTIME_FAST=CLOCK_UPTIME_RAW;\r
+ {$endif}\r
+\r
+ CLOCK_REALTIME_FAST=CLOCK_REALTIME_COARSE;\r
+ CLOCK_MONOTONIC_FAST=CLOCK_MONOTONIC_COARSE;\r
+\r
+\r
var\r
timezone:integer;\r
timezonestr:string;\r
irctime,unixtime:tunixtimeint;\r
tickcount:integer;\r
settimebias:tunixtimeint;\r
- performancecountfreq:extended;\r
+ performancecountfreq:int64;\r
+ performancecountstep:float;\r
+\r
btimenowin8:boolean;\r
\r
function irctimefloat:float;\r
//monotonic float seconds\r
function monotimefloat:float;\r
\r
+//coarse float seconds - usually faster, but a resolution in the milliseconds\r
+function unixtimefloat_coarse:float;\r
+function monotimefloat_coarse:float;\r
+\r
+//float versions of CLOCK_BOOTTIME and CLOCK_UPTIME\r
+function boottimefloat:float;\r
+function uptimefloat:float;\r
+\r
//monotonic (alias, old function name)\r
function wintimefloat:float;\r
\r
+//get localtime vs UTC offset in seconds\r
+function tzgetoffset:integer;\r
+\r
procedure settime(newtime:tunixtimeint);\r
procedure gettimezone;\r
procedure timehandler;\r
\r
{$ifdef mswindows}\r
function mmtimefloat:float;\r
+function mmtimeint64:int64;\r
function qpctimefloat:float;\r
{$endif}\r
\r
{$ifdef mswindows}\r
-procedure gettimeofday(var tv:ttimeval);\r
+function gettimeofday(var tv:ttimeval):integer;\r
{$endif}\r
\r
\r
lastsyncbias:float=0;\r
\r
mmtime_last:integer=0;\r
- mmtime_wrapadd:float;\r
+ mmtime_wrapadd:int64;\r
mmtime_lastsyncmm:float=0;\r
mmtime_lastsyncqpc:float=0;\r
mmtime_drift:float=1;\r
mmtime_prev_lastsyncmm:float;\r
mmtime_prev_lastsyncqpc:float;\r
\r
-implementation\r
+ gettime64_nosupport_cached:boolean;\r
+ coarse_nosupport_cached:boolean;\r
\r
+type\r
+ //i define my own "timespec" and "gettime" because that way, they can be 64 bits even if the real one is 32 bits, and avoid the wrong one being used.\r
+ //tbtimespec can't be changed because it is passed as-is to clock_gettime64\r
+ tbtimespec=packed record\r
+ tv_sec:int64;\r
+ tv_nsec:int64;\r
+ end;\r
+ pbtimespec=^tbtimespec;\r
\r
\r
+//on unix, btime_gettime is the "inner" function that calls the actual OS/library functions, and other functions in btime call it\r
+//on windows, btime_gettime is an "outer" function that calls the other functions. so if not called by the app, it does not add to exe size.\r
+function btime_gettime(clockid:integer;tp:pbtimespec):integer;\r
+\r
+implementation\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
{$else}\r
result := ((i)/86400)+daysdifference;\r
end;\r
\r
-const\r
- highdwordconst=65536.0 * 65536.0;\r
-\r
-function utrunc(f:float):integer;\r
-{converts float to integer, in 32 bits unsigned range}\r
-begin\r
- if f >= (highdwordconst/2) then f := f - highdwordconst;\r
- result := trunc(f);\r
-end;\r
-\r
-function uinttofloat(i:integer):float;\r
-{converts 32 bits unsigned integer to float}\r
-begin\r
- result := i;\r
- if result < 0 then result := result + highdwordconst;\r
-end;\r
-\r
{$ifdef unix}\r
{-----------------------------------------*nix/freepascal code to read time }\r
\r
-function unixtimefloat:float;\r
-var\r
- tv:ttimeval;\r
- sec:tunixtimeint;\r
-begin\r
- gettimeofday(tv);\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}{$define have_clock_gettime}{$endif}\r
{$ifdef freebsd}{$define have_clock_gettime}{$endif}\r
\r
-{$ifdef have_clock_gettime}\r
- {$define monotimefloat_implemented}\r
+{$ifdef linux}\r
+ {$ifdef cpu386}{$define use_syscall_gettime64}{$endif}\r
+ {$ifdef cpu32}{$define use_syscall_gettime64}{$endif}\r
\r
- function monotimefloat:float;\r
- var\r
- ts: ttimespec;\r
- begin\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
+ {$ifdef use_syscall_gettime64}\r
+const\r
+ clock_gettime64=403;\r
+ {$endif}\r
+{$endif} //linux\r
\r
\r
-{$endif}\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
+ numer: cardinal;\r
+ denom: cardinal;\r
end;\r
pmach_timebase_info = ^tmach_timebase_info;\r
- \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
+{$endif} //darwin\r
\r
- function monotimefloat:float;\r
- var\r
- i:int64;\r
- begin\r
+\r
+function btime_gettime(clockid:integer;tp:pbtimespec):integer;\r
+var\r
+{$ifdef have_clock_gettime}\r
+ ts: ttimespec;\r
+{$endif}\r
+ tv: ttimeval;\r
+{$ifdef darwin}\r
+ nanos:int64;\r
+ nanosf:extended;\r
+{$endif}\r
+\r
+begin\r
+ result := -1; //error\r
+\r
+ {$ifdef darwin}\r
+ if (clockid = CLOCK_MONOTONIC) or (clockid = CLOCK_MONOTONIC_COARSE) then 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
+ if (timebase_info.denom > 0) then begin\r
+ nanos := mach_absolute_time;\r
+ if (nanos > 0) then begin\r
+ result := 0; //indicate success\r
+ if (timebase_info.denom > 10) then begin\r
+ //on powerpc mac, numer and denom are large numbers such as 1000000000 and 33333335, and extended is available\r
+ nanosf := nanos;\r
+ nanosf := (nanosf * timebase_info.numer) / timebase_info.denom;\r
+ nanos := trunc(nanosf);\r
+ end else begin\r
+ //on intel mac, numer and denom are 1 and 1. on apple silicon they are typically 125 and 3, and extended is not available\r
+ nanos := nanos div timebase_info.denom;\r
+ nanos := nanos * timebase_info.numer;\r
+ end;\r
+ tp.tv_sec := nanos div 1000000000;\r
+ tp.tv_nsec := nanos mod 1000000000;\r
+ exit;\r
+ end;\r
+ end;\r
end;\r
+ {$endif} //darwin\r
\r
-{$endif} {darwin, mac OS X}\r
+ if (coarse_nosupport_cached) then begin\r
+ if (clockid = CLOCK_REALTIME_COARSE) then clockid := CLOCK_REALTIME;\r
+ if (clockid = CLOCK_MONOTONIC_COARSE) then clockid := CLOCK_MONOTONIC;\r
+ end;\r
\r
+ {$ifdef use_syscall_gettime64}\r
+ //don't do this for monotonic for performance reasons\r
+ //the clock_gettime call below has the potential to be handled by libc, and then it is faster\r
+ //also if it failed, don't call it again to avoid slowdown of doing two calls every time\r
+ if (not ((clockid = CLOCK_MONOTONIC) or (clockid = CLOCK_MONOTONIC_COARSE) or (clockid = CLOCK_BOOTTIME) or (clockid = CLOCK_UPTIME))) and (not gettime64_nosupport_cached) then begin\r
+ result := do_syscall(clock_gettime64,clockid,tsysparam(tp));\r
\r
-{$ifndef monotimefloat_implemented} {fallback}\r
- \r
- function monotimefloat:extended;\r
- begin\r
- result := unixtimefloat;\r
+ if ((clockid = CLOCK_REALTIME) or (clockid = CLOCK_REALTIME_COARSE)) and (result <> 0) then gettime64_nosupport_cached := true;\r
+\r
+ if (result = 0) then exit;\r
+ end;\r
+ {$endif}\r
+\r
+ {$ifdef have_clock_gettime}\r
+ result := clock_gettime(clockid, @ts);\r
+ if (result <> 0) then begin\r
+ //fallback\r
+ if (clockid = CLOCK_REALTIME_COARSE) then begin\r
+ coarse_nosupport_cached := true;\r
+ result := clock_gettime(CLOCK_REALTIME, @ts);\r
+ end else\r
+ if (clockid = CLOCK_MONOTONIC_COARSE) then begin\r
+ coarse_nosupport_cached := true;\r
+ result := clock_gettime(CLOCK_MONOTONIC, @ts);\r
+ end;\r
end;\r
+ if (result = 0) then begin\r
+ tp.tv_sec := ts.tv_sec;\r
+ tp.tv_nsec := ts.tv_nsec;\r
\r
-{$endif} {monotimefloat fallback}\r
+ {$ifndef cpu64}\r
+ if (tp.tv_sec < -1) then inc(tp.tv_sec, $100000000);\r
+ {$endif}\r
+\r
+ exit;\r
+ end;\r
+ {$endif} //have_clock_gettime\r
+\r
+ result := gettimeofday(tv);\r
+ if (result = 0) then begin\r
+ tp.tv_sec := tv.tv_sec;\r
+ tp.tv_nsec := tv.tv_usec * 1000;\r
+\r
+ {$ifndef cpu64}\r
+ if (tp.tv_sec < -1) then inc(tp.tv_sec, $100000000);\r
+ {$endif}\r
+ end;\r
+end;\r
+\r
+\r
+function unixtimefloat:float;\r
+var\r
+ ts:tbtimespec;\r
+begin\r
+ btime_gettime(CLOCK_REALTIME, @ts);\r
+ //doing the below as a division causes a bug in fpc 3.2.0 x64, where the result becomes single precision\r
+ result := ts.tv_sec + (ts.tv_nsec * 0.000000001);\r
+end;\r
+\r
+\r
+function monotimefloat:float;\r
+var\r
+ ts:tbtimespec;\r
+begin\r
+ btime_gettime(CLOCK_MONOTONIC, @ts);\r
+ result := ts.tv_sec + (ts.tv_nsec * 0.000000001);\r
+end;\r
+\r
+\r
+function unixtimefloat_coarse:float;\r
+var\r
+ ts:tbtimespec;\r
+begin\r
+ btime_gettime(CLOCK_REALTIME_COARSE, @ts);\r
+ result := ts.tv_sec + (ts.tv_nsec * 0.000000001);\r
+end;\r
+\r
+\r
+function monotimefloat_coarse:float;\r
+var\r
+ ts:tbtimespec;\r
+begin\r
+ btime_gettime(CLOCK_MONOTONIC_COARSE, @ts);\r
+ result := ts.tv_sec + (ts.tv_nsec * 0.000000001);\r
+end;\r
+\r
+\r
+function boottimefloat:float;\r
+var\r
+ ts:tbtimespec;\r
+begin\r
+ btime_gettime(CLOCK_BOOTTIME, @ts);\r
+ result := ts.tv_sec + (ts.tv_nsec * 0.000000001);\r
+end;\r
+\r
+\r
+function uptimefloat:float;\r
+var\r
+ ts:tbtimespec;\r
+begin\r
+ btime_gettime(CLOCK_UPTIME, @ts);\r
+ result := ts.tv_sec + (ts.tv_nsec * 0.000000001);\r
+end;\r
\r
\r
function unixtimeint:tunixtimeint;\r
var\r
- tv:ttimeval;\r
- sec:tunixtimeint;\r
+ ts:tbtimespec;\r
begin\r
- gettimeofday(tv);\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;\r
+ btime_gettime(CLOCK_REALTIME,@ts);\r
+ result := ts.tv_sec;\r
end;\r
\r
{------------------------------ end of *nix/freepascal section}\r
\r
-{$else} {windows}\r
+{$endif} //unix\r
+\r
+{$ifdef mswindows}\r
{------------------------------ windows/delphi code to read time}\r
\r
\r
gettimezone;\r
end;\r
\r
-{simulate gettimeofday on windows so one can always use gettimeofday if preferred}\r
\r
-procedure gettimeofday(var tv:ttimeval);\r
var\r
- e:extended;\r
+ GetTickCount64:function:int64; stdcall;\r
+ gettickcount64_inited:boolean;\r
+\r
+procedure init_gettickcount64;\r
+var\r
+ dllhandle:thandle;\r
begin\r
- e := unixtimefloat;\r
- tv.tv_sec := round(int(e));\r
- tv.tv_usec := trunc(frac(e)*1000000);\r
- {just in case}\r
- if (tv.tv_usec < 0) then tv.tv_usec := 0;\r
- if (tv.tv_usec > 999999) then tv.tv_usec := 999999;\r
+ gettickcount64_inited := true;\r
+ dllhandle := loadlibrary('kernel32.dll');\r
+ if (dllhandle <> 0) then begin\r
+ GetTickCount64 := getprocaddress(dllhandle,'GetTickCount64');\r
+ end;\r
+end;\r
+\r
+\r
+\r
+function mmtimeint64:int64;\r
+var\r
+ i:int64;\r
+begin\r
+ if not gettickcount64_inited then init_gettickcount64;\r
+ if assigned(GetTickCount64) then begin\r
+ result := GetTickCount64;\r
+ end else begin\r
+ i := gettickcount;\r
+ if i < mmtime_last then begin\r
+ mmtime_wrapadd := mmtime_wrapadd + $100000000;\r
+ end;\r
+ mmtime_last := i;\r
+ result := mmtime_wrapadd + i;\r
+ end;\r
end;\r
\r
\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
temp:float;\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
+ result := mmtimeint64 * 0.001;\r
\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
end;\r
end;\r
\r
+var\r
+ win_version_known:boolean;\r
+ win_isnt:boolean;\r
+ win_ver_major:integer;\r
+ win_ver_minor:integer;\r
+\r
+procedure init_win_version;\r
+var\r
+ o:tosversioninfo;\r
+begin\r
+ if not win_version_known then begin\r
+ win_version_known := true;\r
+ fillchar(o,sizeof(o),0);\r
+ o.dwOSVersionInfoSize := sizeof(o);\r
+ getversionex(o);\r
+ win_isnt := o.dwPlatformId = VER_PLATFORM_WIN32_NT;\r
+ win_ver_major := o.dwMajorVersion;\r
+ win_ver_minor := o.dwMinorVersion;\r
+ end;\r
+end;\r
+\r
procedure measure_ticks_freq;\r
var\r
f,g:float;\r
- o:tosversioninfo;\r
- isnt:boolean;\r
-{ is9x:boolean;}\r
+\r
adjust1,adjust2:cardinal;\r
adjustbool:longbool;\r
+ win8_or_later:boolean;\r
begin\r
if (performancecountfreq = 0) then qpctimefloat;\r
ticks_freq_known := false;\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
+ init_win_version;\r
\r
ticks_freq2 := f;\r
mmtime_synchedqpc := false;\r
\r
- if (isnt and (o.dwMajorVersion >= 5)) then begin\r
+ if (win_isnt and (win_ver_major >= 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
+\r
+ //windows 8/10/11, 10 MHz time source is invariant TSC. add 64 Hz check for safety.\r
+ //with manifest, windows 10/11 major.minor will be 10.0 \r
+ win8_or_later := ((win_ver_major = 6) and (win_ver_minor >= 2)) or (win_ver_major = 10);\r
+ if (win8_or_later and (performancecountfreq = 10000000) and (adjust1 = 156250)) then begin\r
+ mmtime_synchedqpc := true;\r
+ end;\r
end;\r
end;\r
\r
frequency base: on NT, not the system clock, drifts compared to it.\r
epoch: system boot\r
}\r
-function qpctimefloat:extended;\r
+function qpctimefloat:float;\r
var\r
- p:packed record\r
- lowpart:longint;\r
- highpart:longint\r
- end;\r
- p2:tlargeinteger absolute p;\r
- e:extended;\r
+ i64:int64;\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
+ QueryPerformancefrequency(performancecountfreq);\r
+ performancecountstep := 1.0 / performancecountfreq;\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
+ queryperformancecounter(i64);\r
+ result := i64 * performancecountstep;\r
end;\r
\r
{\r
epoch: system boot\r
}\r
\r
-function mmqpctimefloat:float;\r
+//function mmqpctimefloat:float;\r
+function monotimefloat:float;\r
const\r
maxretries=5;\r
margin=0.002;\r
mmtime_lastresult := result;\r
end;\r
\r
-{ free pascals tsystemtime is incompatible with windows api calls\r
- so we declare it ourselves - plugwash\r
-}\r
-{$ifdef fpc}\r
-type\r
- TSystemTime = record\r
- wYear: Word;\r
- wMonth: Word;\r
- wDayOfWeek: Word;\r
- wDay: Word;\r
- wHour: Word;\r
- wMinute: Word;\r
- wSecond: Word;\r
- wMilliseconds: Word;\r
- end;\r
- {$endif}\r
-function Date_utc: extended;\r
-var\r
- SystemTime: TSystemTime;\r
+\r
+function boottimefloat:float;\r
begin\r
- {$ifdef fpc}\r
- GetsystemTime(@SystemTime);\r
- {$else}\r
- GetsystemTime(SystemTime);\r
- {$endif}\r
- with SystemTime do Result := EncodeDate(wYear, wMonth, wDay);\r
+ result := monotimefloat;\r
end;\r
\r
-function Time_utc: extended;\r
var\r
- SystemTime: TSystemTime;\r
-begin\r
- {$ifdef fpc}\r
- GetsystemTime(@SystemTime);\r
- {$else}\r
- GetsystemTime(SystemTime);\r
- {$endif}\r
- with SystemTime do\r
- Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);\r
-end;\r
+ QueryUnbiasedInterruptTime:function(var i:int64):longbool; stdcall;\r
+ unbiasedinterrupttime_inited:boolean;\r
+\r
\r
-function Now_utc: extended;\r
+procedure initunbiasedinterrupttime;\r
+var\r
+ dllhandle:thandle;\r
begin\r
- Result := round(Date_utc) + Time_utc;\r
+ unbiasedinterrupttime_inited := true;\r
+ dllhandle := loadlibrary('kernel32.dll');\r
+ if (dllhandle <> 0) then begin\r
+ QueryUnbiasedInterruptTime := getprocaddress(dllhandle,'QueryUnbiasedInterruptTime');\r
+ end;\r
end;\r
\r
-function unixtimefloat_systemtime:float;\r
+function unbiasedtime_100ns:int64;\r
begin\r
- {result := oletounixfloat(now_utc);}\r
-\r
- {this method gives exactly the same result with extended precision, but is less sensitive to float rounding in theory}\r
- result := oletounixfloat(int(date_utc+0.5))+time_utc*86400;\r
+ result := -1;\r
+ if not unbiasedinterrupttime_inited then initunbiasedinterrupttime;\r
+ if assigned(@QueryUnbiasedInterruptTime) then begin\r
+ QueryUnbiasedInterruptTime(result);\r
+ end;\r
end;\r
\r
-function monotimefloat:extended;\r
+function uptimefloat:float;\r
+var\r
+ i:int64;\r
begin\r
- result := mmqpctimefloat;\r
+ i := unbiasedtime_100ns;\r
+ if (i > 0) then begin\r
+ result := i * 0.0000001;\r
+ exit;\r
+ end;\r
+ result := qpctimefloat;\r
end;\r
\r
\r
end;\r
\r
\r
-function unixtimefloat_win8:float;\r
+function win8time_as_unix_100ns:int64;\r
+var\r
+ ft:tfiletime;\r
+ i:int64 absolute ft;\r
+begin\r
+ result := -1;\r
+ if not win8inited then initwin8;\r
+ if assigned(@GetSystemTimePreciseAsFileTime) then begin\r
+ GetSystemTimePreciseAsFileTime(ft);\r
+ //change from windows 1601-01-01 to unix 1970-01-01.\r
+ dec(i, 116444736000000000);\r
+ result := i;\r
+ end;\r
+end;\r
+\r
+\r
+function unixtimefloat_systemtime: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
+ //result := oletounixfloat(now_utc);\r
+\r
+ //this method gives exactly the same result with extended precision, but is less sensitive to float rounding in theory}\r
+ //result := oletounixfloat(int(date_utc+0.5))+time_utc*86400;\r
+\r
+ //new method that is much faster (22 vs 190 ns)\r
+ GetSystemTimeAsFileTime(ft);\r
dec(i, 116444736000000000);\r
- result := (i / 10000000);\r
+ result := i * 0.0000001;\r
+end;\r
+\r
+\r
+function unixtimefloat_coarse:float;\r
+begin\r
+ //don't do the coarse method if worse than about 16 ms. on win9x it may be only a 55 ms resolution\r
+ //but i have also seen it is less (like 1 ms)\r
+ //don't call measure_ticks_freq on NT because it is expensive and unnecessary\r
+ init_win_version;\r
+ if not win_isnt then begin\r
+ if not ticks_freq_known then measure_ticks_freq;\r
+ end;\r
+ if win_isnt or (ticks_freq < 0.017) then begin\r
+ result := unixtimefloat_systemtime;\r
+ exit;\r
+ end;\r
+\r
+ result := unixtimefloat;\r
+end;\r
+\r
+function monotimefloat_coarse:float;\r
+begin\r
+ init_win_version;\r
+ if not win_isnt then begin\r
+ if not ticks_freq_known then measure_ticks_freq;\r
+ end;\r
+ if win_isnt or (ticks_freq < 0.017) then begin\r
+ result := mmtimeint64 * 0.001;\r
+ exit;\r
+ end;\r
+ result := monotimefloat;\r
+end;\r
+\r
+\r
+//simulate gettimeofday on windows so one can always use gettimeofday if preferred\r
+function gettimeofday(var tv:ttimeval):integer;\r
+var\r
+ e:float;\r
+ i:int64;\r
+begin\r
+ result := -1;\r
+\r
+ if not btimenowin8 then begin\r
+ i := win8time_as_unix_100ns;\r
+ if (i > 0) then begin\r
+ tv.tv_sec := i div 10000000;\r
+ tv.tv_usec := (i mod 10000000) div 10;\r
+ result := 0;\r
+ exit;\r
+ end;\r
+ end;\r
+\r
+ e := unixtimefloat;\r
+ if (e > 0) then result := 0;\r
+ tv.tv_sec := trunc(e);\r
+ tv.tv_usec := trunc(frac(e)*1000000);\r
+end;\r
+\r
+\r
+function btime_gettime(clockid:integer;tp:pbtimespec):integer;\r
+var\r
+ f:float;\r
+ i:int64;\r
+\r
+{$ifdef cpu386}{$ifdef has_extended}{$define itotp_float}{$endif}{$endif}\r
+procedure i100ns_to_tp_and_success;\r
+{$ifdef itotp_float}\r
+var\r
+ f:float;\r
+{$endif}\r
+begin\r
+ //in 32 bits delphi, float is 10 times faster than int64 here (30 vs 300 ns for the conversion)\r
+ //and with extended available, there is no loss of precision\r
+\r
+ {$ifdef itotp_float}\r
+ f := i / 10000000.0;\r
+ tp.tv_sec := trunc(f);\r
+ tp.tv_nsec := round(frac(f) * 1000000000.0);\r
+ {$else}\r
+ tp.tv_sec := i div 10000000;\r
+ tp.tv_nsec := (i mod 10000000) * 100;\r
+ {$endif}\r
+\r
+ result := 0; //success\r
+end;\r
+\r
+procedure f_to_tp_and_success;\r
+begin\r
+ tp.tv_sec := trunc(f);\r
+ tp.tv_nsec := round(frac(f) * 1000000000.0);\r
+ result := 0; //success\r
+end;\r
+\r
+begin\r
+ result := -1; //error\r
+\r
+ case clockid of\r
+ CLOCK_REALTIME: begin\r
+ //implement this case directly for full precision even without extended floats\r
+ if not btimenowin8 then begin\r
+ i := win8time_as_unix_100ns;\r
+ if (i > 0) then begin\r
+ i100ns_to_tp_and_success;\r
+ exit;\r
+ end;\r
+ end;\r
+ f := unixtimefloat;\r
+ f_to_tp_and_success;\r
+ end;\r
+ CLOCK_MONOTONIC: begin\r
+ f := monotimefloat;\r
+ f_to_tp_and_success;\r
+ end;\r
+ CLOCK_REALTIME_COARSE: begin\r
+ f := unixtimefloat_coarse;\r
+ f_to_tp_and_success;\r
+ end;\r
+ CLOCK_MONOTONIC_COARSE: begin\r
+ f := monotimefloat_coarse;\r
+ f_to_tp_and_success;\r
+ end;\r
+ CLOCK_UPTIME: begin\r
+ i := unbiasedtime_100ns;\r
+ if (i > 0) then begin\r
+ i100ns_to_tp_and_success;\r
+ exit;\r
+ end;\r
+ f := qpctimefloat;\r
+ f_to_tp_and_success;\r
+ end;\r
+ end;\r
end;\r
\r
\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
+ result := win8time_as_unix_100ns * 0.0000001;\r
+ if (result > 0) then 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 := monotimefloat until g > f;\r
result := unixtimefloat;\r
end;\r
\r
- {for small changes backwards, guarantee no steps backwards}\r
- if (result <= lastunixtimefloat) and (result > lastunixtimefloat-1.5) then result := lastunixtimefloat + 0.0000001;\r
+ //for small changes backwards, guarantee no steps backwards\r
+ if (result <= lastunixtimefloat) and (result > lastunixtimefloat-1.5) then result := lastunixtimefloat;\r
lastunixtimefloat := result;\r
end;\r
\r
result := trunc(unixtimefloat);\r
end;\r
\r
-{$endif}\r
+{$endif} //mswindows\r
{-----------------------------------------------end of platform specific}\r
\r
function wintimefloat:float;\r
begin\r
if unixtime = 0 then init;\r
unixtime := unixtimeint;\r
- irctime := irctimeint;\r
+ irctime := unixtime+settimebias;\r
if unixtime and 63 = 0 then begin\r
{update everything, apply timezone changes, clock changes, etc}\r
gettimezone;\r
function tzgetfilename:ansistring;\r
var\r
t:textfile;\r
-\r
+ a:integer;\r
s,tz,tzdir:ansistring;\r
+ ispath:boolean;\r
begin\r
result := '';\r
filemode := 0;\r
- {$ifdef unix}\r
+\r
tz := getenv('TZ');\r
\r
- if (copy(tz,1,1) = ':') then begin\r
- tz := copy(tz,2,99999);\r
+ if (tz <> '') then begin\r
+ ispath := false;\r
+ if (copy(tz,1,1) = ':') then begin\r
+ ispath := true;\r
+ tz := copy(tz,2,99999);\r
+ end;\r
\r
if (copy(tz,1,1) <> '/') then begin\r
+ a := pos(',',tz);\r
+ if (a > 1) and not ispath then begin\r
+ tz := copy(tz,1,a-1);\r
+ end;\r
+\r
tzdir := getenv('TZDIR');\r
if (tzdir = '') then begin\r
tzdir := '/usr/share/zoneinfo/';\r
end;\r
\r
end;\r
- {$endif}\r
- \r
+\r
assignfile(t,'/etc/localtime');\r
{$i-}reset(t);{$i+}\r
if (ioresult = 0) then begin\r
result := '/etc/localtime';\r
exit;\r
end;\r
-\r
- assignfile(t,'/etc/timezone');\r
-\r
- s := '';\r
- {$i-}reset(t);{$i+}\r
- if (ioresult = 0) then begin\r
- readln(t,s);\r
- closefile(t);\r
- if (s <> '') then begin\r
- result := '/usr/share/zoneinfo/'+s;\r
- exit;\r
- end;\r
- end;\r
end;\r
\r
type\r
end;\r
end;\r
\r
-function tzgetoffset:integer;\r
-begin\r
- tzgetoffsetforts(unixtimeint);\r
-end;\r
-\r
-\r
-{$endif}\r
-\r
+{$endif} //unix\r
\r
-procedure gettimezone;\r
-var\r
+function tzgetoffset:integer;\r
{$ifdef UNIX}\r
{$ifndef ver1_9_4}\r
{$ifndef ver1_0}\r
{$endif}\r
{$endif}\r
{$ifndef above194}\r
+var\r
hh,mm,ss:word;\r
{$endif}\r
+ {$else}\r
+var\r
+ TimeZoneInfo: TIME_ZONE_INFORMATION;\r
+ tztype:cardinal;\r
+ min:integer;\r
{$endif}\r
- l:integer;\r
+\r
begin\r
{$ifdef UNIX}\r
{$ifdef above194}\r
- timezone := tzgetoffset;\r
+ result := tzgetoffsetforts(unixtimeint);\r
//freepascal tzseconds is not 2038 safe\r
{$else}\r
gettime(hh,mm,ss);\r
- timezone := (longint(hh) * 3600 + mm * 60 + ss) - (unixtimeint mod 86400);\r
+ result := (integer(hh) * 3600 + mm * 60 + ss) - (unixtimeint mod 86400);\r
{$endif}\r
{$else}\r
- timezone := round((now-now_utc)*86400);\r
+ tztype := GetTimeZoneInformation(TimeZoneInfo);\r
+ min := TimeZoneInfo.Bias;\r
+ case tztype of\r
+ //TIME_ZONE_ID_UNKNOWN: don't add DST\r
+ TIME_ZONE_ID_STANDARD: inc(min, TimeZoneInfo.StandardBias);\r
+ TIME_ZONE_ID_DAYLIGHT: inc(min, TimeZoneInfo.DaylightBias);\r
+ end;\r
+ result := min * -60;\r
{$endif}\r
\r
- while timezone > 50400 do dec(timezone,86400);\r
- while timezone < -50400 do inc(timezone,86400);\r
+ while result > (14 * 3600) do dec(result,86400);\r
+ while result < -(14 * 3600) do inc(result,86400);\r
+end;\r
+\r
+\r
+procedure gettimezone;\r
+var\r
+ l:integer;\r
+begin\r
+ timezone := tzgetoffset;\r
\r
if timezone >= 0 then timezonestr := '+' else timezonestr := '-';\r
l := abs(timezone) div 60;\r
lcore.org gitweb / lcore.git / commitdiff