+2012-05-06 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gcc-interface/gigi.h (make_packable_type): Declare.
+ (make_type_from_size): Likewise.
+ (relate_alias_sets): Likewise.
+ (maybe_pad_type): Adjust.
+ (init_gnat_to_gnu): Delete.
+ (destroy_gnat_to_gnu): Likewise.
+ (init_dummy_type): Likewise.
+ (destroy_dummy_type): Likewise.
+ (init_gnat_utils): Declare.
+ (destroy_gnat_utils): Likewise.
+ (ceil_pow2): New inline function.
+ * gcc-interface/decl.c (gnat_to_gnu_entity): Use ceil_pow2.
+ <object>: Pass True for the final processing of alignment and size.
+ <E_Subprogram_Type>: Only create the TYPE_DECL for a padded return
+ type if necessary.
+ (round_up_to_align): Delete.
+ (ceil_alignment): Likewise.
+ (relate_alias_sets): Move to...
+ (make_aligning_type): Likewise.
+ (make_packable_type): Likewise.
+ (maybe_pad_type): Likewise.
+ (make_type_from_size): Likewise.
+ * gcc-interface/utils.c (MAX_BITS_PER_WORD): Delete.
+ (struct pad_type_hash): New type.
+ (pad_type_hash_table): New static variable.
+ (init_gnat_to_gnu): Merge into...
+ (init_dummy_type): Likewise.
+ (init_gnat_utils): ...this. New function.
+ (destroy_gnat_to_gnu): Merge into...
+ (destroy_dummy_type): Likewise.
+ (destroy_gnat_utils): ...this. New function.
+ (pad_type_hash_marked_p): New function.
+ (pad_type_hash_hash): Likewise.
+ (pad_type_hash_eq): Likewise.
+ (relate_alias_sets): ...here.
+ (make_aligning_type): Likewise.
+ (make_packable_type): Likewise.
+ (maybe_pad_type): Likewise. Change same_rm_size parameter into
+ set_rm_size; do not set TYPE_ADA_SIZE if it is false. Do not set
+ null as Ada size. Do not set TYPE_VOLATILE on the padded type. If it
+ is complete and has constant size, canonicalize it. Bail out earlier
+ if a warning need not be issued.
+ (make_type_from_size): Likewise.
+ <INTEGER_TYPE>: Bail out if size is too large
+ (gnat_types_compatible_p): Do not deal with padded types.
+ (convert): Compare main variants for padded types.
+ * gcc-interface/trans.c (gigi): Call {init|destroy}_gnat_utils.
+ (gnat_to_gnu): Do not convert at the end for a call to a function that
+ returns an unconstrained type with default discriminant.
+ (Attribute_to_gnu) <Attr_Size>: Simplify handling of padded objects.
+ * gcc-interface/utils2.c (build_binary_op) <MODIFY_EXPR>: Likewise.
+ Do not use the padded type if it is BLKmode and the inner type is
+ non-BLKmode.
+
2012-05-02 Pascal Obry <obry@adacore.com>
Revert
static GTY ((if_marked ("tree_int_map_marked_p"),
param_is (struct tree_int_map))) htab_t annotate_value_cache;
-enum alias_set_op
-{
- ALIAS_SET_COPY,
- ALIAS_SET_SUBSET,
- ALIAS_SET_SUPERSET
-};
-
-static void relate_alias_sets (tree, tree, enum alias_set_op);
-
static bool allocatable_size_p (tree, bool);
static void prepend_one_attribute_to (struct attrib **,
enum attr_type, tree, tree, Node_Id);
static tree elaborate_expression_1 (tree, Entity_Id, tree, bool, bool);
static tree elaborate_expression_2 (tree, Entity_Id, tree, bool, bool,
unsigned int);
-static tree make_packable_type (tree, bool);
static tree gnat_to_gnu_component_type (Entity_Id, bool, bool);
static tree gnat_to_gnu_param (Entity_Id, Mechanism_Type, Entity_Id, bool,
bool *);
VEC(variant_desc,heap) *);
static tree validate_size (Uint, tree, Entity_Id, enum tree_code, bool, bool);
static void set_rm_size (Uint, tree, Entity_Id);
-static tree make_type_from_size (tree, tree, bool);
static unsigned int validate_alignment (Uint, Entity_Id, unsigned int);
-static unsigned int ceil_alignment (unsigned HOST_WIDE_INT);
static void check_ok_for_atomic (tree, Entity_Id, bool);
static tree create_field_decl_from (tree, tree, tree, tree, tree,
VEC(subst_pair,heap) *);
else if (compare_tree_int (TYPE_SIZE (gnu_type), align_cap) > 0)
align = align_cap;
else
- align = ceil_alignment (tree_low_cst (TYPE_SIZE (gnu_type), 1));
+ align = ceil_pow2 (tree_low_cst (TYPE_SIZE (gnu_type), 1));
/* But make sure not to under-align the object. */
if (align <= TYPE_ALIGN (gnu_type))
tree orig_type = gnu_type;
gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity,
- false, false, definition,
- gnu_size ? true : false);
+ 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
= validate_alignment (Alignment (gnat_entity), gnat_entity, 0);
else if (Is_Atomic (gnat_entity))
TYPE_ALIGN (gnu_type)
- = esize >= BITS_PER_WORD ? BITS_PER_WORD : ceil_alignment (esize);
+ = esize >= BITS_PER_WORD ? BITS_PER_WORD : ceil_pow2 (esize);
/* If a type needs strict alignment, the minimum size will be the
type size instead of the RM size (see validate_size). Cap the
alignment, lest it causes this type size to become too large. */
mechanism to avoid copying too much data when it returns. */
if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_return_type)))
{
+ tree orig_type = gnu_return_type;
+
gnu_return_type
= maybe_pad_type (gnu_return_type,
max_size (TYPE_SIZE (gnu_return_type),
/* Declare it now since it will never be declared otherwise.
This is necessary to ensure that its subtrees are properly
marked. */
- create_type_decl (TYPE_NAME (gnu_return_type), gnu_return_type,
- NULL, true, debug_info_p, gnat_entity);
+ if (gnu_return_type != orig_type
+ && !DECL_P (TYPE_NAME (gnu_return_type)))
+ create_type_decl (TYPE_NAME (gnu_return_type),
+ gnu_return_type, NULL, true,
+ debug_info_p, gnat_entity);
return_by_invisi_ref_p = true;
}
if (operand_equal_p (TYPE_SIZE (gnu_type), gnu_size, 0)
&& operand_equal_p (rm_size (gnu_type), gnu_size, 0))
- gnu_size = 0;
+ gnu_size = NULL_TREE;
}
/* If the alignment hasn't already been processed and this is
gnu_entity_name = DECL_NAME (gnu_entity_name);
}
+ /* Now set the RM size of the type. We cannot do it before padding
+ because we need to accept arbitrary RM sizes on integral types. */
set_rm_size (RM_Size (gnat_entity), gnu_type, gnat_entity);
/* If we are at global level, GCC will have applied variable_size to
}
}
\f
-/* Relate the alias sets of GNU_NEW_TYPE and GNU_OLD_TYPE according to OP.
- If this is a multi-dimensional array type, do this recursively.
-
- OP may be
- - ALIAS_SET_COPY: the new set is made a copy of the old one.
- - ALIAS_SET_SUPERSET: the new set is made a superset of the old one.
- - ALIAS_SET_SUBSET: the new set is made a subset of the old one. */
-
-static void
-relate_alias_sets (tree gnu_new_type, tree gnu_old_type, enum alias_set_op op)
-{
- /* Remove any padding from GNU_OLD_TYPE. It doesn't matter in the case
- of a one-dimensional array, since the padding has the same alias set
- as the field type, but if it's a multi-dimensional array, we need to
- see the inner types. */
- while (TREE_CODE (gnu_old_type) == RECORD_TYPE
- && (TYPE_JUSTIFIED_MODULAR_P (gnu_old_type)
- || TYPE_PADDING_P (gnu_old_type)))
- gnu_old_type = TREE_TYPE (TYPE_FIELDS (gnu_old_type));
-
- /* Unconstrained array types are deemed incomplete and would thus be given
- alias set 0. Retrieve the underlying array type. */
- if (TREE_CODE (gnu_old_type) == UNCONSTRAINED_ARRAY_TYPE)
- gnu_old_type
- = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_old_type))));
- if (TREE_CODE (gnu_new_type) == UNCONSTRAINED_ARRAY_TYPE)
- gnu_new_type
- = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_new_type))));
-
- if (TREE_CODE (gnu_new_type) == ARRAY_TYPE
- && TREE_CODE (TREE_TYPE (gnu_new_type)) == ARRAY_TYPE
- && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_new_type)))
- relate_alias_sets (TREE_TYPE (gnu_new_type), TREE_TYPE (gnu_old_type), op);
-
- switch (op)
- {
- case ALIAS_SET_COPY:
- /* The alias set shouldn't be copied between array types with different
- aliasing settings because this can break the aliasing relationship
- between the array type and its element type. */
-#ifndef ENABLE_CHECKING
- if (flag_strict_aliasing)
-#endif
- gcc_assert (!(TREE_CODE (gnu_new_type) == ARRAY_TYPE
- && TREE_CODE (gnu_old_type) == ARRAY_TYPE
- && TYPE_NONALIASED_COMPONENT (gnu_new_type)
- != TYPE_NONALIASED_COMPONENT (gnu_old_type)));
-
- TYPE_ALIAS_SET (gnu_new_type) = get_alias_set (gnu_old_type);
- break;
-
- case ALIAS_SET_SUBSET:
- case ALIAS_SET_SUPERSET:
- {
- alias_set_type old_set = get_alias_set (gnu_old_type);
- alias_set_type new_set = get_alias_set (gnu_new_type);
-
- /* Do nothing if the alias sets conflict. This ensures that we
- never call record_alias_subset several times for the same pair
- or at all for alias set 0. */
- if (!alias_sets_conflict_p (old_set, new_set))
- {
- if (op == ALIAS_SET_SUBSET)
- record_alias_subset (old_set, new_set);
- else
- record_alias_subset (new_set, old_set);
- }
- }
- break;
-
- default:
- gcc_unreachable ();
- }
-
- record_component_aliases (gnu_new_type);
-}
-\f
/* Return true if the size represented by GNU_SIZE can be handled by an
allocation. If STATIC_P is true, consider only what can be done with a
static allocation. */
unit_align);
}
\f
-/* Create a record type that contains a SIZE bytes long field of TYPE with a
- starting bit position so that it is aligned to ALIGN bits, and leaving at
- least ROOM bytes free before the field. BASE_ALIGN is the alignment the
- record is guaranteed to get. */
-
-tree
-make_aligning_type (tree type, unsigned int align, tree size,
- unsigned int base_align, int room)
-{
- /* We will be crafting a record type with one field at a position set to be
- the next multiple of ALIGN past record'address + room bytes. We use a
- record placeholder to express record'address. */
- tree record_type = make_node (RECORD_TYPE);
- tree record = build0 (PLACEHOLDER_EXPR, record_type);
-
- tree record_addr_st
- = convert (sizetype, build_unary_op (ADDR_EXPR, NULL_TREE, record));
-
- /* The diagram below summarizes the shape of what we manipulate:
-
- <--------- pos ---------->
- { +------------+-------------+-----------------+
- record =>{ |############| ... | field (type) |
- { +------------+-------------+-----------------+
- |<-- room -->|<- voffset ->|<---- size ----->|
- o o
- | |
- record_addr vblock_addr
-
- Every length is in sizetype bytes there, except "pos" which has to be
- set as a bit position in the GCC tree for the record. */
- tree room_st = size_int (room);
- tree vblock_addr_st = size_binop (PLUS_EXPR, record_addr_st, room_st);
- tree voffset_st, pos, field;
-
- tree name = TYPE_NAME (type);
-
- if (TREE_CODE (name) == TYPE_DECL)
- name = DECL_NAME (name);
- name = concat_name (name, "ALIGN");
- TYPE_NAME (record_type) = name;
-
- /* Compute VOFFSET and then POS. The next byte position multiple of some
- alignment after some address is obtained by "and"ing the alignment minus
- 1 with the two's complement of the address. */
- voffset_st = size_binop (BIT_AND_EXPR,
- fold_build1 (NEGATE_EXPR, sizetype, vblock_addr_st),
- size_int ((align / BITS_PER_UNIT) - 1));
-
- /* POS = (ROOM + VOFFSET) * BIT_PER_UNIT, in bitsizetype. */
- pos = size_binop (MULT_EXPR,
- convert (bitsizetype,
- size_binop (PLUS_EXPR, room_st, voffset_st)),
- bitsize_unit_node);
-
- /* Craft the GCC record representation. We exceptionally do everything
- manually here because 1) our generic circuitry is not quite ready to
- handle the complex position/size expressions we are setting up, 2) we
- have a strong simplifying factor at hand: we know the maximum possible
- value of voffset, and 3) we have to set/reset at least the sizes in
- accordance with this maximum value anyway, as we need them to convey
- what should be "alloc"ated for this type.
-
- Use -1 as the 'addressable' indication for the field to prevent the
- creation of a bitfield. We don't need one, it would have damaging
- consequences on the alignment computation, and create_field_decl would
- make one without this special argument, for instance because of the
- complex position expression. */
- field = create_field_decl (get_identifier ("F"), type, record_type, size,
- pos, 1, -1);
- TYPE_FIELDS (record_type) = field;
-
- TYPE_ALIGN (record_type) = base_align;
- TYPE_USER_ALIGN (record_type) = 1;
-
- TYPE_SIZE (record_type)
- = size_binop (PLUS_EXPR,
- size_binop (MULT_EXPR, convert (bitsizetype, size),
- bitsize_unit_node),
- bitsize_int (align + room * BITS_PER_UNIT));
- TYPE_SIZE_UNIT (record_type)
- = size_binop (PLUS_EXPR, size,
- size_int (room + align / BITS_PER_UNIT));
-
- SET_TYPE_MODE (record_type, BLKmode);
- relate_alias_sets (record_type, type, ALIAS_SET_COPY);
-
- /* Declare it now since it will never be declared otherwise. This is
- necessary to ensure that its subtrees are properly marked. */
- create_type_decl (name, record_type, NULL, true, false, Empty);
-
- return record_type;
-}
-\f
-/* Return the result of rounding T up to ALIGN. */
-
-static inline unsigned HOST_WIDE_INT
-round_up_to_align (unsigned HOST_WIDE_INT t, unsigned int align)
-{
- t += align - 1;
- t /= align;
- t *= align;
- return t;
-}
-
-/* TYPE is a RECORD_TYPE, UNION_TYPE or QUAL_UNION_TYPE that is being used
- as the field type of a packed record if IN_RECORD is true, or as the
- component type of a packed array if IN_RECORD is false. See if we can
- rewrite it either as a type that has a non-BLKmode, which we can pack
- tighter in the packed record case, or as a smaller type. If so, return
- the new type. If not, return the original type. */
-
-static tree
-make_packable_type (tree type, bool in_record)
-{
- unsigned HOST_WIDE_INT size = tree_low_cst (TYPE_SIZE (type), 1);
- unsigned HOST_WIDE_INT new_size;
- tree new_type, old_field, field_list = NULL_TREE;
-
- /* No point in doing anything if the size is zero. */
- if (size == 0)
- return type;
-
- new_type = make_node (TREE_CODE (type));
-
- /* Copy the name and flags from the old type to that of the new.
- Note that we rely on the pointer equality created here for
- TYPE_NAME to look through conversions in various places. */
- TYPE_NAME (new_type) = TYPE_NAME (type);
- TYPE_JUSTIFIED_MODULAR_P (new_type) = TYPE_JUSTIFIED_MODULAR_P (type);
- TYPE_CONTAINS_TEMPLATE_P (new_type) = TYPE_CONTAINS_TEMPLATE_P (type);
- if (TREE_CODE (type) == RECORD_TYPE)
- TYPE_PADDING_P (new_type) = TYPE_PADDING_P (type);
-
- /* If we are in a record and have a small size, set the alignment to
- try for an integral mode. Otherwise set it to try for a smaller
- type with BLKmode. */
- if (in_record && size <= MAX_FIXED_MODE_SIZE)
- {
- TYPE_ALIGN (new_type) = ceil_alignment (size);
- new_size = round_up_to_align (size, TYPE_ALIGN (new_type));
- }
- else
- {
- unsigned HOST_WIDE_INT align;
-
- /* Do not try to shrink the size if the RM size is not constant. */
- if (TYPE_CONTAINS_TEMPLATE_P (type)
- || !host_integerp (TYPE_ADA_SIZE (type), 1))
- 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. */
- new_size = TREE_INT_CST_LOW (TYPE_ADA_SIZE (type));
- new_size = round_up_to_align (new_size, BITS_PER_UNIT);
- if (new_size == size)
- return type;
-
- align = new_size & -new_size;
- TYPE_ALIGN (new_type) = MIN (TYPE_ALIGN (type), align);
- }
-
- TYPE_USER_ALIGN (new_type) = 1;
-
- /* Now copy the fields, keeping the position and size as we don't want
- to change the layout by propagating the packedness downwards. */
- for (old_field = TYPE_FIELDS (type); old_field;
- old_field = DECL_CHAIN (old_field))
- {
- tree new_field_type = TREE_TYPE (old_field);
- tree new_field, new_size;
-
- if (RECORD_OR_UNION_TYPE_P (new_field_type)
- && !TYPE_FAT_POINTER_P (new_field_type)
- && host_integerp (TYPE_SIZE (new_field_type), 1))
- new_field_type = make_packable_type (new_field_type, true);
-
- /* However, for the last field in a not already packed record type
- that is of an aggregate type, we need to use the RM size in the
- packable version of the record type, see finish_record_type. */
- if (!DECL_CHAIN (old_field)
- && !TYPE_PACKED (type)
- && RECORD_OR_UNION_TYPE_P (new_field_type)
- && !TYPE_FAT_POINTER_P (new_field_type)
- && !TYPE_CONTAINS_TEMPLATE_P (new_field_type)
- && TYPE_ADA_SIZE (new_field_type))
- new_size = TYPE_ADA_SIZE (new_field_type);
- else
- new_size = DECL_SIZE (old_field);
-
- new_field
- = create_field_decl (DECL_NAME (old_field), new_field_type, new_type,
- new_size, bit_position (old_field),
- TYPE_PACKED (type),
- !DECL_NONADDRESSABLE_P (old_field));
-
- DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field);
- SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, old_field);
- if (TREE_CODE (new_type) == QUAL_UNION_TYPE)
- DECL_QUALIFIER (new_field) = DECL_QUALIFIER (old_field);
-
- DECL_CHAIN (new_field) = field_list;
- field_list = new_field;
- }
-
- finish_record_type (new_type, nreverse (field_list), 2, false);
- relate_alias_sets (new_type, type, ALIAS_SET_COPY);
- SET_DECL_PARALLEL_TYPE (TYPE_STUB_DECL (new_type),
- DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type)));
-
- /* If this is a padding record, we never want to make the size smaller
- than what was specified. For QUAL_UNION_TYPE, also copy the size. */
- if (TYPE_IS_PADDING_P (type) || TREE_CODE (type) == QUAL_UNION_TYPE)
- {
- TYPE_SIZE (new_type) = TYPE_SIZE (type);
- TYPE_SIZE_UNIT (new_type) = TYPE_SIZE_UNIT (type);
- new_size = size;
- }
- else
- {
- TYPE_SIZE (new_type) = bitsize_int (new_size);
- TYPE_SIZE_UNIT (new_type)
- = size_int ((new_size + BITS_PER_UNIT - 1) / BITS_PER_UNIT);
- }
-
- if (!TYPE_CONTAINS_TEMPLATE_P (type))
- SET_TYPE_ADA_SIZE (new_type, TYPE_ADA_SIZE (type));
-
- compute_record_mode (new_type);
-
- /* 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), MODE_INT, 1));
-
- /* If neither the mode nor the size has shrunk, return the old type. */
- if (TYPE_MODE (new_type) == BLKmode && new_size >= size)
- return type;
-
- return new_type;
-}
-\f
-/* Ensure that TYPE has SIZE and ALIGN. Make and return a new padded type
- if needed. We have already verified that SIZE and TYPE 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 we must complete the original type.
- DEFINITION is true if this type is being defined. SAME_RM_SIZE is true
- if the RM size of the resulting type is to be set to SIZE too; otherwise,
- it's set to the RM size of the original type. */
-
-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 same_rm_size)
-{
- tree orig_rm_size = same_rm_size ? NULL_TREE : rm_size (type);
- tree orig_size = TYPE_SIZE (type);
- tree record, field;
-
- /* If TYPE is a padded type, see if it agrees with any size and alignment
- we were given. If so, return the original type. Otherwise, strip
- off the padding, since we will either be returning the inner type
- or repadding it. If no size or alignment is specified, use that of
- the original padded type. */
- if (TYPE_IS_PADDING_P (type))
- {
- if ((!size
- || operand_equal_p (round_up (size,
- MAX (align, TYPE_ALIGN (type))),
- round_up (TYPE_SIZE (type),
- MAX (align, TYPE_ALIGN (type))),
- 0))
- && (align == 0 || align == TYPE_ALIGN (type)))
- return type;
-
- if (!size)
- size = TYPE_SIZE (type);
- if (align == 0)
- align = TYPE_ALIGN (type);
-
- type = TREE_TYPE (TYPE_FIELDS (type));
- orig_size = TYPE_SIZE (type);
- }
-
- /* If the size is either not being changed or is being made smaller (which
- is not done here and is only valid for bitfields anyway), show the size
- isn't changing. Likewise, clear the alignment if it isn't being
- changed. Then return if we aren't doing anything. */
- if (size
- && (operand_equal_p (size, orig_size, 0)
- || (TREE_CODE (orig_size) == INTEGER_CST
- && tree_int_cst_lt (size, orig_size))))
- size = NULL_TREE;
-
- if (align == TYPE_ALIGN (type))
- align = 0;
-
- 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,
- NULL, !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;
-
- if (Present (gnat_entity))
- TYPE_NAME (record) = create_concat_name (gnat_entity, "PAD");
-
- TYPE_VOLATILE (record)
- = Present (gnat_entity) && Treat_As_Volatile (gnat_entity);
-
- TYPE_ALIGN (record) = align;
- TYPE_SIZE (record) = size ? size : orig_size;
- TYPE_SIZE_UNIT (record)
- = convert (sizetype,
- size_binop (CEIL_DIV_EXPR, TYPE_SIZE (record),
- bitsize_unit_node));
-
- /* If we are changing the alignment and the input type is a record with
- BLKmode and a small constant size, try to make a form that has an
- integral mode. This might allow the padding record to also have an
- integral mode, which will be much more efficient. There is no point
- in doing so if a size is specified unless it is also a small constant
- size and it is incorrect to do so if we cannot guarantee that the mode
- will be naturally aligned since the field must always be addressable.
-
- ??? This might not always be a win when done for a stand-alone object:
- since the nominal and the effective type of the object will now have
- different modes, a VIEW_CONVERT_EXPR will be required for converting
- between them and it might be hard to overcome afterwards, including
- at the RTL level when the stand-alone object is accessed as a whole. */
- if (align != 0
- && RECORD_OR_UNION_TYPE_P (type)
- && TYPE_MODE (type) == BLKmode
- && !TYPE_BY_REFERENCE_P (type)
- && TREE_CODE (orig_size) == INTEGER_CST
- && !TREE_OVERFLOW (orig_size)
- && compare_tree_int (orig_size, MAX_FIXED_MODE_SIZE) <= 0
- && (!size
- || (TREE_CODE (size) == INTEGER_CST
- && compare_tree_int (size, MAX_FIXED_MODE_SIZE) <= 0)))
- {
- tree packable_type = make_packable_type (type, true);
- if (TYPE_MODE (packable_type) != BLKmode
- && align >= TYPE_ALIGN (packable_type))
- type = packable_type;
- }
-
- /* Now create the field with the original size. */
- field = create_field_decl (get_identifier ("F"), type, record, orig_size,
- bitsize_zero_node, 0, 1);
- DECL_INTERNAL_P (field) = 1;
-
- /* Do not emit debug info until after the auxiliary record is built. */
- finish_record_type (record, field, 1, false);
-
- /* Set the same size for its RM size if requested; otherwise reuse
- the RM size of the original type. */
- SET_TYPE_ADA_SIZE (record, same_rm_size ? size : orig_rm_size);
-
- /* 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. */
- if (TREE_CODE (orig_size) != INTEGER_CST
- && TYPE_NAME (record)
- && TYPE_NAME (type)
- && !(TREE_CODE (TYPE_NAME (type)) == TYPE_DECL
- && DECL_IGNORED_P (TYPE_NAME (type))))
- {
- tree marker = make_node (RECORD_TYPE);
- tree name = TYPE_NAME (record);
- tree orig_name = TYPE_NAME (type);
-
- if (TREE_CODE (name) == TYPE_DECL)
- name = DECL_NAME (name);
-
- if (TREE_CODE (orig_name) == TYPE_DECL)
- orig_name = DECL_NAME (orig_name);
-
- TYPE_NAME (marker) = concat_name (name, "XVS");
- finish_record_type (marker,
- create_field_decl (orig_name,
- build_reference_type (type),
- marker, NULL_TREE, NULL_TREE,
- 0, 0),
- 0, true);
-
- add_parallel_type (record, marker);
-
- if (definition && size && TREE_CODE (size) != INTEGER_CST)
- TYPE_SIZE_UNIT (marker)
- = create_var_decl (concat_name (name, "XVZ"), NULL_TREE, sizetype,
- TYPE_SIZE_UNIT (record), false, false, false,
- false, NULL, gnat_entity);
- }
-
- rest_of_record_type_compilation (record);
-
- /* If the size was widened explicitly, maybe give a warning. Take the
- original size as the maximum size of the input if there was an
- unconstrained record involved and round it up to the specified alignment,
- if one was specified. But don't do it if we are just annotating types
- and the type is tagged, since tagged types aren't fully laid out in this
- mode. */
- if (CONTAINS_PLACEHOLDER_P (orig_size))
- orig_size = max_size (orig_size, true);
-
- if (align)
- orig_size = round_up (orig_size, align);
-
- if (Present (gnat_entity)
- && size
- && TREE_CODE (size) != MAX_EXPR
- && TREE_CODE (size) != COND_EXPR
- && !operand_equal_p (size, orig_size, 0)
- && !(TREE_CODE (size) == INTEGER_CST
- && TREE_CODE (orig_size) == INTEGER_CST
- && (TREE_OVERFLOW (size)
- || TREE_OVERFLOW (orig_size)
- || tree_int_cst_lt (size, orig_size)))
- && !(type_annotate_only && Is_Tagged_Type (Etype (gnat_entity))))
- {
- Node_Id gnat_error_node = Empty;
-
- if (Is_Packed_Array_Type (gnat_entity))
- gnat_entity = Original_Array_Type (gnat_entity);
-
- if ((Ekind (gnat_entity) == E_Component
- || Ekind (gnat_entity) == E_Discriminant)
- && Present (Component_Clause (gnat_entity)))
- gnat_error_node = Last_Bit (Component_Clause (gnat_entity));
- else if (Present (Size_Clause (gnat_entity)))
- gnat_error_node = Expression (Size_Clause (gnat_entity));
-
- /* Generate message only for entities that come from source, since
- if we have an entity created by expansion, the message will be
- generated for some other corresponding source entity. */
- if (Comes_From_Source (gnat_entity))
- {
- if (Present (gnat_error_node))
- post_error_ne_tree ("{^ }bits of & unused?",
- gnat_error_node, gnat_entity,
- size_diffop (size, orig_size));
- else if (is_component_type)
- post_error_ne_tree ("component of& padded{ by ^ bits}?",
- gnat_entity, gnat_entity,
- size_diffop (size, orig_size));
- }
- }
-
- return record;
-}
-\f
/* Given a GNU tree and a GNAT list of choices, generate an expression to test
the value passed against the list of choices. */
SET_TYPE_ADA_SIZE (gnu_type, size);
}
\f
-/* Given a type TYPE, return a new type whose size is appropriate for SIZE.
- If TYPE is the best type, return it. Otherwise, make a new type. We
- only support new integral and pointer types. FOR_BIASED is true if
- we are making a biased type. */
-
-static tree
-make_type_from_size (tree type, tree size_tree, bool for_biased)
-{
- unsigned HOST_WIDE_INT size;
- bool biased_p;
- tree new_type;
-
- /* If size indicates an error, just return TYPE to avoid propagating
- the error. Likewise if it's too large to represent. */
- if (!size_tree || !host_integerp (size_tree, 1))
- return type;
-
- size = tree_low_cst (size_tree, 1);
-
- switch (TREE_CODE (type))
- {
- case INTEGER_TYPE:
- case ENUMERAL_TYPE:
- case BOOLEAN_TYPE:
- biased_p = (TREE_CODE (type) == INTEGER_TYPE
- && TYPE_BIASED_REPRESENTATION_P (type));
-
- /* Integer types with precision 0 are forbidden. */
- if (size == 0)
- size = 1;
-
- /* Only do something if the type is not a packed array type and
- doesn't already have the proper size. */
- if (TYPE_IS_PACKED_ARRAY_TYPE_P (type)
- || (TYPE_PRECISION (type) == size && biased_p == for_biased))
- break;
-
- biased_p |= for_biased;
- if (size > LONG_LONG_TYPE_SIZE)
- size = LONG_LONG_TYPE_SIZE;
-
- if (TYPE_UNSIGNED (type) || biased_p)
- new_type = make_unsigned_type (size);
- else
- new_type = make_signed_type (size);
- TREE_TYPE (new_type) = TREE_TYPE (type) ? TREE_TYPE (type) : type;
- SET_TYPE_RM_MIN_VALUE (new_type,
- convert (TREE_TYPE (new_type),
- TYPE_MIN_VALUE (type)));
- SET_TYPE_RM_MAX_VALUE (new_type,
- convert (TREE_TYPE (new_type),
- TYPE_MAX_VALUE (type)));
- /* Copy the name to show that it's essentially the same type and
- not a subrange type. */
- TYPE_NAME (new_type) = TYPE_NAME (type);
- TYPE_BIASED_REPRESENTATION_P (new_type) = biased_p;
- SET_TYPE_RM_SIZE (new_type, bitsize_int (size));
- return new_type;
-
- case RECORD_TYPE:
- /* Do something if this is a fat pointer, in which case we
- may need to return the thin pointer. */
- if (TYPE_FAT_POINTER_P (type) && size < POINTER_SIZE * 2)
- {
- enum machine_mode p_mode = mode_for_size (size, MODE_INT, 0);
- if (!targetm.valid_pointer_mode (p_mode))
- p_mode = ptr_mode;
- return
- build_pointer_type_for_mode
- (TYPE_OBJECT_RECORD_TYPE (TYPE_UNCONSTRAINED_ARRAY (type)),
- p_mode, 0);
- }
- break;
-
- case POINTER_TYPE:
- /* Only do something if this is a thin pointer, in which case we
- may need to return the fat pointer. */
- if (TYPE_IS_THIN_POINTER_P (type) && size >= POINTER_SIZE * 2)
- return
- build_pointer_type (TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (type)));
- break;
-
- default:
- break;
- }
-
- return type;
-}
-\f
/* ALIGNMENT is a Uint giving the alignment specified for GNAT_ENTITY,
a type or object whose present alignment is ALIGN. If this alignment is
valid, return it. Otherwise, give an error and return ALIGN. */
return align;
}
-
-/* Return the smallest alignment not less than SIZE. */
-
-static unsigned int
-ceil_alignment (unsigned HOST_WIDE_INT size)
-{
- return (unsigned int) 1 << (floor_log2 (size - 1) + 1);
-}
\f
/* Verify that OBJECT, a type or decl, is something we can implement
atomically. If not, give an error for GNAT_ENTITY. COMP_P is true
extern tree make_aligning_type (tree type, unsigned int align, tree size,
unsigned int base_align, int room);
+/* TYPE is a RECORD_TYPE, UNION_TYPE or QUAL_UNION_TYPE that is being used
+ as the field type of a packed record if IN_RECORD is true, or as the
+ component type of a packed array if IN_RECORD is false. See if we can
+ rewrite it either as a type that has a non-BLKmode, which we can pack
+ tighter in the packed record case, or as a smaller type. If so, return
+ the new type. If not, return the original type. */
+extern tree make_packable_type (tree type, bool in_record);
+
+/* Given a type TYPE, return a new type whose size is appropriate for SIZE.
+ If TYPE is the best type, return it. Otherwise, make a new type. We
+ only support new integral and pointer types. FOR_BIASED is true if
+ we are making a biased type. */
+extern tree make_type_from_size (tree type, tree size_tree, bool for_biased);
+
/* Ensure that TYPE has SIZE and ALIGN. Make and return a new padded type
if needed. We have already verified that SIZE and TYPE 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 we must complete the original type.
- DEFINITION is true if this type is being defined. SAME_RM_SIZE is true
- if the RM size of the resulting type is to be set to SIZE too; otherwise,
- it's set to the RM size of the original type. */
+ 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. */
extern 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 same_rm_size);
+ bool set_rm_size);
+
+enum alias_set_op
+{
+ ALIAS_SET_COPY,
+ ALIAS_SET_SUBSET,
+ ALIAS_SET_SUPERSET
+};
+
+/* Relate the alias sets of GNU_NEW_TYPE and GNU_OLD_TYPE according to OP.
+ If this is a multi-dimensional array type, do this recursively.
+
+ OP may be
+ - ALIAS_SET_COPY: the new set is made a copy of the old one.
+ - ALIAS_SET_SUPERSET: the new set is made a superset of the old one.
+ - ALIAS_SET_SUBSET: the new set is made a subset of the old one. */
+extern void relate_alias_sets (tree gnu_new_type, tree gnu_old_type,
+ enum alias_set_op op);
/* Given a GNU tree and a GNAT list of choices, generate an expression to test
the value passed against the list of choices. */
/* Routines created solely for the tree translator's sake. Their prototypes
can be changed as desired. */
-/* Initialize the association of GNAT nodes to GCC trees. */
-extern void init_gnat_to_gnu (void);
+/* Initialize data structures of the utils.c module. */
+extern void init_gnat_utils (void);
-/* Destroy the association of GNAT nodes to GCC trees. */
-extern void destroy_gnat_to_gnu (void);
+/* Destroy data structures of the utils.c module. */
+extern void destroy_gnat_utils (void);
/* GNAT_ENTITY is a GNAT tree node for a defining identifier.
GNU_DECL is the GCC tree which is to be associated with
/* Return nonzero if a GCC tree has been associated with GNAT_ENTITY. */
extern bool present_gnu_tree (Entity_Id gnat_entity);
-/* Initialize the association of GNAT nodes to GCC trees as dummies. */
-extern void init_dummy_type (void);
-
-/* Destroy the association of GNAT nodes to GCC trees as dummies. */
-extern void destroy_dummy_type (void);
-
/* Make a dummy type corresponding to GNAT_TYPE. */
extern tree make_dummy_type (Entity_Id gnat_type);
/* Convenient shortcuts. */
#define VECTOR_TYPE_P(TYPE) (TREE_CODE (TYPE) == VECTOR_TYPE)
+
+static inline unsigned HOST_WIDE_INT
+ceil_pow2 (unsigned HOST_WIDE_INT x)
+{
+ return (unsigned HOST_WIDE_INT) 1 << (floor_log2 (x - 1) + 1);
+}
/* Initialize ourselves. */
init_code_table ();
- init_gnat_to_gnu ();
- init_dummy_type ();
+ init_gnat_utils ();
/* If we are just annotating types, give VOID_TYPE zero sizes to avoid
errors. */
}
/* Destroy ourselves. */
- destroy_gnat_to_gnu ();
- destroy_dummy_type ();
+ destroy_gnat_utils ();
/* We cannot track the location of errors past this point. */
error_gnat_node = Empty;
gnu_type = TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (gnu_type)));
}
- /* If we're looking for the size of a field, return the field size.
- Otherwise, if the prefix is an object, or if we're looking for
- 'Object_Size or 'Max_Size_In_Storage_Elements, the result is the
- GCC size of the type. Otherwise, it is the RM size of the type. */
+ /* If we're looking for the size of a field, return the field size. */
if (TREE_CODE (gnu_prefix) == COMPONENT_REF)
gnu_result = DECL_SIZE (TREE_OPERAND (gnu_prefix, 1));
- else if (TREE_CODE (gnu_prefix) != TYPE_DECL
+
+ /* Otherwise, if the prefix is an object, or if we are looking for
+ 'Object_Size or 'Max_Size_In_Storage_Elements, the result is the
+ GCC size of the type. We make an exception for padded objects,
+ as we do not take into account alignment promotions for the size.
+ 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))
|| attribute == Attr_Object_Size
|| attribute == Attr_Max_Size_In_Storage_Elements)
{
- /* If the prefix is an object of a padded type, the GCC size isn't
- relevant to the programmer. Normally what we want is the RM size,
- which was set from the specified size, but if it was not set, we
- want the size of the field. Using the MAX of those two produces
- the right result in all cases. Don't use the size of the field
- if it's self-referential, since that's never what's wanted. */
- if (TREE_CODE (gnu_prefix) != TYPE_DECL
- && TYPE_IS_PADDING_P (gnu_type)
- && TREE_CODE (gnu_expr) == COMPONENT_REF)
- {
- gnu_result = rm_size (gnu_type);
- if (!CONTAINS_PLACEHOLDER_P
- (DECL_SIZE (TREE_OPERAND (gnu_expr, 1))))
- gnu_result
- = size_binop (MAX_EXPR, gnu_result,
- DECL_SIZE (TREE_OPERAND (gnu_expr, 1)));
- }
- else if (Nkind (Prefix (gnat_node)) == N_Explicit_Dereference)
+ /* If this is a dereference and we have a special dynamic constrained
+ subtype on the prefix, use it to compute the size; otherwise, use
+ the designated subtype. */
+ if (Nkind (Prefix (gnat_node)) == N_Explicit_Dereference)
{
Node_Id gnat_deref = Prefix (gnat_node);
Node_Id gnat_actual_subtype
get_identifier ("SIZE"),
false);
}
-
- gnu_result = TYPE_SIZE (gnu_type);
}
- else
- gnu_result = TYPE_SIZE (gnu_type);
+
+ gnu_result = TYPE_SIZE (gnu_type);
}
+
+ /* Otherwise, the result is the RM size of the type. */
else
gnu_result = rm_size (gnu_type);
else if (TREE_CODE (gnu_result) == CALL_EXPR
&& TYPE_IS_PADDING_P (TREE_TYPE (gnu_result))
+ && TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_result)))
+ == gnu_result_type
&& CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type)))
- {
- /* ??? We need to convert if the padded type has fixed size because
- gnat_types_compatible_p will say that padded types are compatible
- but the gimplifier will not and, therefore, will ultimately choke
- if there isn't a conversion added early. */
- if (TREE_CODE (TYPE_SIZE (TREE_TYPE (gnu_result))) == INTEGER_CST)
- gnu_result = convert (gnu_result_type, gnu_result);
- }
+ ;
else if (TREE_TYPE (gnu_result) != gnu_result_type)
gnu_result = convert (gnu_result_type, gnu_result);
#include "ada-tree.h"
#include "gigi.h"
-#ifndef MAX_BITS_PER_WORD
-#define MAX_BITS_PER_WORD BITS_PER_WORD
-#endif
-
/* If nonzero, pretend we are allocating at global level. */
int force_global;
/* A chain of unused BLOCK nodes. */
static GTY((deletable)) tree free_block_chain;
+static int pad_type_hash_marked_p (const void *p);
+static hashval_t pad_type_hash_hash (const void *p);
+static int pad_type_hash_eq (const void *p1, const void *p2);
+
+/* 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. */
+struct GTY(()) pad_type_hash {
+ unsigned long hash;
+ tree type;
+};
+
+static GTY ((if_marked ("pad_type_hash_marked_p"),
+ param_is (struct pad_type_hash)))
+ htab_t pad_type_hash_table;
+
static tree merge_sizes (tree, tree, tree, bool, bool);
static tree compute_related_constant (tree, tree);
static tree split_plus (tree, tree *);
static bool potential_alignment_gap (tree, tree, tree);
static void process_attributes (tree, struct attrib *);
\f
-/* Initialize the association of GNAT nodes to GCC trees. */
+/* Initialize data structures of the utils.c module. */
void
-init_gnat_to_gnu (void)
+init_gnat_utils (void)
{
+ /* Initialize the association of GNAT nodes to GCC trees. */
associate_gnat_to_gnu = ggc_alloc_cleared_vec_tree (max_gnat_nodes);
+
+ /* Initialize the association of GNAT nodes to GCC trees as dummies. */
+ dummy_node_table = ggc_alloc_cleared_vec_tree (max_gnat_nodes);
+
+ /* Initialize the hash table of padded types. */
+ pad_type_hash_table = htab_create_ggc (512, pad_type_hash_hash,
+ pad_type_hash_eq, 0);
}
-/* Destroy the association of GNAT nodes to GCC trees. */
+/* Destroy data structures of the utils.c module. */
void
-destroy_gnat_to_gnu (void)
+destroy_gnat_utils (void)
{
+ /* Destroy the association of GNAT nodes to GCC trees. */
ggc_free (associate_gnat_to_gnu);
associate_gnat_to_gnu = NULL;
-}
+ /* Destroy the association of GNAT nodes to GCC trees as dummies. */
+ ggc_free (dummy_node_table);
+ dummy_node_table = NULL;
+
+ /* Destroy the hash table of padded types. */
+ htab_delete (pad_type_hash_table);
+ pad_type_hash_table = NULL;
+
+ /* Invalidate the global renaming pointers. */
+ invalidate_global_renaming_pointers ();
+}
+\f
/* GNAT_ENTITY is a GNAT tree node for an entity. Associate GNU_DECL, a GCC
tree node, with GNAT_ENTITY. If GNU_DECL is not a ..._DECL node, abort.
If NO_CHECK is true, the latter check is suppressed.
return PRESENT_GNU_TREE (gnat_entity);
}
\f
-/* Initialize the association of GNAT nodes to GCC trees as dummies. */
-
-void
-init_dummy_type (void)
-{
- dummy_node_table = ggc_alloc_cleared_vec_tree (max_gnat_nodes);
-}
-
-/* Destroy the association of GNAT nodes to GCC trees as dummies. */
-
-void
-destroy_dummy_type (void)
-{
- ggc_free (dummy_node_table);
- dummy_node_table = NULL;
-}
-
/* Make a dummy type corresponding to GNAT_TYPE. */
tree
}
}
\f
+/* Create a record type that contains a SIZE bytes long field of TYPE with a
+ starting bit position so that it is aligned to ALIGN bits, and leaving at
+ least ROOM bytes free before the field. BASE_ALIGN is the alignment the
+ record is guaranteed to get. */
+
+tree
+make_aligning_type (tree type, unsigned int align, tree size,
+ unsigned int base_align, int room)
+{
+ /* We will be crafting a record type with one field at a position set to be
+ the next multiple of ALIGN past record'address + room bytes. We use a
+ record placeholder to express record'address. */
+ tree record_type = make_node (RECORD_TYPE);
+ tree record = build0 (PLACEHOLDER_EXPR, record_type);
+
+ tree record_addr_st
+ = convert (sizetype, build_unary_op (ADDR_EXPR, NULL_TREE, record));
+
+ /* The diagram below summarizes the shape of what we manipulate:
+
+ <--------- pos ---------->
+ { +------------+-------------+-----------------+
+ record =>{ |############| ... | field (type) |
+ { +------------+-------------+-----------------+
+ |<-- room -->|<- voffset ->|<---- size ----->|
+ o o
+ | |
+ record_addr vblock_addr
+
+ Every length is in sizetype bytes there, except "pos" which has to be
+ set as a bit position in the GCC tree for the record. */
+ tree room_st = size_int (room);
+ tree vblock_addr_st = size_binop (PLUS_EXPR, record_addr_st, room_st);
+ tree voffset_st, pos, field;
+
+ tree name = TYPE_NAME (type);
+
+ if (TREE_CODE (name) == TYPE_DECL)
+ name = DECL_NAME (name);
+ name = concat_name (name, "ALIGN");
+ TYPE_NAME (record_type) = name;
+
+ /* Compute VOFFSET and then POS. The next byte position multiple of some
+ alignment after some address is obtained by "and"ing the alignment minus
+ 1 with the two's complement of the address. */
+ voffset_st = size_binop (BIT_AND_EXPR,
+ fold_build1 (NEGATE_EXPR, sizetype, vblock_addr_st),
+ size_int ((align / BITS_PER_UNIT) - 1));
+
+ /* POS = (ROOM + VOFFSET) * BIT_PER_UNIT, in bitsizetype. */
+ pos = size_binop (MULT_EXPR,
+ convert (bitsizetype,
+ size_binop (PLUS_EXPR, room_st, voffset_st)),
+ bitsize_unit_node);
+
+ /* Craft the GCC record representation. We exceptionally do everything
+ manually here because 1) our generic circuitry is not quite ready to
+ handle the complex position/size expressions we are setting up, 2) we
+ have a strong simplifying factor at hand: we know the maximum possible
+ value of voffset, and 3) we have to set/reset at least the sizes in
+ accordance with this maximum value anyway, as we need them to convey
+ what should be "alloc"ated for this type.
+
+ Use -1 as the 'addressable' indication for the field to prevent the
+ creation of a bitfield. We don't need one, it would have damaging
+ consequences on the alignment computation, and create_field_decl would
+ make one without this special argument, for instance because of the
+ complex position expression. */
+ field = create_field_decl (get_identifier ("F"), type, record_type, size,
+ pos, 1, -1);
+ TYPE_FIELDS (record_type) = field;
+
+ TYPE_ALIGN (record_type) = base_align;
+ TYPE_USER_ALIGN (record_type) = 1;
+
+ TYPE_SIZE (record_type)
+ = size_binop (PLUS_EXPR,
+ size_binop (MULT_EXPR, convert (bitsizetype, size),
+ bitsize_unit_node),
+ bitsize_int (align + room * BITS_PER_UNIT));
+ TYPE_SIZE_UNIT (record_type)
+ = size_binop (PLUS_EXPR, size,
+ size_int (room + align / BITS_PER_UNIT));
+
+ SET_TYPE_MODE (record_type, BLKmode);
+ relate_alias_sets (record_type, type, ALIAS_SET_COPY);
+
+ /* Declare it now since it will never be declared otherwise. This is
+ necessary to ensure that its subtrees are properly marked. */
+ create_type_decl (name, record_type, NULL, true, false, Empty);
+
+ return record_type;
+}
+
+/* TYPE is a RECORD_TYPE, UNION_TYPE or QUAL_UNION_TYPE that is being used
+ as the field type of a packed record if IN_RECORD is true, or as the
+ component type of a packed array if IN_RECORD is false. See if we can
+ rewrite it either as a type that has a non-BLKmode, which we can pack
+ tighter in the packed record case, or as a smaller type. If so, return
+ the new type. If not, return the original type. */
+
+tree
+make_packable_type (tree type, bool in_record)
+{
+ unsigned HOST_WIDE_INT size = tree_low_cst (TYPE_SIZE (type), 1);
+ unsigned HOST_WIDE_INT new_size;
+ tree new_type, old_field, field_list = NULL_TREE;
+ unsigned int align;
+
+ /* No point in doing anything if the size is zero. */
+ if (size == 0)
+ return type;
+
+ new_type = make_node (TREE_CODE (type));
+
+ /* Copy the name and flags from the old type to that of the new.
+ Note that we rely on the pointer equality created here for
+ TYPE_NAME to look through conversions in various places. */
+ TYPE_NAME (new_type) = TYPE_NAME (type);
+ TYPE_JUSTIFIED_MODULAR_P (new_type) = TYPE_JUSTIFIED_MODULAR_P (type);
+ TYPE_CONTAINS_TEMPLATE_P (new_type) = TYPE_CONTAINS_TEMPLATE_P (type);
+ if (TREE_CODE (type) == RECORD_TYPE)
+ TYPE_PADDING_P (new_type) = TYPE_PADDING_P (type);
+
+ /* If we are in a record and have a small size, set the alignment to
+ try for an integral mode. Otherwise set it to try for a smaller
+ type with BLKmode. */
+ if (in_record && size <= MAX_FIXED_MODE_SIZE)
+ {
+ align = ceil_pow2 (size);
+ TYPE_ALIGN (new_type) = align;
+ new_size = (size + align - 1) & -align;
+ }
+ else
+ {
+ unsigned HOST_WIDE_INT align;
+
+ /* Do not try to shrink the size if the RM size is not constant. */
+ if (TYPE_CONTAINS_TEMPLATE_P (type)
+ || !host_integerp (TYPE_ADA_SIZE (type), 1))
+ 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. */
+ new_size = TREE_INT_CST_LOW (TYPE_ADA_SIZE (type));
+ new_size = (new_size + BITS_PER_UNIT - 1) & -BITS_PER_UNIT;
+ if (new_size == size)
+ return type;
+
+ align = new_size & -new_size;
+ TYPE_ALIGN (new_type) = MIN (TYPE_ALIGN (type), align);
+ }
+
+ TYPE_USER_ALIGN (new_type) = 1;
+
+ /* Now copy the fields, keeping the position and size as we don't want
+ to change the layout by propagating the packedness downwards. */
+ for (old_field = TYPE_FIELDS (type); old_field;
+ old_field = DECL_CHAIN (old_field))
+ {
+ tree new_field_type = TREE_TYPE (old_field);
+ tree new_field, new_size;
+
+ if (RECORD_OR_UNION_TYPE_P (new_field_type)
+ && !TYPE_FAT_POINTER_P (new_field_type)
+ && host_integerp (TYPE_SIZE (new_field_type), 1))
+ new_field_type = make_packable_type (new_field_type, true);
+
+ /* However, for the last field in a not already packed record type
+ that is of an aggregate type, we need to use the RM size in the
+ packable version of the record type, see finish_record_type. */
+ if (!DECL_CHAIN (old_field)
+ && !TYPE_PACKED (type)
+ && RECORD_OR_UNION_TYPE_P (new_field_type)
+ && !TYPE_FAT_POINTER_P (new_field_type)
+ && !TYPE_CONTAINS_TEMPLATE_P (new_field_type)
+ && TYPE_ADA_SIZE (new_field_type))
+ new_size = TYPE_ADA_SIZE (new_field_type);
+ else
+ new_size = DECL_SIZE (old_field);
+
+ new_field
+ = create_field_decl (DECL_NAME (old_field), new_field_type, new_type,
+ new_size, bit_position (old_field),
+ TYPE_PACKED (type),
+ !DECL_NONADDRESSABLE_P (old_field));
+
+ DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field);
+ SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, old_field);
+ if (TREE_CODE (new_type) == QUAL_UNION_TYPE)
+ DECL_QUALIFIER (new_field) = DECL_QUALIFIER (old_field);
+
+ DECL_CHAIN (new_field) = field_list;
+ field_list = new_field;
+ }
+
+ finish_record_type (new_type, nreverse (field_list), 2, false);
+ relate_alias_sets (new_type, type, ALIAS_SET_COPY);
+ SET_DECL_PARALLEL_TYPE (TYPE_STUB_DECL (new_type),
+ DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type)));
+
+ /* If this is a padding record, we never want to make the size smaller
+ than what was specified. For QUAL_UNION_TYPE, also copy the size. */
+ if (TYPE_IS_PADDING_P (type) || TREE_CODE (type) == QUAL_UNION_TYPE)
+ {
+ TYPE_SIZE (new_type) = TYPE_SIZE (type);
+ TYPE_SIZE_UNIT (new_type) = TYPE_SIZE_UNIT (type);
+ new_size = size;
+ }
+ else
+ {
+ TYPE_SIZE (new_type) = bitsize_int (new_size);
+ TYPE_SIZE_UNIT (new_type)
+ = size_int ((new_size + BITS_PER_UNIT - 1) / BITS_PER_UNIT);
+ }
+
+ if (!TYPE_CONTAINS_TEMPLATE_P (type))
+ SET_TYPE_ADA_SIZE (new_type, TYPE_ADA_SIZE (type));
+
+ compute_record_mode (new_type);
+
+ /* 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), MODE_INT, 1));
+
+ /* If neither the mode nor the size has shrunk, return the old type. */
+ if (TYPE_MODE (new_type) == BLKmode && new_size >= size)
+ return type;
+
+ return new_type;
+}
+
+/* Given a type TYPE, return a new type whose size is appropriate for SIZE.
+ If TYPE is the best type, return it. Otherwise, make a new type. We
+ only support new integral and pointer types. FOR_BIASED is true if
+ we are making a biased type. */
+
+tree
+make_type_from_size (tree type, tree size_tree, bool for_biased)
+{
+ unsigned HOST_WIDE_INT size;
+ bool biased_p;
+ tree new_type;
+
+ /* If size indicates an error, just return TYPE to avoid propagating
+ the error. Likewise if it's too large to represent. */
+ if (!size_tree || !host_integerp (size_tree, 1))
+ return type;
+
+ size = tree_low_cst (size_tree, 1);
+
+ switch (TREE_CODE (type))
+ {
+ case INTEGER_TYPE:
+ case ENUMERAL_TYPE:
+ case BOOLEAN_TYPE:
+ biased_p = (TREE_CODE (type) == INTEGER_TYPE
+ && TYPE_BIASED_REPRESENTATION_P (type));
+
+ /* Integer types with precision 0 are forbidden. */
+ 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)
+ || (TYPE_PRECISION (type) == size && biased_p == for_biased)
+ || size > LONG_LONG_TYPE_SIZE)
+ break;
+
+ biased_p |= for_biased;
+ if (TYPE_UNSIGNED (type) || biased_p)
+ new_type = make_unsigned_type (size);
+ else
+ new_type = make_signed_type (size);
+ TREE_TYPE (new_type) = TREE_TYPE (type) ? TREE_TYPE (type) : type;
+ SET_TYPE_RM_MIN_VALUE (new_type,
+ convert (TREE_TYPE (new_type),
+ TYPE_MIN_VALUE (type)));
+ SET_TYPE_RM_MAX_VALUE (new_type,
+ convert (TREE_TYPE (new_type),
+ TYPE_MAX_VALUE (type)));
+ /* Copy the name to show that it's essentially the same type and
+ not a subrange type. */
+ TYPE_NAME (new_type) = TYPE_NAME (type);
+ TYPE_BIASED_REPRESENTATION_P (new_type) = biased_p;
+ SET_TYPE_RM_SIZE (new_type, bitsize_int (size));
+ return new_type;
+
+ case RECORD_TYPE:
+ /* Do something if this is a fat pointer, in which case we
+ may need to return the thin pointer. */
+ if (TYPE_FAT_POINTER_P (type) && size < POINTER_SIZE * 2)
+ {
+ enum machine_mode p_mode = mode_for_size (size, MODE_INT, 0);
+ if (!targetm.valid_pointer_mode (p_mode))
+ p_mode = ptr_mode;
+ return
+ build_pointer_type_for_mode
+ (TYPE_OBJECT_RECORD_TYPE (TYPE_UNCONSTRAINED_ARRAY (type)),
+ p_mode, 0);
+ }
+ break;
+
+ case POINTER_TYPE:
+ /* Only do something if this is a thin pointer, in which case we
+ may need to return the fat pointer. */
+ if (TYPE_IS_THIN_POINTER_P (type) && size >= POINTER_SIZE * 2)
+ return
+ build_pointer_type (TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (type)));
+ break;
+
+ default:
+ break;
+ }
+
+ return type;
+}
+
+/* See if the data pointed to by the hash table slot is marked. */
+
+static int
+pad_type_hash_marked_p (const void *p)
+{
+ const_tree const type = ((const struct pad_type_hash *) p)->type;
+
+ return ggc_marked_p (type);
+}
+
+/* Return the cached hash value. */
+
+static hashval_t
+pad_type_hash_hash (const void *p)
+{
+ return ((const struct pad_type_hash *) p)->hash;
+}
+
+/* Return 1 iff the padded types are equivalent. */
+
+static int
+pad_type_hash_eq (const void *p1, const void *p2)
+{
+ const struct pad_type_hash *const t1 = (const struct pad_type_hash *) p1;
+ const struct pad_type_hash *const t2 = (const struct pad_type_hash *) p2;
+ tree type1, type2;
+
+ if (t1->hash != t2->hash)
+ return 0;
+
+ type1 = t1->type;
+ type2 = t2->type;
+
+ /* We consider that the padded types are equivalent if they pad the same
+ type and have the same size, alignment and RM size. Taking the mode
+ into account is redundant since it is determined by the others. */
+ return
+ TREE_TYPE (TYPE_FIELDS (type1)) == TREE_TYPE (TYPE_FIELDS (type2))
+ && TYPE_SIZE (type1) == TYPE_SIZE (type2)
+ && TYPE_ALIGN (type1) == TYPE_ALIGN (type2)
+ && TYPE_ADA_SIZE (type1) == TYPE_ADA_SIZE (type2);
+}
+
+/* Ensure that TYPE has SIZE and ALIGN. Make and return a new padded type
+ if needed. We have already verified that SIZE and TYPE 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. */
+
+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)
+{
+ tree orig_size = TYPE_SIZE (type);
+ tree record, field;
+
+ /* If TYPE is a padded type, see if it agrees with any size and alignment
+ we were given. If so, return the original type. Otherwise, strip
+ off the padding, since we will either be returning the inner type
+ or repadding it. If no size or alignment is specified, use that of
+ the original padded type. */
+ if (TYPE_IS_PADDING_P (type))
+ {
+ if ((!size
+ || operand_equal_p (round_up (size,
+ MAX (align, TYPE_ALIGN (type))),
+ round_up (TYPE_SIZE (type),
+ MAX (align, TYPE_ALIGN (type))),
+ 0))
+ && (align == 0 || align == TYPE_ALIGN (type)))
+ return type;
+
+ if (!size)
+ size = TYPE_SIZE (type);
+ if (align == 0)
+ align = TYPE_ALIGN (type);
+
+ type = TREE_TYPE (TYPE_FIELDS (type));
+ orig_size = TYPE_SIZE (type);
+ }
+
+ /* If the size is either not being changed or is being made smaller (which
+ is not done here and is only valid for bitfields anyway), show the size
+ isn't changing. Likewise, clear the alignment if it isn't being
+ changed. Then return if we aren't doing anything. */
+ if (size
+ && (operand_equal_p (size, orig_size, 0)
+ || (TREE_CODE (orig_size) == INTEGER_CST
+ && tree_int_cst_lt (size, orig_size))))
+ size = NULL_TREE;
+
+ if (align == TYPE_ALIGN (type))
+ align = 0;
+
+ 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,
+ NULL, !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;
+
+ if (Present (gnat_entity))
+ TYPE_NAME (record) = create_concat_name (gnat_entity, "PAD");
+
+ TYPE_ALIGN (record) = align;
+ TYPE_SIZE (record) = size ? size : orig_size;
+ TYPE_SIZE_UNIT (record)
+ = convert (sizetype,
+ size_binop (CEIL_DIV_EXPR, TYPE_SIZE (record),
+ bitsize_unit_node));
+
+ /* If we are changing the alignment and the input type is a record with
+ BLKmode and a small constant size, try to make a form that has an
+ integral mode. This might allow the padding record to also have an
+ integral mode, which will be much more efficient. There is no point
+ in doing so if a size is specified unless it is also a small constant
+ size and it is incorrect to do so if we cannot guarantee that the mode
+ will be naturally aligned since the field must always be addressable.
+
+ ??? This might not always be a win when done for a stand-alone object:
+ since the nominal and the effective type of the object will now have
+ different modes, a VIEW_CONVERT_EXPR will be required for converting
+ between them and it might be hard to overcome afterwards, including
+ at the RTL level when the stand-alone object is accessed as a whole. */
+ if (align != 0
+ && RECORD_OR_UNION_TYPE_P (type)
+ && TYPE_MODE (type) == BLKmode
+ && !TYPE_BY_REFERENCE_P (type)
+ && TREE_CODE (orig_size) == INTEGER_CST
+ && !TREE_OVERFLOW (orig_size)
+ && compare_tree_int (orig_size, MAX_FIXED_MODE_SIZE) <= 0
+ && (!size
+ || (TREE_CODE (size) == INTEGER_CST
+ && compare_tree_int (size, MAX_FIXED_MODE_SIZE) <= 0)))
+ {
+ tree packable_type = make_packable_type (type, true);
+ if (TYPE_MODE (packable_type) != BLKmode
+ && align >= TYPE_ALIGN (packable_type))
+ type = packable_type;
+ }
+
+ /* Now create the field with the original size. */
+ field = create_field_decl (get_identifier ("F"), type, record, orig_size,
+ bitsize_zero_node, 0, 1);
+ DECL_INTERNAL_P (field) = 1;
+
+ /* Do not emit debug info until after the auxiliary record is built. */
+ finish_record_type (record, field, 1, false);
+
+ /* Set the RM size if requested. */
+ if (set_rm_size)
+ {
+ 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)))
+ {
+ hashval_t hashcode;
+ struct pad_type_hash in, *h;
+ void **loc;
+
+ hashcode = iterative_hash_object (TYPE_HASH (type), 0);
+ hashcode = iterative_hash_expr (TYPE_SIZE (record), hashcode);
+ hashcode = iterative_hash_hashval_t (TYPE_ALIGN (record), hashcode);
+ hashcode = iterative_hash_expr (TYPE_ADA_SIZE (record), hashcode);
+
+ in.hash = hashcode;
+ in.type = record;
+ h = (struct pad_type_hash *)
+ htab_find_with_hash (pad_type_hash_table, &in, hashcode);
+ if (h)
+ {
+ record = h->type;
+ goto built;
+ }
+
+ h = ggc_alloc_pad_type_hash ();
+ h->hash = hashcode;
+ h->type = record;
+ loc = htab_find_slot_with_hash (pad_type_hash_table, h, hashcode,
+ INSERT);
+ *loc = (void *)h;
+ }
+ }
+
+ /* 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. */
+ if (TREE_CODE (orig_size) != INTEGER_CST
+ && TYPE_NAME (record)
+ && TYPE_NAME (type)
+ && !(TREE_CODE (TYPE_NAME (type)) == TYPE_DECL
+ && DECL_IGNORED_P (TYPE_NAME (type))))
+ {
+ tree marker = make_node (RECORD_TYPE);
+ tree name = TYPE_NAME (record);
+ tree orig_name = TYPE_NAME (type);
+
+ if (TREE_CODE (name) == TYPE_DECL)
+ name = DECL_NAME (name);
+
+ if (TREE_CODE (orig_name) == TYPE_DECL)
+ orig_name = DECL_NAME (orig_name);
+
+ TYPE_NAME (marker) = concat_name (name, "XVS");
+ finish_record_type (marker,
+ create_field_decl (orig_name,
+ build_reference_type (type),
+ marker, NULL_TREE, NULL_TREE,
+ 0, 0),
+ 0, true);
+
+ add_parallel_type (record, marker);
+
+ if (definition && size && TREE_CODE (size) != INTEGER_CST)
+ TYPE_SIZE_UNIT (marker)
+ = create_var_decl (concat_name (name, "XVZ"), NULL_TREE, sizetype,
+ TYPE_SIZE_UNIT (record), false, false, false,
+ false, NULL, gnat_entity);
+ }
+
+ rest_of_record_type_compilation (record);
+
+built:
+ /* If the size was widened explicitly, maybe give a warning. Take the
+ original size as the maximum size of the input if there was an
+ unconstrained record involved and round it up to the specified alignment,
+ if one was specified. But don't do it if we are just annotating types
+ and the type is tagged, since tagged types aren't fully laid out in this
+ mode. */
+ if (!size
+ || TREE_CODE (size) == COND_EXPR
+ || TREE_CODE (size) == MAX_EXPR
+ || No (gnat_entity)
+ || (type_annotate_only && Is_Tagged_Type (Etype (gnat_entity))))
+ return record;
+
+ if (CONTAINS_PLACEHOLDER_P (orig_size))
+ orig_size = max_size (orig_size, true);
+
+ if (align)
+ orig_size = round_up (orig_size, align);
+
+ if (!operand_equal_p (size, orig_size, 0)
+ && !(TREE_CODE (size) == INTEGER_CST
+ && TREE_CODE (orig_size) == INTEGER_CST
+ && (TREE_OVERFLOW (size)
+ || TREE_OVERFLOW (orig_size)
+ || tree_int_cst_lt (size, orig_size))))
+ {
+ Node_Id gnat_error_node = Empty;
+
+ if (Is_Packed_Array_Type (gnat_entity))
+ gnat_entity = Original_Array_Type (gnat_entity);
+
+ if ((Ekind (gnat_entity) == E_Component
+ || Ekind (gnat_entity) == E_Discriminant)
+ && Present (Component_Clause (gnat_entity)))
+ gnat_error_node = Last_Bit (Component_Clause (gnat_entity));
+ else if (Present (Size_Clause (gnat_entity)))
+ gnat_error_node = Expression (Size_Clause (gnat_entity));
+
+ /* Generate message only for entities that come from source, since
+ if we have an entity created by expansion, the message will be
+ generated for some other corresponding source entity. */
+ if (Comes_From_Source (gnat_entity))
+ {
+ if (Present (gnat_error_node))
+ post_error_ne_tree ("{^ }bits of & unused?",
+ gnat_error_node, gnat_entity,
+ size_diffop (size, orig_size));
+ else if (is_component_type)
+ post_error_ne_tree ("component of& padded{ by ^ bits}?",
+ gnat_entity, gnat_entity,
+ size_diffop (size, orig_size));
+ }
+ }
+
+ return record;
+}
+\f
+/* Relate the alias sets of GNU_NEW_TYPE and GNU_OLD_TYPE according to OP.
+ If this is a multi-dimensional array type, do this recursively.
+
+ OP may be
+ - ALIAS_SET_COPY: the new set is made a copy of the old one.
+ - ALIAS_SET_SUPERSET: the new set is made a superset of the old one.
+ - ALIAS_SET_SUBSET: the new set is made a subset of the old one. */
+
+void
+relate_alias_sets (tree gnu_new_type, tree gnu_old_type, enum alias_set_op op)
+{
+ /* Remove any padding from GNU_OLD_TYPE. It doesn't matter in the case
+ of a one-dimensional array, since the padding has the same alias set
+ as the field type, but if it's a multi-dimensional array, we need to
+ see the inner types. */
+ while (TREE_CODE (gnu_old_type) == RECORD_TYPE
+ && (TYPE_JUSTIFIED_MODULAR_P (gnu_old_type)
+ || TYPE_PADDING_P (gnu_old_type)))
+ gnu_old_type = TREE_TYPE (TYPE_FIELDS (gnu_old_type));
+
+ /* Unconstrained array types are deemed incomplete and would thus be given
+ alias set 0. Retrieve the underlying array type. */
+ if (TREE_CODE (gnu_old_type) == UNCONSTRAINED_ARRAY_TYPE)
+ gnu_old_type
+ = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_old_type))));
+ if (TREE_CODE (gnu_new_type) == UNCONSTRAINED_ARRAY_TYPE)
+ gnu_new_type
+ = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_new_type))));
+
+ if (TREE_CODE (gnu_new_type) == ARRAY_TYPE
+ && TREE_CODE (TREE_TYPE (gnu_new_type)) == ARRAY_TYPE
+ && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_new_type)))
+ relate_alias_sets (TREE_TYPE (gnu_new_type), TREE_TYPE (gnu_old_type), op);
+
+ switch (op)
+ {
+ case ALIAS_SET_COPY:
+ /* The alias set shouldn't be copied between array types with different
+ aliasing settings because this can break the aliasing relationship
+ between the array type and its element type. */
+#ifndef ENABLE_CHECKING
+ if (flag_strict_aliasing)
+#endif
+ gcc_assert (!(TREE_CODE (gnu_new_type) == ARRAY_TYPE
+ && TREE_CODE (gnu_old_type) == ARRAY_TYPE
+ && TYPE_NONALIASED_COMPONENT (gnu_new_type)
+ != TYPE_NONALIASED_COMPONENT (gnu_old_type)));
+
+ TYPE_ALIAS_SET (gnu_new_type) = get_alias_set (gnu_old_type);
+ break;
+
+ case ALIAS_SET_SUBSET:
+ case ALIAS_SET_SUPERSET:
+ {
+ alias_set_type old_set = get_alias_set (gnu_old_type);
+ alias_set_type new_set = get_alias_set (gnu_new_type);
+
+ /* Do nothing if the alias sets conflict. This ensures that we
+ never call record_alias_subset several times for the same pair
+ or at all for alias set 0. */
+ if (!alias_sets_conflict_p (old_set, new_set))
+ {
+ if (op == ALIAS_SET_SUBSET)
+ record_alias_subset (old_set, new_set);
+ else
+ record_alias_subset (new_set, old_set);
+ }
+ }
+ break;
+
+ default:
+ gcc_unreachable ();
+ }
+
+ record_component_aliases (gnu_new_type);
+}
+\f
/* Record TYPE as a builtin type for Ada. NAME is the name of the type.
ARTIFICIAL_P is true if it's a type that was generated by the compiler. */
&& gnat_types_compatible_p (TREE_TYPE (t1), TREE_TYPE (t2)))))
return 1;
- /* Padding record types are also compatible if they pad the same
- type and have the same constant size. */
- if (code == RECORD_TYPE
- && TYPE_PADDING_P (t1) && TYPE_PADDING_P (t2)
- && TREE_TYPE (TYPE_FIELDS (t1)) == TREE_TYPE (TYPE_FIELDS (t2))
- && tree_int_cst_equal (TYPE_SIZE (t1), TYPE_SIZE (t2)))
- return 1;
-
return 0;
}
&& TYPE_PADDING_P (type) && TYPE_PADDING_P (etype)
&& (!TREE_CONSTANT (TYPE_SIZE (type))
|| !TREE_CONSTANT (TYPE_SIZE (etype))
- || gnat_types_compatible_p (type, etype)
+ || TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype)
|| TYPE_NAME (TREE_TYPE (TYPE_FIELDS (type)))
== TYPE_NAME (TREE_TYPE (TYPE_FIELDS (etype)))))
;
if (TREE_CODE (expr) == COMPONENT_REF
&& TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (expr, 0)))
&& (!TREE_CONSTANT (TYPE_SIZE (type))
- || gnat_types_compatible_p (type,
- TREE_TYPE (TREE_OPERAND (expr, 0)))
+ || TYPE_MAIN_VARIANT (type)
+ == TYPE_MAIN_VARIANT (TREE_TYPE (TREE_OPERAND (expr, 0)))
|| (ecode == RECORD_TYPE
&& TYPE_NAME (etype)
== TYPE_NAME (TREE_TYPE (TYPE_FIELDS (type))))))
else if (TYPE_IS_PADDING_P (left_type)
&& TREE_CONSTANT (TYPE_SIZE (left_type))
&& ((TREE_CODE (right_operand) == COMPONENT_REF
- && TYPE_IS_PADDING_P
- (TREE_TYPE (TREE_OPERAND (right_operand, 0)))
- && gnat_types_compatible_p
- (left_type,
- TREE_TYPE (TREE_OPERAND (right_operand, 0))))
+ && TYPE_MAIN_VARIANT (left_type)
+ == TYPE_MAIN_VARIANT
+ (TREE_TYPE (TREE_OPERAND (right_operand, 0))))
|| (TREE_CODE (right_operand) == CONSTRUCTOR
&& !CONTAINS_PLACEHOLDER_P
(DECL_SIZE (TYPE_FIELDS (left_type)))))
&& !integer_zerop (TYPE_SIZE (right_type)))
- operation_type = left_type;
+ {
+ /* We make an exception for a BLKmode type padding a non-BLKmode
+ inner type and do the conversion of the LHS right away, since
+ unchecked_convert wouldn't do it properly. */
+ if (TYPE_MODE (left_type) == BLKmode
+ && TYPE_MODE (right_type) != BLKmode
+ && TREE_CODE (right_operand) != CONSTRUCTOR)
+ {
+ operation_type = right_type;
+ left_operand = convert (operation_type, left_operand);
+ left_type = operation_type;
+ }
+ else
+ operation_type = left_type;
+ }
/* If we have a call to a function that returns an unconstrained type
with default discriminant on the RHS, use the RHS type (which is
+2012-05-04 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gcc.target/ia64/pr48496.c: New test.
+ * gcc.target/ia64/pr52657.c: Likewise.
+
2012-05-05 Manuel López-Ibáñez <manu@gcc.gnu.org>
PR c/43772
--- /dev/null
+-- { dg-do compile }
+
+with Discr36_Pkg;
+
+package body Discr36 is
+
+ function N return Natural is begin return 0; end;
+
+ type Arr is array (1 .. N) of R;
+
+ function My_Func is new Discr36_Pkg.Func (Arr);
+
+ procedure Proc is
+ A : constant Arr := My_Func;
+ begin
+ null;
+ end;
+
+end Discr36;
--- /dev/null
+package Discr36 is\r
+\r
+ type R (D : Boolean := True) is record\r
+ case D is\r
+ when True => I : Integer;\r
+ when False => null;\r
+ end case;\r
+ end record;\r
+\r
+ function N return Natural;\r
+\r
+end Discr36;\r
--- /dev/null
+package body Discr36_Pkg is\r
+\r
+ function Func return T is\r
+ Ret : T;\r
+ pragma Warnings (Off, Ret);\r
+ begin\r
+ return Ret;\r
+ end;\r
+\r
+end Discr36_Pkg;\r
--- /dev/null
+package Discr36_Pkg is\r
+\r
+ generic\r
+ type T is private;\r
+ function Func return T;\r
+\r
+end Discr36_Pkg;\r
projects / thirdparty / gcc.git / commitdiff
