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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@111022 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 173 insertions, 44 deletions

diff --git a/gcc/ada/a-taster.adb b/gcc/ada/a-taster.adb
index 93374b269a3..8b0be0a22f6 100644
--- a/gcc/ada/a-taster.adb
+++ b/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;
 
diff --git a/gcc/ada/s-solita.adb b/gcc/ada/s-solita.adb
index 5c4b9ed6219..2bc27932632 100644
--- a/gcc/ada/s-solita.adb
+++ b/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
diff --git a/gcc/ada/s-tarest.adb b/gcc/ada/s-tarest.adb
index f0ac3b8de16..6c43d7ce962 100644
--- a/gcc/ada/s-tarest.adb
+++ b/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);
diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads
index da8b8005003..26994efd2c9 100644
--- a/gcc/ada/s-taskin.ads
+++ b/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;
 
    ---------------------------------------
diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index 4ceea414a6d..38c1fca70ed 100644
--- a/gcc/ada/s-tassta.adb
+++ b/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);