aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/gcc-interface/utils.c
diff options
context:
space:
mode:
authorAldy Hernandez <aldyh@redhat.com>2020-06-17 07:50:57 -0400
committerAldy Hernandez <aldyh@redhat.com>2020-06-17 07:50:57 -0400
commitb9e67f2840ce0d8859d96e7f8df8fe9584af5eba (patch)
treeed3b7284ff15c802583f6409b9c71b3739642d15 /gcc/ada/gcc-interface/utils.c
parent1957047ed1c94bf17cf993a2b1866965f493ba87 (diff)
parent56638b9b1853666f575928f8baf17f70e4ed3517 (diff)
downloadgcc-b9e67f2840ce0d8859d96e7f8df8fe9584af5eba.zip
gcc-b9e67f2840ce0d8859d96e7f8df8fe9584af5eba.tar.gz
gcc-b9e67f2840ce0d8859d96e7f8df8fe9584af5eba.tar.bz2
Merge from trunk at:
commit 56638b9b1853666f575928f8baf17f70e4ed3517 Author: GCC Administrator <gccadmin@gcc.gnu.org> Date: Wed Jun 17 00:16:36 2020 +0000 Daily bump.
Diffstat (limited to 'gcc/ada/gcc-interface/utils.c')
-rw-r--r--gcc/ada/gcc-interface/utils.c196
1 files changed, 140 insertions, 56 deletions
diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index fa98a5a..fb08b6c 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
- * Copyright (C) 1992-2019, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2020, 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- *
@@ -258,6 +258,29 @@ static GTY(()) vec<tree, va_gc> *builtin_decls;
/* A chain of unused BLOCK nodes. */
static GTY((deletable)) tree free_block_chain;
+/* A hash table of packable types. It is modelled on the generic type
+ hash table in tree.c, which must thus be used as a reference. */
+
+struct GTY((for_user)) packable_type_hash
+{
+ hashval_t hash;
+ tree type;
+};
+
+struct packable_type_hasher : ggc_cache_ptr_hash<packable_type_hash>
+{
+ static inline hashval_t hash (packable_type_hash *t) { return t->hash; }
+ static bool equal (packable_type_hash *a, packable_type_hash *b);
+
+ static int
+ keep_cache_entry (packable_type_hash *&t)
+ {
+ return ggc_marked_p (t->type);
+ }
+};
+
+static GTY ((cache)) hash_table<packable_type_hasher> *packable_type_hash_table;
+
/* A hash table of padded types. It is modelled on the generic type
hash table in tree.c, which must thus be used as a reference. */
@@ -333,6 +356,9 @@ init_gnat_utils (void)
/* Initialize the association of GNAT nodes to GCC trees as dummies. */
dummy_node_table = ggc_cleared_vec_alloc<tree> (max_gnat_nodes);
+ /* Initialize the hash table of packable types. */
+ packable_type_hash_table = hash_table<packable_type_hasher>::create_ggc (512);
+
/* Initialize the hash table of padded types. */
pad_type_hash_table = hash_table<pad_type_hasher>::create_ggc (512);
}
@@ -350,6 +376,10 @@ destroy_gnat_utils (void)
ggc_free (dummy_node_table);
dummy_node_table = NULL;
+ /* Destroy the hash table of packable types. */
+ packable_type_hash_table->empty ();
+ packable_type_hash_table = NULL;
+
/* Destroy the hash table of padded types. */
pad_type_hash_table->empty ();
pad_type_hash_table = NULL;
@@ -861,6 +891,9 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
their GNAT encodings. */
if (TREE_CODE (t) == ARRAY_TYPE && !TYPE_NAME (t))
TYPE_NAME (t) = DECL_NAME (decl);
+ /* Remark the canonical fat pointer type as artificial. */
+ if (TYPE_IS_FAT_POINTER_P (t))
+ TYPE_ARTIFICIAL (t) = 1;
t = NULL_TREE;
}
else if (TYPE_NAME (t)
@@ -983,6 +1016,71 @@ make_aligning_type (tree type, unsigned int align, tree size,
return record_type;
}
+/* Return true iff the packable types are equivalent. */
+
+bool
+packable_type_hasher::equal (packable_type_hash *t1, packable_type_hash *t2)
+{
+ tree type1, type2;
+
+ if (t1->hash != t2->hash)
+ return 0;
+
+ type1 = t1->type;
+ type2 = t2->type;
+
+ /* We consider that packable types are equivalent if they have the same name,
+ size, alignment, RM size and storage order. Taking the mode into account
+ is redundant since it is determined by the others. */
+ return
+ TYPE_NAME (type1) == TYPE_NAME (type2)
+ && TYPE_SIZE (type1) == TYPE_SIZE (type2)
+ && TYPE_ALIGN (type1) == TYPE_ALIGN (type2)
+ && TYPE_ADA_SIZE (type1) == TYPE_ADA_SIZE (type2)
+ && TYPE_REVERSE_STORAGE_ORDER (type1) == TYPE_REVERSE_STORAGE_ORDER (type2);
+}
+
+/* Compute the hash value for the packable TYPE. */
+
+static hashval_t
+hash_packable_type (tree type)
+{
+ hashval_t hashcode;
+
+ hashcode = iterative_hash_expr (TYPE_NAME (type), 0);
+ hashcode = iterative_hash_expr (TYPE_SIZE (type), hashcode);
+ hashcode = iterative_hash_hashval_t (TYPE_ALIGN (type), hashcode);
+ hashcode = iterative_hash_expr (TYPE_ADA_SIZE (type), hashcode);
+ hashcode
+ = iterative_hash_hashval_t (TYPE_REVERSE_STORAGE_ORDER (type), hashcode);
+
+ return hashcode;
+}
+
+/* Look up the packable TYPE in the hash table and return its canonical version
+ if it exists; otherwise, insert it into the hash table. */
+
+static tree
+canonicalize_packable_type (tree type)
+{
+ const hashval_t hashcode = hash_packable_type (type);
+ struct packable_type_hash in, *h, **slot;
+
+ in.hash = hashcode;
+ in.type = type;
+ slot = packable_type_hash_table->find_slot_with_hash (&in, hashcode, INSERT);
+ h = *slot;
+ if (!h)
+ {
+ h = ggc_alloc<packable_type_hash> ();
+ h->hash = hashcode;
+ h->type = type;
+ *slot = h;
+ }
+
+ return h->type;
+}
+
/* TYPE is an ARRAY_TYPE that is being used as the type of a field in a packed
record. See if we can rewrite it as a type that has non-BLKmode, which we
can pack tighter in the packed record. If so, return the new type; if not,
@@ -1062,16 +1160,16 @@ make_packable_type (tree type, bool in_record, unsigned int max_align)
}
else
{
- tree type_size = TYPE_ADA_SIZE (type);
+ tree ada_size = TYPE_ADA_SIZE (type);
+
/* Do not try to shrink the size if the RM size is not constant. */
- if (TYPE_CONTAINS_TEMPLATE_P (type)
- || !tree_fits_uhwi_p (type_size))
+ if (TYPE_CONTAINS_TEMPLATE_P (type) || !tree_fits_uhwi_p (ada_size))
return type;
/* Round the RM size up to a unit boundary to get the minimal size
for a BLKmode record. Give up if it's already the size and we
don't need to lower the alignment. */
- new_size = tree_to_uhwi (type_size);
+ new_size = tree_to_uhwi (ada_size);
new_size = (new_size + BITS_PER_UNIT - 1) & -BITS_PER_UNIT;
if (new_size == size && (max_align == 0 || align <= max_align))
return type;
@@ -1117,7 +1215,13 @@ make_packable_type (tree type, bool in_record, unsigned int max_align)
&& TYPE_ADA_SIZE (new_field_type))
new_field_size = TYPE_ADA_SIZE (new_field_type);
else
- new_field_size = DECL_SIZE (field);
+ {
+ new_field_size = DECL_SIZE (field);
+
+ /* Make sure not to use too small a type for the size. */
+ if (TYPE_MODE (new_field_type) == BLKmode)
+ new_field_type = TREE_TYPE (field);
+ }
/* This is a layout with full representation, alignment and size clauses
so we simply pass 0 as PACKED like gnat_to_gnu_field in this case. */
@@ -1160,8 +1264,8 @@ make_packable_type (tree type, bool in_record, unsigned int max_align)
SET_DECL_PARALLEL_TYPE (TYPE_STUB_DECL (new_type),
DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type)));
- /* Try harder to get a packable type if necessary, for example
- in case the record itself contains a BLKmode field. */
+ /* Try harder to get a packable type if necessary, for example in case
+ the record itself contains a BLKmode field. */
if (in_record && TYPE_MODE (new_type) == BLKmode)
SET_TYPE_MODE (new_type,
mode_for_size_tree (TYPE_SIZE (new_type),
@@ -1171,7 +1275,11 @@ make_packable_type (tree type, bool in_record, unsigned int max_align)
if (TYPE_MODE (new_type) == BLKmode && new_size >= size && max_align == 0)
return type;
- return new_type;
+ /* If the packable type is named, 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 packable types. */
+ return
+ TYPE_NAME (new_type) ? canonicalize_packable_type (new_type) : new_type;
}
/* Return true if TYPE has an unsigned representation. This needs to be used
@@ -1230,9 +1338,9 @@ make_type_from_size (tree type, tree size_tree, bool for_biased)
if (size == 0)
size = 1;
- /* Only do something if the type isn't a packed array type and doesn't
- already have the proper size and the size isn't too large. */
- if (TYPE_IS_PACKED_ARRAY_TYPE_P (type)
+ /* Only do something if the type is not a bit-packed array type and does
+ not already have the proper size and the size is not too large. */
+ if (BIT_PACKED_ARRAY_TYPE_P (type)
|| (TYPE_PRECISION (type) == size && biased_p == for_biased)
|| size > LONG_LONG_TYPE_SIZE)
break;
@@ -1300,7 +1408,7 @@ pad_type_hasher::equal (pad_type_hash *t1, pad_type_hash *t2)
type1 = t1->type;
type2 = t2->type;
- /* We consider that the padded types are equivalent if they pad the same type
+ /* We consider that padded types are equivalent if they pad the same type
and have the same size, alignment, RM size and storage order. Taking the
mode into account is redundant since it is determined by the others. */
return
@@ -1323,6 +1431,8 @@ hash_pad_type (tree type)
hashcode = iterative_hash_expr (TYPE_SIZE (type), hashcode);
hashcode = iterative_hash_hashval_t (TYPE_ALIGN (type), hashcode);
hashcode = iterative_hash_expr (TYPE_ADA_SIZE (type), hashcode);
+ hashcode
+ = iterative_hash_hashval_t (TYPE_REVERSE_STORAGE_ORDER (type), hashcode);
return hashcode;
}
@@ -1355,15 +1465,14 @@ canonicalize_pad_type (tree type)
if needed. We have already verified that SIZE and ALIGN are large enough.
GNAT_ENTITY is used to name the resulting record and to issue a warning.
IS_COMPONENT_TYPE is true if this is being done for the component type of
- an array. IS_USER_TYPE is true if the original type needs to be completed.
- DEFINITION is true if this type is being defined. SET_RM_SIZE is true if
- the RM size of the resulting type is to be set to SIZE too; in this case,
- the padded type is canonicalized before being returned. */
+ an array. DEFINITION is true if this type is being defined. SET_RM_SIZE
+ is true if the RM size of the resulting type is to be set to SIZE too; in
+ this case, the padded type is canonicalized before being returned. */
tree
maybe_pad_type (tree type, tree size, unsigned int align,
Entity_Id gnat_entity, bool is_component_type,
- bool is_user_type, bool definition, bool set_rm_size)
+ bool definition, bool set_rm_size)
{
tree orig_size = TYPE_SIZE (type);
unsigned int orig_align = TYPE_ALIGN (type);
@@ -1407,31 +1516,13 @@ maybe_pad_type (tree type, tree size, unsigned int align,
if (align == 0 && !size)
return type;
- /* If requested, complete the original type and give it a name. */
- if (is_user_type)
- create_type_decl (get_entity_name (gnat_entity), type,
- !Comes_From_Source (gnat_entity),
- !(TYPE_NAME (type)
- && TREE_CODE (TYPE_NAME (type)) == TYPE_DECL
- && DECL_IGNORED_P (TYPE_NAME (type))),
- gnat_entity);
-
/* We used to modify the record in place in some cases, but that could
generate incorrect debugging information. So make a new record
type and name. */
record = make_node (RECORD_TYPE);
TYPE_PADDING_P (record) = 1;
- /* ??? Padding types around packed array implementation types will be
- considered as root types in the array descriptor language hook (see
- gnat_get_array_descr_info). Give them the original packed array type
- name so that the one coming from sources appears in the debugging
- information. */
- if (TYPE_IMPL_PACKED_ARRAY_P (type)
- && TYPE_ORIGINAL_PACKED_ARRAY (type)
- && gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
- TYPE_NAME (record) = TYPE_NAME (TYPE_ORIGINAL_PACKED_ARRAY (type));
- else if (Present (gnat_entity))
+ if (Present (gnat_entity))
TYPE_NAME (record) = create_concat_name (gnat_entity, "PAD");
SET_TYPE_ALIGN (record, align ? align : orig_align);
@@ -1499,6 +1590,7 @@ maybe_pad_type (tree type, tree size, unsigned int align,
}
}
+ /* Make the inner type the debug type of the padded type. */
if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
SET_TYPE_DEBUG_TYPE (record, maybe_debug_type (type));
@@ -3127,7 +3219,7 @@ compute_deferred_decl_context (Entity_Id gnat_scope)
if (TREE_CODE (context) == TYPE_DECL)
{
- const tree context_type = TREE_TYPE (context);
+ tree context_type = TREE_TYPE (context);
/* Skip dummy types: only the final ones can appear in the context
chain. */
@@ -4078,7 +4170,6 @@ tree
build_unc_object_type (tree template_type, tree object_type, tree name,
bool debug_info_p)
{
- tree decl;
tree type = make_node (RECORD_TYPE);
tree template_field
= create_field_decl (get_identifier ("BOUNDS"), template_type, type,
@@ -4094,12 +4185,7 @@ build_unc_object_type (tree template_type, tree object_type, tree name,
/* Declare it now since it will never be declared otherwise. This is
necessary to ensure that its subtrees are properly marked. */
- decl = create_type_decl (name, type, true, debug_info_p, Empty);
-
- /* template_type will not be used elsewhere than here, so to keep the debug
- info clean and in order to avoid scoping issues, make decl its
- context. */
- gnat_set_type_context (template_type, decl);
+ create_type_decl (name, type, true, debug_info_p, Empty);
return type;
}
@@ -4773,7 +4859,7 @@ convert (tree type, tree expr)
&& smaller_form_type_p (etype, type))
{
expr = convert (maybe_pad_type (etype, TYPE_SIZE (type), 0, Empty,
- false, false, false, true),
+ false, false, true),
expr);
return build1 (VIEW_CONVERT_EXPR, type, expr);
}
@@ -5155,11 +5241,9 @@ maybe_unconstrained_array (tree exp)
exp = build_component_ref (exp, DECL_CHAIN (TYPE_FIELDS (type)),
false);
- type = TREE_TYPE (exp);
- /* If the array type is padded, convert to the unpadded type. */
- if (TYPE_IS_PADDING_P (type))
- exp = convert (TREE_TYPE (TYPE_FIELDS (type)), exp);
+ /* If the array is padded, remove the padding. */
+ exp = maybe_padded_object (exp);
}
break;
@@ -5395,14 +5479,14 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
if (c < 0)
{
expr = convert (maybe_pad_type (etype, TYPE_SIZE (type), 0, Empty,
- false, false, false, true),
+ false, false, true),
expr);
expr = unchecked_convert (type, expr, notrunc_p);
}
else
{
tree rec_type = maybe_pad_type (type, TYPE_SIZE (etype), 0, Empty,
- false, false, false, true);
+ false, false, true);
expr = unchecked_convert (rec_type, expr, notrunc_p);
expr = build_component_ref (expr, TYPE_FIELDS (rec_type), false);
}
@@ -5420,14 +5504,14 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
if (c < 0)
{
expr = convert (maybe_pad_type (etype, new_size, 0, Empty,
- false, false, false, true),
+ false, false, true),
expr);
expr = unchecked_convert (type, expr, notrunc_p);
}
else
{
tree rec_type = maybe_pad_type (type, TYPE_SIZE (etype), 0, Empty,
- false, false, false, true);
+ false, false, true);
expr = unchecked_convert (rec_type, expr, notrunc_p);
expr = build_component_ref (expr, TYPE_FIELDS (rec_type), false);
}
@@ -5472,7 +5556,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
&& TYPE_ALIGN (etype) < TYPE_ALIGN (type))
{
expr = convert (maybe_pad_type (etype, NULL_TREE, TYPE_ALIGN (type),
- Empty, false, false, false, true),
+ Empty, false, false, true),
expr);
return unchecked_convert (type, expr, notrunc_p);
}
@@ -5489,7 +5573,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
|| tree_int_cst_lt (TYPE_SIZE (etype), TYPE_SIZE (type))))
{
expr = convert (maybe_pad_type (etype, TYPE_SIZE (type), 0,
- Empty, false, false, false, true),
+ Empty, false, false, true),
expr);
return unchecked_convert (type, expr, notrunc_p);
}