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:
parent
ae25db4568
commit
5f2e59d44b
|
@ -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.
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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,33 +7570,25 @@ 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))
|
||||
{
|
||||
tree type_size = TYPE_SIZE (TREE_TYPE (gnu_field));
|
||||
|
||||
if (CONTAINS_PLACEHOLDER_P (type_size))
|
||||
if ((reorder || has_aliased_after_self_field)
|
||||
&& field_has_self_size (gnu_field))
|
||||
{
|
||||
MOVE_FROM_FIELD_LIST_TO (gnu_self_list);
|
||||
continue;
|
||||
}
|
||||
|
||||
if (TREE_CODE (type_size) != INTEGER_CST)
|
||||
if (reorder && field_has_variable_size (gnu_field))
|
||||
{
|
||||
MOVE_FROM_FIELD_LIST_TO (gnu_var_list);
|
||||
continue;
|
||||
}
|
||||
}
|
||||
|
||||
gnu_last = gnu_field;
|
||||
}
|
||||
|
||||
#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. */
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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;
|
Loading…
Reference in New Issue