| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- A D A . E X C E P T I O N S . E X C E P T I O N _ P R O P A G A T I O N -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 1992-2021, Free Software Foundation, Inc. -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
| -- -- |
| -- As a special exception under Section 7 of GPL version 3, you are granted -- |
| -- additional permissions described in the GCC Runtime Library Exception, -- |
| -- version 3.1, as published by the Free Software Foundation. -- |
| -- -- |
| -- You should have received a copy of the GNU General Public License and -- |
| -- a copy of the GCC Runtime Library Exception along with this program; -- |
| -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- |
| -- <http://www.gnu.org/licenses/>. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| -- 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; |
| |
| with System.Storage_Elements; use System.Storage_Elements; |
| with System.Exceptions.Machine; use System.Exceptions.Machine; |
| |
| separate (Ada.Exceptions) |
| package body Exception_Propagation is |
| |
| use Exception_Traces; |
| |
| type bool is new Boolean; |
| pragma Convention (C, bool); |
| |
| Foreign_Exception : aliased System.Standard_Library.Exception_Data; |
| pragma Import (Ada, Foreign_Exception, |
| "system__exceptions__foreign_exception"); |
| -- Id for foreign exceptions |
| |
| -------------------------------------------------------------- |
| -- 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); |
| pragma Convention (C, GNAT_GCC_Exception_Cleanup); |
| -- Procedure called when a GNAT GCC exception is free. |
| |
| procedure Propagate_GCC_Exception |
| (GCC_Exception : not null GCC_Exception_Access); |
| pragma No_Return (Propagate_GCC_Exception); |
| -- Propagate a GCC exception |
| |
| procedure Reraise_GCC_Exception |
| (GCC_Exception : not null GCC_Exception_Access); |
| pragma No_Return (Reraise_GCC_Exception); |
| pragma Export (C, Reraise_GCC_Exception, "__gnat_reraise_zcx"); |
| -- Called to implement raise without exception, ie reraise. Called |
| -- directly from gigi. |
| |
| function Setup_Current_Excep |
| (GCC_Exception : not null GCC_Exception_Access; |
| Phase : Unwind_Action) return EOA; |
| pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep"); |
| -- 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); |
| pragma No_Return (Unhandled_Except_Handler); |
| pragma Export (C, Unhandled_Except_Handler, |
| "__gnat_unhandled_except_handler"); |
| -- Called for handle unhandled exceptions, ie the last chance handler |
| -- on platforms (such as SEH) that never returns after throwing an |
| -- exception. Called directly by gigi. |
| |
| function CleanupUnwind_Handler |
| (UW_Version : Integer; |
| UW_Phases : Unwind_Action; |
| UW_Eclass : Exception_Class; |
| UW_Exception : not null GCC_Exception_Access; |
| UW_Context : System.Address; |
| UW_Argument : System.Address) return Unwind_Reason_Code; |
| pragma Import (C, CleanupUnwind_Handler, |
| "__gnat_cleanupunwind_handler"); |
| -- Hook called at each step of the forced unwinding we perform to trigger |
| -- cleanups found during the propagation of an unhandled exception. |
| |
| -- GCC runtime functions used. These are C non-void functions, actually, |
| -- but we ignore the return values. See raise.c as to why we are using |
| -- __gnat stubs for these. |
| |
| procedure Unwind_RaiseException |
| (UW_Exception : not null GCC_Exception_Access); |
| pragma Import (C, Unwind_RaiseException, "__gnat_Unwind_RaiseException"); |
| |
| procedure Unwind_ForcedUnwind |
| (UW_Exception : not null GCC_Exception_Access; |
| UW_Handler : System.Address; |
| UW_Argument : System.Address); |
| pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind"); |
| |
| procedure Set_Exception_Parameter |
| (Excep : EOA; |
| GCC_Exception : not null GCC_Exception_Access); |
| pragma Export |
| (C, Set_Exception_Parameter, "__gnat_set_exception_parameter"); |
| -- Called inserted by gigi to set the exception choice parameter from the |
| -- gcc occurrence. |
| |
| procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address); |
| -- Utility routine to initialize occurrence Excep from a foreign exception |
| -- 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. 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 -- |
| -------------------------------------------------------------------- |
| |
| -- As of today, these are only used by the C implementation of the GCC |
| -- propagation personality routine to avoid having to rely on a C |
| -- counterpart of the whole exception_data structure, which is both |
| -- painful and error prone. These subprograms could be moved to a more |
| -- widely visible location if need be. |
| |
| function Is_Handled_By_Others (E : Exception_Data_Ptr) return bool; |
| pragma Export (C, Is_Handled_By_Others, "__gnat_is_handled_by_others"); |
| |
| function Language_For (E : Exception_Data_Ptr) return Character; |
| pragma Export (C, Language_For, "__gnat_language_for"); |
| |
| function Foreign_Data_For (E : Exception_Data_Ptr) return Address; |
| pragma Export (C, Foreign_Data_For, "__gnat_foreign_data_for"); |
| |
| function EID_For (GNAT_Exception : not null GNAT_GCC_Exception_Access) |
| return Exception_Id; |
| pragma Export (C, EID_For, "__gnat_eid_for"); |
| |
| --------------------------------------------------------------------------- |
| -- Objects to materialize "others" and "all others" in the GCC EH tables -- |
| --------------------------------------------------------------------------- |
| |
| -- Currently, these only have their address taken and compared so there is |
| -- no real point having whole exception data blocks allocated. Note that |
| -- there are corresponding declarations in gigi (trans.c) which must be |
| -- kept properly synchronized. |
| |
| Others_Value : constant Character := 'O'; |
| pragma Export (C, Others_Value, "__gnat_others_value"); |
| |
| All_Others_Value : constant Character := 'A'; |
| pragma Export (C, All_Others_Value, "__gnat_all_others_value"); |
| |
| Unhandled_Others_Value : constant Character := 'U'; |
| pragma Export (C, Unhandled_Others_Value, "__gnat_unhandled_others_value"); |
| -- Special choice (emitted by gigi) to catch and notify unhandled |
| -- exceptions on targets which always handle exceptions (such as SEH). |
| -- The handler will simply call Unhandled_Except_Handler. |
| |
| ------------------------- |
| -- Allocate_Occurrence -- |
| ------------------------- |
| |
| function Allocate_Occurrence return EOA is |
| Res : GNAT_GCC_Exception_Access; |
| |
| begin |
| Res := New_Occurrence; |
| Res.Header.Cleanup := GNAT_GCC_Exception_Cleanup'Address; |
| Res.Occurrence.Machine_Occurrence := Res.all'Address; |
| |
| return Res.Occurrence'Access; |
| end Allocate_Occurrence; |
| |
| -------------------------------- |
| -- GNAT_GCC_Exception_Cleanup -- |
| -------------------------------- |
| |
| procedure GNAT_GCC_Exception_Cleanup |
| (Reason : Unwind_Reason_Code; |
| Excep : not null GNAT_GCC_Exception_Access) |
| is |
| pragma Unreferenced (Reason); |
| |
| procedure Free is new Unchecked_Deallocation |
| (GNAT_GCC_Exception, GNAT_GCC_Exception_Access); |
| |
| Copy : GNAT_GCC_Exception_Access := Excep; |
| |
| begin |
| -- Simply free the memory |
| |
| Free (Copy); |
| end GNAT_GCC_Exception_Cleanup; |
| |
| ---------------------------- |
| -- Set_Foreign_Occurrence -- |
| ---------------------------- |
| |
| procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address) is |
| begin |
| Excep.all := ( |
| Id => Foreign_Exception'Access, |
| Machine_Occurrence => Mo, |
| Msg => <>, |
| Msg_Length => 0, |
| Exception_Raised => True, |
| Pid => Local_Partition_ID, |
| Num_Tracebacks => 0, |
| Tracebacks => <>); |
| end Set_Foreign_Occurrence; |
| |
| ------------------------- |
| -- Setup_Current_Excep -- |
| ------------------------- |
| |
| function Setup_Current_Excep |
| (GCC_Exception : not null GCC_Exception_Access; |
| Phase : Unwind_Action) return EOA |
| is |
| Excep : constant EOA := Get_Current_Excep.all; |
| |
| begin |
| |
| if GCC_Exception.Class = GNAT_Exception_Class then |
| |
| -- 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 |
| |
| -- 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 |
| |
| -- 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); |
| |
| return Excep; |
| 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 -- |
| ------------------- |
| |
| procedure Begin_Handler (GCC_Exception : not null GCC_Exception_Access) is |
| pragma Unreferenced (GCC_Exception); |
| begin |
| null; |
| end Begin_Handler; |
| |
| ----------------- |
| -- End_Handler -- |
| ----------------- |
| |
| procedure End_Handler (GCC_Exception : GCC_Exception_Access) is |
| begin |
| if GCC_Exception /= null then |
| |
| -- The exception might have been reraised, in this case the cleanup |
| -- mustn't be called. |
| |
| Unwind_DeleteException (GCC_Exception); |
| end if; |
| end End_Handler; |
| |
| ----------------------------- |
| -- Reraise_GCC_Exception -- |
| ----------------------------- |
| |
| procedure Reraise_GCC_Exception |
| (GCC_Exception : not null GCC_Exception_Access) |
| is |
| begin |
| -- Simply propagate it |
| |
| Propagate_GCC_Exception (GCC_Exception); |
| end Reraise_GCC_Exception; |
| |
| ----------------------------- |
| -- Propagate_GCC_Exception -- |
| ----------------------------- |
| |
| -- Call Unwind_RaiseException to actually throw, taking care of handling |
| -- the two phase scheme it implements. |
| |
| procedure Propagate_GCC_Exception |
| (GCC_Exception : not null GCC_Exception_Access) |
| is |
| -- 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 |
| -- will be entered after all the intermediate cleanups have run. If |
| -- there is no regular handler, it will return. |
| |
| Unwind_RaiseException (GCC_Exception); |
| |
| -- If we get here we know the exception is not handled, as otherwise |
| -- Unwind_RaiseException arranges for the handler to be entered. Take |
| -- the necessary steps to enable the debugger to gain control while the |
| -- stack is still intact. |
| |
| Notify_Unhandled_Exception (Excep); |
| |
| -- Now, un a forced unwind to trigger cleanups. Control should not |
| -- resume there, if there are cleanups and in any cases as the |
| -- unwinding hook calls Unhandled_Exception_Terminate when end of |
| -- stack is reached. |
| |
| Unwind_ForcedUnwind |
| (GCC_Exception, |
| CleanupUnwind_Handler'Address, |
| System.Null_Address); |
| |
| -- We get here in case of error. The debugger has been notified before |
| -- the second step above. |
| |
| Unhandled_Except_Handler (GCC_Exception); |
| end Propagate_GCC_Exception; |
| |
| ------------------------- |
| -- Propagate_Exception -- |
| ------------------------- |
| |
| procedure Propagate_Exception (Excep : Exception_Occurrence) is |
| begin |
| Propagate_GCC_Exception (To_GCC_Exception (Excep.Machine_Occurrence)); |
| end Propagate_Exception; |
| |
| ----------------------------- |
| -- Set_Exception_Parameter -- |
| ----------------------------- |
| |
| procedure Set_Exception_Parameter |
| (Excep : EOA; |
| GCC_Exception : not null GCC_Exception_Access) |
| is |
| begin |
| -- Setup the exception occurrence |
| |
| if GCC_Exception.Class = GNAT_Exception_Class then |
| |
| -- From the GCC exception |
| |
| declare |
| GNAT_Occurrence : constant GNAT_GCC_Exception_Access := |
| To_GNAT_GCC_Exception (GCC_Exception); |
| begin |
| Save_Occurrence (Excep.all, GNAT_Occurrence.Occurrence); |
| end; |
| |
| else |
| -- A default one |
| |
| Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address); |
| end if; |
| end Set_Exception_Parameter; |
| |
| ------------------------------ |
| -- Unhandled_Except_Handler -- |
| ------------------------------ |
| |
| procedure Unhandled_Except_Handler |
| (GCC_Exception : not null GCC_Exception_Access) |
| is |
| Excep : EOA; |
| begin |
| Excep := Setup_Current_Excep (GCC_Exception, Phase => UA_CLEANUP_PHASE); |
| Unhandled_Exception_Terminate (Excep); |
| end Unhandled_Except_Handler; |
| |
| ------------- |
| -- EID_For -- |
| ------------- |
| |
| function EID_For |
| (GNAT_Exception : not null GNAT_GCC_Exception_Access) return Exception_Id |
| is |
| begin |
| return GNAT_Exception.Occurrence.Id; |
| end EID_For; |
| |
| ---------------------- |
| -- Foreign_Data_For -- |
| ---------------------- |
| |
| function Foreign_Data_For (E : Exception_Data_Ptr) return Address is |
| begin |
| return E.Foreign_Data; |
| end Foreign_Data_For; |
| |
| -------------------------- |
| -- Is_Handled_By_Others -- |
| -------------------------- |
| |
| function Is_Handled_By_Others (E : Exception_Data_Ptr) return bool is |
| begin |
| return not bool (E.all.Not_Handled_By_Others); |
| end Is_Handled_By_Others; |
| |
| ------------------ |
| -- Language_For -- |
| ------------------ |
| |
| function Language_For (E : Exception_Data_Ptr) return Character is |
| begin |
| return E.all.Lang; |
| end Language_For; |
| |
| end Exception_Propagation; |
