===================================================================
@@ -104,11 +104,12 @@
-- 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;
+ Class : Exception_Class;
+ Cleanup : System.Address;
Private1 : Unwind_Word;
Private2 : 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;
@@ -117,6 +118,19 @@
-- maximally aligned (see unwind.h). See additional comments on the
-- alignment below.
+ type GCC_Exception_Access is access all Unwind_Exception;
+ pragma Convention (C, GCC_Exception_Access);
+ -- Pointer to a GCC exception
+
+ 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");
+ -- Id for foreign exceptions
+
--------------------------------------------------------------
-- GNAT Specific Entities To Deal With The GCC EH Circuitry --
--------------------------------------------------------------
@@ -128,13 +142,8 @@
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 being propagated.
-
- Next_Exception : EOA;
- -- Used to create a linked list of exception occurrences
+ Occurrence : Exception_Occurrence;
+ -- The Ada occurrence
end record;
pragma Convention (C, GNAT_GCC_Exception);
@@ -158,20 +167,40 @@
type GNAT_GCC_Exception_Access is access all GNAT_GCC_Exception;
+ function To_GCC_Exception is new
+ Unchecked_Conversion (GNAT_GCC_Exception_Access, GCC_Exception_Access);
+
function To_GNAT_GCC_Exception is new
- Unchecked_Conversion (System.Address, GNAT_GCC_Exception_Access);
+ Unchecked_Conversion (GCC_Exception_Access, GNAT_GCC_Exception_Access);
- procedure Free is new Unchecked_Deallocation
- (GNAT_GCC_Exception, GNAT_GCC_Exception_Access);
+ 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 Free is new Unchecked_Deallocation
- (Exception_Occurrence, EOA);
+ 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.
+
+ procedure Setup_Current_Excep
+ (GCC_Exception : not null GCC_Exception_Access);
+ pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep");
+ -- Write Get_Current_Excep.all from GCC_Exception
+
function CleanupUnwind_Handler
(UW_Version : Integer;
UW_Phases : Unwind_Action;
UW_Eclass : Exception_Class;
- UW_Exception : not null access GNAT_GCC_Exception;
+ UW_Exception : not null GCC_Exception_Access;
UW_Context : System.Address;
UW_Argument : System.Address) return Unwind_Reason_Code;
-- Hook called at each step of the forced unwinding we perform to
@@ -183,57 +212,25 @@
-- __gnat stubs for these.
procedure Unwind_RaiseException
- (UW_Exception : not null access GNAT_GCC_Exception);
+ (UW_Exception : not null GCC_Exception_Access);
pragma Import (C, Unwind_RaiseException, "__gnat_Unwind_RaiseException");
procedure Unwind_ForcedUnwind
- (UW_Exception : not null access GNAT_GCC_Exception;
+ (UW_Exception : not null GCC_Exception_Access;
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);
+ procedure Begin_Handler (GCC_Exception : not null GCC_Exception_Access);
pragma Export (C, Begin_Handler, "__gnat_begin_handler");
- procedure End_Handler (GCC_Exception : GNAT_GCC_Exception_Access);
+ procedure End_Handler (GCC_Exception : 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 Pointer --
--------------------------------------------------------------------
@@ -254,7 +251,7 @@
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)
+ function EID_For (GNAT_Exception : not null GNAT_GCC_Exception_Access)
return Exception_Id;
pragma Export (C, EID_For, "__gnat_eid_for");
@@ -274,65 +271,25 @@
All_Others_Value : constant Integer := 16#7FFF#;
pragma Export (C, All_Others_Value, "__gnat_all_others_value");
- ------------
- -- Remove --
- ------------
+ --------------------------------
+ -- GNAT_GCC_Exception_Cleanup --
+ --------------------------------
- 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;
+ 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
- -- Pop stack
+ -- Simply free the memory
- loop
- pragma Assert (Iter.Private_Data /= System.Null_Address);
+ Free (Copy);
+ end GNAT_GCC_Exception_Cleanup;
- 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 --
---------------------------
@@ -341,17 +298,16 @@
(UW_Version : Integer;
UW_Phases : Unwind_Action;
UW_Eclass : Exception_Class;
- UW_Exception : not null access GNAT_GCC_Exception;
+ UW_Exception : not null GCC_Exception_Access;
UW_Context : System.Address;
UW_Argument : System.Address) return Unwind_Reason_Code
is
- pragma Unreferenced
- (UW_Version, UW_Eclass, UW_Exception, UW_Context, UW_Argument);
-
+ pragma Unreferenced (UW_Version, UW_Eclass, UW_Context, UW_Argument);
begin
-- Terminate when the end of the stack is reached
if UW_Phases >= UA_END_OF_STACK then
+ Setup_Current_Excep (UW_Exception);
Unhandled_Exception_Terminate;
end if;
@@ -362,54 +318,6 @@
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 --
---------------------
@@ -423,80 +331,56 @@
Current : EOA;
Reraised : Boolean := False)
is
- Top : constant EOA := Current;
- Next : EOA;
- GCC_Exception : GNAT_GCC_Exception_Access;
-
+ pragma Unreferenced (Excep, Current, Reraised);
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.
+ -- 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.
- -- What we do here is to trigger this push when need be, and allocate a
- -- Private_Data block for the forthcoming Propagation.
+ null;
+ end Setup_Exception;
- -- 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.
+ -------------------------
+ -- Setup_Current_Excep --
+ -------------------------
- -- 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.
+ procedure Setup_Current_Excep
+ (GCC_Exception : not null GCC_Exception_Access) is
+ Excep : constant EOA := Get_Current_Excep.all;
+ begin
+ -- Setup the exception occurrence
- if not Reraised and then Is_Setup_And_Not_Propagated (Excep) then
- return;
- end if;
+ if GCC_Exception.Class = GNAT_Exception_Class then
- -- Allocate what will be the Private_Data block for the exception
- -- to be propagated.
+ -- From the GCC exception
- GCC_Exception := new GNAT_GCC_Exception;
+ declare
+ GNAT_Occurrence : constant GNAT_GCC_Exception_Access :=
+ To_GNAT_GCC_Exception (GCC_Exception);
+ begin
+ Excep.all := GNAT_Occurrence.Occurrence;
+ end;
+ else
- -- 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.
+ -- A default one
- -- 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;
+ Excep.Id := Foreign_Exception'Access;
+ Excep.Msg_Length := 0;
+ Excep.Cleanup_Flag := False;
+ Excep.Exception_Raised := True;
+ Excep.Pid := Local_Partition_ID;
+ Excep.Num_Tracebacks := 0;
+ Excep.Private_Data := System.Null_Address;
end if;
+ end Setup_Current_Excep;
- 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
+ procedure Begin_Handler (GCC_Exception : not null 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;
@@ -504,13 +388,68 @@
-- End_Handler --
-----------------
- procedure End_Handler (GCC_Exception : GNAT_GCC_Exception_Access) is
- Removed : Boolean;
+ procedure End_Handler (GCC_Exception : GCC_Exception_Access) is
begin
- Removed := Remove (Get_Current_Excep.all, GCC_Exception);
- pragma Assert (Removed);
+ 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
+ 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.
+
+ Setup_Current_Excep (GCC_Exception);
+ Notify_Unhandled_Exception;
+
+ -- 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.
+
+ Setup_Current_Excep (GCC_Exception);
+ Unhandled_Exception_Terminate;
+ end Propagate_GCC_Exception;
+
-------------------------
-- Propagate_Exception --
-------------------------
@@ -530,18 +469,6 @@
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;
-
-- Compute the backtrace for this occurrence if the corresponding
-- binder option has been set. Call_Chain takes care of the reraise
-- case.
@@ -565,32 +492,17 @@
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, it will return.
+ -- Allocate the GCC exception
- Unwind_RaiseException (GCC_Exception);
+ GCC_Exception := new GNAT_GCC_Exception'
+ (Header => (Class => GNAT_Exception_Class,
+ Cleanup => GNAT_GCC_Exception_Cleanup'Address,
+ Private1 => 0,
+ Private2 => 0),
+ Occurrence => Excep.all);
- -- 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, 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_Exception_Terminate;
+ -- Propagate it.
+ Propagate_GCC_Exception (To_GCC_Exception (GCC_Exception));
end Propagate_Exception;
-------------
@@ -598,10 +510,10 @@
-------------
function EID_For
- (GNAT_Exception : GNAT_GCC_Exception_Access) return Exception_Id
+ (GNAT_Exception : not null GNAT_GCC_Exception_Access) return Exception_Id
is
begin
- return GNAT_Exception.Id;
+ return GNAT_Exception.Occurrence.Id;
end EID_For;
---------------------
@@ -633,67 +545,4 @@
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 proved 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 occurrence
- -- 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 being simple, and induces
- -- extra costs only in reraise cases which is acceptable.
-
end Exception_Propagation;
===================================================================
@@ -1665,6 +1665,15 @@
-- does not have a choice parameter specification, then we provide one.
else
+
+ -- Don't expand if back end exception handling active
+
+ if VM_Target = No_VM
+ and then Exception_Mechanism = Back_End_Exceptions
+ then
+ return;
+ end if;
+
-- Find innermost enclosing exception handler (there must be one,
-- since the semantics has already verified that this raise statement
-- is valid, and a raise with no arguments is only permitted in the
===================================================================
@@ -81,4 +81,9 @@
private
ZCX_By_Default : constant Boolean := System.ZCX_By_Default;
+ Foreign_Exception : exception;
+ pragma Unreferenced (Foreign_Exception);
+ -- This hidden exception is used to represent non-Ada exception to
+ -- Ada handlers. It is in fact referenced by its linking name.
+
end System.Exceptions;
===================================================================
@@ -101,6 +101,7 @@
_Unwind_Reason_Code
__gnat_Unwind_ForcedUnwind (_Unwind_Exception *, void *, void *);
+extern void __gnat_setup_current_excep (_Unwind_Exception *);
#ifdef IN_RTS /* For eh personality routine */
@@ -108,7 +109,11 @@
#include "unwind-dw2-fde.h"
#include "unwind-pe.h"
+/* The known and handled exception classes. */
+#define CXX_EXCEPTION_CLASS 0x474e5543432b2b00ULL
+#define GNAT_EXCEPTION_CLASS 0x474e552d41646100ULL
+
/* --------------------------------------------------------------
-- The DB stuff below is there for debugging purposes only. --
-------------------------------------------------------------- */
@@ -853,39 +858,51 @@
static int
is_handled_by (_Unwind_Ptr choice, _GNAT_Exception * propagated_exception)
{
- /* Pointer to the GNAT exception data corresponding to the propagated
- occurrence. */
- _Unwind_Ptr E = (_Unwind_Ptr) EID_For (propagated_exception);
+ if (propagated_exception->common.exception_class == GNAT_EXCEPTION_CLASS)
+ {
+ /* Pointer to the GNAT exception data corresponding to the propagated
+ occurrence. */
+ _Unwind_Ptr E = (_Unwind_Ptr) EID_For (propagated_exception);
- /* Base matching rules: An exception data (id) matches itself, "when
- all_others" matches anything and "when others" matches anything unless
- explicitly stated otherwise in the propagated occurrence. */
+ /* Base matching rules: An exception data (id) matches itself, "when
+ all_others" matches anything and "when others" matches anything
+ unless explicitly stated otherwise in the propagated occurrence. */
- bool is_handled =
- choice == E
- || choice == GNAT_ALL_OTHERS
- || (choice == GNAT_OTHERS && Is_Handled_By_Others (E));
+ bool is_handled =
+ choice == E
+ || choice == GNAT_ALL_OTHERS
+ || (choice == GNAT_OTHERS && Is_Handled_By_Others (E));
- /* In addition, on OpenVMS, Non_Ada_Error matches VMS exceptions, and we
- may have different exception data pointers that should match for the
- same condition code, if both an export and an import have been
- registered. The import code for both the choice and the propagated
- occurrence are expected to have been masked off regarding severity
- bits already (at registration time for the former and from within the
- low level exception vector for the latter). */
+ /* In addition, on OpenVMS, Non_Ada_Error matches VMS exceptions, and we
+ may have different exception data pointers that should match for the
+ same condition code, if both an export and an import have been
+ registered. The import code for both the choice and the propagated
+ occurrence are expected to have been masked off regarding severity
+ bits already (at registration time for the former and from within the
+ low level exception vector for the latter). */
#ifdef VMS
- #define Non_Ada_Error system__aux_dec__non_ada_error
- extern struct Exception_Data Non_Ada_Error;
+# define Non_Ada_Error system__aux_dec__non_ada_error
+ extern struct Exception_Data Non_Ada_Error;
- is_handled |=
- (Language_For (E) == 'V'
- && choice != GNAT_OTHERS && choice != GNAT_ALL_OTHERS
- && ((Language_For (choice) == 'V' && Import_Code_For (choice) != 0
- && Import_Code_For (choice) == Import_Code_For (E))
- || choice == (_Unwind_Ptr)&Non_Ada_Error));
+ is_handled |=
+ (Language_For (E) == 'V'
+ && choice != GNAT_OTHERS && choice != GNAT_ALL_OTHERS
+ && ((Language_For (choice) == 'V' && Import_Code_For (choice) != 0
+ && Import_Code_For (choice) == Import_Code_For (E))
+ || choice == (_Unwind_Ptr)&Non_Ada_Error));
#endif
- return is_handled;
+ return is_handled;
+ }
+ else
+ {
+# define Foreign_Exception system__exceptions__foreign_exception;
+ extern struct Exception_Data Foreign_Exception;
+
+ return choice == GNAT_ALL_OTHERS
+ || choice == GNAT_OTHERS
+ || choice == (_Unwind_Ptr)&Foreign_Exception;
+ }
}
/* Fill out the ACTION to be taken from propagating UW_EXCEPTION up to
@@ -1079,9 +1096,6 @@
Condition Handling Facility. */
int uw_version = (int) version_arg;
_Unwind_Action uw_phases = (_Unwind_Action) phases_arg;
-
- _GNAT_Exception * gnat_exception = (_GNAT_Exception *) uw_exception;
-
region_descriptor region;
action_descriptor action;
@@ -1089,7 +1103,7 @@
possible variation on VMS for IA64. */
if (uw_version != 1)
{
- #if defined (VMS) && defined (__IA64)
+#if defined (VMS) && defined (__IA64)
/* Assume we're called with sigargs/mechargs arguments if really
unexpected bits are set in our first two formals. Redirect to the
@@ -1103,7 +1117,7 @@
if ((unsigned int)uw_version & version_unexpected_bits_mask
&& (unsigned int)uw_phases & phases_unexpected_bits_mask)
return __gnat_handle_vms_condition (version_arg, phases_arg);
- #endif
+#endif
return _URC_FATAL_PHASE1_ERROR;
}
@@ -1160,6 +1174,9 @@
setup_to_install
(uw_context, uw_exception, action.landing_pad, action.ttype_filter);
+ /* Write current exception, so that it can be retrieved from Ada. */
+ __gnat_setup_current_excep (uw_exception);
+
return _URC_INSTALL_CONTEXT;
}