diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 64ac98ba1f4c..bcfc8cc1ae45 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2019-08-02 Alexandre Oliva + + * 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 * 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 6cd37598d396..b484bc78532a 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. + 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 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. */ + 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: */ 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 b1aa1c6e6ba6..5e72fd6e3f2a 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 -- -------------------