[Ada] improve handling of requeue stmts
Arnaud Charlet
charlet@adacore.com
Wed Aug 29 08:36:00 GMT 2007
Tested on i686-linux, committed on trunk
Code clean up: simplify handling of 'requeue with/without abort' statements.
Fixes also the following bug: in case of a requeue without abort performed at
the beginning of a timed entry call, the "without abort" information was lost.
See gnat.dg/requeue1.adb which should not output anything.
* s-tpobop.ads, s-tpobop.adb, s-tasren.ads, s-tasren.adb,
s-taskin.ads (Requeue_With_Abort): Rename field With_Abort.
(PO_Do_Or_Queue, Task_Do_Or_Queue, Requeue_Call): Remove With_Abort
parameter.
* s-tassta.adb (Task_Wrapper): Increased value of the small overflow
guard to 12K.
-------------- next part --------------
Index: s-tpobop.ads
===================================================================
--- s-tpobop.ads (revision 127358)
+++ s-tpobop.ads (working copy)
@@ -187,8 +187,7 @@ package System.Tasking.Protected_Objects
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;
Index: s-tpobop.adb
===================================================================
--- s-tpobop.adb (revision 127358)
+++ s-tpobop.adb (working copy)
@@ -123,8 +123,7 @@ package body System.Tasking.Protected_Ob
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_Ob
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_Ob
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_Ob
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_Ob
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_Ob
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_Ob
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_Ob
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_Ob
(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_Ob
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_Ob
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_Ob
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_Ob
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_Ob
-- 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_Ob
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
Index: s-tasren.ads
===================================================================
--- s-tasren.ads (revision 127358)
+++ s-tasren.ads (working copy)
@@ -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
Index: s-tasren.adb
===================================================================
--- s-tasren.adb (revision 127358)
+++ s-tasren.adb (working copy)
@@ -456,6 +456,7 @@ package body System.Tasking.Rendezvous i
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 i
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 i
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 i
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 i
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 i
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 i
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 i
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 i
-- (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 i
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 i
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 i
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 i
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);
Index: s-taskin.ads
===================================================================
--- s-taskin.ads (revision 127358)
+++ s-taskin.ads (working copy)
@@ -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
Index: s-tassta.adb
===================================================================
--- s-tassta.adb (revision 127358)
+++ s-tassta.adb (working copy)
@@ -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);
More information about the Gcc-patches
mailing list