diff options
Diffstat (limited to 'gcc/ada/s-tasren.adb')
| -rw-r--r-- | gcc/ada/s-tasren.adb | 45 |
1 files changed, 25 insertions, 20 deletions
diff --git a/gcc/ada/s-tasren.adb b/gcc/ada/s-tasren.adb index 6fafb39..d448b82 100644 --- a/gcc/ada/s-tasren.adb +++ b/gcc/ada/s-tasren.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -48,7 +48,6 @@ with System.Tasking.Entry_Calls; with System.Tasking.Initialization; -- used for Defer_Abort -- Undefer_Abort --- Poll_Base_Priority_Change -- Do_Pending_Action with System.Tasking.Queuing; @@ -71,6 +70,9 @@ with System.Tasking.Protected_Objects.Operations; with System.Tasking.Debug; -- used for Trace +with System.Restrictions; +-- used for Abort_Allowed + with System.Parameters; -- used for Single_Lock -- Runtime_Traces @@ -476,7 +478,7 @@ package body System.Tasking.Rendezvous is Send_Trace_Info (E_Missed, Acceptor); end if; - Initialization.Undefer_Abort (Self_Id); + Local_Undefer_Abort (Self_Id); raise Tasking_Error; end if; @@ -506,7 +508,7 @@ package body System.Tasking.Rendezvous is Self_Id : constant Task_Id := STPO.Self; begin - Initialization.Defer_Abort (Self_Id); + Initialization.Defer_Abort_Nestable (Self_Id); if Single_Lock then Lock_RTS; @@ -520,7 +522,7 @@ package body System.Tasking.Rendezvous is Unlock_RTS; end if; - Initialization.Undefer_Abort (Self_Id); + Initialization.Undefer_Abort_Nestable (Self_Id); return Result; end Callable; @@ -923,7 +925,11 @@ package body System.Tasking.Rendezvous is then Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data; - pragma Assert (Self_Id.Deferral_Level = 1); + pragma Assert + (Self_Id.Deferral_Level = 1 + or else + (Self_Id.Deferral_Level = 0 + and then not Restrictions.Abort_Allowed)); Initialization.Defer_Abort_Nestable (Self_Id); @@ -1019,7 +1025,6 @@ package body System.Tasking.Rendezvous is Self_Id.Common.State := Delay_Sleep; loop - Initialization.Poll_Base_Priority_Change (Self_Id); exit when Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level; Sleep (Self_Id, Delay_Sleep); @@ -1097,6 +1102,11 @@ package body System.Tasking.Rendezvous is Unlock_RTS; end if; + -- Call Yield to let other tasks get a chance to run as this is a + -- potential dispatching point. + + Yield (Do_Yield => False); + Initialization.Undefer_Abort (Self_Id); return Return_Count; end Task_Count; @@ -1111,7 +1121,7 @@ package body System.Tasking.Rendezvous is With_Abort : Boolean) return Boolean is E : constant Task_Entry_Index := - Task_Entry_Index (Entry_Call.E); + Task_Entry_Index (Entry_Call.E); Old_State : constant Entry_Call_State := Entry_Call.State; Acceptor : constant Task_Id := Entry_Call.Called_Task; Parent : constant Task_Id := Acceptor.Common.Parent; @@ -1119,7 +1129,8 @@ package body System.Tasking.Rendezvous is Null_Body : Boolean; begin - -- Find out whether Entry_Call can be accepted immediately. + -- Find out whether Entry_Call can be accepted immediately + -- If the Acceptor is not callable, return False. -- If the rendezvous can start, initiate it. -- If the accept-body is trivial, also complete the rendezvous. @@ -1562,6 +1573,8 @@ package body System.Tasking.Rendezvous is -- Wait for a normal call and a pending action until the -- Wakeup_Time is reached. + Self_Id.Common.State := Acceptor_Sleep; + -- Try to remove calls to Sleep in the loop below by letting the -- caller a chance of getting ready immediately, using Unlock -- Yield. See similar action in Wait_For_Completion/Wait_For_Call. @@ -1588,10 +1601,7 @@ package body System.Tasking.Rendezvous is Self_Id.Open_Accepts := null; end if; - Self_Id.Common.State := Acceptor_Sleep; - loop - Initialization.Poll_Base_Priority_Change (Self_Id); exit when Self_Id.Open_Accepts = null; if Timedout then @@ -1653,8 +1663,6 @@ package body System.Tasking.Rendezvous is Self_Id.Open_Accepts := null; Self_Id.Common.State := Acceptor_Sleep; - Initialization.Poll_Base_Priority_Change (Self_Id); - STPO.Timed_Sleep (Self_Id, Timeout, Mode, Acceptor_Sleep, Timedout, Yielded); @@ -1799,9 +1807,11 @@ package body System.Tasking.Rendezvous is procedure Wait_For_Call (Self_Id : Task_Id) is begin + Self_Id.Common.State := Acceptor_Sleep; + -- Try to remove calls to Sleep in the loop below by letting the caller -- a chance of getting ready immediately, using Unlock & Yield. - -- See similar action in Wait_For_Completion & Selective_Wait. + -- See similar action in Wait_For_Completion & Timed_Selective_Wait. if Single_Lock then Unlock_RTS; @@ -1825,13 +1835,8 @@ package body System.Tasking.Rendezvous is Self_Id.Open_Accepts := null; end if; - Self_Id.Common.State := Acceptor_Sleep; - loop - Initialization.Poll_Base_Priority_Change (Self_Id); - exit when Self_Id.Open_Accepts = null; - Sleep (Self_Id, Acceptor_Sleep); end loop; |