gimple.h (compare_field_offset): Rename into...

* gimple.h (compare_field_offset): Rename into...
	(gimple_compare_field_offset): ...this.
	* gimple.c (compare_field_offset): Rename into...
	(gimple_compare_field_offset): ...this.  Compare the full access if
	the offset is self-referential.
	(gimple_types_compatible_p): Adjust for above renaming.
	* lto-streamer-in.c (input_gimple_stmt): Likewise.  Also compare the
	DECL_NONADDRESSABLE_P flag of fields before merging them.

From-SVN: r159438
This commit is contained in:
Eric Botcazou 2010-05-15 19:05:06 +00:00 committed by Eric Botcazou
parent b75bdd292f
commit d025732d19
9 changed files with 117 additions and 9 deletions

View File

@ -1,3 +1,14 @@
2010-05-15 Eric Botcazou <ebotcazou@adacore.com>
* gimple.h (compare_field_offset): Rename into...
(gimple_compare_field_offset): ...this.
* gimple.c (compare_field_offset): Rename into...
(gimple_compare_field_offset): ...this. Compare the full access if
the offset is self-referential.
(gimple_types_compatible_p): Adjust for above renaming.
* lto-streamer-in.c (input_gimple_stmt): Likewise. Also compare the
DECL_NONADDRESSABLE_P flag of fields before merging them.
2010-05-15 Nathan Froyd <froydnj@codesourcery.com>
* tree.h (ctor_to_list): Delete.

View File

@ -3219,16 +3219,35 @@ compare_type_names_p (tree t1, tree t2, bool for_completion_p)
return false;
}
/* Return true if the field decls F1 and F2 are at the same offset. */
/* Return true if the field decls F1 and F2 are at the same offset.
This is intended to be used on GIMPLE types only. In order to
compare GENERIC types, use fields_compatible_p instead. */
bool
compare_field_offset (tree f1, tree f2)
gimple_compare_field_offset (tree f1, tree f2)
{
if (DECL_OFFSET_ALIGN (f1) == DECL_OFFSET_ALIGN (f2))
return (operand_equal_p (DECL_FIELD_OFFSET (f1),
DECL_FIELD_OFFSET (f2), 0)
&& tree_int_cst_equal (DECL_FIELD_BIT_OFFSET (f1),
DECL_FIELD_BIT_OFFSET (f2)));
{
tree offset1 = DECL_FIELD_OFFSET (f1);
tree offset2 = DECL_FIELD_OFFSET (f2);
return ((offset1 == offset2
/* Once gimplification is done, self-referential offsets are
instantiated as operand #2 of the COMPONENT_REF built for
each access and reset. Therefore, they are not relevant
anymore and fields are interchangeable provided that they
represent the same access. */
|| (TREE_CODE (offset1) == PLACEHOLDER_EXPR
&& TREE_CODE (offset2) == PLACEHOLDER_EXPR
&& (DECL_SIZE (f1) == DECL_SIZE (f2)
|| (TREE_CODE (DECL_SIZE (f1)) == PLACEHOLDER_EXPR
&& TREE_CODE (DECL_SIZE (f2)) == PLACEHOLDER_EXPR)
|| operand_equal_p (DECL_SIZE (f1), DECL_SIZE (f2), 0))
&& DECL_ALIGN (f1) == DECL_ALIGN (f2))
|| operand_equal_p (offset1, offset2, 0))
&& tree_int_cst_equal (DECL_FIELD_BIT_OFFSET (f1),
DECL_FIELD_BIT_OFFSET (f2)));
}
/* Fortran and C do not always agree on what DECL_OFFSET_ALIGN
should be, so handle differing ones specially by decomposing
@ -3576,7 +3595,7 @@ gimple_types_compatible_p (tree t1, tree t2)
/* The fields must have the same name, offset and type. */
if (DECL_NAME (f1) != DECL_NAME (f2)
|| DECL_NONADDRESSABLE_P (f1) != DECL_NONADDRESSABLE_P (f2)
|| !compare_field_offset (f1, f2)
|| !gimple_compare_field_offset (f1, f2)
|| !gimple_types_compatible_p (TREE_TYPE (f1),
TREE_TYPE (f2)))
goto different_types;

View File

@ -954,7 +954,7 @@ extern bool is_gimple_call_addr (tree);
extern tree get_call_expr_in (tree t);
extern void recalculate_side_effects (tree);
extern bool compare_field_offset (tree, tree);
extern bool gimple_compare_field_offset (tree, tree);
extern tree gimple_register_type (tree);
extern void print_gimple_types_stats (void);
extern void free_gimple_type_tables (void);

View File

@ -1094,7 +1094,9 @@ input_gimple_stmt (struct lto_input_block *ib, struct data_in *data_in,
{
if (tem == field
|| (TREE_TYPE (tem) == TREE_TYPE (field)
&& compare_field_offset (tem, field)))
&& DECL_NONADDRESSABLE_P (tem)
== DECL_NONADDRESSABLE_P (field)
&& gimple_compare_field_offset (tem, field)))
break;
}
/* In case of type mismatches across units we can fail

View File

@ -1,3 +1,9 @@
2010-05-15 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/lto9.adb: New test.
* gnat.dg/lto9_pkg1.ads: New helper.
* gnat.dg/lto9_pkg2.ad[sb]: Likewise.
2010-05-15 Jan Hubicka <jh@suse.cz>
* gcc.dg/lto/ipareference_1.c: Rename to ...

View File

@ -0,0 +1,15 @@
-- { dg-do run }
-- { dg-options "-flto" { target lto } }
with Lto9_Pkg1; use Lto9_Pkg1;
procedure Lto9 is
begin
District_Subscription_Lists.Put
(List => District_01_Subscribers,
Elem_Ptr => New_Subscriber_01'Access,
Location => 1);
end;

View File

@ -0,0 +1,24 @@
with Lto9_Pkg2;
package Lto9_Pkg1 is
subtype Lengths is Natural range 0 .. 50;
type Subscriber (NLen, ALen: Lengths := 50) is record
Name : String(1 .. NLen);
Address : String(1 .. ALen);
end record;
type Subscriber_Ptr is access all Subscriber;
package District_Subscription_Lists is new Lto9_Pkg2
(Element_Type => Subscriber,
Element_Ptr => Subscriber_Ptr,
Size => 100);
District_01_Subscribers : District_Subscription_Lists.List_Type;
New_Subscriber_01 : aliased Subscriber :=
(12, 23, "Brown, Silas", "King's Pyland, Dartmoor");
end Lto9_Pkg1;

View File

@ -0,0 +1,10 @@
package body Lto9_Pkg2 is
procedure Put (List : in out List_Type;
Elem_Ptr : in Element_Ptr;
Location : in Index) is
begin
List.Elements(Location) := Elem_Ptr;
end Put;
end Lto9_Pkg2;

View File

@ -0,0 +1,21 @@
generic
Size : in Positive;
type Element_Type (<>) is private;
type Element_Ptr is access all Element_Type;
package Lto9_Pkg2 is
subtype Index is Positive range 1 .. (Size + 1);
type List_Array is array (Index) of Element_Ptr;
type List_Type is record
Elements : List_Array;
end record;
procedure Put (List : in out List_Type;
Elem_Ptr : in Element_Ptr;
Location : in Index);
end Lto9_Pkg2;