===================================================================
@@ -43,7 +43,7 @@
pragma No_Return (builtin_longjmp);
pragma Import (Intrinsic, builtin_longjmp, "__builtin_longjmp");
- procedure Propagate_Continue (Excep : EOA);
+ procedure Propagate_Continue (E : Exception_Id);
pragma No_Return (Propagate_Continue);
pragma Export (C, Propagate_Continue, "__gnat_raise_nodefer_with_msg");
-- A call to this procedure is inserted automatically by GIGI, in order
@@ -74,14 +74,14 @@
if Jumpbuf_Ptr /= Null_Address then
if not Excep.Exception_Raised then
Excep.Exception_Raised := True;
- Exception_Traces.Notify_Handled_Exception;
+ Exception_Traces.Notify_Handled_Exception (Excep);
end if;
builtin_longjmp (Jumpbuf_Ptr, 1);
else
- Exception_Traces.Notify_Unhandled_Exception;
- Exception_Traces.Unhandled_Exception_Terminate;
+ Exception_Traces.Notify_Unhandled_Exception (Excep);
+ Exception_Traces.Unhandled_Exception_Terminate (Excep);
end if;
end Propagate_Exception;
@@ -89,9 +89,10 @@
-- Propagate_Continue --
------------------------
- procedure Propagate_Continue (Excep : EOA) is
+ procedure Propagate_Continue (E : Exception_Id) is
+ pragma Unreferenced (E);
begin
- Propagate_Exception (Excep);
+ Propagate_Exception (Get_Current_Excep.all);
end Propagate_Continue;
end Exception_Propagation;
===================================================================
@@ -49,6 +49,8 @@
typedef struct Exception_Data *Exception_Id;
+struct Exception_Occurrence;
+
extern void _gnat_builtin_longjmp (void *, int);
extern void __gnat_unhandled_terminate (void);
extern void *__gnat_malloc (__SIZE_TYPE__);
===================================================================
@@ -202,8 +202,9 @@
-- Called to implement raise without exception, ie reraise. Called
-- directly from gigi.
- procedure Setup_Current_Excep
- (GCC_Exception : not null GCC_Exception_Access);
+ function Setup_Current_Excep
+ (GCC_Exception : not null GCC_Exception_Access)
+ return EOA;
pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep");
-- Write Get_Current_Excep.all from GCC_Exception
@@ -342,8 +343,9 @@
-- Setup_Current_Excep --
-------------------------
- procedure Setup_Current_Excep
+ function Setup_Current_Excep
(GCC_Exception : not null GCC_Exception_Access)
+ return EOA
is
Excep : constant EOA := Get_Current_Excep.all;
@@ -359,6 +361,8 @@
To_GNAT_GCC_Exception (GCC_Exception);
begin
Excep.all := GNAT_Occurrence.Occurrence;
+
+ return GNAT_Occurrence.Occurrence'Access;
end;
else
@@ -370,6 +374,8 @@
Excep.Exception_Raised := True;
Excep.Pid := Local_Partition_ID;
Excep.Num_Tracebacks := 0;
+
+ return Excep;
end if;
end Setup_Current_Excep;
@@ -420,6 +426,7 @@
procedure Propagate_GCC_Exception
(GCC_Exception : not null GCC_Exception_Access)
is
+ Excep : EOA;
begin
-- Perform a standard raise first. If a regular handler is found, it
-- will be entered after all the intermediate cleanups have run. If
@@ -432,8 +439,8 @@
-- the necessary steps to enable the debugger to gain control while the
-- stack is still intact.
- Setup_Current_Excep (GCC_Exception);
- Notify_Unhandled_Exception;
+ Excep := Setup_Current_Excep (GCC_Exception);
+ Notify_Unhandled_Exception (Excep);
-- Now, un a forced unwind to trigger cleanups. Control should not
-- resume there, if there are cleanups and in any cases as the
@@ -466,9 +473,10 @@
procedure Unhandled_Except_Handler
(GCC_Exception : not null GCC_Exception_Access)
is
+ Excep : EOA;
begin
- Setup_Current_Excep (GCC_Exception);
- Unhandled_Exception_Terminate;
+ Excep := Setup_Current_Excep (GCC_Exception);
+ Unhandled_Exception_Terminate (Excep);
end Unhandled_Except_Handler;
-------------
===================================================================
@@ -72,17 +72,6 @@
-- latter case because Notify_Handled_Exception may be called for an
-- actually unhandled occurrence in the Front-End-SJLJ case.
- --------------------------------
- -- Import Run-Time C Routines --
- --------------------------------
-
- -- The purpose of the following pragma Import is to ensure that we
- -- generate appropriate subprogram descriptors for all C routines in
- -- the standard GNAT library that can raise exceptions. This ensures
- -- that the exception propagation can properly find these routines
-
- pragma Propagate_Exceptions;
-
----------------------
-- Notify_Exception --
----------------------
@@ -132,18 +121,16 @@
-- Notify_Handled_Exception --
------------------------------
- procedure Notify_Handled_Exception is
+ procedure Notify_Handled_Exception (Excep : EOA) is
begin
- Notify_Exception (Get_Current_Excep.all, Is_Unhandled => False);
+ Notify_Exception (Excep, Is_Unhandled => False);
end Notify_Handled_Exception;
--------------------------------
-- Notify_Unhandled_Exception --
--------------------------------
- procedure Notify_Unhandled_Exception is
- Excep : constant EOA := Get_Current_Excep.all;
-
+ procedure Notify_Unhandled_Exception (Excep : EOA) is
begin
-- Check whether there is any termination handler to be executed for
-- the environment task, and execute it if needed. Here we handle both
@@ -161,8 +148,8 @@
-- Unhandled_Exception_Terminate --
-----------------------------------
- procedure Unhandled_Exception_Terminate is
- Excep : Exception_Occurrence;
+ procedure Unhandled_Exception_Terminate (Excep : EOA) is
+ Occ : Exception_Occurrence;
-- This occurrence will be used to display a message after finalization.
-- It is necessary to save a copy here, or else the designated value
-- could be overwritten if an exception is raised during finalization
@@ -172,8 +159,8 @@
-- that there is enough room on the stack however.
begin
- Save_Occurrence (Excep, Get_Current_Excep.all.all);
- Last_Chance_Handler (Excep);
+ Save_Occurrence (Occ, Excep.all);
+ Last_Chance_Handler (Occ);
end Unhandled_Exception_Terminate;
------------------------------------
===================================================================
@@ -189,19 +189,19 @@
-- exported to be usable by the Ada exception handling personality
-- routine when the GCC 3 mechanism is used.
- procedure Notify_Handled_Exception;
+ procedure Notify_Handled_Exception (Excep : EOA);
pragma Export
(C, Notify_Handled_Exception, "__gnat_notify_handled_exception");
-- This routine is called for a handled occurrence is about to be
-- propagated.
- procedure Notify_Unhandled_Exception;
+ procedure Notify_Unhandled_Exception (Excep : EOA);
pragma Export
(C, Notify_Unhandled_Exception, "__gnat_notify_unhandled_exception");
-- This routine is called when an unhandled occurrence is about to be
-- propagated.
- procedure Unhandled_Exception_Terminate;
+ procedure Unhandled_Exception_Terminate (Excep : EOA);
pragma No_Return (Unhandled_Exception_Terminate);
-- This procedure is called to terminate program execution following an
-- unhandled exception. The exception information, including traceback
@@ -895,14 +895,14 @@
if Jumpbuf_Ptr /= Null_Address then
if not Excep.Exception_Raised then
Excep.Exception_Raised := True;
- Exception_Traces.Notify_Handled_Exception;
+ Exception_Traces.Notify_Handled_Exception (Excep);
end if;
builtin_longjmp (Jumpbuf_Ptr, 1);
else
- Exception_Traces.Notify_Unhandled_Exception;
- Exception_Traces.Unhandled_Exception_Terminate;
+ Exception_Traces.Notify_Unhandled_Exception (Excep);
+ Exception_Traces.Unhandled_Exception_Terminate (Excep);
end if;
end Process_Raise_Exception;
===================================================================
@@ -209,19 +209,19 @@
-- exported to be usable by the Ada exception handling personality
-- routine when the GCC 3 mechanism is used.
- procedure Notify_Handled_Exception;
+ procedure Notify_Handled_Exception (Excep : EOA);
pragma Export
(C, Notify_Handled_Exception, "__gnat_notify_handled_exception");
-- This routine is called for a handled occurrence is about to be
-- propagated.
- procedure Notify_Unhandled_Exception;
+ procedure Notify_Unhandled_Exception (Excep : EOA);
pragma Export
(C, Notify_Unhandled_Exception, "__gnat_notify_unhandled_exception");
-- This routine is called when an unhandled occurrence is about to be
-- propagated.
- procedure Unhandled_Exception_Terminate;
+ procedure Unhandled_Exception_Terminate (Excep : EOA);
pragma No_Return (Unhandled_Exception_Terminate);
-- This procedure is called to terminate execution following an
-- unhandled exception. The exception information, including
@@ -395,15 +395,16 @@
-- Reraises the exception referenced by the Current_Excep field of
-- the TSD (all fields of this exception occurrence are set). Abort
-- is deferred before the reraise operation.
+ -- Called from System.Tasking.RendezVous.Exceptional_Complete_RendezVous
procedure Transfer_Occurrence
(Target : Exception_Occurrence_Access;
Source : Exception_Occurrence);
pragma Export (C, Transfer_Occurrence, "__gnat_transfer_occurrence");
- -- Called from System.Tasking.RendezVous.Exceptional_Complete_RendezVous
- -- to setup Target from Source as an exception to be propagated in the
- -- caller task. Target is expected to be a pointer to the fixed TSD
- -- occurrence for this task.
+ -- Called from s-tasren.adb:Local_Complete_RendezVous and
+ -- s-tpobop.adb:Exceptional_Complete_Entry_Body to setup Target from
+ -- Source as an exception to be propagated in the caller task. Target is
+ -- expected to be a pointer to the fixed TSD occurrence for this task.
-----------------------------
-- Run-Time Check Routines --
@@ -953,8 +954,6 @@
Message : String := "")
is
EF : Exception_Id := E;
- X : constant EOA := Exception_Propagation.Allocate_Occurrence;
-
begin
-- Raise CE if E = Null_ID (AI-446)
@@ -964,14 +963,7 @@
-- Go ahead and raise appropriate exception
- Exception_Data.Set_Exception_Msg (X, EF, Message);
-
- if not ZCX_By_Default then
- Abort_Defer.all;
- end if;
-
- Complete_Occurrence (X);
- Exception_Propagation.Propagate_Exception (X);
+ Raise_Exception_Always (EF, Message);
end Raise_Exception;
----------------------------
===================================================================
@@ -77,7 +77,8 @@
_Unwind_Reason_Code
__gnat_Unwind_ForcedUnwind (_Unwind_Exception *, void *, void *);
-extern void __gnat_setup_current_excep (_Unwind_Exception *);
+extern struct Exception_Occurrence *__gnat_setup_current_excep
+ (_Unwind_Exception *);
extern void __gnat_unhandled_except_handler (_Unwind_Exception *);
#include "dwarf2.h"
@@ -1001,8 +1002,8 @@
/* The following is defined from a-except.adb. Its purpose is to enable
automatic backtraces upon exception raise, as provided through the
GNAT.Traceback facilities. */
-extern void __gnat_notify_handled_exception (void);
-extern void __gnat_notify_unhandled_exception (void);
+extern void __gnat_notify_handled_exception (struct Exception_Occurrence *);
+extern void __gnat_notify_unhandled_exception (struct Exception_Occurrence *);
/* Below is the eh personality routine per se. We currently assume that only
GNU-Ada exceptions are met. */
@@ -1131,14 +1132,16 @@
}
else
{
+ struct Exception_Occurrence *excep;
+
/* Trigger the appropriate notification routines before the second
phase starts, which ensures the stack is still intact.
First, setup the Ada occurrence. */
- __gnat_setup_current_excep (uw_exception);
+ excep = __gnat_setup_current_excep (uw_exception);
if (action.kind == unhandler)
- __gnat_notify_unhandled_exception ();
+ __gnat_notify_unhandled_exception (excep);
else
- __gnat_notify_handled_exception ();
+ __gnat_notify_handled_exception (excep);
return _URC_HANDLER_FOUND;
}
@@ -1324,7 +1327,7 @@
CONTEXT context;
PRUNTIME_FUNCTION mf_func = NULL;
ULONG64 mf_imagebase;
- ULONG64 mf_rsp;
+ ULONG64 mf_rsp = 0;
/* Get the context. */
RtlCaptureContext (&context);