diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 17 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-exexpr.adb | 116 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-excmac__arm.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-excmac__gcc.ads | 18 | ||||
| -rw-r--r-- | gcc/ada/raise-gcc.c | 25 |
5 files changed, 137 insertions, 44 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index de142bf..b713c49 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2018-06-11 Olivier Hainque <hainque@adacore.com> + + * 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 <schonberg@adacore.com> * 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 2fe003e..20baf0b 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 : <gcc occurrence type> | +-- | | - 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 ae83c62..b188046 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 e299777..a828a02 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 7558414..5c2cc43 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; |