From patchwork Mon Jun 11 09:23:53 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 927580 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-479444-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="v4trvP1v"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 41470r2Bmvz9ryk for ; Mon, 11 Jun 2018 19:25:48 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=xxTxiXN0oAkl84jTQramjjpNAz7BdBAKHlvGRD4oqC2ScV+RVw MRXIilxo6nIlYdvfoSRVz5bpEz+ODfa1bw/jMVOlSICN5fN81sXoTSSFw0Sgso0N qkyLOLfVj8s0F5qM2ooeL8KFKy7Sl8Et930YJvhyPg2UUWWteyd/zCHMQ= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=Q7YMengE/DR5eWk3pmRCcu5zeqE=; b=v4trvP1vuBHX6xyQMXaF Uc7s34+6X8IlzgNLZlauL8SQRSUUgBjHyLqAzjX0IoAmq88EKNAuWR9kHQIB8ynq hSTRsIgH0yfT7BPFWk/btRlPKbniW2vyhH7skUPfH3I6HgPmGylmXMSaA4qjoA6V KOcaCub1InlSvcwL8M3DbhM= Received: (qmail 36212 invoked by alias); 11 Jun 2018 09:23:59 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 36065 invoked by uid 89); 11 Jun 2018 09:23:59 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-11.2 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=Foreign, intact, bo, Deal X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 11 Jun 2018 09:23:55 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 13707560ED; Mon, 11 Jun 2018 05:23:54 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id rX+kOk0I3E6P; Mon, 11 Jun 2018 05:23:54 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 0097C560EC; Mon, 11 Jun 2018 05:23:54 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id F3B8054C; Mon, 11 Jun 2018 05:23:53 -0400 (EDT) Date: Mon, 11 Jun 2018 05:23:53 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Olivier Hainque Subject: [Ada] Improve last exception info availability from C++ handlers Message-ID: <20180611092353.GA135111@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes 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; Tested on x86_64-pc-linux-gnu, committed on trunk 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. --- gcc/ada/libgnat/a-exexpr.adb +++ 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; --- gcc/ada/libgnat/s-excmac__arm.ads +++ 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); --- gcc/ada/libgnat/s-excmac__gcc.ads +++ 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. --- gcc/ada/raise-gcc.c +++ 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;