exp_ch3.adb (Build_Init_Statements): Alphabetize local variables.

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.

From-SVN: r135896

1 files changed, 54 insertions, 2 deletions

diff --git a/gcc/ada/s-tpoben.adb b/gcc/ada/s-tpoben.adb
index 986a30a..3812695 100644
--- a/gcc/ada/s-tpoben.adb
+++ b/gcc/ada/s-tpoben.adb
@@ -43,6 +43,8 @@
 
 --  Note: the compiler generates direct calls to this interface, via Rtsfind
 
+with Ada.Unchecked_Deallocation;
+
 with System.Task_Primitives.Operations;
 with System.Restrictions;
 with System.Parameters;
@@ -58,6 +60,13 @@ package body System.Tasking.Protected_Objects.Entries is
    use Parameters;
    use Task_Primitives.Operations;
 
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
+
+   procedure Free_Entry_Names (Object : Protection_Entries);
+   --  Deallocate all string names associated with protected entries
+
    ----------------
    -- Local Data --
    ----------------
@@ -134,6 +143,8 @@ package body System.Tasking.Protected_Objects.Entries is
          end loop;
       end loop;
 
+      Free_Entry_Names (Object);
+
       Object.Finalized := True;
 
       if Single_Lock then
@@ -145,6 +156,26 @@ package body System.Tasking.Protected_Objects.Entries is
       STPO.Finalize_Lock (Object.L'Unrestricted_Access);
    end Finalize;
 
+   ----------------------
+   -- Free_Entry_Names --
+   ----------------------
+
+   procedure Free_Entry_Names (Object : Protection_Entries) is
+      Names : Entry_Names_Array_Access := Object.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;
+
    -----------------
    -- Get_Ceiling --
    -----------------
@@ -177,14 +208,15 @@ package body System.Tasking.Protected_Objects.Entries is
       Ceiling_Priority  : Integer;
       Compiler_Info     : System.Address;
       Entry_Bodies      : Protected_Entry_Body_Access;
-      Find_Body_Index   : Find_Body_Index_Access)
+      Find_Body_Index   : Find_Body_Index_Access;
+      Build_Entry_Names : Boolean)
    is
       Init_Priority : Integer := Ceiling_Priority;
       Self_ID       : constant Task_Id := STPO.Self;
 
    begin
       if Init_Priority = Unspecified_Priority then
-         Init_Priority  := System.Priority'Last;
+         Init_Priority := System.Priority'Last;
       end if;
 
       if Locking_Policy = 'C'
@@ -213,6 +245,11 @@ package body System.Tasking.Protected_Objects.Entries is
          Object.Entry_Queues (E).Head := null;
          Object.Entry_Queues (E).Tail := null;
       end loop;
+
+      if Build_Entry_Names then
+         Object.Entry_Names :=
+           new Entry_Names_Array (1 .. Entry_Index (Object.Num_Entries));
+      end if;
    end Initialize_Protection_Entries;
 
    ------------------
@@ -358,6 +395,21 @@ package body System.Tasking.Protected_Objects.Entries is
    end Set_Ceiling;
 
    --------------------
+   -- Set_Entry_Name --
+   --------------------
+
+   procedure Set_Entry_Name
+     (Object : Protection_Entries'Class;
+      Pos    : Protected_Entry_Index;
+      Val    : String_Access)
+   is
+   begin
+      pragma Assert (Object.Entry_Names /= null);
+
+      Object.Entry_Names (Entry_Index (Pos)) := Val;
+   end Set_Entry_Name;
+
+   --------------------
    -- Unlock_Entries --
    --------------------