debug.adb: Document new debug flag -gnatd.1.

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

	* debug.adb: Document new debug flag -gnatd.1.
	* einfo.ads, einfo.adb (Has_Nested_Subprogram): New flag.
	(Has_Uplevel_Reference): New flag (Is_Static_Type): New flag.
	(Uplevel_Reference_Noted):New flag (Uplevel_References): New field.
	* elists.ads elists.adb (List_Length): New function.
	* exp_ch6.adb (Expand_N_Subprogram_Body): Call Unnest_Subprogram
	when appropriate (Process_Preconditions): Minor code
	reorganization and reformatting
	* exp_unst.ads, exp_unst.adb: New files.
	* gnat1drv.adb (Adjust_Global_Switches): Set
	Unnest_Subprogram_Mode if -gnatd.1
	* namet.ads, namet.adb (Name_Find_Str): New version of Name_Find with
	string argument.
	* opt.ads (Unnest_Subprogram_Mode): New flag.
	* par-ch3.adb (P_Identifier_Declarations): Fixes to -gnatd.2 handling.
	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Set
	Has_Nested_Subprogram flag.
	* sem_ch8.adb (Find_Direct_Name): New calling sequence for
	Check_Nested_Access.
	(Find_Selected_Component): Minor comment addition.
	* sem_util.adb (Check_Nested_Access): New version for use with Exp_Unst.
	(Note_Possible_Modification): New calling sequence for
	Check_Nested_Access.
	* sem_util.ads (Check_Nested_Access): New version for use with Exp_Unst.
	* gcc-interface/Make-lang.in (GNAT1_OBJS): Add exp_unst.o

From-SVN: r221109

gcc/ada/ChangeLog

+2015-03-02  Robert Dewar  <dewar@adacore.com>
+
+	* debug.adb: Document new debug flag -gnatd.1.
+	* einfo.ads, einfo.adb (Has_Nested_Subprogram): New flag.
+	(Has_Uplevel_Reference): New flag (Is_Static_Type): New flag.
+	(Uplevel_Reference_Noted):New flag (Uplevel_References): New field.
+	* elists.ads elists.adb (List_Length): New function.
+	* exp_ch6.adb (Expand_N_Subprogram_Body): Call Unnest_Subprogram
+	when appropriate (Process_Preconditions): Minor code
+	reorganization and reformatting
+	* exp_unst.ads, exp_unst.adb: New files.
+	* gnat1drv.adb (Adjust_Global_Switches): Set
+	Unnest_Subprogram_Mode if -gnatd.1
+	* namet.ads, namet.adb (Name_Find_Str): New version of Name_Find with
+	string argument.
+	* opt.ads (Unnest_Subprogram_Mode): New flag.
+	* par-ch3.adb (P_Identifier_Declarations): Fixes to -gnatd.2 handling.
+	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Set
+	Has_Nested_Subprogram flag.
+	* sem_ch8.adb (Find_Direct_Name): New calling sequence for
+	Check_Nested_Access.
+	(Find_Selected_Component): Minor comment addition.
+	* sem_util.adb (Check_Nested_Access): New version for use with Exp_Unst.
+	(Note_Possible_Modification): New calling sequence for
+	Check_Nested_Access.
+	* sem_util.ads (Check_Nested_Access): New version for use with Exp_Unst.
+	* gcc-interface/Make-lang.in (GNAT1_OBJS): Add exp_unst.o
+
 2015-03-02  Pierre-Marie de Rodat  <derodat@adacore.com>
 
 	* gcc-interface/utils.c (gnat_pushdecl): For non-artificial pointer

gcc/ada/debug.adb

@@ -746,9 +746,10 @@ package body Debug is
    --  d9   This allows lock free implementation for protected objects
    --       (see Exp_Ch9).
 
-   --  d.1  Enable unnesting of nested procedures. This special pass does not
-   --       actually unnest things, but it ensures that a nested procedure
-   --       does not contain any uplevel references.
+   --  d.1  Sets Opt.Unnest_Subprogram_Mode to enable unnesting of subprograms.
+   --       This special pass does not actually unnest things, but it ensures
+   --       that a nested procedure does not contain any uplevel references.
+   --       See spec of Exp_Unst for full details.
 
    --  d.2  Allow statements within declarative parts. This is not usually
    --       allowed, but in some debugging contexts (e.g. testing the circuit

gcc/ada/einfo.adb

@@ -213,6 +213,7 @@ package body Einfo is
    --    Stored_Constraint               Elist23
 
    --    Related_Expression              Node24
+   --    Uplevel_References              Elist24
 
    --    Interface_Alias                 Node25
    --    Interfaces                      Elist25
@@ -505,7 +506,7 @@ package body Einfo is
    --    Has_Pragma_Unreferenced_Objects Flag212
    --    Requires_Overriding             Flag213
    --    Has_RACW                        Flag214
-   --    Has_Up_Level_Access             Flag215
+   --    Has_Uplevel_Reference           Flag215
    --    Universal_Aliasing              Flag216
    --    Suppress_Value_Tracking_On_Call Flag217
    --    Is_Primitive                    Flag218
@@ -578,9 +579,10 @@ package body Einfo is
    --    Contains_Ignored_Ghost_Code     Flag279
    --    Partial_View_Has_Unknown_Discr  Flag280
 
-   --    (unused)                        Flag281
-   --    (unused)                        Flag282
-   --    (unused)                        Flag283
+   --    Is_Static_Type                  Flag281
+   --    Has_Nested_Subprogram           Flag282
+   --    Uplevel_Reference_Noted         Flag283
+
    --    (unused)                        Flag284
    --    (unused)                        Flag285
    --    (unused)                        Flag286
@@ -1544,6 +1546,12 @@ package body Einfo is
       return Flag101 (Id);
    end Has_Nested_Block_With_Handler;
 
+   function Has_Nested_Subprogram (Id : E) return B is
+   begin
+      pragma Assert (Is_Subprogram (Id));
+      return Flag282 (Id);
+   end Has_Nested_Subprogram;
+
    function Has_Non_Standard_Rep (Id : E) return B is
    begin
       return Flag75 (Implementation_Base_Type (Id));
@@ -1786,12 +1794,10 @@ package body Einfo is
       return Flag72 (Id);
    end Has_Unknown_Discriminants;
 
-   function Has_Up_Level_Access (Id : E) return B is
+   function Has_Uplevel_Reference (Id : E) return B is
    begin
-      pragma Assert
-        (Ekind_In (Id, E_Variable, E_Constant, E_Loop_Parameter));
       return Flag215 (Id);
-   end Has_Up_Level_Access;
+   end Has_Uplevel_Reference;
 
    function Has_Visible_Refinement (Id : E) return B is
    begin
@@ -2376,6 +2382,12 @@ package body Einfo is
       return Flag60 (Id);
    end Is_Shared_Passive;
 
+   function Is_Static_Type (Id : E) return B is
+   begin
+      pragma Assert (Is_Type (Id));
+      return Flag281 (Id);
+   end Is_Static_Type;
+
    function Is_Statically_Allocated (Id : E) return B is
    begin
       return Flag28 (Id);
@@ -3188,6 +3200,17 @@ 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);
@@ -4371,11 +4394,16 @@ package body Einfo is
       Set_Flag101 (Id, V);
    end Set_Has_Nested_Block_With_Handler;
 
-   procedure Set_Has_Up_Level_Access (Id : E; V : B := True) is
+   procedure Set_Has_Nested_Subprogram (Id : E; V : B := True) is
+   begin
+      pragma Assert (Is_Subprogram (Id));
+      Set_Flag282 (Id, V);
+   end Set_Has_Nested_Subprogram;
+
+   procedure Set_Has_Uplevel_Reference (Id : E; V : B := True) is
    begin
-      pragma Assert (Ekind_In (Id, E_Variable, E_Constant, E_Loop_Parameter));
       Set_Flag215 (Id, V);
-   end Set_Has_Up_Level_Access;
+   end Set_Has_Uplevel_Reference;
 
    procedure Set_Has_Non_Standard_Rep (Id : E; V : B := True) is
    begin
@@ -5270,6 +5298,12 @@ package body Einfo is
       Set_Flag60 (Id, V);
    end Set_Is_Shared_Passive;
 
+   procedure Set_Is_Static_Type (Id : E; V : B := True) is
+   begin
+      pragma Assert (Is_Type (Id));
+      Set_Flag281 (Id, V);
+   end Set_Is_Static_Type;
+
    procedure Set_Is_Statically_Allocated (Id : E; V : B := True) is
    begin
       pragma Assert
@@ -6119,6 +6153,17 @@ 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);
@@ -8517,6 +8562,7 @@ package body Einfo is
       W ("Has_Master_Entity",               Flag21  (Id));
       W ("Has_Missing_Return",              Flag142 (Id));
       W ("Has_Nested_Block_With_Handler",   Flag101 (Id));
+      W ("Has_Nested_Subprogram",           Flag282 (Id));
       W ("Has_Non_Standard_Rep",            Flag75  (Id));
       W ("Has_Out_Or_In_Out_Parameter",     Flag110 (Id));
       W ("Has_Object_Size_Clause",          Flag172 (Id));
@@ -8561,7 +8607,7 @@ package body Einfo is
       W ("Has_Thunks",                      Flag228 (Id));
       W ("Has_Unchecked_Union",             Flag123 (Id));
       W ("Has_Unknown_Discriminants",       Flag72  (Id));
-      W ("Has_Up_Level_Access",             Flag215 (Id));
+      W ("Has_Uplevel_Reference",           Flag215 (Id));
       W ("Has_Visible_Refinement",          Flag263 (Id));
       W ("Has_Volatile_Components",         Flag87  (Id));
       W ("Has_Xref_Entry",                  Flag182 (Id));
@@ -8662,6 +8708,7 @@ package body Einfo is
       W ("Is_Return_Object",                Flag209 (Id));
       W ("Is_Safe_To_Reevaluate",           Flag249 (Id));
       W ("Is_Shared_Passive",               Flag60  (Id));
+      W ("Is_Static_Type",                  Flag281 (Id));
       W ("Is_Statically_Allocated",         Flag28  (Id));
       W ("Is_Tag",                          Flag78  (Id));
       W ("Is_Tagged_Type",                  Flag55  (Id));
@@ -8728,6 +8775,7 @@ 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));
@@ -9638,6 +9686,11 @@ package body Einfo is
               Type_Kind                                    =>
             Write_Str ("Related_Expression");
 
+         when E_Function                                   |
+              E_Operator                                   |
+              E_Procedure                                  =>
+            Write_Str ("Uplevel_References");
+
          when others                                       =>
             Write_Str ("Field24???");
       end case;

gcc/ada/elists.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -288,6 +288,25 @@ package body Elists is
       return Elmts.Last;
    end Last_Elmt_Id;
 
+   -----------------
+   -- List_Length --
+   -----------------
+
+   function List_Length (List : Elist_Id) return Nat is
+      Elmt : Elmt_Id;
+      N    : Nat;
+   begin
+      N := 0;
+      Elmt := First_Elmt (List);
+      loop
+         if No (Elmt) then
+            return N;
+         else
+            Next_Elmt (Elmt);
+         end if;
+      end loop;
+   end List_Length;
+
    ----------
    -- Lock --
    ----------

gcc/ada/elists.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -107,6 +107,9 @@ package Elists is
    --  Obtains the last element of the given element list or, if the list has
    --  no items, then No_Elmt is returned.
 
+   function List_Length (List : Elist_Id) return Nat;
+   --  Returns number of elements in given List
+
    function Next_Elmt (Elmt : Elmt_Id) return Elmt_Id;
    pragma Inline (Next_Elmt);
    --  This function returns the next element on an element list. The argument

gcc/ada/exp_ch6.adb

@@ -42,6 +42,7 @@ with Exp_Intr; use Exp_Intr;
 with Exp_Pakd; use Exp_Pakd;
 with Exp_Prag; use Exp_Prag;
 with Exp_Tss;  use Exp_Tss;
+with Exp_Unst; use Exp_Unst;
 with Exp_Util; use Exp_Util;
 with Freeze;   use Freeze;
 with Inline;   use Inline;
@@ -5339,6 +5340,16 @@ package body Exp_Ch6 is
       --  Set to encode entity names in package body before gigi is called
 
       Qualify_Entity_Names (N);
+
+      --  If we are unnesting procedures, and this is an outer level procedure
+      --  with nested subprograms, do the unnesting operation now.
+
+      if Opt.Unnest_Subprogram_Mode
+        and then Is_Library_Level_Entity (Spec_Id)
+        and then Has_Nested_Subprogram (Spec_Id)
+      then
+         Unnest_Subprogram (Spec_Id, N);
+      end if;
    end Expand_N_Subprogram_Body;
 
    -----------------------------------
@@ -7716,14 +7727,9 @@ package body Exp_Ch6 is
 
          if Present (Decls) then
             Decl := First (Decls);
-
             while Present (Decl) loop
-               if Comes_From_Source (Decl) then
-                  exit;
-               else
-                  Insert_Node := Decl;
-               end if;
-
+               exit when Comes_From_Source (Decl);
+               Insert_Node := Decl;
                Next (Decl);
             end loop;
          end if;

gcc/ada/gcc-interface/Make-lang.in

@@ -282,6 +282,7 @@ GNAT_ADA_OBJS =	\
  ada/exp_smem.o	\
  ada/exp_strm.o	\
  ada/exp_tss.o	\
+ ada/exp_unst.o \
  ada/exp_util.o	\
  ada/expander.o	\
  ada/fmap.o	\

gcc/ada/gnat1drv.adb

@@ -130,6 +130,12 @@ procedure Gnat1drv is
          Relaxed_RM_Semantics := True;
       end if;
 
+      --  -gnatd.1 enables unnesting of subprograms
+
+      if Debug_Flag_Dot_1 then
+         Unnest_Subprogram_Mode := True;
+      end if;
+
       --  -gnatd.V or -gnatd.u enables special C expansion mode
 
       if Debug_Flag_Dot_VV or Debug_Flag_Dot_U then

gcc/ada/namet.adb

@@ -1104,6 +1104,17 @@ package body Namet is
       end if;
    end Name_Find;
 
+   -------------------
+   -- Name_Find_Str --
+   -------------------
+
+   function Name_Find_Str (S : String) return Name_Id is
+   begin
+      Name_Len := S'Length;
+      Name_Buffer (1 .. Name_Len) := S;
+      return Name_Find;
+   end Name_Find_Str;
+
    -------------
    -- Nam_In --
    -------------

gcc/ada/namet.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -422,6 +422,11 @@ package Namet is
    --  not modified by this call. Note that it is permissible for Name_Len to
    --  be set to zero to lookup the null name string.
 
+   function Name_Find_Str (S : String) return Name_Id;
+   --  Similar to Name_Find, except that the string is provided as an argument.
+   --  This call destroys the contents of Name_Buffer and Name_Len (by storing
+   --  the given string there.
+
    function Name_Enter return Name_Id;
    --  Name_Enter has the same calling interface as Name_Find. The difference
    --  is that it does not search the table for an existing match, and also

gcc/ada/opt.ads

@@ -1533,6 +1533,10 @@ package Opt is
    --  Indicates if error messages are to be prefixed by the string error:
    --  Initialized from Tag_Errors, can be forced on with the -gnatU switch.
 
+   Unnest_Subprogram_Mode : Boolean := False;
+   --  If true, activates the circuitry for unnesting subprograms (see the spec
+   --  of Exp_Unst for full details). Currently set only by use of -gnatd.1.
+
    Universal_Addressing_On_AAMP : Boolean := False;
    --  GNAAMP
    --  Indicates if library-level objects should be accessed and updated using

gcc/ada/par-ch3.adb

@@ -1514,14 +1514,34 @@ package body Ch3 is
             return;
 
          --  Otherwise we definitely have an ordinary identifier with a junk
-         --  token after it. Just complain that we expect a declaration, and
-         --  skip to a semicolon
+         --  token after it.
 
          else
-            Set_Declaration_Expected;
-            Resync_Past_Semicolon;
-            Done := False;
-            return;
+            --  If in -gnatd.2 mode, try for statements
+
+            if Debug_Flag_Dot_2 then
+               Restore_Scan_State (Scan_State);
+
+               --  Reset Token_Node, because it already got changed from an
+               --  Identifier to a Defining_Identifier, and we don't want that
+               --  for a statement!
+
+               Token_Node :=
+                 Make_Identifier (Sloc (Token_Node), Chars (Token_Node));
+
+               --  And now scan out one or more statements
+
+               Statement_When_Declaration_Expected (Decls, Done, In_Spec);
+               return;
+
+            --  Normal case, just complain and skip to semicolon
+
+            else
+               Set_Declaration_Expected;
+               Resync_Past_Semicolon;
+               Done := False;
+               return;
+            end if;
          end if;
       end if;
 

gcc/ada/sem_ch6.adb

@@ -3223,8 +3223,7 @@ package body Sem_Ch6 is
                --  We make two copies of the given spec, one for the new
                --  declaration, and one for the body.
 
-               if No (Spec_Id)
-                 and then GNATprove_Mode
+               if No (Spec_Id) and then GNATprove_Mode
 
                  --  Inlining does not apply during pre-analysis of code
 
@@ -4157,6 +4156,28 @@ package body Sem_Ch6 is
 
          Check_References (Body_Id);
       end;
+
+      --  Check for nested subprogram, and mark outer level subprogram if so
+
+      declare
+         Ent : Entity_Id;
+
+      begin
+         if Present (Spec_Id) then
+            Ent := Spec_Id;
+         else
+            Ent := Body_Id;
+         end if;
+
+         loop
+            Ent := Enclosing_Subprogram (Ent);
+            exit when No (Ent) or else Is_Subprogram (Ent);
+         end loop;
+
+         if Present (Ent) then
+            Set_Has_Nested_Subprogram (Ent);
+         end if;
+      end;
    end Analyze_Subprogram_Body_Helper;
 
    ---------------------------------

gcc/ada/sem_ch8.adb

@@ -5623,7 +5623,7 @@ package body Sem_Ch8 is
                   end if;
                end if;
 
-               Check_Nested_Access (E);
+               Check_Nested_Access (N, E);
             end if;
 
             Set_Entity_Or_Discriminal (N, E);
@@ -6593,6 +6593,8 @@ package body Sem_Ch8 is
                  and then (not Is_Entity_Name (P)
                             or else Chars (Entity (P)) /= Name_uInit)
                then
+                  --  Check if we already have an available subtype we can use
+
                   if Ekind (Etype (P)) = E_Record_Subtype
                     and then Nkind (Parent (Etype (P))) = N_Subtype_Declaration
                     and then Is_Array_Type (Etype (Selector))

gcc/ada/sem_util.adb

@@ -32,6 +32,7 @@ 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;
@@ -2863,23 +2864,37 @@ package body Sem_Util is
    -- Check_Nested_Access --
    -------------------------
 
-   procedure Check_Nested_Access (Ent : Entity_Id) is
+   procedure Check_Nested_Access (N : Node_Id; 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 ???
+      --  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.
 
-      --  Check for Is_Imported needs commenting below ???
-
-      if VM_Target /= No_VM
-        and then Ekind_In (Ent, E_Variable, E_Constant, E_Loop_Parameter)
+      if (VM_Target /= No_VM or else Unnest_Subprogram_Mode)
         and then Scope (Ent) /= Empty
         and then not Is_Library_Level_Entity (Ent)
+
+        --  Comment the exclusion of imported entities ???
+
         and then not Is_Imported (Ent)
       then
+         --  For VM case, we are only interested in variables, constants,
+         --  and loop parameters. For general nested procedure usage, we
+         --  allow types as well.
+
+         if Ekind_In (Ent, E_Variable, E_Constant, E_Loop_Parameter) then
+            null;
+         elsif not (Unnest_Subprogram_Mode and then Is_Type (Ent)) then
+            return;
+         end if;
+
+         --  Get current subprogram that is relevant
+
          if Is_Subprogram (Scop)
            or else Is_Generic_Subprogram (Scop)
            or else Is_Entry (Scop)
@@ -2891,8 +2906,19 @@ package body Sem_Util is
 
          Enclosing := Enclosing_Subprogram (Ent);
 
+         --  Set flag if uplevel reference
+
          if Enclosing /= Empty and then Enclosing /= Current_Subp then
-            Set_Has_Up_Level_Access (Ent, True);
+            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;
          end if;
       end if;
    end Check_Nested_Access;
@@ -15168,7 +15194,7 @@ package body Sem_Util is
                   end if;
                end if;
 
-               Check_Nested_Access (Ent);
+               Check_Nested_Access (N, Ent);
             end if;
 
             Kill_Checks (Ent);

gcc/ada/sem_util.ads

@@ -308,10 +308,12 @@ 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 (Ent : Entity_Id);
+   procedure Check_Nested_Access (N : Node_Id; Ent : Entity_Id);
    --  Check whether Ent denotes an entity declared in an uplevel scope, which
-   --  is accessed inside a nested procedure, and set Has_Up_Level_Access flag
-   --  accordingly. This is currently only enabled for VM_Target /= No_VM.
+   --  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.
 
    procedure Check_No_Hidden_State (Id : Entity_Id);
    --  Determine whether object or state Id introduces a hidden state. If this