back_end.adb (Call_Back_End): Remove previous patch...

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

	* back_end.adb (Call_Back_End): Remove previous patch,
	the back end now gets to see the result of -gnatd.1
	(Unnest_Subprogram_Mode) processing.
	* elists.ads, elists.adb (List_Length): New function.
	* exp_unst.ads, exp_unst.adb: Major changes, first complete version.
	* sem_util.adb (Check_Nested_Access): Handle formals in
	Unnest_Subprogram_Mode.
	(Adjust_Named_Associations): Minor reformatting.
	* sprint.adb (Sprint_Node_Actual): Fix failure to print aliased
	for parameters.

From-SVN: r221115

gcc/ada/ChangeLog

 2015-03-02  Robert Dewar  <dewar@adacore.com>
 
+	* back_end.adb (Call_Back_End): Remove previous patch,
+	the back end now gets to see the result of -gnatd.1
+	(Unnest_Subprogram_Mode) processing.
+	* elists.ads, elists.adb (List_Length): New function.
+	* exp_unst.ads, exp_unst.adb: Major changes, first complete version.
+	* sem_util.adb (Check_Nested_Access): Handle formals in
+	Unnest_Subprogram_Mode.
+	(Adjust_Named_Associations): Minor reformatting.
+	* sprint.adb (Sprint_Node_Actual): Fix failure to print aliased
+	for parameters.
+
+2015-03-02  Robert Dewar  <dewar@adacore.com>
+
 	* atree.ads, atree.adb (Uint24): New function
 	(Set_Uint24): New procedure.
 	* atree.h (Uint24): New macro for field access.

gcc/ada/back_end.adb

@@ -118,12 +118,6 @@ package body Back_End is
          return;
       end if;
 
-      --  Skip call if unnesting subprograms (temp for now ???)
-
-      if Opt.Unnest_Subprogram_Mode then
-         return;
-      end if;
-
       --  The back end needs to know the maximum line number that can appear
       --  in a Sloc, in other words the maximum logical line number.
 

gcc/ada/elists.adb

@@ -295,17 +295,23 @@ package body Elists is
    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
-            N := N + 1;
-            Next_Elmt (Elmt);
-         end if;
-      end loop;
+      if List = No_Elist then
+         return 0;
+
+      else
+         N := 0;
+         Elmt := First_Elmt (List);
+         loop
+            if No (Elmt) then
+               return N;
+            else
+               N := N + 1;
+               Next_Elmt (Elmt);
+            end if;
+         end loop;
+      end if;
    end List_Length;
 
    ----------

gcc/ada/elists.ads

@@ -108,7 +108,7 @@ package Elists is
    --  no items, then No_Elmt is returned.
 
    function List_Length (List : Elist_Id) return Nat;
-   --  Returns number of elements in given List
+   --  Returns number of elements in given List (zero if List = No_Elist)
 
    function Next_Elmt (Elmt : Elmt_Id) return Elmt_Id;
    pragma Inline (Next_Elmt);

gcc/ada/exp_unst.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---            Copyright (C) 2015, Free Software Foundation, Inc.            --
+--          Copyright (C) 2014-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- --

gcc/ada/sem_util.adb

@@ -2883,13 +2883,22 @@ package body Sem_Util is
 
         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.
+         --  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;
-         elsif not (Unnest_Subprogram_Mode and then Is_Type (Ent)) then
+
+         --  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;
 
@@ -14081,8 +14090,8 @@ package body Sem_Util is
                   New_Next := First (Parameter_Associations (New_Node));
 
                   while Nkind (Old_Next) /= N_Parameter_Association
-                    or else  Explicit_Actual_Parameter (Old_Next)
-                      /= Next_Named_Actual (Old_E)
+                    or else Explicit_Actual_Parameter (Old_Next) /=
+                                              Next_Named_Actual (Old_E)
                   loop
                      Next (Old_Next);
                      Next (New_Next);

gcc/ada/sprint.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- --
@@ -2703,12 +2703,15 @@ package body Sprint is
                --  it is emitted when the access definition is displayed.
 
                if Null_Exclusion_Present (Node)
-                 and then Nkind (Parameter_Type (Node))
-                   /= N_Access_Definition
+                 and then Nkind (Parameter_Type (Node)) /= N_Access_Definition
                then
                   Write_Str ("not null ");
                end if;
 
+               if Aliased_Present (Node) then
+                  Write_Str ("aliased ");
+               end if;
+
                Sprint_Node (Parameter_Type (Node));
 
                if Present (Expression (Node)) then