diff gcc/ada/libgnarl/s-tpopmo.adb @ 131:84e7813d76e9

gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
line wrap: on
line diff
--- a/gcc/ada/libgnarl/s-tpopmo.adb	Fri Oct 27 22:46:09 2017 +0900
+++ b/gcc/ada/libgnarl/s-tpopmo.adb	Thu Oct 25 07:37:49 2018 +0900
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---         Copyright (C) 1992-2017, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2018, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -42,11 +42,10 @@
      (Time       : Duration;
       Mode       : ST.Delay_Modes;
       Check_Time : out Duration;
-      Abs_Time   : out Duration;
-      Rel_Time   : out Duration);
+      Abs_Time   : out Duration);
    --  Helper for Timed_Sleep and Timed_Delay: given a deadline specified by
    --  Time and Mode, compute the current clock reading (Check_Time), and the
-   --  target absolute and relative clock readings (Abs_Time, Rel_Time). The
+   --  target absolute and relative clock readings (Abs_Time). The
    --  epoch for Time depends on Mode; the epoch for Check_Time and Abs_Time
    --  is always that of CLOCK_RT_Ada.
 
@@ -88,8 +87,7 @@
      (Time       : Duration;
       Mode       : ST.Delay_Modes;
       Check_Time : out Duration;
-      Abs_Time   : out Duration;
-      Rel_Time   : out Duration)
+      Abs_Time   : out Duration)
    is
    begin
       Check_Time := Monotonic_Clock;
@@ -99,10 +97,6 @@
       if Mode = Relative then
          Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time;
 
-         if Relative_Timed_Wait then
-            Rel_Time := Duration'Min (Max_Sensible_Delay, Time);
-         end if;
-
          pragma Warnings (Off);
          --  Comparison "OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME" is compile
          --  time known.
@@ -115,10 +109,6 @@
          pragma Warnings (On);
          Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
 
-         if Relative_Timed_Wait then
-            Rel_Time := Duration'Min (Max_Sensible_Delay, Time - Check_Time);
-         end if;
-
       --  Absolute deadline specified using the calendar clock, in the
       --  case where it is not the same as the tasking clock: compensate for
       --  difference between clock epochs (Base_Time - Base_Cal_Time).
@@ -133,10 +123,6 @@
             Abs_Time :=
               Duration'Min (Check_Time + Max_Sensible_Delay, RT_Time);
 
-            if Relative_Timed_Wait then
-               Rel_Time :=
-                 Duration'Min (Max_Sensible_Delay, RT_Time - Check_Time);
-            end if;
          end;
       end if;
    end Compute_Deadline;
@@ -162,10 +148,11 @@
       Base_Time  : Duration;
       Check_Time : Duration;
       Abs_Time   : Duration;
-      Rel_Time   : Duration;
+      P_Abs_Time : Duration;
 
       Request    : aliased timespec;
       Result     : Interfaces.C.int;
+      Exit_Outer : Boolean := False;
 
    begin
       Timedout := True;
@@ -175,38 +162,63 @@
         (Time       => Time,
          Mode       => Mode,
          Check_Time => Check_Time,
-         Abs_Time   => Abs_Time,
-         Rel_Time   => Rel_Time);
+         Abs_Time   => Abs_Time);
       Base_Time := Check_Time;
 
+      --  To keep a sensible Max_Sensible_Delay on a target whose system
+      --  maximum is less than sensible, we split the delay into manageable
+      --  chunks of time less than or equal to the Max_System_Delay.
+
       if Abs_Time > Check_Time then
-         Request :=
-           To_Timespec (if Relative_Timed_Wait then Rel_Time else Abs_Time);
 
-         loop
-            exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
+         Outer : loop
 
-            Result :=
-              pthread_cond_timedwait
-                (cond    => Self_ID.Common.LL.CV'Access,
-                 mutex   => (if Single_Lock
-                             then Single_RTS_Lock'Access
-                             else Self_ID.Common.LL.L'Access),
-                 abstime => Request'Access);
+            pragma Warnings (Off, "condition is always *");
+            if Max_System_Delay < Max_Sensible_Delay and then
+               Abs_Time > Check_Time + Max_System_Delay
+            then
+               P_Abs_Time := Check_Time + Max_System_Delay;
+            else
+               P_Abs_Time := Abs_Time;
+               Exit_Outer := True;
+            end if;
+            pragma Warnings (On);
+
+            Request := To_Timespec (P_Abs_Time);
+
+            Inner : loop
+               exit Outer
+                  when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
 
-            Check_Time := Monotonic_Clock;
-            exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
+               Result :=
+                 pthread_cond_timedwait
+                   (cond    => Self_ID.Common.LL.CV'Access,
+                    mutex   => (if Single_Lock
+                                then Single_RTS_Lock'Access
+                                else Self_ID.Common.LL.L'Access),
+                    abstime => Request'Access);
 
-            if Result in 0 | EINTR then
-
-               --  Somebody may have called Wakeup for us
+               case Result is
+                  when 0 | EINTR =>
+                     --  Somebody may have called Wakeup for us
+                     Timedout := False;
+                     exit Outer;
 
-               Timedout := False;
-               exit;
-            end if;
+                  when ETIMEDOUT =>
+                     exit Outer when Exit_Outer;
+                     Check_Time := Monotonic_Clock;
+                     exit Inner;
+
+                  when others =>
+                     pragma Assert (False);
 
-            pragma Assert (Result = ETIMEDOUT);
-         end loop;
+               end case;
+
+               exit Outer
+                 when Abs_Time <= Check_Time or else Check_Time < Base_Time;
+
+            end loop Inner;
+         end loop Outer;
       end if;
    end Timed_Sleep;
 
@@ -225,11 +237,11 @@
       Base_Time  : Duration;
       Check_Time : Duration;
       Abs_Time   : Duration;
-      Rel_Time   : Duration;
+      P_Abs_Time : Duration;
       Request    : aliased timespec;
 
-      Result : Interfaces.C.int;
-      pragma Warnings (Off, Result);
+      Result     : Interfaces.C.int;
+      Exit_Outer : Boolean := False;
 
    begin
       if Single_Lock then
@@ -242,31 +254,61 @@
         (Time       => Time,
          Mode       => Mode,
          Check_Time => Check_Time,
-         Abs_Time   => Abs_Time,
-         Rel_Time   => Rel_Time);
+         Abs_Time   => Abs_Time);
       Base_Time := Check_Time;
 
+      --  To keep a sensible Max_Sensible_Delay on a target whose system
+      --  maximum is less than sensible, we split the delay into manageable
+      --  chunks of time less than or equal to the Max_System_Delay.
+
       if Abs_Time > Check_Time then
-         Request :=
-           To_Timespec (if Relative_Timed_Wait then Rel_Time else Abs_Time);
          Self_ID.Common.State := Delay_Sleep;
 
-         loop
-            exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
+         Outer : loop
+
+            pragma Warnings (Off, "condition is always *");
+            if Max_System_Delay < Max_Sensible_Delay and then
+              Abs_Time > Check_Time + Max_System_Delay
+            then
+               P_Abs_Time := Check_Time + Max_System_Delay;
+            else
+               P_Abs_Time := Abs_Time;
+               Exit_Outer := True;
+            end if;
+            pragma Warnings (On);
+
+            Request := To_Timespec (P_Abs_Time);
+
+            Inner : loop
+               exit Outer
+                 when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
 
-            Result :=
-              pthread_cond_timedwait
-                (cond    => Self_ID.Common.LL.CV'Access,
-                 mutex   => (if Single_Lock
-                             then Single_RTS_Lock'Access
-                             else Self_ID.Common.LL.L'Access),
-                 abstime => Request'Access);
+               Result :=
+                 pthread_cond_timedwait
+                   (cond    => Self_ID.Common.LL.CV'Access,
+                    mutex   => (if Single_Lock
+                                then Single_RTS_Lock'Access
+                                else Self_ID.Common.LL.L'Access),
+                    abstime => Request'Access);
 
-            Check_Time := Monotonic_Clock;
-            exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
+               case Result is
+                  when ETIMEDOUT =>
+                     exit Outer when Exit_Outer;
+                     Check_Time := Monotonic_Clock;
+                     exit Inner;
+
+                  when 0 | EINTR => null;
 
-            pragma Assert (Result in 0 | ETIMEDOUT | EINTR);
-         end loop;
+                  when others =>
+                     pragma Assert (False);
+
+               end case;
+
+               exit Outer
+                  when Abs_Time <= Check_Time or else Check_Time < Base_Time;
+
+            end loop Inner;
+         end loop Outer;
 
          Self_ID.Common.State := Runnable;
       end if;
@@ -277,6 +319,7 @@
          Unlock_RTS;
       end if;
 
+      pragma Unreferenced (Result);
       Result := sched_yield;
    end Timed_Delay;