This is preliminary work to have a better support of foreign exceptions and
of Windows 64 SEH. This patch introduce the notion of machine occurrence,
which is the system exception propagated. This occurrence is allocated before
setting up the Ada occurrence, which slightly speed-up occurrence setup.
Previously, the Ada occurrence was built in the ATCB and then copied to a
newly allocated machine occurrence.
No testcase as there is no behavioral change.
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-07-16 Tristan Gingold <ging...@adacore.com>
* a-exexpr.adb (Propagate_Continue): New function replacing
Raise_Current_Excep.
(Allocate_Occurrence): New function.
(Propagate_Exception): Add Excep parameter, remove call to Call_Chain.
* a-exexpr-gcc.adb (GNAT_GCC_Exception): Occurrence component
is now aliased.
(To_GCC_Exception): Convert from Address.
(Allocate_Occurrence): Allocate an Unwind exception occurrence.
(Setup_Current_Excep): Fill the machine occurrence in case of
foreign exception.
(Propagate_Exception): Add Excep parameter, remove call to Call_Chain.
* a-except.adb (Set_Exception_C_Msg, Set_Exception_Msg): add
Excep parameter.
(Raise_Exception, Raise_Exception_Always,
Raise_Exception_No_Defer): Adjust calls to the above procedures.
(Raise_From_Signal_Handler, Raise_With_Location_And_Msg)
(Rcheck_PE_Finalize_Raised_Exception): Likewise.
* a-except-2005.adb (Set_Exception_C_Msg, Set_Exception_Msg):
add Excep parameter.
(Propagate_Exception): Likewise.
(Allocate_Occurrence): New function.
(Raise_Current_Excep): Removed.
(Complete_Occurrence): New function to save the call chain.
(Complete_And_Propagate_Occurrence): New procedure.
(Create_Occurrence_From_Signal_Handler): New function to build an
occurrence without propagating it.
(Create_Machine_Occurrence_From_Signal_Handler): Likewise, but
return the machine occurrence.
(Raise_From_Signal_Handler): Use Create_Occurrence_From_Signal_Handler.
(Raise_Exception, Raise_Exception_Always, Raise_Exception_No_Defer):
Adjust calls to the above procedures. Allocate the occurrence at
the beginning.
(Raise_With_Location_And_Msg, Raise_With_Msg)
(Rcheck_PE_Finalize_Raised_Exceptionm Reraise): Likewise.
(Reraise_Occurrence): Use Reraise_Occurrence_Always.
(Reraise_Occurrence_Always): Use Reraise_Occurrence_No_Defer.
(Reraise_Occurrence_No_Defer): Preserve machine occurrence.
(Save_Occurrence): Do not save machine occurrence.
* a-except-2005.ads (Exception_Occurrence): Add Machine_Occurrence
component.
(Null_Occurrence): Consider it.
* a-exexda.adb (Set_Exception_C_Msg, Set_Exception_Msg): add
Excep parameter.
Index: a-exexpr.adb
===================================================================
--- a-exexpr.adb (revision 189524)
+++ a-exexpr.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
@@ -43,42 +43,29 @@
pragma No_Return (builtin_longjmp);
pragma Import (Intrinsic, builtin_longjmp, "__builtin_longjmp");
+ procedure Propagate_Continue (Excep : EOA);
+ 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
+ -- to continue the propagation when the exception was not handled.
+ -- The linkage name is historical.
+
-------------------------
- -- Propagate_Exception --
+ -- Allocate_Occurrence --
-------------------------
- procedure Propagate_Exception
- is
- Jumpbuf_Ptr : constant Address := Get_Jmpbuf_Address.all;
- Excep : constant EOA := Get_Current_Excep.all;
+ function Allocate_Occurrence return EOA is
begin
- -- Compute the backtrace for this occurrence if corresponding binder
- -- option has been set. Call_Chain takes care of the reraise case.
+ return Get_Current_Excep.all;
+ end Allocate_Occurrence;
- Call_Chain (Excep);
+ -------------------------
+ -- Propagate_Exception --
+ -------------------------
- -- Note on above call to Call_Chain:
-
- -- 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 flag is never set in tasking programs (Notify_Exception
- -- performs regular raise statements), and
-
- -- 2. No problem has shown up in tasking programs around here so
- -- far, this turned out to be too strong an assumption.
-
- -- As, in addition, the test was
-
- -- 1. preventing the production of backtraces in non-tasking
- -- programs, and
-
- -- 2. introducing a behavior inconsistency between
- -- the tasking and non-tasking cases,
-
- -- we have simply removed it
-
+ procedure Propagate_Exception (Excep : EOA) is
+ Jumpbuf_Ptr : constant Address := Get_Jmpbuf_Address.all;
+ begin
-- 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
@@ -98,4 +85,13 @@
end if;
end Propagate_Exception;
+ ------------------------
+ -- Propagate_Continue --
+ ------------------------
+
+ procedure Propagate_Continue (Excep : EOA) is
+ begin
+ Propagate_Exception (Excep);
+ end Propagate_Continue;
+
end Exception_Propagation;
Index: a-exexpr-gcc.adb
===================================================================
--- a-exexpr-gcc.adb (revision 189524)
+++ a-exexpr-gcc.adb (working copy)
@@ -39,6 +39,8 @@
separate (Ada.Exceptions)
package body Exception_Propagation is
+ use Exception_Traces;
+
------------------------------------------------
-- Entities to interface with the GCC runtime --
------------------------------------------------
@@ -110,7 +112,7 @@
Private2 : Unwind_Word;
-- Usual exception structure has only two private fields, but the SEH
- -- one has six. To avoid makeing this file more complex, we use six
+ -- one has six. To avoid making this file more complex, we use six
-- fields on all platforms, wasting a few bytes on some.
Private3 : Unwind_Word;
@@ -151,7 +153,7 @@
Header : Unwind_Exception;
-- ABI Exception header first
- Occurrence : Exception_Occurrence;
+ Occurrence : aliased Exception_Occurrence;
-- The Ada occurrence
end record;
@@ -177,7 +179,7 @@
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);
+ Unchecked_Conversion (System.Address, GCC_Exception_Access);
function To_GNAT_GCC_Exception is new
Unchecked_Conversion (GCC_Exception_Access, GNAT_GCC_Exception_Access);
@@ -297,6 +299,24 @@
-- exceptions on targets which always handle exceptions (such as SEH).
-- The handler will simply call Unhandled_Except_Handler.
+ -------------------------
+ -- Allocate_Occurrence --
+ -------------------------
+
+ function Allocate_Occurrence return EOA is
+ Res : GNAT_GCC_Exception_Access;
+ begin
+ Res :=
+ new GNAT_GCC_Exception'
+ (Header => (Class => GNAT_Exception_Class,
+ Cleanup => GNAT_GCC_Exception_Cleanup'Address,
+ others => 0),
+ Occurrence => (others => <>));
+ Res.Occurrence.Machine_Occurrence := Res.all'Address;
+
+ return Res.Occurrence'Access;
+ end Allocate_Occurrence;
+
--------------------------------
-- GNAT_GCC_Exception_Cleanup --
--------------------------------
@@ -345,6 +365,7 @@
-- A default one
Excep.Id := Foreign_Exception'Access;
+ Excep.Machine_Occurrence := GCC_Exception.all'Address;
Excep.Msg_Length := 0;
Excep.Exception_Raised := True;
Excep.Pid := Local_Partition_ID;
@@ -433,50 +454,9 @@
-- Propagate_Exception --
-------------------------
- -- Build an object suitable for the libgcc processing and call
- -- Unwind_RaiseException to actually do the raise, taking care of
- -- handling the two phase scheme it implements.
-
- procedure Propagate_Exception is
- Excep : constant EOA := Get_Current_Excep.all;
- GCC_Exception : GNAT_GCC_Exception_Access;
-
+ procedure Propagate_Exception (Excep : EOA) is
begin
- -- 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);
-
- -- Allocate the GCC exception
-
- GCC_Exception :=
- new GNAT_GCC_Exception'
- (Header => (Class => GNAT_Exception_Class,
- Cleanup => GNAT_GCC_Exception_Cleanup'Address,
- others => 0),
- Occurrence => Excep.all);
-
- -- Propagate it
-
- Propagate_GCC_Exception (To_GCC_Exception (GCC_Exception));
+ Propagate_GCC_Exception (To_GCC_Exception (Excep.Machine_Occurrence));
end Propagate_Exception;
------------------------------
Index: a-except.adb
===================================================================
--- a-except.adb (revision 189524)
+++ a-except.adb (working copy)
@@ -93,7 +93,8 @@
---------------------------------
procedure Set_Exception_C_Msg
- (Id : Exception_Id;
+ (Excep : EOA;
+ Id : Exception_Id;
Msg1 : System.Address;
Line : Integer := 0;
Column : Integer := 0;
@@ -107,7 +108,8 @@
-- additional null terminated string is added to the message.
procedure Set_Exception_Msg
- (Id : Exception_Id;
+ (Excep : EOA;
+ Id : Exception_Id;
Message : String);
-- This routine is called to setup the exception referenced by the
-- Current_Excep field in the TSD to contain the indicated Id value and
@@ -966,8 +968,8 @@
(E : Exception_Id;
Message : String := "")
is
- EF : Exception_Id := E;
-
+ EF : Exception_Id := E;
+ Excep : constant EOA := Get_Current_Excep.all;
begin
-- Raise CE if E = Null_ID (AI-446)
@@ -977,7 +979,7 @@
-- Go ahead and raise appropriate exception
- Exception_Data.Set_Exception_Msg (EF, Message);
+ Exception_Data.Set_Exception_Msg (Excep, EF, Message);
Abort_Defer.all;
Raise_Current_Excep (EF);
end Raise_Exception;
@@ -990,8 +992,9 @@
(E : Exception_Id;
Message : String := "")
is
+ Excep : constant EOA := Get_Current_Excep.all;
begin
- Exception_Data.Set_Exception_Msg (E, Message);
+ Exception_Data.Set_Exception_Msg (Excep, E, Message);
Abort_Defer.all;
Raise_Current_Excep (E);
end Raise_Exception_Always;
@@ -1004,8 +1007,9 @@
(E : Exception_Id;
Message : String := "")
is
+ Excep : constant EOA := Get_Current_Excep.all;
begin
- Exception_Data.Set_Exception_Msg (E, Message);
+ Exception_Data.Set_Exception_Msg (Excep, E, Message);
-- Do not call Abort_Defer.all, as specified by the spec
@@ -1065,8 +1069,9 @@
(E : Exception_Id;
M : System.Address)
is
+ Excep : constant EOA := Get_Current_Excep.all;
begin
- Exception_Data.Set_Exception_C_Msg (E, M);
+ Exception_Data.Set_Exception_C_Msg (Excep, E, M);
Abort_Defer.all;
Process_Raise_Exception (E);
end Raise_From_Signal_Handler;
@@ -1135,8 +1140,9 @@
L : Integer;
M : System.Address := System.Null_Address)
is
+ Excep : constant EOA := Get_Current_Excep.all;
begin
- Exception_Data.Set_Exception_C_Msg (E, F, L, Msg2 => M);
+ Exception_Data.Set_Exception_C_Msg (Excep, E, F, L, Msg2 => M);
Abort_Defer.all;
Raise_Current_Excep (E);
end Raise_With_Location_And_Msg;
@@ -1402,8 +1408,8 @@
procedure Rcheck_PE_Finalize_Raised_Exception
(File : System.Address; Line : Integer)
is
- E : constant Exception_Id := Program_Error_Def'Access;
-
+ E : constant Exception_Id := Program_Error_Def'Access;
+ Excep : constant EOA := Get_Current_Excep.all;
begin
-- This is "finalize/adjust raised exception". This subprogram is always
-- called with abort deferred, unlike all other Rcheck_* routines, it
@@ -1411,7 +1417,8 @@
-- This is consistent with Raise_From_Controlled_Operation
- Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address);
+ Exception_Data.Set_Exception_C_Msg (Excep, E, File, Line, 0,
+ Rmsg_22'Address);
Raise_Current_Excep (E);
end Rcheck_PE_Finalize_Raised_Exception;
Index: a-except-2005.adb
===================================================================
--- a-except-2005.adb (revision 189524)
+++ a-except-2005.adb (working copy)
@@ -116,26 +116,27 @@
---------------------------------
procedure Set_Exception_C_Msg
- (Id : Exception_Id;
+ (Excep : EOA;
+ Id : Exception_Id;
Msg1 : System.Address;
Line : Integer := 0;
Column : Integer := 0;
Msg2 : System.Address := System.Null_Address);
- -- This routine is called to setup the exception referenced by the
- -- Current_Excep field in the TSD to contain the indicated Id value
- -- and message. Msg1 is a null terminated string which is generated
- -- as the exception message. If line is non-zero, then a colon and
- -- the decimal representation of this integer is appended to the
- -- message. Ditto for Column. When Msg2 is non-null, a space and this
- -- additional null terminated string is added to the message.
+ -- This routine is called to setup the exception referenced by X
+ -- to contain the indicated Id value and message. Msg1 is a null
+ -- terminated string which is generated as the exception message. If
+ -- line is non-zero, then a colon and the decimal representation of
+ -- this integer is appended to the message. Ditto for Column. When Msg2
+ -- is non-null, a space and this additional null terminated string is
+ -- added to the message.
procedure Set_Exception_Msg
- (Id : Exception_Id;
+ (Excep : EOA;
+ Id : Exception_Id;
Message : String);
- -- This routine is called to setup the exception referenced by the
- -- Current_Excep field in the TSD to contain the indicated Id value
- -- and message. Message is a string which is generated as the
- -- exception message.
+ -- This routine is called to setup the exception referenced by X
+ -- to contain the indicated Id value and message. Message is a string
+ -- which is generated as the exception message.
--------------------------------------
-- Exception information subprogram --
@@ -232,18 +233,16 @@
package Exception_Propagation is
- use Exception_Traces;
- -- Imports Notify_Unhandled_Exception and
- -- Unhandled_Exception_Terminate
-
------------------------------------
-- Exception propagation routines --
------------------------------------
- procedure Propagate_Exception;
+ function Allocate_Occurrence return EOA;
+ -- Allocate an exception occurence (as well as the machine occurence)
+
+ procedure Propagate_Exception (Excep : EOA);
pragma No_Return (Propagate_Exception);
- -- This procedure propagates the exception represented by the occurrence
- -- referenced by Current_Excep in the TSD for the current task.
+ -- This procedure propagates the exception represented by Excep
end Exception_Propagation;
@@ -264,15 +263,31 @@
end Stream_Attributes;
- procedure Raise_Current_Excep (E : Exception_Id);
- pragma No_Return (Raise_Current_Excep);
- pragma Export (C, Raise_Current_Excep, "__gnat_raise_nodefer_with_msg");
- -- This is a simple wrapper to Exception_Propagation.Propagate_Exception.
- --
- -- This external name for Raise_Current_Excep is historical, and probably
- -- should be changed but for now we keep it, because gdb and gigi know
- -- about it.
+ procedure Complete_Occurrence (X : EOA);
+ -- Finish building the occurrence: save the call chain and notify the
+ -- debugger.
+ procedure Complete_And_Propagate_Occurrence (X : EOA);
+ pragma No_Return (Complete_And_Propagate_Occurrence);
+ -- This is a simple wrapper to Complete_Occurrence and
+ -- Exception_Propagation.Propagate_Exception.
+
+ function Create_Occurrence_From_Signal_Handler
+ (E : Exception_Id;
+ M : System.Address)
+ return EOA;
+ -- Create and build an exception occurrence using exception id E and
+ -- nul-terminated message M.
+
+ function Create_Machine_Occurrence_From_Signal_Handler
+ (E : Exception_Id;
+ M : System.Address)
+ return System.Address;
+ pragma Export (C, Create_Machine_Occurrence_From_Signal_Handler,
+ "__gnat_create_machine_occurrence_from_signal_handler");
+ -- Create and build an exception occurrence using exception id E and
+ -- nul-terminated message M. Return the machine occurrence.
+
procedure Raise_Exception_No_Defer
(E : Exception_Id; Message : String := "");
pragma Export
@@ -372,7 +387,7 @@
-- | | | |
-- | | | Set_E_C_Msg(i)
-- | | |
- -- Raise_Current_Excep
+ -- Complete_And_Propagate_Occurrence
procedure Reraise;
pragma No_Return (Reraise);
@@ -887,15 +902,48 @@
end Raise_Constraint_Error_Msg;
-------------------------
- -- Raise_Current_Excep --
+ -- Complete_Occurrence --
-------------------------
- procedure Raise_Current_Excep (E : Exception_Id) is
+ procedure Complete_Occurrence (X : EOA) is
begin
- Debug_Raise_Exception (E => SSL.Exception_Data_Ptr (E));
- Exception_Propagation.Propagate_Exception;
- end Raise_Current_Excep;
+ -- 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 (X);
+
+ -- Notify the debugger
+ Debug_Raise_Exception (E => SSL.Exception_Data_Ptr (X.Id));
+ end Complete_Occurrence;
+
+ ---------------------------------------
+ -- Complete_And_Propagate_Occurrence --
+ ---------------------------------------
+
+ procedure Complete_And_Propagate_Occurrence (X : EOA) is
+ begin
+ Complete_Occurrence (X);
+ Exception_Propagation.Propagate_Exception (X);
+ end Complete_And_Propagate_Occurrence;
+
---------------------
-- Raise_Exception --
---------------------
@@ -905,6 +953,7 @@
Message : String := "")
is
EF : Exception_Id := E;
+ X : constant EOA := Exception_Propagation.Allocate_Occurrence;
begin
-- Raise CE if E = Null_ID (AI-446)
@@ -915,13 +964,14 @@
-- Go ahead and raise appropriate exception
- Exception_Data.Set_Exception_Msg (EF, Message);
+ Exception_Data.Set_Exception_Msg (X, EF, Message);
if not ZCX_By_Default then
Abort_Defer.all;
end if;
- Raise_Current_Excep (EF);
+ Complete_Occurrence (X);
+ Exception_Propagation.Propagate_Exception (X);
end Raise_Exception;
----------------------------
@@ -932,12 +982,13 @@
(E : Exception_Id;
Message : String := "")
is
+ X : constant EOA := Exception_Propagation.Allocate_Occurrence;
begin
- Exception_Data.Set_Exception_Msg (E, Message);
+ Exception_Data.Set_Exception_Msg (X, E, Message);
if not ZCX_By_Default then
Abort_Defer.all;
end if;
- Raise_Current_Excep (E);
+ Complete_And_Propagate_Occurrence (X);
end Raise_Exception_Always;
------------------------------
@@ -948,12 +999,13 @@
(E : Exception_Id;
Message : String := "")
is
+ X : constant EOA := Exception_Propagation.Allocate_Occurrence;
begin
- Exception_Data.Set_Exception_Msg (E, Message);
+ Exception_Data.Set_Exception_Msg (X, E, Message);
-- Do not call Abort_Defer.all, as specified by the spec
- Raise_Current_Excep (E);
+ Complete_And_Propagate_Occurrence (X);
end Raise_Exception_No_Defer;
-------------------------------------
@@ -1001,22 +1053,51 @@
end if;
end Raise_From_Controlled_Operation;
- -------------------------------
- -- Raise_From_Signal_Handler --
- -------------------------------
+ -------------------------------------------
+ -- Create_Occurrence_From_Signal_Handler --
+ -------------------------------------------
- procedure Raise_From_Signal_Handler
+ function Create_Occurrence_From_Signal_Handler
(E : Exception_Id;
M : System.Address)
+ return EOA
is
+ X : constant EOA := Exception_Propagation.Allocate_Occurrence;
begin
- Exception_Data.Set_Exception_C_Msg (E, M);
+ Exception_Data.Set_Exception_C_Msg (X, E, M);
if not ZCX_By_Default then
Abort_Defer.all;
end if;
- Raise_Current_Excep (E);
+ Complete_Occurrence (X);
+ return X;
+ end Create_Occurrence_From_Signal_Handler;
+
+ ---------------------------------------------------
+ -- Create_Machine_Occurrence_From_Signal_Handler --
+ ---------------------------------------------------
+
+ function Create_Machine_Occurrence_From_Signal_Handler
+ (E : Exception_Id;
+ M : System.Address)
+ return System.Address
+ is
+ begin
+ return Create_Occurrence_From_Signal_Handler (E, M).Machine_Occurrence;
+ end Create_Machine_Occurrence_From_Signal_Handler;
+
+ -------------------------------
+ -- Raise_From_Signal_Handler --
+ -------------------------------
+
+ procedure Raise_From_Signal_Handler
+ (E : Exception_Id;
+ M : System.Address)
+ is
+ begin
+ Exception_Propagation.Propagate_Exception
+ (Create_Occurrence_From_Signal_Handler (E, M));
end Raise_From_Signal_Handler;
-------------------------
@@ -1082,14 +1163,15 @@
C : Integer := 0;
M : System.Address := System.Null_Address)
is
+ X : constant EOA := Exception_Propagation.Allocate_Occurrence;
begin
- Exception_Data.Set_Exception_C_Msg (E, F, L, C, M);
+ Exception_Data.Set_Exception_C_Msg (X, E, F, L, C, M);
if not ZCX_By_Default then
Abort_Defer.all;
end if;
- Raise_Current_Excep (E);
+ Complete_And_Propagate_Occurrence (X);
end Raise_With_Location_And_Msg;
--------------------
@@ -1097,14 +1179,20 @@
--------------------
procedure Raise_With_Msg (E : Exception_Id) is
- Excep : constant EOA := Get_Current_Excep.all;
-
+ Excep : constant EOA := Exception_Propagation.Allocate_Occurrence;
+ Ex : constant Exception_Occurrence_Access := Get_Current_Excep.all;
begin
Excep.Exception_Raised := False;
Excep.Id := E;
Excep.Num_Tracebacks := 0;
Excep.Pid := Local_Partition_ID;
+ -- Copy the message from the current exception
+ -- Change the interface to be called with an occurrence ???
+
+ Excep.Msg_Length := Ex.Msg_Length;
+ Excep.Msg (1 .. Excep.Msg_Length) := Ex.Msg (1 .. Ex.Msg_Length);
+
-- The following is a common pattern, should be abstracted
-- into a procedure call ???
@@ -1112,7 +1200,7 @@
Abort_Defer.all;
end if;
- Raise_Current_Excep (E);
+ Complete_And_Propagate_Occurrence (Excep);
end Raise_With_Msg;
--------------------------------------
@@ -1400,7 +1488,7 @@
procedure Rcheck_PE_Finalize_Raised_Exception
(File : System.Address; Line : Integer)
is
- E : constant Exception_Id := Program_Error_Def'Access;
+ X : constant EOA := Exception_Propagation.Allocate_Occurrence;
begin
-- This is "finalize/adjust raised exception". This subprogram is always
@@ -1409,8 +1497,9 @@
-- This is consistent with Raise_From_Controlled_Operation
- Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address);
- Raise_Current_Excep (E);
+ Exception_Data.Set_Exception_C_Msg
+ (X, Program_Error_Def'Access, File, Line, 0, Rmsg_22'Address);
+ Complete_And_Propagate_Occurrence (X);
end Rcheck_PE_Finalize_Raised_Exception;
-------------
@@ -1418,12 +1507,15 @@
-------------
procedure Reraise is
- Excep : constant EOA := Get_Current_Excep.all;
+ Excep : constant EOA := Exception_Propagation.Allocate_Occurrence;
+ Saved_MO : constant System.Address := Excep.Machine_Occurrence;
begin
if not ZCX_By_Default then
Abort_Defer.all;
end if;
- Raise_Current_Excep (Excep.Id);
+ Save_Occurrence (Excep.all, Get_Current_Excep.all.all);
+ Excep.Machine_Occurrence := Saved_MO;
+ Complete_And_Propagate_Occurrence (Excep);
end Reraise;
--------------------------------------
@@ -1451,14 +1543,11 @@
procedure Reraise_Occurrence (X : Exception_Occurrence) is
begin
- if X.Id /= null then
- if not ZCX_By_Default then
- Abort_Defer.all;
- end if;
+ if X.Id = null then
+ return;
+ end if;
- Save_Occurrence (Get_Current_Excep.all.all, X);
- Raise_Current_Excep (X.Id);
- end if;
+ Reraise_Occurrence_Always (X);
end Reraise_Occurrence;
-------------------------------
@@ -1471,8 +1560,7 @@
Abort_Defer.all;
end if;
- Save_Occurrence (Get_Current_Excep.all.all, X);
- Raise_Current_Excep (X.Id);
+ Reraise_Occurrence_No_Defer (X);
end Reraise_Occurrence_Always;
---------------------------------
@@ -1480,9 +1568,12 @@
---------------------------------
procedure Reraise_Occurrence_No_Defer (X : Exception_Occurrence) is
+ Excep : constant EOA := Exception_Propagation.Allocate_Occurrence;
+ Saved_MO : constant System.Address := Excep.Machine_Occurrence;
begin
- Save_Occurrence (Get_Current_Excep.all.all, X);
- Raise_Current_Excep (X.Id);
+ Save_Occurrence (Excep.all, X);
+ Excep.Machine_Occurrence := Saved_MO;
+ Complete_And_Propagate_Occurrence (Excep);
end Reraise_Occurrence_No_Defer;
---------------------
@@ -1494,11 +1585,15 @@
Source : Exception_Occurrence)
is
begin
- Target.Id := Source.Id;
- Target.Msg_Length := Source.Msg_Length;
- Target.Num_Tracebacks := Source.Num_Tracebacks;
- Target.Pid := Source.Pid;
+ -- As the machine occurrence might be a data that must be finalized
+ -- (outside any Ada mechanism), do not copy it
+ Target.Id := Source.Id;
+ Target.Machine_Occurrence := System.Null_Address;
+ Target.Msg_Length := Source.Msg_Length;
+ Target.Num_Tracebacks := Source.Num_Tracebacks;
+ Target.Pid := Source.Pid;
+
Target.Msg (1 .. Target.Msg_Length) :=
Source.Msg (1 .. Target.Msg_Length);
Index: a-except-2005.ads
===================================================================
--- a-except-2005.ads (revision 189526)
+++ a-except-2005.ads (working copy)
@@ -302,6 +302,10 @@
Id : Exception_Id;
-- Exception_Identity for this exception occurrence
+ Machine_Occurrence : System.Address;
+ -- The underlying machine occurrence. For GCC, this corresponds to the
+ -- _Unwind_Exception structure address.
+
Msg_Length : Natural := 0;
-- Length of message (zero = no message)
@@ -339,12 +343,13 @@
-- Functions for implementing Exception_Occurrence stream attributes
Null_Occurrence : constant Exception_Occurrence := (
- Id => null,
- Msg_Length => 0,
- Msg => (others => ' '),
- Exception_Raised => False,
- Pid => 0,
- Num_Tracebacks => 0,
- Tracebacks => (others => TBE.Null_TB_Entry));
+ Id => null,
+ Machine_Occurrence => System.Null_Address,
+ Msg_Length => 0,
+ Msg => (others => ' '),
+ Exception_Raised => False,
+ Pid => 0,
+ Num_Tracebacks => 0,
+ Tracebacks => (others => TBE.Null_TB_Entry));
end Ada.Exceptions;
Index: a-exexda.adb
===================================================================
--- a-exexda.adb (revision 189524)
+++ a-exexda.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
@@ -558,13 +558,13 @@
-------------------------
procedure Set_Exception_C_Msg
- (Id : Exception_Id;
+ (Excep : EOA;
+ Id : Exception_Id;
Msg1 : System.Address;
Line : Integer := 0;
Column : Integer := 0;
Msg2 : System.Address := System.Null_Address)
is
- Excep : constant EOA := Get_Current_Excep.all;
Remind : Integer;
Ptr : Natural;
@@ -654,13 +654,13 @@
-----------------------
procedure Set_Exception_Msg
- (Id : Exception_Id;
+ (Excep : EOA;
+ Id : Exception_Id;
Message : String)
is
Len : constant Natural :=
Natural'Min (Message'Length, Exception_Msg_Max_Length);
First : constant Integer := Message'First;
- Excep : constant EOA := Get_Current_Excep.all;
begin
Excep.Exception_Raised := False;
Excep.Msg_Length := Len;
