diff options
| -rw-r--r-- | gcc/ada/s-taskin.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/s-tasren.adb | 39 | ||||
| -rw-r--r-- | gcc/ada/s-tasren.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/s-tassta.adb | 31 | ||||
| -rw-r--r-- | gcc/ada/s-tpobop.adb | 42 | ||||
| -rw-r--r-- | gcc/ada/s-tpobop.ads | 6 |
6 files changed, 60 insertions, 69 deletions
diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads index dad836c824c..e8c0653deb6 100644 --- a/gcc/ada/s-taskin.ads +++ b/gcc/ada/s-taskin.ads @@ -799,9 +799,9 @@ package System.Tasking is -- Cancellation of the call has been attempted. -- Consider merging this into State??? - Requeue_With_Abort : Boolean := False; - -- Temporary to tell caller whether requeue is with abort. - -- Find a better way of doing this ??? + With_Abort : Boolean := False; + -- Tell caller whether the call may be aborted + -- ??? consider merging this with Was_Abortable state Needs_Requeue : Boolean := False; -- Temporary to tell acceptor of task entry call that diff --git a/gcc/ada/s-tasren.adb b/gcc/ada/s-tasren.adb index d448b82de26..2af7365554b 100644 --- a/gcc/ada/s-tasren.adb +++ b/gcc/ada/s-tasren.adb @@ -456,6 +456,7 @@ package body System.Tasking.Rendezvous is Entry_Call.Uninterpreted_Data := Uninterpreted_Data; Entry_Call.Called_Task := Acceptor; Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id; + Entry_Call.With_Abort := True; -- Note: the caller will undefer abort on return (see WARNING above) @@ -463,9 +464,7 @@ package body System.Tasking.Rendezvous is Lock_RTS; end if; - if not Task_Do_Or_Queue - (Self_Id, Entry_Call, With_Abort => True) - then + if not Task_Do_Or_Queue (Self_Id, Entry_Call) then STPO.Write_Lock (Self_Id); Utilities.Exit_One_ATC_Level (Self_Id); STPO.Unlock (Self_Id); @@ -646,9 +645,7 @@ package body System.Tasking.Rendezvous is Lock_RTS; end if; - if not Task_Do_Or_Queue - (Self_Id, Entry_Call, Entry_Call.Requeue_With_Abort) - then + if not Task_Do_Or_Queue (Self_Id, Entry_Call) then if Single_Lock then Unlock_RTS; end if; @@ -687,9 +684,7 @@ package body System.Tasking.Rendezvous is end if; else - POO.PO_Do_Or_Queue - (Self_Id, Called_PO, Entry_Call, - Entry_Call.Requeue_With_Abort); + POO.PO_Do_Or_Queue (Self_Id, Called_PO, Entry_Call); POO.PO_Service_Entries (Self_Id, Called_PO); end if; end if; @@ -758,7 +753,7 @@ package body System.Tasking.Rendezvous is Entry_Call.E := Entry_Index (E); Entry_Call.Called_Task := Acceptor; Entry_Call.Called_PO := Null_Address; - Entry_Call.Requeue_With_Abort := With_Abort; + Entry_Call.With_Abort := With_Abort; Object.Call_In_Progress := null; end Requeue_Protected_To_Task_Entry; @@ -777,7 +772,7 @@ package body System.Tasking.Rendezvous is begin Initialization.Defer_Abort (Self_Id); Entry_Call.Needs_Requeue := True; - Entry_Call.Requeue_With_Abort := With_Abort; + Entry_Call.With_Abort := With_Abort; Entry_Call.E := Entry_Index (E); Entry_Call.Called_Task := Acceptor; Initialization.Undefer_Abort (Self_Id); @@ -1102,12 +1097,12 @@ package body System.Tasking.Rendezvous is Unlock_RTS; end if; + Initialization.Undefer_Abort (Self_Id); + -- 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; @@ -1117,8 +1112,7 @@ package body System.Tasking.Rendezvous is function Task_Do_Or_Queue (Self_ID : Task_Id; - Entry_Call : Entry_Call_Link; - With_Abort : Boolean) return Boolean + Entry_Call : Entry_Call_Link) return Boolean is E : constant Task_Entry_Index := Task_Entry_Index (Entry_Call.E); @@ -1273,7 +1267,7 @@ package body System.Tasking.Rendezvous is -- (re)enqueue the call, if the mode permits that. if Entry_Call.Mode /= Conditional_Call - or else not With_Abort + or else not Entry_Call.With_Abort then -- Timed_Call, Simple_Call, or Asynchronous_Call @@ -1283,7 +1277,8 @@ package body System.Tasking.Rendezvous is pragma Assert (Old_State < Done); - Entry_Call.State := New_State (With_Abort, Entry_Call.State); + Entry_Call.State := + New_State (Entry_Call.With_Abort, Entry_Call.State); STPO.Unlock (Acceptor); @@ -1391,14 +1386,13 @@ package body System.Tasking.Rendezvous is Entry_Call.Called_Task := Acceptor; Entry_Call.Called_PO := Null_Address; Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id; + Entry_Call.With_Abort := True; if Single_Lock then Lock_RTS; end if; - if not Task_Do_Or_Queue - (Self_Id, Entry_Call, With_Abort => True) - then + if not Task_Do_Or_Queue (Self_Id, Entry_Call) then STPO.Write_Lock (Self_Id); Utilities.Exit_One_ATC_Level (Self_Id); STPO.Unlock (Self_Id); @@ -1759,6 +1753,7 @@ package body System.Tasking.Rendezvous is Entry_Call.Called_Task := Acceptor; Entry_Call.Called_PO := Null_Address; Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id; + Entry_Call.With_Abort := True; -- Note: the caller will undefer abort on return (see WARNING above) @@ -1766,9 +1761,7 @@ package body System.Tasking.Rendezvous is Lock_RTS; end if; - if not Task_Do_Or_Queue - (Self_Id, Entry_Call, With_Abort => True) - then + if not Task_Do_Or_Queue (Self_Id, Entry_Call) then STPO.Write_Lock (Self_Id); Utilities.Exit_One_ATC_Level (Self_Id); STPO.Unlock (Self_Id); diff --git a/gcc/ada/s-tasren.ads b/gcc/ada/s-tasren.ads index 9225584d99c..67fdc5a1437 100644 --- a/gcc/ada/s-tasren.ads +++ b/gcc/ada/s-tasren.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2005, 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- -- @@ -319,8 +319,7 @@ package System.Tasking.Rendezvous is function Task_Do_Or_Queue (Self_ID : Task_Id; - Entry_Call : Entry_Call_Link; - With_Abort : Boolean) return Boolean; + Entry_Call : Entry_Call_Link) return Boolean; -- Call this only with abort deferred and holding no locks, except -- the global RTS lock when Single_Lock is True which must be owned. -- Returns False iff the call cannot be served or queued, as is the diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb index 28284322f8d..3086a69f6d2 100644 --- a/gcc/ada/s-tassta.adb +++ b/gcc/ada/s-tassta.adb @@ -770,7 +770,7 @@ package body System.Tasking.Stages is pragma Assert (Self_ID = Environment_Task); -- Set Environment_Task'Callable to false to notify library-level tasks - -- that it is waiting for them (cf 5619-003). + -- that it is waiting for them. Self_ID.Callable := False; @@ -798,8 +798,8 @@ package body System.Tasking.Stages is exit when Utilities.Independent_Task_Count = 0; -- We used to yield here, but this did not take into account - -- low priority tasks that would cause dead lock in some cases. - -- See 8126-020. + -- low priority tasks that would cause dead lock in some cases + -- (true FIFO scheduling). Timed_Sleep (Self_ID, 0.01, System.OS_Primitives.Relative, @@ -958,16 +958,22 @@ package body System.Tasking.Stages is Secondary_Stack : aliased SSE.Storage_Array (1 .. Secondary_Stack_Size); pragma Warnings (Off); + -- Why are warnings being turned off here??? + Secondary_Stack_Address : System.Address := Secondary_Stack'Address; - Small_Overflow_Guard : constant := 4 * 1024; - Big_Overflow_Guard : constant := 16 * 1024; - Small_Stack_Limit : constant := 64 * 1024; + Small_Overflow_Guard : constant := 12 * 1024; + -- Note: this used to be 4K, but was changed to 12K, since smaller + -- values resulted in segmentation faults from dynamic stack analysis. + + Big_Overflow_Guard : constant := 16 * 1024; + Small_Stack_Limit : constant := 64 * 1024; -- ??? These three values are experimental, and seems to work on most - -- platforms. They still need to be analyzed further. + -- platforms. They still need to be analyzed further. They also need + -- documentation, what are they??? - Size : - Natural := Natural (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size); + Size : Natural := + Natural (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size); Overflow_Guard : Natural; -- Size of the overflow guard, used by dynamic stack usage analysis @@ -975,7 +981,7 @@ package body System.Tasking.Stages is pragma Warnings (On); -- Address of secondary stack. In the fixed secondary stack case, this -- value is not modified, causing a warning, hence the bracketing with - -- Warnings (Off/On). + -- Warnings (Off/On). But why is so much *more* bracketed ??? SEH_Table : aliased SSE.Storage_Array (1 .. 8); -- Structured Exception Registration table (2 words) @@ -1145,8 +1151,7 @@ package body System.Tasking.Stages is Cause := Abnormal; end if; when others => - -- ??? Using an E : others here causes CD2C11A to fail on - -- DEC Unix, see 7925-005. + -- ??? Using an E : others here causes CD2C11A to fail on Tru64. Initialization.Defer_Abort_Nestable (Self_ID); @@ -1253,7 +1258,7 @@ package body System.Tasking.Stages is -- Since GCC cannot allocate stack chunks efficiently without reordering -- some of the allocations, we have to handle this unexpected situation -- here. We should normally never have to call Vulnerable_Complete_Task - -- here. See 6602-003 for more details. + -- here. if Self_ID.Common.Activator /= null then Vulnerable_Complete_Task (Self_ID); diff --git a/gcc/ada/s-tpobop.adb b/gcc/ada/s-tpobop.adb index 867e51c8f81..25208ad10c0 100644 --- a/gcc/ada/s-tpobop.adb +++ b/gcc/ada/s-tpobop.adb @@ -123,8 +123,7 @@ package body System.Tasking.Protected_Objects.Operations is procedure Requeue_Call (Self_Id : Task_Id; Object : Protection_Entries_Access; - Entry_Call : Entry_Call_Link; - With_Abort : Boolean); + Entry_Call : Entry_Call_Link); -- Handle requeue of Entry_Call. -- In particular, queue the call if needed, or service it immediately -- if possible. @@ -314,8 +313,7 @@ package body System.Tasking.Protected_Objects.Operations is procedure PO_Do_Or_Queue (Self_ID : Task_Id; Object : Protection_Entries_Access; - Entry_Call : Entry_Call_Link; - With_Abort : Boolean) + Entry_Call : Entry_Call_Link) is E : constant Protected_Entry_Index := Protected_Entry_Index (Entry_Call.E); @@ -366,11 +364,11 @@ package body System.Tasking.Protected_Objects.Operations is end if; else - Requeue_Call (Self_ID, Object, Entry_Call, With_Abort); + Requeue_Call (Self_ID, Object, Entry_Call); end if; elsif Entry_Call.Mode /= Conditional_Call - or else not With_Abort + or else not Entry_Call.With_Abort then if Run_Time_Restrictions.Set (Max_Entry_Queue_Length) @@ -396,7 +394,7 @@ package body System.Tasking.Protected_Objects.Operations is end if; else Queuing.Enqueue (Object.Entry_Queues (E), Entry_Call); - Update_For_Queue_To_PO (Entry_Call, With_Abort); + Update_For_Queue_To_PO (Entry_Call, Entry_Call.With_Abort); end if; else -- Conditional_Call and With_Abort @@ -467,8 +465,7 @@ package body System.Tasking.Protected_Objects.Operations is end; if Object.Call_In_Progress = null then - Requeue_Call - (Self_ID, Object, Entry_Call, Entry_Call.Requeue_With_Abort); + Requeue_Call (Self_ID, Object, Entry_Call); exit when Entry_Call.State = Cancelled; else @@ -628,8 +625,9 @@ package body System.Tasking.Protected_Objects.Operations is Entry_Call.Called_PO := To_Address (Object); Entry_Call.Called_Task := null; Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id; + Entry_Call.With_Abort := True; - PO_Do_Or_Queue (Self_ID, Object, Entry_Call, With_Abort => True); + PO_Do_Or_Queue (Self_ID, Object, Entry_Call); Initially_Abortable := Entry_Call.State = Now_Abortable; PO_Service_Entries (Self_ID, Object); @@ -712,8 +710,7 @@ package body System.Tasking.Protected_Objects.Operations is procedure Requeue_Call (Self_Id : Task_Id; Object : Protection_Entries_Access; - Entry_Call : Entry_Call_Link; - With_Abort : Boolean) + Entry_Call : Entry_Call_Link) is New_Object : Protection_Entries_Access; Ceiling_Violation : Boolean; @@ -731,9 +728,7 @@ package body System.Tasking.Protected_Objects.Operations is STPO.Lock_RTS; end if; - Result := Rendezvous.Task_Do_Or_Queue - (Self_Id, Entry_Call, - With_Abort => Entry_Call.Requeue_With_Abort); + Result := Rendezvous.Task_Do_Or_Queue (Self_Id, Entry_Call); if not Result then Queuing.Broadcast_Program_Error @@ -759,7 +754,7 @@ package body System.Tasking.Protected_Objects.Operations is (Self_Id, Object, Entry_Call); else - PO_Do_Or_Queue (Self_Id, New_Object, Entry_Call, With_Abort); + PO_Do_Or_Queue (Self_Id, New_Object, Entry_Call); PO_Service_Entries (Self_Id, New_Object); end if; @@ -772,7 +767,7 @@ package body System.Tasking.Protected_Objects.Operations is STPO.Yield (False); - if Entry_Call.Requeue_With_Abort + if Entry_Call.With_Abort and then Entry_Call.Cancellation_Attempted then -- If this is a requeue with abort and someone tried @@ -782,7 +777,7 @@ package body System.Tasking.Protected_Objects.Operations is return; end if; - if not With_Abort + if not Entry_Call.With_Abort or else Entry_Call.Mode /= Conditional_Call then E := Protected_Entry_Index (Entry_Call.E); @@ -812,11 +807,11 @@ package body System.Tasking.Protected_Objects.Operations is else Queuing.Enqueue (New_Object.Entry_Queues (E), Entry_Call); - Update_For_Queue_To_PO (Entry_Call, With_Abort); + Update_For_Queue_To_PO (Entry_Call, Entry_Call.With_Abort); end if; else - PO_Do_Or_Queue (Self_Id, New_Object, Entry_Call, With_Abort); + PO_Do_Or_Queue (Self_Id, New_Object, Entry_Call); end if; end if; end if; @@ -890,7 +885,7 @@ package body System.Tasking.Protected_Objects.Operations is Entry_Call.E := Entry_Index (E); Entry_Call.Called_PO := To_Address (New_Object); Entry_Call.Called_Task := null; - Entry_Call.Requeue_With_Abort := With_Abort; + Entry_Call.With_Abort := With_Abort; Object.Call_In_Progress := null; end Requeue_Protected_Entry; @@ -935,7 +930,7 @@ package body System.Tasking.Protected_Objects.Operations is -- at this point, and therefore, the caller cannot cancel the call. Entry_Call.Needs_Requeue := True; - Entry_Call.Requeue_With_Abort := With_Abort; + Entry_Call.With_Abort := With_Abort; Entry_Call.Called_PO := To_Address (New_Object); Entry_Call.Called_Task := null; Entry_Call.E := Entry_Index (E); @@ -1022,8 +1017,9 @@ package body System.Tasking.Protected_Objects.Operations is Entry_Call.Called_PO := To_Address (Object); Entry_Call.Called_Task := null; Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id; + Entry_Call.With_Abort := True; - PO_Do_Or_Queue (Self_Id, Object, Entry_Call, With_Abort => True); + PO_Do_Or_Queue (Self_Id, Object, Entry_Call); PO_Service_Entries (Self_Id, Object); if Single_Lock then diff --git a/gcc/ada/s-tpobop.ads b/gcc/ada/s-tpobop.ads index 7c0a5714c1a..0316e0c6564 100644 --- a/gcc/ada/s-tpobop.ads +++ b/gcc/ada/s-tpobop.ads @@ -187,8 +187,7 @@ package System.Tasking.Protected_Objects.Operations is procedure PO_Do_Or_Queue (Self_ID : Task_Id; Object : Entries.Protection_Entries_Access; - Entry_Call : Entry_Call_Link; - With_Abort : Boolean); + Entry_Call : Entry_Call_Link); -- This procedure either executes or queues an entry call, depending -- on the status of the corresponding barrier. It assumes that abort -- is deferred and that the specified object is locked. @@ -201,10 +200,9 @@ private end record; pragma Volatile (Communication_Block); - -- ????? -- The Communication_Block seems to be a relic. At the moment, the -- compiler seems to be generating unnecessary conditional code based on -- this block. See the code generated for async. select with task entry - -- call for another way of solving this. + -- call for another way of solving this ??? end System.Tasking.Protected_Objects.Operations; |