OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

ada-tree.h (DECL_ALIASED_P): New flag. 

* gcc-interface/ada-tree.h (DECL_ALIASED_P): New flag.
	* gcc-interface/decl.c (is_variable_size): Rename to...
	(type_has_variable_size): ...this.
	(adjust_packed): Adjust to above renaming.
	(gnat_to_gnu_field): Set DECL_ALIASED_P on the field.
	(field_is_artificial): New predicate.
	(field_is_aliased): Likewise.
	(field_has_self_size): Likewise.
	(field_has_variable_size): Likewise.
	(components_to_record): Record information for the final layout during
	the first pass on fields.
	If there is an aliased field placed after a field whose length depends
	on discriminants, put all the fields of the latter sort, last.

From-SVN: r183609
This commit is contained in:
Eric Botcazou 2012-01-27 09:35:03 +00:00 committed by Eric Botcazou
parent ae25db4568
commit 5f2e59d44b
5 changed files with 140 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -1,3 +1,19 @@
2012-01-27 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/ada-tree.h (DECL_ALIASED_P): New flag.
* gcc-interface/decl.c (is_variable_size): Rename to...
(type_has_variable_size): ...this.
(adjust_packed): Adjust to above renaming.
(gnat_to_gnu_field): Set DECL_ALIASED_P on the field.
(field_is_artificial): New predicate.
(field_is_aliased): Likewise.
(field_has_self_size): Likewise.
(field_has_variable_size): Likewise.
(components_to_record): Record information for the final layout during
the first pass on fields.
If there is an aliased field placed after a field whose length depends
on discriminants, put all the fields of the latter sort, last.
2012-01-27 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/gigi.h (get_minimal_subprog_decl): Declare.

5
gcc/ada/gcc-interface/ada-tree.h
View File

@ -6,7 +6,7 @@
* *
* C Header File *
* *
* Copyright (C) 1992-2011, Free Software Foundation, Inc. *
* Copyright (C) 1992-2012, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
@ -344,6 +344,9 @@ do { \
pair of INDIRECT_REFs is needed to access the object. */
#define DECL_BY_DOUBLE_REF_P(NODE) DECL_LANG_FLAG_0 (PARM_DECL_CHECK (NODE))
/* Nonzero in a FIELD_DECL if it is declared as aliased. */
#define DECL_ALIASED_P(NODE) DECL_LANG_FLAG_0 (FIELD_DECL_CHECK (NODE))
/* Nonzero in a TYPE_DECL if this is the declaration of a Taft amendment type
in the main unit, i.e. the full declaration is available. */
#define DECL_TAFT_TYPE_P(NODE) DECL_LANG_FLAG_0 (TYPE_DECL_CHECK (NODE))

107
gcc/ada/gcc-interface/decl.c
View File

@ -145,7 +145,7 @@ static void prepend_one_attribute_to (struct attrib **,
enum attr_type, tree, tree, Node_Id);
static void prepend_attributes (Entity_Id, struct attrib **);
static tree elaborate_expression (Node_Id, Entity_Id, tree, bool, bool, bool);
static bool is_variable_size (tree);
static bool type_has_variable_size (tree);
static tree elaborate_expression_1 (tree, Entity_Id, tree, bool, bool);
static tree elaborate_expression_2 (tree, Entity_Id, tree, bool, bool,
unsigned int);
@ -6848,7 +6848,7 @@ adjust_packed (tree field_type, tree record_type, int packed)
because we cannot create temporaries of non-fixed size in case
we need to take the address of the field. See addressable_p and
the notes on the addressability issues for further details. */
if (is_variable_size (field_type))
if (type_has_variable_size (field_type))
return 0;
/* If the alignment of the record is specified and the field type
@ -7123,6 +7123,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
= create_field_decl (gnu_field_id, gnu_field_type, gnu_record_type,
gnu_size, gnu_pos, packed, Is_Aliased (gnat_field));
Sloc_to_locus (Sloc (gnat_field), &DECL_SOURCE_LOCATION (gnu_field));
DECL_ALIASED_P (gnu_field) = Is_Aliased (gnat_field);
TREE_THIS_VOLATILE (gnu_field) = TREE_SIDE_EFFECTS (gnu_field) = is_volatile;
if (Ekind (gnat_field) == E_Discriminant)
@ -7136,7 +7137,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
field of variable size or is a record that has a field such a field. */
static bool
is_variable_size (tree type)
type_has_variable_size (tree type)
{
tree field;
@ -7151,12 +7152,68 @@ is_variable_size (tree type)
return false;
for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
if (is_variable_size (TREE_TYPE (field)))
if (type_has_variable_size (TREE_TYPE (field)))
return true;
return false;
}
/* Return true if FIELD is an artificial field. */
static bool
field_is_artificial (tree field)
{
/* These fields are generated by the front-end proper. */
if (IDENTIFIER_POINTER (DECL_NAME (field)) [0] == '_')
return true;
/* These fields are generated by gigi. */
if (DECL_INTERNAL_P (field))
return true;
return false;
}
/* Return true if FIELD is a non-artificial aliased field. */
static bool
field_is_aliased (tree field)
{
if (field_is_artificial (field))
return false;
return DECL_ALIASED_P (field);
}
/* Return true if FIELD is a non-artificial field with self-referential
size. */
static bool
field_has_self_size (tree field)
{
if (field_is_artificial (field))
return false;
if (DECL_SIZE (field) && TREE_CODE (DECL_SIZE (field)) == INTEGER_CST)
return false;
return CONTAINS_PLACEHOLDER_P (TYPE_SIZE (TREE_TYPE (field)));
}
/* Return true if FIELD is a non-artificial field with variable size. */
static bool
field_has_variable_size (tree field)
{
if (field_is_artificial (field))
return false;
if (DECL_SIZE (field) && TREE_CODE (DECL_SIZE (field)) == INTEGER_CST)
return false;
return TREE_CODE (TYPE_SIZE (TREE_TYPE (field))) != INTEGER_CST;
}
/* qsort comparer for the bit positions of two record components. */
static int
@ -7219,6 +7276,8 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
{
bool all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type);
bool layout_with_rep = false;
bool has_self_field = false;
bool has_aliased_after_self_field = false;
Node_Id component_decl, variant_part;
tree gnu_field, gnu_next, gnu_last;
tree gnu_rep_part = NULL_TREE;
@ -7270,6 +7329,12 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
gnu_field_list = gnu_field;
if (!gnu_last)
gnu_last = gnu_field;
/* And record information for the final layout. */
if (field_has_self_size (gnu_field))
has_self_field = true;
else if (has_self_field && field_is_aliased (gnu_field))
has_aliased_after_self_field = true;
}
}
@ -7505,25 +7570,17 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
continue;
}
/* Reorder non-internal fields with non-fixed size. */
if (reorder
&& !DECL_INTERNAL_P (gnu_field)
&& !(DECL_SIZE (gnu_field)
&& TREE_CODE (DECL_SIZE (gnu_field)) == INTEGER_CST))
if ((reorder || has_aliased_after_self_field)
&& field_has_self_size (gnu_field))
{
tree type_size = TYPE_SIZE (TREE_TYPE (gnu_field));
MOVE_FROM_FIELD_LIST_TO (gnu_self_list);
continue;
}
if (CONTAINS_PLACEHOLDER_P (type_size))
{
MOVE_FROM_FIELD_LIST_TO (gnu_self_list);
continue;
}
if (TREE_CODE (type_size) != INTEGER_CST)
{
MOVE_FROM_FIELD_LIST_TO (gnu_var_list);
continue;
}
if (reorder && field_has_variable_size (gnu_field))
{
MOVE_FROM_FIELD_LIST_TO (gnu_var_list);
continue;
}
gnu_last = gnu_field;
@ -7531,7 +7588,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
#undef MOVE_FROM_FIELD_LIST_TO
/* If permitted, we reorder the components as follows:
/* If permitted, we reorder the fields as follows:
1) all fixed length fields,
2) all fields whose length doesn't depend on discriminants,
@ -7544,6 +7601,12 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
= chainon (nreverse (gnu_self_list),
chainon (nreverse (gnu_var_list), gnu_field_list));
/* Otherwise, if there is an aliased field placed after a field whose length
depends on discriminants, we put all the fields of the latter sort, last.
We need to do this in case an object of this record type is mutable. */
else if (has_aliased_after_self_field)
gnu_field_list = chainon (nreverse (gnu_self_list), gnu_field_list);
/* If P_REP_LIST is nonzero, this means that we are asked to move the fields
in our REP list to the previous level because this level needs them in
order to do a correct layout, i.e. avoid having overlapping fields. */

4
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,7 @@
2012-01-27 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/discr33.adb: New test.
2012-01-27 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/limited_with3.ad[sb): New test.

31
gcc/testsuite/gnat.dg/discr33.adb Normal file
View File

@ -0,0 +1,31 @@
-- { dg-do run }
procedure Discr33 is
subtype Int is Integer range 1..100;
type T (D : Int := 1) is
record
A : Integer;
B : String (1..D);
C : aliased Integer;
end record;
Var : T := (D => 1, A => 1234, B => "x", C => 4567);
type Int_Ref is access all Integer;
Pointer_To_C : Int_Ref := Var.C'Access;
begin
if Pointer_To_C.all /= 4567 then
raise Program_Error;
end if;
Var := (D => 26, A => 1234, B => "abcdefghijklmnopqrstuvwxyz", C => 2345);
if Pointer_To_C.all /= 2345 then
raise Program_Error;
end if;
end Discr33;