2008-05-26 Hristian Kirtchev <kirtchev@adacore.com>

	* exp_ch3.adb (Build_Init_Statements): Alphabetize local variables.
	Create the statements which map a string name to protected or task
	entry indix.

	* exp_ch9.adb: Add with and use clause for Stringt.
	Minor code reformatting.
	(Build_Entry_Names): New routine.
	(Make_Initialize_Protection, Make_Task_Create_Call): Generate a value
	for flag Build_Entry_Names which controls the allocation of the data
	structure for the string names of entries.

	* exp_ch9.ads (Build_Entry_Names): New subprogram.

	* exp_util.adb (Entry_Names_OK): New function.

	* exp_util.ads (Entry_Names_OK): New function.

	* rtsfind.ads: Add RO_PE_Set_Entry_Name and RO_TS_Set_Entry_Name to
	enumerations RE_Id and RE_Unit_Table.

	* s-taskin.adb Add with and use clause for Ada.Unchecked_Deallocation.
	(Free_Entry_Names_Array): New routine.

	* s-taskin.ads: Comment reformatting.
	Add types String_Access, Entry_Names_Array, Entry_Names_Array_Access.
	Add component Entry_Names to record Ada_Task_Control_Block.
	(Free_Entry_Names_Array): New routine.

	* s-tassta.adb (Create_Task): If flag Build_Entry_Names is set,
	dynamically allocate an array
	of string pointers. This structure holds string entry names.
	(Free_Entry_Names): New routine.
	(Free_Task, Vulnerable_Free_Task): Deallocate the entry names array.
	(Set_Entry_Names): New routine.

	* s-tassta.ads:
	(Create_Task): Add formal Build_Entry_Names. The flag is used to
	control the allocation of the data structure which stores entry names.
	(Set_Entry_Name): New routine.

	* s-tpoben.adb:
	Add with and use clause for Ada.Unchecked_Conversion.
	(Finalize): Deallocate the entry names array.
	(Free_Entry_Names): New routine.
	(Initialize_Protection_Entries): When flag Build_Entry_Names is set,
	create an array of string pointers to hold the entry names.
	(Set_Entry_Name): New routine.

	* s-tpoben.ads:
	Add field Entry_Names to record Protection_Entries.
	(Initialize_Protection_Entries): Add formal Build_Entry_Names.
	(Set_Entry_Name): New routine.


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

1 files changed, 56 insertions, 8 deletions

diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index d3c6739fb3d..09d9070cd4e 100644
--- a/gcc/ada/s-tassta.adb
+++ b/gcc/ada/s-tassta.adb
@@ -88,6 +88,9 @@ package body System.Tasking.Stages is
    procedure Free is new
      Ada.Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id);
 
+   procedure Free_Entry_Names (T : Task_Id);
+   --  Deallocate all string names associated with task entries
+
    procedure Trace_Unhandled_Exception_In_Task (Self_Id : Task_Id);
    --  This procedure outputs the task specific message for exception
    --  tracing purposes.
@@ -465,7 +468,8 @@ package body System.Tasking.Stages is
       Elaborated        : Access_Boolean;
       Chain             : in out Activation_Chain;
       Task_Image        : String;
-      Created_Task      : out Task_Id)
+      Created_Task      : out Task_Id;
+      Build_Entry_Names : Boolean)
    is
       T, P          : Task_Id;
       Self_ID       : constant Task_Id := STPO.Self;
@@ -605,6 +609,11 @@ package body System.Tasking.Stages is
          T.Common.Task_Image_Len := Len;
       end if;
 
+      if Build_Entry_Names then
+         T.Entry_Names :=
+           new Entry_Names_Array (1 .. Entry_Index (Num_Entries));
+      end if;
+
       Unlock (Self_ID);
       Unlock_RTS;
 
@@ -816,6 +825,26 @@ package body System.Tasking.Stages is
 
    end Finalize_Global_Tasks;
 
+   ----------------------
+   -- Free_Entry_Names --
+   ----------------------
+
+   procedure Free_Entry_Names (T : Task_Id) is
+      Names : Entry_Names_Array_Access := T.Entry_Names;
+
+      procedure Free_Entry_Names_Array_Access is new
+        Ada.Unchecked_Deallocation
+          (Entry_Names_Array, Entry_Names_Array_Access);
+
+   begin
+      if Names = null then
+         return;
+      end if;
+
+      Free_Entry_Names_Array (Names.all);
+      Free_Entry_Names_Array_Access (Names);
+   end Free_Entry_Names;
+
    ---------------
    -- Free_Task --
    ---------------
@@ -837,6 +866,7 @@ package body System.Tasking.Stages is
 
          Initialization.Task_Unlock (Self_Id);
 
+         Free_Entry_Names (T);
          System.Task_Primitives.Operations.Finalize_TCB (T);
 
       --  If the task is not terminated, then we simply ignore the call. This
@@ -895,6 +925,23 @@ package body System.Tasking.Stages is
       Initialization.Undefer_Abort (Self_ID);
    end Move_Activation_Chain;
 
+   --  Compiler interface only. Do not call from within the RTS.
+
+   --------------------
+   -- Set_Entry_Name --
+   --------------------
+
+   procedure Set_Entry_Name
+     (T   : Task_Id;
+      Pos : Task_Entry_Index;
+      Val : String_Access)
+   is
+   begin
+      pragma Assert (T.Entry_Names /= null);
+
+      T.Entry_Names (Entry_Index (Pos)) := Val;
+   end Set_Entry_Name;
+
    ------------------
    -- Task_Wrapper --
    ------------------
@@ -1419,15 +1466,15 @@ package body System.Tasking.Stages is
    --------------------------------
 
    procedure Vulnerable_Complete_Master (Self_ID : Task_Id) is
-      C      : Task_Id;
-      P      : Task_Id;
-      CM     : constant Master_Level := Self_ID.Master_Within;
-      T      : aliased Task_Id;
+      C  : Task_Id;
+      P  : Task_Id;
+      CM : constant Master_Level := Self_ID.Master_Within;
+      T  : aliased Task_Id;
 
       To_Be_Freed : Task_Id;
-      --  This is a list of ATCBs to be freed, after we have released
-      --  all RTS locks. This is necessary because of the locking order
-      --  rules, since the storage manager uses Global_Task_Lock.
+      --  This is a list of ATCBs to be freed, after we have released all RTS
+      --  locks. This is necessary because of the locking order rules, since
+      --  the storage manager uses Global_Task_Lock.
 
       pragma Warnings (Off);
       function Check_Unactivated_Tasks return Boolean;
@@ -1877,6 +1924,7 @@ package body System.Tasking.Stages is
          Unlock_RTS;
       end if;
 
+      Free_Entry_Names (T);
       System.Task_Primitives.Operations.Finalize_TCB (T);
    end Vulnerable_Free_Task;