diff options
Diffstat (limited to 'gcc/ada/a-exexpr-gcc.adb')
| -rw-r--r-- | gcc/ada/a-exexpr-gcc.adb | 142 |
1 files changed, 3 insertions, 139 deletions
diff --git a/gcc/ada/a-exexpr-gcc.adb b/gcc/ada/a-exexpr-gcc.adb index a9d9e4b..fa8e9db 100644 --- a/gcc/ada/a-exexpr-gcc.adb +++ b/gcc/ada/a-exexpr-gcc.adb @@ -35,107 +35,13 @@ 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; - ------------------------------------------------ - -- Entities to interface with the GCC runtime -- - ------------------------------------------------ - - -- These come from "C++ ABI for Itanium: Exception handling", which is the - -- reference for GCC. - - -- Return codes from GCC runtime functions used to propagate an exception - - type Unwind_Reason_Code is - (URC_NO_REASON, - URC_FOREIGN_EXCEPTION_CAUGHT, - URC_PHASE2_ERROR, - URC_PHASE1_ERROR, - URC_NORMAL_STOP, - URC_END_OF_STACK, - URC_HANDLER_FOUND, - URC_INSTALL_CONTEXT, - URC_CONTINUE_UNWIND); - - pragma Unreferenced - (URC_NO_REASON, - URC_FOREIGN_EXCEPTION_CAUGHT, - URC_PHASE2_ERROR, - URC_PHASE1_ERROR, - URC_NORMAL_STOP, - URC_END_OF_STACK, - URC_HANDLER_FOUND, - URC_INSTALL_CONTEXT, - URC_CONTINUE_UNWIND); - - 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. - - type Exception_Class is mod 2 ** 64; - - GNAT_Exception_Class : constant Exception_Class := 16#474e552d41646100#; - -- "GNU-Ada\0" - - type Unwind_Word is mod 2 ** System.Word_Size; - for Unwind_Word'Size use System.Word_Size; - -- Map the corresponding C type used in Unwind_Exception below - - type Unwind_Exception is record - Class : Exception_Class; - Cleanup : System.Address; - Private1 : Unwind_Word; - Private2 : Unwind_Word; - - -- Usual exception structure has only two private fields, but the SEH - -- one has six. To avoid making this file more complex, we use six - -- fields on all platforms, wasting a few bytes on some. - - Private3 : Unwind_Word; - Private4 : Unwind_Word; - Private5 : Unwind_Word; - Private6 : Unwind_Word; - end record; - pragma Convention (C, Unwind_Exception); - -- Map the GCC struct used for exception handling - - for Unwind_Exception'Alignment use Standard'Maximum_Alignment; - -- The C++ ABI mandates the common exception header to be at least - -- doubleword aligned, and the libGCC implementation actually makes it - -- maximally aligned (see unwind.h). See additional comments on the - -- alignment below. - - type GCC_Exception_Access is access all Unwind_Exception; - -- Pointer to a GCC exception. Do not use convention C as on VMS this - -- would imply the use of 32-bits pointers. - - procedure Unwind_DeleteException (Excp : not null GCC_Exception_Access); - pragma Import (C, Unwind_DeleteException, "_Unwind_DeleteException"); - -- Procedure to free any GCC exception - Foreign_Exception : aliased System.Standard_Library.Exception_Data; pragma Import (Ada, Foreign_Exception, "system__exceptions__foreign_exception"); @@ -145,44 +51,6 @@ package body Exception_Propagation is -- GNAT Specific Entities To Deal With The GCC EH Circuitry -- -------------------------------------------------------------- - -- A GNAT exception object to be dealt with by the personality routine - -- called by the GCC unwinding runtime. - - type GNAT_GCC_Exception is record - Header : Unwind_Exception; - -- ABI Exception header first - - Occurrence : aliased Exception_Occurrence; - -- The Ada occurrence - end record; - - pragma Convention (C, GNAT_GCC_Exception); - - -- There is a subtle issue with the common header alignment, since the C - -- version is aligned on BIGGEST_ALIGNMENT, the Ada version is aligned on - -- Standard'Maximum_Alignment, and those two values don't quite represent - -- the same concepts and so may be decoupled someday. One typical reason - -- is that BIGGEST_ALIGNMENT may be larger than what the underlying system - -- allocator guarantees, and there are extra costs involved in allocating - -- objects aligned to such factors. - - -- To deal with the potential alignment differences between the C and Ada - -- representations, the Ada part of the whole structure is only accessed - -- by the personality routine through the accessors declared below. Ada - -- specific fields are thus always accessed through consistent layout, and - -- we expect the actual alignment to always be large enough to avoid traps - -- from the C accesses to the common header. Besides, accessors alleviate - -- the need for a C struct whole counterpart, both painful and error-prone - -- to maintain anyway. - - type GNAT_GCC_Exception_Access is access all GNAT_GCC_Exception; - - function To_GCC_Exception is new - Unchecked_Conversion (System.Address, GCC_Exception_Access); - - function To_GNAT_GCC_Exception is new - Unchecked_Conversion (GCC_Exception_Access, GNAT_GCC_Exception_Access); - procedure GNAT_GCC_Exception_Cleanup (Reason : Unwind_Reason_Code; Excep : not null GNAT_GCC_Exception_Access); @@ -317,12 +185,8 @@ package body Exception_Propagation is Res : GNAT_GCC_Exception_Access; begin - Res := - new GNAT_GCC_Exception' - (Header => (Class => GNAT_Exception_Class, - Cleanup => GNAT_GCC_Exception_Cleanup'Address, - others => 0), - Occurrence => (others => <>)); + Res := New_Occurrence; + Res.Header.Cleanup := GNAT_GCC_Exception_Cleanup'Address; Res.Occurrence.Machine_Occurrence := Res.all'Address; return Res.Occurrence'Access; |