diff options
Diffstat (limited to 'gcc-4.2.1/gcc/ada/a-exexpr-gcc.adb')
| -rw-r--r-- | gcc-4.2.1/gcc/ada/a-exexpr-gcc.adb | 730 |
1 files changed, 0 insertions, 730 deletions
diff --git a/gcc-4.2.1/gcc/ada/a-exexpr-gcc.adb b/gcc-4.2.1/gcc/ada/a-exexpr-gcc.adb deleted file mode 100644 index fdec8d039..000000000 --- a/gcc-4.2.1/gcc/ada/a-exexpr-gcc.adb +++ /dev/null @@ -1,730 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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; |