From eca2c8e0a8aad79c7dc7738346d265f973428995 Mon Sep 17 00:00:00 2001
From: beware <beware@bircd.org>
Date: Fri, 13 Aug 2021 03:52:55 +0000
Subject: [PATCH] replace internal uses of gettimeofday with monotonic time
 where appropriate. make btime use clock_gettime provided by freepascal.
 single apostrophes in comments mess up vim's broken syntax highlighting.

git-svn-id: file:///svnroot/lcore/trunk@157 b1de8a11-f9be-4011-bde0-cc7ace90066a
---
 btime.pas         | 44 +++++++++++++-------------------------------
 dnssync.pas       |  4 ++--
 lcore.pas         |  2 +-
 lcoremessages.pas |  8 ++++----
 lcoreselect.pas   |  6 +++---
 ltimevalstuff.pas | 32 ++++++++++++++++++++++++++++++--
 6 files changed, 53 insertions(+), 43 deletions(-)

diff --git a/btime.pas b/btime.pas
index a0bfc5e..a3428e8 100644
--- a/btime.pas
+++ b/btime.pas
@@ -121,11 +121,10 @@ uses
     {$ifdef VER1_0}
       linux,
     {$else}
+      {$ifdef linux}linux,{$endif} //for clock_gettime
+      {$ifdef freebsd}freebsd,{$endif} //for clock_gettime
       baseunix,unix,unixutil,sockets, {unixutil and sockets needed by unixstuff.inc on some compiler versions}
     {$endif}
-    {$ifdef linux}
-      dl,
-    {$endif}
   {$else}
     windows,unitsettc,mmsystem,
   {$endif}
@@ -181,49 +180,32 @@ begin
   gettimeofday(tv);
   sec := tv.tv_sec;
   {$ifndef cpu64}
-  if (sec < 0) then inc(sec,$100000000); //tv_sec is 32 bits
+  if (sec < -1) then inc(sec,$100000000); //tv_sec is 32 bits. allow -1 for invalid result
   {$endif}
   result := sec+(tv.tv_usec/1000000);
 end;
 
-{$ifdef linux}
-  {$define monotimefloat_implemented}
-  const
-    CLOCK_MONOTONIC = 1;
-  type 
-    ptimeval = ^ttimeval;
-    tclock_gettime = function(clk_id: integer; tp: ptimeval): integer; cdecl;
+{$ifdef linux}{$define have_clock_gettime}{$endif}
+{$ifdef freebsd}{$define have_clock_gettime}{$endif}
 
-  var
-    librt_handle:pointer;
-    librt_inited:boolean;
-    clock_gettime: tclock_gettime;
+{$ifdef have_clock_gettime}
+  {$define monotimefloat_implemented}
 
   function monotimefloat:float;
   var
-    ts: ttimeval;
+    ts: ttimespec;
   begin
-    if not librt_inited then begin
-      librt_inited := true;
-      clock_gettime := nil;
-      librt_handle := dlopen('librt.so', RTLD_LAZY);
-      if assigned(librt_handle) then begin
-        clock_gettime := dlsym(librt_handle, 'clock_gettime');
-      end;
-    end;
-    if assigned(clock_gettime) then begin
-      if clock_gettime(CLOCK_MONOTONIC, @ts) = 0 then begin
-        //note this really returns nanoseconds
-        result := ts.tv_sec + ts.tv_usec / 1000000000.0;
-        exit;
-      end;
+    if clock_gettime(CLOCK_MONOTONIC, @ts) = 0 then begin
+      //note this really returns nanoseconds
+      result := ts.tv_sec + ts.tv_nsec / 1000000000.0;
+      exit;
     end;
     //fallback
     result := unixtimefloat;
   end;
 
 
-{$endif} {linux}
+{$endif}
 
 {$ifdef darwin} {mac OS X}
 {$define monotimefloat_implemented}
diff --git a/dnssync.pas b/dnssync.pas
index f5eafa6..84caf9a 100644
--- a/dnssync.pas
+++ b/dnssync.pas
@@ -94,7 +94,7 @@ begin
 var
   temp:ttimeval;
 begin
-  gettimeofday(temp);
+  gettimemonotonic(temp);
   result := ((temp.tv_usec div 1000) + (temp.tv_sec * 1000)) and tsmask;
 {$endif}
 end;
@@ -256,7 +256,7 @@ begin
       selecttimeout.tv_sec := 0;
       selecttimeout.tv_usec := retryafter;
     end;
-    //find the highest of the used fd's
+    //find the highest of the used fds
     b := 0;
     for socknum := numsockused-1 downto 0 do if fd[socknum] > b then b := fd[socknum];
     selectresult := select(b+1,@fds,nil,nil,@selecttimeout);
diff --git a/lcore.pas b/lcore.pas
index 109f4d7..f47bdab 100644
--- a/lcore.pas
+++ b/lcore.pas
@@ -669,7 +669,7 @@ end;
 {$ifndef mswindows}
   procedure tltimer.resettimes;
   begin
-    gettimeofday(nextts);
+    gettimemonotonic(nextts);
     {if not initialevent then} tv_add(nextts,interval);
   end;
 {$endif}
diff --git a/lcoremessages.pas b/lcoremessages.pas
index 8a2bd54..b67e4c0 100644
--- a/lcoremessages.pas
+++ b/lcoremessages.pas
@@ -389,7 +389,7 @@ var
   result64: integer;
   tv : ttimeval;
 begin
-  gettimeofday(tv);
+  gettimemonotonic(tv);
   result64 := (tv.tv_sec*1000)+(tv.tv_usec div 1000);
   result := result64;
 end;
@@ -451,7 +451,7 @@ begin
     threaddata := findthreaddata(tm.GetCurrentThreadId);
     if threaddata.lcorethread then raise exception.create('get/peek message cannot be used in the lcore thread');
     message := threaddata.messagequeue;
-    gettimeofday(nowtv);
+    gettimemonotonic(nowtv);
     while (not peek) and (message=nil) and (not tv_compare(nowtv,threaddata.nexttimer)) do begin
       threaddata.waiting := true;
       structurelock.release;
@@ -461,7 +461,7 @@ begin
 
         timeouttv := threaddata.nexttimer;
         timeoutms := (timeouttv.tv_sec * 1000)+(timeouttv.tv_usec div 1000);
-        //i'm assuming the timeout is in milliseconds
+        //i am assuming the timeout is in milliseconds
         if (timeoutms > maxlongint) then timeoutms := maxlongint;
         threaddata.messageevent.waitfor(timeoutms);
 
@@ -469,7 +469,7 @@ begin
       structurelock.acquire;
       threaddata.waiting := false;
       message := threaddata.messagequeue;
-      gettimeofday(nowtv);
+      gettimemonotonic(nowtv);
     end;
     if (message=nil) and tv_compare(nowtv,threaddata.nexttimer) then begin
       processtimers;
diff --git a/lcoreselect.pas b/lcoreselect.pas
index f613f67..a20a55b 100644
--- a/lcoreselect.pas
+++ b/lcoreselect.pas
@@ -69,7 +69,7 @@ var
   temptimer               : tltimer  ;
 
 begin
-  gettimeofday(tvnow);
+  gettimemonotonic(tvnow);
   currenttimer := firsttimer;
   while assigned(currenttimer) do begin
     //writeln(currenttimer.enabled);
@@ -249,7 +249,7 @@ begin
     fd_zero(FDSW);
     if result=-1 then begin
       if linuxerror = SYS_EINTR then begin
-        // we received a signal it's not a problem
+        // we received a signal it is not a problem
       end else begin
         raise esocketexception.create('select returned error '+inttostr(linuxerror));
       end;
@@ -309,7 +309,7 @@ begin
       selectresult := doselect(nil);
 
     end else begin
-      gettimeofday(tvnow);
+      gettimemonotonic(tvnow);
       tv_subtract(tv,tvnow);
 
       //writeln('timers active');
diff --git a/ltimevalstuff.pas b/ltimevalstuff.pas
index 7054ea9..7a10c7a 100644
--- a/ltimevalstuff.pas
+++ b/ltimevalstuff.pas
@@ -20,7 +20,10 @@ interface
   {$ifdef ver1_0}
     uses linux;
   {$else}
-    uses baseunix,unix,unixutil,sockets;
+    uses 
+      {$ifdef linux}linux,{$endif} //for clock_gettime
+      {$ifdef freebsd}freebsd,{$endif} //for clock_gettime      
+      baseunix,unix,unixutil,sockets;
   {$endif}
 {$endif}
                                 
@@ -30,6 +33,11 @@ function tv_compare(const tv1,tv2:ttimeval):boolean;
 procedure tv_subtract(var tv:ttimeval;const tv2:ttimeval);
 procedure msectotimeval(var tv:ttimeval;msec:integer);
 
+{$ifdef unix}
+//for internal use by lcore as a replacement for gettimeofday -beware
+procedure gettimemonotonic(var tv:ttimeval);
+{$endif}
+
 //tv_invalidtimebig will always compare as greater than any valid timeval
 //unfortunately unixstuff.inc hasn't worked it's magic yet so we
 //have to ifdef this manually.
@@ -75,4 +83,24 @@ begin
   tv.tv_usec := (msec mod 1000)*1000;
 end;
 
-end.
\ No newline at end of file
+
+{$ifdef unix}
+{$ifdef linux}{$define have_clock_gettime}{$endif}
+{$ifdef freebsd}{$define have_clock_gettime}{$endif}
+
+procedure gettimemonotonic(var tv:ttimeval);
+var
+  ts:ttimespec;
+begin
+  {$ifdef have_clock_gettime}
+  if (clock_gettime(CLOCK_MONOTONIC, @ts) = 0) then begin
+    tv.tv_sec := ts.tv_sec;
+    tv.tv_usec := ts.tv_nsec div 1000;
+    exit;
+  end;
+  {$endif}
+  gettimeofday(tv);
+end;
+{$endif}
+
+end.
-- 
2.30.2