-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
+-- 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. 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, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
--- 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. --
+-- 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. --
-- --
------------------------------------------------------------------------------
-with Interfaces;
-
-with Ada.Unchecked_Conversion;
-with Ada.Unchecked_Deallocation;
+-- This is the default version, using the __builtin_setjmp/longjmp EH
+-- mechanism.
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.
-
- subtype Exception_Class is Interfaces.Unsigned_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). We need to match this because:
-
- -- 1/ We pass pointers to such headers down to the underlying
- -- libGCC unwinder,
-
- -- and
-
- -- 2/ The GNAT_GCC_Exception record below starts with this common
- -- common header and has a C counterpart which needs to be laid
- -- out identically in raise.c. If the alignment of the C and Ada
- -- common headers mismatch, their size may also differ, and the
- -- layouts may not match anymore.
-
- ---------------------------------------------------------------
- -- 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. This structure shall match the
- -- one in raise.c and is currently experimental as it might be merged
- -- with the GNAT runtime definition some day.
-
- type GNAT_GCC_Exception is record
- Header : Unwind_Exception;
- -- ABI Exception header first.
-
- Id : Exception_Id;
- -- GNAT Exception identifier. This is 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 used to control the forced unwinding triggered when
- -- no handler has been found.
-
- Next_Exception : EOA;
- -- Used to create a linked list of exception occurrences.
- end record;
-
- pragma Convention (C, GNAT_GCC_Exception);
-
- 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 --
- --------------------------------------------
-
- 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");
-
- -- 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.
-
- Setup_Key : constant := 16#DEAD_BEEF#;
-
- 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);
-
- ------------------------------------------------------------
- -- Accessors to basic components of a GNAT exception data --
- ------------------------------------------------------------
-
- -- As of today, these are only used by the C implementation of the
- -- 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");
-
- ------------
- -- 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
- 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 : 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 : 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 : 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;
-
---------------------
-- Setup_Exception --
---------------------
- -- In this implementation of the exception 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;
-
+ pragma Unreferenced (Excep, Current, Reraised);
begin
+ -- In the GNAT-SJLJ case this "stack" only exists implicitly, by way of
+ -- local occurrence declarations together with save/restore operations
+ -- generated by the front-end, and this routine has nothing to do.
- -- 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
- 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;
+ end Setup_Exception;
-------------------------
-- 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 (From_Signal_Handler : Boolean) is
- Excep : EOA := Get_Current_Excep.all;
- GCC_Exception : GNAT_GCC_Exception_Access;
+ procedure Propagate_Exception
+ (E : Exception_Id;
+ From_Signal_Handler : Boolean)
+ is
+ pragma Inspection_Point (E);
+ Jumpbuf_Ptr : constant Address := Get_Jmpbuf_Address.all;
+ Excep : constant EOA := Get_Current_Excep.all;
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);
+ -- Compute the backtrace for this occurrence if corresponding binder
+ -- option has been set. Call_Chain takes care of the reraise case.
- 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.
+ Call_Chain (Excep);
- -- ??? 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.
+ -- Note on above call to Call_Chain:
- -- 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:
+ -- We used to only do this if From_Signal_Handler was not set,
+ -- based on the assumption that backtracing from a signal handler
+ -- would not work due to stack layout oddities. However, since
- -- 1) the trace is incomplete if the exception is handled since we
- -- don't walk past the frame with the handler,
+ -- 1. The flag is never set in tasking programs (Notify_Exception
+ -- performs regular raise statements), and
- -- and
+ -- 2. No problem has shown up in tasking programs around here so
+ -- far, this turned out to be too strong an assumption.
- -- 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.
+ -- As, in addition, the test was
- Call_Chain (Excep);
+ -- 1. preventing the production of backtraces in non-tasking
+ -- programs, and
- -- 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.
+ -- 2. introducing a behavior inconsistency between
+ -- the tasking and non-tasking cases,
- Unwind_RaiseException (GCC_Exception);
+ -- we have simply removed it
- -- 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.
+ -- If the jump buffer pointer is non-null, transfer control using
+ -- it. Otherwise announce an unhandled exception (note that this
+ -- means that we have no finalizations to do other than at the outer
+ -- level). Perform the necessary notification tasks in both cases.
- Notify_Unhandled_Exception;
+ if Jumpbuf_Ptr /= Null_Address then
+ if not Excep.Exception_Raised then
+ Excep.Exception_Raised := True;
+ Exception_Traces.Notify_Handled_Exception;
+ end if;
- -- 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.
+ builtin_longjmp (To_Jmpbuf_Address (Jumpbuf_Ptr), 1);
- if GCC_Exception.N_Cleanups_To_Trigger /= 0 then
- Unwind_ForcedUnwind (GCC_Exception,
- CleanupUnwind_Handler'Address,
- System.Null_Address);
+ else
+ Exception_Traces.Notify_Unhandled_Exception;
+ Exception_Traces.Unhandled_Exception_Terminate;
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;
- ---------------------
- -- 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;