diff options
| -rw-r--r-- | gcc/ada/a-taster.adb | 91 | ||||
| -rw-r--r-- | gcc/ada/s-solita.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/s-tarest.adb | 44 | ||||
| -rw-r--r-- | gcc/ada/s-taskin.ads | 18 | ||||
| -rw-r--r-- | gcc/ada/s-tassta.adb | 58 |
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); |