diff options
author | Doug Rupp <rupp@adacore.com> | 2018-05-25 09:03:47 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2018-05-25 09:03:47 +0000 |
commit | 5865218e3bf9b40d90c210446fa06e04265ffda0 (patch) | |
tree | ed7c0a9b8e15500b04d7858f3e4cf05ca41908e1 /gcc | |
parent | a036d1de575622d6cc7efb8d1de75ce9c4a27de4 (diff) | |
download | gcc-5865218e3bf9b40d90c210446fa06e04265ffda0.zip gcc-5865218e3bf9b40d90c210446fa06e04265ffda0.tar.gz gcc-5865218e3bf9b40d90c210446fa06e04265ffda0.tar.bz2 |
[Ada] Make Max_Sensible_Delay uniform across all Posix targets
For instance: 6 months where Duration is 64bits. Heretofore LynxOS was unique
in having an approximately 12 days max delay. By experimentation the actual
maximum was determined and all relevant delay and sleep procedures rewritten to
incrementally wait if necessary.
2018-05-25 Doug Rupp <rupp@adacore.com>
gcc/ada/
* libgnarl/s-osinte__aix.ads, libgnarl/s-osinte__android.ads,
libgnarl/s-osinte__darwin.ads, libgnarl/s-osinte__freebsd.ads,
libgnarl/s-osinte__hpux.ads, libgnarl/s-osinte__kfreebsd-gnu.ads,
libgnarl/s-osinte__linux.ads, libgnarl/s-osinte__lynxos178e.ads,
libgnarl/s-osinte__qnx.ads, libgnarl/s-osinte__rtems.ads
(Relative_Timed_Wait): Remove.
* libgnarl/s-tpopmo.adb (Timed_Sleep, Timed_Delay): Rewrite to allow
for incremental looping. Remove references to Rel_Time and
Relative_Timed_Wait.
* libgnat/s-osprim__posix.adb, libgnat/s-osprim__posix2008.adb
(Timed_Delay): Make separate.
* libgnat/s-optide.adb: New separate procedure.
* libgnat/s-osprim.ads (Max_System_Delay): New constant.
* libgnat/s-osprim__lynxos.ads (Max_Sensible_Delay): Set to 6 months.
(Max_System_Delay): New constant.
From-SVN: r260724
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 18 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-osinte__aix.ads | 3 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-osinte__android.ads | 3 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-osinte__darwin.ads | 3 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-osinte__freebsd.ads | 3 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-osinte__hpux.ads | 3 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads | 3 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-osinte__linux.ads | 3 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-osinte__lynxos178e.ads | 3 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-osinte__qnx.ads | 3 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-osinte__rtems.ads | 3 | ||||
-rw-r--r-- | gcc/ada/libgnarl/s-tpopmo.adb | 163 | ||||
-rw-r--r-- | gcc/ada/libgnat/s-optide.adb | 84 | ||||
-rw-r--r-- | gcc/ada/libgnat/s-osprim.ads | 4 | ||||
-rw-r--r-- | gcc/ada/libgnat/s-osprim__lynxos.ads | 24 | ||||
-rw-r--r-- | gcc/ada/libgnat/s-osprim__posix.adb | 33 | ||||
-rw-r--r-- | gcc/ada/libgnat/s-osprim__posix2008.adb | 33 |
17 files changed, 229 insertions, 160 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index adb62f5..6f261db 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2018-05-25 Doug Rupp <rupp@adacore.com> + + * libgnarl/s-osinte__aix.ads, libgnarl/s-osinte__android.ads, + libgnarl/s-osinte__darwin.ads, libgnarl/s-osinte__freebsd.ads, + libgnarl/s-osinte__hpux.ads, libgnarl/s-osinte__kfreebsd-gnu.ads, + libgnarl/s-osinte__linux.ads, libgnarl/s-osinte__lynxos178e.ads, + libgnarl/s-osinte__qnx.ads, libgnarl/s-osinte__rtems.ads + (Relative_Timed_Wait): Remove. + * libgnarl/s-tpopmo.adb (Timed_Sleep, Timed_Delay): Rewrite to allow + for incremental looping. Remove references to Rel_Time and + Relative_Timed_Wait. + * libgnat/s-osprim__posix.adb, libgnat/s-osprim__posix2008.adb + (Timed_Delay): Make separate. + * libgnat/s-optide.adb: New separate procedure. + * libgnat/s-osprim.ads (Max_System_Delay): New constant. + * libgnat/s-osprim__lynxos.ads (Max_Sensible_Delay): Set to 6 months. + (Max_System_Delay): New constant. + 2018-05-25 Ed Schonberg <schonberg@adacore.com> * sem_ch12.adb (Validate_Derived_Type_Instance): Verify that the actual diff --git a/gcc/ada/libgnarl/s-osinte__aix.ads b/gcc/ada/libgnarl/s-osinte__aix.ads index a0bee29..928be32 100644 --- a/gcc/ada/libgnarl/s-osinte__aix.ads +++ b/gcc/ada/libgnarl/s-osinte__aix.ads @@ -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 -- -------------------------- diff --git a/gcc/ada/libgnarl/s-osinte__android.ads b/gcc/ada/libgnarl/s-osinte__android.ads index 9825717..2185734 100644 --- a/gcc/ada/libgnarl/s-osinte__android.ads +++ b/gcc/ada/libgnarl/s-osinte__android.ads @@ -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 -- -------------------------- diff --git a/gcc/ada/libgnarl/s-osinte__darwin.ads b/gcc/ada/libgnarl/s-osinte__darwin.ads index 9bb2389..0f9b152 100644 --- a/gcc/ada/libgnarl/s-osinte__darwin.ads +++ b/gcc/ada/libgnarl/s-osinte__darwin.ads @@ -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 -- -------------------------- diff --git a/gcc/ada/libgnarl/s-osinte__freebsd.ads b/gcc/ada/libgnarl/s-osinte__freebsd.ads index 31a7a98..3380e2f 100644 --- a/gcc/ada/libgnarl/s-osinte__freebsd.ads +++ b/gcc/ada/libgnarl/s-osinte__freebsd.ads @@ -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 -- -------------------------- diff --git a/gcc/ada/libgnarl/s-osinte__hpux.ads b/gcc/ada/libgnarl/s-osinte__hpux.ads index 4b05c58..db5f03c 100644 --- a/gcc/ada/libgnarl/s-osinte__hpux.ads +++ b/gcc/ada/libgnarl/s-osinte__hpux.ads @@ -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 -- -------------------------- diff --git a/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads b/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads index 754f6ee..4081873 100644 --- a/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads +++ b/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads @@ -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 -- -------------------------- diff --git a/gcc/ada/libgnarl/s-osinte__linux.ads b/gcc/ada/libgnarl/s-osinte__linux.ads index 5bf4a5f..447f9b5 100644 --- a/gcc/ada/libgnarl/s-osinte__linux.ads +++ b/gcc/ada/libgnarl/s-osinte__linux.ads @@ -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 -- -------------------------- diff --git a/gcc/ada/libgnarl/s-osinte__lynxos178e.ads b/gcc/ada/libgnarl/s-osinte__lynxos178e.ads index 20d983c..5193a35 100644 --- a/gcc/ada/libgnarl/s-osinte__lynxos178e.ads +++ b/gcc/ada/libgnarl/s-osinte__lynxos178e.ads @@ -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 -- -------------------------- diff --git a/gcc/ada/libgnarl/s-osinte__qnx.ads b/gcc/ada/libgnarl/s-osinte__qnx.ads index 36655a9..b1d077b 100644 --- a/gcc/ada/libgnarl/s-osinte__qnx.ads +++ b/gcc/ada/libgnarl/s-osinte__qnx.ads @@ -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 -- -------------------------- diff --git a/gcc/ada/libgnarl/s-osinte__rtems.ads b/gcc/ada/libgnarl/s-osinte__rtems.ads index ab061be..c623c2e 100644 --- a/gcc/ada/libgnarl/s-osinte__rtems.ads +++ b/gcc/ada/libgnarl/s-osinte__rtems.ads @@ -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 -- -------------------------- diff --git a/gcc/ada/libgnarl/s-tpopmo.adb b/gcc/ada/libgnarl/s-tpopmo.adb index f3ee54a..00411b2 100644 --- a/gcc/ada/libgnarl/s-tpopmo.adb +++ b/gcc/ada/libgnarl/s-tpopmo.adb @@ -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; diff --git a/gcc/ada/libgnat/s-optide.adb b/gcc/ada/libgnat/s-optide.adb new file mode 100644 index 0000000..83245d6 --- /dev/null +++ b/gcc/ada/libgnat/s-optide.adb @@ -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; diff --git a/gcc/ada/libgnat/s-osprim.ads b/gcc/ada/libgnat/s-osprim.ads index 2df0a8e..e3484d4 100644 --- a/gcc/ada/libgnat/s-osprim.ads +++ b/gcc/ada/libgnat/s-osprim.ads @@ -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 diff --git a/gcc/ada/libgnat/s-osprim__lynxos.ads b/gcc/ada/libgnat/s-osprim__lynxos.ads index d713a76..51aa149 100644 --- a/gcc/ada/libgnat/s-osprim__lynxos.ads +++ b/gcc/ada/libgnat/s-osprim__lynxos.ads @@ -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 diff --git a/gcc/ada/libgnat/s-osprim__posix.adb b/gcc/ada/libgnat/s-osprim__posix.adb index ed28d86..6e1ad9a 100644 --- a/gcc/ada/libgnat/s-osprim__posix.adb +++ b/gcc/ada/libgnat/s-osprim__posix.adb @@ -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 -- diff --git a/gcc/ada/libgnat/s-osprim__posix2008.adb b/gcc/ada/libgnat/s-osprim__posix2008.adb index c6b0405..2e717a9 100644 --- a/gcc/ada/libgnat/s-osprim__posix2008.adb +++ b/gcc/ada/libgnat/s-osprim__posix2008.adb @@ -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 -- |