2015-03-02 Robert Dewar <dewar@adacore.com>

	* atree.ads, atree.adb (Uint24): New function
	(Set_Uint24): New procedure.
	* atree.h (Uint24): New macro for field access.
	* back_end.adb (Call_Back_End): For now, don't call back end
	if unnesting subprogs.
	* einfo.adb (Activation_Record_Component): New field
	(Subps_Index): New field.
	* einfo.ads (Activation_Record_Component): New field
	(Subps_Index): New field Minor reordering of comments into alpha order.
	* exp_unst.ads, exp_unst.adb: Continued development.

2015-03-02  Gary Dismukes  <dismukes@adacore.com>

	* exp_disp.ads: Minor reformatting.

2015-03-02  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Chain_Use_Clause): Do not chain use clause from
	ancestor to list of use clauses active in descendant unit if we
	are within the private part of an intervening parent, to prevent
	circularities in use clause list.



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

11 files changed, 633 insertions, 170 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d05d5c41a9a..d96dd9b83b9 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,27 @@
+2015-03-02  Robert Dewar  <dewar@adacore.com>
+
+	* atree.ads, atree.adb (Uint24): New function
+	(Set_Uint24): New procedure.
+	* atree.h (Uint24): New macro for field access.
+	* back_end.adb (Call_Back_End): For now, don't call back end
+	if unnesting subprogs.
+	* einfo.adb (Activation_Record_Component): New field
+	(Subps_Index): New field.
+	* einfo.ads (Activation_Record_Component): New field
+	(Subps_Index): New field Minor reordering of comments into alpha order.
+	* exp_unst.ads, exp_unst.adb: Continued development.
+
+2015-03-02  Gary Dismukes  <dismukes@adacore.com>
+
+	* exp_disp.ads: Minor reformatting.
+
+2015-03-02  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch8.adb (Chain_Use_Clause): Do not chain use clause from
+	ancestor to list of use clauses active in descendant unit if we
+	are within the private part of an intervening parent, to prevent
+	circularities in use clause list.
+
 2015-03-02  Javier Miranda  <miranda@adacore.com>
 
 	* exp_ch9.adb (Build_Corresponding_Record): Propagate type
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 3264ac37867..036aee3b51a 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -3181,6 +3181,17 @@ package body Atree is
          end if;
       end Uint22;
 
+      function Uint24 (N : Node_Id) return Uint is
+         pragma Assert (Nkind (N) in N_Entity);
+         U : constant Union_Id := Nodes.Table (N + 4).Field6;
+      begin
+         if U = 0 then
+            return Uint_0;
+         else
+            return From_Union (U);
+         end if;
+      end Uint24;
+
       function Ureal3 (N : Node_Id) return Ureal is
       begin
          pragma Assert (N <= Nodes.Last);
@@ -5786,6 +5797,12 @@ package body Atree is
          Nodes.Table (N + 3).Field9 := To_Union (Val);
       end Set_Uint22;
 
+      procedure Set_Uint24 (N : Node_Id; Val : Uint) is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         Nodes.Table (N + 4).Field6 := To_Union (Val);
+      end Set_Uint24;
+
       procedure Set_Ureal3 (N : Node_Id; Val : Ureal) is
       begin
          pragma Assert (N <= Nodes.Last);
diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index 7d2e64f4f88..1be32662c25 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -1424,6 +1424,9 @@ package Atree is
       function Uint22 (N : Node_Id) return Uint;
       pragma Inline (Uint22);
 
+      function Uint24 (N : Node_Id) return Uint;
+      pragma Inline (Uint24);
+
       function Ureal3 (N : Node_Id) return Ureal;
       pragma Inline (Ureal3);
 
@@ -2731,6 +2734,9 @@ package Atree is
       procedure Set_Uint22 (N : Node_Id; Val : Uint);
       pragma Inline (Set_Uint22);
 
+      procedure Set_Uint24 (N : Node_Id; Val : Uint);
+      pragma Inline (Set_Uint24);
+
       procedure Set_Ureal3 (N : Node_Id; Val : Ureal);
       pragma Inline (Set_Ureal3);
 
diff --git a/gcc/ada/atree.h b/gcc/ada/atree.h
index 7d603ba425d..170bd959a64 100644
--- a/gcc/ada/atree.h
+++ b/gcc/ada/atree.h
@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          Copyright (C) 1992-2013, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2015, 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- *
@@ -535,6 +535,7 @@ extern Node_Id Current_Error_Node;
 #define Uint16(N)     ((Field16 (N) == 0) ? Uint_0 : Field16 (N))
 #define Uint17(N)     ((Field17 (N) == 0) ? Uint_0 : Field17 (N))
 #define Uint22(N)     ((Field22 (N) == 0) ? Uint_0 : Field22 (N))
+#define Uint24(N)     ((Field24 (N) == 0) ? Uint_0 : Field24 (N))
 
 #define Ureal3(N)     Field3  (N)
 #define Ureal18(N)    Field18 (N)
diff --git a/gcc/ada/back_end.adb b/gcc/ada/back_end.adb
index 7768687b269..e7176d25d55 100644
--- a/gcc/ada/back_end.adb
+++ b/gcc/ada/back_end.adb
@@ -118,6 +118,12 @@ package body Back_End is
          return;
       end if;
 
+      --  Skip call if unnesting subprograms (temp for now ???)
+
+      if Opt.Unnest_Subprogram_Mode then
+         return;
+      end if;
+
       --  The back end needs to know the maximum line number that can appear
       --  in a Sloc, in other words the maximum logical line number.
 
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index c3067b825b0..9ad146c37ab 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -214,6 +214,7 @@ package body Einfo is
 
    --    Related_Expression              Node24
    --    Uplevel_References              Elist24
+   --    Subps_Index                     Uint24
 
    --    Interface_Alias                 Node25
    --    Interfaces                      Elist25
@@ -251,6 +252,7 @@ package body Einfo is
 
    --    Derived_Type_Link               Node31
    --    Thunk_Entity                    Node31
+   --    Activation_Record_Component     Node31
 
    --    SPARK_Pragma                    Node32
    --    No_Tagged_Streams_Pragma        Node32
@@ -689,6 +691,17 @@ package body Einfo is
       return Elist16 (Implementation_Base_Type (Id));
    end Access_Disp_Table;
 
+   function Activation_Record_Component (Id : E) return E is
+   begin
+      pragma Assert (Ekind_In (Id, E_Constant,
+                                   E_In_Parameter,
+                                   E_In_Out_Parameter,
+                                   E_Loop_Parameter,
+                                   E_Out_Parameter,
+                                   E_Variable));
+      return Node31 (Id);
+   end Activation_Record_Component;
+
    function Actual_Subtype (Id : E) return E is
    begin
       pragma Assert
@@ -3139,6 +3152,12 @@ package body Einfo is
       return Node29 (Id);
    end Subprograms_For_Type;
 
+   function Subps_Index (Id : E) return U is
+   begin
+      pragma Assert (Is_Subprogram (Id));
+      return Uint24 (Id);
+   end Subps_Index;
+
    function Suppress_Elaboration_Warnings (Id : E) return B is
    begin
       return Flag148 (Id);
@@ -3533,6 +3552,17 @@ package body Einfo is
       Set_Node22 (Id, V);
    end Set_Associated_Storage_Pool;
 
+   procedure Set_Activation_Record_Component (Id : E; V : E) is
+   begin
+      pragma Assert (Ekind_In (Id, E_Constant,
+                                   E_In_Parameter,
+                                   E_In_Out_Parameter,
+                                   E_Loop_Parameter,
+                                   E_Out_Parameter,
+                                   E_Variable));
+      Set_Node31 (Id, V);
+   end Set_Activation_Record_Component;
+
    procedure Set_Actual_Subtype (Id : E; V : E) is
    begin
       pragma Assert
@@ -6091,6 +6121,12 @@ package body Einfo is
       Set_Node29 (Id, V);
    end Set_Subprograms_For_Type;
 
+   procedure Set_Subps_Index (Id : E; V : U) is
+   begin
+      pragma Assert (Is_Subprogram (Id));
+      Set_Uint24 (Id, V);
+   end Set_Subps_Index;
+
    procedure Set_Suppress_Elaboration_Warnings (Id : E; V : B := True) is
    begin
       Set_Flag148 (Id, V);
@@ -9689,7 +9725,11 @@ package body Einfo is
          when E_Function                                   |
               E_Operator                                   |
               E_Procedure                                  =>
-            Write_Str ("Uplevel_References");
+            if Field24 (Id) in Uint_Range then
+               Write_Str ("Subps_Index");
+            else
+               Write_Str ("Uplevel_References");
+            end if;
 
          when others                                       =>
             Write_Str ("Field24???");
@@ -9899,6 +9939,14 @@ package body Einfo is
          when Type_Kind                                    =>
             Write_Str ("Derived_Type_Link");
 
+         when E_Constant                                   |
+              E_In_Parameter                               |
+              E_In_Out_Parameter                           |
+              E_Loop_Parameter                             |
+              E_Out_Parameter                              |
+              E_Variable                                   =>
+            Write_Str ("Activation_Record_Component");
+
          when others                                       =>
             Write_Str ("Field31??");
       end case;
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 316b6ad0e4e..5ac7f3268d1 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -353,6 +353,13 @@ package Einfo is
 --       used to expand dispatching calls through the primary dispatch table.
 --       For an untagged record, contains No_Elist.
 
+--    Activation_Record_Component (Node31)
+--       Defined in E_Variable, E_Constant, E_Loop_Parameter, E_In_Parameter,
+--       E_Out_Parameter, E_In_Out_Parameter nodes. Used only if we are in
+--       Opt.Unnest_Subprogram_Mode, in which case for the case of an uplevel
+--       referenced entity, this field contains the entity for the component
+--       in the generated ARECnT activation record (Exp_Unst for details).
+
 --    Actual_Subtype (Node17)
 --       Defined in variables, constants, and formal parameters. This is the
 --       subtype imposed by the value of the object, as opposed to its nominal
@@ -1163,24 +1170,6 @@ package Einfo is
 --       Note one obscure case: for pragma Default_Storage_Pool (null), the
 --       Etype of the N_Null node is Empty.
 
---    Extra_Formal (Node15)
---       Defined in formal parameters in the non-generic case. Certain
---       parameters require extra implicit information to be passed (e.g. the
---       flag indicating if an unconstrained variant record argument is
---       constrained, and the accessibility level for access parameters. See
---       description of Extra_Constrained, Extra_Accessibility fields for
---       further details. Extra formal parameters are constructed to represent
---       these values, and chained to the end of the list of formals using the
---       Extra_Formal field (i.e. the Extra_Formal field of the last "real"
---       formal points to the first extra formal, and the Extra_Formal field of
---       each extra formal points to the next one, with Empty indicating the
---       end of the list of extra formals.
-
---    Extra_Formals (Node28)
---       Applies to subprograms and subprogram types, and also in entries
---       and entry families. Returns first extra formal of the subprogram
---       or entry. Returns Empty if there are no extra formals.
-
 --    Extra_Accessibility (Node13)
 --       Defined in formal parameters in the non-generic case. Normally Empty,
 --       but if expansion is active, and a parameter is one for which a
@@ -1214,6 +1203,24 @@ package Einfo is
 --       must be retrieved through the entity designed by this field instead of
 --       being computed.
 
+--    Extra_Formal (Node15)
+--       Defined in formal parameters in the non-generic case. Certain
+--       parameters require extra implicit information to be passed (e.g. the
+--       flag indicating if an unconstrained variant record argument is
+--       constrained, and the accessibility level for access parameters). See
+--       description of Extra_Constrained, Extra_Accessibility fields for
+--       further details. Extra formal parameters are constructed to represent
+--       these values, and chained to the end of the list of formals using the
+--       Extra_Formal field (i.e. the Extra_Formal field of the last "real"
+--       formal points to the first extra formal, and the Extra_Formal field of
+--       each extra formal points to the next one, with Empty indicating the
+--       end of the list of extra formals).
+
+--    Extra_Formals (Node28)
+--       Applies to subprograms and subprogram types, and also in entries
+--       and entry families. Returns first extra formal of the subprogram
+--       or entry. Returns Empty if there are no extra formals.
+
 --    Finalization_Master (Node23) [root type only]
 --       Defined in access-to-controlled or access-to-class-wide types. The
 --       field contains the entity of the finalization master which handles
@@ -1261,7 +1268,7 @@ package Einfo is
 --       N_Exit_Statement node with Empty marking the end of the list.
 
 --    First_Formal (synthesized)
---       Applies to subprograms and subprogram types, and also in entries
+--       Applies to subprograms and subprogram types, and also to entries
 --       and entry families. Returns first formal of the subprogram or entry.
 --       The formals are the first entities declared in a subprogram or in
 --       a subprogram type (the designated type of an Access_To_Subprogram
@@ -4121,6 +4128,12 @@ package Einfo is
 --       for Predicate_Function, and clients will always use the latter two
 --       names to access entries in this list.
 
+--    Subps_Index (Uint24)
+--       Used during Exp_Inst.Unnest_Subprogram to hold the index in the Subps
+--       table for a subprogram. See processing in this procedure for details.
+--       Note that this overlaps Uplevel_References, it is only set after the
+--       latter field has been acquired.
+
 --    Suppress_Elaboration_Warnings (Flag148)
 --       Defined in all entities, can be set only for subprogram entities and
 --       for variables. If this flag is set then Sem_Elab will not generate
@@ -4263,7 +4276,9 @@ package Einfo is
 --       Defined in subprogram entities. Set only if Has_Uplevel_Reference is
 --       set and if we are Unnest_Subprogram_Mode, otherwise undefined. Points
 --       to a list of explicit uplevel references to entities declared in
---       the subprogram which need rewriting. See spec of Exp_Unst for details.
+--       the subprogram which need rewriting. Each entry uses two elements of
+--       the list, the first is the node that is the actual reference, the
+--       second is the entity of the enclosing subprogram for the reference.
 
 --    Used_As_Generic_Actual (Flag222)
 --       Defined in all entities, set if the entity is used as an argument to
@@ -5578,6 +5593,7 @@ package Einfo is
    --    Initialization_Statements           (Node28)
    --    BIP_Initialization_Call             (Node29)
    --    Last_Aggregate_Assignment           (Node30)
+   --    Activation_Record_Component         (Node31)
    --    Linker_Section_Pragma               (Node33)
    --    Has_Alignment_Clause                (Flag46)
    --    Has_Atomic_Components               (Flag86)
@@ -5755,6 +5771,7 @@ package Einfo is
    --    Inner_Instances                     (Elist23)  (generic case only)
    --    Protection_Object                   (Node23)   (for concurrent kind)
    --    Uplevel_References                  (Elist24)  (non-generic case only)
+   --    Subps_Index                         (Uint24)   (non-generic case only)
    --    Interface_Alias                     (Node25)
    --    Overridden_Operation                (Node26)
    --    Wrapped_Entity                      (Node27)   (non-generic case only)
@@ -5868,6 +5885,7 @@ package Einfo is
    --    Protected_Formal                    (Node22)
    --    Extra_Constrained                   (Node23)
    --    Last_Assignment                     (Node26)   (OUT, IN-OUT only)
+   --    Activation_Record_Component         (Node31)
    --    Has_Initial_Value                   (Flag219)
    --    Is_Controlling_Formal               (Flag97)
    --    Is_Only_Out_Parameter               (Flag226)
@@ -5926,6 +5944,7 @@ package Einfo is
    --    Last_Entity                         (Node20)
    --    Has_Nested_Subprogram               (Flag282)
    --    Uplevel_References                  (Elist24)
+   --    Subps_Index                         (Uint24)
    --    Overridden_Operation                (Node26)
    --    Subprograms_For_Type                (Node29)
    --    Linker_Section_Pragma               (Node33)
@@ -6058,6 +6077,7 @@ package Einfo is
    --    Inner_Instances                     (Elist23)  (generic case only)
    --    Protection_Object                   (Node23)   (for concurrent kind)
    --    Uplevel_References                  (Elist24)  (non-generic case only)
+   --    Subps_Index                         (Uint24)   (non-generic case only)
    --    Interface_Alias                     (Node25)
    --    Overridden_Operation                (Node26)   (never for init proc)
    --    Wrapped_Entity                      (Node27)   (non-generic case only)
@@ -6303,6 +6323,7 @@ package Einfo is
    --    Initialization_Statements           (Node28)
    --    BIP_Initialization_Call             (Node29)
    --    Last_Aggregate_Assignment           (Node30)
+   --    Activation_Record_Component         (Node31)
    --    Linker_Section_Pragma               (Node33)
    --    Contract                            (Node34)
    --    Has_Alignment_Clause                (Flag46)
@@ -6568,6 +6589,7 @@ package Einfo is
    function Abstract_States                     (Id : E) return L;
    function Accept_Address                      (Id : E) return L;
    function Access_Disp_Table                   (Id : E) return L;
+   function Activation_Record_Component         (Id : E) return E;
    function Actual_Subtype                      (Id : E) return E;
    function Address_Taken                       (Id : E) return B;
    function Alias                               (Id : E) return E;
@@ -6987,6 +7009,7 @@ package Einfo is
    function String_Literal_Length               (Id : E) return U;
    function String_Literal_Low_Bound            (Id : E) return N;
    function Subprograms_For_Type                (Id : E) return E;
+   function Subps_Index                         (Id : E) return U;
    function Suppress_Elaboration_Warnings       (Id : E) return B;
    function Suppress_Initialization             (Id : E) return B;
    function Suppress_Style_Checks               (Id : E) return B;
@@ -7216,6 +7239,7 @@ package Einfo is
    procedure Set_Abstract_States                 (Id : E; V : L);
    procedure Set_Accept_Address                  (Id : E; V : L);
    procedure Set_Access_Disp_Table               (Id : E; V : L);
+   procedure Set_Activation_Record_Component     (Id : E; V : E);
    procedure Set_Actual_Subtype                  (Id : E; V : E);
    procedure Set_Address_Taken                   (Id : E; V : B := True);
    procedure Set_Alias                           (Id : E; V : E);
@@ -7639,6 +7663,7 @@ package Einfo is
    procedure Set_String_Literal_Length           (Id : E; V : U);
    procedure Set_String_Literal_Low_Bound        (Id : E; V : N);
    procedure Set_Subprograms_For_Type            (Id : E; V : E);
+   procedure Set_Subps_Index                     (Id : E; V : U);
    procedure Set_Suppress_Elaboration_Warnings   (Id : E; V : B := True);
    procedure Set_Suppress_Initialization         (Id : E; V : B := True);
    procedure Set_Suppress_Style_Checks           (Id : E; V : B := True);
@@ -7980,6 +8005,7 @@ package Einfo is
    pragma Inline (Abstract_States);
    pragma Inline (Accept_Address);
    pragma Inline (Access_Disp_Table);
+   pragma Inline (Activation_Record_Component);
    pragma Inline (Actual_Subtype);
    pragma Inline (Address_Taken);
    pragma Inline (Alias);
@@ -8443,6 +8469,7 @@ package Einfo is
    pragma Inline (String_Literal_Length);
    pragma Inline (String_Literal_Low_Bound);
    pragma Inline (Subprograms_For_Type);
+   pragma Inline (Subps_Index);
    pragma Inline (Suppress_Elaboration_Warnings);
    pragma Inline (Suppress_Initialization);
    pragma Inline (Suppress_Style_Checks);
@@ -8476,6 +8503,7 @@ package Einfo is
    pragma Inline (Set_Abstract_States);
    pragma Inline (Set_Accept_Address);
    pragma Inline (Set_Access_Disp_Table);
+   pragma Inline (Set_Activation_Record_Component);
    pragma Inline (Set_Actual_Subtype);
    pragma Inline (Set_Address_Taken);
    pragma Inline (Set_Alias);
@@ -8894,6 +8922,7 @@ package Einfo is
    pragma Inline (Set_String_Literal_Length);
    pragma Inline (Set_String_Literal_Low_Bound);
    pragma Inline (Set_Subprograms_For_Type);
+   pragma Inline (Set_Subps_Index);
    pragma Inline (Set_Suppress_Elaboration_Warnings);
    pragma Inline (Set_Suppress_Initialization);
    pragma Inline (Set_Suppress_Style_Checks);
diff --git a/gcc/ada/exp_disp.ads b/gcc/ada/exp_disp.ads
index 9a364660b33..a1cc11068eb 100644
--- a/gcc/ada/exp_disp.ads
+++ b/gcc/ada/exp_disp.ads
@@ -386,7 +386,7 @@ package Exp_Disp is
 
    procedure Set_DTC_Entity_Value (Tagged_Type : Entity_Id; Prim : Entity_Id);
    --  Set the definite value of the DTC_Entity value associated with a given
-   --  primitive of a tagged type. For subprogram wrappers propagat the value
+   --  primitive of a tagged type. For subprogram wrappers, propagate the value
    --  to the wrapped subprogram.
 
    procedure Write_DT (Typ : Entity_Id);
diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb
index fd15cc18926..f5022b95929 100755
--- a/gcc/ada/exp_unst.adb
+++ b/gcc/ada/exp_unst.adb
@@ -26,6 +26,7 @@
 with Atree;    use Atree;
 with Einfo;    use Einfo;
 with Elists;   use Elists;
+with Exp_Util; use Exp_Util;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
@@ -36,9 +37,84 @@ with Sinfo;    use Sinfo;
 with Snames;   use Snames;
 with Table;
 with Tbuild;   use Tbuild;
+with Uintp;    use Uintp;
 
 package body Exp_Unst is
 
+   --  Tables used by Unnest_Subprogram
+
+   type Subp_Entry is record
+      Ent : Entity_Id;
+      --  Entity of the subprogram
+
+      Bod : Node_Id;
+      --  Subprogram_Body node for this subprogram
+
+      Lev : Nat;
+      --  Subprogram level (1 = outer subprogram (Subp argument), 2 = nested
+      --  immediately within this outer subprogram etc.)
+
+      Urefs : Elist_Id;
+      --  This is a copy of the Uplevel_References field from the entity for
+      --  the subprogram. Copy this to reuse the field for Subps_Index.
+
+      ARECnF : Entity_Id;
+      --  This entity is defined for all subprograms with uplevel references
+      --  except for the top-level subprogram (Subp itself). It is the entity
+      --  for the formal which is added to the parameter list to pass the
+      --  pointer to the activation record. Note that for this entity, n is
+      --  one less than the current level.
+
+      ARECn   : Entity_Id;
+      ARECnT  : Entity_Id;
+      ARECnPT : Entity_Id;
+      ARECnP  : Entity_Id;
+      --  These AREC entities are defined only for subprograms for which we
+      --  generate an activation record declaration, i.e. for subprograms
+      --  with at least one nested subprogram that have uplevel referennces.
+      --  They are set to Empty for all other cases.
+
+      ARECnU : Entity_Id;
+      --  This AREC entity is the uplink component. It is other than Empty only
+      --  for nested subprograms that themselves have nested subprograms and
+      --  have uplevel references. Note that the n here is one less than the
+      --  level of the subprogram defining the activation record.
+
+   end record;
+
+   subtype SI_Type is Nat;
+
+   package Subps is new Table.Table (
+     Table_Component_Type => Subp_Entry,
+     Table_Index_Type     => SI_Type,
+     Table_Low_Bound      => 1,
+     Table_Initial        => 100,
+     Table_Increment      => 200,
+     Table_Name           => "Subps");
+   --  Records the subprograms in the nest whose outer subprogram is Subp
+
+   type Call_Entry is record
+      N   : Node_Id;
+      --  The actual call
+
+      From : Entity_Id;
+      --  Entity of the subprogram containing the call
+
+      To : Entity_Id;
+      --  Entity of the subprogram called
+   end record;
+
+   package Calls is new Table.Table (
+     Table_Component_Type => Call_Entry,
+     Table_Index_Type     => Nat,
+     Table_Low_Bound      => 1,
+     Table_Initial        => 100,
+     Table_Increment      => 200,
+     Table_Name           => "Calls");
+   --  Records each call within the outer subprogram and all nested subprograms
+   --  that are to other subprograms nested within the outer subprogram. These
+   --  are the calls that may need an additional parameter.
+
    -------------------------------------
    -- Check_Uplevel_Reference_To_Type --
    -------------------------------------
@@ -194,9 +270,20 @@ package body Exp_Unst is
          Set_Uplevel_References (Subp, New_Elmt_List);
       end if;
 
-      --  Add new element to Uplevel_References
+      --  Add new entry to Uplevel_References. Each entry is two elements of
+      --  the list. The first is the actual reference, the second is the
+      --  enclosing subprogram at the point of reference
+
+      Append_Elmt
+        (N, Uplevel_References (Subp));
+
+      if Is_Subprogram (Current_Scope) then
+         Append_Elmt (Current_Scope, Uplevel_References (Subp));
+      else
+         Append_Elmt
+           (Enclosing_Subprogram (Current_Scope), Uplevel_References (Subp));
+      end if;
 
-      Append_Elmt (N, Uplevel_References (Subp));
       Set_Has_Uplevel_Reference (Entity (N));
    end Note_Uplevel_Reference;
 
@@ -204,61 +291,23 @@ package body Exp_Unst is
    -- Unnest_Subprogram --
    -----------------------
 
-   --  Tables used by Unnest_Subprogram
-
-   type Subp_Entry is record
-      Ent : Entity_Id;
-      --  Entity of the subprogram
-
-      Bod : Node_Id;
-      --  Subprogram_Body node for this subprogram
-
-      Lev : Nat;
-      --  Subprogram level (1 = outer subprogram (Subp argument), 2 = nested
-      --  immediately within this outer subprogram etc.)
-   end record;
-
-   package Subps is new Table.Table (
-     Table_Component_Type => Subp_Entry,
-     Table_Index_Type     => Nat,
-     Table_Low_Bound      => 1,
-     Table_Initial        => 100,
-     Table_Increment      => 200,
-     Table_Name           => "Subps");
-   --  Records the subprograms in the nest whose outer subprogram is Subp
-
-   type Call_Entry is record
-      N   : Node_Id;
-      --  The actual call
-
-      From : Entity_Id;
-      --  Entity of the subprogram containing the call
-
-      To : Entity_Id;
-      --  Entity of the subprogram called
-   end record;
-
-   package Calls is new Table.Table (
-     Table_Component_Type => Call_Entry,
-     Table_Index_Type     => Nat,
-     Table_Low_Bound      => 1,
-     Table_Initial        => 100,
-     Table_Increment      => 200,
-     Table_Name           => "Calls");
-   --  Records each call within the outer subprogram and all nested subprograms
-   --  that are to other subprograms nested within the outer subprogram. These
-   --  are the calls that may need an additional parameter.
-
    procedure Unnest_Subprogram (Subp : Entity_Id; Subp_Body : Node_Id) is
-
       function Get_AREC_String (Lev : Pos) return String;
       --  Given a level value, 1, 2, ... returns the string AREC, AREC2, ...
 
+      function Get_Enclosing_Subp (Subp : SI_Type) return SI_Type;
+      --  Subp is the index of a subprogram which has a Lev greater than 1.
+      --  This function returns the index of the enclosing subprogram which
+      --  will have a Lev value one less than this.
+
       function Get_Level (Sub : Entity_Id) return Nat;
       --  Sub is either Subp itself, or a subprogram nested within Subp. This
       --  function returns the level of nesting (Subp = 1, subprograms that
       --  are immediately nested within Subp = 2, etc).
 
+      function Subp_Index (Sub : Entity_Id) return SI_Type;
+      --  Given the entity for a subprogram, return corresponding Subps index
+
       ---------------------
       -- Get_AREC_String --
       ---------------------
@@ -274,6 +323,20 @@ package body Exp_Unst is
          end if;
       end Get_AREC_String;
 
+      ------------------------
+      -- Get_Enclosing_Subp --
+      ------------------------
+
+      function Get_Enclosing_Subp (Subp : SI_Type) return SI_Type is
+         STJ : Subp_Entry renames Subps.Table (Subp);
+         Ret : constant SI_Type :=
+                 UI_To_Int (Subps_Index (Enclosing_Subprogram (STJ.Ent)));
+      begin
+         pragma Assert (STJ.Lev > 1);
+         pragma Assert (Subps.Table (Ret).Lev = STJ.Lev - 1);
+         return Ret;
+      end Get_Enclosing_Subp;
+
       ---------------
       -- Get_Level --
       ---------------
@@ -294,6 +357,16 @@ package body Exp_Unst is
          end loop;
       end Get_Level;
 
+      ----------------
+      -- Subp_Index --
+      ----------------
+
+      function Subp_Index (Sub : Entity_Id) return SI_Type is
+      begin
+         pragma Assert (Is_Subprogram (Sub));
+         return SI_Type (UI_To_Int (Subps_Index (Sub)));
+      end Subp_Index;
+
    --  Start of processing for Unnest_Subprogram
 
    begin
@@ -309,7 +382,7 @@ package body Exp_Unst is
       --  subprogram has a call to a subprogram requiring a static link, then
       --  the calling subprogram requires a static link.
 
-      --  First step, populate the above tables
+      --  First populate the above tables
 
       Subps.Init;
       Calls.Init;
@@ -353,6 +426,8 @@ package body Exp_Unst is
          --  Start of processing for Visit_Node
 
          begin
+            --  Record a call
+
             if Nkind_In (N, N_Procedure_Call_Statement, N_Function_Call) then
                Ent := Entity (Name (N));
 
@@ -360,19 +435,34 @@ package body Exp_Unst is
                   Calls.Append ((N, Find_Current_Subprogram, Ent));
                end if;
 
-            elsif Nkind (N) = N_Subprogram_Body and then Acts_As_Spec (N) then
-               Ent := Defining_Unit_Name (Specification (N));
-               Subps.Append
-                 ((Ent => Ent,
-                   Bod => N,
-                   Lev => Get_Level (Ent)));
-
-            elsif Nkind (N) = N_Subprogram_Declaration then
-               Ent := Defining_Unit_Name (Specification (N));
-               Subps.Append
-                 ((Ent => Ent,
-                   Bod => Corresponding_Body (N),
-                   Lev => Get_Level (Ent)));
+            --  Record a subprogram
+
+            elsif (Nkind (N) = N_Subprogram_Body and then Acts_As_Spec (N))
+              or else Nkind (N) = N_Subprogram_Declaration
+            then
+               Subps.Increment_Last;
+
+               declare
+                  STJ : Subp_Entry renames Subps.Table (Subps.Last);
+
+               begin
+                  --  Set fields of Subp_Entry for new subprogram
+
+                  STJ.Ent := Defining_Unit_Name (Specification (N));
+                  STJ.Lev := Get_Level (STJ.Ent);
+
+                  if Nkind (N) = N_Subprogram_Body then
+                     STJ.Bod := N;
+                  else
+                     STJ.Bod := Corresponding_Body (N);
+                  end if;
+
+                  --  Capture Uplevel_References, and then set (uses the same
+                  --  field), the Subps_Index value for this subprogram.
+
+                  STJ.Urefs := Uplevel_References (STJ.Ent);
+                  Set_Subps_Index (STJ.Ent, UI_From_Int (Int (Subps.Last)));
+               end;
             end if;
 
             return OK;
@@ -423,11 +513,71 @@ package body Exp_Unst is
          end loop Outer;
       end Closure;
 
-      --  Next step, process each subprogram in turn, inserting necessary
-      --  declarations for ARECxx types and variables for any subprogram
-      --  that has nested subprograms, and is uplevel referenced.
+      --  Next step, create the entities for code we will insert. We do this
+      --  at the start so that all the entities are defined, regardless of the
+      --  order in which we do the code insertions.
+
+      for J in Subps.First .. Subps.Last loop
+         declare
+            STJ : Subp_Entry renames Subps.Table (J);
+            Loc : constant Source_Ptr := Sloc (STJ.Bod);
+            ARS : constant String     := Get_AREC_String (STJ.Lev);
 
-      Arec_Decls : declare
+         begin
+            if STJ.Ent = Subp then
+               STJ.ARECnF := Empty;
+            else
+               STJ.ARECnF :=
+                 Make_Defining_Identifier (Loc,
+                   Chars =>
+                     Name_Find_Str (Get_AREC_String (STJ.Lev - 1) & "F"));
+            end if;
+
+            if Has_Nested_Subprogram (STJ.Ent)
+              and then Has_Uplevel_Reference (STJ.Ent)
+            then
+               STJ.ARECn   :=
+                 Make_Defining_Identifier (Loc, Name_Find_Str (ARS));
+               STJ.ARECnT  :=
+                 Make_Defining_Identifier (Loc, Name_Find_Str (ARS & "T"));
+               STJ.ARECnPT :=
+                 Make_Defining_Identifier (Loc, Name_Find_Str (ARS & "PT"));
+               STJ.ARECnP  :=
+                 Make_Defining_Identifier (Loc, Name_Find_Str (ARS & "P"));
+
+            else
+               STJ.ARECn   := Empty;
+               STJ.ARECnT  := Empty;
+               STJ.ARECnPT := Empty;
+               STJ.ARECnP  := Empty;
+               STJ.ARECnU  := Empty;
+            end if;
+
+            --  Define uplink component entity if inner nesting case and also
+            --  the extra formal entity.
+
+            if Has_Uplevel_Reference (STJ.Ent) and then STJ.Lev > 1 then
+               declare
+                  ARS1 : constant String := Get_AREC_String (STJ.Lev - 1);
+               begin
+                  STJ.ARECnU :=
+                    Make_Defining_Identifier (Loc,
+                      Chars => Name_Find_Str (ARS1 & "U"));
+                  STJ.ARECnF :=
+                    Make_Defining_Identifier (Loc,
+                      Chars => Name_Find_Str (ARS1 & "F"));
+               end;
+
+            else
+               STJ.ARECnU := Empty;
+               STJ.ARECnF := Empty;
+            end if;
+         end;
+      end loop;
+
+      --  Loop through subprograms
+
+      Subp_Loop : declare
          Addr : constant Entity_Id := RTE (RE_Address);
 
       begin
@@ -436,23 +586,30 @@ package body Exp_Unst is
                STJ : Subp_Entry renames Subps.Table (J);
 
             begin
-               --  We add AREC declarations for any subprogram that has at
-               --  least one nested subprogram, and has uplevel references.
+               --  First add the extra formal if needed. This applies to all
+               --  nested subprograms that have uplevel references.
+
+               if STJ.Lev > 1 and then Has_Uplevel_Reference (STJ.Ent) then
+                  null; -- TBD???
+               end if;
+
+               --  Processing for subprograms that have at least one nested
+               --  subprogram, and have uplevel references.
 
                if Has_Nested_Subprogram (STJ.Ent)
                  and then Has_Uplevel_Reference (STJ.Ent)
                then
-                  Add_AREC_Declarations : declare
+                  --  Local declarations for one such subprogram
+
+                  declare
                      Loc   : constant Source_Ptr := Sloc (STJ.Bod);
-                     ARS   : constant String     := Get_AREC_String (STJ.Lev);
-                     Urefs : constant Elist_Id   :=
-                               Uplevel_References (STJ.Ent);
                      Elmt  : Elmt_Id;
                      Ent   : Entity_Id;
                      Clist : List_Id;
+                     Comp  : Entity_Id;
 
                      Uplevel_Entities :
-                       array (1 .. List_Length (Urefs)) of Entity_Id;
+                       array (1 .. List_Length (STJ.Urefs)) of Entity_Id;
                      Num_Uplevel_Entities : Nat;
                      --  Uplevel_Entities (1 .. Num_Uplevel_Entities) contains
                      --  a list (with no duplicates) of the entities for this
@@ -465,7 +622,7 @@ package body Exp_Unst is
                      --  Uplevel_Reference_Noted to avoid duplicates.
 
                      Num_Uplevel_Entities := 0;
-                     Elmt := First_Elmt (Urefs);
+                     Elmt := First_Elmt (STJ.Urefs);
                      while Present (Elmt) loop
                         Ent := Entity (Node (Elmt));
 
@@ -476,38 +633,48 @@ package body Exp_Unst is
                         end if;
 
                         Next_Elmt (Elmt);
+                        Next_Elmt (Elmt);
                      end loop;
 
                      --  Build list of component declarations for ARECnT
 
                      Clist := Empty_List;
 
-                     --  If not top level, include ARECn : ARECnPT := ARECnP
+                     --  If not top level, include ARECnU : ARECnPT := ARECnF
+                     --  where n is one less than the current level and the
+                     --  entity ARECnPT comes from the enclosing subprogram.
 
                      if STJ.Lev > 1 then
-                        Append_To (Clist,
-                          Make_Component_Declaration (Loc,
-                            Defining_Identifier =>
-                              Make_Defining_Identifier (Loc,
-                                Chars => Name_Find_Str (ARS)),
-                            Component_Definition =>
-                              Make_Component_Definition (Loc,
-                                Subtype_Indication =>
-                                  Make_Identifier (Loc,
-                                    Chars => Name_Find_Str (ARS & "PT"))),
-                            Expression =>
-                              Make_Identifier (Loc,
-                                Chars => Name_Find_Str (ARS & "P"))));
+                        declare
+                           STJE : Subp_Entry
+                             renames Subps.Table (Get_Enclosing_Subp (J));
+
+                        begin
+                           Append_To (Clist,
+                             Make_Component_Declaration (Loc,
+                               Defining_Identifier  => STJ.ARECnU,
+                               Component_Definition =>
+                                 Make_Component_Definition (Loc,
+                                   Subtype_Indication =>
+                                     New_Occurrence_Of (STJE.ARECnPT, Loc)),
+                               Expression           =>
+                                 New_Occurrence_Of (STJ.ARECnF, Loc)));
+                        end;
                      end if;
 
                      --  Add components for uplevel referenced entities
 
                      for J in 1 .. Num_Uplevel_Entities loop
+                        Comp :=
+                          Make_Defining_Identifier (Loc,
+                            Chars => Chars (Uplevel_Entities (J)));
+
+                        Set_Activation_Record_Component
+                            (Uplevel_Entities (J), Comp);
+
                         Append_To (Clist,
                           Make_Component_Declaration (Loc,
-                            Defining_Identifier =>
-                              Make_Defining_Identifier (Loc,
-                                Chars => Chars (Uplevel_Entities (J))),
+                            Defining_Identifier  => Comp,
                             Component_Definition =>
                               Make_Component_Definition (Loc,
                                 Subtype_Indication =>
@@ -519,54 +686,210 @@ package body Exp_Unst is
                      Prepend_List_To (Declarations (STJ.Bod),
                        New_List (
 
-                         --  type ARECT is record .. end record;
+                         --  type ARECnT is record .. end record;
 
                          Make_Full_Type_Declaration (Loc,
-                           Defining_Identifier =>
-                             Make_Defining_Identifier (Loc,
-                               Chars => Name_Find_Str (ARS & "T")),
+                           Defining_Identifier => STJ.ARECnT,
                            Type_Definition     =>
                              Make_Record_Definition (Loc,
                                Component_List =>
                                  Make_Component_List (Loc,
                                    Component_Items => Clist))),
 
-                         --  type ARECPT is access all ARECT;
+                         --  ARECn : aliased ARECnT;
+
+                         Make_Object_Declaration (Loc,
+                           Defining_Identifier => STJ.ARECn,
+                             Aliased_Present   => True,
+                             Object_Definition =>
+                               New_Occurrence_Of (STJ.ARECnT, Loc)),
+
+                         --  type ARECnPT is access all ARECnT;
 
                          Make_Full_Type_Declaration (Loc,
-                           Defining_Identifier =>
-                             Make_Defining_Identifier (Loc,
-                               Chars => Name_Find_Str (ARS & "PT")),
-                             Type_Definition   =>
-                                Make_Access_To_Object_Definition (Loc,
-                                  All_Present        => True,
-                                  Subtype_Indication =>
-                                    Make_Identifier (Loc,
-                                      Chars => Name_Find_Str (ARS & "T")))),
-
-                        --  ARECP : constant ARECPT := AREC'Access;
+                           Defining_Identifier => STJ.ARECnPT,
+                           Type_Definition     =>
+                             Make_Access_To_Object_Definition (Loc,
+                               All_Present        => True,
+                               Subtype_Indication =>
+                                 New_Occurrence_Of (STJ.ARECnT, Loc))),
+
+                        --  ARECnP : constant ARECnPT := ARECn'Access;
 
                         Make_Object_Declaration (Loc,
-                          Defining_Identifier =>
-                            Make_Defining_Identifier (Loc,
-                              Chars => Name_Find_Str (ARS & "P")),
+                          Defining_Identifier => STJ.ARECnP,
                           Constant_Present    => True,
                           Object_Definition   =>
-                            Make_Identifier (Loc, Name_Find_Str (ARS & "PT")),
+                            New_Occurrence_Of (STJ.ARECnPT, Loc),
                           Expression          =>
                             Make_Attribute_Reference (Loc,
-                              Prefix         =>
-                                Make_Identifier (Loc, Name_Find_Str (ARS)),
-                                  Attribute_Name => Name_Access))));
-                  end Add_AREC_Declarations;
+                              Prefix           =>
+                                New_Occurrence_Of (STJ.ARECn, Loc),
+                              Attribute_Name => Name_Access))));
+
+                     --  Next step, for each uplevel referenced entity, add
+                     --  assignment operations to set the comoponent in the
+                     --  activation record.
+
+                     for J in 1 .. Num_Uplevel_Entities loop
+                        declare
+                           Ent : constant Entity_Id  := Uplevel_Entities (J);
+                           Loc : constant Source_Ptr := Sloc (Ent);
+                           Dec : constant Node_Id    := Declaration_Node (Ent);
+
+                        begin
+                           Set_Aliased_Present (Dec);
+
+                           Insert_After (Dec,
+                             Make_Assignment_Statement (Loc,
+                               Name       =>
+                                 Make_Selected_Component (Loc,
+                                   Prefix        =>
+                                     New_Occurrence_Of (STJ.ARECn, Loc),
+                                   Selector_Name =>
+                                     Make_Identifier (Loc, Chars (Ent))),
+
+                               Expression =>
+                                 Make_Attribute_Reference (Loc,
+                                   Prefix         =>
+                                     New_Occurrence_Of (Ent, Loc),
+                                   Attribute_Name => Name_Address)));
+                        end;
+                     end loop;
+
+                     --  Next step, process uplevel references
+
+                     Uplev_Refs : declare
+                        Elmt : Elmt_Id;
+
+                     begin
+                        --  Loop through uplevel references
+
+                        Elmt := First_Elmt (STJ.Urefs);
+                        while Present (Elmt) loop
+                           declare
+                              Ref : constant Node_Id := Node (Elmt);
+                              --  The uplevel reference itself
+
+                              Loc : constant Source_Ptr := Sloc (Ref);
+                              --  Source location for the reference
+
+                              Ent : constant Entity_Id := Entity (Ref);
+                              --  The referenced entity
+
+                              Typ : constant Entity_Id := Etype (Ent);
+                              --  The type of the referenced entity
+
+                              Rsub : constant Entity_Id :=
+                                       Node (Next_Elmt (Elmt));
+                              --  The enclosing subprogram for the reference
+
+                              RSX : constant SI_Type := Subp_Index (Rsub);
+                              --  Subp_Index for enclosing subprogram for ref
+
+                              STJR : Subp_Entry renames Subps.Table (RSX);
+                              --  Subp_Entry for enclosing subprogram for ref
+
+                              Tnn : constant Entity_Id :=
+                                      Make_Temporary
+                                        (Loc, 'T', Related_Node => Ref);
+                              --  Local pointer type for reference
+
+                              Pfx  : Node_Id;
+                              Comp : Entity_Id;
+                              SI   : SI_Type;
+
+                           begin
+                              --  First insert declaration for pointer type
+
+                              --    type Tnn is access all typ;
+
+                              Insert_Action (Ref,
+                                Make_Full_Type_Declaration (Loc,
+                                  Defining_Identifier => Tnn,
+                                  Type_Definition     =>
+                                    Make_Access_To_Object_Definition (Loc,
+                                      All_Present        => True,
+                                      Subtype_Indication =>
+                                        New_Occurrence_Of (Typ, Loc))));
+
+                              --  Now we need to rewrite the reference. The
+                              --  reference is from level STJE.Lev to level
+                              --  STJ.Lev. The general form of the rewritten
+                              --  reference for entity X is:
+
+                              --    Tnn!(ARECaF.ARECbU.ARECcU.ARECdU
+                              --            ....ARECm.X).all
+
+                              --  where a,b,c,d .. m =
+                              --        STJR.Lev - 1,  STJ.Lev - 2, .. STJ.Lev
+
+                              pragma Assert (STJR.Lev > STJ.Lev);
+
+                              --  Compute the prefix of X. Here are examples
+                              --  to make things clear (with parens to show
+                              --  groupings, the prefix is everything except
+                              --  the .X at the end).
+
+                              --   level 2 to level 1
+
+                              --     AREC1F.X
+
+                              --   level 3 to level 1
+
+                              --     (AREC2F.AREC1U).X
+
+                              --   level 4 to level 1
+
+                              --     ((AREC3F.AREC2U).AREC1U).X
+
+                              --   level 6 to level 2
+
+                              --     (((AREC5F.AREC4U).AREC3U).AREC2U).X
+
+                              Pfx := New_Occurrence_Of (STJR.ARECnF, Loc);
+                              SI := RSX;
+                              for L in STJ.Lev .. STJR.Lev - 2 loop
+                                 SI := Get_Enclosing_Subp (SI);
+                                 Pfx :=
+                                   Make_Selected_Component (Loc,
+                                     Prefix        => Pfx,
+                                     Selector_Name =>
+                                       New_Occurrence_Of
+                                         (Subps.Table (SI).ARECnU, Loc));
+                              end loop;
+
+                              --  Get activation record component (must exist)
+
+                              Comp := Activation_Record_Component (Ent);
+                              pragma Assert (Present (Comp));
+
+                              --  Do the replacement
+
+                              Rewrite (Ref,
+                                Make_Explicit_Dereference (Loc,
+                                  Prefix =>
+                                    Unchecked_Convert_To (Tnn,
+                                      Make_Selected_Component (Loc,
+                                        Prefix        => Pfx,
+                                        Selector_Name =>
+                                          New_Occurrence_Of (Comp, Loc)))));
+
+                              Next_Elmt (Elmt);
+                              Next_Elmt (Elmt);
+                           end;
+                        end loop;
+                     end Uplev_Refs;
+                  end;
                end if;
             end;
          end loop;
-      end Arec_Decls;
+      end Subp_Loop;
+
+      --  Finally, loop through all calls adding extra actual for the
+      --  activation record where it is required.
 
-      --  Next step, for each uplevel referenced entity, add assignment
-      --  operations to set the corresponding AREC fields, and define
-      --  the PTR types.
+      --  TBD ???
 
       return;
    end Unnest_Subprogram;
diff --git a/gcc/ada/exp_unst.ads b/gcc/ada/exp_unst.ads
index 8690a3547a8..32b2eb82824 100644
--- a/gcc/ada/exp_unst.ads
+++ b/gcc/ada/exp_unst.ads
@@ -165,9 +165,6 @@ package Exp_Unst is
    --    since they will be accessed indirectly via an activation record as
    --    described below.
 
-   --    For each such entity xxx we create an access type xxxPTR (forced to
-   --    single length in the unconstrained case).
-
    --    An activation record is created containing system address values
    --    for each uplevel referenced entity in a given scope. In the example
    --    given before, we would have:
@@ -177,8 +174,11 @@ package Exp_Unst is
    --         x  : Address;
    --         rv : Address;
    --      end record;
-   --      type AREC1P is access all AREC1T;
-   --      AREC1 : AREC1T;
+
+   --      AREC1 : aliased AREC1T;
+
+   --      type AREC1PT is access all AREC1T;
+   --      AREC1P : constant AREC1PT := AREC1'Access;
 
    --   The fields of AREC1 are set at the point the corresponding entity
    --   is declared (immediately for parameters).
@@ -188,8 +188,8 @@ package Exp_Unst is
    --   will use AREC2, AREC3, ...
 
    --   For all subprograms nested immediately within the corresponding scope,
-   --   a parameter AREC1P is passed, and all calls to these routines have
-   --   AREC1 added as an additional formal.
+   --   a parameter AREC1F is passed, and all calls to these routines have
+   --   AREC1P added as an additional formal.
 
    --   Now within the nested procedures, any reference to an uplevel entity
    --   xxx is replaced by Tnn!(AREC1.xxx).all (where ! represents a call
@@ -216,11 +216,11 @@ package Exp_Unst is
    --
    --          AREC1.b := b'Address;
    --
-   --          procedure inner (bb : integer; AREC1P : AREC1PT);
+   --          procedure inner (bb : integer; AREC1F : AREC1PT);
    --
-   --          procedure inner2 (AREC1P : AREC1PT) is
+   --          procedure inner2 (AREC1F : AREC1PT) is
    --          begin
-   --            inner(5, AREC1P);
+   --            inner(5, AREC1F);
    --          end;
    --
    --          x  : aliased integer := 77;
@@ -231,13 +231,13 @@ package Exp_Unst is
    --          rv : aliased Integer;
    --          AREC1.rv := rv'Address;
    --
-   --          procedure inner (bb : integer; AREC1P : AREC1PT) is
+   --          procedure inner (bb : integer; AREC1F : AREC1PT) is
    --          begin
    --             type Tnn1 is access all Integer;
    --             type Tnn2 is access all Integer;
    --             type Tnn3 is access all Integer;
-   --             Tnn1!(AREC1P.x).all :=
-   --               Tnn2!(AREC1P.rv).all + y + b + Tnn3!(AREC1P.b).all;
+   --             Tnn1!(AREC1F.x).all :=
+   --               Tnn2!(AREC1F.rv).all + y + b + Tnn3!(AREC1F.b).all;
    --          end;
    --
    --       begin
@@ -386,10 +386,10 @@ package Exp_Unst is
    --          end record;
    --          darecv : darec;
    --
-   --          function inner (b : integer; AREC1P : AREC1PT) return boolean is
+   --          function inner (b : integer; AREC1F : AREC1PT) return boolean is
    --          begin
    --             type Tnn is access all Integer
-   --             return b in x .. Tnn!(AREC1P.dynam_LAST).all
+   --             return b in x .. Tnn!(AREC1F.dynam_LAST).all
    --               and then darecv.b in 42 .. 73;
    --          end inner;
    --
@@ -414,9 +414,9 @@ package Exp_Unst is
    --  approach described above for case 2, except that we need an activation
    --  record at each nested level. Basically the rule is that any procedure
    --  that has nested procedures needs an activation record. When we do this,
-   --  the inner activation records have a pointer to the immediately enclosing
-   --  activation record, the normal arrangement of static links. The following
-   --  shows the full translation of this fourth case.
+   --  the inner activation records have a pointer (uplink) to the immediately
+   --  enclosing activation record, the normal arrangement of static links. The
+   --  following shows the full translation of this fourth case.
 
    --     function case4x (x : integer) return integer is
    --        type AREC1T is record
@@ -430,10 +430,10 @@ package Exp_Unst is
    --        v1 : integer := x;
    --        AREC1.v1 := v1'Address;
    --
-   --        function inner1 (y : integer; AREC1P : ARECPT) return integer is
+   --        function inner1 (y : integer; AREC1F : AREC1PT) return integer is
    --           type AREC2T is record
-   --              AREC1 : AREC1PT := AREC1P;
-   --              v2    : Address;
+   --              AREC1U : AREC1PT := AREC1F;
+   --              v2     : Address;
    --           end record;
    --
    --           AREC2 : aliased AREC2T;
@@ -441,22 +441,22 @@ package Exp_Unst is
    --           AREC2P : constant AREC2PT := AREC2'Access;
    --
    --           type Tnn1 is access all Integer;
-   --           v2 : integer := Tnn1!(AREC1P.v1).all {+} 1;
+   --           v2 : integer := Tnn1!(AREC1F.v1).all {+} 1;
    --           AREC2.v2 := v2'Address;
    --
    --           function inner2
-   --              (z : integer; AREC2P : AREC2PT) return integer
+   --              (z : integer; AREC2F : AREC2PT) return integer
    --           is
    --           begin
    --              type Tnn1 is access all Integer;
    --              type Tnn2 is access all Integer;
    --              return integer(z {+}
-   --                             Tnn1!(AREC2P.AREC1.v1).all {+}
-   --                             Tnn2!(AREC2P.v2).all);
+   --                             Tnn1!(AREC2F.AREC1U.v1).all {+}
+   --                             Tnn2!(AREC2F.v2).all);
    --           end inner2;
    --        begin
    --           type Tnn is access all Integer;
-   --           return integer(y {+} inner2 (Tnn!(AREC1P.v1).all, AREC2P));
+   --           return integer(y {+} inner2 (Tnn!(AREC1F.v1).all, AREC2P));
    --        end inner1;
    --     begin
    --        return inner1 (x, AREC1P);
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index b86e1514efc..ab9ee00dc68 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -4026,6 +4026,15 @@ package body Sem_Ch8 is
          if not In_Open_Scopes (Pack) then
             null;  --  default as well
 
+         --  If the use clause appears in an ancestor and we are in the
+         --  private part of the immediate parent, the use clauses are
+         --  already installed.
+
+         elsif Pack /= Scope (Current_Scope)
+           and then In_Private_Part (Scope (Current_Scope))
+         then
+            null;
+
          else
             --  Find entry for parent unit in scope stack