[multiple changes]

2011-08-29  Tristan Gingold  <gingold@adacore.com>

	* a-exexpr-gcc.adb (Unwind_Action) Rewrite as an integer with constants.
	(GNAT_GCC_Exception): Remove N_Cleanups_To_Trigger component.
	(Adjust_N_CLeanups_For): Remove.
	(CleanupUnwind_Handler): Call Unhandled_Exception_Terminate when end of
	stack is reached.
	(Propgate_Exception): Adjust.
	* raise-gcc.c: Add a few static/const.
	(Adjust_N_Cleanups_For): Remove declaration.
	(PERSONALITY_FUNCTION): Remove code dealing with N_Cleanups_To_Trigger.

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

	* sem_ch8.adb: Use type of function return when rewriting as object
	declaration.

From-SVN: r178188

4 files changed, 50 insertions, 73 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8997586..0440dda 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,20 @@
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* a-exexpr-gcc.adb (Unwind_Action) Rewrite as an integer with constants.
+	(GNAT_GCC_Exception): Remove N_Cleanups_To_Trigger component.
+	(Adjust_N_CLeanups_For): Remove.
+	(CleanupUnwind_Handler): Call Unhandled_Exception_Terminate when end of
+	stack is reached.
+	(Propgate_Exception): Adjust.
+	* raise-gcc.c: Add a few static/const.
+	(Adjust_N_Cleanups_For): Remove declaration.
+	(PERSONALITY_FUNCTION): Remove code dealing with N_Cleanups_To_Trigger.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch8.adb: Use type of function return when rewriting as object
+	declaration.
+
 2011-08-29  Gary Dismukes  <dismukes@adacore.com>
 
 	* sem_type.adb: Minor reformatting.
diff --git a/gcc/ada/a-exexpr-gcc.adb b/gcc/ada/a-exexpr-gcc.adb
index 358f6fa..00dab03 100644
--- a/gcc/ada/a-exexpr-gcc.adb
+++ b/gcc/ada/a-exexpr-gcc.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -76,20 +76,21 @@ package body Exception_Propagation is
 
    --  Phase identifiers
 
-   type Unwind_Action is
+   type Unwind_Action is new Integer;
+   pragma Convention (C, Unwind_Action);
+
+   UA_SEARCH_PHASE  : constant Unwind_Action := 1;
+   UA_CLEANUP_PHASE : constant Unwind_Action := 2;
+   UA_HANDLER_FRAME : constant Unwind_Action := 4;
+   UA_FORCE_UNWIND  : constant Unwind_Action := 8;
+   UA_END_OF_STACK  : constant Unwind_Action := 16;  --  GCC extension ?
+
+   pragma Unreferenced
      (UA_SEARCH_PHASE,
       UA_CLEANUP_PHASE,
       UA_HANDLER_FRAME,
       UA_FORCE_UNWIND);
 
-   for Unwind_Action use
-      (UA_SEARCH_PHASE  => 1,
-       UA_CLEANUP_PHASE => 2,
-       UA_HANDLER_FRAME => 4,
-       UA_FORCE_UNWIND  => 8);
-
-   pragma Convention (C, Unwind_Action);
-
    --  Mandatory common header for any exception object handled by the
    --  GCC unwinding runtime.
 
@@ -132,13 +133,6 @@ package body Exception_Propagation is
       --  and then used by the personality routine to determine if the context
       --  it examines contains a handler for the exception being propagated.
 
-      N_Cleanups_To_Trigger : Integer;
-      --  Number of cleanup only frames encountered in SEARCH phase.  This is
-      --  initialized to 0 by Propagate_Exception and maintained by the
-      --  personality routine to control a forced unwinding phase triggering
-      --  all the cleanups before calling Unhandled_Exception_Terminate when
-      --  an exception is not handled.
-
       Next_Exception : EOA;
       --  Used to create a linked list of exception occurrences
    end record;
@@ -264,11 +258,6 @@ package body Exception_Propagation is
      return Exception_Id;
    pragma Export (C, EID_For, "__gnat_eid_for");
 
-   procedure Adjust_N_Cleanups_For
-     (GNAT_Exception : GNAT_GCC_Exception_Access;
-      Adjustment     : Integer);
-   pragma Export (C, Adjust_N_Cleanups_For, "__gnat_adjust_n_cleanups_for");
-
    ---------------------------------------------------------------------------
    -- Objects to materialize "others" and "all others" in the GCC EH tables --
    ---------------------------------------------------------------------------
@@ -357,19 +346,18 @@ package body Exception_Propagation is
       UW_Argument  : System.Address) return Unwind_Reason_Code
    is
       pragma Unreferenced
-        (UW_Version, UW_Phases, UW_Eclass, UW_Context, UW_Argument);
+        (UW_Version, UW_Eclass, UW_Exception, UW_Context, UW_Argument);
 
    begin
-      --  Terminate as soon as we know there is nothing more to run. The
-      --  count is maintained by the personality routine.
+      --  Terminate when the end of the stack is reached
 
-      if UW_Exception.N_Cleanups_To_Trigger = 0 then
+      if UW_Phases >= UA_END_OF_STACK then
          Unhandled_Exception_Terminate;
       end if;
 
       --  We know there is at least one cleanup further up. Return so that it
       --  is searched and entered, after which Unwind_Resume will be called
-      --  and this hook will gain control (with an updated count) again.
+      --  and this hook will gain control again.
 
       return URC_NO_REASON;
    end CleanupUnwind_Handler;
@@ -553,7 +541,6 @@ package body Exception_Propagation is
       Clear_Setup_And_Not_Propagated (Excep);
 
       GCC_Exception.Id := Excep.Id;
-      GCC_Exception.N_Cleanups_To_Trigger := 0;
 
       --  Compute the backtrace for this occurrence if the corresponding
       --  binder option has been set. Call_Chain takes care of the reraise
@@ -581,8 +568,7 @@ package body Exception_Propagation is
       --  Perform a standard raise first. If a regular handler is found, it
       --  will be entered after all the intermediate cleanups have run. If
       --  there is no regular handler, control will get back to after the
-      --  call, with N_Cleanups_To_Trigger set to the number of frames with
-      --  cleanups found on the way up, and none of these already run.
+      --  call.
 
       Unwind_RaiseException (GCC_Exception);
 
@@ -593,36 +579,21 @@ package body Exception_Propagation is
 
       Notify_Unhandled_Exception;
 
-      --  Now, if cleanups have been found, run a forced unwind to trigger
-      --  them. Control should not resume there, as the unwinding hook calls
-      --  Unhandled_Exception_Terminate as soon as the last cleanup has been
-      --  triggered.
+      --  Now, un a forced unwind to trigger cleanups. Control should not
+      --  resume there, if there are cleanups and in any cases as the
+      --  unwinding hook calls Unhandled_Exception_Terminate when end of stack
+      --  is reached.
 
-      if GCC_Exception.N_Cleanups_To_Trigger /= 0 then
-         Unwind_ForcedUnwind (GCC_Exception,
-                              CleanupUnwind_Handler'Address,
-                              System.Null_Address);
-      end if;
+      Unwind_ForcedUnwind (GCC_Exception,
+                           CleanupUnwind_Handler'Address,
+                           System.Null_Address);
 
-      --  We get here when there is no handler or cleanup to be run at all.
+      --  We get here in case of error.
       --  The debugger has been notified before the second step above.
 
       Unhandled_Exception_Terminate;
    end Propagate_Exception;
 
-   ---------------------------
-   -- Adjust_N_Cleanups_For --
-   ---------------------------
-
-   procedure Adjust_N_Cleanups_For
-     (GNAT_Exception : GNAT_GCC_Exception_Access;
-      Adjustment     : Integer)
-   is
-   begin
-      GNAT_Exception.N_Cleanups_To_Trigger :=
-        GNAT_Exception.N_Cleanups_To_Trigger + Adjustment;
-   end Adjust_N_Cleanups_For;
-
    -------------
    -- EID_For --
    -------------
diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c
index 3a88727..fb0ec81 100644
--- a/gcc/ada/raise-gcc.c
+++ b/gcc/ada/raise-gcc.c
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *             Copyright (C) 1992-2010, Free Software Foundation, Inc.      *
+ *             Copyright (C) 1992-2011, 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- *
@@ -128,7 +128,7 @@ typedef struct
   char * description;
 } phase_descriptor;
 
-static phase_descriptor phase_descriptors[]
+static const phase_descriptor phase_descriptors[]
   = {{ _UA_SEARCH_PHASE,  "SEARCH_PHASE" },
      { _UA_CLEANUP_PHASE, "CLEANUP_PHASE" },
      { _UA_HANDLER_FRAME, "HANDLER_FRAME" },
@@ -622,7 +622,7 @@ typedef enum
 } action_kind;
 
 /* filter value for cleanup actions.  */
-const int cleanup_filter = 0;
+static const int cleanup_filter = 0;
 
 typedef struct
 {
@@ -842,7 +842,6 @@ get_call_site_action_for (_Unwind_Context *uw_context,
 #define Language_For          __gnat_language_for
 #define Import_Code_For       __gnat_import_code_for
 #define EID_For               __gnat_eid_for
-#define Adjust_N_Cleanups_For __gnat_adjust_n_cleanups_for
 
 extern bool Is_Handled_By_Others (_Unwind_Ptr eid);
 extern char Language_For (_Unwind_Ptr eid);
@@ -850,7 +849,6 @@ extern char Language_For (_Unwind_Ptr eid);
 extern Exception_Code Import_Code_For (_Unwind_Ptr eid);
 
 extern Exception_Id EID_For (_GNAT_Exception * e);
-extern void Adjust_N_Cleanups_For (_GNAT_Exception * e, int n);
 
 static int
 is_handled_by (_Unwind_Ptr choice, _GNAT_Exception * propagated_exception)
@@ -1142,7 +1140,6 @@ PERSONALITY_FUNCTION (version_arg_t version_arg,
     {
       if (action.kind == cleanup)
 	{
-	  Adjust_N_Cleanups_For (gnat_exception, 1);
 	  return _URC_CONTINUE_UNWIND;
 	}
       else
@@ -1160,14 +1157,6 @@ PERSONALITY_FUNCTION (version_arg_t version_arg,
      occurrence (we are in a FORCED_UNWIND phase in this case). Install the
      context to get there.  */
 
-  /* If we are going to install a cleanup context, decrement the cleanup
-     count.  This is required in a FORCED_UNWINDing phase (for an unhandled
-     exception), as this is used from the forced unwinding handler in
-     Ada.Exceptions.Exception_Propagation to decide whether unwinding should
-     proceed further or Unhandled_Exception_Terminate should be called.  */
-  if (action.kind == cleanup)
-    Adjust_N_Cleanups_For (gnat_exception, -1);
-
   setup_to_install
     (uw_context, uw_exception, action.landing_pad, action.ttype_filter);
 
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 8a14462..0b9ab13 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -814,7 +814,7 @@ package body Sem_Ch8 is
 
          if Nkind (Nam) = N_Function_Call
            and then Is_Immutably_Limited_Type (Etype (Nam))
-           and then not Is_Constrained (T)
+           and then not Is_Constrained (Etype (Nam))
            and then Comes_From_Source (N)
          then
             Set_Etype (Id, T);
@@ -823,7 +823,7 @@ package body Sem_Ch8 is
               Make_Object_Declaration (Loc,
                 Defining_Identifier => Id,
                 Constant_Present    => True,
-                Object_Definition   => New_Occurrence_Of (T, Loc),
+                Object_Definition   => New_Occurrence_Of (Etype (Nam), Loc),
                 Expression          => Relocate_Node (Nam)));
             return;
          end if;
@@ -851,9 +851,9 @@ package body Sem_Ch8 is
 
          --  Ada 2005 AI05-105: if the declaration has an anonymous access
          --  type, the renamed object must also have an anonymous type, and
-         --  this is a name resolution rule. This was implicit in the last
-         --  part of the first sentence in 8.5.1.(3/2), and is made explicit
-         --  by this recent AI.
+         --  this is a name resolution rule. This was implicit in the last part
+         --  of the first sentence in 8.5.1(3/2), and is made explicit by this
+         --  recent AI.
 
          if not Is_Overloaded (Nam) then
             if Ekind (Etype (Nam)) /= Ekind (T) then
@@ -994,7 +994,7 @@ package body Sem_Ch8 is
 
       T2 := Etype (Nam);
 
-      --  (Ada 2005: AI-326): Handle wrong use of incomplete type
+      --  Ada 2005 (AI-326): Handle wrong use of incomplete type
 
       if Nkind (Nam) = N_Explicit_Dereference
         and then Ekind (Etype (T2)) = E_Incomplete_Type