Mercurial > hg > CbC > CbC_gcc
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;