Commit 7ef5e86c by Eric Botcazou Committed by Eric Botcazou

tree.c (free_lang_data_in_one_sizepos): New inline function.

	* tree.c (free_lang_data_in_one_sizepos): New inline function.
	(free_lang_data_in_type): Call it on TYPE_{MIN|MAX}_VALUE of numerical
	types.  Call it on TYPE_SIZE and TYPE_SIZE_UNIT of all types.
	(free_lang_data_in_decl): Call it on DECL_SIZE and DECL_SIZE_UNIT of
	all decls.  Call it on DECL_FIELD_OFFSET of fields.
	(find_decls_types_r): Follow DECL_VALUE_EXPR.
	(iterative_hash_expr) <PLACEHOLDER_EXPR>: New case.

From-SVN: r159039
parent 6cbd3b6a
2010-05-04 Eric Botcazou <ebotcazou@adacore.com>
* tree.c (free_lang_data_in_one_sizepos): New inline function.
(free_lang_data_in_type): Call it on TYPE_{MIN|MAX}_VALUE of numerical
types. Call it on TYPE_SIZE and TYPE_SIZE_UNIT of all types.
(free_lang_data_in_decl): Call it on DECL_SIZE and DECL_SIZE_UNIT of
all decls. Call it on DECL_FIELD_OFFSET of fields.
(find_decls_types_r): Follow DECL_VALUE_EXPR.
(iterative_hash_expr) <PLACEHOLDER_EXPR>: New case.
2010-05-04 Martin Jambor <mjambor@suse.cz>
* tree-sra.c (build_access_from_expr_1): The first parameter type
......
2010-05-04 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/lto1.adb: New test.
* gnat.dg/lto1_pkg.ad[sb]: New helper.
2010-05-04 H.J. Lu <hongjiu.lu@intel.com>
PR middle-end/43671
......
-- 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 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;
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;
......@@ -4174,6 +4174,26 @@ build_type_attribute_variant (tree ttype, tree attribute)
}
/* Reset the expression *EXPR_P, a size or position.
??? We could reset all non-constant sizes or positions. But it's cheap
enough to not do so and refrain from adding workarounds to dwarf2out.c.
We need to reset self-referential sizes or positions because they cannot
be gimplified and thus can contain a CALL_EXPR after the gimplification
is finished, which will run afoul of LTO streaming. And they need to be
reset to something essentially dummy but not constant, so as to preserve
the properties of the object they are attached to. */
static inline void
free_lang_data_in_one_sizepos (tree *expr_p)
{
tree expr = *expr_p;
if (CONTAINS_PLACEHOLDER_P (expr))
*expr_p = build0 (PLACEHOLDER_EXPR, TREE_TYPE (expr));
}
/* Reset all the fields in a binfo node BINFO. We only keep
BINFO_VIRTUALS, which is used by gimple_fold_obj_type_ref. */
......@@ -4280,8 +4300,19 @@ free_lang_data_in_type (tree type)
/* For non-aggregate types, clear out the language slot (which
overloads TYPE_BINFO). */
TYPE_LANG_SLOT_1 (type) = NULL_TREE;
if (INTEGRAL_TYPE_P (type)
|| SCALAR_FLOAT_TYPE_P (type)
|| FIXED_POINT_TYPE_P (type))
{
free_lang_data_in_one_sizepos (&TYPE_MIN_VALUE (type));
free_lang_data_in_one_sizepos (&TYPE_MAX_VALUE (type));
}
}
free_lang_data_in_one_sizepos (&TYPE_SIZE (type));
free_lang_data_in_one_sizepos (&TYPE_SIZE_UNIT (type));
if (debug_info_level < DINFO_LEVEL_TERSE
|| (TYPE_CONTEXT (type)
&& TREE_CODE (TYPE_CONTEXT (type)) != FUNCTION_DECL
......@@ -4417,9 +4448,10 @@ free_lang_data_in_decl (tree decl)
}
}
/* ??? We could free non-constant DECL_SIZE, DECL_SIZE_UNIT
and DECL_FIELD_OFFSET. But it's cheap enough to not do
that and refrain from adding workarounds to dwarf2out.c */
free_lang_data_in_one_sizepos (&DECL_SIZE (decl));
free_lang_data_in_one_sizepos (&DECL_SIZE_UNIT (decl));
if (TREE_CODE (decl) == FIELD_DECL)
free_lang_data_in_one_sizepos (&DECL_FIELD_OFFSET (decl));
/* DECL_FCONTEXT is only used for debug info generation. */
if (TREE_CODE (decl) == FIELD_DECL
......@@ -4633,6 +4665,10 @@ find_decls_types_r (tree *tp, int *ws, void *data)
fld_worklist_push (DECL_COMDAT_GROUP (t), fld);
}
if ((TREE_CODE (t) == VAR_DECL || TREE_CODE (t) == PARM_DECL)
&& DECL_HAS_VALUE_EXPR_P (t))
fld_worklist_push (DECL_VALUE_EXPR (t), fld);
if (TREE_CODE (t) != FIELD_DECL)
fld_worklist_push (TREE_CHAIN (t), fld);
*ws = 0;
......@@ -6591,11 +6627,12 @@ iterative_hash_expr (const_tree t, hashval_t val)
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. */
......
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