[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

4 files changed, 114 insertions, 13 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5f0b861..371d50e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+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.
+
 2017-09-25  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch12.adb (Save_References_In_Aggregate): Small correction to
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 33948bd..39ad94a 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -517,11 +517,16 @@ package body Exp_Ch3 is
 
    procedure Build_Array_Init_Proc (A_Type : Entity_Id; Nod : Node_Id) is
       Comp_Type        : constant Entity_Id := Component_Type (A_Type);
-      Comp_Type_Simple : constant Boolean   :=
+      Comp_Simple_Init : constant Boolean   :=
         Needs_Simple_Initialization
           (T           => Comp_Type,
            Consider_IS =>
              not (Validity_Check_Copies and Is_Bit_Packed_Array (A_Type)));
+      --  True if the component needs simple initialization, based on its type,
+      --  plus the fact that we do not do simple initialization for components
+      --  of bit-packed arrays when validity checks are enabled, because the
+      --  initialization with deliberately out-of-range values would raise
+      --  Constraint_Error.
 
       Body_Stmts       : List_Id;
       Has_Default_Init : Boolean;
@@ -563,7 +568,7 @@ package body Exp_Ch3 is
                   Convert_To (Comp_Type,
                     Default_Aspect_Component_Value (First_Subtype (A_Type)))));
 
-         elsif Comp_Type_Simple then
+         elsif Comp_Simple_Init then
             Set_Assignment_OK (Comp);
             return New_List (
               Make_Assignment_Statement (Loc,
@@ -595,7 +600,7 @@ package body Exp_Ch3 is
          --  the dummy Init_Proc needed for Initialize_Scalars processing.
 
          if not Has_Non_Null_Base_Init_Proc (Comp_Type)
-           and then not Comp_Type_Simple
+           and then not Comp_Simple_Init
            and then not Has_Task (Comp_Type)
            and then not Has_Default_Aspect (A_Type)
          then
@@ -685,7 +690,7 @@ package body Exp_Ch3 is
       --  init_proc.
 
       Has_Default_Init := Has_Non_Null_Base_Init_Proc (Comp_Type)
-                            or else Comp_Type_Simple
+                            or else Comp_Simple_Init
                             or else Has_Task (Comp_Type)
                             or else Has_Default_Aspect (A_Type);
 
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);
diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c
index 0ace0b6..444ad60 100644
--- a/gcc/ada/s-oscons-tmplt.c
+++ b/gcc/ada/s-oscons-tmplt.c
@@ -1440,7 +1440,8 @@ CND(CLOCK_FASTEST, "Fastest clock")
 #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