| ------------------------------------------------------------------------------ |
| -- -- |
| -- 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-2006, 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 2, 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. See the GNU General Public License -- |
| -- for more details. You should have received a copy of the GNU General -- |
| -- Public License distributed with GNAT; see file COPYING. If not, write -- |
| -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- |
| -- Boston, MA 02110-1301, USA. -- |
| -- -- |
| -- As a special exception, if other files instantiate generics from this -- |
| -- unit, or you link this unit with other files to produce an executable, -- |
| -- this unit does not by itself cause the resulting executable to be -- |
| -- covered by the GNU General Public License. This exception does not -- |
| -- however invalidate any other reasons why the executable file might be -- |
| -- covered by the GNU Public License. -- |
| -- -- |
| -- 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 |
| |
| with Ada.Unchecked_Conversion; |
| with Ada.Unchecked_Deallocation; |
| |
| with System.Storage_Elements; use System.Storage_Elements; |
| |
| separate (Ada.Exceptions) |
| package body Exception_Propagation is |
| |
| ------------------------------------------------ |
| -- Entities to interface with the GCC runtime -- |
| ------------------------------------------------ |
| |
| -- These come from "C++ ABI for Itanium: Exception handling", which is |
| -- the reference for GCC. They are used only when we are relying on |
| -- back-end tables for exception propagation, which in turn is currenly |
| -- only the case for Zero_Cost_Exceptions in GNAT5. |
| |
| -- Return codes from the 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_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 |
| (UA_SEARCH_PHASE, |
| UA_CLEANUP_PHASE, |
| UA_HANDLER_FRAME, |
| UA_FORCE_UNWIND); |
| |
| for Unwind_Action use |
| (UA_SEARCH_PHASE => 1, |
| UA_CLEANUP_PHASE => 2, |
| UA_HANDLER_FRAME => 4, |
| UA_FORCE_UNWIND => 8); |
| |
| pragma Convention (C, Unwind_Action); |
| |
| -- 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 := GNAT_Exception_Class; |
| Cleanup : System.Address := System.Null_Address; |
| Private1 : Unwind_Word; |
| Private2 : Unwind_Word; |
| end record; |
| -- 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. |
| |
| -------------------------------------------------------------- |
| -- 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 |
| |
| Id : Exception_Id; |
| -- GNAT Exception identifier. This is filled by Propagate_Exception |
| -- and then used by the personality routine to determine if the context |
| -- it examines contains a handler for the exception beeing propagated. |
| |
| N_Cleanups_To_Trigger : Integer; |
| -- Number of cleanup only frames encountered in SEARCH phase. This is |
| -- initialized to 0 by Propagate_Exception and maintained by the |
| -- personality routine to control a forced unwinding phase triggering |
| -- all the cleanups before calling Unhandled_Exception_Terminate when |
| -- an exception is not handled. |
| |
| Next_Exception : EOA; |
| -- Used to create a linked list of exception occurrences |
| 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 aleviate |
| -- the need for a C struct whole conterpart, both painful and errorprone |
| -- to maintain anyway. |
| |
| type GNAT_GCC_Exception_Access is access all GNAT_GCC_Exception; |
| |
| function To_GNAT_GCC_Exception is new |
| Unchecked_Conversion (System.Address, GNAT_GCC_Exception_Access); |
| |
| procedure Free is new Unchecked_Deallocation |
| (GNAT_GCC_Exception, GNAT_GCC_Exception_Access); |
| |
| procedure Free is new Unchecked_Deallocation |
| (Exception_Occurrence, EOA); |
| |
| function CleanupUnwind_Handler |
| (UW_Version : Integer; |
| UW_Phases : Unwind_Action; |
| UW_Eclass : Exception_Class; |
| UW_Exception : access GNAT_GCC_Exception; |
| UW_Context : System.Address; |
| UW_Argument : System.Address) return Unwind_Reason_Code; |
| -- 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 : access GNAT_GCC_Exception); |
| pragma Import (C, Unwind_RaiseException, "__gnat_Unwind_RaiseException"); |
| |
| procedure Unwind_ForcedUnwind |
| (UW_Exception : access GNAT_GCC_Exception; |
| UW_Handler : System.Address; |
| UW_Argument : System.Address); |
| pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind"); |
| |
| ------------------------------------------------------------------ |
| -- Occurrence Stack Management Facilities for the GCC-EH Scheme -- |
| ------------------------------------------------------------------ |
| |
| function Remove |
| (Top : EOA; |
| Excep : GNAT_GCC_Exception_Access) return Boolean; |
| -- Remove Excep from the stack starting at Top. |
| -- Return True if Excep was found and removed, false otherwise. |
| |
| -- Hooks called when entering/leaving an exception handler for a given |
| -- occurrence, aimed at handling the stack of active occurrences. The |
| -- calls are generated by gigi in tree_transform/N_Exception_Handler. |
| |
| procedure Begin_Handler (GCC_Exception : GNAT_GCC_Exception_Access); |
| pragma Export (C, Begin_Handler, "__gnat_begin_handler"); |
| |
| procedure End_Handler (GCC_Exception : GNAT_GCC_Exception_Access); |
| pragma Export (C, End_Handler, "__gnat_end_handler"); |
| |
| Setup_Key : constant := 16#DEAD#; |
| -- To handle the case of a task "transferring" an exception occurrence to |
| -- another task, for instance via Exceptional_Complete_Rendezvous, we need |
| -- to be able to identify occurrences which have been Setup and not yet |
| -- Propagated. We hijack one of the common header fields for that purpose, |
| -- setting it to a special key value during the setup process, clearing it |
| -- at the very beginning of the propagation phase, and expecting it never |
| -- to be reset to the special value later on. A 16-bit value is used rather |
| -- than a 32-bit value for static compatibility with 16-bit targets such as |
| -- AAMP (where type Unwind_Word will be 16 bits). |
| |
| function Is_Setup_And_Not_Propagated (E : EOA) return Boolean; |
| |
| procedure Set_Setup_And_Not_Propagated (E : EOA); |
| procedure Clear_Setup_And_Not_Propagated (E : EOA); |
| |
| procedure Save_Occurrence_And_Private |
| (Target : out Exception_Occurrence; |
| Source : Exception_Occurrence); |
| -- Copy all the components of Source to Target as well as the |
| -- Private_Data pointer. |
| |
| ------------------------------------------------------------ |
| -- Accessors to basic components of a GNAT exception data -- |
| ------------------------------------------------------------ |
| |
| -- 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 Boolean; |
| 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 Import_Code_For (E : Exception_Data_Ptr) return Exception_Code; |
| pragma Export (C, Import_Code_For, "__gnat_import_code_for"); |
| |
| function EID_For (GNAT_Exception : GNAT_GCC_Exception_Access) |
| return Exception_Id; |
| pragma Export (C, EID_For, "__gnat_eid_for"); |
| |
| procedure Adjust_N_Cleanups_For |
| (GNAT_Exception : GNAT_GCC_Exception_Access; |
| Adjustment : Integer); |
| pragma Export (C, Adjust_N_Cleanups_For, "__gnat_adjust_n_cleanups_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. In any case |
| -- the types should match what gigi and the personality routine expect. |
| -- The initial value is an arbitrary value that will not exceed the range |
| -- of Integer on 16-bit targets (such as AAMP). |
| |
| Others_Value : constant Integer := 16#7FFF#; |
| pragma Export (C, Others_Value, "__gnat_others_value"); |
| |
| All_Others_Value : constant Integer := 16#7FFF#; |
| pragma Export (C, All_Others_Value, "__gnat_all_others_value"); |
| |
| ------------ |
| -- Remove -- |
| ------------ |
| |
| function Remove |
| (Top : EOA; |
| Excep : GNAT_GCC_Exception_Access) return Boolean |
| is |
| Prev : GNAT_GCC_Exception_Access := null; |
| Iter : EOA := Top; |
| GCC_Exception : GNAT_GCC_Exception_Access; |
| |
| begin |
| -- Pop stack |
| |
| loop |
| pragma Assert (Iter.Private_Data /= System.Null_Address); |
| |
| GCC_Exception := To_GNAT_GCC_Exception (Iter.Private_Data); |
| |
| if GCC_Exception = Excep then |
| if Prev = null then |
| |
| -- Special case for the top of the stack: shift the contents |
| -- of the next item to the top, since top is at a fixed |
| -- location and can't be changed. |
| |
| Iter := GCC_Exception.Next_Exception; |
| |
| if Iter = null then |
| |
| -- Stack is now empty |
| |
| Top.Private_Data := System.Null_Address; |
| |
| else |
| Save_Occurrence_And_Private (Top.all, Iter.all); |
| Free (Iter); |
| end if; |
| |
| else |
| Prev.Next_Exception := GCC_Exception.Next_Exception; |
| Free (Iter); |
| end if; |
| |
| Free (GCC_Exception); |
| |
| return True; |
| end if; |
| |
| exit when GCC_Exception.Next_Exception = null; |
| |
| Prev := GCC_Exception; |
| Iter := GCC_Exception.Next_Exception; |
| end loop; |
| |
| return False; |
| end Remove; |
| |
| --------------------------- |
| -- CleanupUnwind_Handler -- |
| --------------------------- |
| |
| function CleanupUnwind_Handler |
| (UW_Version : Integer; |
| UW_Phases : Unwind_Action; |
| UW_Eclass : Exception_Class; |
| UW_Exception : access GNAT_GCC_Exception; |
| UW_Context : System.Address; |
| UW_Argument : System.Address) return Unwind_Reason_Code |
| is |
| pragma Unreferenced |
| (UW_Version, UW_Phases, UW_Eclass, UW_Context, UW_Argument); |
| |
| begin |
| -- Terminate as soon as we know there is nothing more to run. The |
| -- count is maintained by the personality routine. |
| |
| if UW_Exception.N_Cleanups_To_Trigger = 0 then |
| Unhandled_Exception_Terminate; |
| end if; |
| |
| -- We know there is at least one cleanup further up. Return so that it |
| -- is searched and entered, after which Unwind_Resume will be called |
| -- and this hook will gain control (with an updated count) again. |
| |
| return URC_NO_REASON; |
| end CleanupUnwind_Handler; |
| |
| --------------------------------- |
| -- Is_Setup_And_Not_Propagated -- |
| --------------------------------- |
| |
| function Is_Setup_And_Not_Propagated (E : EOA) return Boolean is |
| GCC_E : constant GNAT_GCC_Exception_Access := |
| To_GNAT_GCC_Exception (E.Private_Data); |
| begin |
| return GCC_E /= null and then GCC_E.Header.Private1 = Setup_Key; |
| end Is_Setup_And_Not_Propagated; |
| |
| ------------------------------------ |
| -- Clear_Setup_And_Not_Propagated -- |
| ------------------------------------ |
| |
| procedure Clear_Setup_And_Not_Propagated (E : EOA) is |
| GCC_E : constant GNAT_GCC_Exception_Access := |
| To_GNAT_GCC_Exception (E.Private_Data); |
| begin |
| pragma Assert (GCC_E /= null); |
| GCC_E.Header.Private1 := 0; |
| end Clear_Setup_And_Not_Propagated; |
| |
| ---------------------------------- |
| -- Set_Setup_And_Not_Propagated -- |
| ---------------------------------- |
| |
| procedure Set_Setup_And_Not_Propagated (E : EOA) is |
| GCC_E : constant GNAT_GCC_Exception_Access := |
| To_GNAT_GCC_Exception (E.Private_Data); |
| begin |
| pragma Assert (GCC_E /= null); |
| GCC_E.Header.Private1 := Setup_Key; |
| end Set_Setup_And_Not_Propagated; |
| |
| -------------------------------- |
| -- Save_Occurrence_And_Private -- |
| -------------------------------- |
| |
| procedure Save_Occurrence_And_Private |
| (Target : out Exception_Occurrence; |
| Source : Exception_Occurrence) |
| is |
| begin |
| Save_Occurrence_No_Private (Target, Source); |
| Target.Private_Data := Source.Private_Data; |
| end Save_Occurrence_And_Private; |
| |
| --------------------- |
| -- Setup_Exception -- |
| --------------------- |
| |
| -- In the GCC-EH implementation of the propagation scheme, this |
| -- subprogram should be understood as: Setup the exception occurrence |
| -- stack headed at Current for a forthcoming raise of Excep. |
| |
| procedure Setup_Exception |
| (Excep : EOA; |
| Current : EOA; |
| Reraised : Boolean := False) |
| is |
| Top : constant EOA := Current; |
| Next : EOA; |
| GCC_Exception : GNAT_GCC_Exception_Access; |
| |
| begin |
| -- The exception Excep is soon to be propagated, and the |
| -- storage used for that will be the occurrence statically allocated |
| -- for the current thread. This storage might currently be used for a |
| -- still active occurrence, so we need to push it on the thread's |
| -- occurrence stack (headed at that static occurrence) before it gets |
| -- clobbered. |
| |
| -- What we do here is to trigger this push when need be, and allocate a |
| -- Private_Data block for the forthcoming Propagation. |
| |
| -- Some tasking rendez-vous attempts lead to an occurrence transfer |
| -- from the server to the client (see Exceptional_Complete_Rendezvous). |
| -- In those cases Setup is called twice for the very same occurrence |
| -- before it gets propagated: once from the server, because this is |
| -- where the occurrence contents is elaborated and known, and then |
| -- once from the client when it detects the case and actually raises |
| -- the exception in its own context. |
| |
| -- The Is_Setup_And_Not_Propagated predicate tells us when we are in |
| -- the second call to Setup for a Transferred occurrence, and there is |
| -- nothing to be done here in this situation. This predicate cannot be |
| -- True if we are dealing with a Reraise, and we may even be called |
| -- with a raw uninitialized Excep occurrence in this case so we should |
| -- not check anyway. Observe the front-end expansion for a "raise;" to |
| -- see that happening. We get a local occurrence and a direct call to |
| -- Save_Occurrence without the intermediate init-proc call. |
| |
| if not Reraised and then Is_Setup_And_Not_Propagated (Excep) then |
| return; |
| end if; |
| |
| -- Allocate what will be the Private_Data block for the exception |
| -- to be propagated. |
| |
| GCC_Exception := new GNAT_GCC_Exception; |
| |
| -- If the Top of the occurrence stack is not currently used for an |
| -- active exception (the stack is empty) we just need to setup the |
| -- Private_Data pointer. |
| |
| -- Otherwise, we also need to shift the contents of the Top of the |
| -- stack in a freshly allocated entry and link everything together. |
| |
| if Top.Private_Data /= System.Null_Address then |
| Next := new Exception_Occurrence; |
| Save_Occurrence_And_Private (Next.all, Top.all); |
| |
| GCC_Exception.Next_Exception := Next; |
| Top.Private_Data := GCC_Exception.all'Address; |
| end if; |
| |
| Top.Private_Data := GCC_Exception.all'Address; |
| |
| Set_Setup_And_Not_Propagated (Top); |
| end Setup_Exception; |
| |
| ------------------- |
| -- Begin_Handler -- |
| ------------------- |
| |
| procedure Begin_Handler (GCC_Exception : GNAT_GCC_Exception_Access) is |
| pragma Unreferenced (GCC_Exception); |
| |
| begin |
| -- Every necessary operation related to the occurrence stack has |
| -- already been performed by Propagate_Exception. This hook remains for |
| -- potential future necessity in optimizing the overall scheme, as well |
| -- a useful debugging tool. |
| |
| null; |
| end Begin_Handler; |
| |
| ----------------- |
| -- End_Handler -- |
| ----------------- |
| |
| procedure End_Handler (GCC_Exception : GNAT_GCC_Exception_Access) is |
| Removed : Boolean; |
| begin |
| Removed := Remove (Get_Current_Excep.all, GCC_Exception); |
| pragma Assert (Removed); |
| end End_Handler; |
| |
| ------------------------- |
| -- Propagate_Exception -- |
| ------------------------- |
| |
| -- Build an object suitable for the libgcc processing and call |
| -- Unwind_RaiseException to actually throw, taking care of handling |
| -- the two phase scheme it implements. |
| |
| procedure Propagate_Exception |
| (E : Exception_Id; |
| From_Signal_Handler : Boolean) |
| is |
| pragma Inspection_Point (E); |
| pragma Unreferenced (From_Signal_Handler); |
| |
| Excep : constant EOA := Get_Current_Excep.all; |
| GCC_Exception : GNAT_GCC_Exception_Access; |
| |
| begin |
| pragma Assert (Excep.Private_Data /= System.Null_Address); |
| |
| -- Retrieve the Private_Data for this occurrence and set the useful |
| -- flags for the personality routine, which will be called for each |
| -- frame via Unwind_RaiseException below. |
| |
| GCC_Exception := To_GNAT_GCC_Exception (Excep.Private_Data); |
| |
| Clear_Setup_And_Not_Propagated (Excep); |
| |
| GCC_Exception.Id := Excep.Id; |
| GCC_Exception.N_Cleanups_To_Trigger := 0; |
| |
| -- Compute the backtrace for this occurrence if the corresponding |
| -- binder option has been set. Call_Chain takes care of the reraise |
| -- case. |
| |
| -- ??? Using Call_Chain here means we are going to walk up the stack |
| -- once only for backtracing purposes before doing it again for the |
| -- propagation per se. |
| |
| -- The first inspection is much lighter, though, as it only requires |
| -- partial unwinding of each frame. Additionally, although we could use |
| -- the personality routine to record the addresses while propagating, |
| -- this method has two drawbacks: |
| |
| -- 1) the trace is incomplete if the exception is handled since we |
| -- don't walk past the frame with the handler, |
| |
| -- and |
| |
| -- 2) we would miss the frames for which our personality routine is not |
| -- called, e.g. if C or C++ calls are on the way. |
| |
| Call_Chain (Excep); |
| |
| -- 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, control will get back to after the |
| -- call, with N_Cleanups_To_Trigger set to the number of frames with |
| -- cleanups found on the way up, and none of these already run. |
| |
| 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; |
| |
| -- Now, if cleanups have been found, run a forced unwind to trigger |
| -- them. Control should not resume there, as the unwinding hook calls |
| -- Unhandled_Exception_Terminate as soon as the last cleanup has been |
| -- triggered. |
| |
| if GCC_Exception.N_Cleanups_To_Trigger /= 0 then |
| Unwind_ForcedUnwind (GCC_Exception, |
| CleanupUnwind_Handler'Address, |
| System.Null_Address); |
| end if; |
| |
| -- We get here when there is no handler or cleanup to be run at all. |
| -- The debugger has been notified before the second step above. |
| |
| Unhandled_Exception_Terminate; |
| end Propagate_Exception; |
| |
| --------------------------- |
| -- Adjust_N_Cleanups_For -- |
| --------------------------- |
| |
| procedure Adjust_N_Cleanups_For |
| (GNAT_Exception : GNAT_GCC_Exception_Access; |
| Adjustment : Integer) |
| is |
| begin |
| GNAT_Exception.N_Cleanups_To_Trigger := |
| GNAT_Exception.N_Cleanups_To_Trigger + Adjustment; |
| end Adjust_N_Cleanups_For; |
| |
| ------------- |
| -- EID_For -- |
| ------------- |
| |
| function EID_For |
| (GNAT_Exception : GNAT_GCC_Exception_Access) return Exception_Id |
| is |
| begin |
| return GNAT_Exception.Id; |
| end EID_For; |
| |
| --------------------- |
| -- Import_Code_For -- |
| --------------------- |
| |
| function Import_Code_For |
| (E : SSL.Exception_Data_Ptr) return Exception_Code |
| is |
| begin |
| return E.all.Import_Code; |
| end Import_Code_For; |
| |
| -------------------------- |
| -- Is_Handled_By_Others -- |
| -------------------------- |
| |
| function Is_Handled_By_Others (E : SSL.Exception_Data_Ptr) return Boolean is |
| begin |
| return not E.all.Not_Handled_By_Others; |
| end Is_Handled_By_Others; |
| |
| ------------------ |
| -- Language_For -- |
| ------------------ |
| |
| function Language_For (E : SSL.Exception_Data_Ptr) return Character is |
| begin |
| return E.all.Lang; |
| end Language_For; |
| |
| ----------- |
| -- Notes -- |
| ----------- |
| |
| -- The current model implemented for the stack of occurrences is a |
| -- simplification of previous attempts, which all prooved to be flawed or |
| -- would have needed significant additional circuitry to be made to work |
| -- correctly. |
| |
| -- We now represent every propagation by a new entry on the stack, which |
| -- means that an exception occurrence may appear more than once (e.g. when |
| -- it is reraised during the course of its own handler). |
| |
| -- This may seem overcostly compared to the C++ model as implemented in |
| -- the g++ v3 libstd. This is actually understandable when one considers |
| -- the extra variations of possible run-time configurations induced by the |
| -- freedom offered by the Save_Occurrence/Reraise_Occurrence public |
| -- interface. |
| |
| -- The basic point is that arranging for an occurrence to always appear at |
| -- most once on the stack requires a way to determine if a given occurence |
| -- is already there, which is not as easy as it might seem. |
| |
| -- An attempt was made to use the Private_Data pointer for this purpose. |
| -- It did not work because: |
| |
| -- 1) The Private_Data has to be saved by Save_Occurrence to be usable |
| -- as a key in case of a later reraise, |
| |
| -- 2) There is no easy way to synchronize End_Handler for an occurrence |
| -- and the data attached to potential copies, so these copies may end |
| -- up pointing to stale data. Moreover ... |
| |
| -- 3) The same address may be reused for different occurrences, which |
| -- defeats the idea of using it as a key. |
| |
| -- The example below illustrates: |
| |
| -- Saved_CE : Exception_Occurrence; |
| |
| -- begin |
| -- raise Constraint_Error; |
| -- exception |
| -- when CE: others => |
| -- Save_Occurrence (Saved_CE, CE); <= Saved_CE.PDA = CE.PDA |
| -- end; |
| |
| -- <= Saved_CE.PDA is stale (!) |
| |
| -- begin |
| -- raise Program_Error; <= Saved_CE.PDA = PE.PDA (!!) |
| -- exception |
| -- when others => |
| -- Reraise_Occurrence (Saved_CE); |
| -- end; |
| |
| -- Not releasing the Private_Data via End_Handler could be an option, |
| -- but making this to work while still avoiding memory leaks is far |
| -- from trivial. |
| |
| -- The current scheme has the advantage of beeing simple, and induces |
| -- extra costs only in reraise cases which is acceptable. |
| |
| end Exception_Propagation; |
