[multiple changes]

2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Build_Raise_Statement): Remove the specialized
	processing for .NET/JVM. These targets can now benefit from
	Raise_From_Controlled_Operation and they share the same processing with
	standard targets.
	(Establish_Transient_Scope): Remove the restriction for .NET/JVM.
	These targets need transient scopes in order to properly finalize short
	lived controlled objects.
	(Make_Handler_For_Ctrl_Operation): Remove the specialized processing for
	 NET/JVM. These targets can now benefit from
	Raise_From_Controlled_Operation and they share the same processing with
	standard targets.

2011-08-04  Geert Bosch  <bosch@adacore.com>

	* tracebak.c (STOP_FRAME): Stop at any next pointer outside the stack

2011-08-04  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (Has_Visible_Private_Ancestor): subsidiary routine to
	Expand_Record_Aggregate, to determine whether aggregate must be
	expanded into assignments. This is the case if the ancestor part is
	private, regarless of the setting of the flag Has_Private_Ancestor.

2011-08-04  Ed Falis  <falis@adacore.com>

	* vxaddr2line.adb: Add support for e500v2 and for Linux hosts

2011-08-04  Bob Duff  <duff@adacore.com>

	* sinfo.ads: Fix comment.

2011-08-04  Steve Baird  <baird@adacore.com>

	* bindgen.adb (Get_Ada_Main_Name): If CodePeer_Mode is set, then
	choose a package name in much the same way as is
	done for JGNAT when VM_Target /= No_VM, except that
	a slightly more distinctive prefix string is used.

2011-08-04  Emmanuel Briot  <briot@adacore.com>

	* makeutl.adb (Complete_Mains): no longer accept unit names on the
	gnatmake command line.
	This behavior was never documented (and was supported only because of
	an early bug in the code). This case might lead to ambiguous cases
	(between unit names and truncated base names without suffixes).

From-SVN: r177379

8 files changed, 208 insertions, 124 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0321d69..62df17c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,53 @@
 2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>
 
+	* exp_ch7.adb (Build_Raise_Statement): Remove the specialized
+	processing for .NET/JVM. These targets can now benefit from
+	Raise_From_Controlled_Operation and they share the same processing with
+	standard targets.
+	(Establish_Transient_Scope): Remove the restriction for .NET/JVM.
+	These targets need transient scopes in order to properly finalize short
+	lived controlled objects.
+	(Make_Handler_For_Ctrl_Operation): Remove the specialized processing for
+	 NET/JVM. These targets can now benefit from
+	Raise_From_Controlled_Operation and they share the same processing with
+	standard targets.
+
+2011-08-04  Geert Bosch  <bosch@adacore.com>
+
+	* tracebak.c (STOP_FRAME): Stop at any next pointer outside the stack
+
+2011-08-04  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_aggr.adb (Has_Visible_Private_Ancestor): subsidiary routine to
+	Expand_Record_Aggregate, to determine whether aggregate must be
+	expanded into assignments. This is the case if the ancestor part is
+	private, regarless of the setting of the flag Has_Private_Ancestor.
+
+2011-08-04  Ed Falis  <falis@adacore.com>
+
+	* vxaddr2line.adb: Add support for e500v2 and for Linux hosts
+
+2011-08-04  Bob Duff  <duff@adacore.com>
+
+	* sinfo.ads: Fix comment.
+
+2011-08-04  Steve Baird  <baird@adacore.com>
+
+	* bindgen.adb (Get_Ada_Main_Name): If CodePeer_Mode is set, then
+	choose a package name in much the same way as is
+	done for JGNAT when VM_Target /= No_VM, except that
+	a slightly more distinctive prefix string is used.
+
+2011-08-04  Emmanuel Briot  <briot@adacore.com>
+
+	* makeutl.adb (Complete_Mains): no longer accept unit names on the
+	gnatmake command line.
+	This behavior was never documented (and was supported only because of
+	an early bug in the code). This case might lead to ambiguous cases
+	(between unit names and truncated base names without suffixes).
+
+2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
 	* a-tags.ads, a-tags.adb (Unregister_Tag): New routine.
 	Remove the external tag of a tagged type from the internal hash table.
 	* exp_ch7.adb (Build_Cleanup_Statements): Update the comment on the
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index 3f88f66..7ee7511 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -3783,12 +3783,21 @@ package body Bindgen is
    begin
       --  The main program generated by JGNAT expects a package called
       --  ada_<main procedure>.
-
       if VM_Target /= No_VM then
          Get_Name_String (Units.Table (First_Unit_Entry).Uname);
          return "ada_" & Get_Main_Unit_Name (Name_Buffer (1 .. Name_Len - 2));
       end if;
 
+      --  For CodePeer, we want reproducible names (independent of other
+      --  mains that may or may not be present) that don't collide
+      --  when analyzing multiple mains and which are easily recognizable
+      --  as "ada_main" names.
+      if CodePeer_Mode then
+         Get_Name_String (Units.Table (First_Unit_Entry).Uname);
+         return "ada_main_for_" &
+           Get_Main_Unit_Name (Name_Buffer (1 .. Name_Len - 2));
+      end if;
+
       --  This loop tries the following possibilities in order
       --    <Ada_Main>
       --    <Ada_Main>_01
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index a38eb59..d6b53d4 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -5178,6 +5178,33 @@ package body Exp_Aggr is
       Comp      : Entity_Id;
       New_Comp  : Node_Id;
 
+      function Has_Visible_Private_Ancestor (Id : E) return Boolean;
+      --  If any ancestor of the current type is private, the aggregate
+      --  cannot be built in place. We canot rely on Has_Private_Ancestor,
+      --  because it will not be set when type and its parent are in the
+      --  same scope, and the parent component needs expansion.
+
+      -----------------------------------
+      --  Has_Visible_Private_Ancestor --
+      -----------------------------------
+
+      function Has_Visible_Private_Ancestor (Id : E) return Boolean is
+         R  : constant Entity_Id := Root_Type (Id);
+         T1 : Entity_Id := Id;
+      begin
+         loop
+            if Is_Private_Type (T1) then
+               return True;
+
+            elsif T1 = R then
+               return False;
+
+            else
+               T1 := Etype (T1);
+            end if;
+         end loop;
+      end Has_Visible_Private_Ancestor;
+
    --  Start of processing for Expand_Record_Aggregate
 
    begin
@@ -5261,7 +5288,7 @@ package body Exp_Aggr is
       --  If an ancestor is private, some components are not inherited and
       --  we cannot expand into a record aggregate
 
-      elsif Has_Private_Ancestor (Typ) then
+      elsif Has_Visible_Private_Ancestor (Typ) then
          Convert_To_Assignments (N, Typ);
 
       --  ??? The following was done to compile fxacc00.ads in the ACVCs. Gigi
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 678948a..a679c29 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -3064,15 +3064,10 @@ package body Exp_Ch7 is
 
       Params := New_List (New_Reference_To (E_Id, Loc));
 
-      --  .NET/JVM
+      --  Standard run-time, .NET/JVM targets, this case handles finalization
+      --  exceptions raised during an abort.
 
-      if VM_Target /= No_VM then
-         Proc_Id := RTE (RE_Reraise_Occurrence);
-
-      --  Standard run-time library, this case handles finalization exceptions
-      --  raised during an abort.
-
-      elsif RTE_Available (RE_Raise_From_Controlled_Operation) then
+      if RTE_Available (RE_Raise_From_Controlled_Operation) then
          Proc_Id := RTE (RE_Raise_From_Controlled_Operation);
          Append_To (Params, New_Reference_To (Abort_Id, Loc));
 
@@ -3494,12 +3489,6 @@ package body Exp_Ch7 is
       Wrap_Node : Node_Id;
 
    begin
-      --  Nothing to do for virtual machines where memory is GCed
-
-      if VM_Target /= No_VM then
-         return;
-      end if;
-
       --  Do not create a transient scope if we are already inside one
 
       for S in reverse Scope_Stack.First .. Scope_Stack.Last loop
@@ -3515,7 +3504,6 @@ package body Exp_Ch7 is
 
          elsif Scope_Stack.Table (S).Entity = Standard_Standard then
             exit;
-
          end if;
       end loop;
 
@@ -7228,23 +7216,12 @@ package body Exp_Ch7 is
       --  Procedure call or raise statement
 
    begin
-      --  .NET/JVM runtime: add choice parameter E and pass it to Reraise_
-      --  Occurrence.
-
-      if VM_Target /= No_VM then
-         E_Occ := Make_Defining_Identifier (Loc, Name_E);
-         Raise_Node :=
-           Make_Procedure_Call_Statement (Loc,
-             Name                   =>
-               New_Reference_To (RTE (RE_Reraise_Occurrence), Loc),
-             Parameter_Associations => New_List (
-               New_Reference_To (E_Occ, Loc)));
-
-      --  Standard runtime: add choice parameter E and pass it to Raise_From_
-      --  Controlled_Operation so that the original exception name and message
-      --  can be recorded in the exception message for Program_Error.
+      --  Standard runtime, .NET/JVM targets: add choice parameter E and pass
+      --  it to Raise_From_Controlled_Operation so that the original exception
+      --  name and message can be recorded in the exception message for
+      --  Program_Error.
 
-      elsif RTE_Available (RE_Raise_From_Controlled_Operation) then
+      if RTE_Available (RE_Raise_From_Controlled_Operation) then
          E_Occ := Make_Defining_Identifier (Loc, Name_E);
          Raise_Node :=
            Make_Procedure_Call_Statement (Loc,
diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb
index 87eeec8..b51e7fb 100644
--- a/gcc/ada/makeutl.adb
+++ b/gcc/ada/makeutl.adb
@@ -1290,7 +1290,6 @@ package body Makeutl is
 
          function Find_File_Add_Extension
            (Tree         : Project_Tree_Ref;
-            Root_Project : Project_Id;
             Base_Main    : String) return Prj.Source_Id;
          --  Search for Main in the project, adding body or spec extensions.
 
@@ -1346,66 +1345,57 @@ package body Makeutl is
 
          function Find_File_Add_Extension
            (Tree         : Project_Tree_Ref;
-            Root_Project : Project_Id;
             Base_Main    : String) return Prj.Source_Id
          is
             Spec_Source : Prj.Source_Id := No_Source;
             Source      : Prj.Source_Id;
-            Project     : Project_Id;
             Iter        : Source_Iterator;
             Suffix      : File_Name_Type;
 
          begin
             Source  := No_Source;
-            Project := Root_Project;
-            while Source = No_Source
-              and then Project /= No_Project
+            Iter := For_Each_Source (Tree);  --  In all projects
             loop
-               Iter := For_Each_Source (Tree, Project);
-               loop
-                  Source := Prj.Element (Iter);
-                  exit when Source = No_Source;
+               Source := Prj.Element (Iter);
+               exit when Source = No_Source;
 
-                  if Source.Kind = Impl then
-                     Get_Name_String (Source.File);
+               if Source.Kind = Impl then
+                  Get_Name_String (Source.File);
 
-                     if Name_Len > Base_Main'Length
-                       and then Name_Buffer (1 .. Base_Main'Length) = Base_Main
-                     then
-                        Suffix :=
-                          Source.Language.Config.Naming_Data.Body_Suffix;
+                  if Name_Len > Base_Main'Length
+                    and then Name_Buffer (1 .. Base_Main'Length) = Base_Main
+                  then
+                     Suffix :=
+                       Source.Language.Config.Naming_Data.Body_Suffix;
 
-                        exit when Suffix /= No_File and then
-                          Name_Buffer (Base_Main'Length + 1 .. Name_Len) =
-                          Get_Name_String (Suffix);
-                     end if;
+                     exit when Suffix /= No_File and then
+                       Name_Buffer (Base_Main'Length + 1 .. Name_Len) =
+                       Get_Name_String (Suffix);
+                  end if;
 
-                  elsif Source.Kind = Spec then
-                     --  A spec needs to be taken into account unless there is
-                     --  also a body. So we delay the decision for them.
+               elsif Source.Kind = Spec then
+                  --  A spec needs to be taken into account unless there is
+                  --  also a body. So we delay the decision for them.
 
-                     Get_Name_String (Source.File);
+                  Get_Name_String (Source.File);
 
-                     if Name_Len > Base_Main'Length
-                       and then Name_Buffer (1 .. Base_Main'Length) = Base_Main
-                     then
-                        Suffix :=
-                          Source.Language.Config.Naming_Data.Spec_Suffix;
+                  if Name_Len > Base_Main'Length
+                    and then Name_Buffer (1 .. Base_Main'Length) = Base_Main
+                  then
+                     Suffix :=
+                       Source.Language.Config.Naming_Data.Spec_Suffix;
 
-                        if Suffix /= No_File
-                          and then
-                            Name_Buffer (Base_Main'Length + 1 .. Name_Len) =
-                            Get_Name_String (Suffix)
-                        then
-                           Spec_Source := Source;
-                        end if;
+                     if Suffix /= No_File
+                       and then
+                         Name_Buffer (Base_Main'Length + 1 .. Name_Len) =
+                         Get_Name_String (Suffix)
+                     then
+                        Spec_Source := Source;
                      end if;
                   end if;
+               end if;
 
-                  Next (Iter);
-               end loop;
-
-               Project := Project.Extends;
+               Next (Iter);
             end loop;
 
             if Source = No_Source then
@@ -1496,7 +1486,7 @@ package body Makeutl is
 
                         if Source = No_Source then
                            Source := Find_File_Add_Extension
-                             (Tree, File.Project, Get_Name_String (Main_Id));
+                             (Tree, Get_Name_String (Main_Id));
                         end if;
 
                         if Is_Absolute
@@ -1510,29 +1500,6 @@ package body Makeutl is
                            Source := No_Source;
                         end if;
 
-                        if Source = No_Source
-                          and then not Is_Absolute
-                        then
-
-                           --  Still not found? Maybe we have a unit name
-
-                           declare
-                              Unit : constant Unit_Index :=
-                                       Units_Htable.Get
-                                         (File.Tree.Units_HT,
-                                          Name_Id (Main_Id));
-
-                           begin
-                              if Unit /= No_Unit_Index then
-                                 Source := Unit.File_Names (Impl);
-
-                                 if Source = No_Source then
-                                    Source := Unit.File_Names (Spec);
-                                 end if;
-                              end if;
-                           end;
-                        end if;
-
                         if Source /= No_Source then
 
                            --  If we have found a multi-unit source file but
@@ -2988,6 +2955,22 @@ package body Makeutl is
                         Shared                  => Project_Tree.Shared,
                         Force_Lower_Case_Index  => False,
                         Allow_Wildcards         => True);
+
+                     --  If not found, try without extension.
+                     --  That's because gnatmake accepts truncated file names
+                     --  in Builder'Switches
+
+                     if Switches_For_Main = Nil_Variable_Value
+                       and then Source.Unit /= null
+                     then
+                        Switches_For_Main := Value_Of
+                          (Name                    => Source.Unit.Name,
+                           Attribute_Or_Array_Name => Name_Switches,
+                           In_Package              => Builder_Package,
+                           Shared                  => Project_Tree.Shared,
+                           Force_Lower_Case_Index  => False,
+                           Allow_Wildcards         => True);
+                     end if;
                   end if;
 
                   if Index = 1 then
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 1fdaae8..a713475 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -5894,23 +5894,32 @@ package Sinfo is
       --  used only internally currently, but is considered to be syntactic.
       --  At the moment, the only cleanup action allowed is a single call to
       --  a parameterless procedure, and the Identifier field of the node is
-      --  the procedure to be called. Also there is a current restriction
-      --  that exception handles and a cleanup cannot be present in the same
-      --  frame, so at least one of Exception_Handlers or the Identifier must
-      --  be missing.
-
-      --  Actually, more accurately, this restriction applies to the original
-      --  source program. In the expanded tree, if the At_End_Proc field is
-      --  present, then there will also be an exception handler of the form:
+      --  the procedure to be called. The cleanup action occurs whenever the
+      --  sequence of statements is left for any reason. The possible reasons
+      --  are:
+      --      1. reaching the end of the sequence
+      --      2. exit, return, or goto
+      --      3. exception or abort
+      --  For some back ends, such as gcc with ZCX, "at end" is implemented
+      --  entirely in the back end. In this case, a handled sequence of
+      --  statements with an "at end" cannot also have exception handlers.
+      --  For other back ends, such as gcc with SJLJ and .NET, the
+      --  implementation is split between the front end and back end; the front
+      --  end implements 3, and the back end implements 1 and 2. In this case,
+      --  if there is an "at end", the front end inserts the appropriate
+      --  exception handler, and this handler takes precedence over "at end"
+      --  in case of exception.
+
+      --  The inserted exception handler is of the form:
 
       --     when all others =>
       --        cleanup;
       --        raise;
 
-      --  where cleanup is the procedure to be generated. The reason we do
-      --  this is so that the front end can handle the necessary entries in
-      --  the exception tables, and other exception handler actions required
-      --  as part of the normal handling for exception handlers.
+      --  where cleanup is the procedure to be called. The reason we do this is
+      --  so that the front end can handle the necessary entries in the
+      --  exception tables, and other exception handler actions required as
+      --  part of the normal handling for exception handlers.
 
       --  The AT END cleanup handler protects only the sequence of statements
       --  (not the associated declarations of the parent), just like exception
diff --git a/gcc/ada/tracebak.c b/gcc/ada/tracebak.c
index 2e29285..eedc715 100644
--- a/gcc/ada/tracebak.c
+++ b/gcc/ada/tracebak.c
@@ -339,7 +339,8 @@ struct layout
 #define STOP_FRAME(CURRENT, TOP_STACK) \
   (IS_BAD_PTR((long)(CURRENT)) \
    || IS_BAD_PTR((long)(CURRENT)->return_address) \
-   || (CURRENT)->return_address == 0|| (CURRENT)->next == 0  \
+   || (CURRENT)->return_address == 0 \
+   || (void *) ((CURRENT)->next) < (TOP_STACK)  \
    || (void *) (CURRENT) < (TOP_STACK))
 
 #define BASE_SKIP (1+FRAME_LEVEL)
diff --git a/gcc/ada/vxaddr2line.adb b/gcc/ada/vxaddr2line.adb
index f1bb48a..028de5e 100644
--- a/gcc/ada/vxaddr2line.adb
+++ b/gcc/ada/vxaddr2line.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2002-2009, AdaCore                     --
+--                     Copyright (C) 2002-2011, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -83,12 +83,17 @@ procedure VxAddr2Line is
 
    --  All supported architectures
    type Architecture is
-     (SOLARIS_I586,
-      WINDOWS_POWERPC,
+     (DEC_ALPHA,
+      LINUX_E500V2,
+      LINUX_I586,
+      LINUX_POWERPC,
+      WINDOWS_E500V2,
       WINDOWS_I586,
       WINDOWS_M68K,
-      SOLARIS_POWERPC,
-      DEC_ALPHA);
+      WINDOWS_POWERPC,
+      SOLARIS_E500V2,
+      SOLARIS_I586,
+      SOLARIS_POWERPC);
 
    type Arch_Record is record
       Addr2line_Binary : String_Access;
@@ -114,17 +119,32 @@ procedure VxAddr2Line is
 
    --  Configuration for each of the architectures
    Arch_List : array (Architecture'Range) of Arch_Record :=
-     (WINDOWS_POWERPC =>
+     (DEC_ALPHA =>
+        (Addr2line_Binary    => null,
+         Nm_Binary           => null,
+         Addr_Digits_To_Skip => 8,
+         Bt_Offset_From_Call => 0),
+      LINUX_E500V2 =>
         (Addr2line_Binary    => null,
          Nm_Binary           => null,
          Addr_Digits_To_Skip => 0,
          Bt_Offset_From_Call => -4),
-      WINDOWS_M68K =>
+      LINUX_I586 =>
+        (Addr2line_Binary    => null,
+         Nm_Binary           => null,
+         Addr_Digits_To_Skip => 0,
+         Bt_Offset_From_Call => -2),
+      LINUX_POWERPC =>
         (Addr2line_Binary    => null,
          Nm_Binary           => null,
          Addr_Digits_To_Skip => 0,
          Bt_Offset_From_Call => -4),
-      WINDOWS_I586 =>
+      SOLARIS_E500V2 =>
+        (Addr2line_Binary    => null,
+         Nm_Binary           => null,
+         Addr_Digits_To_Skip => 0,
+         Bt_Offset_From_Call => -4),
+      SOLARIS_I586 =>
         (Addr2line_Binary    => null,
          Nm_Binary           => null,
          Addr_Digits_To_Skip => 0,
@@ -133,17 +153,27 @@ procedure VxAddr2Line is
         (Addr2line_Binary    => null,
          Nm_Binary           => null,
          Addr_Digits_To_Skip => 0,
-         Bt_Offset_From_Call => 0),
-      SOLARIS_I586 =>
+         Bt_Offset_From_Call => -4),
+      WINDOWS_E500V2 =>
+        (Addr2line_Binary    => null,
+         Nm_Binary           => null,
+         Addr_Digits_To_Skip => 0,
+         Bt_Offset_From_Call => -4),
+      WINDOWS_I586 =>
         (Addr2line_Binary    => null,
          Nm_Binary           => null,
          Addr_Digits_To_Skip => 0,
          Bt_Offset_From_Call => -2),
-      DEC_ALPHA =>
+      WINDOWS_M68K =>
         (Addr2line_Binary    => null,
          Nm_Binary           => null,
-         Addr_Digits_To_Skip => 8,
-         Bt_Offset_From_Call => 0)
+         Addr_Digits_To_Skip => 0,
+         Bt_Offset_From_Call => -4),
+      WINDOWS_POWERPC =>
+        (Addr2line_Binary    => null,
+         Nm_Binary           => null,
+         Addr_Digits_To_Skip => 0,
+         Bt_Offset_From_Call => -4)
      );
 
    --  Current architecture