[multiple changes]

2017-09-25  Bob Duff  <duff@adacore.com>

	* exp_ch3.adb: Rename Comp_Type_Simple to be Comp_Simple_Init.

2017-09-25  Doug Rupp  <rupp@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.

From-SVN: r253136

1 files changed, 90 insertions, 8 deletions

diff --git a/gcc/ada/libgnarl/s-taprop__linux.adb b/gcc/ada/libgnarl/s-taprop__linux.adb
index cc49205..4f83d73 100644
--- a/gcc/ada/libgnarl/s-taprop__linux.adb
+++ b/gcc/ada/libgnarl/s-taprop__linux.adb
@@ -64,6 +64,7 @@ package body System.Task_Primitives.Operations is
    use System.Parameters;
    use System.OS_Primitives;
    use System.Task_Info;
+   use type Interfaces.C.long;
 
    ----------------
    -- Local Data --
@@ -110,6 +111,8 @@ package body System.Task_Primitives.Operations is
    --  Constant to indicate that the thread identifier has not yet been
    --  initialized.
 
+   Base_Monotonic_Clock : Duration := 0.0;
+
    --------------------
    -- Local Packages --
    --------------------
@@ -160,6 +163,12 @@ package body System.Task_Primitives.Operations is
 
    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 @@ package body System.Task_Primitives.Operations is
       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 @@ package body System.Task_Primitives.Operations is
       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 @@ package body System.Task_Primitives.Operations is
       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 @@ package body System.Task_Primitives.Operations is
                  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 @@ package body System.Task_Primitives.Operations is
       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 @@ package body System.Task_Primitives.Operations is
       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 @@ package body System.Task_Primitives.Operations is
                  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 @@ package body System.Task_Primitives.Operations is
 
    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 @@ package body System.Task_Primitives.Operations is
 
       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);