The monotonic clock epoch is set to some undetermined time
in the past (typically system boot time). In order to use the
monotonic clock for absolute time, the offset from a known epoch
is calculated and incorporated into timed delay and sleep.
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-09-25 Doug Rupp <r...@adacore.com>
* libgnarl/s-taprop__linux.adb (Base_Monotonic_Clock): New variable.
(Compute_Base_Monotonic_Clock): New function.
(Timed_Sleep): Adjust to use Base_Monotonic_Clock.
(Timed_Delay): Likewise.
(Monotonic_Clock): Likewise.
* s-oscons-tmplt.c (CLOCK_MONOTONIC): Use on Linux.
Index: s-oscons-tmplt.c
===================================================================
--- s-oscons-tmplt.c (revision 253134)
+++ s-oscons-tmplt.c (working copy)
@@ -1440,7 +1440,8 @@
#endif
CND(CLOCK_THREAD_CPUTIME_ID, "Thread CPU clock")
-#if defined(__FreeBSD__) || (defined(_AIX) && defined(_AIXVERSION_530)) \
+#if defined(__linux__) || defined(__FreeBSD__) \
+ || (defined(_AIX) && defined(_AIXVERSION_530)) \
|| defined(__DragonFly__)
/** On these platforms use system provided monotonic clock instead of
** the default CLOCK_REALTIME. We then need to set up cond var attributes
Index: libgnarl/s-taprop__linux.adb
===================================================================
--- libgnarl/s-taprop__linux.adb (revision 253134)
+++ libgnarl/s-taprop__linux.adb (working copy)
@@ -64,6 +64,7 @@
use System.Parameters;
use System.OS_Primitives;
use System.Task_Info;
+ use type Interfaces.C.long;
----------------
-- Local Data --
@@ -110,6 +111,8 @@
-- Constant to indicate that the thread identifier has not yet been
-- initialized.
+ Base_Monotonic_Clock : Duration := 0.0;
+
--------------------
-- Local Packages --
--------------------
@@ -160,6 +163,12 @@
procedure Abort_Handler (signo : Signal);
+ function Compute_Base_Monotonic_Clock return Duration;
+ -- The monotonic clock epoch is set to some undetermined time
+ -- in the past (typically system boot time). In order to use the
+ -- monotonic clock for absolute time, the offset from a known epoch
+ -- is needed.
+
function GNAT_pthread_condattr_setup
(attr : access pthread_condattr_t) return C.int;
pragma Import
@@ -257,6 +266,73 @@
end if;
end Abort_Handler;
+ ----------------------------------
+ -- Compute_Base_Monotonic_Clock --
+ ----------------------------------
+
+ function Compute_Base_Monotonic_Clock return Duration is
+ TS_Bef0, TS_Mon0, TS_Aft0 : aliased timespec;
+ TS_Bef, TS_Mon, TS_Aft : aliased timespec;
+ Bef, Mon, Aft : Duration;
+ Res_B, Res_M, Res_A : Interfaces.C.int;
+ begin
+ Res_B := clock_gettime
+ (clock_id => OSC.CLOCK_REALTIME, tp => TS_Bef0'Unchecked_Access);
+ pragma Assert (Res_B = 0);
+ Res_M := clock_gettime
+ (clock_id => OSC.CLOCK_RT_Ada, tp => TS_Mon0'Unchecked_Access);
+ pragma Assert (Res_M = 0);
+ Res_A := clock_gettime
+ (clock_id => OSC.CLOCK_REALTIME, tp => TS_Aft0'Unchecked_Access);
+ pragma Assert (Res_A = 0);
+
+ for I in 1 .. 10 loop
+ -- Guard against a leap second which will cause CLOCK_REALTIME
+ -- to jump backwards. In the extrenmely unlikely event we call
+ -- clock_gettime before and after the jump the epoch result will
+ -- be off slightly.
+ -- Use only results where the tv_sec values match for the sake
+ -- of convenience.
+ -- Also try to calculate the most accurate
+ -- epoch by taking the minimum difference of 10 tries.
+
+ Res_B := clock_gettime
+ (clock_id => OSC.CLOCK_REALTIME, tp => TS_Bef'Unchecked_Access);
+ pragma Assert (Res_B = 0);
+ Res_M := clock_gettime
+ (clock_id => OSC.CLOCK_RT_Ada, tp => TS_Mon'Unchecked_Access);
+ pragma Assert (Res_M = 0);
+ Res_A := clock_gettime
+ (clock_id => OSC.CLOCK_REALTIME, tp => TS_Aft'Unchecked_Access);
+ pragma Assert (Res_A = 0);
+
+ if (TS_Bef0.tv_sec /= TS_Aft0.tv_sec and then
+ TS_Bef.tv_sec = TS_Aft.tv_sec)
+ -- The calls to clock_gettime before the loop were no good.
+ or else
+ (TS_Bef0.tv_sec = TS_Aft0.tv_sec and then
+ TS_Bef.tv_sec = TS_Aft.tv_sec and then
+ (TS_Aft.tv_nsec - TS_Bef.tv_nsec <
+ TS_Aft0.tv_nsec - TS_Bef0.tv_nsec))
+ -- The most recent calls to clock_gettime were more better.
+ then
+ TS_Bef0.tv_sec := TS_Bef.tv_sec;
+ TS_Bef0.tv_nsec := TS_Bef.tv_nsec;
+ TS_Aft0.tv_sec := TS_Aft.tv_sec;
+ TS_Aft0.tv_nsec := TS_Aft.tv_nsec;
+ TS_Mon0.tv_sec := TS_Mon.tv_sec;
+ TS_Mon0.tv_nsec := TS_Mon.tv_nsec;
+ end if;
+ end loop;
+
+ Bef := To_Duration (TS_Bef0);
+ Mon := To_Duration (TS_Mon0);
+ Aft := To_Duration (TS_Aft0);
+
+ return Bef / 2 + Aft / 2 - Mon;
+ -- Distribute the division to avoid potential type overflow someday.
+ end Compute_Base_Monotonic_Clock;
+
--------------
-- Lock_RTS --
--------------
@@ -583,7 +659,7 @@
pragma Unreferenced (Reason);
Base_Time : constant Duration := Monotonic_Clock;
- Check_Time : Duration := Base_Time;
+ Check_Time : Duration := Base_Time - Base_Monotonic_Clock;
Abs_Time : Duration;
Request : aliased timespec;
Result : C.int;
@@ -595,7 +671,8 @@
Abs_Time :=
(if Mode = Relative
then Duration'Min (Time, Max_Sensible_Delay) + Check_Time
- else Duration'Min (Check_Time + Max_Sensible_Delay, Time));
+ else Duration'Min (Check_Time + Max_Sensible_Delay,
+ Time - Base_Monotonic_Clock));
if Abs_Time > Check_Time then
Request := To_Timespec (Abs_Time);
@@ -612,7 +689,8 @@
abstime => Request'Access);
Check_Time := Monotonic_Clock;
- exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
+ exit when Abs_Time + Base_Monotonic_Clock <= Check_Time
+ or else Check_Time < Base_Time;
if Result in 0 | EINTR then
@@ -640,7 +718,7 @@
Mode : ST.Delay_Modes)
is
Base_Time : constant Duration := Monotonic_Clock;
- Check_Time : Duration := Base_Time;
+ Check_Time : Duration := Base_Time - Base_Monotonic_Clock;
Abs_Time : Duration;
Request : aliased timespec;
@@ -657,7 +735,8 @@
Abs_Time :=
(if Mode = Relative
then Time + Check_Time
- else Duration'Min (Check_Time + Max_Sensible_Delay, Time));
+ else Duration'Min (Check_Time + Max_Sensible_Delay,
+ Time - Base_Monotonic_Clock));
if Abs_Time > Check_Time then
Request := To_Timespec (Abs_Time);
@@ -675,7 +754,8 @@
abstime => Request'Access);
Check_Time := Monotonic_Clock;
- exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
+ exit when Abs_Time + Base_Monotonic_Clock <= Check_Time
+ or else Check_Time < Base_Time;
pragma Assert (Result in 0 | ETIMEDOUT | EINTR);
end loop;
@@ -698,13 +778,13 @@
function Monotonic_Clock return Duration is
TS : aliased timespec;
- Result : C.int;
+ Result : Interfaces.C.int;
begin
Result := clock_gettime
(clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access);
pragma Assert (Result = 0);
- return To_Duration (TS);
+ return Base_Monotonic_Clock + To_Duration (TS);
end Monotonic_Clock;
-------------------
@@ -1496,6 +1576,8 @@
Interrupt_Management.Initialize;
+ Base_Monotonic_Clock := Compute_Base_Monotonic_Clock;
+
-- Prepare the set of signals that should be unblocked in all tasks
Result := sigemptyset (Unblocked_Signal_Mask'Access);
