Patchwork [Ada] Static entry [family] names for VMS Debug

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 29, 2012, 11:09 a.m.
Message ID <20121029110956.GA21707@adacore.com>
Download mbox | patch
Permalink /patch/194969/
State New
Headers show

Comments

Arnaud Charlet - Oct. 29, 2012, 11:09 a.m.
This patch reimplements the mechanism which creates string names for entries
and families. The names are now created statically during object initialization
and associated with the concurrent object's Protection_Entries or ATCB. This
approach eliminates the need for runtime support (allocation, deallocation) of
the names.

No simple test as this requires VMS and gdb to demonstrate

Tested on x86_64-pc-linux-gnu, committed on trunk

2012-10-29  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch3.adb (Build_Initialization_Call): Create static strings
	which denote entry [family] names and associate them with the
	object's Protection_Entries or ATCB.
	(Build_Init_Statements):
	Remove local variable Names. Do not generate the entry [family]
	names inside the init proc because they are now static.
	* exp_ch9.adb (Build_Entry_Names): Reimplemented. The strings
	which denote entry [family] names are now generated statically
	and associated with the concurrent object's Protection_Entries
	or ATCB during initialization.
	* exp_ch9.ads (Build_Entry_Names): Change subprogram profile
	and associated comment on usage.
	* rtsfind.ads: Add the following entries to tables RE_Id and
	RE_Unit_Table:

	RE_Protected_Entry_Names_Array RE_Task_Entry_Names_Array
	RO_PE_Number_Of_Entries RO_PE_Set_Entry_Names
	RO_ST_Number_Of_Entries RO_ST_Set_Entry_Names

	Remove the following entries from tables RE_Id and RE_Unit_Table:

	RO_PE_Set_Entry_Name RO_TS_Set_Entry_Name

	* s-taskin.adb: Remove with clause for Ada.Unchecked_Deallocation.
	(Free_Entry_Names_Array): Removed.
	(Number_Of_Entries): New routine.
	(Set_Entry_Names): New routine.
	* s-taskin.ads: Rename type Entry_Names_Array to
	Task_Entry_Names_Array. Rename type Entry_Names_Array_Access
	to Task_Entry_Names_Access. Update the type of ACTB field
	Entry_Names and add a comment on its protection status.
	(Free_Entry_Names_Array): Removed.
	(Number_Of_Entries): New routine.
	(Set_Entry_Names): New routine.
	* s-tassta.adb (Create_Task): Remove formal parameter
	Build_Entry_Names. Do not allocate an array to hold the
	string names of entries and families.
	(Free_Entry_Names): Removed.
	(Free_Task): Remove the call to Free_Entry_Names.
	(Set_Entry_Name): Removed.
	(Vulnerable_Free_Task): Remove the call to Free_Entry_Names.
	* s-tassta.ads (Create_Task): Remove formal parameter
	Build_Entry_Names along with associated comment.
	(Set_Entry_Name): Removed.
	* s-tpoben.adb: Remove with clause for Ada.Unchecked_Deallocation.
	(Finalize): Remove the call to Free_Entry_Names.
	(Free_Entry_Names): Removed.
	(Initialize_Protection_Entries):
	Remove formal parameter Build_Entry_Names. Do not allocate
	an array to hold the string names of entries and families.
	(Number_Of_Entries): New routine.
	(Set_Entry_Name): Removed.
	(Set_Entry_Names): New routine.
	* s-tpoben.ads: Add types Protected_Entry_Names_Array and
	Protected_Entry_Names_Access. Update the type of Protection_Enties
	field Entry_Names.
	(Initialize_Protection_Entries): Remove
	formal parameter Build_Entry_Names along with associated comment.
	(Number_Of_Entries): New routine.
	(Set_Entry_Name): Removed.
	(Set_Entry_Names): New routine.

Patch

Index: exp_ch9.adb
===================================================================
--- exp_ch9.adb	(revision 192929)
+++ exp_ch9.adb	(working copy)
@@ -1363,59 +1363,54 @@ 
    -- Build_Entry_Names --
    -----------------------
 
-   function Build_Entry_Names (Conc_Typ : Entity_Id) return Node_Id is
-      Loc       : constant Source_Ptr := Sloc (Conc_Typ);
-      B_Decls   : List_Id;
-      B_Stmts   : List_Id;
-      Comp      : Node_Id;
-      Index     : Entity_Id;
-      Index_Typ : RE_Id;
-      Typ       : Entity_Id := Conc_Typ;
+   procedure Build_Entry_Names
+     (Obj_Ref : Node_Id;
+      Obj_Typ : Entity_Id;
+      Stmts   : List_Id)
+   is
+      Loc   : constant Source_Ptr := Sloc (Obj_Ref);
+      Data  : Entity_Id := Empty;
+      Index : Entity_Id := Empty;
+      Typ   : Entity_Id := Obj_Typ;
 
-      procedure Build_Entry_Family_Name (Id : Entity_Id);
-      --  Generate:
-      --    for Lnn in Family_Low .. Family_High loop
-      --       Inn := Inn + 1;
-      --       Set_Entry_Name
-      --         (_init._object <or> _init._task_id,
-      --          Inn,
-      --          new String ("<Entry name>(" & Lnn'Img & ")"));
-      --    end loop;
-      --  Note that the bounds of the range may reference discriminants. The
-      --  above construct is added directly to the statements of the block.
+      procedure Build_Entry_Name (Comp_Id : Entity_Id);
+      --  Given an entry [family], create a static string which denotes the
+      --  name of Comp_Id and assign it to the underlying data structure which
+      --  contains the entry names of a concurrent object.
 
-      procedure Build_Entry_Name (Id : Entity_Id);
-      --  Generate:
-      --    Inn := Inn + 1;
-      --    Set_Entry_Name
-      --      (_init._object <or>_init._task_id,
-      --       Inn,
-      --       new String ("<Entry name>");
-      --  The above construct is added directly to the statements of the block.
+      function Object_Reference return Node_Id;
+      --  Return a reference to field _object or _task_id depending on the
+      --  concurrent object being processed.
 
-      function Build_Set_Entry_Name_Call (Arg3 : Node_Id) return Node_Id;
-      --  Generate the call to the runtime routine Set_Entry_Name with actuals
-      --  _init._task_id or _init._object, Inn and Arg3.
+      ----------------------
+      -- Build_Entry_Name --
+      ----------------------
 
-      procedure Increment_Index (Stmts : List_Id);
-      --  Generate the following and add it to Stmts
-      --    Inn := Inn + 1;
-
-      -----------------------------
-      -- Build_Entry_Family_Name --
-      -----------------------------
-
-      procedure Build_Entry_Family_Name (Id : Entity_Id) is
-         Def     : constant Node_Id :=
-                     Discrete_Subtype_Definition (Parent (Id));
-         L_Id    : constant Entity_Id := Make_Temporary (Loc, 'L');
-         L_Stmts : constant List_Id := New_List;
-         Val     : Node_Id;
-
+      procedure Build_Entry_Name (Comp_Id : Entity_Id) is
          function Build_Range (Def : Node_Id) return Node_Id;
          --  Given a discrete subtype definition of an entry family, generate a
          --  range node which covers the range of Def's type.
 
+         procedure Create_Index_And_Data;
+         --  Generate the declarations of variables Index and Data. Subsequent
+         --  calls do nothing.
+
+         function Increment_Index return Node_Id;
+         --  Increment the index used in the assignment of string names to the
+         --  Data array.
+
+         function Name_Declaration (Def_Id : Entity_Id) return Node_Id;
+         --  Given the name of a temporary variable, create the following
+         --  declaration for it:
+         --
+         --    Def_Id : aliased constant String := <String_Name_From_Buffer>;
+
+         function Set_Entry_Name (Def_Id : Entity_Id) return Node_Id;
+         --  Given the name of a temporary variable, place it in the array of
+         --  string names. Generate:
+         --
+         --    Data (Index) := Def_Id'Unchecked_Access;
+
          -----------------
          -- Build_Range --
          -----------------
@@ -1432,7 +1427,10 @@ 
             if Is_Entity_Name (Low)
               and then Ekind (Entity (Low)) = E_Discriminant
             then
-               Low := Make_Identifier (Loc, Chars (Low));
+               Low :=
+                 Make_Selected_Component (Loc,
+                   Prefix        => New_Copy_Tree (Obj_Ref),
+                   Selector_Name => Make_Identifier (Loc, Chars (Low)));
             else
                Low := New_Copy_Tree (Low);
             end if;
@@ -1440,7 +1438,10 @@ 
             if Is_Entity_Name (High)
               and then Ekind (Entity (High)) = E_Discriminant
             then
-               High := Make_Identifier (Loc, Chars (High));
+               High :=
+                 Make_Selected_Component (Loc,
+                   Prefix        => New_Copy_Tree (Obj_Ref),
+                   Selector_Name => Make_Identifier (Loc, Chars (High)));
             else
                High := New_Copy_Tree (High);
             end if;
@@ -1451,150 +1452,239 @@ 
                 High_Bound => High);
          end Build_Range;
 
-      --  Start of processing for Build_Entry_Family_Name
+         ---------------------------
+         -- Create_Index_And_Data --
+         ---------------------------
 
-      begin
-         Get_Name_String (Chars (Id));
+         procedure Create_Index_And_Data is
+         begin
+            if No (Index) and then No (Data) then
+               declare
+                  Count     : RE_Id;
+                  Data_Typ  : RE_Id;
+                  Index_Typ : RE_Id;
+                  Size      : Entity_Id;
 
-         --  Add a leading '('
+               begin
+                  if Is_Protected_Type (Typ) then
+                     Count     := RO_PE_Number_Of_Entries;
+                     Data_Typ  := RE_Protected_Entry_Names_Array;
+                     Index_Typ := RE_Protected_Entry_Index;
+                  else
+                     Count     := RO_ST_Number_Of_Entries;
+                     Data_Typ  := RE_Task_Entry_Names_Array;
+                     Index_Typ := RE_Task_Entry_Index;
+                  end if;
 
-         Add_Char_To_Name_Buffer ('(');
+                  --  Step 1: Generate the declaration of the index variable:
 
-         --  Generate:
-         --    new String'("<Entry name>(" & Lnn'Img & ")");
+                  --    Index : <Index_Typ> := 1;
 
-         --  This is an implicit heap allocation, and Comes_From_Source is
-         --  False, which ensures that it will get flagged as a violation of
-         --  No_Implicit_Heap_Allocations when that restriction applies.
+                  Index := Make_Temporary (Loc, 'I');
 
-         Val :=
-           Make_Allocator (Loc,
-             Make_Qualified_Expression (Loc,
-               Subtype_Mark =>
-                 New_Reference_To (Standard_String, Loc),
-               Expression =>
-                 Make_Op_Concat (Loc,
-                   Left_Opnd =>
-                     Make_Op_Concat (Loc,
-                       Left_Opnd =>
-                         Make_String_Literal (Loc,
-                           Strval => String_From_Name_Buffer),
-                       Right_Opnd =>
-                         Make_Attribute_Reference (Loc,
-                           Prefix =>
-                             New_Reference_To (L_Id, Loc),
-                               Attribute_Name => Name_Img)),
-                   Right_Opnd =>
-                     Make_String_Literal (Loc,
-                       Strval => ")"))));
+                  Append_To (Stmts,
+                    Make_Object_Declaration (Loc,
+                      Defining_Identifier => Index,
+                      Object_Definition   =>
+                        New_Reference_To (RTE (Index_Typ), Loc),
+                      Expression          => Make_Integer_Literal (Loc, 1)));
 
-         Increment_Index (L_Stmts);
-         Append_To (L_Stmts, Build_Set_Entry_Name_Call (Val));
+                  --  Step 2: Generate the declaration of an array to house all
+                  --  names:
 
-         --  Generate:
-         --    for Lnn in Family_Low .. Family_High loop
-         --       Inn := Inn + 1;
-         --       Set_Entry_Name
-         --         (_init._object <or> _init._task_id, Inn, <Val>);
-         --    end loop;
+                  --    Size : constant <Index_Typ> := <Count> (Obj_Ref);
+                  --    Data : aliased <Data_Typ> := (1 .. Size => null);
 
-         Append_To (B_Stmts,
-           Make_Loop_Statement (Loc,
-             Iteration_Scheme =>
-               Make_Iteration_Scheme (Loc,
-                 Loop_Parameter_Specification =>
-                   Make_Loop_Parameter_Specification (Loc,
-                    Defining_Identifier         => L_Id,
-                    Discrete_Subtype_Definition => Build_Range (Def))),
-             Statements => L_Stmts,
-             End_Label => Empty));
-      end Build_Entry_Family_Name;
+                  Size := Make_Temporary (Loc, 'S');
 
-      ----------------------
-      -- Build_Entry_Name --
-      ----------------------
+                  Append_To (Stmts,
+                    Make_Object_Declaration (Loc,
+                      Defining_Identifier => Size,
+                      Constant_Present    => True,
+                      Object_Definition   =>
+                        New_Reference_To (RTE (Index_Typ), Loc),
+                      Expression          =>
+                        Make_Function_Call (Loc,
+                          Name                   =>
+                            New_Reference_To (RTE (Count), Loc),
+                          Parameter_Associations =>
+                            New_List (Object_Reference))));
 
-      procedure Build_Entry_Name (Id : Entity_Id) is
-         Val : Node_Id;
+                  Data := Make_Temporary (Loc, 'A');
 
+                  Append_To (Stmts,
+                    Make_Object_Declaration (Loc,
+                      Defining_Identifier => Data,
+                      Aliased_Present     => True,
+                      Object_Definition   =>
+                        New_Reference_To (RTE (Data_Typ), Loc),
+                      Expression          =>
+                        Make_Aggregate (Loc,
+                          Component_Associations => New_List (
+                            Make_Component_Association (Loc,
+                              Choices    => New_List (
+                                Make_Range (Loc,
+                                  Low_Bound  => Make_Integer_Literal (Loc, 1),
+                                  High_Bound => New_Reference_To (Size, Loc))),
+                              Expression => Make_Null (Loc))))));
+               end;
+            end if;
+         end Create_Index_And_Data;
+
+         ---------------------
+         -- Increment_Index --
+         ---------------------
+
+         function Increment_Index return Node_Id is
+         begin
+            return
+              Make_Assignment_Statement (Loc,
+                Name       => New_Reference_To (Index, Loc),
+                Expression =>
+                  Make_Op_Add (Loc,
+                    Left_Opnd  => New_Reference_To (Index, Loc),
+                    Right_Opnd => Make_Integer_Literal (Loc, 1)));
+         end Increment_Index;
+
+         ----------------------
+         -- Name_Declaration --
+         ----------------------
+
+         function Name_Declaration (Def_Id : Entity_Id) return Node_Id is
+         begin
+            return
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Def_Id,
+                Aliased_Present     => True,
+                Constant_Present    => True,
+                Object_Definition   => New_Reference_To (Standard_String, Loc),
+                Expression          =>
+                  Make_String_Literal (Loc, String_From_Name_Buffer));
+         end Name_Declaration;
+
+         --------------------
+         -- Set_Entry_Name --
+         --------------------
+
+         function Set_Entry_Name (Def_Id : Entity_Id) return Node_Id is
+         begin
+            return
+              Make_Assignment_Statement (Loc,
+                Name       =>
+                  Make_Indexed_Component (Loc,
+                    Prefix      => New_Reference_To (Data, Loc),
+                    Expressions => New_List (New_Reference_To (Index, Loc))),
+
+                Expression =>
+                  Make_Attribute_Reference (Loc,
+                    Prefix         => New_Reference_To (Def_Id, Loc),
+                    Attribute_Name => Name_Unchecked_Access));
+         end Set_Entry_Name;
+
+         --  Local variables
+
+         Temp_Id  : Entity_Id;
+         Subt_Def : Node_Id;
+
+      --  Start of processing for Build_Entry_Name
+
       begin
-         Get_Name_String (Chars (Id));
+         if Ekind (Comp_Id) = E_Entry_Family then
+            Subt_Def := Discrete_Subtype_Definition (Parent (Comp_Id));
 
-         --  This is an implicit heap allocation, and Comes_From_Source is
-         --  False, which ensures that it will get flagged as a violation of
-         --  No_Implicit_Heap_Allocations when that restriction applies.
+            Create_Index_And_Data;
 
-         Val :=
-           Make_Allocator (Loc,
-             Make_Qualified_Expression (Loc,
-               Subtype_Mark =>
-                 New_Reference_To (Standard_String, Loc),
-               Expression =>
-                 Make_String_Literal (Loc,
-                   String_From_Name_Buffer)));
+            --  Step 1: Create the string name of the entry family.
+            --  Generate:
+            --    Temp : aliased constant String := "name ()";
 
-         Increment_Index (B_Stmts);
-         Append_To (B_Stmts, Build_Set_Entry_Name_Call (Val));
+            Temp_Id := Make_Temporary (Loc, 'S');
+            Get_Name_String (Chars (Comp_Id));
+            Add_Char_To_Name_Buffer (' ');
+            Add_Char_To_Name_Buffer ('(');
+            Add_Char_To_Name_Buffer (')');
+
+            Append_To (Stmts, Name_Declaration (Temp_Id));
+
+            --  Generate:
+            --    for Member in Family_Low .. Family_High loop
+            --       Set_Entry_Name (...);
+            --       Index := Index + 1;
+            --    end loop;
+
+            Append_To (Stmts,
+              Make_Loop_Statement (Loc,
+                Iteration_Scheme =>
+                  Make_Iteration_Scheme (Loc,
+                    Loop_Parameter_Specification =>
+                      Make_Loop_Parameter_Specification (Loc,
+                        Defining_Identifier         =>
+                          Make_Temporary (Loc, 'L'),
+                        Discrete_Subtype_Definition =>
+                          Build_Range (Subt_Def))),
+
+                Statements       => New_List (
+                  Set_Entry_Name (Temp_Id),
+                  Increment_Index),
+                End_Label        => Empty));
+
+         --  Entry
+
+         else
+            Create_Index_And_Data;
+
+            --  Step 1: Create the string name of the entry. Generate:
+            --    Temp : aliased constant String := "name";
+
+            Temp_Id := Make_Temporary (Loc, 'S');
+            Get_Name_String (Chars (Comp_Id));
+
+            Append_To (Stmts, Name_Declaration (Temp_Id));
+
+            --  Step 2: Associate the string name with the underlying data
+            --  structure.
+
+            Append_To (Stmts, Set_Entry_Name (Temp_Id));
+            Append_To (Stmts, Increment_Index);
+         end if;
       end Build_Entry_Name;
 
-      -------------------------------
-      -- Build_Set_Entry_Name_Call --
-      -------------------------------
+      ----------------------
+      -- Object_Reference --
+      ----------------------
 
-      function Build_Set_Entry_Name_Call (Arg3 : Node_Id) return Node_Id is
-         Arg1 : Name_Id;
-         Proc : RE_Id;
+      function Object_Reference return Node_Id is
+         Conc_Typ : constant Entity_Id := Corresponding_Record_Type (Typ);
+         Field    : Name_Id;
+         Ref      : Node_Id;
 
       begin
-         --  Determine the proper name for the first argument and the RTS
-         --  routine to call.
-
          if Is_Protected_Type (Typ) then
-            Arg1 := Name_uObject;
-            Proc := RO_PE_Set_Entry_Name;
-
-         else pragma Assert (Is_Task_Type (Typ));
-            Arg1 := Name_uTask_Id;
-            Proc := RO_TS_Set_Entry_Name;
+            Field := Name_uObject;
+         else
+            Field := Name_uTask_Id;
          end if;
 
-         --  Generate:
-         --    Set_Entry_Name (_init.Arg1, Inn, Arg3);
+         Ref :=
+           Make_Selected_Component (Loc,
+             Prefix        =>
+               Unchecked_Convert_To (Conc_Typ, New_Copy_Tree (Obj_Ref)),
+             Selector_Name => Make_Identifier (Loc, Field));
 
-         return
-           Make_Procedure_Call_Statement (Loc,
-             Name =>
-               New_Reference_To (RTE (Proc), Loc),
-             Parameter_Associations => New_List (
-               Make_Selected_Component (Loc,              --  _init._object
-                 Prefix =>                                --  _init._task_id
-                   Make_Identifier (Loc, Name_uInit),
-                 Selector_Name =>
-                   Make_Identifier (Loc, Arg1)),
-               New_Reference_To (Index, Loc),             --  Inn
-               Arg3));                                    --  Val
-      end Build_Set_Entry_Name_Call;
+         if Is_Protected_Type (Typ) then
+            Ref :=
+              Make_Attribute_Reference (Loc,
+                Prefix         => Ref,
+                Attribute_Name => Name_Unchecked_Access);
+         end if;
 
-      ---------------------
-      -- Increment_Index --
-      ---------------------
+         return Ref;
+      end Object_Reference;
 
-      procedure Increment_Index (Stmts : List_Id) is
-      begin
-         --  Generate:
-         --    Inn := Inn + 1;
+      --  Local variables
 
-         Append_To (Stmts,
-           Make_Assignment_Statement (Loc,
-             Name =>
-               New_Reference_To (Index, Loc),
-             Expression =>
-               Make_Op_Add (Loc,
-                 Left_Opnd =>
-                   New_Reference_To (Index, Loc),
-                 Right_Opnd =>
-                   Make_Integer_Literal (Loc, 1))));
-      end Increment_Index;
+      Comp : Node_Id;
+      Proc : RE_Id;
 
    --  Start of processing for Build_Entry_Names
 
@@ -1605,67 +1695,57 @@ 
          Typ := Corresponding_Concurrent_Type (Typ);
       end if;
 
-      pragma Assert (Is_Protected_Type (Typ) or else Is_Task_Type (Typ));
+      pragma Assert (Is_Concurrent_Type (Typ));
 
       --  Nothing to do if the type has no entries
 
       if not Has_Entries (Typ) then
-         return Empty;
+         return;
       end if;
 
       --  Avoid generating entry names for a protected type with only one entry
 
       if Is_Protected_Type (Typ)
-        and then Find_Protection_Type (Typ) /= RTE (RE_Protection_Entries)
+        and then Find_Protection_Type (Base_Type (Typ)) /=
+                   RTE (RE_Protection_Entries)
       then
-         return Empty;
+         return;
       end if;
 
-      Index := Make_Temporary (Loc, 'I');
+      --  Step 1: Populate the array with statically generated strings denoting
+      --  entries and entry family names.
 
-      --  Step 1: Generate the declaration of the index variable:
-      --    Inn : Protected_Entry_Index := 0;
-      --      or
-      --    Inn : Task_Entry_Index := 0;
-
-      if Is_Protected_Type (Typ) then
-         Index_Typ := RE_Protected_Entry_Index;
-      else
-         Index_Typ := RE_Task_Entry_Index;
-      end if;
-
-      B_Decls := New_List;
-      Append_To (B_Decls,
-        Make_Object_Declaration (Loc,
-          Defining_Identifier => Index,
-          Object_Definition   => New_Reference_To (RTE (Index_Typ), Loc),
-          Expression          => Make_Integer_Literal (Loc, 0)));
-
-      B_Stmts := New_List;
-
-      --  Step 2: Generate a call to Set_Entry_Name for each entry and entry
-      --  family member.
-
       Comp := First_Entity (Typ);
       while Present (Comp) loop
-         if Ekind (Comp) = E_Entry then
+         if Comes_From_Source (Comp)
+           and then Ekind_In (Comp, E_Entry, E_Entry_Family)
+         then
             Build_Entry_Name (Comp);
-
-         elsif Ekind (Comp) = E_Entry_Family then
-            Build_Entry_Family_Name (Comp);
          end if;
 
          Next_Entity (Comp);
       end loop;
 
-      --  Step 3: Wrap the statements in a block
+      --  Step 2: Associate the array with the related concurrent object:
 
-      return
-        Make_Block_Statement (Loc,
-          Declarations => B_Decls,
-          Handled_Statement_Sequence =>
-            Make_Handled_Sequence_Of_Statements (Loc,
-              Statements => B_Stmts));
+      --    Set_Entry_Names (Obj_Ref, <Data>'Unchecked_Access);
+
+      if Present (Data) then
+         if Is_Protected_Type (Typ) then
+            Proc := RO_PE_Set_Entry_Names;
+         else
+            Proc := RO_ST_Set_Entry_Names;
+         end if;
+
+         Append_To (Stmts,
+           Make_Procedure_Call_Statement (Loc,
+             Name                   => New_Reference_To (RTE (Proc), Loc),
+             Parameter_Associations => New_List (
+               Object_Reference,
+               Make_Attribute_Reference (Loc,
+                 Prefix         => New_Reference_To (Data, Loc),
+                 Attribute_Name => Name_Unchecked_Access))));
+      end if;
    end Build_Entry_Names;
 
    ---------------------------
@@ -13505,20 +13585,6 @@ 
                        Make_Attribute_Reference (Loc,
                          Prefix         => New_Reference_To (P_Arr, Loc),
                          Attribute_Name => Name_Unrestricted_Access));
-
-                     --  Build_Entry_Names generation flag. When set to true,
-                     --  the runtime will allocate an array to hold the string
-                     --  names of protected entries.
-
-                     if not Restricted_Profile then
-                        if Entry_Names_OK then
-                           Append_To (Args,
-                             New_Reference_To (Standard_True, Loc));
-                        else
-                           Append_To (Args,
-                             New_Reference_To (Standard_False, Loc));
-                        end if;
-                     end if;
                   end if;
 
                elsif Pkg_Id =
@@ -13529,7 +13595,6 @@ 
                elsif Pkg_Id = System_Tasking_Protected_Objects_Entries then
                   Append_To (Args, Make_Null (Loc));
                   Append_To (Args, Make_Null (Loc));
-                  Append_To (Args, New_Reference_To (Standard_False, Loc));
                end if;
 
                Append_To (L,
@@ -13953,16 +14018,6 @@ 
           Prefix        => Make_Identifier (Loc, Name_uInit),
           Selector_Name => Make_Identifier (Loc, Name_uTask_Id)));
 
-      --  Build_Entry_Names generation flag. When set to true, the runtime
-      --  will allocate an array to hold the string names of task entries.
-
-      if not Restricted_Profile then
-         Append_To (Args,
-           New_Reference_To
-             (Boolean_Literals (Has_Entries (Ttyp) and then Entry_Names_OK),
-              Loc));
-      end if;
-
       if Restricted_Profile then
          Name := New_Reference_To (RTE (RE_Create_Restricted_Task), Loc);
       else
Index: exp_ch9.ads
===================================================================
--- exp_ch9.ads	(revision 192918)
+++ exp_ch9.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -55,10 +55,15 @@ 
    --  interface, ensure that the designated type has a _master and generate
    --  a renaming of the said master to service the access type.
 
-   function Build_Entry_Names (Conc_Typ : Entity_Id) return Node_Id;
-   --  Create the statements which populate the entry names array of a task or
-   --  protected type. The statements are wrapped inside a block due to a local
-   --  declaration.
+   procedure Build_Entry_Names
+     (Obj_Ref : Node_Id;
+      Obj_Typ : Entity_Id;
+      Stmts   : List_Id);
+   --  Given a concurrent object, create static string names for all entries
+   --  and entry families. Associate each name with the Protection_Entries or
+   --  ATCB field of the object. Obj_Ref is a reference to the concurrent
+   --  object. Obj_Typ is the type of the object. Stmts is the list where all
+   --  generated code is attached.
 
    procedure Build_Master_Entity (Obj_Or_Typ : Entity_Id);
    --  Given the name of an object or a type which is either a task, contains
Index: s-tpoben.adb
===================================================================
--- s-tpoben.adb	(revision 192918)
+++ s-tpoben.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                               B o d y                                    --
 --                                                                          --
---          Copyright (C) 1998-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2012, 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- --
@@ -41,8 +41,6 @@ 
 
 --  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,13 +56,6 @@ 
    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 --
    ----------------
@@ -141,8 +132,6 @@ 
          end loop;
       end loop;
 
-      Free_Entry_Names (Object);
-
       Object.Finalized := True;
 
       if Single_Lock then
@@ -154,26 +143,6 @@ 
       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 --
    -----------------
@@ -202,12 +171,11 @@ 
    -----------------------------------
 
    procedure Initialize_Protection_Entries
-     (Object            : Protection_Entries_Access;
-      Ceiling_Priority  : Integer;
-      Compiler_Info     : System.Address;
-      Entry_Bodies      : Protected_Entry_Body_Access;
-      Find_Body_Index   : Find_Body_Index_Access;
-      Build_Entry_Names : Boolean)
+     (Object           : Protection_Entries_Access;
+      Ceiling_Priority : Integer;
+      Compiler_Info    : System.Address;
+      Entry_Bodies     : Protected_Entry_Body_Access;
+      Find_Body_Index  : Find_Body_Index_Access)
    is
       Init_Priority : Integer := Ceiling_Priority;
       Self_ID       : constant Task_Id := STPO.Self;
@@ -250,11 +218,6 @@ 
          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;
 
    ------------------
@@ -391,6 +354,17 @@ 
       end if;
    end Lock_Read_Only_Entries;
 
+   -----------------------
+   -- Number_Of_Entries --
+   -----------------------
+
+   function Number_Of_Entries
+     (Object : Protection_Entries_Access) return Protected_Entry_Index
+   is
+   begin
+      return Object.Num_Entries;
+   end Number_Of_Entries;
+
    -----------------
    -- Set_Ceiling --
    -----------------
@@ -402,21 +376,18 @@ 
       Object.New_Ceiling := Prio;
    end Set_Ceiling;
 
-   --------------------
-   -- Set_Entry_Name --
-   --------------------
+   ---------------------
+   -- Set_Entry_Names --
+   ---------------------
 
-   procedure Set_Entry_Name
-     (Object : Protection_Entries'Class;
-      Pos    : Protected_Entry_Index;
-      Val    : String_Access)
+   procedure Set_Entry_Names
+     (Object : Protection_Entries_Access;
+      Names  : Protected_Entry_Names_Access)
    is
    begin
-      pragma Assert (Object.Entry_Names /= null);
+      Object.Entry_Names := Names;
+   end Set_Entry_Names;
 
-      Object.Entry_Names (Entry_Index (Pos)) := Val;
-   end Set_Entry_Name;
-
    --------------------
    -- Unlock_Entries --
    --------------------
Index: s-tpoben.ads
===================================================================
--- s-tpoben.ads	(revision 192918)
+++ s-tpoben.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -67,6 +67,14 @@ 
    type Protected_Entry_Queue_Array is
      array (Protected_Entry_Index range <>) of Entry_Queue;
 
+   --  A data structure which contains the string names of entries and entry
+   --  family members.
+
+   type Protected_Entry_Names_Array is
+     array (Protected_Entry_Index range <>) of String_Access;
+
+   type Protected_Entry_Names_Access is access all Protected_Entry_Names_Array;
+
    --  This type contains the GNARL state of a protected object. The
    --  application-defined portion of the state (i.e. private objects)
    --  is maintained by the compiler-generated code.
@@ -136,7 +144,7 @@ 
 
       Entry_Queues : Protected_Entry_Queue_Array (1 .. Num_Entries);
 
-      Entry_Names : Entry_Names_Array_Access := null;
+      Entry_Names : Protected_Entry_Names_Access := null;
       --  An array of string names which denotes entry [family member] names.
       --  The structure is indexed by protected entry index and contains Num_
       --  Entries components.
@@ -167,12 +175,11 @@ 
    --  System.Tasking.Protected_Objects.Initialize_Protection.
 
    procedure Initialize_Protection_Entries
-     (Object            : Protection_Entries_Access;
-      Ceiling_Priority  : Integer;
-      Compiler_Info     : System.Address;
-      Entry_Bodies      : Protected_Entry_Body_Access;
-      Find_Body_Index   : Find_Body_Index_Access;
-      Build_Entry_Names : Boolean);
+     (Object           : Protection_Entries_Access;
+      Ceiling_Priority : Integer;
+      Compiler_Info    : System.Address;
+      Entry_Bodies     : Protected_Entry_Body_Access;
+      Find_Body_Index  : Find_Body_Index_Access);
    --  Initialize the Object parameter so that it can be used by the runtime
    --  to keep track of the runtime state of a protected object.
 
@@ -201,17 +208,20 @@ 
    --  possible future use. At the current time, everyone uses Lock for both
    --  read and write locks.
 
+   function Number_Of_Entries
+     (Object : Protection_Entries_Access) return Protected_Entry_Index;
+   --  Return the number of entries of a protected object
+
    procedure Set_Ceiling
      (Object : Protection_Entries_Access;
       Prio   : System.Any_Priority);
    --  Sets the new ceiling priority of the protected object
 
-   procedure Set_Entry_Name
-     (Object : Protection_Entries'Class;
-      Pos    : Protected_Entry_Index;
-      Val    : String_Access);
-   --  This is called by the compiler to map a string which denotes an entry
-   --  name to a protected entry index.
+   procedure Set_Entry_Names
+     (Object : Protection_Entries_Access;
+      Names  : Protected_Entry_Names_Access);
+   --  Associate an array of string that denote entry [family] names with a
+   --  protected object.
 
    procedure Unlock_Entries (Object : Protection_Entries_Access);
    --  Relinquish ownership of the lock for the object represented by the
Index: s-tassta.adb
===================================================================
--- s-tassta.adb	(revision 192931)
+++ s-tassta.adb	(working copy)
@@ -91,9 +91,6 @@ 
    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.
@@ -487,8 +484,7 @@ 
       Elaborated        : Access_Boolean;
       Chain             : in out Activation_Chain;
       Task_Image        : String;
-      Created_Task      : out Task_Id;
-      Build_Entry_Names : Boolean)
+      Created_Task      : out Task_Id)
    is
       T, P          : Task_Id;
       Self_ID       : constant Task_Id := STPO.Self;
@@ -706,14 +702,6 @@ 
            Dispatching_Domain_Tasks (Base_CPU) + 1;
       end if;
 
-      --  Note: we should not call 'new' while holding locks since new may use
-      --  locks (e.g. RTS_Lock under Windows) itself and cause a deadlock.
-
-      if Build_Entry_Names then
-         T.Entry_Names :=
-           new Entry_Names_Array (1 .. Entry_Index (Num_Entries));
-      end if;
-
       --  Create TSD as early as possible in the creation of a task, since it
       --  may be used by the operation of Ada code within the task.
 
@@ -942,26 +930,6 @@ 
 
    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 --
    ---------------
@@ -983,7 +951,6 @@ 
 
          Initialization.Task_Unlock (Self_Id);
 
-         Free_Entry_Names (T);
          System.Task_Primitives.Operations.Finalize_TCB (T);
 
       else
@@ -1041,23 +1008,6 @@ 
       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 --
    ------------------
@@ -2119,7 +2069,6 @@ 
          Unlock_RTS;
       end if;
 
-      Free_Entry_Names (T);
       System.Task_Primitives.Operations.Finalize_TCB (T);
    end Vulnerable_Free_Task;
 
Index: s-tassta.ads
===================================================================
--- s-tassta.ads	(revision 192918)
+++ s-tassta.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -180,8 +180,7 @@ 
       Elaborated        : Access_Boolean;
       Chain             : in out Activation_Chain;
       Task_Image        : String;
-      Created_Task      : out Task_Id;
-      Build_Entry_Names : Boolean);
+      Created_Task      : out Task_Id);
    --  Compiler interface only. Do not call from within the RTS.
    --  This must be called to create a new task.
    --
@@ -212,8 +211,6 @@ 
    --   run time can store to ease the debugging and the
    --   Ada.Task_Identification facility.
    --  Created_Task is the resulting task.
-   --  Build_Entry_Names is a flag which controls the allocation of the data
-   --   structure which stores all entry names.
    --
    --  This procedure can raise Storage_Error if the task creation failed.
 
@@ -285,13 +282,6 @@ 
    --  that doesn't happen, they will never be activated, and will become
    --  terminated on leaving the return statement.
 
-   procedure Set_Entry_Name
-     (T   : Task_Id;
-      Pos : Task_Entry_Index;
-      Val : String_Access);
-   --  This is called by the compiler to map a string which denotes an entry
-   --  name to a task entry index.
-
    function Terminated (T : Task_Id) return Boolean;
    --  This is called by the compiler to implement the 'Terminated attribute.
    --  Though is not required to be so by the ARM, we choose to synchronize
Index: rtsfind.ads
===================================================================
--- rtsfind.ads	(revision 192918)
+++ rtsfind.ads	(working copy)
@@ -1502,6 +1502,9 @@ 
      RE_Unspecified_Task_Info,           -- System.Task_Info
 
      RE_Task_Procedure_Access,           -- System.Tasking
+     RE_Task_Entry_Names_Array,          -- System.Tasking
+     RO_ST_Number_Of_Entries,            -- System.Tasking
+     RO_ST_Set_Entry_Names,              -- System.Tasking
 
      RO_ST_Task_Id,                      -- System.Tasking
      RO_ST_Null_Task,                    -- System.Tasking
@@ -1687,14 +1690,16 @@ 
      RE_Dispatching_Domain,              -- Dispatching_Domains
 
      RE_Protected_Entry_Body_Array,      -- Tasking.Protected_Objects.Entries
+     RE_Protected_Entry_Names_Array,     -- Tasking.Protected_Objects.Entries
      RE_Protection_Entries,              -- Tasking.Protected_Objects.Entries
      RE_Protection_Entries_Access,       -- Tasking.Protected_Objects.Entries
      RE_Initialize_Protection_Entries,   -- Tasking.Protected_Objects.Entries
      RE_Lock_Entries,                    -- Tasking.Protected_Objects.Entries
+     RE_Unlock_Entries,                  -- Tasking.Protected_Objects.Entries
      RO_PE_Get_Ceiling,                  -- Tasking.Protected_Objects.Entries
+     RO_PE_Number_Of_Entries,            -- Tasking.Protected_Objects.Entries
      RO_PE_Set_Ceiling,                  -- Tasking.Protected_Objects.Entries
-     RO_PE_Set_Entry_Name,               -- Tasking.Protected_Objects.Entries
-     RE_Unlock_Entries,                  -- Tasking.Protected_Objects.Entries
+     RO_PE_Set_Entry_Names,              -- Tasking.Protected_Objects.Entries
 
      RE_Communication_Block,             -- Protected_Objects.Operations
      RE_Protected_Entry_Call,            -- Protected_Objects.Operations
@@ -1769,7 +1774,6 @@ 
      RE_Free_Task,                       -- System.Tasking.Stages
      RE_Expunge_Unactivated_Tasks,       -- System.Tasking.Stages
      RE_Move_Activation_Chain,           -- System_Tasking_Stages
-     RO_TS_Set_Entry_Name,               -- System.Tasking.Stages
      RE_Terminated);                     -- System.Tasking.Stages
 
    --  The following declarations build a table that is indexed by the RTE
@@ -2749,6 +2753,9 @@ 
      RE_Unspecified_Task_Info            => System_Task_Info,
 
      RE_Task_Procedure_Access            => System_Tasking,
+     RE_Task_Entry_Names_Array           => System_Tasking,
+     RO_ST_Number_Of_Entries             => System_Tasking,
+     RO_ST_Set_Entry_Names               => System_Tasking,
 
      RO_ST_Task_Id                       => System_Tasking,
      RO_ST_Null_Task                     => System_Tasking,
@@ -2937,6 +2944,8 @@ 
 
      RE_Protected_Entry_Body_Array       =>
        System_Tasking_Protected_Objects_Entries,
+     RE_Protected_Entry_Names_Array      =>
+       System_Tasking_Protected_Objects_Entries,
      RE_Protection_Entries               =>
        System_Tasking_Protected_Objects_Entries,
      RE_Protection_Entries_Access        =>
@@ -2945,14 +2954,16 @@ 
        System_Tasking_Protected_Objects_Entries,
      RE_Lock_Entries                     =>
        System_Tasking_Protected_Objects_Entries,
+     RE_Unlock_Entries                   =>
+       System_Tasking_Protected_Objects_Entries,
      RO_PE_Get_Ceiling                   =>
        System_Tasking_Protected_Objects_Entries,
+     RO_PE_Number_Of_Entries             =>
+       System_Tasking_Protected_Objects_Entries,
      RO_PE_Set_Ceiling                   =>
        System_Tasking_Protected_Objects_Entries,
-     RO_PE_Set_Entry_Name                =>
+     RO_PE_Set_Entry_Names               =>
        System_Tasking_Protected_Objects_Entries,
-     RE_Unlock_Entries                   =>
-       System_Tasking_Protected_Objects_Entries,
 
      RE_Communication_Block              =>
        System_Tasking_Protected_Objects_Operations,
@@ -3054,7 +3065,6 @@ 
      RE_Free_Task                        => System_Tasking_Stages,
      RE_Expunge_Unactivated_Tasks        => System_Tasking_Stages,
      RE_Move_Activation_Chain            => System_Tasking_Stages,
-     RO_TS_Set_Entry_Name                => System_Tasking_Stages,
      RE_Terminated                       => System_Tasking_Stages);
 
    --------------------------------
Index: s-taskin.adb
===================================================================
--- s-taskin.adb	(revision 192918)
+++ s-taskin.adb	(working copy)
@@ -33,8 +33,6 @@ 
 --  Turn off polling, we do not want ATC polling to take place during tasking
 --  operations. It causes infinite loops and other problems.
 
-with Ada.Unchecked_Deallocation;
-
 with System.Task_Primitives.Operations;
 with System.Storage_Elements;
 
@@ -42,19 +40,6 @@ 
 
    package STPO renames System.Task_Primitives.Operations;
 
-   ----------------------------
-   -- Free_Entry_Names_Array --
-   ----------------------------
-
-   procedure Free_Entry_Names_Array (Obj : in out Entry_Names_Array) is
-      procedure Free_String is new
-        Ada.Unchecked_Deallocation (String, String_Access);
-   begin
-      for Index in Obj'Range loop
-         Free_String (Obj (Index));
-      end loop;
-   end Free_Entry_Names_Array;
-
    ---------------------
    -- Detect_Blocking --
    ---------------------
@@ -70,6 +55,15 @@ 
       return GL_Detect_Blocking = 1;
    end Detect_Blocking;
 
+   -----------------------
+   -- Number_Of_Entries --
+   -----------------------
+
+   function Number_Of_Entries (Self_Id : Task_Id) return Task_Entry_Index is
+   begin
+      return Self_Id.Entry_Num;
+   end Number_Of_Entries;
+
    ----------
    -- Self --
    ----------
@@ -257,4 +251,16 @@ 
       T.Entry_Calls (1).Self := T;
    end Initialize;
 
+   ---------------------
+   -- Set_Entry_Names --
+   ---------------------
+
+   procedure Set_Entry_Names
+     (Self_Id : Task_Id;
+      Names   : Task_Entry_Names_Access)
+   is
+   begin
+      Self_Id.Entry_Names := Names;
+   end Set_Entry_Names;
+
 end System.Tasking;
Index: s-taskin.ads
===================================================================
--- s-taskin.ads	(revision 192918)
+++ s-taskin.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -252,14 +252,11 @@ 
 
    type String_Access is access all String;
 
-   type Entry_Names_Array is
-     array (Entry_Index range <>) of String_Access;
+   type Task_Entry_Names_Array is
+     array (Task_Entry_Index range <>) of String_Access;
 
-   type Entry_Names_Array_Access is access all Entry_Names_Array;
+   type Task_Entry_Names_Access is access all Task_Entry_Names_Array;
 
-   procedure Free_Entry_Names_Array (Obj : in out Entry_Names_Array);
-   --  Deallocate all string names contained in an entry names array
-
    ----------------------------------
    -- Entry_Call_Record definition --
    ----------------------------------
@@ -968,10 +965,13 @@ 
       --  associated with protected objects or task entries, and are protected
       --  by the protected object lock or Acceptor.L, respectively.
 
-      Entry_Names : Entry_Names_Array_Access := null;
+      Entry_Names : Task_Entry_Names_Access := null;
       --  An array of string names which denotes entry [family member] names.
       --  The structure is indexed by task entry index and contains Entry_Num
       --  components.
+      --
+      --  Protection: The array is populated during task initialization, before
+      --  the task has been activated. No protection is required in this case.
 
       New_Base_Priority : System.Any_Priority;
       --  New value for Base_Priority (for dynamic priorities package)
@@ -1203,4 +1203,13 @@ 
    --  registered for removal (Expunge_Unactivated_Tasks). The "limited" forces
    --  Activation_Chain to be a by-reference type; see RM-6.2(4).
 
+   function Number_Of_Entries (Self_Id : Task_Id) return Task_Entry_Index;
+   --  Given a task, return the number of entries it contains
+
+   procedure Set_Entry_Names
+     (Self_Id : Task_Id;
+      Names   : Task_Entry_Names_Access);
+   --  Associate an array of string that denote entry [family] names with a
+   --  task.
+
 end System.Tasking;
Index: exp_ch3.adb
===================================================================
--- exp_ch3.adb	(revision 192929)
+++ exp_ch3.adb	(working copy)
@@ -1704,6 +1704,18 @@ 
          end if;
       end if;
 
+      --  When the object is either protected or a task, create static strings
+      --  which denote the names of entries and families. Associate the strings
+      --  with the concurrent object's Protection_Entries or ATCB. This is a
+      --  VMS Debug feature.
+
+      if OpenVMS_On_Target
+        and then Is_Concurrent_Type (Typ)
+        and then Entry_Names_OK
+      then
+         Build_Entry_Names (Id_Ref, Typ, Res);
+      end if;
+
       return Res;
 
    exception
@@ -2665,7 +2677,6 @@ 
          Decl       : Node_Id;
          Has_POC    : Boolean;
          Id         : Entity_Id;
-         Names      : Node_Id;
          Stmts      : List_Id;
          Typ        : Entity_Id;
 
@@ -3009,17 +3020,6 @@ 
 
             Append_To (Stmts, Make_Task_Create_Call (Rec_Type));
 
-            --  Generate the statements which map a string entry name to a
-            --  task entry index. Note that the task may not have entries.
-
-            if Entry_Names_OK then
-               Names := Build_Entry_Names (Rec_Type);
-
-               if Present (Names) then
-                  Append_To (Stmts, Names);
-               end if;
-            end if;
-
             declare
                Task_Type : constant Entity_Id :=
                              Corresponding_Concurrent_Type (Rec_Type);
@@ -3073,18 +3073,6 @@ 
          if Is_Protected_Record_Type (Rec_Type) then
             Append_List_To (Stmts,
               Make_Initialize_Protection (Rec_Type));
-
-            --  Generate the statements which map a string entry name to a
-            --  protected entry index. Note that the protected type may not
-            --  have entries.
-
-            if Entry_Names_OK then
-               Names := Build_Entry_Names (Rec_Type);
-
-               if Present (Names) then
-                  Append_To (Stmts, Names);
-               end if;
-            end if;
          end if;
 
          --  Second pass: components with per-object constraints