[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Tue, 12 May 2015 08:36:45 +0000 (10:36 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Tue, 12 May 2015 08:36:45 +0000 (10:36 +0200)
2015-05-12  Robert Dewar  <dewar@adacore.com>

* sem_ch3.adb: Minor reformatting.

2015-05-12  Vincent Celier  <celier@adacore.com>

* gnatcmd.adb: If we want to invoke gnatmake (gnatclean) with
-P, then check if gprbuild (gprclean) is available; if it is,
use gprbuild (gprclean) instead of gnatmake (gnatclean).

2015-05-12  Robert Dewar  <dewar@adacore.com>

* debug.adb: Add flag -gnatd.3 to output diagnostic info from
Exp_Unst.
* einfo.ad, einfo.adb: Reorganize (and remove most of) flags used by
Exp_Unst.
* exp_ch6.adb (Unest_Bodies): Table for delayed calls to
Unnest_Subprogram (Expand_N_Subprogram_Body): Add entry to table
for later call instead of calling Unnest_Subprogram directly
(Initialize): New procedure (Unnest_Subprograms): New procedure
* exp_ch6.ads (Add_Extra_Actual_To_Call): Move into proper
alpha order.
(Initialize): New procedure.
(Unnest_Subprograms): New procedure.
* exp_unst.adb (Unnest_Subprogram): Major rewrite, moving
all processing to this routine which is now called late
after instantiating bodies. Fully handles the case of generic
instantiations now.
* exp_unst.ads: Major rewrite, moving all processing to
Unnest_Subprogram.
* frontend.adb (Frontend): Add call to Exp_Ch6.Initialize.
(Frontend): Add call to Unnest_Subprograms.
* sem_ch8.adb (Find_Direct_Name): Back to old calling sequence
for Check_Nested_Access.
* sem_util.adb (Build_Default_Subtype): Minor reformatting
(Check_Nested_Access): Back to original VM-only form (we
now do all the processing for Unnest_Subprogram at the time
it is called.
(Denotes_Same_Object): Minor reformatting
(Note_Possible_Modification): Old calling sequence for
Check_Nested_Access.
* sem_util.ads (Check_Nested_Access): Back to original VM-only
form (we now do all the processing for Unnest_Subprogram at the
time it is called.

From-SVN: r223043

14 files changed:
gcc/ada/ChangeLog
gcc/ada/debug.adb
gcc/ada/einfo.adb
gcc/ada/einfo.ads
gcc/ada/exp_ch6.adb
gcc/ada/exp_ch6.ads
gcc/ada/exp_unst.adb
gcc/ada/exp_unst.ads
gcc/ada/frontend.adb
gcc/ada/gnatcmd.adb
gcc/ada/sem_ch3.adb
gcc/ada/sem_ch8.adb
gcc/ada/sem_util.adb
gcc/ada/sem_util.ads

index 0cba4e798a4aacf7b7e02248e61167971c97f7b6..10af3d88788162469ff456e404a59dfc10deb5e4 100644 (file)
@@ -1,3 +1,48 @@
+2015-05-12  Robert Dewar  <dewar@adacore.com>
+
+       * sem_ch3.adb: Minor reformatting.
+
+2015-05-12  Vincent Celier  <celier@adacore.com>
+
+       * gnatcmd.adb: If we want to invoke gnatmake (gnatclean) with
+       -P, then check if gprbuild (gprclean) is available; if it is,
+       use gprbuild (gprclean) instead of gnatmake (gnatclean).
+
+2015-05-12  Robert Dewar  <dewar@adacore.com>
+
+       * debug.adb: Add flag -gnatd.3 to output diagnostic info from
+       Exp_Unst.
+       * einfo.ad, einfo.adb: Reorganize (and remove most of) flags used by
+       Exp_Unst.
+       * exp_ch6.adb (Unest_Bodies): Table for delayed calls to
+       Unnest_Subprogram (Expand_N_Subprogram_Body): Add entry to table
+       for later call instead of calling Unnest_Subprogram directly
+       (Initialize): New procedure (Unnest_Subprograms): New procedure
+       * exp_ch6.ads (Add_Extra_Actual_To_Call): Move into proper
+       alpha order.
+       (Initialize): New procedure.
+       (Unnest_Subprograms): New procedure.
+       * exp_unst.adb (Unnest_Subprogram): Major rewrite, moving
+       all processing to this routine which is now called late
+       after instantiating bodies. Fully handles the case of generic
+       instantiations now.
+       * exp_unst.ads: Major rewrite, moving all processing to
+       Unnest_Subprogram.
+       * frontend.adb (Frontend): Add call to Exp_Ch6.Initialize.
+       (Frontend): Add call to Unnest_Subprograms.
+       * sem_ch8.adb (Find_Direct_Name): Back to old calling sequence
+       for Check_Nested_Access.
+       * sem_util.adb (Build_Default_Subtype): Minor reformatting
+       (Check_Nested_Access): Back to original VM-only form (we
+       now do all the processing for Unnest_Subprogram at the time
+       it is called.
+       (Denotes_Same_Object): Minor reformatting
+       (Note_Possible_Modification): Old calling sequence for
+       Check_Nested_Access.
+       * sem_util.ads (Check_Nested_Access): Back to original VM-only
+       form (we now do all the processing for Unnest_Subprogram at the
+       time it is called.
+
 2015-05-12  Robert Dewar  <dewar@adacore.com>
 
        * sem_ch3.adb, freeze.adb, sem_ch6.adb: Minor reformatting.
index e04b5b55856e7811e0fc95b46ed066637bc58c83..116fcfc6782546922b553ba97421cb810e98cbe6 100644 (file)
@@ -157,7 +157,7 @@ package body Debug is
 
    --  d.1  Enable unnesting of nested procedures
    --  d.2  Allow statements in declarative part
-   --  d.3
+   --  d.3  Output debugging information from Exp_Unst
    --  d.4
    --  d.5
    --  d.6
@@ -755,6 +755,9 @@ package body Debug is
    --       allowed, but in some debugging contexts (e.g. testing the circuit
    --       for unnesting of procedures), it is useful to allow this.
 
+   --  d.3  Output debugging information from Exp_Unst, including the name of
+   --       any unreachable subprograms that get deleted.
+
    ------------------------------------------
    -- Documentation for Binder Debug Flags --
    ------------------------------------------
index 2e7d51980c7b127745196e42f424fbed3ac90a00..772195bd424c7a78ba4d1602799faacf926d097a 100644 (file)
@@ -213,7 +213,6 @@ package body Einfo is
    --    Stored_Constraint               Elist23
 
    --    Related_Expression              Node24
-   --    Uplevel_References              Elist24
    --    Subps_Index                     Uint24
 
    --    Interface_Alias                 Node25
@@ -590,7 +589,7 @@ package body Einfo is
 
    --    Is_Static_Type                  Flag281
    --    Has_Nested_Subprogram           Flag282
-   --    Uplevel_Reference_Noted         Flag283
+   --    Is_Uplevel_Referenced_Entity    Flag283
    --    Is_Unimplemented                Flag284
 
    --    (unused)                        Flag285
@@ -2418,7 +2417,6 @@ package body Einfo is
 
    function Is_Static_Type (Id : E) return B is
    begin
-      pragma Assert (Is_Type (Id));
       return Flag281 (Id);
    end Is_Static_Type;
 
@@ -2474,6 +2472,11 @@ package body Einfo is
       return Flag144 (Id);
    end Is_Unsigned_Type;
 
+   function Is_Uplevel_Referenced_Entity (Id : E) return B is
+   begin
+      return Flag283 (Id);
+   end Is_Uplevel_Referenced_Entity;
+
    function Is_Valued_Procedure (Id : E) return B is
    begin
       pragma Assert (Ekind (Id) = E_Procedure);
@@ -2684,8 +2687,10 @@ package body Einfo is
    begin
       pragma Assert
         (Ekind (Id) in Incomplete_Kind
-           or else Ekind (Id) in Class_Wide_Kind
-           or else Ekind (Id) = E_Abstract_State);
+           or else
+         Ekind (Id) in Class_Wide_Kind
+           or else
+         Ekind (Id) = E_Abstract_State);
       return Node19 (Id);
    end Non_Limited_View;
 
@@ -3247,17 +3252,6 @@ package body Einfo is
       return Node16 (Id);
    end Unset_Reference;
 
-   function Uplevel_Reference_Noted (Id : E) return B is
-   begin
-      return Flag283 (Id);
-   end Uplevel_Reference_Noted;
-
-   function Uplevel_References (Id : E) return L is
-   begin
-      pragma Assert (Is_Subprogram (Id));
-      return Elist24 (Id);
-   end Uplevel_References;
-
    function Used_As_Generic_Actual (Id : E) return B is
    begin
       return Flag222 (Id);
@@ -4458,11 +4452,6 @@ package body Einfo is
       Set_Flag282 (Id, V);
    end Set_Has_Nested_Subprogram;
 
-   procedure Set_Has_Uplevel_Reference (Id : E; V : B := True) is
-   begin
-      Set_Flag215 (Id, V);
-   end Set_Has_Uplevel_Reference;
-
    procedure Set_Has_Non_Standard_Rep (Id : E; V : B := True) is
    begin
       pragma Assert (Id = Base_Type (Id));
@@ -4713,6 +4702,11 @@ package body Einfo is
       Set_Flag72 (Id, V);
    end Set_Has_Unknown_Discriminants;
 
+   procedure Set_Has_Uplevel_Reference (Id : E; V : B := True) is
+   begin
+      Set_Flag215 (Id, V);
+   end Set_Has_Uplevel_Reference;
+
    procedure Set_Has_Visible_Refinement (Id : E; V : B := True) is
    begin
       pragma Assert (Ekind (Id) = E_Abstract_State);
@@ -5423,6 +5417,15 @@ package body Einfo is
       Set_Flag144 (Id, V);
    end Set_Is_Unsigned_Type;
 
+   procedure Set_Is_Uplevel_Referenced_Entity (Id : E; V : B := True) is
+   begin
+      pragma Assert
+        (Ekind_In (Id, E_Constant, E_Variable)
+          or else Is_Formal (Id)
+          or else Is_Type (Id));
+      Set_Flag283 (Id, V);
+   end Set_Is_Uplevel_Referenced_Entity;
+
    procedure Set_Is_Valued_Procedure (Id : E; V : B := True) is
    begin
       pragma Assert (Ekind (Id) = E_Procedure);
@@ -5632,8 +5635,7 @@ package body Einfo is
    begin
       pragma Assert
         (Ekind (Id) in Incomplete_Kind
-           or else Ekind (Id) = E_Abstract_State
-           or else Ekind (Id) = E_Class_Wide_Type);
+          or else Ekind_In (Id, E_Abstract_State, E_Class_Wide_Type));
       Set_Node19 (Id, V);
    end Set_Non_Limited_View;
 
@@ -6224,17 +6226,6 @@ package body Einfo is
       Set_Node16 (Id, V);
    end Set_Unset_Reference;
 
-   procedure Set_Uplevel_Reference_Noted (Id : E; V : B := True) is
-   begin
-      Set_Flag283 (Id, V);
-   end Set_Uplevel_Reference_Noted;
-
-   procedure Set_Uplevel_References (Id : E; V : L) is
-   begin
-      pragma Assert (Is_Subprogram (Id));
-      Set_Elist24 (Id, V);
-   end Set_Uplevel_References;
-
    procedure Set_Used_As_Generic_Actual (Id : E; V : B := True) is
    begin
       Set_Flag222 (Id, V);
@@ -7116,8 +7107,8 @@ package body Einfo is
    function Has_Non_Limited_View (Id : E) return B is
    begin
       return (Ekind (Id) in Incomplete_Kind
-          or else Ekind (Id) in Class_Wide_Kind
-          or else Ekind (Id) = E_Abstract_State)
+               or else Ekind (Id) in Class_Wide_Kind
+               or else Ekind (Id) = E_Abstract_State)
         and then Present (Non_Limited_View (Id));
    end Has_Non_Limited_View;
 
@@ -8802,6 +8793,7 @@ package body Einfo is
       W ("Is_Underlying_Record_View",       Flag246 (Id));
       W ("Is_Unimplemented",                Flag284 (Id));
       W ("Is_Unsigned_Type",                Flag144 (Id));
+      W ("Is_Uplevel_Referenced_Entity",    Flag283 (Id));
       W ("Is_Valued_Procedure",             Flag127 (Id));
       W ("Is_Visible_Formal",               Flag206 (Id));
       W ("Is_Visible_Lib_Unit",             Flag116 (Id));
@@ -8859,7 +8851,6 @@ package body Einfo is
       W ("Suppress_Value_Tracking_On_Call", Flag217 (Id));
       W ("Treat_As_Volatile",               Flag41  (Id));
       W ("Universal_Aliasing",              Flag216 (Id));
-      W ("Uplevel_Reference_Noted",         Flag283 (Id));
       W ("Used_As_Generic_Actual",          Flag222 (Id));
       W ("Uses_Sec_Stack",                  Flag95  (Id));
       W ("Warnings_Off",                    Flag96  (Id));
@@ -9774,11 +9765,7 @@ package body Einfo is
          when E_Function                                   |
               E_Operator                                   |
               E_Procedure                                  =>
-            if Field24 (Id) in Uint_Range then
-               Write_Str ("Subps_Index");
-            else
-               Write_Str ("Uplevel_References");
-            end if;
+            Write_Str ("Subps_Index");
 
          when others                                       =>
             Write_Str ("Field24???");
index 6779a4b483c0cd56db1b0de056c136e33e9d33fc..c25be53052522b1ee1898a6cdf2d66f6fb78dc2d 100644 (file)
@@ -2009,11 +2009,10 @@ package Einfo is
 --       Defined in all entities. Indicates that the entity is locally defined
 --       within a subprogram P, and there is a reference to the entity within
 --       a subprogram nested within P (at any depth). Set only for the VM case
---       (where it is set for variables, constants and loop parameters), and in
---       the case where we are unnesting nested subprograms (in which case it
---       is also set for types and subtypes which are not static types, and
---       that are referenced uplevel, as well as for subprograms that contain
---       uplevel references or call other subprograms (Exp_Unst has details).
+--       (where it is set for variables, constants and loop parameters). Note
+--       that this is similar in usage to Is_Uplevel_Referenced_Entity (which
+--       is used when we are unnesting subprograms), but the usages are a bit
+--       different and it is cleaner to leave the old VM usage unchanged.
 
 --    Has_Visible_Refinement (Flag263)
 --       Defined in E_Abstract_State entities. Set when a state has at least
@@ -2988,8 +2987,8 @@ package Einfo is
 --       Wide_Wide_String).
 
 --    Is_Static_Type (Flag281)
---       Defined in all type and subtype entities. If set, indicates that the
---       type is known to be a static type (defined as a discrete type with
+--       Defined in entities. Only set for (sub)types. If set, indicates that
+--       the type is known to be a static type (defined as a discrete type with
 --       static bounds, a record all of whose component types are static types,
 --       or an array, all of whose bounds are of a static type, and also have
 --       a component type that is a static type). See Set_Uplevel_Type for more
@@ -3111,6 +3110,20 @@ package Einfo is
 --       subtype is still unsigned, but this cannot be determined by looking
 --       at its bounds or the bounds of the corresponding base type.
 
+--    Is_Uplevel_Referenced_Entity (Flag283)
+--       Defined in all entities. Used when unnesting subprograms to indicate
+--       that an entity is locally defined within a subprogram P, and there is
+--       a reference to the entity within a subprogram nested within P (at any
+--       depth). Set for uplevel referenced objects (variables, constants and
+--       loop parameters), and also for upreferenced dynamic types, including
+--       the cases where the reference is implicit (e.g. the type of an array
+--       used for computing the location of an element in an array. This is
+--       used internally in Exp_Unst, see this package for further details.
+--       Note that this is similar to the Has_Uplevel_Reference flag which
+--       is used in the VM case but we prefer to keep the two cases entirely
+--       separated, so that the VM usage is not disturbed by work on the
+--       Unnesting_Subprograms mode.
+
 --    Is_Valued_Procedure (Flag127)
 --       Defined in procedure entities. Set if an Import_Valued_Procedure
 --       or Export_Valued_Procedure pragma applies to the procedure entity.
@@ -4142,8 +4155,6 @@ package Einfo is
 --    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
@@ -4278,19 +4289,6 @@ package Einfo is
 --       is identified. This field is used to generate a warning message if
 --       necessary (see Sem_Warn.Check_Unset_Reference).
 
---    Uplevel_Reference_Noted (Flag283)
---       Defined in all entities, used in Exp_Unst processing to note that an
---       uplevel reference to the entity has been noted (to avoid processing a
---       given entity more than once).
-
---    Uplevel_References (Elist24)
---       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. 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
 --       a generic instantiation. Used to tune certain warning messages.
@@ -5255,6 +5253,7 @@ package Einfo is
    --    Has_Qualified_Name                  (Flag161)
    --    Has_Stream_Size_Clause              (Flag184)
    --    Has_Unknown_Discriminants           (Flag72)
+   --    Has_Uplevel_Reference               (Flag215)
    --    Has_Xref_Entry                      (Flag182)
    --    In_Private_Part                     (Flag45)
    --    Is_Ada_2005_Only                    (Flag185)
@@ -5304,6 +5303,7 @@ package Einfo is
    --    Is_Renaming_Of_Object               (Flag112)
    --    Is_Shared_Passive                   (Flag60)
    --    Is_Statically_Allocated             (Flag28)
+   --    Is_Static_Type                      (Flag281)
    --    Is_Tagged_Type                      (Flag55)
    --    Is_Thunk                            (Flag225)
    --    Is_Trivial_Subprogram               (Flag235)
@@ -5324,7 +5324,6 @@ package Einfo is
    --    Suppress_Elaboration_Warnings       (Flag148)
    --    Suppress_Style_Checks               (Flag165)
    --    Suppress_Value_Tracking_On_Call     (Flag217)
-   --    Uplevel_Reference_Noted             (Flag283)
    --    Used_As_Generic_Actual              (Flag222)
    --    Warnings_Off                        (Flag96)
    --    Warnings_Off_Used                   (Flag236)
@@ -5395,7 +5394,6 @@ package Einfo is
    --    Has_Static_Predicate_Aspect         (Flag259)
    --    Has_Task                            (Flag30)   (base type only)
    --    Has_Unchecked_Union                 (Flag123)  (base type only)
-   --    Has_Uplevel_Reference               (Flag215)
    --    Has_Volatile_Components             (Flag87)   (base type only)
    --    In_Use                              (Flag8)
    --    Is_Abstract_Type                    (Flag146)
@@ -5412,7 +5410,6 @@ package Einfo is
    --    Is_Non_Static_Subtype               (Flag109)
    --    Is_Packed                           (Flag51)   (base type only)
    --    Is_Private_Composite                (Flag107)
-   --    Is_Static_Type                      (Flag281)
    --    Is_Unsigned_Type                    (Flag144)
    --    Is_Volatile                         (Flag16)
    --    Itype_Printed                       (Flag202)  (itypes only)
@@ -5617,7 +5614,6 @@ package Einfo is
    --    Has_Independent_Components          (Flag34)
    --    Has_Size_Clause                     (Flag29)
    --    Has_Thunks                          (Flag228)  (constants only)
-   --    Has_Uplevel_Reference               (Flag215)
    --    Has_Volatile_Components             (Flag87)
    --    Is_Atomic                           (Flag85)
    --    Is_Eliminated                       (Flag124)
@@ -5625,6 +5621,7 @@ package Einfo is
    --    Is_Processed_Transient              (Flag252)  (constants only)
    --    Is_Return_Object                    (Flag209)
    --    Is_True_Constant                    (Flag163)
+   --    Is_Uplevel_Referenced_Entity        (Flag283)
    --    Is_Volatile                         (Flag16)
    --    Stores_Attribute_Old_Prefix         (Flag270)  (constants only)
    --    Optimize_Alignment_Space            (Flag241)  (constants only)
@@ -5785,7 +5782,6 @@ package Einfo is
    --    Generic_Renamings                   (Elist23)  (for an instance)
    --    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)
@@ -5960,7 +5956,6 @@ package Einfo is
    --    Extra_Accessibility_Of_Result       (Node19)
    --    Last_Entity                         (Node20)
    --    Has_Nested_Subprogram               (Flag282)
-   --    Uplevel_References                  (Elist24)
    --    Subps_Index                         (Uint24)
    --    Overridden_Operation                (Node26)
    --    Subprograms_For_Type                (Node29)
@@ -6094,7 +6089,6 @@ package Einfo is
    --    Generic_Renamings                   (Elist23)  (for an instance)
    --    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)
@@ -6351,7 +6345,6 @@ package Einfo is
    --    Has_Independent_Components          (Flag34)
    --    Has_Initial_Value                   (Flag219)
    --    Has_Size_Clause                     (Flag29)
-   --    Has_Uplevel_Reference               (Flag215)
    --    Has_Volatile_Components             (Flag87)
    --    Is_Atomic                           (Flag85)
    --    Is_Eliminated                       (Flag124)
@@ -6362,6 +6355,7 @@ package Einfo is
    --    Is_True_Constant                    (Flag163)
    --    Is_Volatile                         (Flag16)
    --    Is_Return_Object                    (Flag209)
+   --    Is_Uplevel_Referenced_Entity        (Flag283)
    --    OK_To_Rename                        (Flag247)
    --    Optimize_Alignment_Space            (Flag241)
    --    Optimize_Alignment_Time             (Flag242)
@@ -6913,6 +6907,7 @@ package Einfo is
    function Is_Underlying_Record_View           (Id : E) return B;
    function Is_Unimplemented                    (Id : E) return B;
    function Is_Unsigned_Type                    (Id : E) return B;
+   function Is_Uplevel_Referenced_Entity        (Id : E) return B;
    function Is_Valued_Procedure                 (Id : E) return B;
    function Is_Visible_Formal                   (Id : E) return B;
    function Is_Visible_Lib_Unit                 (Id : E) return B;
@@ -7041,8 +7036,6 @@ package Einfo is
    function Underlying_Record_View              (Id : E) return E;
    function Universal_Aliasing                  (Id : E) return B;
    function Unset_Reference                     (Id : E) return N;
-   function Uplevel_Reference_Noted             (Id : E) return B;
-   function Uplevel_References                  (Id : E) return L;
    function Used_As_Generic_Actual              (Id : E) return B;
    function Uses_Lock_Free                      (Id : E) return B;
    function Uses_Sec_Stack                      (Id : E) return B;
@@ -7569,6 +7562,7 @@ package Einfo is
    procedure Set_Is_Underlying_Record_View       (Id : E; V : B := True);
    procedure Set_Is_Unimplemented                (Id : E; V : B := True);
    procedure Set_Is_Unsigned_Type                (Id : E; V : B := True);
+   procedure Set_Is_Uplevel_Referenced_Entity    (Id : E; V : B := True);
    procedure Set_Is_Valued_Procedure             (Id : E; V : B := True);
    procedure Set_Is_Visible_Formal               (Id : E; V : B := True);
    procedure Set_Is_Visible_Lib_Unit             (Id : E; V : B := True);
@@ -7697,8 +7691,6 @@ package Einfo is
    procedure Set_Underlying_Record_View          (Id : E; V : E);
    procedure Set_Universal_Aliasing              (Id : E; V : B := True);
    procedure Set_Unset_Reference                 (Id : E; V : N);
-   procedure Set_Uplevel_Reference_Noted         (Id : E; V : B := True);
-   procedure Set_Uplevel_References              (Id : E; V : L);
    procedure Set_Used_As_Generic_Actual          (Id : E; V : B := True);
    procedure Set_Uses_Lock_Free                  (Id : E; V : B := True);
    procedure Set_Uses_Sec_Stack                  (Id : E; V : B := True);
@@ -8380,6 +8372,7 @@ package Einfo is
    pragma Inline (Is_Underlying_Record_View);
    pragma Inline (Is_Unimplemented);
    pragma Inline (Is_Unsigned_Type);
+   pragma Inline (Is_Uplevel_Referenced_Entity);
    pragma Inline (Is_Valued_Procedure);
    pragma Inline (Is_Visible_Formal);
    pragma Inline (Is_Visible_Lib_Unit);
@@ -8510,8 +8503,6 @@ package Einfo is
    pragma Inline (Underlying_Record_View);
    pragma Inline (Universal_Aliasing);
    pragma Inline (Unset_Reference);
-   pragma Inline (Uplevel_Reference_Noted);
-   pragma Inline (Uplevel_References);
    pragma Inline (Used_As_Generic_Actual);
    pragma Inline (Uses_Lock_Free);
    pragma Inline (Uses_Sec_Stack);
@@ -8717,7 +8708,6 @@ package Einfo is
    pragma Inline (Set_Has_Thunks);
    pragma Inline (Set_Has_Unchecked_Union);
    pragma Inline (Set_Has_Unknown_Discriminants);
-   pragma Inline (Set_Has_Uplevel_Reference);
    pragma Inline (Set_Has_Visible_Refinement);
    pragma Inline (Set_Has_Volatile_Components);
    pragma Inline (Set_Has_Xref_Entry);
@@ -8836,6 +8826,7 @@ package Einfo is
    pragma Inline (Set_Is_Underlying_Record_View);
    pragma Inline (Set_Is_Unimplemented);
    pragma Inline (Set_Is_Unsigned_Type);
+   pragma Inline (Set_Is_Uplevel_Referenced_Entity);
    pragma Inline (Set_Is_Valued_Procedure);
    pragma Inline (Set_Is_Visible_Formal);
    pragma Inline (Set_Is_Visible_Lib_Unit);
@@ -8963,8 +8954,6 @@ package Einfo is
    pragma Inline (Set_Underlying_Full_View);
    pragma Inline (Set_Underlying_Record_View);
    pragma Inline (Set_Universal_Aliasing);
-   pragma Inline (Set_Uplevel_Reference_Noted);
-   pragma Inline (Set_Uplevel_References);
    pragma Inline (Set_Unset_Reference);
    pragma Inline (Set_Used_As_Generic_Actual);
    pragma Inline (Set_Uses_Lock_Free);
index 0b9fb75328b806a5cc3fec5df37faf4ed0332a30..8677562f435802d19ddb4111e8f7ef576050560d 100644 (file)
@@ -71,6 +71,7 @@ with Sinfo;    use Sinfo;
 with Snames;   use Snames;
 with Stand;    use Stand;
 with Stringt;  use Stringt;
+with Table;
 with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
@@ -78,6 +79,33 @@ with Validsw;  use Validsw;
 
 package body Exp_Ch6 is
 
+   -------------------------------------
+   -- Table for Unnesting Subprograms --
+   -------------------------------------
+
+   --  When we expand a subprogram body, if it has nested subprograms and if
+   --  we are in Unnest_Subprogram_Mode, then we record the subprogram entity
+   --  and the body in this table, to later be passed to Unnest_Subprogram.
+
+   --  We need this delaying mechanism, because we have to wait untiil all
+   --  instantiated bodies have been inserted before doing the unnesting.
+
+   type Unest_Entry is record
+      Ent : Entity_Id;
+      --  Entity for subprogram to be unnested
+
+      Bod : Node_Id;
+      --  Subprogram body to be unnested
+   end record;
+
+   package Unest_Bodies is new Table.Table (
+     Table_Component_Type => Unest_Entry,
+     Table_Index_Type     => Nat,
+     Table_Low_Bound      => 1,
+     Table_Initial        => 100,
+     Table_Increment      => 200,
+     Table_Name           => "Unest_Bodies");
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -5360,7 +5388,7 @@ package body Exp_Ch6 is
 
         and then Has_Nested_Subprogram (Spec_Id)
       then
-         Unnest_Subprogram (Spec_Id, N);
+         Unest_Bodies.Append ((Spec_Id, N));
       end if;
    end Expand_N_Subprogram_Body;
 
@@ -5788,32 +5816,6 @@ package body Exp_Ch6 is
       end if;
    end Expand_Protected_Subprogram_Call;
 
-   --------------------------------------------
-   -- Has_Unconstrained_Access_Discriminants --
-   --------------------------------------------
-
-   function Has_Unconstrained_Access_Discriminants
-     (Subtyp : Entity_Id) return Boolean
-   is
-      Discr : Entity_Id;
-
-   begin
-      if Has_Discriminants (Subtyp)
-        and then not Is_Constrained (Subtyp)
-      then
-         Discr := First_Discriminant (Subtyp);
-         while Present (Discr) loop
-            if Ekind (Etype (Discr)) = E_Anonymous_Access_Type then
-               return True;
-            end if;
-
-            Next_Discriminant (Discr);
-         end loop;
-      end if;
-
-      return False;
-   end Has_Unconstrained_Access_Discriminants;
-
    -----------------------------------
    -- Expand_Simple_Function_Return --
    -----------------------------------
@@ -7999,6 +8001,41 @@ package body Exp_Ch6 is
       end if;
    end Expand_Subprogram_Contract;
 
+   --------------------------------------------
+   -- Has_Unconstrained_Access_Discriminants --
+   --------------------------------------------
+
+   function Has_Unconstrained_Access_Discriminants
+     (Subtyp : Entity_Id) return Boolean
+   is
+      Discr : Entity_Id;
+
+   begin
+      if Has_Discriminants (Subtyp)
+        and then not Is_Constrained (Subtyp)
+      then
+         Discr := First_Discriminant (Subtyp);
+         while Present (Discr) loop
+            if Ekind (Etype (Discr)) = E_Anonymous_Access_Type then
+               return True;
+            end if;
+
+            Next_Discriminant (Discr);
+         end loop;
+      end if;
+
+      return False;
+   end Has_Unconstrained_Access_Discriminants;
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize is
+   begin
+      Unest_Bodies.Init;
+   end Initialize;
+
    --------------------------------
    -- Is_Build_In_Place_Function --
    --------------------------------
@@ -9489,4 +9526,19 @@ package body Exp_Ch6 is
       end if;
    end Needs_Result_Accessibility_Level;
 
+   ------------------------
+   -- Unnest_Subprograms --
+   ------------------------
+
+   procedure Unnest_Subprograms is
+   begin
+      for J in Unest_Bodies.First .. Unest_Bodies.Last loop
+         declare
+            UBJ : Unest_Entry renames Unest_Bodies.Table (J);
+         begin
+            Unnest_Subprogram (UBJ.Ent, UBJ.Bod);
+         end;
+      end loop;
+   end Unnest_Subprograms;
+
 end Exp_Ch6;
index 48b98e812e9cc4da41cb9ffecdb43f2630209c47..5cbcc965cf444afdb6f9d3f868c2f4eddcb097a8 100644 (file)
@@ -97,6 +97,13 @@ package Exp_Ch6 is
       --
       --  ??? We might also need to be able to pass in a constrained flag.
 
+   procedure Add_Extra_Actual_To_Call
+     (Subprogram_Call : Node_Id;
+      Extra_Formal    : Entity_Id;
+      Extra_Actual    : Node_Id);
+   --  Adds Extra_Actual as a named parameter association for the formal
+   --  Extra_Formal in Subprogram_Call.
+
    function BIP_Formal_Suffix (Kind : BIP_Formal_Kind) return String;
    --  Ada 2005 (AI-318-02): Returns a string to be used as the suffix of names
    --  for build-in-place formal parameters of the given kind.
@@ -109,6 +116,9 @@ package Exp_Ch6 is
    --  function Func, and returns its Entity_Id. It is a bug if not found; the
    --  caller should ensure this is called only when the extra formal exists.
 
+   procedure Initialize;
+   --  Initialize internal tables
+
    function Is_Build_In_Place_Function (E : Entity_Id) return Boolean;
    --  Ada 2005 (AI-318-02): Returns True if E denotes a function, generic
    --  function, or access-to-function type whose result must be built in
@@ -201,11 +211,9 @@ package Exp_Ch6 is
    --  parameter to identify the accessibility level of the function result
    --  "determined by the point of call".
 
-   procedure Add_Extra_Actual_To_Call
-     (Subprogram_Call : Node_Id;
-      Extra_Formal    : Entity_Id;
-      Extra_Actual    : Node_Id);
-   --  Adds Extra_Actual as a named parameter association for the formal
-   --  Extra_Formal in Subprogram_Call.
+   procedure Unnest_Subprograms;
+   --  Called to unnest subprograms. If we are in unnest subprogram mode, and
+   --  subprograms have been gathered in the Unest_Bodies table, this is the
+   --  call that causes them to be processed for unnesting.
 
 end Exp_Ch6;
index 446f3fc4e4a25198cdf9345f6e39e137cf4c2609..e80002d3361afafb2713345f90a142d6d99881c4 100644 (file)
@@ -24,6 +24,7 @@
 ------------------------------------------------------------------------------
 
 with Atree;    use Atree;
+with Debug;    use Debug;
 with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Lib;      use Lib;
@@ -31,14 +32,15 @@ with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
 with Opt;      use Opt;
+with Output;   use Output;
 with Rtsfind;  use Rtsfind;
-with Sinput;   use Sinput;
 with Sem;      use Sem;
 with Sem_Ch8;  use Sem_Ch8;
 with Sem_Mech; use Sem_Mech;
 with Sem_Res;  use Sem_Res;
 with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
+with Sinput;   use Sinput;
 with Snames;   use Snames;
 with Table;
 with Tbuild;   use Tbuild;
@@ -46,7 +48,37 @@ with Uintp;    use Uintp;
 
 package body Exp_Unst is
 
-   --  Tables used by Unnest_Subprogram
+   ---------------------------
+   -- Terminology for Calls --
+   ---------------------------
+
+   --  The level of a subprogram in the nest being analyzed is defined to be
+   --  the level of nesting, so the outer level subprogram (the one passed to
+   --  Unnest_Subprogram) is 1, subprograms immediately nested within this
+   --  outer level subprogram have a level of 2, etc.
+
+   --  Calls within the nest being analyzed are of three types:
+
+   --    Downward call: this is a call from a subprogram to a subprogram that
+   --    is immediately nested with in the caller, and thus has a level that
+   --    is one greater than the caller. It is a fundamental property of the
+   --    nesting structure and visibility that it is not possible to make a
+   --    call from level N to level M, where M is greater than N + 1.
+
+   --    Parallel call: this is a call from a nested subprogram to another
+   --    nested subprogram that is at the same level.
+
+   --    Upward call: this is a call from a subprogram to a subprogram that
+   --    encloses the caller. The level of the callee is less than the level
+   --    of the caller, and there is no limit on the difference, e.g. for an
+   --    uplevel call, a subprogram at level 5 can call one at level 2 or even
+   --    the outer level subprogram at level 1.
+
+   -----------
+   -- Subps --
+   -----------
+
+   --  Table to record subprograms within the nest being currently analyzed
 
    type Subp_Entry is record
       Ent : Entity_Id;
@@ -59,31 +91,69 @@ package body Exp_Unst is
       --  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.
+      Reachable : Boolean;
+      --  This flag is set True if there is a call path from the outer level
+      --  subprogram to this subprogram. If Reachable is False, it means that
+      --  the subprogram is declared but not actually referenced. We remove
+      --  such suprograms from the tree, which simplifies our task, because
+      --  we don't have to worry about e.g. uplevel references from such an
+      --  unreferenced subpogram, which might require (useless) activation
+      --  records to be created. This is computed by setting the outer level
+      --  subprogram (Subp itself) as reachable, and then doing a transitive
+      --  closure following all calls.
+
+      Uplevel_Ref : Nat;
+      --  The outermost level which defines entities which this subprogram
+      --  references either directly or indirectly via a call. This cannot
+      --  be greater than Lev. If it is equal to Lev, then it means that the
+      --  subprogram does not make any uplevel references and that thus it
+      --  does not need an activation record pointer passed. If it is less than
+      --  Lev, then an activation record pointer is needed, since there is at
+      --  least one uplevel reference. This is computed by initially setting
+      --  Uplevel_Ref to Lev for all subprograms. Then on the initial tree
+      --  traversal, decreasing Uplevel_Ref for an explicit uplevel reference,
+      --  and finally by doing a transitive closure that follows calls (if A
+      --  calls B and B has an uplevel reference to level X, then A references
+      --  level X indirectly).
+
+      Declares_AREC : Boolean;
+      --  This is set True for a subprogram which include the declarations
+      --  for a local activation record to bew passed on downward calls. It
+      --  is set True for the target level of an uplevel reference, and for
+      --  all intervening nested subprograms. For example, if a subprogram X
+      --  at level 5 makes an uplevel reference to an entity declared in a
+      --  level 2 subprogram, then the subprograms at levels 4,3,2 enclosing
+      --  the level 5 subprogram will have this flag set True.
+
+      Uents : Elist_Id;
+      --  This is a list of entities declared in this subprogram which are
+      --  uplevel referenced. It contains both objects (which will be put in
+      --  the corresponding AREC activation record), and types. The types are
+      --  not put in the AREC activation record, but referenced bounds (i.e.
+      --  generated _FIRST and _LAST entites, and formal parameters) will be
+      --  in the list in their own right.
 
       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.
+      --  This entity is defined for all subprograms which need an extra formal
+      --  that contains a pointer to the activation record needed for uplevel
+      --  references. ARECnF must be defined for any subprogram which has a
+      --  direct or indirect uplevel reference (i.e. Reference_Level < Lev).
 
       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.
+      --  generate an activation record declaration, i.e. for subprograms for
+      --  which the Declares_AREC flag is set True.
 
       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.
+      --  for nested subprograms that declare an activation record as indicated
+      --  by Declares_AREC being Ture, and which have uplevel references (Lev
+      --  greater than Uplevel_Ref). It is the additional component in the
+      --  activation record that references the ARECnF pointer (which points
+      --  the activation record one level higher, thus forming the chain).
 
    end record;
 
@@ -98,15 +168,24 @@ package body Exp_Unst is
      Table_Name           => "Unnest_Subps");
    --  Records the subprograms in the nest whose outer subprogram is Subp
 
+   -----------
+   -- Calls --
+   -----------
+
+   --  Table to record calls within the nest being analyzed. These are the
+   --  calls which may need to have an AREC actual added.
+
    type Call_Entry is record
       N : Node_Id;
       --  The actual call
 
-      From : Entity_Id;
-      --  Entity of the subprogram containing the call
+      Caller : Entity_Id;
+      --  Entity of the subprogram containing the call (can be at any level)
 
-      To : Entity_Id;
-      --  Entity of the subprogram called
+      Callee : Entity_Id;
+      --  Entity of the subprogram called (always at level 2 or higher). Note
+      --  that in accordance with the basic rules of nesting, the level of To
+      --  is either less than or equal to the level of From, or one greater.
    end record;
 
    package Calls is new Table.Table (
@@ -120,227 +199,48 @@ package body Exp_Unst is
    --  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 --
-   -------------------------------------
-
-   procedure Check_Uplevel_Reference_To_Type (Typ : Entity_Id) is
-      function Check_Dynamic_Type (T : Entity_Id) return Boolean;
-      --  This is an internal recursive routine that checks if T or any of
-      --  its subsdidiary types are dynamic. If so, then the original Typ is
-      --  marked as having an uplevel reference, as is the subsidiary type in
-      --  question, and any referenced dynamic bounds are also marked as having
-      --  an uplevel reference, and True is returned. If the type is a static
-      --  type, then False is returned;
-
-      ------------------------
-      -- Check_Dynamic_Type --
-      ------------------------
-
-      function Check_Dynamic_Type (T : Entity_Id) return Boolean is
-         DT : Boolean := False;
-
-      begin
-         --  If it's a static type, nothing to do
-
-         if Is_Static_Type (T) then
-            return False;
-
-         --  If the type is uplevel referenced, then it must be dynamic
-
-         elsif Has_Uplevel_Reference (T) then
-            Set_Has_Uplevel_Reference (Typ);
-            return True;
-
-         --  If the type is at library level, always consider it static, since
-         --  uplevel references do not matter in this case.
-
-         elsif Is_Library_Level_Entity (T) then
-            Set_Is_Static_Type (T);
-            return False;
-
-         --  Otherwise we need to figure out what the story is with this type
-
-         else
-            DT := False;
-
-            --  For a scalar type, check bounds
-
-            if Is_Scalar_Type (T) then
-
-               --  If both bounds static, then this is a static type
-
-               declare
-                  LB : constant Node_Id := Type_Low_Bound (T);
-                  UB : constant Node_Id := Type_High_Bound (T);
-
-               begin
-                  if not Is_Static_Expression (LB) then
-                     Set_Has_Uplevel_Reference (Entity (LB));
-                     DT := True;
-                  end if;
-
-                  if not Is_Static_Expression (UB) then
-                     Set_Has_Uplevel_Reference (Entity (UB));
-                     DT := True;
-                  end if;
-               end;
-
-            --  For record type, check all components
-
-            elsif Is_Record_Type (T) then
-               declare
-                  C : Entity_Id;
-
-               begin
-                  C := First_Component_Or_Discriminant (T);
-                  while Present (C) loop
-                     if Check_Dynamic_Type (Etype (C)) then
-                        DT := True;
-                     end if;
-
-                     Next_Component_Or_Discriminant (C);
-                  end loop;
-               end;
-
-            --  For array type, check index types and component type
-
-            elsif Is_Array_Type (T) then
-               declare
-                  IX : Node_Id;
-
-               begin
-                  if Check_Dynamic_Type (Component_Type (T)) then
-                     DT := True;
-                  end if;
-
-                  IX := First_Index (T);
-                  while Present (IX) loop
-                     if Check_Dynamic_Type (Etype (IX)) then
-                        DT := True;
-                     end if;
-
-                     Next_Index (IX);
-                  end loop;
-               end;
-
-            --  For now, ignore other types
-
-            else
-               return False;
-            end if;
-
-            --  See if we marked that type as dynamic
-
-            if DT then
-               Set_Has_Uplevel_Reference (T);
-               Set_Has_Uplevel_Reference (Typ);
-               return True;
-
-            --  If not mark it as static
-
-            else
-               Set_Is_Static_Type (T);
-               return False;
-            end if;
-         end if;
-      end Check_Dynamic_Type;
-
-   --  Start of processing for Check_Uplevel_Reference_To_Type
-
-   begin
-      --  Nothing to do inside a generic (all processing is for instance)
-
-      if Inside_A_Generic then
-         return;
-
-      --  Nothing to do if we know this is a static type
-
-      elsif Is_Static_Type (Typ) then
-         return;
-
-      --  Nothing to do if already marked as uplevel referenced
-
-      elsif Has_Uplevel_Reference (Typ) then
-         return;
-
-      --  Otherwise check if we have a dynamic type
-
-      else
-         if Check_Dynamic_Type (Typ) then
-            Set_Has_Uplevel_Reference (Typ);
-         end if;
-      end if;
-
-      null;
-   end Check_Uplevel_Reference_To_Type;
+   -----------
+   -- Urefs --
+   -----------
 
-   ----------------------------
-   -- Note_Uplevel_Reference --
-   ----------------------------
+   --  Table to record explicit uplevel references to objects (variables,
+   --  constants, formal parameters). These are the references that will
+   --  need rewriting to use the activation table (AREC) pointers. Also
+   --  included are implicit and explicit uplevel references to types, but
+   --  these do not get rewritten by the front end.
 
-   procedure Note_Uplevel_Reference (N : Node_Id; Subp : Entity_Id) is
-      Elmt : Elmt_Id;
+   type Uref_Entry is record
+      Ref : Node_Id;
+      --  The reference itself. For objects this is always an entity reference
+      --  and the referenced entity will have its Is_Uplevel_Referenced_Entity
+      --  flag set and will appear in the Uplevel_Referenced_Entities list of
+      --  the subprogram declaring this entity.
 
-   begin
-      --  Nothing to do inside a generic (all processing is for instance)
-
-      if Inside_A_Generic then
-         return;
-      end if;
-
-      --  Nothing to do if reference has no entity field
-
-      if Nkind (N) not in N_Has_Entity then
-         return;
-      end if;
-
-      --  Establish list if first call for Uplevel_References
-
-      if No (Uplevel_References (Subp)) then
-         Set_Uplevel_References (Subp, New_Elmt_List);
-      end if;
-
-      --  Ignore if node is already in the list. This is a bit inefficient,
-      --  but we can definitely get duplicates that cause trouble!
-
-      Elmt := First_Elmt (Uplevel_References (Subp));
-      while Present (Elmt) loop
-         if N = Node (Elmt) then
-            return;
-         else
-            Next_Elmt (Elmt);
-         end if;
-      end loop;
-
-      --  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
+      Ent : Entity_Id;
+      --  The Entity_Id of the uplevel referenced object or type
 
-      Append_Elmt (N, Uplevel_References (Subp));
+      Caller : Entity_Id;
+      --  The entity for the subprogram immediately containing this entity
 
-      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;
+      Callee : Entity_Id;
+      --  The entity for the subprogram containing the referenced entity. Note
+      --  that the level of Callee must be less than the level of Caller, since
+      --  this is uplevel reference.
+   end record;
 
-      Set_Has_Uplevel_Reference (Entity (N));
-      Set_Has_Uplevel_Reference (Subp);
-   end Note_Uplevel_Reference;
+   package Urefs is new Table.Table (
+     Table_Component_Type => Uref_Entry,
+     Table_Index_Type     => Nat,
+     Table_Low_Bound      => 1,
+     Table_Initial        => 100,
+     Table_Increment      => 200,
+     Table_Name           => "Unnest_Urefs");
 
    -----------------------
    -- Unnest_Subprogram --
    -----------------------
 
    procedure Unnest_Subprogram (Subp : Entity_Id; Subp_Body : Node_Id) is
-      function Actual_Ref (N : Node_Id) return Node_Id;
-      --  This function is applied to an element in the Uplevel_References
-      --  list, and it finds the actual reference. Often this is just N itself,
-      --  but in some cases it gets rewritten, e.g. as a Type_Conversion, and
-      --  this function digs out the actual reference
-
       function AREC_String (Lev : Pos) return String;
       --  Given a level value, 1, 2, ... returns the string AREC, AREC2, ...
 
@@ -357,43 +257,14 @@ package body Exp_Unst is
       function Subp_Index (Sub : Entity_Id) return SI_Type;
       --  Given the entity for a subprogram, return corresponding Subps index
 
-      function Upref_Name (Ent : Entity_Id) return Name_Id;
+      function Upref_Name (Ent : Entity_Id; Clist : List_Id) return Name_Id;
       --  This function returns the name to be used in the activation record to
-      --  reference the variable uplevel. Normally this is just a copy of the
-      --  Chars field of the entity. The exception is when the scope of Ent
-      --  is a declare block, in which case we append the entity number to
-      --  make sure that no confusion occurs between use of the same name
-      --  in different declare blocks.
-
-      ----------------
-      -- Actual_Ref --
-      ----------------
-
-      function Actual_Ref (N : Node_Id) return Node_Id is
-      begin
-         case Nkind (N) is
-
-            --  If we have an entity reference, then this is the actual ref
-
-            when N_Has_Entity =>
-               return N;
-
-            --  For a type conversion, go get the expression
-
-            when N_Type_Conversion =>
-               return Expression (N);
-
-            --  For an explicit dereference, get the prefix
-
-            when N_Explicit_Dereference =>
-               return Prefix (N);
-
-            --  No other possibilities should exist
-
-            when others =>
-               raise Program_Error;
-         end case;
-      end Actual_Ref;
+      --  reference the variable uplevel. Clist is the list of components that
+      --  have been created in the activation record so far. Normally this is
+      --  just a copy of the Chars field of the entity. The exception is when
+      --  the name has already been used, in which case we suffix the name with
+      --  the entity number to avoid duplication. This happens with declare
+      --  blocks and generic parameters at least.
 
       -----------------
       -- AREC_String --
@@ -456,17 +327,25 @@ package body Exp_Unst is
       -- Upref_Name --
       ----------------
 
-      function Upref_Name (Ent : Entity_Id) return Name_Id is
+      function Upref_Name (Ent : Entity_Id; Clist : List_Id) return Name_Id is
+         C : Node_Id;
+
       begin
-         if Ekind (Scope (Ent)) /= E_Block then
-            return Chars (Ent);
+         C := First (Clist);
+         loop
+            if No (C) then
+               return Chars (Ent);
 
-         else
-            Get_Name_String (Chars (Ent));
-            Add_Str_To_Name_Buffer ("__");
-            Add_Nat_To_Name_Buffer (Nat (Ent));
-            return Name_Enter;
-         end if;
+            elsif Chars (Defining_Identifier (C)) = Chars (Ent) then
+               Get_Name_String (Chars (Ent));
+               Add_Str_To_Name_Buffer ("__");
+               Add_Nat_To_Name_Buffer (Nat (Ent));
+               return Name_Enter;
+
+            else
+               Next (C);
+            end if;
+         end loop;
       end Upref_Name;
 
    --  Start of processing for Unnest_Subprogram
@@ -477,15 +356,22 @@ package body Exp_Unst is
       if Inside_A_Generic then
          return;
       end if;
+
       --  At least for now, do not unnest anything but main source unit
 
       if not In_Extended_Main_Source_Unit (Subp_Body) then
          return;
       end if;
 
+      --  This routine is called late, after the scope stack is gone. The
+      --  following creates a suitable dummy scope stack to be used for the
+      --  analyze/expand calls made from this routine.
+
+      Push_Scope (Subp);
+
       --  First step, we must mark all nested subprograms that require a static
       --  link (activation record) because either they contain explicit uplevel
-      --  references (as indicated by Has_Uplevel_Reference being set at this
+      --  references (as indicated by ??? being set at this
       --  point), or they make calls to other subprograms in the same nest that
       --  require a static link (in which case we set this flag).
 
@@ -499,43 +385,194 @@ package body Exp_Unst is
 
       Subps.Init;
       Calls.Init;
+      Urefs.Init;
 
       Build_Tables : declare
+         Current_Subprogram : Entity_Id;
+         --  When we scan a subprogram body, we set Current_Subprogram to the
+         --  corresponding entity. This gets recursively saved and restored.
+
          function Visit_Node (N : Node_Id) return Traverse_Result;
          --  Visit a single node in Subp
 
+         -----------
+         -- Visit --
+         -----------
+
+         procedure Visit is new Traverse_Proc (Visit_Node);
+         --  Used to traverse the body of Subp, populating the tables
+
          ----------------
          -- Visit_Node --
          ----------------
 
          function Visit_Node (N : Node_Id) return Traverse_Result is
-            Ent  : Entity_Id;
-            Csub : Entity_Id;
+            Ent    : Entity_Id;
+            Caller : Entity_Id;
+            Callee : Entity_Id;
+
+            procedure Check_Static_Type (T : Entity_Id; DT : in out Boolean);
+               --  Given a type T, checks if it is a static type defined as a
+               --  type with no dynamic bounds in sight. If so, the only action
+               --  is to set Is_Static_Type True for T. If T is not a static
+               --  type, then all types with dynamic bounds associated with
+               --  T are detected, and their bounds are marked as uplevel
+               --  referenced if not at the library level, and DT is set True.
+
+            procedure Note_Uplevel_Ref
+              (E      : Entity_Id;
+               Caller : Entity_Id;
+               Callee : Entity_Id);
+            --  Called when we detect an explicit or implicit uplevel reference
+            --  from within Caller to entity E declared in Callee. E can be a
+            --  an object or a type.
+
+            -----------------------
+            -- Check_Static_Type --
+            -----------------------
+
+            procedure Check_Static_Type (T : Entity_Id; DT : in out Boolean) is
+               procedure Note_Uplevel_Bound (N : Node_Id);
+               --  N is the bound of a dynamic type. This procedure notes that
+               --  this bound is uplevel referenced, it can handle references
+               --  to entities (typically _FIRST and _LAST entities), and also
+               --  attribute references of the form T'name (name is typically
+               --  FIRST or LAST) where T is the uplevel referenced bound.
+
+               ------------------------
+               -- Note_Uplevel_Bound --
+               ------------------------
+
+               procedure Note_Uplevel_Bound (N : Node_Id) is
+               begin
+                  --  Entity name case
+
+                  if Is_Entity_Name (N) then
+                     if Present (Entity (N)) then
+                        Note_Uplevel_Ref
+                          (E      => Entity (N),
+                           Caller => Current_Subprogram,
+                           Callee => Enclosing_Subprogram (Entity (N)));
+                     end if;
 
-            function Find_Current_Subprogram return Entity_Id;
-            --  Finds the current subprogram containing the call N
+                  --  Attribute case
 
-            -----------------------------
-            -- Find_Current_Subprogram --
-            -----------------------------
+                  elsif Nkind (N) = N_Attribute_Reference then
+                     Note_Uplevel_Bound (Prefix (N));
+                  end if;
+               end Note_Uplevel_Bound;
 
-            function Find_Current_Subprogram return Entity_Id is
-               Nod : Node_Id;
+            --  Start of processing for Check_Static_Type
 
             begin
-               Nod := N;
-               loop
-                  Nod := Parent (Nod);
+               --  If already marked static, immediate return
 
-                  if Nkind (Nod) = N_Subprogram_Body then
-                     if Acts_As_Spec (Nod) then
-                        return Defining_Entity (Specification (Nod));
-                     else
-                        return Corresponding_Spec (Nod);
+               if Is_Static_Type (T) then
+                  return;
+               end if;
+
+               --  If the type is at library level, always consider it static,
+               --  since such uplevel references are irrelevant.
+
+               if Is_Library_Level_Entity (T) then
+                  Set_Is_Static_Type (T);
+                  return;
+               end if;
+
+               --  Otherwise figure out what the story is with this type
+
+               --  For a scalar type, check bounds
+
+               if Is_Scalar_Type (T) then
+
+                  --  If both bounds static, then this is a static type
+
+                  declare
+                     LB : constant Node_Id := Type_Low_Bound (T);
+                     UB : constant Node_Id := Type_High_Bound (T);
+
+                  begin
+                     if not Is_Static_Expression (LB) then
+                        Note_Uplevel_Bound (LB);
+                        DT := True;
                      end if;
-                  end if;
-               end loop;
-            end Find_Current_Subprogram;
+
+                     if not Is_Static_Expression (UB) then
+                        Note_Uplevel_Bound (UB);
+                        DT := True;
+                     end if;
+                  end;
+
+                  --  For record type, check all components
+
+               elsif Is_Record_Type (T) then
+                  declare
+                     C : Entity_Id;
+                  begin
+                     C := First_Component_Or_Discriminant (T);
+                     while Present (C) loop
+                        Check_Static_Type (Etype (C), DT);
+                        Next_Component_Or_Discriminant (C);
+                     end loop;
+                  end;
+
+                  --  For array type, check index types and component type
+
+               elsif Is_Array_Type (T) then
+                  declare
+                     IX : Node_Id;
+                  begin
+                     Check_Static_Type (Component_Type (T), DT);
+
+                     IX := First_Index (T);
+                     while Present (IX) loop
+                        Check_Static_Type (Etype (IX), DT);
+                        Next_Index (IX);
+                     end loop;
+                  end;
+
+               --  For now, ignore other types
+
+               else
+                  return;
+               end if;
+
+               if not DT then
+                  Set_Is_Static_Type (T);
+               end if;
+            end Check_Static_Type;
+
+            ----------------------
+            -- Note_Uplevel_Ref --
+            ----------------------
+
+            procedure Note_Uplevel_Ref
+              (E      : Entity_Id;
+               Caller : Entity_Id;
+               Callee : Entity_Id)
+            is
+            begin
+               --  Nothing to do for static type
+
+               if Is_Static_Type (E) then
+                  return;
+               end if;
+
+               --  Nothing to do if Caller and Callee are the same
+
+               if Caller = Callee then
+                  return;
+               end if;
+
+               --  We have a new uplevel referenced entity
+
+               --  All we do at this stage is to add the uplevel reference to
+               --  the table. It's too earch to do anything else, since this
+               --  uplevel reference may come from an unreachable subprogram
+               --  in which case the entry will be deleted.
+
+               Urefs.Append ((N, E, Caller, Callee));
+            end Note_Uplevel_Ref;
 
          --  Start of processing for Visit_Node
 
@@ -557,29 +594,18 @@ package body Exp_Unst is
 
                if Scope_Within (Ent, Subp) then
 
-                  --  For now, ignore calls to generic instances. Seems to be
-                  --  some problem there which we will investigate later ???
-
-                  if Original_Location (Sloc (Ent)) /= Sloc (Ent)
-                    or else Is_Generic_Instance (Ent)
-                  then
-                     null;
-
                   --  Ignore calls to imported routines
 
-                  elsif Is_Imported (Ent) then
+                  if Is_Imported (Ent) then
                      null;
 
                   --  Here we have a call to keep and analyze
 
                   else
-                     Csub := Find_Current_Subprogram;
+                     --  Both caller and callee must be subprograms
 
-                     --  Both caller and callee must be subprograms (we ignore
-                     --  generic subprograms).
-
-                     if Is_Subprogram (Csub) and then Is_Subprogram (Ent) then
-                        Calls.Append ((N, Find_Current_Subprogram, Ent));
+                     if Is_Subprogram (Ent) then
+                        Calls.Append ((N, Current_Subprogram, Ent));
                      end if;
                   end if;
                end if;
@@ -589,103 +615,425 @@ package body Exp_Unst is
             --  that it has a corresponding body we can get hold of. The case
             --  of no corresponding body being available is ignored for now.
 
-            elsif (Nkind (N) = N_Subprogram_Body and then Acts_As_Spec (N))
-              or else (Nkind (N) = N_Subprogram_Declaration
-                        and then Present (Corresponding_Body (N)))
-            then
-               Subps.Increment_Last;
+            elsif Nkind (N) = N_Subprogram_Body then
+               Ent := Corresponding_Spec_Of (N);
+
+               --  Ignore generic subprogram
+
+               if Is_Generic_Subprogram (Ent) then
+                  return Skip;
+               end if;
+
+               --  Make new entry in subprogram table if not already made
+
+               declare
+                  L : constant Nat := Get_Level (Ent);
+               begin
+                  Subps.Append
+                    ((Ent           => Ent,
+                      Bod           => N,
+                      Lev           => L,
+                      Reachable     => False,
+                      Uplevel_Ref   => L,
+                      Declares_AREC => False,
+                      Uents         => No_Elist,
+                      ARECnF        => Empty,
+                      ARECn         => Empty,
+                      ARECnT        => Empty,
+                      ARECnPT       => Empty,
+                      ARECnP        => Empty,
+                      ARECnU        => Empty));
+                  Set_Subps_Index (Ent, UI_From_Int (Subps.Last));
+               end;
+
+               --  We make a recursive call to scan the subprogram body, so
+               --  that we can save and restore Current_Subprogram.
 
                declare
-                  STJ : Subp_Entry renames Subps.Table (Subps.Last);
+                  Save_CS : constant Entity_Id := Current_Subprogram;
+                  Decl    : Node_Id;
 
                begin
-                  --  Set fields of Subp_Entry for new subprogram
+                  Current_Subprogram := Ent;
 
-                  STJ.Ent := Defining_Entity (Specification (N));
-                  STJ.Lev := Get_Level (STJ.Ent);
+                  --  Scan declarations
 
-                  if Nkind (N) = N_Subprogram_Body then
-                     STJ.Bod := N;
-                  else
-                     STJ.Bod :=
-                       Parent (Declaration_Node (Corresponding_Body (N)));
-                     pragma Assert (Nkind (STJ.Bod) = N_Subprogram_Body);
-                  end if;
+                  Decl := First (Declarations (N));
+                  while Present (Decl) loop
+                     Visit (Decl);
+                     Next (Decl);
+                  end loop;
+
+                  --  Scan statements
+
+                  Visit (Handled_Statement_Sequence (N));
 
-                  --  Capture Uplevel_References, and then set (uses the same
-                  --  field), the Subps_Index value for this subprogram.
+                  --  Restore current subprogram setting
 
-                  STJ.Urefs := Uplevel_References (STJ.Ent);
-                  Set_Subps_Index (STJ.Ent, UI_From_Int (Int (Subps.Last)));
+                  Current_Subprogram := Save_CS;
                end;
+
+               --  Now at this level, return skipping the subprogram body
+               --  descendents, since we already took care of them!
+
+               return Skip;
+
+            --  Record an uplevel reference
+
+            elsif Nkind (N) in N_Has_Entity and then Present (Entity (N)) then
+               Ent := Entity (N);
+
+               --  Only interested in entities declared within our nest
+
+               if not Is_Library_Level_Entity (Ent)
+                 and then Scope_Within_Or_Same (Scope (Ent), Subp)
+                 and then
+
+                   --  Constants and variables are interesting
+
+                   (Ekind_In (Ent, E_Constant, E_Variable)
+
+                     --  Formals are interesting, but not if being used as mere
+                     --  names of parameters for name notation calls.
+
+                     or else
+                       (Is_Formal (Ent)
+                         and then not
+                          (Nkind (Parent (N)) = N_Parameter_Association
+                            and then Selector_Name (Parent (N)) = N))
+
+                     --  Types other than known Is_Static types are interesting
+
+                     or else (Is_Type (Ent)
+                               and then not Is_Static_Type (Ent)))
+               then
+                  --  Here we have a possible interesting uplevel reference
+
+                  if Is_Type (Ent) then
+                     declare
+                        DT : Boolean := False;
+
+                     begin
+                        Check_Static_Type (Ent, DT);
+
+                        if Is_Static_Type (Ent) then
+                           return OK;
+                        end if;
+                     end;
+                  end if;
+
+                  Caller := Current_Subprogram;
+                  Callee := Enclosing_Subprogram (Ent);
+
+                  if Callee /= Caller and then not Is_Static_Type (Ent) then
+                     Note_Uplevel_Ref (Ent, Caller, Callee);
+                  end if;
+               end if;
+
+            --  Skip generic declarations
+
+            elsif Nkind (N) in N_Generic_Declaration then
+               return Skip;
+
+            --  Skip generic package body
+
+            elsif Nkind (N) = N_Package_Body
+              and then Present (Corresponding_Spec (N))
+              and then Ekind (Corresponding_Spec (N)) = E_Generic_Package
+            then
+               return Skip;
             end if;
 
+            --  Fall through to continue scanning children of this node
+
             return OK;
          end Visit_Node;
 
-         -----------
-         -- Visit --
-         -----------
-
-         procedure Visit is new Traverse_Proc (Visit_Node);
-         --  Used to traverse the body of Subp, populating the tables
-
       --  Start of processing for Build_Tables
 
       begin
-         --  A special case, if the outer level subprogram has a separate spec
-         --  then we won't catch it in the traversal of the body. But we do
-         --  want to visit the declaration in this case!
-
-         if not Acts_As_Spec (Subp_Body) then
-            declare
-               Dummy : Traverse_Result;
-               Decl  : constant Node_Id :=
-                 Parent (Declaration_Node (Corresponding_Spec (Subp_Body)));
-               pragma Assert (Nkind (Decl) = N_Subprogram_Declaration);
-            begin
-               Dummy := Visit_Node (Decl);
-            end;
-         end if;
-
-         --  Traverse the body to get the rest of the subprograms and calls
+         --  Traverse the body to get subprograms, calls and uplevel references
 
          Visit (Subp_Body);
       end Build_Tables;
 
-      --  Second step is to do the transitive closure, if any subprogram has
-      --  a call to a subprogram for which Has_Uplevel_Reference is set, then
-      --  we set Has_Uplevel_Reference for the calling routine.
+      --  Now do the first transitive closure which determines which
+      --  subprograms in the nest are actually reachable.
 
-      Closure : declare
+      Reachable_Closure : declare
          Modified : Boolean;
 
       begin
+         Subps.Table (1).Reachable := True;
+
          --  We use a simple minded algorithm as follows (obviously this can
          --  be done more efficiently, using one of the standard algorithms
          --  for efficient transitive closure computation, but this is simple
          --  and most likely fast enough that its speed does not matter).
 
          --  Repeatedly scan the list of calls. Any time we find a call from
-         --  A to B, where A does not have Has_Uplevel_Reference, and B does
-         --  have this flag set, then set the flag for A, and note that we
-         --  have made a change by setting Modified True. We repeat this until
-         --  we make a pass with no modifications.
+         --  A to B, where A is reachable, but B is not, then B is reachable,
+         --  and note that we have made a change by setting Modified True. We
+         --  repeat this until we make a pass with no modifications.
 
          Outer : loop
             Modified := False;
             Inner : for J in Calls.First .. Calls.Last loop
-               if not Has_Uplevel_Reference (Calls.Table (J).From)
-                 and then Has_Uplevel_Reference (Calls.Table (J).To)
-               then
-                  Set_Has_Uplevel_Reference (Calls.Table (J).From);
-                  Modified := True;
-               end if;
+               declare
+                  CTJ : Call_Entry renames Calls.Table (J);
+
+                  SINF : constant SI_Type := Subp_Index (CTJ.Caller);
+                  SINT : constant SI_Type := Subp_Index (CTJ.Callee);
+
+                  SUBF : Subp_Entry renames Subps.Table (SINF);
+                  SUBT : Subp_Entry renames Subps.Table (SINT);
+
+               begin
+                  if SUBF.Reachable and then not SUBT.Reachable then
+                     SUBT.Reachable := True;
+                     Modified := True;
+                  end if;
+               end;
             end loop Inner;
 
             exit Outer when not Modified;
          end loop Outer;
-      end Closure;
+      end Reachable_Closure;
+
+      --  Remove calls from unreachable subprograms
+
+      declare
+         New_Index : Nat;
+
+      begin
+         New_Index := 0;
+         for J in Calls.First .. Calls.Last loop
+            declare
+               CTJ : Call_Entry renames Calls.Table (J);
+
+               SINF : constant SI_Type := Subp_Index (CTJ.Caller);
+               SINT : constant SI_Type := Subp_Index (CTJ.Callee);
+
+               SUBF : Subp_Entry renames Subps.Table (SINF);
+               SUBT : Subp_Entry renames Subps.Table (SINT);
+
+            begin
+               if SUBF.Reachable then
+                  pragma Assert (SUBT.Reachable);
+                  New_Index := New_Index + 1;
+                  Calls.Table (New_Index) := Calls.Table (J);
+               end if;
+            end;
+         end loop;
+
+         Calls.Set_Last (New_Index);
+      end;
+
+      --  Remove uplevel references from unreachable subprograms
+
+      declare
+         New_Index : Nat;
+
+      begin
+         New_Index := 0;
+         for J in Urefs.First .. Urefs.Last loop
+            declare
+               URJ : Uref_Entry renames Urefs.Table (J);
+
+               SINF : constant SI_Type := Subp_Index (URJ.Caller);
+               SINT : constant SI_Type := Subp_Index (URJ.Callee);
+
+               SUBF : Subp_Entry renames Subps.Table (SINF);
+               SUBT : Subp_Entry renames Subps.Table (SINT);
+
+               S : Entity_Id;
+
+            begin
+               --  Keep reachable reference
+
+               if SUBF.Reachable then
+                  New_Index := New_Index + 1;
+                  Urefs.Table (New_Index) := Urefs.Table (J);
+
+                  --  And since we know we are keeping this one, this is a good
+                  --  place to fill in information for a good reference.
+
+                  --  Mark all enclosing subprograms need to declare AREC
+
+                  S := URJ.Caller;
+                  loop
+                     S := Enclosing_Subprogram (S);
+                     Subps.Table (Subp_Index (S)).Declares_AREC := True;
+                     exit when S = URJ.Callee;
+                  end loop;
+
+                  --  Add to list of uplevel referenced entities for Callee.
+                  --  We do not add types to this list, only actual references
+                  --  to objects that will be referenced uplevel, and we use
+                  --  the flag Is_Uplevel_Referenced_Entity to avoid making
+                  --  duplicate entries in the list.
+
+                  if not Is_Uplevel_Referenced_Entity (URJ.Ent) then
+                     Set_Is_Uplevel_Referenced_Entity (URJ.Ent);
+
+                     if not Is_Type (URJ.Ent) then
+                        Append_New_Elmt (URJ.Ent, SUBT.Uents);
+                     end if;
+                  end if;
+
+                  --  And set uplevel indication for caller
+
+                  if SUBT.Lev < SUBF.Uplevel_Ref then
+                     SUBF.Uplevel_Ref := SUBT.Lev;
+                  end if;
+               end if;
+            end;
+         end loop;
+
+         Urefs.Set_Last (New_Index);
+      end;
+
+      --  Remove unreachable subprograms from Subps table. Note that we do
+      --  this after eliminating entries from the other two tables, since
+      --  thos elimination steps depend on referencing the Subps table.
+
+      declare
+         New_SI : SI_Type;
+
+      begin
+         New_SI := 0;
+         for J in Subps.First .. Subps.Last loop
+            declare
+               STJ  : Subp_Entry renames Subps.Table (J);
+               Spec : Node_Id;
+               Decl : Node_Id;
+
+            begin
+               --  Subprogram is reachable, copy and reset index
+
+               if STJ.Reachable then
+                  New_SI := New_SI + 1;
+                  Subps.Table (New_SI) := STJ;
+                  Set_Subps_Index (STJ.Ent, UI_From_Int (New_SI));
+
+               --  Subprogram is not reachable
+
+               else
+                  --  Clear index, since no longer active
+
+                  Set_Subps_Index (Subps.Table (J).Ent, Uint_0);
+
+                  --  Output debug information if -gnatd.3 set
+
+                  if Debug_Flag_Dot_3 then
+                     Write_Str ("Eliminate ");
+                     Write_Name (Chars (Subps.Table (J).Ent));
+                     Write_Str (" at ");
+                     Write_Location (Sloc (Subps.Table (J).Ent));
+                     Write_Str (" (not referenced)");
+                     Write_Eol;
+                  end if;
+
+                  --  Rewrite declaration and body to null statements
+
+                  Spec := Corresponding_Spec (STJ.Bod);
+
+                  if Present (Spec) then
+                     Decl := Parent (Declaration_Node (Spec));
+                     Rewrite (Decl, Make_Null_Statement (Sloc (Decl)));
+                  end if;
+
+                  Rewrite (STJ.Bod, Make_Null_Statement (Sloc (STJ.Bod)));
+               end if;
+            end;
+         end loop;
+
+         Subps.Set_Last (New_SI);
+      end;
+
+      --  Now it is time for the second transitive closure, which follows calls
+      --  and makes sure that A calls B, and B has uplevel references, then A
+      --  is also marked as having uplevel references.
+
+      Closure_Uplevel : declare
+         Modified : Boolean;
+
+      begin
+         --  We use a simple minded algorithm as follows (obviously this can
+         --  be done more efficiently, using one of the standard algorithms
+         --  for efficient transitive closure computation, but this is simple
+         --  and most likely fast enough that its speed does not matter).
+
+         --  Repeatedly scan the list of calls. Any time we find a call from
+         --  A to B, where B has uplevel references, make sure that A is marked
+         --  as having at least the same level of uplevel referencing.
+
+         Outer2 : loop
+            Modified := False;
+            Inner2 : for J in Calls.First .. Calls.Last loop
+               declare
+                  CTJ  : Call_Entry renames Calls.Table (J);
+                  SINF : constant SI_Type := Subp_Index (CTJ.Caller);
+                  SINT : constant SI_Type := Subp_Index (CTJ.Callee);
+                  SUBF : Subp_Entry renames Subps.Table (SINF);
+                  SUBT : Subp_Entry renames Subps.Table (SINT);
+               begin
+                  if SUBT.Lev > SUBT.Uplevel_Ref
+                    and then SUBF.Uplevel_Ref > SUBT.Uplevel_Ref
+                  then
+                     SUBF.Uplevel_Ref := SUBT.Uplevel_Ref;
+                     Modified := True;
+                  end if;
+               end;
+            end loop Inner2;
+
+            exit Outer2 when not Modified;
+         end loop Outer2;
+      end Closure_Uplevel;
+
+      --  We have one more step before the tables are complete. An uplevel
+      --  call from subprogram A to subprogram B where subprogram B has uplevel
+      --  references is in effect an uplevel reference, and must arrange for
+      --  the proper activation link to be passed.
+
+      for J in Calls.First .. Calls.Last loop
+         declare
+            CTJ : Call_Entry renames Calls.Table (J);
+
+            SINF : constant SI_Type := Subp_Index (CTJ.Caller);
+            SINT : constant SI_Type := Subp_Index (CTJ.Callee);
+
+            SUBF : Subp_Entry renames Subps.Table (SINF);
+            SUBT : Subp_Entry renames Subps.Table (SINT);
+
+            A : Entity_Id;
+
+         begin
+            --  If callee has uplevel references
+
+            if SUBT.Uplevel_Ref < SUBT.Lev
+
+              --  And this is an uplevel call
+
+              and then SUBT.Lev < SUBF.Lev
+            then
+               --  We need to arrange for finding the uplink
+
+               A := CTJ.Caller;
+               loop
+                  A := Enclosing_Subprogram (A);
+                  Subps.Table (Subp_Index (A)).Declares_AREC := True;
+                  exit when A = CTJ.Callee;
+
+                  --  In any case exit when we get to the outer level. This
+                  --  happens in some odd cases with generics (in particular
+                  --  sem_ch3.adb does not compile without this kludge ???).
+
+                  exit when A = Subp;
+               end loop;
+            end if;
+         end;
+      end loop;
 
       --  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
@@ -698,30 +1046,18 @@ package body Exp_Unst is
             ARS : constant String     := AREC_String (STJ.Lev);
 
          begin
-            --  First we create the ARECnF entity for the additional formal
-            --  for all subprograms requiring that an activation record pointer
-            --  be passed. This is true of all subprograms that have uplevel
-            --  references, and whose enclosing subprogram also has uplevel
-            --  references.
-
-            if Has_Uplevel_Reference (STJ.Ent)
-              and then STJ.Ent /= Subp
-              and then Has_Uplevel_Reference (Enclosing_Subprogram (STJ.Ent))
-            then
+            --  First we create the ARECnF entity for the additional formal for
+            --  all subprograms which need an activation record passed.
+
+            if STJ.Uplevel_Ref < STJ.Lev then
                STJ.ARECnF :=
                  Make_Defining_Identifier (Loc,
                    Chars => Name_Find_Str (AREC_String (STJ.Lev - 1) & "F"));
-            else
-               STJ.ARECnF := Empty;
             end if;
 
-            --  Now define the AREC entities for the activation record. This
-            --  is needed for any subprogram that has nested subprograms and
-            --  has uplevel references.
+            --  Define the AREC entities for the activation record if needed
 
-            if Has_Nested_Subprogram (STJ.Ent)
-              and then Has_Uplevel_Reference (STJ.Ent)
-            then
+            if STJ.Declares_AREC then
                STJ.ARECn   :=
                  Make_Defining_Identifier (Loc, Name_Find_Str (ARS));
                STJ.ARECnT  :=
@@ -731,27 +1067,17 @@ package body Exp_Unst is
                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
-
-            if Has_Uplevel_Reference (STJ.Ent) and then STJ.Lev > 1 then
-               declare
-                  ARS1 : constant String := AREC_String (STJ.Lev - 1);
-               begin
-                  STJ.ARECnU :=
-                    Make_Defining_Identifier (Loc,
-                      Chars => Name_Find_Str (ARS1 & "U"));
-               end;
+               --  Define uplink component entity if inner nesting case
 
-            else
-               STJ.ARECnU := Empty;
+               if Present (STJ.ARECnF) then
+                  declare
+                     ARS1 : constant String := AREC_String (STJ.Lev - 1);
+                  begin
+                     STJ.ARECnU :=
+                       Make_Defining_Identifier (Loc,
+                         Chars => Name_Find_Str (ARS1 & "U"));
+                  end;
+               end if;
             end if;
          end;
       end loop Create_Entities;
@@ -850,19 +1176,14 @@ package body Exp_Unst is
                   end Add_Extra_Formal;
                end if;
 
-               --  Processing for subprograms that have at least one nested
-               --  subprogram, and have uplevel references.
+               --  Processing for subprograms that declare an activation record
+
+               if Present (STJ.ARECn) then
 
-               if Has_Nested_Subprogram (STJ.Ent)
-                 and then Has_Uplevel_Reference (STJ.Ent)
-               then
                   --  Local declarations for one such subprogram
 
                   declare
                      Loc   : constant Source_Ptr := Sloc (STJ.Bod);
-                     Elmt  : Elmt_Id;
-                     Nod   : Node_Id;
-                     Ent   : Entity_Id;
                      Clist : List_Id;
                      Comp  : Entity_Id;
 
@@ -872,44 +1193,13 @@ package body Exp_Unst is
                      Decl_ARECnP  : Node_Id;
                      --  Declaration nodes for the AREC entities we build
 
-                     Uplevel_Entities :
-                       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
-                     --  subprogram that are referenced uplevel. The maximum
-                     --  number of entries cannot exceed the total number of
-                     --  uplevel references.
-
                   begin
-                     --  Populate the Uplevel_Entities array, using the flag
-                     --  Uplevel_Reference_Noted to avoid duplicates.
-
-                     Num_Uplevel_Entities := 0;
-
-                     if Present (STJ.Urefs) then
-                        Elmt := First_Elmt (STJ.Urefs);
-                        while Present (Elmt) loop
-                           Nod := Actual_Ref (Node (Elmt));
-                           Ent := Entity (Nod);
-
-                           if not Uplevel_Reference_Noted (Ent) then
-                              Set_Uplevel_Reference_Noted (Ent, True);
-                              Num_Uplevel_Entities := Num_Uplevel_Entities + 1;
-                              Uplevel_Entities (Num_Uplevel_Entities) := Ent;
-                           end if;
-
-                           Next_Elmt (Elmt);
-                           Next_Elmt (Elmt);
-                        end loop;
-                     end if;
-
                      --  Build list of component declarations for ARECnT
 
                      Clist := Empty_List;
 
                      --  If we are in a subprogram that has a static link that
-                     --  ias passed in (as indicated by ARECnF being deinfed),
+                     --  is passed in (as indicated by ARECnF being defined),
                      --  then include ARECnU : ARECnPT := ARECnF where n is
                      --  one less than the current level and the entity ARECnPT
                      --  comes from the enclosing subprogram.
@@ -934,22 +1224,35 @@ package body Exp_Unst is
 
                      --  Add components for uplevel referenced entities
 
-                     for J in 1 .. Num_Uplevel_Entities loop
-                        Comp :=
-                          Make_Defining_Identifier (Loc,
-                            Chars => Upref_Name (Uplevel_Entities (J)));
-
-                        Set_Activation_Record_Component
-                          (Uplevel_Entities (J), Comp);
-
-                        Append_To (Clist,
-                          Make_Component_Declaration (Loc,
-                            Defining_Identifier  => Comp,
-                            Component_Definition =>
-                              Make_Component_Definition (Loc,
-                                Subtype_Indication =>
-                                  New_Occurrence_Of (Addr, Loc))));
-                     end loop;
+                     if Present (STJ.Uents) then
+                        declare
+                           Elmt : Elmt_Id;
+                           Uent : Entity_Id;
+
+                        begin
+                           Elmt := First_Elmt (STJ.Uents);
+                           while Present (Elmt) loop
+                              Uent := Node (Elmt);
+
+                              Comp :=
+                                Make_Defining_Identifier (Loc,
+                                  Chars => Upref_Name (Uent, Clist));
+
+                              Set_Activation_Record_Component
+                                (Uent, Comp);
+
+                              Append_To (Clist,
+                                Make_Component_Declaration (Loc,
+                                  Defining_Identifier  => Comp,
+                                  Component_Definition =>
+                                    Make_Component_Definition (Loc,
+                                      Subtype_Indication =>
+                                        New_Occurrence_Of (Addr, Loc))));
+
+                              Next_Elmt (Elmt);
+                           end loop;
+                        end;
+                     end if;
 
                      --  Now we can insert the AREC declarations into the body
 
@@ -1010,89 +1313,93 @@ package body Exp_Unst is
                      --  newly created entities go in the right entity chain.
 
                      --  We analyze with all checks suppressed (since we do
-                     --  not expect any exceptions, and also we temporarily
-                     --  turn off Unested_Subprogram_Mode to avoid trying to
-                     --  mark uplevel references (not needed at this stage,
-                     --  and in fact causes a bit of recursive chaos).
+                     --  not expect any exceptions).
 
                      Push_Scope (STJ.Ent);
-                     Opt.Unnest_Subprogram_Mode := False;
                      Analyze (Decl_ARECnT,  Suppress => All_Checks);
                      Analyze (Decl_ARECn,   Suppress => All_Checks);
                      Analyze (Decl_ARECnPT, Suppress => All_Checks);
                      Analyze (Decl_ARECnP,  Suppress => All_Checks);
-                     Opt.Unnest_Subprogram_Mode := True;
                      Pop_Scope;
 
                      --  Next step, for each uplevel referenced entity, add
-                     --  assignment operations to set the comoponent in the
+                     --  assignment operations to set the component in the
                      --  activation record.
 
-                     for J in 1 .. Num_Uplevel_Entities loop
+                     if Present (STJ.Uents) then
                         declare
-                           Ent : constant Entity_Id  := Uplevel_Entities (J);
-                           Loc : constant Source_Ptr := Sloc (Ent);
-                           Dec : constant Node_Id    := Declaration_Node (Ent);
-                           Ins : Node_Id;
-                           Asn : Node_Id;
+                           Elmt : Elmt_Id;
 
                         begin
-                           --  For parameters, we insert the assignment right
-                           --  after the declaration of ARECnP. For all other
-                           --  entities, we insert the assignment immediately
-                           --  after the declaration of the entity.
-
-                           --  Note: we don't need to mark the entity as being
-                           --  aliased, because the address attribute will mark
-                           --  it as Address_Taken, and that is good enough.
-
-                           if Is_Formal (Ent) then
-                              Ins := Decl_ARECnP;
-                           else
-                              Ins := Dec;
-                           end if;
-
-                           --  Build and insert the assignment:
-                           --    ARECn.nam := nam'Address
-
-                           Asn :=
-                             Make_Assignment_Statement (Loc,
-                               Name       =>
-                                 Make_Selected_Component (Loc,
-                                   Prefix        =>
-                                     New_Occurrence_Of (STJ.ARECn, Loc),
-                                   Selector_Name =>
-                                     New_Occurrence_Of
-                                       (Activation_Record_Component (Ent),
-                                        Loc)),
-
-                               Expression =>
-                                 Make_Attribute_Reference (Loc,
-                                   Prefix         =>
-                                     New_Occurrence_Of (Ent, Loc),
-                                   Attribute_Name => Name_Address));
-
-                           Insert_After (Ins, Asn);
-
-                           --  Analyze the assignment statement. We do not need
-                           --  to establish the relevant scope stack entries
-                           --  here, because we have already set the correct
-                           --  entity references, so no name resolution is
-                           --  required, and no new entities are created, so
-                           --  we don't even need to set the current scope.
-
-                           --  We analyze with all checks suppressed (since
-                           --  we do not expect any exceptions, and also we
-                           --  temporarily turn off Unested_Subprogram_Mode
-                           --  to avoid trying to mark uplevel references (not
-                           --  needed at this stage, and in fact causes a bit
-                           --  of recursive chaos).
-
-                           Opt.Unnest_Subprogram_Mode := False;
-                           Analyze (Asn, Suppress => All_Checks);
-                           Opt.Unnest_Subprogram_Mode := True;
+                           Elmt := First_Elmt (STJ.Uents);
+                           while Present (Elmt) loop
+                              declare
+                                 Ent : constant Entity_Id  := Node (Elmt);
+                                 Loc : constant Source_Ptr := Sloc (Ent);
+                                 Dec : constant Node_Id    :=
+                                         Declaration_Node (Ent);
+                                 Ins : Node_Id;
+                                 Asn : Node_Id;
+
+                              begin
+                                 --  For parameters, we insert the assignment
+                                 --  right after the declaration of ARECnP.
+                                 --  For all other entities, we insert
+                                 --  the assignment immediately after
+                                 --  the declaration of the entity.
+
+                                 --  Note: we don't need to mark the entity
+                                 --  as being aliased, because the address
+                                 --  attribute will mark it as Address_Taken,
+                                 --  and that is good enough.
+
+                                 if Is_Formal (Ent) then
+                                    Ins := Decl_ARECnP;
+                                 else
+                                    Ins := Dec;
+                                 end if;
+
+                                 --  Build and insert the assignment:
+                                 --    ARECn.nam := nam'Address
+
+                                 Asn :=
+                                   Make_Assignment_Statement (Loc,
+                                     Name       =>
+                                       Make_Selected_Component (Loc,
+                                         Prefix        =>
+                                           New_Occurrence_Of (STJ.ARECn, Loc),
+                                         Selector_Name =>
+                                           New_Occurrence_Of
+                                             (Activation_Record_Component
+                                                (Ent),
+                                              Loc)),
+
+                                     Expression =>
+                                       Make_Attribute_Reference (Loc,
+                                         Prefix         =>
+                                           New_Occurrence_Of (Ent, Loc),
+                                         Attribute_Name => Name_Address));
+
+                                 Insert_After (Ins, Asn);
+
+                                 --  Analyze the assignment statement. We do
+                                 --  not need to establish the relevant scope
+                                 --  stack entries here, because we have
+                                 --  already set the correct entity references,
+                                 --  so no name resolution is required, and no
+                                 --  new entities are created, so we don't even
+                                 --  need to set the current scope.
+
+                                 --  We analyze with all checks suppressed
+                                 --  (since we do not expect any exceptions).
+
+                                 Analyze (Asn, Suppress => All_Checks);
+                              end;
+
+                              Next_Elmt (Elmt);
+                           end loop;
                         end;
-                     end loop;
+                     end if;
                   end;
                end if;
             end;
@@ -1104,204 +1411,141 @@ package body Exp_Unst is
       --  need all the AREC declarations generated, inserted, and analyzed so
       --  that the uplevel references can be successfully analyzed.
 
-      Uplev_Refs : for J in Subps.First .. Subps.Last loop
+      Uplev_Refs : for J in Urefs.First .. Urefs.Last loop
          declare
-            STJ : Subp_Entry renames Subps.Table (J);
+            UPJ : Uref_Entry renames Urefs.Table (J);
 
          begin
-            --  We are only interested in entries which have uplevel references
-            --  to deal with, as indicated by the Urefs list being present
-
-            if Present (STJ.Urefs) then
-
-               --  Process uplevel references for one subprogram
-
-               Uplev_Refs_For_One_Subp : declare
-                  Elmt : Elmt_Id;
-
-                  function Get_Real_Subp (Ent : Entity_Id) return Entity_Id;
-                  --  The entity recorded as the enclosing subprogram for the
-                  --  reference sometimes turns out to be a subprogram body.
-                  --  This function gets the proper subprogram spec if needed.
-
-                  -------------------
-                  -- Get_Real_Subp --
-                  -------------------
-
-                  function Get_Real_Subp (Ent : Entity_Id) return Entity_Id is
-                     Nod : Node_Id;
+            --  Ignore type references, these are implicit references that do
+            --  not need rewriting (e.g. the appearence in a conversion).
 
-                  begin
-                     --  If we have a subprogram, return it
-
-                     if Is_Subprogram (Ent) then
-                        return Ent;
-
-                     --  If we have a subprogram body, go to the body
-
-                     elsif Ekind (Ent) = E_Subprogram_Body then
-                        Nod := Parent (Parent (Ent));
-                        pragma Assert (Nkind (Nod) = N_Subprogram_Body);
-
-                        if Acts_As_Spec (Nod) then
-                           return Ent;
-                        else
-                           return Corresponding_Spec (Nod);
-                        end if;
-
-                     --  Should not be any other possibilities
-
-                     else
-                        raise Program_Error;
-                     end if;
-                  end Get_Real_Subp;
-
-               --  Start of processing for Uplevel_References_For_One_Subp
-
-               begin
-                  --  Loop through uplevel references
-
-                  Elmt := First_Elmt (STJ.Urefs);
-                  while Present (Elmt) loop
-
-                     --  Rewrite one reference
-
-                     Rewrite_One_Ref : declare
-                        Ref : constant Node_Id := Actual_Ref (Node (Elmt));
-                        --  The reference to be rewritten
+            if Is_Type (UPJ.Ent) then
+               goto Continue;
+            end if;
 
-                        Loc : constant Source_Ptr := Sloc (Ref);
-                        --  Source location for the reference
+            --  Rewrite one reference
 
-                        Ent : constant Entity_Id := Entity (Ref);
-                        --  The referenced entity
+            Rewrite_One_Ref : declare
+               Loc : constant Source_Ptr := Sloc (UPJ.Ref);
+               --  Source location for the reference
 
-                        Typ : constant Entity_Id := Etype (Ent);
-                        --  The type of the referenced entity
+               Typ : constant Entity_Id := Etype (UPJ.Ent);
+               --  The type of the referenced entity
 
-                        Atyp : constant Entity_Id := Get_Actual_Subtype (Ref);
-                        --  The actual subtype of the reference
+               Atyp : constant Entity_Id := Get_Actual_Subtype (UPJ.Ref);
+               --  The actual subtype of the reference
 
-                        Rsub : constant Entity_Id :=
-                                 Get_Real_Subp (Node (Next_Elmt (Elmt)));
-                        --  The enclosing subprogram for the reference
+               RS_Caller : constant SI_Type := Subp_Index (UPJ.Caller);
+               --  Subp_Index for caller containing reference
 
-                        RSX : constant SI_Type := Subp_Index (Rsub);
-                        --  Subp_Index for enclosing subprogram for ref
+               STJR : Subp_Entry renames Subps.Table (RS_Caller);
+               --  Subp_Entry for subprogram containing reference
 
-                        STJR : Subp_Entry renames Subps.Table (RSX);
-                        --  Subp_Entry for enclosing subprogram for ref
+               RS_Callee : constant SI_Type := Subp_Index (UPJ.Callee);
+               --  Subp_Index for subprogram containing referenced entity
 
-                        Pfx  : Node_Id;
-                        Comp : Entity_Id;
-                        SI   : SI_Type;
+               STJE : Subp_Entry renames Subps.Table (RS_Callee);
+               --  Subp_Entry for subprogram containing referenced entity
 
-                     begin
-                        --  Ignore if no ARECnF entity for enclosing subprogram
-                        --  which probably happens as a result of not properly
-                        --  treating instance bodies. To be examined ???
+               Pfx  : Node_Id;
+               Comp : Entity_Id;
+               SI   : SI_Type;
 
-                        --  If this test is omitted, then the compilation of
-                        --  freeze.adb and inline.adb fail in unnesting mode.
+            begin
+               --  Ignore if no ARECnF entity for enclosing subprogram which
+               --  probably happens as a result of not properly treating
+               --  instance bodies. To be examined ???
 
-                        if No (STJR.ARECnF) then
-                           goto Continue;
-                        end if;
+               --  If this test is omitted, then the compilation of
+               --  freeze.adb and inline.adb fail in unnesting mode.
 
-                        --  Push the current scope, so that the pointer type
-                        --  Tnn, and any subsidiary entities resulting from
-                        --  the analysis of the rewritten reference, go in the
-                        --  right entity chain.
+               if No (STJR.ARECnF) then
+                  goto Continue;
+               end if;
 
-                        Push_Scope (STJR.Ent);
+               --  Push the current scope, so that the pointer type Tnn, and
+               --  any subsidiary entities resulting from the analysis of the
+               --  rewritten reference, go in the right entity chain.
 
-                        --  Now we need to rewrite the reference. We have a
-                        --  reference is from level STJE.Lev to level STJ.Lev.
-                        --  The general form of the rewritten reference for
-                        --  entity X is:
+               Push_Scope (STJR.Ent);
 
-                        --   Typ'Deref (ARECaF.ARECbU.ARECcU.ARECdU....ARECm.X)
+               --  Now we need to rewrite the reference. We have a
+               --  reference is from level STJR.Lev to level STJE.Lev.
+               --  The general form of the rewritten reference for
+               --  entity X is:
 
-                        --  where a,b,c,d .. m =
-                        --    STJR.Lev - 1,  STJ.Lev - 2, .. STJ.Lev
+               --   Typ'Deref (ARECaF.ARECbU.ARECcU.ARECdU....ARECm.X)
 
-                        pragma Assert (STJR.Lev > STJ.Lev);
+               --  where a,b,c,d .. m =
+               --    STJR.Lev - 1,  STJR.Lev - 2, .. STJE.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).
+               pragma Assert (STJR.Lev > STJE.Lev);
 
-                        --   level 2 to level 1
+               --  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).
 
-                        --     AREC1F.X
+               --   level 2 to level 1
 
-                        --   level 3 to level 1
+               --     AREC1F.X
 
-                        --     (AREC2F.AREC1U).X
+               --   level 3 to level 1
 
-                        --   level 4 to level 1
+               --     (AREC2F.AREC1U).X
 
-                        --     ((AREC3F.AREC2U).AREC1U).X
+               --   level 4 to level 1
 
-                        --   level 6 to level 2
+               --     ((AREC3F.AREC2U).AREC1U).X
 
-                        --     (((AREC5F.AREC4U).AREC3U).AREC2U).X
+               --   level 6 to level 2
 
-                        Pfx := New_Occurrence_Of (STJR.ARECnF, Loc);
-                        SI := RSX;
-                        for L in STJ.Lev .. STJR.Lev - 2 loop
-                           SI := Enclosing_Subp (SI);
-                           Pfx :=
-                             Make_Selected_Component (Loc,
-                               Prefix        => Pfx,
-                               Selector_Name =>
-                                 New_Occurrence_Of
-                                   (Subps.Table (SI).ARECnU, Loc));
-                        end loop;
+               --     (((AREC5F.AREC4U).AREC3U).AREC2U).X
 
-                        --  Get activation record component (must exist)
+               Pfx := New_Occurrence_Of (STJR.ARECnF, Loc);
+               SI := RS_Caller;
+               for L in STJE.Lev .. STJR.Lev - 2 loop
+                  SI := Enclosing_Subp (SI);
+                  Pfx :=
+                    Make_Selected_Component (Loc,
+                      Prefix        => Pfx,
+                      Selector_Name =>
+                        New_Occurrence_Of (Subps.Table (SI).ARECnU, Loc));
+               end loop;
 
-                        Comp := Activation_Record_Component (Ent);
-                        pragma Assert (Present (Comp));
+               --  Get activation record component (must exist)
 
-                        --  Do the replacement
+               Comp := Activation_Record_Component (UPJ.Ent);
+               pragma Assert (Present (Comp));
 
-                        Rewrite (Ref,
-                          Make_Attribute_Reference (Loc,
-                            Prefix         => New_Occurrence_Of (Atyp, Loc),
-                            Attribute_Name => Name_Deref,
-                            Expressions    => New_List (
-                              Make_Selected_Component (Loc,
-                                Prefix        => Pfx,
-                                Selector_Name =>
-                                  New_Occurrence_Of (Comp, Loc)))));
+               --  Do the replacement
 
-                        --  Analyze and resolve the new expression. We do not
-                        --  need to establish the relevant scope stack entries
-                        --  here, because we have already set all the correct
-                        --  entity references, so no name resolution is needed.
-                        --  We have already set the current scope, so that any
-                        --  new entities created will be in the right scope.
+               Rewrite (UPJ.Ref,
+                 Make_Attribute_Reference (Loc,
+                   Prefix         => New_Occurrence_Of (Atyp, Loc),
+                   Attribute_Name => Name_Deref,
+                   Expressions    => New_List (
+                     Make_Selected_Component (Loc,
+                       Prefix        => Pfx,
+                       Selector_Name =>
+                         New_Occurrence_Of (Comp, Loc)))));
 
-                        --  We analyze with all checks suppressed (since we do
-                        --  not expect any exceptions, and also we temporarily
-                        --  turn off Unested_Subprogram_Mode to avoid trying to
-                        --  mark uplevel references (not needed at this stage,
-                        --  and in fact causes a bit of recursive chaos).
+               --  Analyze and resolve the new expression. We do not need to
+               --  establish the relevant scope stack entries here, because we
+               --  have already set all the correct entity references, so no
+               --  name resolution is needed. We have already set the current
+               --  scope, so that any new entities created will be in the right
+               --  scope.
 
-                        Opt.Unnest_Subprogram_Mode := False;
-                        Analyze_And_Resolve (Ref, Typ, Suppress => All_Checks);
-                        Opt.Unnest_Subprogram_Mode := True;
-                        Pop_Scope;
-                     end Rewrite_One_Ref;
+               --  We analyze with all checks suppressed (since we do not
+               --  expect any exceptions)
 
-                  <<Continue>>
-                     Next_Elmt (Elmt);
-                     Next_Elmt (Elmt);
-                  end loop;
-               end Uplev_Refs_For_One_Subp;
-            end if;
+               Analyze_And_Resolve (UPJ.Ref, Typ, Suppress => All_Checks);
+               Pop_Scope;
+            end Rewrite_One_Ref;
          end;
+
+      <<Continue>>
+         null;
       end loop Uplev_Refs;
 
       --  Finally, loop through all calls adding extra actual for the
@@ -1316,8 +1560,8 @@ package body Exp_Unst is
 
          Adjust_One_Call : declare
             CTJ : Call_Entry renames Calls.Table (J);
-            STF : Subp_Entry renames Subps.Table (Subp_Index (CTJ.From));
-            STT : Subp_Entry renames Subps.Table (Subp_Index (CTJ.To));
+            STF : Subp_Entry renames Subps.Table (Subp_Index (CTJ.Caller));
+            STT : Subp_Entry renames Subps.Table (Subp_Index (CTJ.Callee));
 
             Loc : constant Source_Ptr := Sloc (CTJ.N);
 
@@ -1344,7 +1588,7 @@ package body Exp_Unst is
                   Extra := New_Occurrence_Of (STF.ARECnF, Loc);
 
                --  For a call that goes down a level, we pass a pointer
-               --  to the activation record constructed wtihin the caller
+               --  to the activation record constructed within the caller
                --  (which may be the outer level subprogram, but also may
                --  be a more deeply nested caller).
 
@@ -1368,7 +1612,7 @@ package body Exp_Unst is
                   pragma Assert (STT.Lev < STF.Lev);
 
                   Extra := New_Occurrence_Of (STF.ARECnF, Loc);
-                  SubX := Subp_Index (CTJ.From);
+                  SubX := Subp_Index (CTJ.Caller);
                   for K in reverse STT.Lev .. STF.Lev - 1 loop
                      SubX := Enclosing_Subp (SubX);
                      Extra :=
index 39930860f637849abad3cc593d08222056c5abb7..9a6393c6473ccccf8e0c213413e52bc5889b7f1d 100644 (file)
@@ -529,23 +529,6 @@ package Exp_Unst is
    -- Subprograms --
    -----------------
 
-   procedure Check_Uplevel_Reference_To_Type (Typ : Entity_Id);
-   --  This procedure is called if Sem_Util.Check_Nested_Access detects an
-   --  uplevel reference to a type or subtype entity Typ. On return there are
-   --  two cases, if Typ is a static type (defined as a discrete type with
-   --  static bounds, or a record all of whose components are of a static type,
-   --  or an array whose index and component types are all static types), then
-   --  the flag Is_Static_Type (Typ) will be set True, and in this case the
-   --  flag Has_Uplevel_Reference is not set since we don't need to worry about
-   --  uplevel references to static types. If on the other hand Typ is not a
-   --  static type, then the flag Has_Uplevel_Reference will be set, and any
-   --  non-static bounds referenced by the type will also be marked as having
-   --  uplevel references (by setting Has_Uplevel_Reference for these bounds).
-
-   procedure Note_Uplevel_Reference (N : Node_Id; Subp : Entity_Id);
-   --  Called in Unnest_Subprogram_Mode when we detect an explicit uplevel
-   --  reference (node N) to an enclosing subprogram Subp.
-
    procedure Unnest_Subprogram (Subp : Entity_Id; Subp_Body : Node_Id);
    --  Subp is a library level subprogram which has nested subprograms, and
    --  Subp_Body is the corresponding N_Subprogram_Body node. This procedure
index bab0b46abfa407e89db0310c0577f9e87c90b036..ba903793300e2b15f7addc1cea8b179dd0e4ce5e 100644 (file)
@@ -30,6 +30,7 @@ with Checks;
 with CStand;
 with Debug;    use Debug;
 with Elists;
+with Exp_Ch6;
 with Exp_Dbug;
 with Fmap;
 with Fname.UF;
@@ -90,6 +91,7 @@ begin
    Checks.Initialize;
    Sem_Warn.Initialize;
    Prep.Initialize;
+   Exp_Ch6.Initialize;
 
    if Generate_SCIL then
       SCIL_LL.Initialize;
@@ -408,13 +410,6 @@ begin
 
          --  Cleanup processing after completing main analysis
 
-         --  Turn off unnesting of subprograms mode. This is not right
-         --  with respect to instantiations. What needs to happen is that
-         --  we do the unnesting AFTER the call to Instantiate_Bodies. We
-         --  will take care of that later ???
-
-         Opt.Unnest_Subprogram_Mode := False;
-
          --  Comment needed for ASIS mode test and GNATprove mode test???
 
          if Operating_Mode = Generate_Code
@@ -444,6 +439,10 @@ begin
             Remove_Ignored_Ghost_Code;
          end if;
 
+         --  At this stage we can unnest subprogram bodies if required
+
+         Exp_Ch6.Unnest_Subprograms;
+
          --  List library units if requested
 
          if List_Units then
index 33c4be2bff155cff9323b79b5a525fd2dc9ce6f7..dcc3a85f539ac9535716b9a89f8a2c33c17b77a0 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1996-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1996-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- --
@@ -57,6 +57,12 @@ with Ada.Text_IO;             use Ada.Text_IO;
 with GNAT.OS_Lib; use GNAT.OS_Lib;
 
 procedure GNATCmd is
+   Gprbuild : constant String := "gprbuild";
+   Gnatmake : constant String := "gnatmake";
+
+   Gprclean  : constant String := "gprclean";
+   Gnatclean : constant String := "gnatclean";
+
    Normal_Exit : exception;
    --  Raise this exception for normal program termination
 
@@ -1166,7 +1172,6 @@ begin
 
    begin
       if The_Command = Stack then
-
          --  Never call gnatstack with a prefix
 
          Program := new String'(Command_List (The_Command).Unixcmd.all);
@@ -1174,6 +1179,40 @@ begin
       else
          Program :=
            Program_Name (Command_List (The_Command).Unixcmd.all, "gnat");
+
+         --  If we want to invoke gnatmake/gnatclean with -P, then check if
+         --  gprbuild/gprclean is available; if it is, use gprbuild/gprclean
+         --  instead of gnatmake/gnatclean.
+
+         if Program.all = Gnatmake or else Program.all = Gnatclean then
+            declare
+               Project_File_Used : Boolean := False;
+               Switch            : String_Access;
+
+            begin
+               for J in 1 .. Last_Switches.Last loop
+                  Switch := Last_Switches.Table (J);
+                  if Switch'Length >= 2 and then
+                    Switch (Switch'First .. Switch'First + 1) = "-P"
+                  then
+                     Project_File_Used := True;
+                     exit;
+                  end if;
+               end loop;
+
+               if Project_File_Used then
+                  if Program.all = Gnatmake
+                    and then Locate_Exec_On_Path (Gprbuild) /= null
+                  then
+                     Program := new String'(Gprbuild);
+                  elsif Program.all = Gnatclean
+                    and then Locate_Exec_On_Path (Gprclean) /= null
+                  then
+                     Program := new String'(Gprclean);
+                  end if;
+               end if;
+            end;
+         end if;
       end if;
 
       --  For the tools where the GNAT driver processes the project files,
index 3b8628065e71735da8ec5074b0ab522dcb5fd8cf..7b87c2dbfc196620da6030cd9f058b8a3bd270be 100644 (file)
@@ -1160,7 +1160,7 @@ package body Sem_Ch3 is
                if Is_Access_Type (Typ)
                  and then Null_Exclusion_In_Return_Present (T_Def)
                then
-                  Set_Etype  (Desig_Type,
+                  Set_Etype (Desig_Type,
                     Create_Null_Excluding_Itype
                       (T           => Typ,
                        Related_Nod => T_Def,
index 2a74e6f08c3518bdb5e9ca3ca14ae552ecd23cb5..9c564dd98e44b919e1cb0907722e52b1bca0f100 100644 (file)
@@ -5633,7 +5633,7 @@ package body Sem_Ch8 is
                   end if;
                end if;
 
-               Check_Nested_Access (N, E);
+               Check_Nested_Access (E);
             end if;
 
             Set_Entity_Or_Discriminal (N, E);
index 0c176f03067bb607debf286db89cc282c5ddca89..bebb7db04d32f24dabe219998d47cab961e8be51 100644 (file)
@@ -32,7 +32,6 @@ with Elists;   use Elists;
 with Errout;   use Errout;
 with Exp_Ch11; use Exp_Ch11;
 with Exp_Disp; use Exp_Disp;
-with Exp_Unst; use Exp_Unst;
 with Exp_Util; use Exp_Util;
 with Fname;    use Fname;
 with Freeze;   use Freeze;
@@ -1547,9 +1546,9 @@ package body Sem_Util is
 
          Insert_Action (N, Decl);
 
-         --  If the context is a component declaration the subtype
-         --  declaration will be analyzed when the enclosing type is
-         --  frozen, otherwise do it now.
+         --  If the context is a component declaration the subtype declaration
+         --  will be analyzed when the enclosing type is frozen, otherwise do
+         --  it now.
 
          if Ekind (Current_Scope) /= E_Record_Type then
             Analyze (Decl);
@@ -2872,18 +2871,16 @@ package body Sem_Util is
    -- Check_Nested_Access --
    -------------------------
 
-   procedure Check_Nested_Access (N : Node_Id; Ent : Entity_Id) is
+   procedure Check_Nested_Access (Ent : Entity_Id) is
       Scop         : constant Entity_Id := Current_Scope;
       Current_Subp : Entity_Id;
       Enclosing    : Entity_Id;
 
    begin
-      --  Currently only enabled for VM back-ends for efficiency, should we
-      --  enable it more systematically? Probably not unless someone actually
-      --  needs it. It will be needed for C generation and is activated if the
-      --  Opt.Unnest_Subprogram_Mode flag is set True.
+      --  Currently only enabled for VM back-ends for efficiency
 
-      if (VM_Target /= No_VM or else Unnest_Subprogram_Mode)
+      if VM_Target /= No_VM
+        and then Ekind_In (Ent, E_Variable, E_Constant, E_Loop_Parameter)
         and then Scope (Ent) /= Empty
         and then not Is_Library_Level_Entity (Ent)
 
@@ -2891,25 +2888,6 @@ package body Sem_Util is
 
         and then not Is_Imported (Ent)
       then
-         --  In both the VM case and in Unnest_Subprogram_Mode, we mark
-         --  variables, constants, and loop parameters.
-
-         if Ekind_In (Ent, E_Variable, E_Constant, E_Loop_Parameter) then
-            null;
-
-         --  In Unnest_Subprogram_Mode, we also mark types and formals
-
-         elsif Unnest_Subprogram_Mode
-           and then (Is_Type (Ent) or else Is_Formal (Ent))
-         then
-            null;
-
-            --  All other cases, do not mark
-
-         else
-            return;
-         end if;
-
          --  Get current subprogram that is relevant
 
          if Is_Subprogram (Scop)
@@ -2926,16 +2904,7 @@ package body Sem_Util is
          --  Set flag if uplevel reference
 
          if Enclosing /= Empty and then Enclosing /= Current_Subp then
-            if Is_Type (Ent) then
-               Check_Uplevel_Reference_To_Type (Ent);
-            else
-               Set_Has_Uplevel_Reference (Ent, True);
-
-               if Unnest_Subprogram_Mode then
-                  Set_Has_Uplevel_Reference (Current_Subp, True);
-                  Note_Uplevel_Reference (N, Enclosing);
-               end if;
-            end if;
+            Set_Has_Uplevel_Reference (Ent, True);
          end if;
       end if;
    end Check_Nested_Access;
@@ -4949,7 +4918,7 @@ package body Sem_Util is
 
       --  Both names are selected_components, their prefixes are known to
       --  denote the same object, and their selector_names denote the same
-      --  component (RM 6.4.1(6.6/3))
+      --  component (RM 6.4.1(6.6/3)).
 
       elsif Nkind (Obj1) = N_Selected_Component then
          return Denotes_Same_Object (Prefix (Obj1), Prefix (Obj2))
@@ -15223,7 +15192,7 @@ package body Sem_Util is
                   end if;
                end if;
 
-               Check_Nested_Access (N, Ent);
+               Check_Nested_Access (Ent);
             end if;
 
             Kill_Checks (Ent);
index ca31b297e0e00f06ee28088dbf403db415f18303..06239d2b66e5367cc4891f49b002f5eb9b9e5b42 100644 (file)
@@ -308,12 +308,10 @@ package Sem_Util is
    --  remains in the Examiner (JB01-005). Note that the Examiner does not
    --  count package declarations in later declarative items.
 
-   procedure Check_Nested_Access (N : Node_Id; Ent : Entity_Id);
+   procedure Check_Nested_Access (Ent : Entity_Id);
    --  Check whether Ent denotes an entity declared in an uplevel scope, which
-   --  is accessed inside a nested procedure, and set the Has_Uplevel_Reference
-   --  flag accordingly. This is currently only enabled for if on a VM target,
-   --  or if Opt.Unnest_Subprogram_Mode is active. N is the node for the
-   --  possible uplevel reference.
+   --  is accessed inside a nested procedure, and set Has_Uplevel_Reference
+   --  flag accordingly. This is currently only enabled for if on a VM target.
 
    procedure Check_No_Hidden_State (Id : Entity_Id);
    --  Determine whether object or state Id introduces a hidden state. If this