[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:
parent
57036dccfc
commit
cff7cd9b13
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
||||
---------------------------------
|
||||
|
@ -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
|
||||
|
@ -7142,11 +7142,14 @@ 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
|
||||
if Is_Object (Ent) then
|
||||
if not Last_Assignment_Only then
|
||||
Kill_Checks (Ent);
|
||||
Set_Current_Value (Ent, Empty);
|
||||
|
||||
@ -7155,6 +7158,17 @@ package body Sem_Util is
|
||||
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;
|
||||
end if;
|
||||
end Kill_Current_Values;
|
||||
|
||||
|
@ -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.
|
||||
|
Loading…
Reference in New Issue
Block a user