From 557b744a6e41a13dd44770dc64e19a34a32092c5 Mon Sep 17 00:00:00 2001 From: Olivier Hainque Date: Mon, 11 Jun 2018 09:19:22 +0000 Subject: [PATCH] [Ada] Improve last exception info availability from C++ handlers The Most_Recent_Exception service failed to provide accurate information on an Ada exception caught by a C++ handler for foreign exceptions. The service relies on updates of a "current exception buffer" from live exception objects at various points of the propagation process and this update was not performed early enough for the case of foreign exception handlers in non-Ada handlers. The correction applied here consists in moving one of the updates earlier in the raise process, just before unwinding starts, then refine the update API to prevent a redundant copy during the unwinding search phase for the same exception. The example below, compiled with gcc -c b.cc gnatmake -g main.adb -largs b.o --LINK=g++ is expected to run and display ada info: Checking Most_Recent_Exception for CONSTRAINT_ERROR ... OK! // b.cc extern "C" { void foo (); extern void _ada_trigger (); extern void _ada_occurrence_info (); } void foo () { try { _ada_trigger (); } catch (const abi::__foreign_exception &e) { printf ("ada info:\n"); _ada_occurrence_info(); } } -- main.adb with EH; procedure Main is begin EH.Foo; end; -- eh.adb with Gnat.Most_Recent_Exception; with Ada.Text_IO; use Ada.Text_IO; package body EH is procedure Ada_Trigger is begin raise Constraint_Error; end; procedure Ada_Occurrence_Info is begin Check_MRE ("CONSTRAINT_ERROR"); end; function Pre_Check_MRE (Ename : String) return Exception_Id is MROA : Exception_Occurrence_Access := GNAT.Most_Recent_Exception.Occurrence_Access; begin Put ("Checking Most_Recent_Exception for " & Ename & " ... "); if MROA = null then Put_Line ("Most recent exception occurrence access is NULL"); return Null_Id; else return Exception_Identity (MROA.all); end if; end; procedure Diagnose_MRE (MRID : Exception_Id; Ok : Boolean) is begin if Ok then Put_Line ("OK!"); else Put_Line ("Err, Most_Recent_Exception was " & Exception_Name (MRID)); end if; end; procedure Check_MRE (Eid : Exception_Id) is MRID : Exception_Id := Pre_Check_MRE (Ename => Exception_Name (Eid)); begin Diagnose_MRE (MRID, Ok => Eid = MRID); end; procedure Check_MRE (Ename : String) is MRID : Exception_Id := Pre_Check_MRE (Ename => Ename); begin Diagnose_MRE (MRID, Ok => Ename = Exception_Name (MRID)); end; end; -- eh.ads with Ada.Exceptions; use Ada.Exceptions; package EH is procedure Ada_Trigger with Export, Convention => C, External_Name => "_ada_trigger"; procedure Ada_Occurrence_Info with Export, Convention => C, External_Name => "_ada_occurrence_info"; procedure Foo with Import, Convention => C, External_Name => "foo"; procedure Check_MRE (Eid : Exception_Id); procedure Check_MRE (Ename : String); end; 2018-06-11 Olivier Hainque gcc/ada/ * libgnat/s-excmac*.ads: Factorize Unwind_Action definitions ... * libgnat/a-exexpr.adb: ... Here, then add comments describing the major datastructures associated with the current exception raised. (Setup_Current_Excep): Accept a "Phase" argument conveying the unwinding phase during which this subprogram is called. For an Ada exception, don't update the current exception buffer from the raised exception object during SEARCH_PHASE, as this is redundant with the call now issued just before propagation starts. (Propagate_GCC_Exception): Move call to Setup_Current_Excep ahead of the unwinding start, conveying Phase 0. (Unhandled_Except_Handler): Pass UA_CLEANUP_PHASE as the Phase value on the call to Setup_Current_Excep. * raise-gcc.c (personality_body): Pass uw_phases as the Phase argument on calls to Setup_Current_Excep. From-SVN: r261426 --- gcc/ada/ChangeLog | 17 +++++ gcc/ada/libgnat/a-exexpr.adb | 116 ++++++++++++++++++++++++++---- gcc/ada/libgnat/s-excmac__arm.ads | 5 +- gcc/ada/libgnat/s-excmac__gcc.ads | 18 ----- gcc/ada/raise-gcc.c | 25 ++++--- 5 files changed, 137 insertions(+), 44 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index de142bfe442..b713c4964f1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2018-06-11 Olivier Hainque + + * libgnat/s-excmac*.ads: Factorize Unwind_Action definitions ... + * libgnat/a-exexpr.adb: ... Here, then add comments describing the + major datastructures associated with the current exception raised. + (Setup_Current_Excep): Accept a "Phase" argument conveying the + unwinding phase during which this subprogram is called. For an Ada + exception, don't update the current exception buffer from the raised + exception object during SEARCH_PHASE, as this is redundant with the + call now issued just before propagation starts. + (Propagate_GCC_Exception): Move call to Setup_Current_Excep ahead of + the unwinding start, conveying Phase 0. + (Unhandled_Except_Handler): Pass UA_CLEANUP_PHASE as the Phase value on + the call to Setup_Current_Excep. + * raise-gcc.c (personality_body): Pass uw_phases as the Phase argument + on calls to Setup_Current_Excep. + 2018-06-11 Ed Schonberg * exp_unst.ads, exp_unst.adb (Needs_Fat_Pointer, diff --git a/gcc/ada/libgnat/a-exexpr.adb b/gcc/ada/libgnat/a-exexpr.adb index 2fe003ef011..20baf0b5e6d 100644 --- a/gcc/ada/libgnat/a-exexpr.adb +++ b/gcc/ada/libgnat/a-exexpr.adb @@ -29,7 +29,56 @@ -- -- ------------------------------------------------------------------------------ --- This is the version using the GCC EH mechanism +-- This is the version using the GCC EH mechanism, which could rely on +-- different underlying unwinding engines, for example DWARF or ARM unwind +-- info based. Here is a sketch of the most prominent data structures +-- involved: + +-- (s-excmac.ads) +-- GNAT_GCC_Exception: +-- *-----------------------------------* +-- o-->| (s-excmac.ads) | +-- | | Header : | +-- | | - Class | +-- | | ... | Constraint_Error: +-- | |-----------------------------------* Program_Error: +-- | | (a-except.ads) | Foreign_Exception: +-- | | Occurrence : Exception_Occurrence | +-- | | | (s-stalib. ads) +-- | | - Id : Exception_Id --------------> Exception_Data +-- o------ - Machine_Occurrence | *------------------------* +-- | - Msg | | Not_Handled_By_Others | +-- | - Traceback | | Lang | +-- | ... | | Foreign_Data --o | +-- *-----------------------------------* | Full_Name | | +-- || | ... | | +-- || foreign rtti blob *----------------|-------* +-- || *---------------* | +-- || | ... ... |<-------------------------o +-- || *---------------* +-- || +-- Setup_Current_Excep() +-- || +-- || Latch into ATCB or +-- || environment Current Exception Buffer: +-- || +-- vv +-- <> : Exception_Occurrence +-- *---------------------------* +-- | ... ... ... ... ... ... * --- Get_Current_Excep() ----> +-- *---------------------------* + +-- On "raise" events, the runtime allocates a new GNAT_GCC_Exception +-- instance and eventually calls into libgcc's Unwind_RaiseException. +-- This part handles the object through the header part only. + +-- During execution, Get_Current_Excep provides a pointer to the +-- Exception_Occurrence being raised or last raised by the current task. + +-- This is actually the address of a statically allocated +-- Exception_Occurrence attached to the current ATCB or to the environment +-- thread into which an occurrence being raised is synchronized at critical +-- points during the raise process, via Setup_Current_Excep. with Ada.Unchecked_Conversion; with Ada.Unchecked_Deallocation; @@ -51,6 +100,22 @@ package body Exception_Propagation is -- GNAT Specific Entities To Deal With The GCC EH Circuitry -- -------------------------------------------------------------- + -- Phase identifiers (Unwind Actions) + + 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_HANDLER_FRAME, + UA_FORCE_UNWIND, + UA_END_OF_STACK); + procedure GNAT_GCC_Exception_Cleanup (Reason : Unwind_Reason_Code; Excep : not null GNAT_GCC_Exception_Access); @@ -70,10 +135,19 @@ package body Exception_Propagation is -- directly from gigi. function Setup_Current_Excep - (GCC_Exception : not null GCC_Exception_Access) return EOA; + (GCC_Exception : not null GCC_Exception_Access; + Phase : Unwind_Action) return EOA; pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep"); - -- Write Get_Current_Excep.all from GCC_Exception. Called by the - -- personality routine. + -- Acknowledge GCC_Exception as the current exception object being + -- raised, which could be an Ada or a foreign exception object. Return + -- a pointer to the embedded Ada occurrence for an Ada exception object, + -- to the current exception buffer otherwise. + -- + -- Synchronize the current exception buffer as needed for possible + -- accesses through Get_Current_Except.all afterwards, depending on the + -- Phase bits, received either from the personality routine, from a + -- forced_unwind cleanup handler, or just before the start of propagation + -- for an Ada exception (Phase 0 in this case). procedure Unhandled_Except_Handler (GCC_Exception : not null GCC_Exception_Access); @@ -236,27 +310,41 @@ package body Exception_Propagation is ------------------------- function Setup_Current_Excep - (GCC_Exception : not null GCC_Exception_Access) return EOA + (GCC_Exception : not null GCC_Exception_Access; + Phase : Unwind_Action) return EOA is Excep : constant EOA := Get_Current_Excep.all; begin - -- Setup the exception occurrence if GCC_Exception.Class = GNAT_Exception_Class then - -- From the GCC exception + -- Ada exception : latch the occurrence data in the Current + -- Exception Buffer if needed and return a pointer to the original + -- Ada exception object. This particular object was specifically + -- allocated for this raise and is thus more precise than the fixed + -- Current Exception Buffer address. declare GNAT_Occurrence : constant GNAT_GCC_Exception_Access := To_GNAT_GCC_Exception (GCC_Exception); begin - Excep.all := GNAT_Occurrence.Occurrence; + + -- When reaching here during SEARCH_PHASE, no need to + -- replicate the copy performed at the propagation start. + + if Phase /= UA_SEARCH_PHASE then + Excep.all := GNAT_Occurrence.Occurrence; + end if; return GNAT_Occurrence.Occurrence'Access; end; else - -- A default one + + -- Foreign exception (caught by Ada handler, reaching here from + -- personality routine) : The original exception object doesn't hold + -- an Ada occurrence info. Set the foreign data pointer in the + -- Current Exception Buffer and return the address of the latter. Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address); @@ -312,7 +400,12 @@ package body Exception_Propagation is procedure Propagate_GCC_Exception (GCC_Exception : not null GCC_Exception_Access) is - Excep : EOA; + -- Acknowledge the current exception info now, before unwinding + -- starts so it is available even from C++ handlers involved before + -- our personality routine. + + Excep : constant EOA := + Setup_Current_Excep (GCC_Exception, Phase => 0); begin -- Perform a standard raise first. If a regular handler is found, it @@ -326,7 +419,6 @@ package body Exception_Propagation is -- the necessary steps to enable the debugger to gain control while the -- stack is still intact. - Excep := Setup_Current_Excep (GCC_Exception); Notify_Unhandled_Exception (Excep); -- Now, un a forced unwind to trigger cleanups. Control should not @@ -392,7 +484,7 @@ package body Exception_Propagation is is Excep : EOA; begin - Excep := Setup_Current_Excep (GCC_Exception); + Excep := Setup_Current_Excep (GCC_Exception, Phase => UA_CLEANUP_PHASE); Unhandled_Exception_Terminate (Excep); end Unhandled_Except_Handler; diff --git a/gcc/ada/libgnat/s-excmac__arm.ads b/gcc/ada/libgnat/s-excmac__arm.ads index ae83c624a04..b188046c40e 100644 --- a/gcc/ada/libgnat/s-excmac__arm.ads +++ b/gcc/ada/libgnat/s-excmac__arm.ads @@ -58,6 +58,7 @@ package System.Exceptions.Machine is URC_INSTALL_CONTEXT, URC_CONTINUE_UNWIND, URC_FAILURE); + pragma Convention (C, Unwind_Reason_Code); pragma Unreferenced (URC_OK, @@ -71,9 +72,7 @@ package System.Exceptions.Machine is URC_CONTINUE_UNWIND, URC_FAILURE); - pragma Convention (C, Unwind_Reason_Code); - subtype Unwind_Action is Unwind_Reason_Code; - -- Phase identifiers + -- ARM Unwinding State type uint32_t is mod 2**32; pragma Convention (C, uint32_t); diff --git a/gcc/ada/libgnat/s-excmac__gcc.ads b/gcc/ada/libgnat/s-excmac__gcc.ads index e2997779b10..a828a020128 100644 --- a/gcc/ada/libgnat/s-excmac__gcc.ads +++ b/gcc/ada/libgnat/s-excmac__gcc.ads @@ -75,24 +75,6 @@ package System.Exceptions.Machine is pragma Convention (C, Unwind_Reason_Code); - -- Phase identifiers - - 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, - UA_END_OF_STACK); - -- Mandatory common header for any exception object handled by the -- GCC unwinding runtime. diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c index 7558414d5a3..5c2cc43bcb3 100644 --- a/gcc/ada/raise-gcc.c +++ b/gcc/ada/raise-gcc.c @@ -106,8 +106,9 @@ __gnat_Unwind_RaiseException (_Unwind_Exception *); _Unwind_Reason_Code __gnat_Unwind_ForcedUnwind (_Unwind_Exception *, _Unwind_Stop_Fn, void *); -extern struct Exception_Occurrence *__gnat_setup_current_excep - (_Unwind_Exception *); +extern struct Exception_Occurrence * +__gnat_setup_current_excep (_Unwind_Exception *, _Unwind_Action); + extern void __gnat_unhandled_except_handler (_Unwind_Exception *); #ifdef CERT @@ -1220,12 +1221,14 @@ personality_body (_Unwind_Action uw_phases, else { #ifndef CERT - struct Exception_Occurrence *excep; - /* Trigger the appropriate notification routines before the second - phase starts, which ensures the stack is still intact. - First, setup the Ada occurrence. */ - excep = __gnat_setup_current_excep (uw_exception); + phase starts, when the stack is still intact. First install what + needs to be installed in the current exception buffer and fetch + the Ada occurrence pointer to use. */ + + struct Exception_Occurrence *excep + = __gnat_setup_current_excep (uw_exception, uw_phases); + if (action.kind == unhandler) __gnat_notify_unhandled_exception (excep); else @@ -1245,10 +1248,10 @@ personality_body (_Unwind_Action uw_phases, (uw_context, uw_exception, action.landing_pad, action.ttype_filter); #ifndef CERT - /* Write current exception, so that it can be retrieved from Ada. It was - already done during phase 1 (just above), but in between, one or several - exceptions may have been raised (in cleanup handlers). */ - __gnat_setup_current_excep (uw_exception); + /* Write current exception so that it can be retrieved from Ada. It was + already done during phase 1, but one or several exceptions may have been + raised in cleanup handlers in between. */ + __gnat_setup_current_excep (uw_exception, uw_phases); #endif return _URC_INSTALL_CONTEXT; -- 2.30.2