@@ -420,9 +420,6 @@ package System.OS_Interface is
abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
- Relative_Timed_Wait : constant Boolean := False;
- -- pthread_cond_timedwait requires an absolute delay time
-
--------------------------
-- POSIX.1c Section 13 --
--------------------------
@@ -414,9 +414,6 @@ package System.OS_Interface is
abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
- Relative_Timed_Wait : constant Boolean := False;
- -- pthread_cond_timedwait requires an absolute delay time
-
--------------------------
-- POSIX.1c Section 13 --
--------------------------
@@ -397,9 +397,6 @@ package System.OS_Interface is
abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
- Relative_Timed_Wait : constant Boolean := False;
- -- pthread_cond_timedwait requires an absolute delay time
-
--------------------------
-- POSIX.1c Section 13 --
--------------------------
@@ -431,9 +431,6 @@ package System.OS_Interface is
abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
- Relative_Timed_Wait : constant Boolean := False;
- -- pthread_cond_timedwait requires an absolute delay time
-
--------------------------
-- POSIX.1c Section 13 --
--------------------------
@@ -400,9 +400,6 @@ package System.OS_Interface is
abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
- Relative_Timed_Wait : constant Boolean := False;
- -- pthread_cond_timedwait requires an absolute delay time
-
--------------------------
-- POSIX.1c Section 13 --
--------------------------
@@ -430,9 +430,6 @@ package System.OS_Interface is
abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
- Relative_Timed_Wait : constant Boolean := False;
- -- pthread_cond_timedwait requires an absolute delay time
-
--------------------------
-- POSIX.1c Section 13 --
--------------------------
@@ -448,9 +448,6 @@ package System.OS_Interface is
abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
- Relative_Timed_Wait : constant Boolean := False;
- -- pthread_cond_timedwait requires an absolute delay time
-
--------------------------
-- POSIX.1c Section 13 --
--------------------------
@@ -420,9 +420,6 @@ package System.OS_Interface is
abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
- Relative_Timed_Wait : constant Boolean := False;
- -- pthread_cond_timedwait requires an absolute delay time
-
--------------------------
-- POSIX.1c Section 13 --
--------------------------
@@ -417,9 +417,6 @@ package System.OS_Interface is
abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
- Relative_Timed_Wait : constant Boolean := False;
- -- pthread_cond_timedwait requires an absolute delay time
-
--------------------------
-- POSIX.1c Section 13 --
--------------------------
@@ -426,9 +426,6 @@ package System.OS_Interface is
abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
- Relative_Timed_Wait : constant Boolean := False;
- -- pthread_cond_timedwait requires an absolute delay time
-
--------------------------
-- POSIX.1c Section 13 --
--------------------------
@@ -42,11 +42,10 @@ package body Monotonic is
(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 @@ package body Monotonic is
(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 @@ package body Monotonic is
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 @@ package body Monotonic is
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 @@ package body Monotonic is
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 @@ package body Monotonic is
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 @@ package body Monotonic is
(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);
- Check_Time := Monotonic_Clock;
- exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
+ Request := To_Timespec (P_Abs_Time);
- if Result in 0 | EINTR then
+ Inner : loop
+ exit Outer
+ when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
- -- Somebody may have called Wakeup for us
+ 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);
- Timedout := False;
- exit;
- end if;
+ case Result is
+ when 0 | EINTR =>
+ -- Somebody may have called Wakeup for us
+ Timedout := False;
+ exit Outer;
- pragma Assert (Result = ETIMEDOUT);
- end loop;
+ when ETIMEDOUT =>
+ exit Outer when Exit_Outer;
+ Check_Time := Monotonic_Clock;
+ exit Inner;
+
+ 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;
end if;
end Timed_Sleep;
@@ -225,11 +237,11 @@ package body Monotonic is
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 @@ package body Monotonic is
(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);
+
+ case Result is
+ when ETIMEDOUT =>
+ exit Outer when Exit_Outer;
+ Check_Time := Monotonic_Clock;
+ exit Inner;
+
+ when 0 | EINTR => null;
+
+ when others =>
+ pragma Assert (False);
- 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);
+ end case;
- Check_Time := Monotonic_Clock;
- exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
+ exit Outer
+ when Abs_Time <= Check_Time or else Check_Time < Base_Time;
- pragma Assert (Result in 0 | ETIMEDOUT | EINTR);
- end loop;
+ end loop Inner;
+ end loop Outer;
Self_ID.Common.State := Runnable;
end if;
@@ -277,6 +319,7 @@ package body Monotonic is
Unlock_RTS;
end if;
+ pragma Unreferenced (Result);
Result := sched_yield;
end Timed_Delay;
new file mode 100644
@@ -0,0 +1,84 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- S Y S T E M . O S _ P R I M I T I V E S. T I M E D _ D E L A Y --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2012-2018, AdaCore --
+-- --
+-- GNAT 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This is the Posix, Posix2008, and LynxOS version of this procedure.
+
+separate (System.OS_Primitives)
+procedure Timed_Delay
+ (Time : Duration;
+ Mode : Integer)
+is
+ Request : aliased timespec;
+ Remaind : aliased timespec;
+ Rel_Time : Duration;
+ Abs_Time : Duration;
+ Base_Time : constant Duration := Clock;
+ Check_Time : Duration := Base_Time;
+ Time_Chunk : Duration;
+
+ Result : Integer;
+ pragma Unreferenced (Result);
+
+begin
+ if Mode = Relative then
+ Rel_Time := Time;
+ Abs_Time := Time + Check_Time;
+ else
+ Rel_Time := Time - Check_Time;
+ Abs_Time := Time;
+ end if;
+
+ -- 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 Rel_Time > 0.0 then
+ Time_Chunk := Rel_Time;
+ loop
+ pragma Warnings (Off, "condition is always *");
+ if Max_System_Delay < Max_Sensible_Delay and then
+ Time_Chunk > Max_System_Delay
+ then
+ Time_Chunk := Max_System_Delay;
+ end if;
+ pragma Warnings (On);
+
+ Request := To_Timespec (Time_Chunk);
+ Result := nanosleep (Request'Access, Remaind'Access);
+
+ Check_Time := Clock;
+
+ exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
+
+ Time_Chunk := Abs_Time - Check_Time;
+ end loop;
+ end if;
+end Timed_Delay;
@@ -52,6 +52,10 @@ package System.OS_Primitives is
-- with 32-bit words, and possibly on some specific ports of GNAT),
-- Duration'Last is used instead.
+ Max_System_Delay : constant Duration := Max_Sensible_Delay;
+ -- If the Max_System_Delay is larger it doesn't matter. Setting it equal
+ -- allows optimization of code in some targets delay functions.
+
procedure Initialize;
-- Initialize global settings related to this package. This procedure
-- should be called before any other subprograms in this package. Note
@@ -40,12 +40,24 @@
package System.OS_Primitives is
pragma Preelaborate;
- Max_Sensible_Delay : constant Duration := 16#10_0000.0#;
- -- LynxOS does not support delays as long as half a year, so we set this to
- -- a shorter, but still fairly long, duration. Experiments show that if
- -- pthread_cond_timedwait is passed an abstime much greater than about
- -- 2**21, it fails, returning EAGAIN. The cutoff is somewhere between
- -- 16#20_8000.0# and 16#20_F000.0#. This behavior is not documented.
+ Max_Sensible_Delay : constant Duration :=
+ Duration'Min (183 * 24 * 60 * 60.0,
+ Duration'Last);
+ -- Max of half a year delay, needed to prevent exceptions for large delay
+ -- values. It seems unlikely that any test will notice this restriction,
+ -- except in the case of applications setting the clock at run time (see
+ -- s-tastim.adb). Also note that a larger value might cause problems (e.g
+ -- overflow, or more likely OS limitation in the primitives used). In the
+ -- case where half a year is too long (which occurs in high integrity mode
+ -- with 32-bit words, and possibly on some specific ports of GNAT),
+ -- Duration'Last is used instead.
+
+ Max_System_Delay : constant Duration := 2147483.0;
+ -- Note that Max_System_Delay is 2**31 / 1000 truncated.
+ -- LynxOS does not support delays as long as half a year, only the
+ -- number of seconds noted in Max_System_Delay, which is used to split
+ -- delays into chunks no larger than what the system can handle. This
+ -- maximum was found by experiment and is not documented.
procedure Initialize;
-- Initialize global settings related to this package. This procedure
@@ -127,38 +127,7 @@ package body System.OS_Primitives is
procedure Timed_Delay
(Time : Duration;
Mode : Integer)
- is
- Request : aliased timespec;
- Remaind : aliased timespec;
- Rel_Time : Duration;
- Abs_Time : Duration;
- Base_Time : constant Duration := Clock;
- Check_Time : Duration := Base_Time;
-
- Result : Integer;
- pragma Unreferenced (Result);
-
- begin
- if Mode = Relative then
- Rel_Time := Time;
- Abs_Time := Time + Check_Time;
- else
- Rel_Time := Time - Check_Time;
- Abs_Time := Time;
- end if;
-
- if Rel_Time > 0.0 then
- loop
- Request := To_Timespec (Rel_Time);
- Result := nanosleep (Request'Access, Remaind'Access);
- Check_Time := Clock;
-
- exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
-
- Rel_Time := Abs_Time - Check_Time;
- end loop;
- end if;
- end Timed_Delay;
+ is separate;
----------------
-- Initialize --
@@ -127,38 +127,7 @@ package body System.OS_Primitives is
procedure Timed_Delay
(Time : Duration;
Mode : Integer)
- is
- Request : aliased timespec;
- Remaind : aliased timespec;
- Rel_Time : Duration;
- Abs_Time : Duration;
- Base_Time : constant Duration := Clock;
- Check_Time : Duration := Base_Time;
-
- Result : Integer;
- pragma Unreferenced (Result);
-
- begin
- if Mode = Relative then
- Rel_Time := Time;
- Abs_Time := Time + Check_Time;
- else
- Rel_Time := Time - Check_Time;
- Abs_Time := Time;
- end if;
-
- if Rel_Time > 0.0 then
- loop
- Request := To_Timespec (Rel_Time);
- Result := nanosleep (Request'Access, Remaind'Access);
- Check_Time := Clock;
-
- exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
-
- Rel_Time := Abs_Time - Check_Time;
- end loop;
- end if;
- end Timed_Delay;
+ is separate;
----------------
-- Initialize --