diff mbox

[Ada] Optimization of anonymous access-to-controlled types

Message ID 20160502100512.GA1379@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet May 2, 2016, 10:05 a.m. UTC
This patch modifies the creation of finalization masters for anonymous access-
to-controlled types. Prior to this change, each compilation unit utilized a
single heterogeneous finalization master to service all allocations where the
associated type is anonymous access-to-controlled. This patch removes the use
of the single heterogeneous finalization master and instead introduces multiple
homogenous finalization masters. This leads to increase in performance because
allocation no longer needs to maintain a mapping between allocated object and
corresponding Finalize_Address primitive in a runtime hash data structure. As
a result, anonymous access-to-controlled types are on par with named access-to-
controlled types.

------------
-- Source --
------------

--  types.ads

with Ada.Finalization; use Ada.Finalization;

package Types is
   type Ctrl is new Controlled with record
      Id : Natural;
   end record;

   --  Anonymous types

   type Anon_Discr (Discr : access Ctrl) is null record;

   type Anon_Comps is record
      Comp_1 : access Ctrl;
      Comp_2 : access Ctrl;
   end record;

   type Anon_Array is array (1 .. 5) of access Ctrl;

   --  Named types

   type Ctrl_Ptr is access all Ctrl;

   type Named_Discr (Discr : Ctrl_Ptr) is null record;

   type Named_Discr_Ptr is access all Named_Discr;

   type Named_Comps is record
      Comp_1 : Ctrl_Ptr;
      Comp_2 : Ctrl_Ptr;
   end record;
end Types;

--  performance.adb

with Ada.Calendar;     use Ada.Calendar;
with Ada.Finalization; use Ada.Finalization;
with Ada.Text_IO;      use Ada.Text_IO;
with Types;            use Types;

procedure Performance is
   Percentage     : constant := 0.3;     --  30%
   Max_Iterations : constant := 50_000;

   Diff_A  : Duration;
   Diff_N  : Duration;
   Factor  : Duration;
   Start_A : Time;
   Start_N : Time;

begin
   Start_A := Clock;

   for Iteration in 1 .. Max_Iterations loop
      declare
         Anon_Discr_Obj : access Anon_Discr :=
                            new Anon_Discr'(Discr =>
                              new Ctrl'(Controlled with Id => 1));
         Anon_Comps_Obj : constant Anon_Comps :=
                            (Comp_1 => new Ctrl'(Controlled with Id => 2),
                             Comp_2 => new Ctrl'(Controlled with Id => 3));
      begin null; end;
   end loop;

   Diff_A  := Clock - Start_A;
   Start_N := Clock;

   for Iteration in 1 .. Max_Iterations loop
      declare
         Named_Discr_Obj : Named_Discr_Ptr :=
                             new Named_Discr'(Discr =>
                               new Ctrl'(Controlled with Id => 4));
         Named_Comps_Obj : constant Named_Comps :=
                             (Comp_1 => new Ctrl'(Controlled with Id => 5),
                              Comp_2 => new Ctrl'(Controlled with Id => 6));
      begin null; end;
   end loop;

   Diff_N := Clock - Start_N;
   Factor := Diff_N * Percentage;

   if Diff_N - Factor < Diff_A and then Diff_A < Diff_N + Factor then
      Put_Line ("Anonymous vs Named within expected percentage");
   else
      Put_Line ("ERROR");
   end if;
end Performance;

----------------------------
-- Compilation and output --
----------------------------

$ gnatmake -q performance.adb
$ ./performance
Anonymous vs Named within expected percentage

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

2016-05-02  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb Anonymous_Master now uses Node35.
	(Anonymous_Master): Update the assertion and node reference.
	(Set_Anonymous_Master): Update the assertion and node reference.
	(Write_Field35_Name): Add output for Anonymous_Master.
	(Write_Field36_Name): The output is now undefined.
	* einfo.ads Update the node and description of attribute
	Anonymous_Master. Remove prior occurrences in entities as this
	is now a type attribute.
	* exp_ch3.adb (Expand_Freeze_Array_Type): Remove local variable
	Ins_Node. Anonymous access- to-controlled component types no
	longer need finalization masters. The master is now built when
	a related allocator is expanded.
	(Expand_Freeze_Record_Type): Remove local variable Has_AACC. Do not
	detect whether the record type has at least one component of anonymous
	access-to- controlled type. These types no longer need finalization
	masters. The master is now built when a related allocator is expanded.
	* exp_ch4.adb Remove with and use clauses for Lib and Sem_Ch8.
	(Current_Anonymous_Master): Removed.
	(Expand_N_Allocator): Call Build_Anonymous_Master to create a
	finalization master for an anonymous access-to-controlled type.
	* exp_ch6.adb (Add_Finalization_Master_Actual_To_Build_In_Place_Call):
	Call routine Build_Anonymous_Master to create a finalization master
	for an anonymous access-to-controlled type.
	* exp_ch7.adb (Allows_Finalization_Master): New routine.
	(Build_Anonymous_Master): New routine.
	(Build_Finalization_Master): Remove formal parameter
	For_Anonymous. Use Allows_Finalization_Master to determine whether
	circumstances warrant a finalization master. This routine no
	longer creates masters for anonymous access-to-controlled types.
	(In_Deallocation_Instance): Removed.
	* exp_ch7.ads (Build_Anonymous_Master): New routine.
	(Build_Finalization_Master): Remove formal parameter For_Anonymous
	and update the comment on usage.
	* sem_util.adb (Get_Qualified_Name): New routines.
	(Output_Name): Reimplemented.
	(Output_Scope): Removed.
	* sem_util.ads (Get_Qualified_Name): New routines.
diff mbox

Patch

Index: exp_ch7.adb
===================================================================
--- exp_ch7.adb	(revision 235706)
+++ exp_ch7.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -301,6 +301,9 @@ 
                      Finalize_Case   => TSS_Deep_Finalize,
                      Address_Case    => TSS_Finalize_Address);
 
+   function Allows_Finalization_Master (Typ : Entity_Id) return Boolean;
+   --  Determine whether access type Typ may have a finalization master
+
    procedure Build_Array_Deep_Procs (Typ : Entity_Id);
    --  Build the deep Initialize/Adjust/Finalize for a record Typ with
    --  Has_Controlled_Component set and store them using the TSS mechanism.
@@ -427,7 +430,333 @@ 
    --       [Deep_]Finalize (Acc_Typ (V).all);
    --    end;
 
+   --------------------------------
+   -- Allows_Finalization_Master --
+   --------------------------------
+
+   function Allows_Finalization_Master (Typ : Entity_Id) return Boolean is
+      function In_Deallocation_Instance (E : Entity_Id) return Boolean;
+      --  Determine whether entity E is inside a wrapper package created for
+      --  an instance of Ada.Unchecked_Deallocation.
+
+      ------------------------------
+      -- In_Deallocation_Instance --
+      ------------------------------
+
+      function In_Deallocation_Instance (E : Entity_Id) return Boolean is
+         Pkg : constant Entity_Id := Scope (E);
+         Par : Node_Id := Empty;
+
+      begin
+         if Ekind (Pkg) = E_Package
+           and then Present (Related_Instance (Pkg))
+           and then Ekind (Related_Instance (Pkg)) = E_Procedure
+         then
+            Par := Generic_Parent (Parent (Related_Instance (Pkg)));
+
+            return
+              Present (Par)
+                and then Chars (Par) = Name_Unchecked_Deallocation
+                and then Chars (Scope (Par)) = Name_Ada
+                and then Scope (Scope (Par)) = Standard_Standard;
+         end if;
+
+         return False;
+      end In_Deallocation_Instance;
+
+      --  Local variables
+
+      Desig_Typ : constant Entity_Id := Designated_Type (Typ);
+      Ptr_Typ   : constant Entity_Id :=
+                    Root_Type_Of_Full_View (Base_Type (Typ));
+
+   --  Start of processing for Allows_Finalization_Master
+
+   begin
+      --  Certain run-time configurations and targets do not provide support
+      --  for controlled types and therefore do not need masters.
+
+      if Restriction_Active (No_Finalization) then
+         return False;
+
+      --  Do not consider C and C++ types since it is assumed that the non-Ada
+      --  side will handle their clean up.
+
+      elsif Convention (Desig_Typ) = Convention_C
+        or else Convention (Desig_Typ) = Convention_CPP
+      then
+         return False;
+
+      --  Do not consider types that return on the secondary stack
+
+      elsif Present (Associated_Storage_Pool (Ptr_Typ))
+        and then Is_RTE (Associated_Storage_Pool (Ptr_Typ), RE_SS_Pool)
+      then
+         return False;
+
+      --  Do not consider types which may never allocate an object
+
+      elsif No_Pool_Assigned (Ptr_Typ) then
+         return False;
+
+      --  Do not consider access types coming from Ada.Unchecked_Deallocation
+      --  instances. Even though the designated type may be controlled, the
+      --  access type will never participate in allocation.
+
+      elsif In_Deallocation_Instance (Ptr_Typ) then
+         return False;
+
+      --  Do not consider non-library access types when restriction
+      --  No_Nested_Finalization is in effect since masters are controlled
+      --  objects.
+
+      elsif Restriction_Active (No_Nested_Finalization)
+        and then not Is_Library_Level_Entity (Ptr_Typ)
+      then
+         return False;
+
+      --  Do not create finalization masters in GNATprove mode because this
+      --  causes unwanted extra expansion. A compilation in this mode must
+      --  keep the tree as close as possible to the original sources.
+
+      elsif GNATprove_Mode then
+         return False;
+
+      --  Otherwise the access type may use a finalization master
+
+      else
+         return True;
+      end if;
+   end Allows_Finalization_Master;
+
    ----------------------------
+   -- Build_Anonymous_Master --
+   ----------------------------
+
+   procedure Build_Anonymous_Master (Ptr_Typ : Entity_Id) is
+      function Create_Anonymous_Master
+        (Desig_Typ : Entity_Id;
+         Unit_Id   : Entity_Id;
+         Unit_Decl : Node_Id) return Entity_Id;
+      --  Create a new anonymous finalization master for access type Ptr_Typ
+      --  with designated type Desig_Typ. The declaration of the master along
+      --  with its specialized initialization is inserted in the declarative
+      --  part of unit Unit_Decl. Unit_Id denotes the entity of Unit_Decl.
+
+      function In_Subtree (N : Node_Id; Root : Node_Id) return Boolean;
+      --  Determine whether arbitrary node N appears within the subtree rooted
+      --  at node Root.
+
+      -----------------------------
+      -- Create_Anonymous_Master --
+      -----------------------------
+
+      function Create_Anonymous_Master
+        (Desig_Typ : Entity_Id;
+         Unit_Id   : Entity_Id;
+         Unit_Decl : Node_Id) return Entity_Id
+      is
+         Loc       : constant Source_Ptr := Sloc (Unit_Id);
+         Spec_Id   : constant Entity_Id  := Unique_Defining_Entity (Unit_Decl);
+         Decls     : List_Id;
+         FM_Decl   : Node_Id;
+         FM_Id     : Entity_Id;
+         FM_Init   : Node_Id;
+         Pref      : Character;
+         Unit_Spec : Node_Id;
+
+      begin
+         --  Find the declarative list of the unit
+
+         if Nkind (Unit_Decl) = N_Package_Declaration then
+            Unit_Spec := Specification (Unit_Decl);
+            Decls     := Visible_Declarations (Unit_Spec);
+
+            if No (Decls) then
+               Decls := New_List;
+               Set_Visible_Declarations (Unit_Spec, Decls);
+            end if;
+
+         --  Package body or subprogram case
+
+         --  ??? A subprogram spec or body that acts as a compilation unit may
+         --  contain a formal parameter of an anonymous access-to-controlled
+         --  type initialized by an allocator.
+
+         --    procedure Comp_Unit_Proc (Param : access Ctrl := new Ctrl);
+
+         --  There is no suitable place to create the anonymous master as the
+         --  subprogram is not in a declarative list.
+
+         else
+            Decls := Declarations (Unit_Decl);
+
+            if No (Decls) then
+               Decls := New_List;
+               Set_Declarations (Unit_Decl, Decls);
+            end if;
+         end if;
+
+         --  Step 1: Anonymous master creation
+
+         --  Use a unique prefix in case the same unit requires two anonymous
+         --  masters, one for the spec (S) and one for the body (B).
+
+         if Ekind_In (Unit_Id, E_Function, E_Package, E_Procedure) then
+            Pref := 'S';
+         else
+            Pref := 'B';
+         end if;
+
+         --  The name of the anonymous master has the following format:
+
+         --    [BS]scopN__scop1__chars_of_desig_typAM
+
+         --  The name utilizes the fully qualified name of the designated type
+         --  in case two controlled types with the same name are declared in
+         --  different scopes and both have anonymous access types.
+
+         FM_Id :=
+           Make_Defining_Identifier (Loc,
+             New_External_Name
+               (Related_Id => Get_Qualified_Name (Desig_Typ),
+                Suffix     => "AM",
+                Prefix     => Pref));
+
+         --  Associate the anonymous master with the designated type. This
+         --  ensures that any additional anonymous access types with the same
+         --  designated type will share the same anonymous paster within the
+         --  same unit.
+
+         Set_Anonymous_Master (Desig_Typ, FM_Id);
+
+         --  Generate:
+         --    <FM_Id> : Finalization_Master;
+
+         FM_Decl :=
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => FM_Id,
+             Object_Definition   =>
+               New_Occurrence_Of (RTE (RE_Finalization_Master), Loc));
+
+         --  Step 2: Initialization actions
+
+         --  Generate:
+         --    Set_Base_Pool
+         --      (<FM_Id>, Global_Pool_Object'Unrestricted_Access);
+
+         FM_Init :=
+           Make_Procedure_Call_Statement (Loc,
+             Name                   =>
+               New_Occurrence_Of (RTE (RE_Set_Base_Pool), Loc),
+             Parameter_Associations => New_List (
+               New_Occurrence_Of (FM_Id, Loc),
+               Make_Attribute_Reference (Loc,
+                 Prefix         =>
+                   New_Occurrence_Of (RTE (RE_Global_Pool_Object), Loc),
+                 Attribute_Name => Name_Unrestricted_Access)));
+
+         Prepend_To (Decls, FM_Init);
+         Prepend_To (Decls, FM_Decl);
+
+         --  Since the anonymous master and all its initialization actions are
+         --  inserted at top level, use the scope of the unit when analyzing.
+
+         Push_Scope (Spec_Id);
+         Analyze (FM_Decl);
+         Analyze (FM_Init);
+         Pop_Scope;
+
+         return FM_Id;
+      end Create_Anonymous_Master;
+
+      ----------------
+      -- In_Subtree --
+      ----------------
+
+      function In_Subtree (N : Node_Id; Root : Node_Id) return Boolean is
+         Par : Node_Id;
+
+      begin
+         --  Traverse the parent chain until reaching the same root
+
+         Par := N;
+         while Present (Par) loop
+            if Par = Root then
+               return True;
+            end if;
+
+            Par := Parent (Par);
+         end loop;
+
+         return False;
+      end In_Subtree;
+
+      --  Local variables
+
+      Desig_Typ : Entity_Id;
+      FM_Id     : Entity_Id;
+      Priv_View : Entity_Id;
+      Unit_Decl : Node_Id;
+      Unit_Id   : Entity_Id;
+
+   --  Start of processing for Build_Anonymous_Master
+
+   begin
+      --  Nothing to do if the circumstances do not allow for a finalization
+      --  master.
+
+      if not Allows_Finalization_Master (Ptr_Typ) then
+         return;
+      end if;
+
+      Unit_Decl := Unit (Cunit (Current_Sem_Unit));
+      Unit_Id   := Defining_Entity (Unit_Decl);
+
+      --  The compilation unit is a package instantiation. In this case the
+      --  anonymous master is associated with the package spec as both the
+      --  spec and body appear at the same level.
+
+      if Nkind (Unit_Decl) = N_Package_Body
+        and then Nkind (Original_Node (Unit_Decl)) = N_Package_Instantiation
+      then
+         Unit_Id   := Corresponding_Spec (Unit_Decl);
+         Unit_Decl := Unit_Declaration_Node (Unit_Id);
+      end if;
+
+      --  Use the initial declaration of the designated type when it denotes
+      --  the full view of an incomplete or private type. This ensures that
+      --  types with one and two views are treated the same.
+
+      Desig_Typ := Directly_Designated_Type (Ptr_Typ);
+      Priv_View := Incomplete_Or_Partial_View (Desig_Typ);
+
+      if Present (Priv_View) then
+         Desig_Typ := Priv_View;
+      end if;
+
+      FM_Id := Anonymous_Master (Desig_Typ);
+
+      --  The designated type already has at least one anonymous access type
+      --  pointing to it within the current unit. Reuse the anonymous master
+      --  because the designated type is the same.
+
+      if Present (FM_Id)
+        and then In_Subtree (Declaration_Node (FM_Id), Root => Unit_Decl)
+      then
+         null;
+
+      --  Otherwise the designated type lacks an anonymous master or it is
+      --  declared in a different unit. Create a brand new master.
+
+      else
+         FM_Id := Create_Anonymous_Master (Desig_Typ, Unit_Id, Unit_Decl);
+      end if;
+
+      Set_Finalization_Master (Ptr_Typ, FM_Id);
+   end Build_Anonymous_Master;
+
+   ----------------------------
    -- Build_Array_Deep_Procs --
    ----------------------------
 
@@ -762,7 +1091,6 @@ 
 
    procedure Build_Finalization_Master
      (Typ            : Entity_Id;
-      For_Anonymous  : Boolean   := False;
       For_Lib_Level  : Boolean   := False;
       For_Private    : Boolean   := False;
       Context_Scope  : Entity_Id := Empty;
@@ -773,10 +1101,6 @@ 
          Ptr_Typ : Entity_Id);
       --  Add access type Ptr_Typ to the pending access type list for type Typ
 
-      function In_Deallocation_Instance (E : Entity_Id) return Boolean;
-      --  Determine whether entity E is inside a wrapper package created for
-      --  an instance of Ada.Unchecked_Deallocation.
-
       -----------------------------
       -- Add_Pending_Access_Type --
       -----------------------------
@@ -798,31 +1122,6 @@ 
          Prepend_Elmt (Ptr_Typ, List);
       end Add_Pending_Access_Type;
 
-      ------------------------------
-      -- In_Deallocation_Instance --
-      ------------------------------
-
-      function In_Deallocation_Instance (E : Entity_Id) return Boolean is
-         Pkg : constant Entity_Id := Scope (E);
-         Par : Node_Id := Empty;
-
-      begin
-         if Ekind (Pkg) = E_Package
-           and then Present (Related_Instance (Pkg))
-           and then Ekind (Related_Instance (Pkg)) = E_Procedure
-         then
-            Par := Generic_Parent (Parent (Related_Instance (Pkg)));
-
-            return
-              Present (Par)
-                and then Chars (Par) = Name_Unchecked_Deallocation
-                and then Chars (Scope (Par)) = Name_Ada
-                and then Scope (Scope (Par)) = Standard_Standard;
-         end if;
-
-         return False;
-      end In_Deallocation_Instance;
-
       --  Local variables
 
       Desig_Typ : constant Entity_Id := Designated_Type (Typ);
@@ -836,67 +1135,17 @@ 
    --  Start of processing for Build_Finalization_Master
 
    begin
-      --  Certain run-time configurations and targets do not provide support
-      --  for controlled types.
+      --  Nothing to do if the circumstances do not allow for a finalization
+      --  master.
 
-      if Restriction_Active (No_Finalization) then
+      if not Allows_Finalization_Master (Typ) then
          return;
 
-      --  Do not process C, C++ types since it is assumed that the non-Ada side
-      --  will handle their clean up.
-
-      elsif Convention (Desig_Typ) = Convention_C
-        or else Convention (Desig_Typ) = Convention_CPP
-      then
-         return;
-
       --  Various machinery such as freezing may have already created a
       --  finalization master.
 
       elsif Present (Finalization_Master (Ptr_Typ)) then
          return;
-
-      --  Do not process types that return on the secondary stack
-
-      elsif Present (Associated_Storage_Pool (Ptr_Typ))
-        and then Is_RTE (Associated_Storage_Pool (Ptr_Typ), RE_SS_Pool)
-      then
-         return;
-
-      --  Do not process types which may never allocate an object
-
-      elsif No_Pool_Assigned (Ptr_Typ) then
-         return;
-
-      --  Do not process access types coming from Ada.Unchecked_Deallocation
-      --  instances. Even though the designated type may be controlled, the
-      --  access type will never participate in allocation.
-
-      elsif In_Deallocation_Instance (Ptr_Typ) then
-         return;
-
-      --  Ignore the general use of anonymous access types unless the context
-      --  requires a finalization master.
-
-      elsif Ekind (Ptr_Typ) = E_Anonymous_Access_Type
-        and then not For_Anonymous
-      then
-         return;
-
-      --  Do not process non-library access types when restriction No_Nested_
-      --  Finalization is in effect since masters are controlled objects.
-
-      elsif Restriction_Active (No_Nested_Finalization)
-        and then not Is_Library_Level_Entity (Ptr_Typ)
-      then
-         return;
-
-      --  Do not create finalization masters in GNATprove mode because this
-      --  unwanted extra expansion. A compilation in this mode keeps the tree
-      --  as close as possible to the original sources.
-
-      elsif GNATprove_Mode then
-         return;
       end if;
 
       declare
@@ -1013,11 +1262,11 @@ 
             Add_Pending_Access_Type (Desig_Typ, Ptr_Typ);
          end if;
 
-         --  A finalization master created for an anonymous access type or an
-         --  access designating a type with private components must be inserted
-         --  before a context-dependent node.
+         --  A finalization master created for an access designating a type
+         --  with private components is inserted before a context-dependent
+         --  node.
 
-         if For_Anonymous or For_Private then
+         if For_Private then
 
             --  At this point both the scope of the context and the insertion
             --  mode must be known.
@@ -3693,15 +3942,6 @@ 
       end if;
    end Check_Visibly_Controlled;
 
-   -------------------------------
-   -- CW_Or_Has_Controlled_Part --
-   -------------------------------
-
-   function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean is
-   begin
-      return Is_Class_Wide_Type (T) or else Needs_Finalization (T);
-   end CW_Or_Has_Controlled_Part;
-
    ------------------
    -- Convert_View --
    ------------------
@@ -3764,6 +4004,15 @@ 
       end if;
    end Convert_View;
 
+   -------------------------------
+   -- CW_Or_Has_Controlled_Part --
+   -------------------------------
+
+   function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean is
+   begin
+      return Is_Class_Wide_Type (T) or else Needs_Finalization (T);
+   end CW_Or_Has_Controlled_Part;
+
    ------------------------
    -- Enclosing_Function --
    ------------------------
Index: exp_ch7.ads
===================================================================
--- exp_ch7.ads	(revision 235706)
+++ exp_ch7.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -35,6 +35,11 @@ 
    -- Finalization Management --
    -----------------------------
 
+   procedure Build_Anonymous_Master (Ptr_Typ : Entity_Id);
+   --  Build a finalization master for an anonymous access-to-controlled type
+   --  denoted by Ptr_Typ. The master is inserted in the declarations of the
+   --  current unit.
+
    procedure Build_Controlling_Procs (Typ : Entity_Id);
    --  Typ is a record, and array type having controlled components.
    --  Create the procedures Deep_Initialize, Deep_Adjust and Deep_Finalize
@@ -99,22 +104,19 @@ 
 
    procedure Build_Finalization_Master
      (Typ            : Entity_Id;
-      For_Anonymous  : Boolean   := False;
       For_Lib_Level  : Boolean   := False;
       For_Private    : Boolean   := False;
       Context_Scope  : Entity_Id := Empty;
       Insertion_Node : Node_Id   := Empty);
    --  Build a finalization master for an access type. The designated type may
    --  not necessarely be controlled or need finalization actions depending on
-   --  the context. Flag For_Anonymous must be set when creating a master for
-   --  an anonymous access type. Flag For_Lib_Level must be set when creating
-   --  a master for a build-in-place function call access result type. Flag
-   --  For_Private must be set when the designated type contains a private
-   --  component. Parameters Context_Scope and Insertion_Node must be used in
-   --  conjunction with flags For_Anonymous and For_Private. Context_Scope is
-   --  the scope of the context where the finalization master must be analyzed.
-   --  Insertion_Node is the insertion point before which the master is to be
-   --  inserted.
+   --  the context. Flag For_Lib_Level must be set when creating a master for a
+   --  build-in-place function call access result type. Flag For_Private must
+   --  be set when the designated type contains a private component. Parameters
+   --  Context_Scope and Insertion_Node must be used in conjunction with flag
+   --  For_Private. Context_Scope is the scope of the context where the
+   --  finalization master must be analyzed. Insertion_Node is the insertion
+   --  point before which the master is to be inserted.
 
    procedure Build_Late_Proc (Typ : Entity_Id; Nam : Name_Id);
    --  Build one controlling procedure when a late body overrides one of
Index: einfo.adb
===================================================================
--- einfo.adb	(revision 235730)
+++ einfo.adb	(working copy)
@@ -265,10 +265,9 @@ 
 
    --    Contract                        Node34
 
+   --    Anonymous_Master                Node35
    --    Import_Pragma                   Node35
 
-   --    Anonymous_Master                Node36
-
    --    Class_Wide_Preconds             List38
 
    --    Class_Wide_Postconds            List39
@@ -757,12 +756,8 @@ 
 
    function Anonymous_Master (Id : E) return E is
    begin
-      pragma Assert (Ekind_In (Id, E_Function,
-                                   E_Package,
-                                   E_Package_Body,
-                                   E_Procedure,
-                                   E_Subprogram_Body));
-      return Node36 (Id);
+      pragma Assert (Is_Type (Id));
+      return Node35 (Id);
    end Anonymous_Master;
 
    function Anonymous_Object (Id : E) return E is
@@ -3682,12 +3677,8 @@ 
 
    procedure Set_Anonymous_Master (Id : E; V : E) is
    begin
-      pragma Assert (Ekind_In (Id, E_Function,
-                                   E_Package,
-                                   E_Package_Body,
-                                   E_Procedure,
-                                   E_Subprogram_Body));
-      Set_Node36 (Id, V);
+      pragma Assert (Is_Type (Id));
+      Set_Node35 (Id, V);
    end Set_Anonymous_Master;
 
    procedure Set_Anonymous_Object (Id : E; V : E) is
@@ -10385,6 +10376,9 @@ 
    procedure Write_Field35_Name (Id : Entity_Id) is
    begin
       case Ekind (Id) is
+         when Type_Kind                                    =>
+            Write_Str ("Anonymous_Master");
+
          when Subprogram_Kind                              =>
             Write_Str ("Import_Pragma");
 
@@ -10398,19 +10392,9 @@ 
    ------------------------
 
    procedure Write_Field36_Name (Id : Entity_Id) is
+      pragma Unreferenced (Id);
    begin
-      case Ekind (Id) is
-         when E_Function                                   |
-              E_Operator                                   |
-              E_Package                                    |
-              E_Package_Body                               |
-              E_Procedure                                  |
-              E_Subprogram_Body                            =>
-            Write_Str ("Anonymous_Master");
-
-         when others                                       =>
-            Write_Str ("Field36??");
-      end case;
+      Write_Str ("Field36??");
    end Write_Field36_Name;
 
    ------------------------
Index: einfo.ads
===================================================================
--- einfo.ads	(revision 235730)
+++ einfo.ads	(working copy)
@@ -438,11 +438,11 @@ 
 --       definition clause with an (obsolescent) mod clause is converted
 --       into an attribute definition clause for this purpose.
 
---    Anonymous_Master (Node36)
---       Defined in the entities of non-generic packages, subprograms and their
---       corresponding bodies. Contains the entity of a special heterogeneous
---       finalization master that services most anonymous access-to-controlled
---       allocations that occur within the unit.
+--    Anonymous_Master (Node35)
+--       Defined in all types. Contains the entity of an anonymous finalization
+--       master which services all anonymous access types associated with the
+--       same designated type within the current semantic unit. The attribute
+--       is set reactively during the expansion of allocators.
 
 --    Anonymous_Object (Node30)
 --       Present in protected and task type entities. Contains the entity of
@@ -5468,6 +5468,7 @@ 
    --    Derived_Type_Link                   (Node31)
    --    No_Tagged_Streams_Pragma            (Node32)
    --    Linker_Section_Pragma               (Node33)
+   --    Anonymous_Master                    (Node35)
 
    --    Depends_On_Private                  (Flag14)
    --    Disable_Controlled                  (Flag253)
@@ -5668,8 +5669,8 @@ 
    --    Cloned_Subtype                      (Node16)   (subtype case only)
    --    First_Entity                        (Node17)
    --    Equivalent_Type                     (Node18)   (always Empty for type)
-   --    Last_Entity                         (Node20)
    --    Non_Limited_View                    (Node19)
+   --    Last_Entity                         (Node20)
    --    SSO_Set_High_By_Default             (Flag273)  (base type only)
    --    SSO_Set_Low_By_Default              (Flag272)  (base type only)
    --    First_Component                     (synth)
@@ -5919,7 +5920,6 @@ 
    --    Linker_Section_Pragma               (Node33)
    --    Contract                            (Node34)
    --    Import_Pragma                       (Node35)   (non-generic case only)
-   --    Anonymous_Master                    (Node36)   (non-generic case only)
    --    Class_Wide_Preconds                 (List38)
    --    Class_Wide_Postconds                (List39)
    --    SPARK_Pragma                        (Node40)
@@ -6141,7 +6141,6 @@ 
    --    Current_Use_Clause                  (Node27)
    --    Finalizer                           (Node28)   (non-generic case only)
    --    Contract                            (Node34)
-   --    Anonymous_Master                    (Node36)   (non-generic case only)
    --    SPARK_Pragma                        (Node40)
    --    SPARK_Aux_Pragma                    (Node41)
    --    Delay_Subprogram_Descriptors        (Flag50)
@@ -6179,7 +6178,6 @@ 
    --    Scope_Depth_Value                   (Uint22)
    --    Finalizer                           (Node28)   (non-generic case only)
    --    Contract                            (Node34)
-   --    Anonymous_Master                    (Node36)
    --    SPARK_Pragma                        (Node40)
    --    SPARK_Aux_Pragma                    (Node41)
    --    Contains_Ignored_Ghost_Code         (Flag279)
@@ -6233,7 +6231,6 @@ 
    --    Linker_Section_Pragma               (Node33)
    --    Contract                            (Node34)
    --    Import_Pragma                       (Node35)   (non-generic case only)
-   --    Anonymous_Master                    (Node36)   (non-generic case only)
    --    Class_Wide_Preconds                 (List38)
    --    Class_Wide_Postconds                (List39)
    --    SPARK_Pragma                        (Node40)
@@ -6419,7 +6416,6 @@ 
    --    Scope_Depth_Value                   (Uint22)
    --    Extra_Formals                       (Node28)
    --    Contract                            (Node34)
-   --    Anonymous_Master                    (Node36)
    --    SPARK_Pragma                        (Node40)
    --    Contains_Ignored_Ghost_Code         (Flag279)
    --    SPARK_Pragma_Inherited              (Flag265)
Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 235729)
+++ sem_util.adb	(working copy)
@@ -8322,6 +8322,73 @@ 
       return Get_Pragma_Id (Pragma_Name (N));
    end Get_Pragma_Id;
 
+   ------------------------
+   -- Get_Qualified_Name --
+   ------------------------
+
+   function Get_Qualified_Name
+     (Id     : Entity_Id;
+      Suffix : Entity_Id := Empty) return Name_Id
+   is
+      Suffix_Nam : Name_Id := No_Name;
+
+   begin
+      if Present (Suffix) then
+         Suffix_Nam := Chars (Suffix);
+      end if;
+
+      return Get_Qualified_Name (Chars (Id), Suffix_Nam, Scope (Id));
+   end Get_Qualified_Name;
+
+   function Get_Qualified_Name
+     (Nam    : Name_Id;
+      Suffix : Name_Id   := No_Name;
+      Scop   : Entity_Id := Current_Scope) return Name_Id
+   is
+      procedure Add_Scope (S : Entity_Id);
+      --  Add the fully qualified form of scope S to the name buffer. The
+      --  format is:
+      --    s-1__s__
+
+      ---------------
+      -- Add_Scope --
+      ---------------
+
+      procedure Add_Scope (S : Entity_Id) is
+      begin
+         if S = Empty then
+            null;
+
+         elsif S = Standard_Standard then
+            null;
+
+         else
+            Add_Scope (Scope (S));
+            Get_Name_String_And_Append (Chars (S));
+            Add_Str_To_Name_Buffer ("__");
+         end if;
+      end Add_Scope;
+
+   --  Start of processing for Get_Qualified_Name
+
+   begin
+      Name_Len := 0;
+      Add_Scope (Scop);
+
+      --  Append the base name after all scopes have been chained
+
+      Get_Name_String_And_Append (Nam);
+
+      --  Append the suffix (if present)
+
+      if Suffix /= No_Name then
+         Add_Str_To_Name_Buffer ("__");
+         Get_Name_String_And_Append (Suffix);
+      end if;
+
+      return Name_Find;
+   end Get_Qualified_Name;
+
    -----------------------
    -- Get_Reason_String --
    -----------------------
@@ -17762,39 +17829,13 @@ 
    -----------------
 
    procedure Output_Name (Nam : Name_Id; Scop : Entity_Id := Current_Scope) is
-      procedure Output_Scope (S : Entity_Id);
-      --  Add the fully qualified form of scope S to the name buffer. The
-      --  qualification format is:
-      --    scope1__scopeN__
-
-      ------------------
-      -- Output_Scope --
-      ------------------
-
-      procedure Output_Scope (S : Entity_Id) is
-      begin
-         if S = Empty then
-            null;
-
-         elsif S = Standard_Standard then
-            null;
-
-         else
-            Output_Scope (Scope (S));
-            Add_Str_To_Name_Buffer (Get_Name_String (Chars (S)));
-            Add_Str_To_Name_Buffer ("__");
-         end if;
-      end Output_Scope;
-
-   --  Start of processing for Output_Name
-
    begin
-      Name_Len := 0;
-      Output_Scope (Scop);
-
-      Add_Str_To_Name_Buffer (Get_Name_String (Nam));
-
-      Write_Str (Name_Buffer (1 .. Name_Len));
+      Write_Str
+        (Get_Name_String
+          (Get_Qualified_Name
+            (Nam    => Nam,
+             Suffix => No_Name,
+             Scop   => Scop)));
       Write_Eol;
    end Output_Name;
 
Index: sem_util.ads
===================================================================
--- sem_util.ads	(revision 235706)
+++ sem_util.ads	(working copy)
@@ -950,6 +950,20 @@ 
    pragma Inline (Get_Pragma_Id);
    --  Obtains the Pragma_Id from the Chars field of Pragma_Identifier (N)
 
+   function Get_Qualified_Name
+     (Id     : Entity_Id;
+      Suffix : Entity_Id := Empty) return Name_Id;
+   --  Obtain the fully qualified form of entity Id. The format is:
+   --    scope_of_id-1__scope_of_id__chars_of_id__chars_of_suffix
+
+   function Get_Qualified_Name
+     (Nam    : Name_Id;
+      Suffix : Name_Id   := No_Name;
+      Scop   : Entity_Id := Current_Scope) return Name_Id;
+   --  Obtain the fully qualified form of name Nam assuming it appears in scope
+   --  Scop. The format is:
+   --    scop-1__scop__nam__suffix
+
    procedure Get_Reason_String (N : Node_Id);
    --  Recursive routine to analyze reason argument for pragma Warnings. The
    --  value of the reason argument is appended to the current string using
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 235730)
+++ exp_ch4.adb	(working copy)
@@ -44,7 +44,6 @@ 
 with Exp_Util; use Exp_Util;
 with Freeze;   use Freeze;
 with Inline;   use Inline;
-with Lib;      use Lib;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
@@ -57,7 +56,6 @@ 
 with Sem_Aux;  use Sem_Aux;
 with Sem_Cat;  use Sem_Cat;
 with Sem_Ch3;  use Sem_Ch3;
-with Sem_Ch8;  use Sem_Ch8;
 with Sem_Ch13; use Sem_Ch13;
 with Sem_Eval; use Sem_Eval;
 with Sem_Res;  use Sem_Res;
@@ -92,12 +90,6 @@ 
    --  If a boolean array assignment can be done in place, build call to
    --  corresponding library procedure.
 
-   function Current_Anonymous_Master return Entity_Id;
-   --  Return the entity of the heterogeneous finalization master belonging to
-   --  the current unit (either function, package or procedure). This master
-   --  services all anonymous access-to-controlled types. If the current unit
-   --  does not have such master, create one.
-
    procedure Displace_Allocator_Pointer (N : Node_Id);
    --  Ada 2005 (AI-251): Subsidiary procedure to Expand_N_Allocator and
    --  Expand_Allocator_Expression. Allocating class-wide interface objects
@@ -410,202 +402,6 @@ 
          return;
    end Build_Boolean_Array_Proc_Call;
 
-   ------------------------------
-   -- Current_Anonymous_Master --
-   ------------------------------
-
-   function Current_Anonymous_Master return Entity_Id is
-      function Create_Anonymous_Master
-        (Unit_Id   : Entity_Id;
-         Unit_Decl : Node_Id) return Entity_Id;
-      --  Create a new anonymous master for a compilation unit denoted by its
-      --  entity Unit_Id and declaration Unit_Decl. The declaration of the new
-      --  master along with any specialized initialization is inserted at the
-      --  top of the unit's declarations (see body for special cases). Return
-      --  the entity of the anonymous master.
-
-      -----------------------------
-      -- Create_Anonymous_Master --
-      -----------------------------
-
-      function Create_Anonymous_Master
-        (Unit_Id   : Entity_Id;
-         Unit_Decl : Node_Id) return Entity_Id
-      is
-         Insert_Nod : Node_Id := Empty;
-         --  The point of insertion into the declarative list of the unit. All
-         --  nodes are inserted before Insert_Nod.
-
-         procedure Insert_And_Analyze (Decls : List_Id; N : Node_Id);
-         --  Insert arbitrary node N in declarative list Decls and analyze it
-
-         ------------------------
-         -- Insert_And_Analyze --
-         ------------------------
-
-         procedure Insert_And_Analyze (Decls : List_Id; N : Node_Id) is
-         begin
-            --  The declarative list is already populated, the nodes are
-            --  inserted at the top of the list, preserving their order.
-
-            if Present (Insert_Nod) then
-               Insert_Before (Insert_Nod, N);
-
-            --  Otherwise append to the declarations to preserve order
-
-            else
-               Append_To (Decls, N);
-            end if;
-
-            Analyze (N);
-         end Insert_And_Analyze;
-
-         --  Local variables
-
-         Loc       : constant Source_Ptr := Sloc (Unit_Id);
-         Spec_Id   : constant Entity_Id  := Unique_Defining_Entity (Unit_Decl);
-         Decls     : List_Id;
-         FM_Id     : Entity_Id;
-         Pref      : Character;
-         Unit_Spec : Node_Id;
-
-      --  Start of processing for Create_Anonymous_Master
-
-      begin
-         --  Find the declarative list of the unit
-
-         if Nkind (Unit_Decl) = N_Package_Declaration then
-            Unit_Spec := Specification (Unit_Decl);
-            Decls := Visible_Declarations (Unit_Spec);
-
-            if No (Decls) then
-               Decls := New_List (Make_Null_Statement (Loc));
-               Set_Visible_Declarations (Unit_Spec, Decls);
-            end if;
-
-         --  Package or subprogram body
-
-         --  ??? A subprogram declaration that acts as a compilation unit may
-         --  contain a formal parameter of an anonymous access-to-controlled
-         --  type initialized by an allocator.
-
-         --    procedure Comp_Unit_Proc (Param : access Ctrl := new Ctrl);
-
-         --  There is no suitable place to create the anonymous master as the
-         --  subprogram is not in a declarative list.
-
-         else
-            Decls := Declarations (Unit_Decl);
-
-            if No (Decls) then
-               Decls := New_List (Make_Null_Statement (Loc));
-               Set_Declarations (Unit_Decl, Decls);
-            end if;
-         end if;
-
-         --  The anonymous master and all initialization actions are inserted
-         --  before the first declaration (if any).
-
-         Insert_Nod := First (Decls);
-
-         --  Since the anonymous master and all its initialization actions are
-         --  inserted at top level, use the scope of the unit when analyzing.
-
-         Push_Scope (Spec_Id);
-
-         --  Step 1: Anonymous master creation
-
-         --  Use a unique prefix in case the same unit requires two anonymous
-         --  masters, one for the spec (S) and one for the body (B).
-
-         if Ekind_In (Unit_Id, E_Function, E_Package, E_Procedure) then
-            Pref := 'S';
-         else
-            Pref := 'B';
-         end if;
-
-         FM_Id :=
-           Make_Defining_Identifier (Loc,
-             New_External_Name
-               (Related_Id => Chars (Unit_Id),
-                Suffix     => "AM",
-                Prefix     => Pref));
-
-         Set_Anonymous_Master (Unit_Id, FM_Id);
-
-         --  Generate:
-         --    <FM_Id> : Finalization_Master;
-
-         Insert_And_Analyze (Decls,
-           Make_Object_Declaration (Loc,
-             Defining_Identifier => FM_Id,
-             Object_Definition   =>
-               New_Occurrence_Of (RTE (RE_Finalization_Master), Loc)));
-
-         --  Step 2: Initialization actions
-
-         --  Generate:
-         --    Set_Base_Pool
-         --      (<FM_Id>, Global_Pool_Object'Unrestricted_Access);
-
-         Insert_And_Analyze (Decls,
-           Make_Procedure_Call_Statement (Loc,
-             Name                   =>
-               New_Occurrence_Of (RTE (RE_Set_Base_Pool), Loc),
-             Parameter_Associations => New_List (
-               New_Occurrence_Of (FM_Id, Loc),
-               Make_Attribute_Reference (Loc,
-                 Prefix         =>
-                   New_Occurrence_Of (RTE (RE_Global_Pool_Object), Loc),
-                 Attribute_Name => Name_Unrestricted_Access))));
-
-         --  Generate:
-         --    Set_Is_Heterogeneous (<FM_Id>);
-
-         Insert_And_Analyze (Decls,
-           Make_Procedure_Call_Statement (Loc,
-             Name                   =>
-               New_Occurrence_Of (RTE (RE_Set_Is_Heterogeneous), Loc),
-             Parameter_Associations => New_List (
-               New_Occurrence_Of (FM_Id, Loc))));
-
-         Pop_Scope;
-         return FM_Id;
-      end Create_Anonymous_Master;
-
-      --  Local declarations
-
-      Unit_Decl : Node_Id;
-      Unit_Id   : Entity_Id;
-
-   --  Start of processing for Current_Anonymous_Master
-
-   begin
-      Unit_Decl := Unit (Cunit (Current_Sem_Unit));
-      Unit_Id   := Defining_Entity (Unit_Decl);
-
-      --  The compilation unit is a package instantiation. In this case the
-      --  anonymous master is associated with the package spec as both the
-      --  spec and body appear at the same level.
-
-      if Nkind (Unit_Decl) = N_Package_Body
-        and then Nkind (Original_Node (Unit_Decl)) = N_Package_Instantiation
-      then
-         Unit_Id   := Corresponding_Spec (Unit_Decl);
-         Unit_Decl := Unit_Declaration_Node (Unit_Id);
-      end if;
-
-      if Present (Anonymous_Master (Unit_Id)) then
-         return Anonymous_Master (Unit_Id);
-
-      --  Create a new anonymous master when allocating an object of anonymous
-      --  access-to-controlled type for the first time.
-
-      else
-         return Create_Anonymous_Master (Unit_Id, Unit_Decl);
-      end if;
-   end Current_Anonymous_Master;
-
    --------------------------------
    -- Displace_Allocator_Pointer --
    --------------------------------
@@ -4296,8 +4092,7 @@ 
             Set_Finalization_Master
               (Root_Type (PtrT), Finalization_Master (Rel_Typ));
          else
-            Set_Finalization_Master
-              (Root_Type (PtrT), Current_Anonymous_Master);
+            Build_Anonymous_Master (Root_Type (PtrT));
          end if;
       end if;
 
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb	(revision 235706)
+++ exp_ch6.adb	(working copy)
@@ -422,11 +422,7 @@ 
                if Ekind (Ptr_Typ) = E_Anonymous_Access_Type
                  and then No (Finalization_Master (Ptr_Typ))
                then
-                  Build_Finalization_Master
-                    (Typ            => Ptr_Typ,
-                     For_Anonymous  => True,
-                     Context_Scope  => Scope (Ptr_Typ),
-                     Insertion_Node => Associated_Node_For_Itype (Ptr_Typ));
+                  Build_Anonymous_Master (Ptr_Typ);
                end if;
 
                --  Access-to-controlled types should always have a master
Index: exp_ch3.adb
===================================================================
--- exp_ch3.adb	(revision 235730)
+++ exp_ch3.adb	(working copy)
@@ -4600,8 +4600,6 @@ 
 
       Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode;
 
-      Ins_Node : Node_Id;
-
    begin
       --  Ensure that all freezing activities are properly flagged as Ghost
 
@@ -4654,39 +4652,13 @@ 
             end if;
          end if;
 
-         if Typ = Base then
-            if Has_Controlled_Component (Base) then
-               Build_Controlling_Procs (Base);
+         if Typ = Base and then Has_Controlled_Component (Base) then
+            Build_Controlling_Procs (Base);
 
-               if not Is_Limited_Type (Comp_Typ)
-                 and then Number_Dimensions (Typ) = 1
-               then
-                  Build_Slice_Assignment (Typ);
-               end if;
-            end if;
-
-            --  Create a finalization master to service the anonymous access
-            --  components of the array.
-
-            if Ekind (Comp_Typ) = E_Anonymous_Access_Type
-              and then Needs_Finalization (Designated_Type (Comp_Typ))
+            if not Is_Limited_Type (Comp_Typ)
+              and then Number_Dimensions (Typ) = 1
             then
-               --  The finalization master is inserted before the declaration
-               --  of the array type. The only exception to this is when the
-               --  array type is an itype, in which case the master appears
-               --  before the related context.
-
-               if Is_Itype (Typ) then
-                  Ins_Node := Associated_Node_For_Itype (Typ);
-               else
-                  Ins_Node := Parent (Typ);
-               end if;
-
-               Build_Finalization_Master
-                 (Typ            => Comp_Typ,
-                  For_Anonymous  => True,
-                  Context_Scope  => Scope (Typ),
-                  Insertion_Node => Ins_Node);
+               Build_Slice_Assignment (Typ);
             end if;
          end if;
 
@@ -5044,13 +5016,12 @@ 
          Append_To (Lst,
            Make_Case_Statement_Alternative (Loc,
              Discrete_Choices => New_List (Make_Others_Choice (Loc)),
-             Statements => New_List (
+             Statements       => New_List (
                Make_Raise_Constraint_Error (Loc,
                  Condition => Make_Identifier (Loc, Name_uF),
                  Reason    => CE_Invalid_Data),
                Make_Simple_Return_Statement (Loc,
-                 Expression =>
-                   Make_Integer_Literal (Loc, -1)))));
+                 Expression => Make_Integer_Literal (Loc, -1)))));
 
       --  If either of the restrictions No_Exceptions_Handlers/Propagation is
       --  active then return -1 (we cannot usefully raise Constraint_Error in
@@ -5060,10 +5031,9 @@ 
          Append_To (Lst,
            Make_Case_Statement_Alternative (Loc,
              Discrete_Choices => New_List (Make_Others_Choice (Loc)),
-             Statements => New_List (
+             Statements       => New_List (
                Make_Simple_Return_Statement (Loc,
-                 Expression =>
-                   Make_Integer_Literal (Loc, -1)))));
+                 Expression => Make_Integer_Literal (Loc, -1)))));
       end if;
 
       --  Now we can build the function body
@@ -5137,9 +5107,11 @@ 
 
       Comp        : Entity_Id;
       Comp_Typ    : Entity_Id;
-      Has_AACC    : Boolean;
       Predef_List : List_Id;
 
+      Wrapper_Decl_List : List_Id := No_List;
+      Wrapper_Body_List : List_Id := No_List;
+
       Renamed_Eq : Node_Id := Empty;
       --  Defining unit name for the predefined equality function in the case
       --  where the type has a primitive operation that is a renaming of
@@ -5147,9 +5119,6 @@ 
       --  user-defined equality function). Used to pass this entity from
       --  Make_Predefined_Primitive_Specs to Predefined_Primitive_Bodies.
 
-      Wrapper_Decl_List : List_Id := No_List;
-      Wrapper_Body_List : List_Id := No_List;
-
    --  Start of processing for Expand_Freeze_Record_Type
 
    begin
@@ -5212,8 +5181,6 @@ 
       --  of the component types may have been private at the point of the
       --  record declaration. Detect anonymous access-to-controlled components.
 
-      Has_AACC := False;
-
       Comp := First_Component (Typ);
       while Present (Comp) loop
          Comp_Typ := Etype (Comp);
@@ -5238,15 +5205,6 @@ 
             Set_Has_Controlled_Component (Typ);
          end if;
 
-         --  Non-self-referential anonymous access-to-controlled component
-
-         if Ekind (Comp_Typ) = E_Anonymous_Access_Type
-           and then Needs_Finalization (Designated_Type (Comp_Typ))
-           and then Designated_Type (Comp_Typ) /= Typ
-         then
-            Has_AACC := True;
-         end if;
-
          Next_Component (Comp);
       end loop;
 
@@ -5595,97 +5553,6 @@ 
          end;
       end if;
 
-      --  Create a heterogeneous finalization master to service the anonymous
-      --  access-to-controlled components of the record type.
-
-      if Has_AACC then
-         declare
-            Encl_Scope : constant Entity_Id  := Scope (Typ);
-            Ins_Node   : constant Node_Id    := Parent (Typ);
-            Loc        : constant Source_Ptr := Sloc (Typ);
-            Fin_Mas_Id : Entity_Id;
-
-            Attributes_Set : Boolean := False;
-            Master_Built   : Boolean := False;
-            --  Two flags which control the creation and initialization of a
-            --  common heterogeneous master.
-
-         begin
-            Comp := First_Component (Typ);
-            while Present (Comp) loop
-               Comp_Typ := Etype (Comp);
-
-               --  A non-self-referential anonymous access-to-controlled
-               --  component.
-
-               if Ekind (Comp_Typ) = E_Anonymous_Access_Type
-                 and then Needs_Finalization (Designated_Type (Comp_Typ))
-                 and then Designated_Type (Comp_Typ) /= Typ
-               then
-                  --  Build a homogeneous master for the first anonymous
-                  --  access-to-controlled component. This master may be
-                  --  converted into a heterogeneous collection if more
-                  --  components are to follow.
-
-                  if not Master_Built then
-                     Master_Built := True;
-
-                     --  All anonymous access-to-controlled types allocate
-                     --  on the global pool. Note that the finalization
-                     --  master and the associated storage pool must be set
-                     --  on the root type (both are "root type only").
-
-                     Set_Associated_Storage_Pool
-                       (Root_Type (Comp_Typ), RTE (RE_Global_Pool_Object));
-
-                     Build_Finalization_Master
-                       (Typ            => Root_Type (Comp_Typ),
-                        For_Anonymous  => True,
-                        Context_Scope  => Encl_Scope,
-                        Insertion_Node => Ins_Node);
-
-                     Fin_Mas_Id := Finalization_Master (Comp_Typ);
-
-                  --  Subsequent anonymous access-to-controlled components
-                  --  reuse the available master.
-
-                  else
-                     --  All anonymous access-to-controlled types allocate
-                     --  on the global pool. Note that both the finalization
-                     --  master and the associated storage pool must be set
-                     --  on the root type (both are "root type only").
-
-                     Set_Associated_Storage_Pool
-                       (Root_Type (Comp_Typ), RTE (RE_Global_Pool_Object));
-
-                     --  Shared the master among multiple components
-
-                     Set_Finalization_Master
-                       (Root_Type (Comp_Typ), Fin_Mas_Id);
-
-                     --  Convert the master into a heterogeneous collection.
-                     --  Generate:
-                     --    Set_Is_Heterogeneous (<Fin_Mas_Id>);
-
-                     if not Attributes_Set then
-                        Attributes_Set := True;
-
-                        Insert_Action (Ins_Node,
-                          Make_Procedure_Call_Statement (Loc,
-                            Name                   =>
-                              New_Occurrence_Of
-                                (RTE (RE_Set_Is_Heterogeneous), Loc),
-                            Parameter_Associations => New_List (
-                              New_Occurrence_Of (Fin_Mas_Id, Loc))));
-                     end if;
-                  end if;
-               end if;
-
-               Next_Component (Comp);
-            end loop;
-         end;
-      end if;
-
       --  Check whether individual components have a defined invariant, and add
       --  the corresponding component invariant checks.