diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 64ac98ba1f4cd0fcc6b80cced116e2fb6cd48b14..bcfc8cc1ae4578a31c9c26972b25c66b72a5e63f 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+2019-08-02 Alexandre Oliva <oliva@adacore.com>
+
+ * libgnat/a-exexpr.adb (Begin_Handler_v1, End_Handler_v1): New.
+ (Claimed_Cleanup): New.
+ (Begin_Handler, End_Handler): Document.
+ * gcc-interface/trans.c (gigi): Switch to exception handler
+ ABI #1.
+ (Exception_Handler_to_gnu_gcc): Save the original cleanup
+ returned by begin handler, pass it to end handler, and use
+ EH_ELSE_EXPR to pass a propagating exception to end handler.
+ (gnat_to_gnu): Leave the exception pointer alone for reraise.
+ (add_cleanup): Handle EH_ELSE_EXPR, require it by itself.
+
2019-07-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Check_Aspect_At_End_Of_Declarations,
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 6cd37598d396240d743ca3235b201556987951a6..b484bc78532a62e293eea29878c1e4e51d5364d8 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -524,22 +524,27 @@ gigi (Node_Id gnat_root,
NULL_TREE, is_default, true, true, true, false, false, NULL, Empty);
/* Hooks to call when entering/leaving an exception handler. */
- ftype = build_function_type_list (void_type_node, ptr_type_node, NULL_TREE);
-
+ ftype = build_function_type_list (ptr_type_node,
+ ptr_type_node, NULL_TREE);
begin_handler_decl
- = create_subprog_decl (get_identifier ("__gnat_begin_handler"), NULL_TREE,
- ftype, NULL_TREE,
+ = create_subprog_decl (get_identifier ("__gnat_begin_handler_v1"),
+ NULL_TREE, ftype, NULL_TREE,
is_default, true, true, true, false, false, NULL,
Empty);
- /* __gnat_begin_handler is a dummy procedure. */
+ /* __gnat_begin_handler_v1 is not a dummy procedure, but we arrange
+ for it not to throw. */
TREE_NOTHROW (begin_handler_decl) = 1;
+ ftype = build_function_type_list (ptr_type_node,
+ ptr_type_node, ptr_type_node,
+ ptr_type_node, NULL_TREE);
end_handler_decl
- = create_subprog_decl (get_identifier ("__gnat_end_handler"), NULL_TREE,
+ = create_subprog_decl (get_identifier ("__gnat_end_handler_v1"), NULL_TREE,
ftype, NULL_TREE,
is_default, true, true, true, false, false, NULL,
Empty);
+ ftype = build_function_type_list (void_type_node, ptr_type_node, NULL_TREE);
unhandled_except_decl
= create_subprog_decl (get_identifier ("__gnat_unhandled_except_handler"),
NULL_TREE, ftype, NULL_TREE,
@@ -6201,37 +6206,55 @@ Exception_Handler_to_gnu_gcc (Node_Id gnat_node)
start_stmt_group ();
gnat_pushlevel ();
- /* Expand a call to the begin_handler hook at the beginning of the handler,
- and arrange for a call to the end_handler hook to occur on every possible
- exit path.
+ /* Expand a call to the begin_handler hook at the beginning of the
+ handler, and arrange for a call to the end_handler hook to occur
+ on every possible exit path. GDB sets a breakpoint in the
+ begin_handler for catchpoints.
- The hooks expect a pointer to the low level occurrence. This is required
- for our stack management scheme because a raise inside the handler pushes
- a new occurrence on top of the stack, which means that this top does not
- necessarily match the occurrence this handler was dealing with.
+ A v1 begin handler saves the cleanup from the exception object,
+ and marks the exception as in use, so that it will not be
+ released by other handlers. A v1 end handler restores the
+ cleanup and releases the exception object, unless it is still
+ claimed, or the exception is being propagated (reraised).
__builtin_eh_pointer references the exception occurrence being
- propagated. Upon handler entry, this is the exception for which the
- handler is triggered. This might not be the case upon handler exit,
- however, as we might have a new occurrence propagated by the handler's
- body, and the end_handler hook called as a cleanup in this context.
-
- We use a local variable to retrieve the incoming value at handler entry
- time, and reuse it to feed the end_handler hook's argument at exit. */
-
+ handled or propagated. Within the handler region, it is the
+ former, but within the else branch of the EH_ELSE_EXPR, i.e. the
+ exceptional cleanup path, it is the latter, so we must save the
+ occurrence being handled early on, so that, should an exception
+ be (re)raised, we can release the current exception, or figure
+ out we're not to release it because we're propagating a reraise
+ thereof.
+
+ We use local variables to retrieve the incoming value at handler
+ entry time (EXPTR), the saved cleanup (EXCLN) and the token
+ (EXVTK), and reuse them to feed the end_handler hook's argument
+ at exit. */
+
+ /* CODE: void *EXPTR = __builtin_eh_pointer (0); */
tree gnu_current_exc_ptr
= build_call_expr (builtin_decl_explicit (BUILT_IN_EH_POINTER),
1, integer_zero_node);
- tree prev_gnu_incoming_exc_ptr = gnu_incoming_exc_ptr;
- gnu_incoming_exc_ptr
+ tree exc_ptr
= create_var_decl (get_identifier ("EXPTR"), NULL_TREE,
ptr_type_node, gnu_current_exc_ptr,
- false, false, false, false, false, true, true,
+ true, false, false, false, false, true, true,
NULL, gnat_node);
- add_stmt_with_node (build_call_n_expr (begin_handler_decl, 1,
- gnu_incoming_exc_ptr),
- gnat_node);
+ tree prev_gnu_incoming_exc_ptr = gnu_incoming_exc_ptr;
+ gnu_incoming_exc_ptr = exc_ptr;
+
+ /* begin_handler_decl must not throw, so we can use it as an
+ initializer for a variable used in cleanups.
+
+ CODE: void *EXCLN = __gnat_begin_handler_v1 (EXPTR); */
+ tree exc_cleanup
+ = create_var_decl (get_identifier ("EXCLN"), NULL_TREE,
+ ptr_type_node,
+ build_call_n_expr (begin_handler_decl, 1,
+ exc_ptr),
+ true, false, false, false, false,
+ true, true, NULL, gnat_node);
/* Declare and initialize the choice parameter, if present. */
if (Present (Choice_Parameter (gnat_node)))
@@ -6239,21 +6262,64 @@ Exception_Handler_to_gnu_gcc (Node_Id gnat_node)
tree gnu_param
= gnat_to_gnu_entity (Choice_Parameter (gnat_node), NULL_TREE, true);
+ /* CODE: __gnat_set_exception_parameter (&choice_param, EXPTR); */
add_stmt (build_call_n_expr
(set_exception_parameter_decl, 2,
build_unary_op (ADDR_EXPR, NULL_TREE, gnu_param),
gnu_incoming_exc_ptr));
}
+ /* CODE: <handler proper> */
add_stmt_list (Statements (gnat_node));
- /* We don't have an End_Label at hand to set the location of the cleanup
- actions, so we use that of the exception handler itself instead. */
- tree stmt = build_call_n_expr (end_handler_decl, 1, gnu_incoming_exc_ptr);
+ tree call = build_call_n_expr (end_handler_decl, 3,
+ exc_ptr,
+ exc_cleanup,
+ null_pointer_node);
+ /* If the handler can only end by falling off the end, don't bother
+ with cleanups. */
if (stmt_list_cannot_alter_control_flow_p (Statements (gnat_node)))
- add_stmt_with_node (stmt, gnat_node);
+ /* CODE: __gnat_end_handler_v1 (EXPTR, EXCLN, NULL); */
+ add_stmt_with_node (call, gnat_node);
+ /* Otherwise, all of the above is after
+ CODE: try {
+
+ The call above will appear after
+ CODE: } finally {
+
+ And the code below will appear after
+ CODE: } else {
+
+ The else block to a finally block is taken instead of the finally
+ block when an exception propagates out of the try block. */
else
- add_cleanup (stmt, gnat_node);
+ {
+ start_stmt_group ();
+ gnat_pushlevel ();
+ /* CODE: void *EXPRP = __builtin_eh_handler (0); */
+ tree prop_ptr
+ = create_var_decl (get_identifier ("EXPRP"), NULL_TREE,
+ ptr_type_node,
+ build_call_expr (builtin_decl_explicit
+ (BUILT_IN_EH_POINTER),
+ 1, integer_zero_node),
+ true, false, false, false, false,
+ true, true, NULL, gnat_node);
+
+ /* CODE: __gnat_end_handler_v1 (EXPTR, EXCLN, EXPRP); */
+ tree ecall = build_call_n_expr (end_handler_decl, 3,
+ exc_ptr,
+ exc_cleanup,
+ prop_ptr);
+
+ add_stmt_with_node (ecall, gnat_node);
+
+ /* CODE: } */
+ gnat_poplevel ();
+ tree eblk = end_stmt_group ();
+ tree ehls = build2 (EH_ELSE_EXPR, void_type_node, call, eblk);
+ add_cleanup (ehls, gnat_node);
+ }
gnat_poplevel ();
@@ -8270,19 +8336,11 @@ gnat_to_gnu (Node_Id gnat_node)
gcc_assert (No (Name (gnat_node)) && 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, false,
- true, true, NULL, gnat_node);
+ add_stmt_with_node (build_call_n_expr (reraise_zcx_decl, 1,
+ gnu_incoming_exc_ptr),
+ gnat_node);
- add_stmt (build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_incoming_exc_ptr,
- build_int_cst (ptr_type_node, 0)));
- add_stmt (build_call_n_expr (reraise_zcx_decl, 1, gnu_expr));
- gnat_poplevel ();
gnu_result = end_stmt_group ();
break;
@@ -9073,7 +9131,23 @@ add_cleanup (tree gnu_cleanup, Node_Id gnat_node)
{
if (Present (gnat_node))
set_expr_location_from_node (gnu_cleanup, gnat_node, true);
- append_to_statement_list (gnu_cleanup, ¤t_stmt_group->cleanups);
+ /* An EH_ELSE_EXPR must be by itself, and that's all we need when we
+ use it. The assert below makes sure that is so. Should we ever
+ need more than that, we could combine EH_ELSE_EXPRs, and copy
+ non-EH_ELSE_EXPR stmts into both cleanup paths of an
+ EH_ELSE_EXPR. */
+ if (TREE_CODE (gnu_cleanup) == EH_ELSE_EXPR)
+ {
+ gcc_assert (!current_stmt_group->cleanups);
+ current_stmt_group->cleanups = gnu_cleanup;
+ }
+ else
+ {
+ gcc_assert (!current_stmt_group->cleanups
+ || (TREE_CODE (current_stmt_group->cleanups)
+ != EH_ELSE_EXPR));
+ append_to_statement_list (gnu_cleanup, ¤t_stmt_group->cleanups);
+ }
}
/* Set the BLOCK node corresponding to the current code group to GNU_BLOCK. */
diff --git a/gcc/ada/libgnat/a-exexpr.adb b/gcc/ada/libgnat/a-exexpr.adb
index b1aa1c6e6ba6022bb86abc5e5ee3cb7b45dbefea..5e72fd6e3f2a5df5727de8d93e5fc6de6fc90058 100644
--- a/gcc/ada/libgnat/a-exexpr.adb
+++ b/gcc/ada/libgnat/a-exexpr.adb
@@ -197,15 +197,75 @@ package body Exception_Propagation is
-- whose machine occurrence is Mo. The message is empty, the backtrace
-- is empty too and the exception identity is Foreign_Exception.
- -- Hooks called when entering/leaving an exception handler for a given
- -- occurrence, aimed at handling the stack of active occurrences. The
- -- calls are generated by gigi in tree_transform/N_Exception_Handler.
+ -- Hooks called when entering/leaving an exception handler for a
+ -- given occurrence. The calls are generated by gigi in
+ -- Exception_Handler_to_gnu_gcc.
+
+ -- Begin_Handler_v1, called when entering an exception handler,
+ -- claims responsibility for the handler to release the
+ -- GCC_Exception occurrence. End_Handler_v1, called when
+ -- leaving the handler, releases the occurrence, unless the
+ -- occurrence is propagating further up, or the handler is
+ -- dynamically nested in the context of another handler that
+ -- claimed responsibility for releasing that occurrence.
+
+ -- Responsibility is claimed by changing the Cleanup field to
+ -- Claimed_Cleanup, which enables claimed exceptions to be
+ -- recognized, and avoids accidental releases even by foreign
+ -- handlers.
+
+ function Begin_Handler_v1
+ (GCC_Exception : not null GCC_Exception_Access)
+ return System.Address;
+ pragma Export (C, Begin_Handler_v1, "__gnat_begin_handler_v1");
+ -- Called when entering an exception handler. Claim
+ -- responsibility for releasing GCC_Exception, by setting the
+ -- cleanup/release function to Claimed_Cleanup, and return the
+ -- address of the previous cleanup/release function.
+
+ procedure End_Handler_v1
+ (GCC_Exception : not null GCC_Exception_Access;
+ Saved_Cleanup : System.Address;
+ Propagating_Exception : GCC_Exception_Access);
+ pragma Export (C, End_Handler_v1, "__gnat_end_handler_v1");
+ -- Called when leaving an exception handler. Restore the
+ -- Saved_Cleanup in the GCC_Exception occurrence, and then release
+ -- it, unless it remains claimed by an enclosing handler, or
+ -- GCC_Exception and Propagating_Exception are the same
+ -- occurrence. Propagating_Exception could be either an
+ -- occurrence (re)raised within the handler of GCC_Exception, when
+ -- we're executing as an exceptional cleanup, or null, if we're
+ -- completing the handler of GCC_Exception normally.
+
+ procedure Claimed_Cleanup
+ (Reason : Unwind_Reason_Code;
+ GCC_Exception : not null GCC_Exception_Access);
+ pragma Export (C, Claimed_Cleanup, "__gnat_claimed_cleanup");
+ -- A do-nothing placeholder installed as GCC_Exception.Cleanup
+ -- while handling GCC_Exception, to claim responsibility for
+ -- releasing it, and to stop it from being accidentally released.
+
+ -- The following are version 0 implementations of the version 1
+ -- hooks above. They remain in place for compatibility with the
+ -- output of compilers that still use version 0, such as those
+ -- used during bootstrap. They are interoperable with the v1
+ -- hooks, except that the older versions may malfunction when
+ -- handling foreign exceptions passed to Reraise_Occurrence.
procedure Begin_Handler (GCC_Exception : not null GCC_Exception_Access);
pragma Export (C, Begin_Handler, "__gnat_begin_handler");
+ -- Called when entering an exception handler translated by an old
+ -- compiler. It does nothing.
procedure End_Handler (GCC_Exception : GCC_Exception_Access);
pragma Export (C, End_Handler, "__gnat_end_handler");
+ -- Called when leaving an exception handler translated by an old
+ -- compiler. It releases GCC_Exception, unless it is null. It is
+ -- only ever null when the handler has a 'raise;' translated by a
+ -- v0-using compiler. The artificial handler variable passed to
+ -- End_Handler was set to null to tell End_Handler to refrain from
+ -- releasing the reraised exception. In v1 safer ways are used to
+ -- accomplish that.
--------------------------------------------------------------------
-- Accessors to Basic Components of a GNAT Exception Data Pointer --
@@ -352,6 +412,128 @@ package body Exception_Propagation is
end if;
end Setup_Current_Excep;
+ ----------------------
+ -- Begin_Handler_v1 --
+ ----------------------
+
+ function Begin_Handler_v1
+ (GCC_Exception : not null GCC_Exception_Access)
+ return System.Address is
+ Saved_Cleanup : constant System.Address := GCC_Exception.Cleanup;
+ begin
+ -- Claim responsibility for releasing this exception, and stop
+ -- others from releasing it.
+ GCC_Exception.Cleanup := Claimed_Cleanup'Address;
+ return Saved_Cleanup;
+ end Begin_Handler_v1;
+
+ --------------------
+ -- End_Handler_v1 --
+ --------------------
+
+ procedure End_Handler_v1
+ (GCC_Exception : not null GCC_Exception_Access;
+ Saved_Cleanup : System.Address;
+ Propagating_Exception : GCC_Exception_Access) is
+ begin
+ GCC_Exception.Cleanup := Saved_Cleanup;
+ -- Restore the Saved_Cleanup, so that it is either used to
+ -- release GCC_Exception below, or transferred to the next
+ -- handler of the Propagating_Exception occurrence. The
+ -- following test ensures that an occurrence is only released
+ -- once, even after reraises.
+ --
+ -- The idea is that the GCC_Exception is not to be released
+ -- unless it had an unclaimed Cleanup when the handler started
+ -- (see Begin_Handler_v1 above), but if we propagate across its
+ -- handler a reraise of the same exception, we transfer to the
+ -- Propagating_Exception the responsibility for running the
+ -- Saved_Cleanup when its handler completes.
+ --
+ -- This ownership transfer mechanism ensures safety, as in
+ -- single release and no dangling pointers, because there is no
+ -- way to hold on to the Machine_Occurrence of an
+ -- Exception_Occurrence: the only situations in which another
+ -- Exception_Occurrence gets the same Machine_Occurrence are
+ -- through Reraise_Occurrence, and plain reraise, and so we
+ -- have the following possibilities:
+ --
+ -- - Reraise_Occurrence is handled within the running handler,
+ -- and so when completing the dynamically nested handler, we
+ -- must NOT release the exception. A Claimed_Cleanup upon
+ -- entry of the nested handler, installed when entering the
+ -- enclosing handler, ensures the exception will not be
+ -- released by the nested handler, but rather by the enclosing
+ -- handler.
+ --
+ -- - Reraise_Occurrence/reraise escapes the running handler,
+ -- and we run as an exceptional cleanup for GCC_Exception. The
+ -- Saved_Cleanup was reinstalled, but since we're propagating
+ -- the same machine occurrence, we do not release it. Instead,
+ -- we transfer responsibility for releasing it to the eventual
+ -- handler of the propagating exception.
+ --
+ -- - An unrelated exception propagates through the running
+ -- handler. We restored GCC_Exception.Saved_Cleanup above.
+ -- Since we're propagating a different exception, we proceed to
+ -- release GCC_Exception, unless Saved_Cleanup was
+ -- Claimed_Cleanup, because then we know we're not in the
+ -- outermost handler for GCC_Exception.
+ --
+ -- - The handler completes normally, so it reinstalls the
+ -- Saved_Cleanup and runs it, unless it was Claimed_Cleanup.
+ -- If Saved_Cleanup is null, Unwind_DeleteException (currently)
+ -- has no effect, so we could skip it, but if it is ever
+ -- changed to do more in this case, we're ready for that,
+ -- calling it exactly once.
+ if Saved_Cleanup /= Claimed_Cleanup'Address
+ and then
+ Propagating_Exception /= GCC_Exception
+ then
+ declare
+ Current : constant EOA := Get_Current_Excep.all;
+ Cur_Occ : constant GCC_Exception_Access
+ := To_GCC_Exception (Current.Machine_Occurrence);
+ begin
+ -- If we are releasing the Machine_Occurrence of the current
+ -- exception, reset the access to it, so that it is no
+ -- longer accessible.
+ if Cur_Occ = GCC_Exception then
+ Current.Machine_Occurrence := System.Null_Address;
+ end if;
+ end;
+ Unwind_DeleteException (GCC_Exception);
+ end if;
+ end End_Handler_v1;
+
+ ---------------------
+ -- Claimed_Cleanup --
+ ---------------------
+
+ procedure Claimed_Cleanup
+ (Reason : Unwind_Reason_Code;
+ GCC_Exception : not null GCC_Exception_Access) is
+ pragma Unreferenced (Reason);
+ pragma Unreferenced (GCC_Exception);
+ begin
+ -- This procedure should never run. If it does, it's either a
+ -- version 0 handler or a foreign handler, attempting to
+ -- release an exception while a version 1 handler that claimed
+ -- responsibility for releasing the exception remains still
+ -- active. This placeholder stops GCC_Exception from being
+ -- released by them.
+
+ -- We could get away with just Null_Address instead, with
+ -- nearly the same effect, but with this placeholder we can
+ -- detect and report unexpected releases, and we can tell apart
+ -- a GCC_Exception without a Cleanup, from one with another
+ -- active handler, so as to still call Unwind_DeleteException
+ -- exactly once: currently, Unwind_DeleteException does nothing
+ -- when the Cleanup is null, but should it ever be changed to
+ -- do more, we'll still be safe.
+ null;
+ end Claimed_Cleanup;
+
-------------------
-- Begin_Handler --
-------------------