-- --
-- 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 --
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;
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 --
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;
-------------------------------------
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;
--------------------------
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;
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;
-- --
-- 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- --
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
-- --
-- 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- --
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
-- 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);
-- --
-- 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- --
-- 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.
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 --
-- 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
-- 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;
---------------------------------------
-- --
-- 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- --
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
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);
-- 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
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;
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,
-- 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.
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);
projects / platform / upstream / gcc.git / commitdiff