[multiple changes]

2009-07-27  Robert Dewar  <dewar@adacore.com>

	* sem_util.adb, sem_util.ads (Kill_Current_Values): Reset Is_Known_Valid

2009-07-27  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Expand_Dispatching_Call): Reverse previous patch and
	add some documentation explaining why the SCIL nodes must be generated
	at that point.

2009-07-27  Olivier Hainque  <hainque@adacore.com>

	* a-except.adb: Bind to __builtin_longjmp directly.
	* a-except-2005.ads: Provide direct binding to __builtin_longjmp
	for sjlj variants.
	* a-exexpr.adb: Use it.
	* a-except-xi.adb: Likewise.
	* raise.c (_gnat_builtin_longjmp): Remove and update comments.
	* raise.h (_gnat_builtin_longjmp): Remove declaration.

From-SVN: r150119
This commit is contained in:
Arnaud Charlet 2009-07-27 15:56:38 +02:00
parent 57036dccfc
commit cff7cd9b13
7 changed files with 86 additions and 34 deletions

View File

@ -1,3 +1,23 @@
2009-07-27 Robert Dewar <dewar@adacore.com>
* sem_util.adb, sem_util.ads (Kill_Current_Values): Reset Is_Known_Valid
2009-07-27 Javier Miranda <miranda@adacore.com>
* exp_disp.adb (Expand_Dispatching_Call): Reverse previous patch and
add some documentation explaining why the SCIL nodes must be generated
at that point.
2009-07-27 Olivier Hainque <hainque@adacore.com>
* a-except.adb: Bind to __builtin_longjmp directly.
* a-except-2005.ads: Provide direct binding to __builtin_longjmp
for sjlj variants.
* a-exexpr.adb: Use it.
* a-except-xi.adb: Likewise.
* raise.c (_gnat_builtin_longjmp): Remove and update comments.
* raise.h (_gnat_builtin_longjmp): Remove declaration.
2009-07-27 Ed Schonberg <schonberg@adacore.com>
* sem_eval.adb (Compile_Time_Compare): More precise handling of

View File

@ -50,6 +50,8 @@ with System.Parameters;
with System.Standard_Library;
with System.Traceback_Entries;
with Ada.Unchecked_Conversion;
package Ada.Exceptions is
pragma Warnings (Off);
pragma Preelaborate_05;
@ -348,4 +350,18 @@ private
Tracebacks => (others => TBE.Null_TB_Entry),
Private_Data => System.Null_Address);
-- Common binding to __builtin_longjmp for sjlj variants.
-- The builtin expects a pointer type for the jmpbuf address argument, and
-- System.Address doesn't work because this is really an integer type.
type Jmpbuf_Address is access Character;
function To_Jmpbuf_Address is new
Ada.Unchecked_Conversion (System.Address, Jmpbuf_Address);
procedure builtin_longjmp (buffer : Jmpbuf_Address; Flag : Integer);
pragma No_Return (builtin_longjmp);
pragma Import (Intrinsic, builtin_longjmp, "__builtin_longjmp");
end Ada.Exceptions;

View File

@ -41,10 +41,6 @@ pragma Warnings (Off);
separate (Ada.Exceptions)
package body Exception_Propagation is
procedure builtin_longjmp (buffer : Address; Flag : Integer);
pragma No_Return (builtin_longjmp);
pragma Import (C, builtin_longjmp, "_gnat_builtin_longjmp");
---------------------
-- Setup_Exception --
---------------------
@ -114,7 +110,7 @@ package body Exception_Propagation is
Exception_Traces.Notify_Handled_Exception;
end if;
builtin_longjmp (Jumpbuf_Ptr, 1);
builtin_longjmp (To_Jmpbuf_Address (Jumpbuf_Ptr), 1);
else
Exception_Traces.Notify_Unhandled_Exception;

View File

@ -643,6 +643,20 @@ package body Exp_Disp is
Typ := Non_Limited_View (Typ);
end if;
-- Generate the SCIL node for this dispatching call. The SCIL node for a
-- dispatching call is inserted in the tree before the call is rewriten
-- and expanded because the SCIL node must be found by the SCIL backend
-- BEFORE the expanded nodes associated with the call node are found.
if Generate_SCIL then
Insert_Action (Call_Node,
New_SCIL_Node
(SN_Kind => Dispatching_Call,
Related_Node => Call_Node,
Entity => Typ,
Target_Prim => Subp));
end if;
if not Is_Limited_Type (Typ) then
Eq_Prim_Op := Find_Prim_Op (Typ, Name_Op_Eq);
end if;
@ -866,17 +880,6 @@ package body Exp_Disp is
-- to avoid the generation of spurious warnings under ZFP run-time.
Analyze_And_Resolve (Call_Node, Call_Typ, Suppress => All_Checks);
-- Generate the SCIL node for this dispatching call
if Generate_SCIL then
Insert_Action (Call_Node,
New_SCIL_Node
(SN_Kind => Dispatching_Call,
Related_Node => Call_Node,
Entity => Typ,
Target_Prim => Subp));
end if;
end Expand_Dispatching_Call;
---------------------------------

View File

@ -29,11 +29,8 @@
* *
****************************************************************************/
/* Shared routines to support exception handling.
Note that _gnat_builtin_longjmp should disappear at some point, replaced
by direct call to __builtin_longjmp from Ada code.
__gnat_unhandled_terminate is code shared between all exception handling
mechanisms */
/* Shared routines to support exception handling. __gnat_unhandled_terminate
is shared between all exception handling mechanisms. */
#ifdef IN_RTS
#include "tconfig.h"
@ -46,13 +43,19 @@
#include "adaint.h"
#include "raise.h"
/* We have not yet figured out how to import this directly */
/* Wrapper to builtin_longjmp. This is for the compiler eh only, as the sjlj
runtime library interfaces directly to the intrinsic. We can't yet do
this for the compiler itself, because this capability relies on changes
made in april 2008 and we need to preserve the possibility to bootstrap
with an older base version. */
#if defined (IN_GCC) && !defined (IN_RTS)
void
_gnat_builtin_longjmp (void *ptr, int flag ATTRIBUTE_UNUSED)
{
__builtin_longjmp (ptr, 1);
}
#endif
/* When an exception is raised for which no handler exists, the procedure
Ada.Exceptions.Unhandled_Exception is called, which performs the call to

View File

@ -7142,19 +7142,33 @@ package body Sem_Util is
Last_Assignment_Only : Boolean := False)
is
begin
-- ??? do we have to worry about clearing cached checks?
if Is_Assignable (Ent) then
Set_Last_Assignment (Ent, Empty);
end if;
if not Last_Assignment_Only and then Is_Object (Ent) then
Kill_Checks (Ent);
Set_Current_Value (Ent, Empty);
if Is_Object (Ent) then
if not Last_Assignment_Only then
Kill_Checks (Ent);
Set_Current_Value (Ent, Empty);
if not Can_Never_Be_Null (Ent) then
Set_Is_Known_Non_Null (Ent, False);
if not Can_Never_Be_Null (Ent) then
Set_Is_Known_Non_Null (Ent, False);
end if;
Set_Is_Known_Null (Ent, False);
-- Reset Is_Known_Valid unless type is always valid, or if we have
-- a loop parameter (loop parameters are always valid, since their
-- bounds are defined by the bounds given in the loop header).
if not Is_Known_Valid (Etype (Ent))
and then Ekind (Ent) /= E_Loop_Parameter
then
Set_Is_Known_Valid (Ent, False);
end if;
end if;
Set_Is_Known_Null (Ent, False);
end if;
end Kill_Current_Values;

View File

@ -820,9 +820,9 @@ package Sem_Util is
-- clear the Is_True_Constant flag, since that only gets reset if there
-- really is an assignment somewhere in the entity scope). This procedure
-- also calls Kill_All_Checks, since this is a special case of needing to
-- forget saved values. This procedure also clears Is_Known_Non_Null flags
-- in variables, constants or parameters since these are also not known to
-- be valid.
-- forget saved values. This procedure also clears the Is_Known_Null and
-- Is_Known_Non_Null and Is_Known_Valid flags in variables, constants or
-- parameters since these are also not known to be trustable any more.
--
-- The Last_Assignment_Only flag is set True to clear only Last_Assignment
-- fields and leave other fields unchanged. This is used when we encounter
@ -839,8 +839,8 @@ package Sem_Util is
Last_Assignment_Only : Boolean := False);
-- This performs the same processing as described above for the form with
-- no argument, but for the specific entity given. The call has no effect
-- if the entity Ent is not for an object. Again, Last_Assignment_Only is
-- set if you want to clear only the Last_Assignment field (see above).
-- if the entity Ent is not for an object. Last_Assignment_Only has the
-- same meaning as for the call with no Ent.
procedure Kill_Size_Check_Code (E : Entity_Id);
-- Called when an address clause or pragma Import is applied to an entity.