Commit 5df1266a by Arnaud Charlet

[multiple changes]

2012-07-16  Thomas Quinot  <quinot@adacore.com>

	* freeze.adb (Check_Component_Storage_Order): Do not reject a
	nested composite with different scalar storage order if it is
	byte aligned.

2012-07-16  Thomas Quinot  <quinot@adacore.com>

	* gnat_rm.texi: Update documentation for Scalar_Storage_Order.

2012-07-16  Tristan Gingold  <gingold@adacore.com>

	* a-exexpr.adb (Propagate_Exception): Adjust call to
	Exception_Traces procedures.
	* a-exexpr-gcc.adb (Setup_Current_Excep): Now a
	function that returns an access to the Ada occurrence.
	(Propagate_GCC_Exception): Adjust calls.
	* raise.h (struct Exception_Occurrence): Declare.
	* a-exextr.adb: Remove useless pragma.	(Notify_Handled_Exception,
	Notify_Unhandled_Exception) (Unhandled_Exception_Terminate):
	Add Excep parameter.
	* a-except.adb (Notify_Handled_Exception,
	Notify_Unhandled_Exception) (Unhandled_Exception_Terminate):
	Add Excep parameter.
	(Process_Raise_Exception): Adjust calls.
	* a-except-2005.adb (Notify_Handled_Exception,
	Notify_Unhandled_Exception) (Unhandled_Exception_Terminate): Add
	Excep parameter.
	(Raise_Exception): Calls Raise_Exception_Always.
	* raise-gcc.c (__gnat_setup_current_excep,
	__gnat_notify_handled_exception)
	(__gnat_notify_unhandled_exception): Adjust declarations.
	(PERSONALITY_FUNCTION): Adjust calls.
	(__gnat_personality_seh0): Remove warning.

2012-07-16  Javier Miranda  <miranda@adacore.com>

	* sem_eval.adb (Test_Expression_Is_Foldable): Adding documentation.
	(Eval_Relational_Op): Adding documentation.

From-SVN: r189532
parent e187fa72
2012-07-16 Thomas Quinot <quinot@adacore.com>
* freeze.adb (Check_Component_Storage_Order): Do not reject a
nested composite with different scalar storage order if it is
byte aligned.
2012-07-16 Thomas Quinot <quinot@adacore.com>
* gnat_rm.texi: Update documentation for Scalar_Storage_Order.
2012-07-16 Tristan Gingold <gingold@adacore.com>
* a-exexpr.adb (Propagate_Exception): Adjust call to
Exception_Traces procedures.
* a-exexpr-gcc.adb (Setup_Current_Excep): Now a
function that returns an access to the Ada occurrence.
(Propagate_GCC_Exception): Adjust calls.
* raise.h (struct Exception_Occurrence): Declare.
* a-exextr.adb: Remove useless pragma. (Notify_Handled_Exception,
Notify_Unhandled_Exception) (Unhandled_Exception_Terminate):
Add Excep parameter.
* a-except.adb (Notify_Handled_Exception,
Notify_Unhandled_Exception) (Unhandled_Exception_Terminate):
Add Excep parameter.
(Process_Raise_Exception): Adjust calls.
* a-except-2005.adb (Notify_Handled_Exception,
Notify_Unhandled_Exception) (Unhandled_Exception_Terminate): Add
Excep parameter.
(Raise_Exception): Calls Raise_Exception_Always.
* raise-gcc.c (__gnat_setup_current_excep,
__gnat_notify_handled_exception)
(__gnat_notify_unhandled_exception): Adjust declarations.
(PERSONALITY_FUNCTION): Adjust calls.
(__gnat_personality_seh0): Remove warning.
2012-07-16 Javier Miranda <miranda@adacore.com>
* sem_eval.adb (Test_Expression_Is_Foldable): Adding documentation.
(Eval_Relational_Op): Adding documentation.
2012-07-16 Robert Dewar <dewar@adacore.com> 2012-07-16 Robert Dewar <dewar@adacore.com>
* freeze.adb, g-debpoo.adb, exp_ch3.adb: Minor reformatting. * freeze.adb, g-debpoo.adb, exp_ch3.adb: Minor reformatting.
......
...@@ -209,19 +209,19 @@ package body Ada.Exceptions is ...@@ -209,19 +209,19 @@ package body Ada.Exceptions is
-- exported to be usable by the Ada exception handling personality -- exported to be usable by the Ada exception handling personality
-- routine when the GCC 3 mechanism is used. -- routine when the GCC 3 mechanism is used.
procedure Notify_Handled_Exception; procedure Notify_Handled_Exception (Excep : EOA);
pragma Export pragma Export
(C, Notify_Handled_Exception, "__gnat_notify_handled_exception"); (C, Notify_Handled_Exception, "__gnat_notify_handled_exception");
-- This routine is called for a handled occurrence is about to be -- This routine is called for a handled occurrence is about to be
-- propagated. -- propagated.
procedure Notify_Unhandled_Exception; procedure Notify_Unhandled_Exception (Excep : EOA);
pragma Export pragma Export
(C, Notify_Unhandled_Exception, "__gnat_notify_unhandled_exception"); (C, Notify_Unhandled_Exception, "__gnat_notify_unhandled_exception");
-- This routine is called when an unhandled occurrence is about to be -- This routine is called when an unhandled occurrence is about to be
-- propagated. -- propagated.
procedure Unhandled_Exception_Terminate; procedure Unhandled_Exception_Terminate (Excep : EOA);
pragma No_Return (Unhandled_Exception_Terminate); pragma No_Return (Unhandled_Exception_Terminate);
-- This procedure is called to terminate execution following an -- This procedure is called to terminate execution following an
-- unhandled exception. The exception information, including -- unhandled exception. The exception information, including
...@@ -395,15 +395,16 @@ package body Ada.Exceptions is ...@@ -395,15 +395,16 @@ package body Ada.Exceptions is
-- Reraises the exception referenced by the Current_Excep field of -- Reraises the exception referenced by the Current_Excep field of
-- the TSD (all fields of this exception occurrence are set). Abort -- the TSD (all fields of this exception occurrence are set). Abort
-- is deferred before the reraise operation. -- is deferred before the reraise operation.
-- Called from System.Tasking.RendezVous.Exceptional_Complete_RendezVous
procedure Transfer_Occurrence procedure Transfer_Occurrence
(Target : Exception_Occurrence_Access; (Target : Exception_Occurrence_Access;
Source : Exception_Occurrence); Source : Exception_Occurrence);
pragma Export (C, Transfer_Occurrence, "__gnat_transfer_occurrence"); pragma Export (C, Transfer_Occurrence, "__gnat_transfer_occurrence");
-- Called from System.Tasking.RendezVous.Exceptional_Complete_RendezVous -- Called from s-tasren.adb:Local_Complete_RendezVous and
-- to setup Target from Source as an exception to be propagated in the -- s-tpobop.adb:Exceptional_Complete_Entry_Body to setup Target from
-- caller task. Target is expected to be a pointer to the fixed TSD -- Source as an exception to be propagated in the caller task. Target is
-- occurrence for this task. -- expected to be a pointer to the fixed TSD occurrence for this task.
----------------------------- -----------------------------
-- Run-Time Check Routines -- -- Run-Time Check Routines --
...@@ -953,8 +954,6 @@ package body Ada.Exceptions is ...@@ -953,8 +954,6 @@ package body Ada.Exceptions is
Message : String := "") Message : String := "")
is is
EF : Exception_Id := E; EF : Exception_Id := E;
X : constant EOA := Exception_Propagation.Allocate_Occurrence;
begin begin
-- Raise CE if E = Null_ID (AI-446) -- Raise CE if E = Null_ID (AI-446)
...@@ -964,14 +963,7 @@ package body Ada.Exceptions is ...@@ -964,14 +963,7 @@ package body Ada.Exceptions is
-- Go ahead and raise appropriate exception -- Go ahead and raise appropriate exception
Exception_Data.Set_Exception_Msg (X, EF, Message); Raise_Exception_Always (EF, Message);
if not ZCX_By_Default then
Abort_Defer.all;
end if;
Complete_Occurrence (X);
Exception_Propagation.Propagate_Exception (X);
end Raise_Exception; end Raise_Exception;
---------------------------- ----------------------------
......
...@@ -189,19 +189,19 @@ package body Ada.Exceptions is ...@@ -189,19 +189,19 @@ package body Ada.Exceptions is
-- exported to be usable by the Ada exception handling personality -- exported to be usable by the Ada exception handling personality
-- routine when the GCC 3 mechanism is used. -- routine when the GCC 3 mechanism is used.
procedure Notify_Handled_Exception; procedure Notify_Handled_Exception (Excep : EOA);
pragma Export pragma Export
(C, Notify_Handled_Exception, "__gnat_notify_handled_exception"); (C, Notify_Handled_Exception, "__gnat_notify_handled_exception");
-- This routine is called for a handled occurrence is about to be -- This routine is called for a handled occurrence is about to be
-- propagated. -- propagated.
procedure Notify_Unhandled_Exception; procedure Notify_Unhandled_Exception (Excep : EOA);
pragma Export pragma Export
(C, Notify_Unhandled_Exception, "__gnat_notify_unhandled_exception"); (C, Notify_Unhandled_Exception, "__gnat_notify_unhandled_exception");
-- This routine is called when an unhandled occurrence is about to be -- This routine is called when an unhandled occurrence is about to be
-- propagated. -- propagated.
procedure Unhandled_Exception_Terminate; procedure Unhandled_Exception_Terminate (Excep : EOA);
pragma No_Return (Unhandled_Exception_Terminate); pragma No_Return (Unhandled_Exception_Terminate);
-- This procedure is called to terminate program execution following an -- This procedure is called to terminate program execution following an
-- unhandled exception. The exception information, including traceback -- unhandled exception. The exception information, including traceback
...@@ -895,14 +895,14 @@ package body Ada.Exceptions is ...@@ -895,14 +895,14 @@ package body Ada.Exceptions is
if Jumpbuf_Ptr /= Null_Address then if Jumpbuf_Ptr /= Null_Address then
if not Excep.Exception_Raised then if not Excep.Exception_Raised then
Excep.Exception_Raised := True; Excep.Exception_Raised := True;
Exception_Traces.Notify_Handled_Exception; Exception_Traces.Notify_Handled_Exception (Excep);
end if; end if;
builtin_longjmp (Jumpbuf_Ptr, 1); builtin_longjmp (Jumpbuf_Ptr, 1);
else else
Exception_Traces.Notify_Unhandled_Exception; Exception_Traces.Notify_Unhandled_Exception (Excep);
Exception_Traces.Unhandled_Exception_Terminate; Exception_Traces.Unhandled_Exception_Terminate (Excep);
end if; end if;
end Process_Raise_Exception; end Process_Raise_Exception;
......
...@@ -202,8 +202,9 @@ package body Exception_Propagation is ...@@ -202,8 +202,9 @@ package body Exception_Propagation is
-- Called to implement raise without exception, ie reraise. Called -- Called to implement raise without exception, ie reraise. Called
-- directly from gigi. -- directly from gigi.
procedure Setup_Current_Excep function Setup_Current_Excep
(GCC_Exception : not null GCC_Exception_Access); (GCC_Exception : not null GCC_Exception_Access)
return EOA;
pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep"); pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep");
-- Write Get_Current_Excep.all from GCC_Exception -- Write Get_Current_Excep.all from GCC_Exception
...@@ -342,8 +343,9 @@ package body Exception_Propagation is ...@@ -342,8 +343,9 @@ package body Exception_Propagation is
-- Setup_Current_Excep -- -- Setup_Current_Excep --
------------------------- -------------------------
procedure Setup_Current_Excep function Setup_Current_Excep
(GCC_Exception : not null GCC_Exception_Access) (GCC_Exception : not null GCC_Exception_Access)
return EOA
is is
Excep : constant EOA := Get_Current_Excep.all; Excep : constant EOA := Get_Current_Excep.all;
...@@ -359,6 +361,8 @@ package body Exception_Propagation is ...@@ -359,6 +361,8 @@ package body Exception_Propagation is
To_GNAT_GCC_Exception (GCC_Exception); To_GNAT_GCC_Exception (GCC_Exception);
begin begin
Excep.all := GNAT_Occurrence.Occurrence; Excep.all := GNAT_Occurrence.Occurrence;
return GNAT_Occurrence.Occurrence'Access;
end; end;
else else
...@@ -370,6 +374,8 @@ package body Exception_Propagation is ...@@ -370,6 +374,8 @@ package body Exception_Propagation is
Excep.Exception_Raised := True; Excep.Exception_Raised := True;
Excep.Pid := Local_Partition_ID; Excep.Pid := Local_Partition_ID;
Excep.Num_Tracebacks := 0; Excep.Num_Tracebacks := 0;
return Excep;
end if; end if;
end Setup_Current_Excep; end Setup_Current_Excep;
...@@ -420,6 +426,7 @@ package body Exception_Propagation is ...@@ -420,6 +426,7 @@ package body Exception_Propagation is
procedure Propagate_GCC_Exception procedure Propagate_GCC_Exception
(GCC_Exception : not null GCC_Exception_Access) (GCC_Exception : not null GCC_Exception_Access)
is is
Excep : EOA;
begin begin
-- Perform a standard raise first. If a regular handler is found, it -- Perform a standard raise first. If a regular handler is found, it
-- will be entered after all the intermediate cleanups have run. If -- will be entered after all the intermediate cleanups have run. If
...@@ -432,8 +439,8 @@ package body Exception_Propagation is ...@@ -432,8 +439,8 @@ package body Exception_Propagation is
-- the necessary steps to enable the debugger to gain control while the -- the necessary steps to enable the debugger to gain control while the
-- stack is still intact. -- stack is still intact.
Setup_Current_Excep (GCC_Exception); Excep := Setup_Current_Excep (GCC_Exception);
Notify_Unhandled_Exception; Notify_Unhandled_Exception (Excep);
-- Now, un a forced unwind to trigger cleanups. Control should not -- Now, un a forced unwind to trigger cleanups. Control should not
-- resume there, if there are cleanups and in any cases as the -- resume there, if there are cleanups and in any cases as the
...@@ -466,9 +473,10 @@ package body Exception_Propagation is ...@@ -466,9 +473,10 @@ package body Exception_Propagation is
procedure Unhandled_Except_Handler procedure Unhandled_Except_Handler
(GCC_Exception : not null GCC_Exception_Access) (GCC_Exception : not null GCC_Exception_Access)
is is
Excep : EOA;
begin begin
Setup_Current_Excep (GCC_Exception); Excep := Setup_Current_Excep (GCC_Exception);
Unhandled_Exception_Terminate; Unhandled_Exception_Terminate (Excep);
end Unhandled_Except_Handler; end Unhandled_Except_Handler;
------------- -------------
......
...@@ -43,7 +43,7 @@ package body Exception_Propagation is ...@@ -43,7 +43,7 @@ package body Exception_Propagation is
pragma No_Return (builtin_longjmp); pragma No_Return (builtin_longjmp);
pragma Import (Intrinsic, builtin_longjmp, "__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 No_Return (Propagate_Continue);
pragma Export (C, Propagate_Continue, "__gnat_raise_nodefer_with_msg"); pragma Export (C, Propagate_Continue, "__gnat_raise_nodefer_with_msg");
-- A call to this procedure is inserted automatically by GIGI, in order -- A call to this procedure is inserted automatically by GIGI, in order
...@@ -74,14 +74,14 @@ package body Exception_Propagation is ...@@ -74,14 +74,14 @@ package body Exception_Propagation is
if Jumpbuf_Ptr /= Null_Address then if Jumpbuf_Ptr /= Null_Address then
if not Excep.Exception_Raised then if not Excep.Exception_Raised then
Excep.Exception_Raised := True; Excep.Exception_Raised := True;
Exception_Traces.Notify_Handled_Exception; Exception_Traces.Notify_Handled_Exception (Excep);
end if; end if;
builtin_longjmp (Jumpbuf_Ptr, 1); builtin_longjmp (Jumpbuf_Ptr, 1);
else else
Exception_Traces.Notify_Unhandled_Exception; Exception_Traces.Notify_Unhandled_Exception (Excep);
Exception_Traces.Unhandled_Exception_Terminate; Exception_Traces.Unhandled_Exception_Terminate (Excep);
end if; end if;
end Propagate_Exception; end Propagate_Exception;
...@@ -89,9 +89,10 @@ package body Exception_Propagation is ...@@ -89,9 +89,10 @@ package body Exception_Propagation is
-- Propagate_Continue -- -- Propagate_Continue --
------------------------ ------------------------
procedure Propagate_Continue (Excep : EOA) is procedure Propagate_Continue (E : Exception_Id) is
pragma Unreferenced (E);
begin begin
Propagate_Exception (Excep); Propagate_Exception (Get_Current_Excep.all);
end Propagate_Continue; end Propagate_Continue;
end Exception_Propagation; end Exception_Propagation;
...@@ -72,17 +72,6 @@ package body Exception_Traces is ...@@ -72,17 +72,6 @@ package body Exception_Traces is
-- latter case because Notify_Handled_Exception may be called for an -- latter case because Notify_Handled_Exception may be called for an
-- actually unhandled occurrence in the Front-End-SJLJ case. -- 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 -- -- Notify_Exception --
---------------------- ----------------------
...@@ -132,18 +121,16 @@ package body Exception_Traces is ...@@ -132,18 +121,16 @@ package body Exception_Traces is
-- Notify_Handled_Exception -- -- Notify_Handled_Exception --
------------------------------ ------------------------------
procedure Notify_Handled_Exception is procedure Notify_Handled_Exception (Excep : EOA) is
begin begin
Notify_Exception (Get_Current_Excep.all, Is_Unhandled => False); Notify_Exception (Excep, Is_Unhandled => False);
end Notify_Handled_Exception; end Notify_Handled_Exception;
-------------------------------- --------------------------------
-- Notify_Unhandled_Exception -- -- Notify_Unhandled_Exception --
-------------------------------- --------------------------------
procedure Notify_Unhandled_Exception is procedure Notify_Unhandled_Exception (Excep : EOA) is
Excep : constant EOA := Get_Current_Excep.all;
begin begin
-- Check whether there is any termination handler to be executed for -- Check whether there is any termination handler to be executed for
-- the environment task, and execute it if needed. Here we handle both -- the environment task, and execute it if needed. Here we handle both
...@@ -161,8 +148,8 @@ package body Exception_Traces is ...@@ -161,8 +148,8 @@ package body Exception_Traces is
-- Unhandled_Exception_Terminate -- -- Unhandled_Exception_Terminate --
----------------------------------- -----------------------------------
procedure Unhandled_Exception_Terminate is procedure Unhandled_Exception_Terminate (Excep : EOA) is
Excep : Exception_Occurrence; Occ : Exception_Occurrence;
-- This occurrence will be used to display a message after finalization. -- This occurrence will be used to display a message after finalization.
-- It is necessary to save a copy here, or else the designated value -- It is necessary to save a copy here, or else the designated value
-- could be overwritten if an exception is raised during finalization -- could be overwritten if an exception is raised during finalization
...@@ -172,8 +159,8 @@ package body Exception_Traces is ...@@ -172,8 +159,8 @@ package body Exception_Traces is
-- that there is enough room on the stack however. -- that there is enough room on the stack however.
begin begin
Save_Occurrence (Excep, Get_Current_Excep.all.all); Save_Occurrence (Occ, Excep.all);
Last_Chance_Handler (Excep); Last_Chance_Handler (Occ);
end Unhandled_Exception_Terminate; end Unhandled_Exception_Terminate;
------------------------------------ ------------------------------------
......
...@@ -1029,6 +1029,10 @@ package body Freeze is ...@@ -1029,6 +1029,10 @@ package body Freeze is
Err_Node : Node_Id; Err_Node : Node_Id;
ADC : Node_Id; ADC : Node_Id;
Comp_Byte_Aligned : Boolean;
-- Set True for the record case, when Comp starts on a byte boundary
-- (in which case it is allowed to have different storage order).
begin begin
-- Record case -- Record case
...@@ -1037,6 +1041,9 @@ package body Freeze is ...@@ -1037,6 +1041,9 @@ package body Freeze is
Comp_Type := Etype (Comp); Comp_Type := Etype (Comp);
Comp_Def := Component_Definition (Parent (Comp)); Comp_Def := Component_Definition (Parent (Comp));
Comp_Byte_Aligned := Present (Component_Clause (Comp))
and then Normalized_First_Bit (Comp) mod System_Storage_Unit = 0;
-- Array case -- Array case
else else
...@@ -1044,6 +1051,8 @@ package body Freeze is ...@@ -1044,6 +1051,8 @@ package body Freeze is
Comp_Type := Component_Type (Encl_Type); Comp_Type := Component_Type (Encl_Type);
Comp_Def := Component_Definition Comp_Def := Component_Definition
(Type_Definition (Declaration_Node (Encl_Type))); (Type_Definition (Declaration_Node (Encl_Type)));
Comp_Byte_Aligned := False;
end if; end if;
-- Note: the Reverse_Storage_Order flag is set on the base type, but -- Note: the Reverse_Storage_Order flag is set on the base type, but
...@@ -1054,14 +1063,20 @@ package body Freeze is ...@@ -1054,14 +1063,20 @@ package body Freeze is
(First_Subtype (Comp_Type), (First_Subtype (Comp_Type),
Attribute_Scalar_Storage_Order); Attribute_Scalar_Storage_Order);
if (Is_Record_Type (Comp_Type) or else Is_Array_Type (Comp_Type)) if Is_Record_Type (Comp_Type) or else Is_Array_Type (Comp_Type) then
and then if No (ADC) then
(No (ADC) or else Reverse_Storage_Order (Encl_Type) /= Error_Msg_N ("nested composite must have explicit scalar "
Reverse_Storage_Order (Etype (Comp_Type))) & "storage order", Err_Node);
then
Error_Msg_N elsif (Reverse_Storage_Order (Encl_Type)
("component type must have same scalar storage order as " /=
& "enclosing composite", Err_Node); Reverse_Storage_Order (Etype (Comp_Type)))
and then not Comp_Byte_Aligned
then
Error_Msg_N
("type of non-byte-aligned component must have same scalar "
& "storage order as enclosing composite", Err_Node);
end if;
elsif Aliased_Present (Comp_Def) then elsif Aliased_Present (Comp_Def) then
Error_Msg_N Error_Msg_N
......
...@@ -6709,7 +6709,7 @@ this attribute. ...@@ -6709,7 +6709,7 @@ this attribute.
@cindex Scalar storage order @cindex Scalar storage order
@findex Scalar_Storage_Order @findex Scalar_Storage_Order
@noindent @noindent
For every record subtype @var{S}, the representation attribute For every array or record type @var{S}, the representation attribute
@code{Scalar_Storage_Order} denotes the order in which storage elements @code{Scalar_Storage_Order} denotes the order in which storage elements
that make up scalar components are ordered within S. Other properties are that make up scalar components are ordered within S. Other properties are
as for standard representation attribute @code{Bit_Order}, as defined by as for standard representation attribute @code{Bit_Order}, as defined by
...@@ -6721,6 +6721,11 @@ equal to @code{@var{S}'Bit_Order}. Note: This means that if a ...@@ -6721,6 +6721,11 @@ equal to @code{@var{S}'Bit_Order}. Note: This means that if a
then the type's @code{Bit_Order} shall be specified explicitly and set to then the type's @code{Bit_Order} shall be specified explicitly and set to
the same value. the same value.
If a component of S has itself a record or array type, then it shall also
have a @code{Scalar_Storage_Order} attribute definition clause. In addition,
if the component does not start on a byte boundary, then the scalar storage
order specified for S and for the nested component type shall be identical.
A confirming @code{Scalar_Storage_Order} attribute definition clause (i.e. A confirming @code{Scalar_Storage_Order} attribute definition clause (i.e.
with a value equal to @code{System.Default_Bit_Order}) has no effect. with a value equal to @code{System.Default_Bit_Order}) has no effect.
......
...@@ -77,7 +77,8 @@ __gnat_Unwind_RaiseException (_Unwind_Exception *); ...@@ -77,7 +77,8 @@ __gnat_Unwind_RaiseException (_Unwind_Exception *);
_Unwind_Reason_Code _Unwind_Reason_Code
__gnat_Unwind_ForcedUnwind (_Unwind_Exception *, void *, void *); __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 *); extern void __gnat_unhandled_except_handler (_Unwind_Exception *);
#include "dwarf2.h" #include "dwarf2.h"
...@@ -1001,8 +1002,8 @@ setup_to_install (_Unwind_Context *uw_context, ...@@ -1001,8 +1002,8 @@ setup_to_install (_Unwind_Context *uw_context,
/* The following is defined from a-except.adb. Its purpose is to enable /* The following is defined from a-except.adb. Its purpose is to enable
automatic backtraces upon exception raise, as provided through the automatic backtraces upon exception raise, as provided through the
GNAT.Traceback facilities. */ GNAT.Traceback facilities. */
extern void __gnat_notify_handled_exception (void); extern void __gnat_notify_handled_exception (struct Exception_Occurrence *);
extern void __gnat_notify_unhandled_exception (void); extern void __gnat_notify_unhandled_exception (struct Exception_Occurrence *);
/* Below is the eh personality routine per se. We currently assume that only /* Below is the eh personality routine per se. We currently assume that only
GNU-Ada exceptions are met. */ GNU-Ada exceptions are met. */
...@@ -1131,14 +1132,16 @@ PERSONALITY_FUNCTION (version_arg_t version_arg, ...@@ -1131,14 +1132,16 @@ PERSONALITY_FUNCTION (version_arg_t version_arg,
} }
else else
{ {
struct Exception_Occurrence *excep;
/* Trigger the appropriate notification routines before the second /* Trigger the appropriate notification routines before the second
phase starts, which ensures the stack is still intact. phase starts, which ensures the stack is still intact.
First, setup the Ada occurrence. */ First, setup the Ada occurrence. */
__gnat_setup_current_excep (uw_exception); excep = __gnat_setup_current_excep (uw_exception);
if (action.kind == unhandler) if (action.kind == unhandler)
__gnat_notify_unhandled_exception (); __gnat_notify_unhandled_exception (excep);
else else
__gnat_notify_handled_exception (); __gnat_notify_handled_exception (excep);
return _URC_HANDLER_FOUND; return _URC_HANDLER_FOUND;
} }
...@@ -1324,7 +1327,7 @@ __gnat_personality_seh0 (PEXCEPTION_RECORD ms_exc, void *this_frame, ...@@ -1324,7 +1327,7 @@ __gnat_personality_seh0 (PEXCEPTION_RECORD ms_exc, void *this_frame,
CONTEXT context; CONTEXT context;
PRUNTIME_FUNCTION mf_func = NULL; PRUNTIME_FUNCTION mf_func = NULL;
ULONG64 mf_imagebase; ULONG64 mf_imagebase;
ULONG64 mf_rsp; ULONG64 mf_rsp = 0;
/* Get the context. */ /* Get the context. */
RtlCaptureContext (&context); RtlCaptureContext (&context);
......
...@@ -49,6 +49,8 @@ struct Exception_Data ...@@ -49,6 +49,8 @@ struct Exception_Data
typedef struct Exception_Data *Exception_Id; typedef struct Exception_Data *Exception_Id;
struct Exception_Occurrence;
extern void _gnat_builtin_longjmp (void *, int); extern void _gnat_builtin_longjmp (void *, int);
extern void __gnat_unhandled_terminate (void); extern void __gnat_unhandled_terminate (void);
extern void *__gnat_malloc (__SIZE_TYPE__); extern void *__gnat_malloc (__SIZE_TYPE__);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment