Skip to content

R
riscv-gcc-1
Commit 20dedfc1 by Arnaud Charlet
Options

s-tpobop.ads, [...] (Requeue_With_Abort): Rename field With_Abort. 

2007-08-14  Arnaud Charlet  <charlet@adacore.com>

	* 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.

From-SVN: r127464
parent cc8be39e
Showing with 60 additions and 69 deletions
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
......
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);
......
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
......
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);
......
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
......
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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment