[multiple changes]

2011-08-29  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch3.adb (Build_Record_Init_Proc.Build_Init_Procedure): Set
	Exception_Handlers to No_List instead of Empty_List in the case where
	there are no handlers.

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

	* gcc-interface/gigi.h (enum standard_datatypes): Add
	ADT_reraise_zcx_decl
	(reraise_zcx_decl): New macro.
	* gcc-interface/trans.c (gnu_incoming_exc_ptr): New variable.
	(gigi): Set reraise_zcx_decl.
	(Exception_Handler_to_gnu_zcx): Save and restore gnu_incoming_exc_ptr.
	(gnat_to_gnu): Handle N_Raise_Statement.

From-SVN: r178212

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 53f5eee019e3291fc7855ae108751235c1394309..f00b143bbf03b388f55176b050a71906337c2295 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,19 @@
+2011-08-29  Gary Dismukes  <dismukes@adacore.com>
+
+       * exp_ch3.adb (Build_Record_Init_Proc.Build_Init_Procedure): Set
+       Exception_Handlers to No_List instead of Empty_List in the case where
+       there are no handlers.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+       * gcc-interface/gigi.h (enum standard_datatypes): Add
+       ADT_reraise_zcx_decl
+       (reraise_zcx_decl): New macro.
+       * gcc-interface/trans.c (gnu_incoming_exc_ptr): New variable.
+       (gigi): Set reraise_zcx_decl.
+       (Exception_Handler_to_gnu_zcx): Save and restore gnu_incoming_exc_ptr.
+       (gnat_to_gnu): Handle N_Raise_Statement.
+
 2011-08-29  Robert Dewar  <dewar@adacore.com>
 
        * sem_ch6.adb, exp_ch3.adb, s-stposu.adb, a-undesu.ads,

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index a7d382bf3d7a1c7484dca95a06e89e4f409beca7..818653062f2bd3b6515d325485e1eb41357cb810 100644 (file)
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -2616,7 +2616,7 @@ package body Exp_Ch3 is
                      Make_Raise_Statement (Loc)))));
             end;
          else
-            Set_Exception_Handlers (Handled_Stmt_Node, Empty_List);
+            Set_Exception_Handlers (Handled_Stmt_Node, No_List);
          end if;
 
          Set_Handled_Statement_Sequence (Body_Node, Handled_Stmt_Node);

diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index 04c0825b52e8f0b77b2ae598f5d4c8eb669aec50..dbe2dc4393b6a4178c9e048a29449273a163b438 100644 (file)
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -377,6 +377,7 @@ enum standard_datatypes
   ADT_longjmp_decl,
   ADT_update_setjmp_buf_decl,
   ADT_raise_nodefer_decl,
+  ADT_reraise_zcx_decl,
   ADT_begin_handler_decl,
   ADT_end_handler_decl,
   ADT_others_decl,
@@ -422,6 +423,7 @@ extern GTY(()) tree gnat_raise_decls_ext[(int) LAST_REASON_CODE + 1];
 #define longjmp_decl gnat_std_decls[(int) ADT_longjmp_decl]
 #define update_setjmp_buf_decl gnat_std_decls[(int) ADT_update_setjmp_buf_decl]
 #define raise_nodefer_decl gnat_std_decls[(int) ADT_raise_nodefer_decl]
+#define reraise_zcx_decl gnat_std_decls[(int) ADT_reraise_zcx_decl]
 #define begin_handler_decl gnat_std_decls[(int) ADT_begin_handler_decl]
 #define others_decl gnat_std_decls[(int) ADT_others_decl]
 #define all_others_decl gnat_std_decls[(int) ADT_all_others_decl]

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index b0b83b3383baf9ad29909b658f6ff2bffa3bebe0..8e0ccd41701dc389e245e525f5ff48abee334cb4 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -165,6 +165,9 @@ static GTY(()) struct elab_info *elab_info_list;
    are in an exception handler.  Not used in the zero-cost case.  */
 static GTY(()) VEC(tree,gc) *gnu_except_ptr_stack;
 
+/* In ZCX case, current exception pointer.  Used to re-raise it.  */
+static GTY(()) tree gnu_incoming_exc_ptr;
+
 /* Stack for storing the current elaboration procedure decl.  */
 static GTY(()) VEC(tree,gc) *gnu_elab_proc_stack;
 
@@ -448,6 +451,12 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
                           Empty);
   DECL_IGNORED_P (end_handler_decl) = 1;
 
+  reraise_zcx_decl
+    = create_subprog_decl (get_identifier ("__gnat_reraise_zcx"), NULL_TREE,
+                          ftype, NULL_TREE, false, true, true, true, NULL,
+                          Empty);
+  DECL_IGNORED_P (reraise_zcx_decl) = 1;
+
   /* If in no exception handlers mode, all raise statements are redirected to
      __gnat_last_chance_handler.  No need to redefine raise_nodefer_decl since
      this procedure will never be called in this mode.  */
@@ -559,8 +568,8 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
     longest_float_type_node = TREE_TYPE (long_long_float_type);
 
   /* Dummy objects to materialize "others" and "all others" in the exception
-     tables.  These are exported by a-exexpr.adb, so see this unit for the
-     types to use.  */
+     tables.  These are exported by a-exexpr-gcc.adb, so see this unit for
+     the types to use.  */
   others_decl
     = create_var_decl (get_identifier ("OTHERS"),
                       get_identifier ("__gnat_others_value"),
@@ -3760,7 +3769,7 @@ Exception_Handler_to_gnu_zcx (Node_Id gnat_node)
   tree gnu_expr;
   tree gnu_etype;
   tree gnu_current_exc_ptr;
-  tree gnu_incoming_exc_ptr;
+  tree prev_gnu_incoming_exc_ptr;
   Node_Id gnat_temp;
 
   /* We build a TREE_LIST of nodes representing what exception types this
@@ -3832,6 +3841,7 @@ Exception_Handler_to_gnu_zcx (Node_Id gnat_node)
   gnu_current_exc_ptr
     = build_call_expr (built_in_decls [BUILT_IN_EH_POINTER],
                       1, integer_zero_node);
+  prev_gnu_incoming_exc_ptr = gnu_incoming_exc_ptr;
   gnu_incoming_exc_ptr = create_var_decl (get_identifier ("EXPTR"), NULL_TREE,
                                          ptr_type_node, gnu_current_exc_ptr,
                                          false, false, false, false,
@@ -3846,6 +3856,8 @@ Exception_Handler_to_gnu_zcx (Node_Id gnat_node)
   add_stmt_list (Statements (gnat_node));
   gnat_poplevel ();
 
+  gnu_incoming_exc_ptr = prev_gnu_incoming_exc_ptr;
+
   return build2 (CATCH_EXPR, void_type_node, gnu_etypes_list,
                 end_stmt_group ());
 }
@@ -5452,7 +5464,27 @@ gnat_to_gnu (Node_Id gnat_node)
        gnu_result = Exception_Handler_to_gnu_zcx (gnat_node);
       else
        gcc_unreachable ();
+      break;
+
+    case N_Raise_Statement:
+      /* Only for reraise in back-end exceptions mode.  */
+      gcc_assert (No (Name (gnat_node))
+                 && Exception_Mechanism == Back_End_Exceptions);
+
+      start_stmt_group ();
+      gnat_pushlevel ();
 
+      /* Clear the current exception pointer so that the occurrence won't be
+        deallocated.  */
+      gnu_expr = create_var_decl (get_identifier ("SAVED_EXPTR"), NULL_TREE,
+                                 ptr_type_node, gnu_incoming_exc_ptr,
+                                 false, false, false, false, NULL, gnat_node);
+
+      add_stmt (build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_incoming_exc_ptr,
+                                convert (ptr_type_node, integer_zero_node)));
+      add_stmt (build_call_1_expr (reraise_zcx_decl, gnu_expr));
+      gnat_poplevel ();
+      gnu_result = end_stmt_group ();
       break;
 
     case N_Push_Constraint_Error_Label: