Skip to content

R
riscv-gcc-1
Commit 85a40c43 by Jose Ruiz Committed by Arnaud Charlet
Options

a-taster.adb (Current_Task_Fallback_Handler): Document why explicit protection… 

a-taster.adb (Current_Task_Fallback_Handler): Document why explicit protection against race conditions is not needed.

2006-02-13  Jose Ruiz  <ruiz@adacore.com>

	* a-taster.adb (Current_Task_Fallback_Handler): Document why explicit
	protection against race conditions is not needed.
	(Set_Dependents_Fallback_Handler): Add mutual exclusive access to the
	fallback handler.
	(Set_Specific_Handler): Add mutual exclusive access to the specific
	handler.
	(Specific_Handler): Add mutual exclusive access for retrieving the
	specific handler.

	* s-tarest.adb (Task_Wrapper): Add mutual exclusive access to the fall
	back handler.

	* s-taskin.ads (Common_ATCB): Remove pragma Atomic for
	Fall_Back_Handler and Specific_Handler.

	* s-tassta.adb (Task_Wrapper): Add mutual exclusive access to the task
	termination handlers.
	Set two different owerflow depending on the maximal stack size.

	* s-solita.adb (Task_Termination_Handler_T): Document why explicit
	protection against race conditions is not needed when executing the
	task termination handler.

From-SVN: r111022
parent ed50c9d2
Showing with 173 additions and 44 deletions
gcc/ada/a-taster.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2005, Free Software Foundation, Inc. --
-- Copyright (C) 2005-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -40,6 +40,17 @@ with System.Tasking;
with System.Task_Primitives.Operations;
-- used for Self
-- Write_Lock
-- Unlock
-- Lock_RTS
-- Unlock_RTS
with System.Parameters;
-- used for Single_Lock
with System.Soft_Links;
-- use for Abort_Defer
-- Abort_Undefer
with Unchecked_Conversion;
......@@ -48,6 +59,9 @@ package body Ada.Task_Termination is
use type Ada.Task_Identification.Task_Id;
package STPO renames System.Task_Primitives.Operations;
package SSL renames System.Soft_Links;
use System.Parameters;
-----------------------
-- Local subprograms --
......@@ -68,7 +82,11 @@ package body Ada.Task_Termination is
function Current_Task_Fallback_Handler return Termination_Handler is
begin
return To_TT (System.Tasking.Self.Common.Fall_Back_Handler);
-- There is no need for explicit protection against race conditions
-- for this function because this function can only be executed by
-- Self, and the Fall_Back_Handler can only be modified by Self.
return To_TT (STPO.Self.Common.Fall_Back_Handler);
end Current_Task_Fallback_Handler;
-------------------------------------
......@@ -78,8 +96,26 @@ package body Ada.Task_Termination is
procedure Set_Dependents_Fallback_Handler
(Handler : Termination_Handler)
is
Self : constant System.Tasking.Task_Id := STPO.Self;
begin
STPO.Self.Common.Fall_Back_Handler := To_ST (Handler);
SSL.Abort_Defer.all;
if Single_Lock then
STPO.Lock_RTS;
end if;
STPO.Write_Lock (Self);
Self.Common.Fall_Back_Handler := To_ST (Handler);
STPO.Unlock (Self);
if Single_Lock then
STPO.Unlock_RTS;
end if;
SSL.Abort_Undefer.all;
end Set_Dependents_Fallback_Handler;
--------------------------
......@@ -100,7 +136,28 @@ package body Ada.Task_Termination is
elsif Ada.Task_Identification.Is_Terminated (T) then
raise Tasking_Error;
else
To_Task_Id (T).Common.Specific_Handler := To_ST (Handler);
declare
Target : constant System.Tasking.Task_Id := To_Task_Id (T);
begin
SSL.Abort_Defer.all;
if Single_Lock then
STPO.Lock_RTS;
end if;
STPO.Write_Lock (Target);
Target.Common.Specific_Handler := To_ST (Handler);
STPO.Unlock (Target);
if Single_Lock then
STPO.Unlock_RTS;
end if;
SSL.Abort_Undefer.all;
end;
end if;
end Set_Specific_Handler;
......@@ -121,7 +178,31 @@ package body Ada.Task_Termination is
elsif Ada.Task_Identification.Is_Terminated (T) then
raise Tasking_Error;
else
return To_TT (To_Task_Id (T).Common.Specific_Handler);
declare
Target : constant System.Tasking.Task_Id := To_Task_Id (T);
TH : Termination_Handler;
begin
SSL.Abort_Defer.all;
if Single_Lock then
STPO.Lock_RTS;
end if;
STPO.Write_Lock (Target);
TH := To_TT (Target.Common.Specific_Handler);
STPO.Unlock (Target);
if Single_Lock then
STPO.Unlock_RTS;
end if;
SSL.Abort_Undefer.all;
return TH;
end;
end if;
end Specific_Handler;
......
gcc/ada/s-solita.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2006, Free Software Foundation, Inc. --
-- --
-- GNAT 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- --
......@@ -185,6 +185,10 @@ package body System.Soft_Links.Tasking is
Ada.Exceptions.Save_Occurrence (EO, Excep);
end if;
-- There is no need for explicit protection against race conditions
-- for this part because it can only be executed by the environment
-- task after all the other tasks have been finalized.
if Self_Id.Common.Specific_Handler /= null then
Self_Id.Common.Specific_Handler.all (Cause, Self_Id, EO);
elsif Self_Id.Common.Fall_Back_Handler /= null then
......
gcc/ada/s-tarest.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1999-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1999-2006, 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,13 +48,6 @@ pragma Polling (Off);
with Ada.Exceptions;
-- used for Exception_Occurrence
with System.Parameters;
-- used for Size_Type
-- Single_Lock
with System.Task_Info;
-- used for Task_Info_Type
with System.Task_Primitives.Operations;
-- used for Enter_Task
-- Write_Lock
......@@ -268,11 +261,38 @@ package body System.Tasking.Restricted.Stages is
-- neither task hierarchies (No_Task_Hierarchy) nor specific task
-- termination handlers (No_Specific_Termination_Handlers).
-- There is no need for explicit protection against race conditions
-- for Self_ID.Common.Fall_Back_Handler because this procedure can
-- only be executed by Self, and the Fall_Back_Handler can only be
-- modified by Self.
if Self_ID.Common.Fall_Back_Handler /= null then
Self_ID.Common.Fall_Back_Handler.all (Cause, Self_ID, EO);
elsif Self_ID.Common.Parent.Common.Fall_Back_Handler /= null then
Self_ID.Common.Parent.Common.Fall_Back_Handler.all
(Cause, Self_ID, EO);
Self_ID.Common.Fall_Back_Handler (Cause, Self_ID, EO);
else
declare
TH : Termination_Handler := null;
begin
if Single_Lock then
Lock_RTS;
end if;
Write_Lock (Self_ID.Common.Parent);
TH := Self_ID.Common.Parent.Common.Fall_Back_Handler;
Unlock (Self_ID.Common.Parent);
if Single_Lock then
Unlock_RTS;
end if;
-- Execute the task termination handler if we found it
if TH /= null then
TH.all (Cause, Self_ID, EO);
end if;
end;
end if;
Terminate_Task (Self_ID);
......
gcc/ada/s-taskin.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -353,9 +353,9 @@ package System.Tasking is
-- raised by by the execution of its task_body.
type Termination_Handler is access protected procedure
(Cause : in Cause_Of_Termination;
T : in Task_Id;
X : in Ada.Exceptions.Exception_Occurrence);
(Cause : Cause_Of_Termination;
T : Task_Id;
X : Ada.Exceptions.Exception_Occurrence);
-- Used to represent protected procedures to be executed when task
-- terminates.
......@@ -375,7 +375,7 @@ package System.Tasking is
function Detect_Blocking return Boolean;
pragma Inline (Detect_Blocking);
-- Return whether the Detect_Blocking pragma is enabled.
-- Return whether the Detect_Blocking pragma is enabled
----------------------------------------------
-- Ada_Task_Control_Block (ATCB) definition --
......@@ -571,7 +571,7 @@ package System.Tasking is
-- Task_Info pragma.
Analyzer : System.Stack_Usage.Stack_Analyzer;
-- For storing informations used to measure the stack usage.
-- For storing informations used to measure the stack usage
Global_Task_Lock_Nesting : Natural;
-- This is the current nesting level of calls to
......@@ -583,18 +583,16 @@ package System.Tasking is
-- Protection: Only accessed by Self
Fall_Back_Handler : Termination_Handler;
pragma Atomic (Fall_Back_Handler);
-- This is the fall-back handler that applies to the dependent tasks of
-- the task.
--
-- Protection: atomic access
-- Protection: Self.L
Specific_Handler : Termination_Handler;
pragma Atomic (Specific_Handler);
-- This is the specific handler that applies only to this task, and not
-- any of its dependent tasks.
--
-- Protection: atomic access
-- Protection: Self.L
end record;
---------------------------------------
......
gcc/ada/s-tassta.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -44,14 +44,6 @@ with System.Tasking.Debug;
with System.Address_Image;
-- Used for the function itself
with System.Parameters;
-- Used for Size_Type
-- Single_Lock
-- Runtime_Traces
with System.Task_Info;
-- Used for Task_Info_Type
with System.Task_Primitives.Operations;
-- Used for Finalize_Lock
-- Enter_Task
......@@ -907,7 +899,11 @@ package body System.Tasking.Stages is
pragma Warnings (Off);
Secondary_Stack_Address : System.Address := Secondary_Stack'Address;
Overflow_Guard : constant := 16#1_000#;
Small_Overflow_Guard : constant := 4 * 1024;
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.
Size :
Natural := Natural (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size);
......@@ -938,16 +934,22 @@ package body System.Tasking.Stages is
-- execution of its task body, then EO will contain the associated
-- exception occurrence. Otherwise, it will contain Null_Occurrence.
TH : Termination_Handler := null;
-- Pointer to the protected procedure to be executed upon task
-- termination.
procedure Search_Fall_Back_Handler (ID : Task_Id);
-- Procedure that searches recursively a fall-back handler through the
-- master relationship.
-- master relationship. If the handler is found, its pointer is stored
-- in TH.
procedure Search_Fall_Back_Handler (ID : Task_Id) is
begin
-- If there is a fall back handler, execute it
-- If there is a fall back handler, store its pointer for later
-- execution.
if ID.Common.Fall_Back_Handler /= null then
ID.Common.Fall_Back_Handler.all (Cause, Self_ID, EO);
TH := ID.Common.Fall_Back_Handler;
-- Otherwise look for a fall back handler in the parent
......@@ -964,6 +966,14 @@ package body System.Tasking.Stages is
begin
pragma Assert (Self_ID.Deferral_Level = 1);
-- Assume a size of the stack taken at this stage
if Size < Small_Stack_Limit then
Size := Size - Small_Overflow_Guard;
else
Size := Size - Big_Overflow_Guard;
end if;
if not Parameters.Sec_Stack_Dynamic then
Self_ID.Common.Compiler_Data.Sec_Stack_Addr :=
Secondary_Stack'Address;
......@@ -971,8 +981,6 @@ package body System.Tasking.Stages is
Size := Size - Natural (Secondary_Stack_Size);
end if;
Size := Size - Overflow_Guard;
if System.Stack_Usage.Is_Enabled then
STPO.Lock_RTS;
Initialize_Analyzer (Self_ID.Common.Analyzer,
......@@ -1096,8 +1104,14 @@ package body System.Tasking.Stages is
-- the environment task. The task termination code for the environment
-- task is executed by SSL.Task_Termination_Handler.
if Single_Lock then
Lock_RTS;
end if;
Write_Lock (Self_ID);
if Self_ID.Common.Specific_Handler /= null then
Self_ID.Common.Specific_Handler.all (Cause, Self_ID, EO);
TH := Self_ID.Common.Specific_Handler;
else
-- Look for a fall-back handler following the master relationship
-- for the task.
......@@ -1105,6 +1119,18 @@ package body System.Tasking.Stages is
Search_Fall_Back_Handler (Self_ID);
end if;
Unlock (Self_ID);
if Single_Lock then
Unlock_RTS;
end if;
-- Execute the task termination handler if we found it
if TH /= null then
TH.all (Cause, Self_ID, EO);
end if;
if System.Stack_Usage.Is_Enabled then
Compute_Result (Self_ID.Common.Analyzer);
Report_Result (Self_ID.Common.Analyzer);
......
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