[patch] Enable LTO support for Ada

[Eric Botcazou <ebotcazou at adacore dot com>]

Hi,

this boils down to adding support for PLACEHOLDER_EXPR in the hash function 
and in the stream output code; the latter is necessary because size trees 
that contain a PLACEHOLDER_EXPR aren't gimplified so can contain CALL_EXPRs 
at the end of gimplification and the streamer chokes on CALL_EXPR.  That such 
size trees aren't properly restored in LTO mode doesn't matter, as long as 
they aren't restored as INTEGER_CSTs.  Hence the trick used here.

This yields 17 failures in gnat.dg at -flto, mostly "type of X does not match 
original" warnings, with 2 ICEs that are more of a gimplification problem than 
a LTO one.  This also yields 17 failures for ACATS at -O2 -flto.

Tested on i586-suse-linux, OK for mainline?


2010-05-03  Eric Botcazou  <ebotcazou@adacore.com>

	* tree.c (iterative_hash_expr) <PLACEHOLDER_EXPR>: New case.
	* lto-streamer-out.c (lto_output_ts_decl_common_tree_pointers): Deal
	with PLACEHOLDER_EXPRs in DECL_SIZE/DECL_SIZE_UNIT.
	(lto_output_ts_field_decl_tree_pointers): Ditto in DECL_FIELD_OFFSET.
	(lto_output_ts_type_tree_pointers): Ditto in TYPE_SIZE/TYPE_SIZE_UNIT.


2010-05-03  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/lto1.adb: New test.
	* gnat.dg/lto1_pkg.ad[sb]: New helper.

	
-- 
Eric Botcazou

Index: tree.c
===================================================================
--- tree.c	(revision 158852)
+++ tree.c	(working copy)
@@ -6567,11 +6567,12 @@ iterative_hash_expr (const_tree t, hashv
       return iterative_hash_expr (TREE_IMAGPART (t), val);
     case VECTOR_CST:
       return iterative_hash_expr (TREE_VECTOR_CST_ELTS (t), val);
-
     case SSA_NAME:
-      /* we can just compare by pointer.  */
+      /* We can just compare by pointer.  */
       return iterative_hash_host_wide_int (SSA_NAME_VERSION (t), val);
-
+    case PLACEHOLDER_EXPR:
+      /* The node itself doesn't matter.  */
+      return val;
     case TREE_LIST:
       /* A list of expressions, for a CALL_EXPR or as the elements of a
 	 VECTOR_CST.  */
Index: lto-streamer-out.c
===================================================================
--- lto-streamer-out.c	(revision 158852)
+++ lto-streamer-out.c	(working copy)
@@ -841,8 +841,15 @@ static void
 lto_output_ts_decl_common_tree_pointers (struct output_block *ob, tree expr,
 					 bool ref_p)
 {
-  lto_output_tree_or_ref (ob, DECL_SIZE (expr), ref_p);
-  lto_output_tree_or_ref (ob, DECL_SIZE_UNIT (expr), ref_p);
+  if (CONTAINS_PLACEHOLDER_P (DECL_SIZE (expr)))
+    lto_output_tree_or_ref (ob, build0 (PLACEHOLDER_EXPR, bitsizetype), ref_p);
+  else
+    lto_output_tree_or_ref (ob, DECL_SIZE (expr), ref_p);
+
+  if (CONTAINS_PLACEHOLDER_P (DECL_SIZE_UNIT (expr)))
+    lto_output_tree_or_ref (ob, build0 (PLACEHOLDER_EXPR, sizetype), ref_p);
+  else
+    lto_output_tree_or_ref (ob, DECL_SIZE_UNIT (expr), ref_p);
 
   if (TREE_CODE (expr) != FUNCTION_DECL)
     lto_output_tree_or_ref (ob, DECL_INITIAL (expr), ref_p);
@@ -909,7 +916,11 @@ static void
 lto_output_ts_field_decl_tree_pointers (struct output_block *ob, tree expr,
 					bool ref_p)
 {
-  lto_output_tree_or_ref (ob, DECL_FIELD_OFFSET (expr), ref_p);
+  if (CONTAINS_PLACEHOLDER_P (DECL_FIELD_OFFSET (expr)))
+    lto_output_tree_or_ref (ob, build0 (PLACEHOLDER_EXPR, sizetype), ref_p);
+  else
+    lto_output_tree_or_ref (ob, DECL_FIELD_OFFSET (expr), ref_p);
+
   lto_output_tree_or_ref (ob, DECL_BIT_FIELD_TYPE (expr), ref_p);
   lto_output_tree_or_ref (ob, DECL_QUALIFIER (expr), ref_p);
   lto_output_tree_or_ref (ob, DECL_FIELD_BIT_OFFSET (expr), ref_p);
@@ -955,8 +966,16 @@ lto_output_ts_type_tree_pointers (struct
   else if (TREE_CODE (expr) == VECTOR_TYPE)
     lto_output_tree_or_ref (ob, TYPE_DEBUG_REPRESENTATION_TYPE (expr), ref_p);
 
-  lto_output_tree_or_ref (ob, TYPE_SIZE (expr), ref_p);
-  lto_output_tree_or_ref (ob, TYPE_SIZE_UNIT (expr), ref_p);
+  if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (expr)))
+    lto_output_tree_or_ref (ob, build0 (PLACEHOLDER_EXPR, bitsizetype), ref_p);
+  else
+    lto_output_tree_or_ref (ob, TYPE_SIZE (expr), ref_p);
+
+  if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE_UNIT (expr)))
+    lto_output_tree_or_ref (ob, build0 (PLACEHOLDER_EXPR, sizetype), ref_p);
+  else
+    lto_output_tree_or_ref (ob, TYPE_SIZE_UNIT (expr), ref_p);
+
   lto_output_tree_or_ref (ob, TYPE_ATTRIBUTES (expr), ref_p);
   lto_output_tree_or_ref (ob, TYPE_NAME (expr), ref_p);
   /* Do not stream TYPE_POINTER_TO or TYPE_REFERENCE_TO nor

-- PR ada/43106
-- Testcase by Bill Neven <neven@hitt.nl>

-- { dg-do run }
-- { dg-options "-O2 -flto" }

with Lto1_Pkg; use Lto1_Pkg;

procedure Lto1 is
   Radar : Radar_T;
begin
   Radar.Sensor_Type := radcmb;
   Initialize (Radar);
end;

package Lto1_Pkg  is

   type Unsigned_64 is mod 2 ** 64;

   type Associated_Report_T is (miss, radpr, radssr, radcmb);

   -- sensor type : primary, secondary, co-rotating (combined)
   subtype Sensor_Type_T is Associated_Report_T; -- range radpr .. radcmb;
   subtype Antenna_Type_T is Sensor_Type_T range radpr .. radssr;

   type Filtering_Level_T is (none, pr_in_clutter, ssr_plots, pr_plots);
   type Filtering_Levels_T is array (Filtering_Level_T) of boolean;

   type Radar_T is record
      External_Sensor_ID : Unsigned_64;
      Dual_Radar_Index : Integer;
      Compatible_Filtering_Levels : Filtering_Levels_T;
      Sensor_Type : Sensor_Type_T;
   end record;

   procedure Initialize (Radar : in Radar_T);

end Lto1_Pkg;

package body Lto1_Pkg is

  procedure Initialize (Radar : in Radar_T) is
    Antenna1 : Antenna_Type_T;
    Antenna2 : Antenna_Type_T;
  begin
    case Radar.Sensor_Type is
      when radpr | radssr =>
        Antenna1 := Radar.Sensor_Type;
        Antenna2 := Radar.Sensor_Type;
      when radcmb =>
        Antenna1 := radpr;
        Antenna2 := radssr;
      when others =>
        Antenna1 := radpr;
        Antenna2 := radssr;
    end case;
    if Antenna1 /= radpr or Antenna2 /= radssr then
      raise Program_Error;
    end if;
  end Initialize;

end Lto1_Pkg;