Index: einfo.adb
===================================================================
--- einfo.adb	(revision 223546)
+++ einfo.adb	(working copy)
@@ -264,7 +264,8 @@
 
    --    Import_Pragma                   Node35
 
-   --    (unused)                        Node36
+   --    Anonymous_Master                Node36
+
    --    (unused)                        Node38
    --    (unused)                        Node39
    --    (unused)                        Node40
@@ -556,7 +557,6 @@
 
    --    Has_Implicit_Dereference        Flag251
    --    Is_Processed_Transient          Flag252
-   --    Has_Anonymous_Master            Flag253
    --    Is_Implementation_Defined       Flag254
    --    Is_Predicate_Function           Flag255
    --    Is_Predicate_Function_M         Flag256
@@ -594,6 +594,7 @@
    --    Has_Volatile_Full_Access        Flag285
    --    Needs_Typedef                   Flag286
 
+   --    (unused)                        Flag253
    --    (unused)                        Flag287
    --    (unused)                        Flag288
    --    (unused)                        Flag289
@@ -753,6 +754,12 @@
       return Uint14 (Id);
    end Alignment;
 
+   function Anonymous_Master (Id : E) return E is
+   begin
+      pragma Assert (Ekind_In (Id, E_Function, E_Package, E_Procedure));
+      return Node36 (Id);
+   end Anonymous_Master;
+
    function Associated_Entity (Id : E) return E is
    begin
       return Node37 (Id);
@@ -1375,13 +1382,6 @@
       return Flag79 (Id);
    end Has_All_Calls_Remote;
 
-   function Has_Anonymous_Master (Id : E) return B is
-   begin
-      pragma Assert
-        (Ekind_In (Id, E_Function, E_Package, E_Package_Body, E_Procedure));
-      return Flag253 (Id);
-   end Has_Anonymous_Master;
-
    function Has_Atomic_Components (Id : E) return B is
    begin
       return Flag86 (Implementation_Base_Type (Id));
@@ -3576,6 +3576,12 @@
       Set_Elist16 (Id, V);
    end Set_Access_Disp_Table;
 
+   procedure Set_Anonymous_Master (Id : E; V : E) is
+   begin
+      pragma Assert (Ekind_In (Id, E_Function, E_Package, E_Procedure));
+      Set_Node36 (Id, V);
+   end Set_Anonymous_Master;
+
    procedure Set_Associated_Entity (Id : E; V : E) is
    begin
       Set_Node37 (Id, V);
@@ -4246,13 +4252,6 @@
       Set_Flag79 (Id, V);
    end Set_Has_All_Calls_Remote;
 
-   procedure Set_Has_Anonymous_Master (Id : E; V : B := True) is
-   begin
-      pragma Assert
-        (Ekind_In (Id, E_Function, E_Package, E_Package_Body, E_Procedure));
-      Set_Flag253 (Id, V);
-   end Set_Has_Anonymous_Master;
-
    procedure Set_Has_Atomic_Components (Id : E; V : B := True) is
    begin
       pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
@@ -8634,7 +8633,6 @@
       W ("Has_Aliased_Components",          Flag135 (Id));
       W ("Has_Alignment_Clause",            Flag46  (Id));
       W ("Has_All_Calls_Remote",            Flag79  (Id));
-      W ("Has_Anonymous_Master",            Flag253 (Id));
       W ("Has_Atomic_Components",           Flag86  (Id));
       W ("Has_Biased_Representation",       Flag139 (Id));
       W ("Has_Completion",                  Flag26  (Id));
@@ -10121,6 +10119,12 @@
    procedure Write_Field36_Name (Id : Entity_Id) is
    begin
       case Ekind (Id) is
+         when E_Function                                   |
+              E_Operator                                   |
+              E_Package                                    |
+              E_Procedure                                  =>
+            Write_Str ("Anonymous_Master");
+
          when others                                       =>
             Write_Str ("Field36??");
       end case;
Index: einfo.ads
===================================================================
--- einfo.ads	(revision 223548)
+++ einfo.ads	(working copy)
@@ -436,6 +436,12 @@
 --       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 subprogram and package units.
+--       Contains the entity of a special heterogeneous finalization master
+--       that services most anonymous access-to-controlled allocations that
+--       occur within the unit.
+
 --    Associated_Entity (Node37)
 --       Defined in all entities. This field is similar to Associated_Node, but
 --       applied to entities. The attribute links an entity from the generic
@@ -1423,13 +1429,6 @@
 --       entities, so the flag Is_Remote_Call_Interface will always be set if
 --       this flag is set.
 
---    Has_Anonymous_Master (Flag253)
---       Defined in units (top-level functions and procedures, library-level
---       packages). Set if the associated unit contains a heterogeneous
---       finalization master. The master's name is of the form <unit>AM and it
---       services anonymous access-to-controlled types with an undetermined
---       lifetime.
-
 --    Has_Atomic_Components (Flag86) [implementation base type only]
 --       Defined in all types and objects. Set only for an array type or
 --       an array object if a valid pragma Atomic_Components applies to the
@@ -5833,6 +5832,7 @@
    --    Linker_Section_Pragma               (Node33)
    --    Contract                            (Node34)
    --    Import_Pragma                       (Node35)   (non-generic case only)
+   --    Anonymous_Master                    (Node36)   (non-generic case only)
    --    Body_Needed_For_SAL                 (Flag40)
    --    Contains_Ignored_Ghost_Code         (Flag279)
    --    Default_Expressions_Processed       (Flag108)
@@ -5840,7 +5840,6 @@
    --    Delay_Subprogram_Descriptors        (Flag50)
    --    Discard_Names                       (Flag88)
    --    Elaboration_Entity_Required         (Flag174)
-   --    Has_Anonymous_Master                (Flag253)
    --    Has_Completion                      (Flag26)
    --    Has_Controlling_Result              (Flag98)
    --    Has_Expanded_Contract               (Flag240)  (non-generic case only)
@@ -6050,6 +6049,7 @@
    --    SPARK_Pragma                        (Node32)
    --    SPARK_Aux_Pragma                    (Node33)
    --    Contract                            (Node34)
+   --    Anonymous_Master                    (Node36)   (non-generic case only)
    --    Delay_Subprogram_Descriptors        (Flag50)
    --    Body_Needed_For_SAL                 (Flag40)
    --    Contains_Ignored_Ghost_Code         (Flag279)
@@ -6058,7 +6058,6 @@
    --    Elaborate_Body_Desirable            (Flag210)  (non-generic case only)
    --    From_Limited_With                   (Flag159)
    --    Has_All_Calls_Remote                (Flag79)
-   --    Has_Anonymous_Master                (Flag253)
    --    Has_Completion                      (Flag26)
    --    Has_Forward_Instantiation           (Flag175)
    --    Has_Master_Entity                   (Flag21)
@@ -6089,7 +6088,6 @@
    --    Contract                            (Node34)
    --    Contains_Ignored_Ghost_Code         (Flag279)
    --    Delay_Subprogram_Descriptors        (Flag50)
-   --    Has_Anonymous_Master                (Flag253)
    --    SPARK_Aux_Pragma_Inherited          (Flag266)
    --    SPARK_Pragma_Inherited              (Flag265)
    --    Scope_Depth                         (synth)
@@ -6139,6 +6137,7 @@
    --    Linker_Section_Pragma               (Node33)
    --    Contract                            (Node34)
    --    Import_Pragma                       (Node35)   (non-generic case only)
+   --    Anonymous_Master                    (Node36)   (non-generic case only)
    --    Body_Needed_For_SAL                 (Flag40)
    --    Contains_Ignored_Ghost_Code         (Flag279)
    --    Delay_Cleanups                      (Flag114)
@@ -6148,7 +6147,6 @@
    --    Delay_Cleanups                      (Flag114)
    --    Delay_Subprogram_Descriptors        (Flag50)
    --    Discard_Names                       (Flag88)
-   --    Has_Anonymous_Master                (Flag253)
    --    Has_Completion                      (Flag26)
    --    Has_Expanded_Contract               (Flag240)  (non-generic case only)
    --    Has_Invariants                      (Flag232)
@@ -6647,6 +6645,7 @@
    function Address_Taken                       (Id : E) return B;
    function Alias                               (Id : E) return E;
    function Alignment                           (Id : E) return U;
+   function Anonymous_Master                    (Id : E) return E;
    function Associated_Entity                   (Id : E) return E;
    function Associated_Formal_Package           (Id : E) return E;
    function Associated_Node_For_Itype           (Id : E) return N;
@@ -6750,7 +6749,6 @@
    function Has_Aliased_Components              (Id : E) return B;
    function Has_Alignment_Clause                (Id : E) return B;
    function Has_All_Calls_Remote                (Id : E) return B;
-   function Has_Anonymous_Master                (Id : E) return B;
    function Has_Atomic_Components               (Id : E) return B;
    function Has_Biased_Representation           (Id : E) return B;
    function Has_Completion                      (Id : E) return B;
@@ -7301,6 +7299,7 @@
    procedure Set_Address_Taken                   (Id : E; V : B := True);
    procedure Set_Alias                           (Id : E; V : E);
    procedure Set_Alignment                       (Id : E; V : U);
+   procedure Set_Anonymous_Master                (Id : E; V : E);
    procedure Set_Associated_Entity               (Id : E; V : E);
    procedure Set_Associated_Formal_Package       (Id : E; V : E);
    procedure Set_Associated_Node_For_Itype       (Id : E; V : N);
@@ -7403,7 +7402,6 @@
    procedure Set_Has_Aliased_Components          (Id : E; V : B := True);
    procedure Set_Has_Alignment_Clause            (Id : E; V : B := True);
    procedure Set_Has_All_Calls_Remote            (Id : E; V : B := True);
-   procedure Set_Has_Anonymous_Master            (Id : E; V : B := True);
    procedure Set_Has_Atomic_Components           (Id : E; V : B := True);
    procedure Set_Has_Biased_Representation       (Id : E; V : B := True);
    procedure Set_Has_Completion                  (Id : E; V : B := True);
@@ -8076,6 +8074,7 @@
    pragma Inline (Address_Taken);
    pragma Inline (Alias);
    pragma Inline (Alignment);
+   pragma Inline (Anonymous_Master);
    pragma Inline (Associated_Entity);
    pragma Inline (Associated_Formal_Package);
    pragma Inline (Associated_Node_For_Itype);
@@ -8176,7 +8175,6 @@
    pragma Inline (Has_Aliased_Components);
    pragma Inline (Has_Alignment_Clause);
    pragma Inline (Has_All_Calls_Remote);
-   pragma Inline (Has_Anonymous_Master);
    pragma Inline (Has_Atomic_Components);
    pragma Inline (Has_Biased_Representation);
    pragma Inline (Has_Completion);
@@ -8577,6 +8575,7 @@
    pragma Inline (Set_Address_Taken);
    pragma Inline (Set_Alias);
    pragma Inline (Set_Alignment);
+   pragma Inline (Set_Anonymous_Master);
    pragma Inline (Set_Associated_Entity);
    pragma Inline (Set_Associated_Formal_Package);
    pragma Inline (Set_Associated_Node_For_Itype);
@@ -8675,7 +8674,6 @@
    pragma Inline (Set_Has_Aliased_Components);
    pragma Inline (Set_Has_Alignment_Clause);
    pragma Inline (Set_Has_All_Calls_Remote);
-   pragma Inline (Set_Has_Anonymous_Master);
    pragma Inline (Set_Has_Atomic_Components);
    pragma Inline (Set_Has_Biased_Representation);
    pragma Inline (Set_Has_Completion);
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 223540)
+++ exp_ch4.adb	(working copy)
@@ -415,174 +415,164 @@
    ------------------------------
 
    function Current_Anonymous_Master return Entity_Id is
-      Decls     : List_Id;
-      Loc       : Source_Ptr;
-      Subp_Body : Node_Id;
-      Unit_Decl : Node_Id;
-      Unit_Id   : Entity_Id;
+      function Create_Anonymous_Master
+        (Unit_Id : Entity_Id;
+         Decls   : List_Id) return Entity_Id;
+      --  Create a new anonymous finalization master for a unit denoted by
+      --  Unit_Id. The declaration of the master along with any specialized
+      --  initialization is inserted at the top of declarative list Decls.
+      --  Return the entity of the anonymous master.
 
-   begin
-      Unit_Id := Cunit_Entity (Current_Sem_Unit);
+      -----------------------------
+      -- Create_Anonymous_Master --
+      -----------------------------
 
-      --  Find the entity of the current unit
+      function Create_Anonymous_Master
+        (Unit_Id : Entity_Id;
+         Decls   : List_Id) return Entity_Id
+      is
+         First_Decl : Node_Id := Empty;
+         --  The first declaration of list Decls. This variable is used when
+         --  inserting various actions.
 
-      if Ekind (Unit_Id) = E_Subprogram_Body then
+         procedure Insert_And_Analyze (Action : Node_Id);
+         --  Insert arbitrary node Action in declarative list Decl and analyze
+         --  it.
 
-         --  When processing subprogram bodies, the proper scope is always that
-         --  of the spec.
+         ------------------------
+         -- Insert_And_Analyze --
+         ------------------------
 
-         Subp_Body := Unit_Id;
-         while Present (Subp_Body)
-           and then Nkind (Subp_Body) /= N_Subprogram_Body
-         loop
-            Subp_Body := Parent (Subp_Body);
-         end loop;
+         procedure Insert_And_Analyze (Action : Node_Id) is
+         begin
+            --  The list is already populated, the actions are inserted at the
+            --  top of the list, preserving their order.
 
-         Unit_Id := Corresponding_Spec (Subp_Body);
-      end if;
+            if Present (First_Decl) then
+               Insert_Before_And_Analyze (First_Decl, Action);
 
-      Loc := Sloc (Unit_Id);
-      Unit_Decl := Unit (Cunit (Current_Sem_Unit));
+            --  Otherwise append to the declarations to preserve order
 
-      --  Find the declarations list of the current unit
+            else
+               Append_To (Decls, Action);
+               Analyze (Action);
+            end if;
+         end Insert_And_Analyze;
 
-      if Nkind (Unit_Decl) = N_Package_Declaration then
-         Unit_Decl := Specification (Unit_Decl);
-         Decls := Visible_Declarations (Unit_Decl);
+         --  Local variables
 
-         if No (Decls) then
-            Decls := New_List (Make_Null_Statement (Loc));
-            Set_Visible_Declarations (Unit_Decl, Decls);
+         Loc   : constant Source_Ptr := Sloc (Unit_Id);
+         FM_Id : Entity_Id;
 
-         elsif Is_Empty_List (Decls) then
-            Append_To (Decls, Make_Null_Statement (Loc));
-         end if;
+      --  Start of processing for Create_Anonymous_Master
 
-      else
-         Decls := Declarations (Unit_Decl);
-
-         if No (Decls) then
-            Decls := New_List (Make_Null_Statement (Loc));
-            Set_Declarations (Unit_Decl, Decls);
-
-         elsif Is_Empty_List (Decls) then
-            Append_To (Decls, Make_Null_Statement (Loc));
+      begin
+         if Present (Decls) then
+            First_Decl := First (Decls);
          end if;
-      end if;
 
-      --  The current unit has an existing anonymous master, traverse its
-      --  declarations and locate the entity.
+         --  Since the anonymous master and all its initialization actions are
+         --  inserted at top level, use the scope of the unit when analyzing.
 
-      if Has_Anonymous_Master (Unit_Id) then
-         declare
-            Decl       : Node_Id;
-            Fin_Mas_Id : Entity_Id;
+         Push_Scope (Unit_Id);
 
-         begin
-            Decl := First (Decls);
-            while Present (Decl) loop
+         --  Create the anonymous master
 
-               --  Look for the first variable in the declarations whole type
-               --  is Finalization_Master.
+         FM_Id :=
+           Make_Defining_Identifier (Loc,
+             Chars => New_External_Name (Chars (Unit_Id), "AM"));
+         Set_Anonymous_Master (Unit_Id, FM_Id);
 
-               if Nkind (Decl) = N_Object_Declaration then
-                  Fin_Mas_Id := Defining_Identifier (Decl);
+         --  Generate:
+         --    <FM_Id> : Finalization_Master;
 
-                  if Ekind (Fin_Mas_Id) = E_Variable
-                    and then Etype (Fin_Mas_Id) = RTE (RE_Finalization_Master)
-                  then
-                     return Fin_Mas_Id;
-                  end if;
-               end if;
+         Insert_And_Analyze
+           (Make_Object_Declaration (Loc,
+             Defining_Identifier => FM_Id,
+             Object_Definition   =>
+               New_Occurrence_Of (RTE (RE_Finalization_Master), Loc)));
 
-               Next (Decl);
-            end loop;
+         --  Do not set the base pool and mode of operation on .NET/JVM since
+         --  those targets do not support pools and all VM masters defaulted to
+         --  heterogeneous.
 
-            --  The master was not found even though the unit was labeled as
-            --  having one.
+         if VM_Target = No_VM then
 
-            raise Program_Error;
-         end;
+            --  Generate:
+            --    Set_Base_Pool
+            --      (<FM_Id>, Global_Pool_Object'Unrestricted_Access);
 
-      --  Create a new anonymous master
+            Insert_And_Analyze
+              (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))));
 
-      else
-         declare
-            First_Decl : constant Node_Id := First (Decls);
-            Action     : Node_Id;
-            Fin_Mas_Id : Entity_Id;
-
-         begin
-            --  Since the master and its associated initialization is inserted
-            --  at top level, use the scope of the unit when analyzing.
-
-            Push_Scope (Unit_Id);
-
-            --  Create the finalization master
-
-            Fin_Mas_Id :=
-              Make_Defining_Identifier (Loc,
-                Chars => New_External_Name (Chars (Unit_Id), "AM"));
-
             --  Generate:
-            --    <Fin_Mas_Id> : Finalization_Master;
+            --    Set_Is_Heterogeneous (<FM_Id>);
 
-            Action :=
-              Make_Object_Declaration (Loc,
-                Defining_Identifier => Fin_Mas_Id,
-                Object_Definition =>
-                  New_Occurrence_Of (RTE (RE_Finalization_Master), Loc));
+            Insert_And_Analyze
+              (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))));
+         end if;
 
-            Insert_Before_And_Analyze (First_Decl, Action);
+         Pop_Scope;
 
-            --  Mark the unit to prevent the generation of multiple masters
+         return FM_Id;
+      end Create_Anonymous_Master;
 
-            Set_Has_Anonymous_Master (Unit_Id);
+      --  Local declarations
 
-            --  Do not set the base pool and mode of operation on .NET/JVM
-            --  since those targets do not support pools and all VM masters
-            --  are heterogeneous by default.
+      Unit_Decl : constant Node_Id   := Unit (Cunit (Current_Sem_Unit));
+      Unit_Id   : constant Entity_Id := Corresponding_Spec_Of (Unit_Decl);
+      Decls     : List_Id;
+      FM_Id     : Entity_Id;
+      Unit_Spec : Node_Id;
 
-            if VM_Target = No_VM then
+   --  Start of processing for Current_Anonymous_Master
 
-               --  Generate:
-               --    Set_Base_Pool
-               --      (<Fin_Mas_Id>, Global_Pool_Object'Unrestricted_Access);
+   begin
+      FM_Id := Anonymous_Master (Unit_Id);
 
-               Action :=
-                 Make_Procedure_Call_Statement (Loc,
-                   Name =>
-                     New_Occurrence_Of (RTE (RE_Set_Base_Pool), Loc),
+      --  Create a new anonymous master when allocating an object of anonymous
+      --  access-to-controlled type for the first time.
 
-                   Parameter_Associations => New_List (
-                     New_Occurrence_Of (Fin_Mas_Id, Loc),
-                     Make_Attribute_Reference (Loc,
-                       Prefix =>
-                         New_Occurrence_Of (RTE (RE_Global_Pool_Object), Loc),
-                       Attribute_Name => Name_Unrestricted_Access)));
+      if No (FM_Id) then
 
-               Insert_Before_And_Analyze (First_Decl, Action);
+         --  Find the declarative list of the current unit
 
-               --  Generate:
-               --    Set_Is_Heterogeneous (<Fin_Mas_Id>);
+         if Nkind (Unit_Decl) = N_Package_Declaration then
+            Unit_Spec := Specification (Unit_Decl);
+            Decls := Visible_Declarations (Unit_Spec);
 
-               Action :=
-                 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)));
-
-               Insert_Before_And_Analyze (First_Decl, Action);
+            if No (Decls) then
+               Decls := New_List;
+               Set_Visible_Declarations (Unit_Spec, Decls);
             end if;
 
-            --  Restore the original state of the scope stack
+         --  Package or subprogram body
 
-            Pop_Scope;
+         else
+            Decls := Declarations (Unit_Decl);
 
-            return Fin_Mas_Id;
-         end;
+            if No (Decls) then
+               Decls := New_List;
+               Set_Declarations (Unit_Decl, Decls);
+            end if;
+         end if;
+
+         FM_Id := Create_Anonymous_Master (Unit_Id, Decls);
       end if;
+
+      return FM_Id;
    end Current_Anonymous_Master;
 
    --------------------------------
