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

gigi.h (pad_type_has_rm_size): Declare. 

* gcc-interface/gigi.h (pad_type_has_rm_size): Declare.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Variable>: Do not build
	a padding type for the alignment before validating the size.
	Flip conditional construct and add a comment.
	* gcc-interface/trans.c (Attribute_to_gnu) <Attr_Size>: Make sure to
	apply the exception for padded objects to the type of the object.
	* gcc-interface/utils.c (hash_pad_type): New static function.
	(lookup_and_insert_pad_type): Rename into...
	(canonicalize_pad_type): ...this.  Call hash_pad_type, do only one
	lookup with insertion and always return the canonical type.
	(maybe_pad_type): Adjust to above changes.  Set debug type later.
	(pad_type_has_rm_size): New predicate.
	(set_reverse_storage_order_on_pad_type): Adjust to above changes.

From-SVN: r255631
This commit is contained in:
Eric Botcazou 2017-12-14 11:47:24 +00:00 committed by Eric Botcazou
parent 02aee32767
commit 4d39941ea9
8 changed files with 133 additions and 74 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 @@
2017-12-14 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/gigi.h (pad_type_has_rm_size): Declare.
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Variable>: Do not build
a padding type for the alignment before validating the size.
Flip conditional construct and add a comment.
* gcc-interface/trans.c (Attribute_to_gnu) <Attr_Size>: Make sure to
apply the exception for padded objects to the type of the object.
* gcc-interface/utils.c (hash_pad_type): New static function.
(lookup_and_insert_pad_type): Rename into...
(canonicalize_pad_type): ...this. Call hash_pad_type, do only one
lookup with insertion and always return the canonical type.
(maybe_pad_type): Adjust to above changes. Set debug type later.
(pad_type_has_rm_size): New predicate.
(set_reverse_storage_order_on_pad_type): Adjust to above changes.
2017-12-13 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (Subprogram_Body_to_gnu): Initialize locus.

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

@ -713,48 +713,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
}
/* If an alignment is specified, use it if valid. Note that exceptions
are objects but don't have an alignment. We must do this before we
validate the size, since the alignment can affect the size. */
if (kind != E_Exception && Known_Alignment (gnat_entity))
{
gcc_assert (Present (Alignment (gnat_entity)));
align = validate_alignment (Alignment (gnat_entity), gnat_entity,
TYPE_ALIGN (gnu_type));
/* No point in changing the type if there is an address clause
as the final type of the object will be a reference type. */
if (Present (Address_Clause (gnat_entity)))
align = 0;
else
{
tree orig_type = gnu_type;
gnu_type
= maybe_pad_type (gnu_type, NULL_TREE, align, gnat_entity,
false, false, definition, true);
/* If a padding record was made, declare it now since it will
never be declared otherwise. This is necessary to ensure
that its subtrees are properly marked. */
if (gnu_type != orig_type && !DECL_P (TYPE_NAME (gnu_type)))
create_type_decl (TYPE_NAME (gnu_type), gnu_type, true,
debug_info_p, gnat_entity);
}
}
/* If we are defining the object, see if it has a Size and validate it
if so. If we are not defining the object and a Size clause applies,
simply retrieve the value. We don't want to ignore the clause and
it is expected to have been validated already. Then get the new
type, if any. */
if (definition)
gnu_size = validate_size (Esize (gnat_entity), gnu_type,
gnat_entity, VAR_DECL, false,
Has_Size_Clause (gnat_entity));
else if (Has_Size_Clause (gnat_entity))
gnu_size = UI_To_gnu (Esize (gnat_entity), bitsizetype);
are objects but don't have an alignment and there is also no point in
setting it for an address clause, since the final type of the object
will be a reference type. */
if (Known_Alignment (gnat_entity)
&& kind != E_Exception
&& No (Address_Clause (gnat_entity)))
align = validate_alignment (Alignment (gnat_entity), gnat_entity,
TYPE_ALIGN (gnu_type));
/* Likewise, if a size is specified, use it if valid. */
if (Known_Esize (gnat_entity) && No (Address_Clause (gnat_entity)))
gnu_size
= validate_size (Esize (gnat_entity), gnu_type, gnat_entity,
VAR_DECL, false, Has_Size_Clause (gnat_entity));
if (gnu_size)
{
gnu_type
@ -4580,15 +4552,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
gnu_type = change_qualified_type (gnu_type, quals);
}
if (!gnu_decl)
gnu_decl = create_type_decl (gnu_entity_name, gnu_type,
artificial_p, debug_info_p,
gnat_entity);
else
/* If we already made a decl, just set the type, otherwise create it. */
if (gnu_decl)
{
TREE_TYPE (gnu_decl) = gnu_type;
TYPE_STUB_DECL (gnu_type) = gnu_decl;
}
else
gnu_decl = create_type_decl (gnu_entity_name, gnu_type, artificial_p,
debug_info_p, gnat_entity);
}
/* If we got a type that is not dummy, back-annotate the alignment of the

3
gcc/ada/gcc-interface/gigi.h
View File

@ -151,6 +151,9 @@ extern tree maybe_pad_type (tree type, tree size, unsigned int align,
bool is_user_type, bool definition,
bool set_rm_size);
/* Return true if padded TYPE was built with an RM size. */
extern bool pad_type_has_rm_size (tree type);
/* Return a copy of the padded TYPE but with reverse storage order. */
extern tree set_reverse_storage_order_on_pad_type (tree type);

3
gcc/ada/gcc-interface/trans.c
View File

@ -1850,7 +1850,8 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
This is in keeping with the object case of gnat_to_gnu_entity. */
else if ((TREE_CODE (gnu_prefix) != TYPE_DECL
&& !(TYPE_IS_PADDING_P (gnu_type)
&& TREE_CODE (gnu_expr) == COMPONENT_REF))
&& TREE_CODE (gnu_expr) == COMPONENT_REF
&& pad_type_has_rm_size (gnu_type)))
|| attribute == Attr_Object_Size
|| attribute == Attr_Max_Size_In_Storage_Elements)
{

84
gcc/ada/gcc-interface/utils.c
View File

@ -1224,14 +1224,12 @@ pad_type_hasher::equal (pad_type_hash *t1, pad_type_hash *t2)
&& TYPE_REVERSE_STORAGE_ORDER (type1) == TYPE_REVERSE_STORAGE_ORDER (type2);
}
/* Look up the padded TYPE in the hash table and return its canonical version
if it exists; otherwise, insert it into the hash table. */
/* Compute the hash value for the padded TYPE. */
static tree
lookup_and_insert_pad_type (tree type)
static hashval_t
hash_pad_type (tree type)
{
hashval_t hashcode;
struct pad_type_hash in, *h;
hashcode
= iterative_hash_object (TYPE_HASH (TREE_TYPE (TYPE_FIELDS (type))), 0);
@ -1239,17 +1237,31 @@ lookup_and_insert_pad_type (tree type)
hashcode = iterative_hash_hashval_t (TYPE_ALIGN (type), hashcode);
hashcode = iterative_hash_expr (TYPE_ADA_SIZE (type), hashcode);
return hashcode;
}
/* Look up the padded TYPE in the hash table and return its canonical version
if it exists; otherwise, insert it into the hash table. */
static tree
canonicalize_pad_type (tree type)
{
const hashval_t hashcode = hash_pad_type (type);
struct pad_type_hash in, *h, **slot;
in.hash = hashcode;
in.type = type;
h = pad_type_hash_table->find_with_hash (&in, hashcode);
if (h)
return h->type;
slot = pad_type_hash_table->find_slot_with_hash (&in, hashcode, INSERT);
h = *slot;
if (!h)
{
h = ggc_alloc<pad_type_hash> ();
h->hash = hashcode;
h->type = type;
*slot = h;
}
h = ggc_alloc<pad_type_hash> ();
h->hash = hashcode;
h->type = type;
*pad_type_hash_table->find_slot_with_hash (h, hashcode, INSERT) = h;
return NULL_TREE;
return h->type;
}
/* Ensure that TYPE has SIZE and ALIGN. Make and return a new padded type
@ -1380,28 +1392,29 @@ maybe_pad_type (tree type, tree size, unsigned int align,
/* We will output additional debug info manually below. */
finish_record_type (record, field, 1, false);
if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
SET_TYPE_DEBUG_TYPE (record, type);
/* Set the RM size if requested. */
if (set_rm_size)
{
tree canonical_pad_type;
SET_TYPE_ADA_SIZE (record, size ? size : orig_size);
/* If the padded type is complete and has constant size, we canonicalize
it by means of the hash table. This is consistent with the language
semantics and ensures that gigi and the middle-end have a common view
of these padded types. */
if (TREE_CONSTANT (TYPE_SIZE (record))
&& (canonical_pad_type = lookup_and_insert_pad_type (record)))
if (TREE_CONSTANT (TYPE_SIZE (record)))
{
record = canonical_pad_type;
goto built;
tree canonical = canonicalize_pad_type (record);
if (canonical != record)
{
record = canonical;
goto built;
}
}
}
if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
SET_TYPE_DEBUG_TYPE (record, type);
/* Unless debugging information isn't being written for the input type,
write a record that shows what we are a subtype of and also make a
variable that indicates our size, if still variable. */
@ -1520,13 +1533,31 @@ built:
return record;
}
/* Return true if padded TYPE was built with an RM size. */
bool
pad_type_has_rm_size (tree type)
{
/* This is required for the lookup. */
if (!TREE_CONSTANT (TYPE_SIZE (type)))
return false;
const hashval_t hashcode = hash_pad_type (type);
struct pad_type_hash in, *h;
in.hash = hashcode;
in.type = type;
h = pad_type_hash_table->find_with_hash (&in, hashcode);
/* The types built with an RM size are the canonicalized ones. */
return h && h->type == type;
}
/* Return a copy of the padded TYPE but with reverse storage order. */
tree
set_reverse_storage_order_on_pad_type (tree type)
{
tree field, canonical_pad_type;
if (flag_checking)
{
/* If the inner type is not scalar then the function does nothing. */
@ -1538,13 +1569,12 @@ set_reverse_storage_order_on_pad_type (tree type)
/* This is required for the canonicalization. */
gcc_assert (TREE_CONSTANT (TYPE_SIZE (type)));
field = copy_node (TYPE_FIELDS (type));
tree field = copy_node (TYPE_FIELDS (type));
type = copy_type (type);
DECL_CONTEXT (field) = type;
TYPE_FIELDS (type) = field;
TYPE_REVERSE_STORAGE_ORDER (type) = 1;
canonical_pad_type = lookup_and_insert_pad_type (type);
return canonical_pad_type ? canonical_pad_type : type;
return canonicalize_pad_type (type);
}
/* Relate the alias sets of GNU_NEW_TYPE and GNU_OLD_TYPE according to OP.

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2017-12-14 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/alignment11.adb: New test.
* gnat.dg/alignment12.adb: Likewise.
2017-12-14 Richard Biener <rguenther@suse.de>
PR c/83415

15
gcc/testsuite/gnat.dg/alignment11.adb Normal file
View File

@ -0,0 +1,15 @@
-- { dg-do run }
-- { dg-options "-gnatws" }
procedure Alignment11 is
type Arr is array (1 .. 3) of Character;
for Arr'Alignment use 4;
A : Arr;
begin
if A'Size /= 32 then
raise Program_Error;
end if;
end;

17
gcc/testsuite/gnat.dg/alignment12.adb Normal file
View File

@ -0,0 +1,17 @@
-- { dg-do run }
-- { dg-options "-gnatws" }
procedure Alignment12 is
type Rec is record
I : Integer;
end record;
R : Rec;
for R'Alignment use 8;
begin
if R'Size /= 32 then
raise Program_Error;
end if;
end;