{$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
gettimeofday(tv);\r
sec := tv.tv_sec;\r
{$ifndef cpu64}\r
- if (sec < 0) then inc(sec,$100000000); //tv_sec is 32 bits\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
var\r
temp:ttimeval;\r
begin\r
- gettimeofday(temp);\r
+ gettimemonotonic(temp);\r
result := ((temp.tv_usec div 1000) + (temp.tv_sec * 1000)) and tsmask;\r
{$endif}\r
end;\r
selecttimeout.tv_sec := 0;\r
selecttimeout.tv_usec := retryafter;\r
end;\r
- //find the highest of the used fd's\r
+ //find the highest of the used fds\r
b := 0;\r
for socknum := numsockused-1 downto 0 do if fd[socknum] > b then b := fd[socknum];\r
selectresult := select(b+1,@fds,nil,nil,@selecttimeout);\r
{$ifndef mswindows}\r
procedure tltimer.resettimes;\r
begin\r
- gettimeofday(nextts);\r
+ gettimemonotonic(nextts);\r
{if not initialevent then} tv_add(nextts,interval);\r
end;\r
{$endif}\r
result64: integer;\r
tv : ttimeval;\r
begin\r
- gettimeofday(tv);\r
+ gettimemonotonic(tv);\r
result64 := (tv.tv_sec*1000)+(tv.tv_usec div 1000);\r
result := result64;\r
end;\r
threaddata := findthreaddata(tm.GetCurrentThreadId);\r
if threaddata.lcorethread then raise exception.create('get/peek message cannot be used in the lcore thread');\r
message := threaddata.messagequeue;\r
- gettimeofday(nowtv);\r
+ gettimemonotonic(nowtv);\r
while (not peek) and (message=nil) and (not tv_compare(nowtv,threaddata.nexttimer)) do begin\r
threaddata.waiting := true;\r
structurelock.release;\r
\r
timeouttv := threaddata.nexttimer;\r
timeoutms := (timeouttv.tv_sec * 1000)+(timeouttv.tv_usec div 1000);\r
- //i'm assuming the timeout is in milliseconds\r
+ //i am assuming the timeout is in milliseconds\r
if (timeoutms > maxlongint) then timeoutms := maxlongint;\r
threaddata.messageevent.waitfor(timeoutms);\r
\r
structurelock.acquire;\r
threaddata.waiting := false;\r
message := threaddata.messagequeue;\r
- gettimeofday(nowtv);\r
+ gettimemonotonic(nowtv);\r
end;\r
if (message=nil) and tv_compare(nowtv,threaddata.nexttimer) then begin\r
processtimers;\r
temptimer : tltimer ;\r
\r
begin\r
- gettimeofday(tvnow);\r
+ gettimemonotonic(tvnow);\r
currenttimer := firsttimer;\r
while assigned(currenttimer) do begin\r
//writeln(currenttimer.enabled);\r
fd_zero(FDSW);\r
if result=-1 then begin\r
if linuxerror = SYS_EINTR then begin\r
- // we received a signal it's not a problem\r
+ // we received a signal it is not a problem\r
end else begin\r
raise esocketexception.create('select returned error '+inttostr(linuxerror));\r
end;\r
selectresult := doselect(nil);\r
\r
end else begin\r
- gettimeofday(tvnow);\r
+ gettimemonotonic(tvnow);\r
tv_subtract(tv,tvnow);\r
\r
//writeln('timers active');\r
{$ifdef ver1_0}\r
uses linux;\r
{$else}\r
- uses baseunix,unix,unixutil,sockets;\r
+ uses \r
+ {$ifdef linux}linux,{$endif} //for clock_gettime\r
+ {$ifdef freebsd}freebsd,{$endif} //for clock_gettime \r
+ baseunix,unix,unixutil,sockets;\r
{$endif}\r
{$endif}\r
\r
procedure tv_subtract(var tv:ttimeval;const tv2:ttimeval);\r
procedure msectotimeval(var tv:ttimeval;msec:integer);\r
\r
+{$ifdef unix}\r
+//for internal use by lcore as a replacement for gettimeofday -beware\r
+procedure gettimemonotonic(var tv:ttimeval);\r
+{$endif}\r
+\r
//tv_invalidtimebig will always compare as greater than any valid timeval\r
//unfortunately unixstuff.inc hasn't worked it's magic yet so we\r
//have to ifdef this manually.\r
tv.tv_usec := (msec mod 1000)*1000;\r
end;\r
\r
-end.
\ No newline at end of file
+\r
+{$ifdef unix}\r
+{$ifdef linux}{$define have_clock_gettime}{$endif}\r
+{$ifdef freebsd}{$define have_clock_gettime}{$endif}\r
+\r
+procedure gettimemonotonic(var tv:ttimeval);\r
+var\r
+ ts:ttimespec;\r
+begin\r
+ {$ifdef have_clock_gettime}\r
+ if (clock_gettime(CLOCK_MONOTONIC, @ts) = 0) then begin\r
+ tv.tv_sec := ts.tv_sec;\r
+ tv.tv_usec := ts.tv_nsec div 1000;\r
+ exit;\r
+ end;\r
+ {$endif}\r
+ gettimeofday(tv);\r
+end;\r
+{$endif}\r
+\r
+end.\r