[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

7 files changed, 86 insertions, 34 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e4efbe3..1451d48 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/a-except-2005.ads b/gcc/ada/a-except-2005.ads
index 0b248ff..5c00cf5 100644
--- a/gcc/ada/a-except-2005.ads
+++ b/gcc/ada/a-except-2005.ads
@@ -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;
diff --git a/gcc/ada/a-exexpr.adb b/gcc/ada/a-exexpr.adb
index 13b7d79..e3ae5b0 100644
--- a/gcc/ada/a-exexpr.adb
+++ b/gcc/ada/a-exexpr.adb
@@ -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;
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 010e6bf..761a113 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -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;
 
    ---------------------------------
diff --git a/gcc/ada/raise.c b/gcc/ada/raise.c
index d821323..1f08778 100644
--- a/gcc/ada/raise.c
+++ b/gcc/ada/raise.c
@@ -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
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 1786b51..caf4cc7 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -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);
-         end if;
+            if not Can_Never_Be_Null (Ent) then
+               Set_Is_Known_Non_Null (Ent, False);
+            end if;
+
+            Set_Is_Known_Null (Ent, False);
 
-         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;
 
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 81dcf1f..0e3dde6 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -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.