static void copy_and_substitute_in_size (tree, tree, vec<subst_pair>);
static void copy_and_substitute_in_layout (Entity_Id, Entity_Id, tree, tree,
vec<subst_pair>, bool);
-static void associate_original_type_to_packed_array (tree, Entity_Id);
+static tree associate_original_type_to_packed_array (tree, Entity_Id);
static const char *get_entity_char (Entity_Id);
/* The relevant constituents of a subprogram binding to a GCC builtin. Used
tree orig_type = gnu_type;
gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity,
- false, false, definition, true);
+ false, definition, true);
/* If the nominal subtype of the object is unconstrained and its
size is not fixed, compute the Ada size from the Ada size of
{
/* Given RM restrictions on 'Small values, we assume here that
the denominator fits in an int. */
- const tree base = build_int_cst (integer_type_node,
- Rbase (gnat_small_value));
- const tree exponent
+ tree base
+ = build_int_cst (integer_type_node, Rbase (gnat_small_value));
+ tree exponent
= build_int_cst (integer_type_node,
UI_To_Int (Denominator (gnat_small_value)));
scale_factor
if (UI_Is_In_Int_Range (num) && UI_Is_In_Int_Range (den))
{
- const tree gnu_num
+ tree gnu_num
= build_int_cst (integer_type_node,
UI_To_Int (Norm_Num (gnat_small_value)));
- const tree gnu_den
+ tree gnu_den
= build_int_cst (integer_type_node,
UI_To_Int (Norm_Den (gnat_small_value)));
scale_factor = build2 (RDIV_EXPR, integer_type_node,
gnat_to_gnu_entity (Ancestor_Subtype (gnat_entity), gnu_expr, false);
/* Set the precision to the Esize except for bit-packed arrays. */
- if (Is_Packed_Array_Impl_Type (gnat_entity)
- && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
+ if (Is_Packed_Array_Impl_Type (gnat_entity))
esize = UI_To_Int (RM_Size (gnat_entity));
/* Boolean types with foreign convention have precision 1. */
TYPE_STUB_DECL (gnu_type)
= create_type_stub_decl (gnu_entity_name, gnu_type);
- /* For a packed array, make the original array type a parallel/debug
- type. */
- if (debug_info_p && Is_Packed_Array_Impl_Type (gnat_entity))
- associate_original_type_to_packed_array (gnu_type, gnat_entity);
-
discrete_type:
/* We have to handle clauses that under-align the type specially. */
such values), we only get the good bits, since the unused bits
are uninitialized. Both goals are accomplished by wrapping up
the modular type in an enclosing record type. */
- if (Is_Packed_Array_Impl_Type (gnat_entity)
- && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
+ if (Is_Packed_Array_Impl_Type (gnat_entity))
{
- tree gnu_field_type, gnu_field;
+ tree gnu_field_type, gnu_field, t;
+
+ gcc_assert (Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)));
+ TYPE_BIT_PACKED_ARRAY_TYPE_P (gnu_type) = 1;
+
+ /* Make the original array type a parallel/debug type. */
+ if (debug_info_p)
+ {
+ tree gnu_name
+ = associate_original_type_to_packed_array (gnu_type,
+ gnat_entity);
+ if (gnu_name)
+ gnu_entity_name = gnu_name;
+ }
/* Set the RM size before wrapping up the original type. */
SET_TYPE_RM_SIZE (gnu_type,
UI_To_gnu (RM_Size (gnat_entity), bitsizetype));
- TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = 1;
/* Create a stripped-down declaration, mainly for debugging. */
- create_type_decl (gnu_entity_name, gnu_type, true, debug_info_p,
- gnat_entity);
+ t = create_type_decl (gnu_entity_name, gnu_type, true, debug_info_p,
+ gnat_entity);
/* Now save it and build the enclosing record type. */
gnu_field_type = gnu_type;
finish_record_type (gnu_type, gnu_field, 2, false);
TYPE_JUSTIFIED_MODULAR_P (gnu_type) = 1;
+ /* Make the original array type a parallel/debug type. Note that
+ gnat_get_array_descr_info needs a TYPE_IMPL_PACKED_ARRAY_P type
+ so we use an intermediate step for standard DWARF. */
if (debug_info_p)
{
- /* Make the original array type a parallel/debug type. */
- associate_original_type_to_packed_array (gnu_type, gnat_entity);
-
- /* Since GNU_TYPE is a padding type around the packed array
- implementation type, the padded type is its debug type. */
if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
SET_TYPE_DEBUG_TYPE (gnu_type, gnu_field_type);
+ else if (DECL_PARALLEL_TYPE (t))
+ add_parallel_type (gnu_type, DECL_PARALLEL_TYPE (t));
}
}
/* Set the RM size before wrapping the type. */
SET_TYPE_RM_SIZE (gnu_type, gnu_size);
+ /* Create a stripped-down declaration, mainly for debugging. */
+ create_type_decl (gnu_entity_name, gnu_type, true, debug_info_p,
+ gnat_entity);
+
gnu_type
= maybe_pad_type (gnu_type, TYPE_SIZE (gnu_type), align,
- gnat_entity, false, true, definition, false);
+ gnat_entity, false, definition, false);
TYPE_PACKED (gnu_type) = 1;
SET_TYPE_ADA_SIZE (gnu_type, gnu_size);
tree *gnu_index_types = XALLOCAVEC (tree, ndim);
tree *gnu_temp_fields = XALLOCAVEC (tree, ndim);
tree gnu_max_size = size_one_node, tem, t;
- Entity_Id gnat_index, gnat_name;
+ Entity_Id gnat_index;
int index;
tree comp_type;
create_type_decl (create_concat_name (gnat_entity, "XUA"), tem,
artificial_p, debug_info_p, gnat_entity);
- /* If told to generate GNAT encodings for them (GDB rely on them at the
- moment): give the fat pointer type a name. If this is a packed
- array, tell the debugger how to interpret the underlying bits. */
- if (Present (Packed_Array_Impl_Type (gnat_entity)))
- gnat_name = Packed_Array_Impl_Type (gnat_entity);
- else
- gnat_name = gnat_entity;
+ /* If the GNAT encodings are used, give the fat pointer type a name.
+ If this is a packed array, tell the debugger how to interpret the
+ underlying bits by fetching that of the implementation type. */
+ const Entity_Id gnat_name
+ = (Present (Packed_Array_Impl_Type (gnat_entity))
+ && gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL)
+ ? Packed_Array_Impl_Type (gnat_entity)
+ : gnat_entity;
+
tree xup_name
= (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
? get_entity_name (gnat_name)
}
}
+ /* Set the TYPE_PACKED flag on packed array types and also on their
+ implementation types, so that the DWARF back-end can output the
+ appropriate description for them. */
+ TYPE_PACKED (gnu_type)
+ = (Is_Packed (gnat_entity)
+ || Is_Packed_Array_Impl_Type (gnat_entity));
+
+ TYPE_BIT_PACKED_ARRAY_TYPE_P (gnu_type)
+ = (Is_Packed_Array_Impl_Type (gnat_entity)
+ && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)));
+
+ /* If the maximum size doesn't overflow, use it. */
+ if (gnu_max_size
+ && TREE_CODE (gnu_max_size) == INTEGER_CST
+ && !TREE_OVERFLOW (gnu_max_size)
+ && compare_tree_int (gnu_max_size, TYPE_ARRAY_SIZE_LIMIT) <= 0)
+ TYPE_ARRAY_MAX_SIZE (gnu_type) = gnu_max_size;
+
/* If we need to write out a record type giving the names of the
bounds for debugging purposes, do it now and make the record
type a parallel type. This is not needed for a packed array
}
/* If this is a packed array type, make the original array type a
- parallel/debug type. Otherwise, if such GNAT encodings are
- required, do it for the base array type if it isn't artificial to
- make sure it is kept in the debug info. */
+ parallel/debug type. Otherwise, if GNAT encodings are used, do
+ it for the base array type if it is not artificial to make sure
+ that it is kept in the debug info. */
if (debug_info_p)
{
if (Is_Packed_Array_Impl_Type (gnat_entity))
- associate_original_type_to_packed_array (gnu_type,
- gnat_entity);
- else
+ {
+ tree gnu_name
+ = associate_original_type_to_packed_array (gnu_type,
+ gnat_entity);
+ if (gnu_name)
+ gnu_entity_name = gnu_name;
+ }
+
+ else if (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL)
{
tree gnu_base_decl
= gnat_to_gnu_entity (Etype (gnat_entity), NULL_TREE,
false);
- if (!DECL_ARTIFICIAL (gnu_base_decl)
- && gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL)
+
+ if (!DECL_ARTIFICIAL (gnu_base_decl))
add_parallel_type (gnu_type,
TREE_TYPE (TREE_TYPE (gnu_base_decl)));
}
}
- TYPE_PACKED_ARRAY_TYPE_P (gnu_type)
- = (Is_Packed_Array_Impl_Type (gnat_entity)
- && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)));
-
- /* Tag top-level ARRAY_TYPE nodes for packed arrays and their
- implementation types as such so that the debug information back-end
- can output the appropriate description for them. */
- TYPE_PACKED (gnu_type)
- = (Is_Packed (gnat_entity)
- || Is_Packed_Array_Impl_Type (gnat_entity));
-
- /* If the maximum size doesn't overflow, use it. */
- if (gnu_max_size
- && TREE_CODE (gnu_max_size) == INTEGER_CST
- && !TREE_OVERFLOW (gnu_max_size)
- && compare_tree_int (gnu_max_size, TYPE_ARRAY_SIZE_LIMIT) <= 0)
- TYPE_ARRAY_MAX_SIZE (gnu_type) = gnu_max_size;
-
/* Set our alias set to that of our base type. This gives all
array subtypes the same alias set. */
relate_alias_sets (gnu_type, gnu_base_type, ALIAS_SET_COPY);
we are asked to output such encodings, write a record that
shows what we are a subtype of and also make a variable that
indicates our size, if still variable. */
- if (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL)
+ if (debug_info_p
+ && gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL)
{
tree gnu_subtype_marker = make_node (RECORD_TYPE);
tree gnu_unpad_base_name
&& integer_pow2p (gnu_size))
align = MIN (BIGGEST_ALIGNMENT, tree_to_uhwi (gnu_size));
- /* See if we need to pad the type. If we did, and made a record,
- the name of the new type may be changed. So get it back for
- us when we make the new TYPE_DECL below. */
+ /* See if we need to pad the type. If we did and built a new type,
+ then create a stripped-down declaration for the original type,
+ mainly for debugging, unless there was already one. */
if (gnu_size || align > 0)
- gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity,
- false, !gnu_decl, definition, false);
+ {
+ tree orig_type = gnu_type;
+
+ gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity,
+ false, definition, false);
- if (TYPE_IS_PADDING_P (gnu_type))
- gnu_entity_name = TYPE_IDENTIFIER (gnu_type);
+ if (gnu_type != orig_type && !gnu_decl)
+ create_type_decl (gnu_entity_name, orig_type, true, debug_info_p,
+ gnat_entity);
+ }
/* 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. */
bool debug_info_p)
{
const Entity_Id gnat_type = Component_Type (gnat_array);
+ const bool is_bit_packed = Is_Bit_Packed_Array (gnat_array);
tree gnu_type = gnat_to_gnu_type (gnat_type);
- bool has_packed_components = Is_Bit_Packed_Array (gnat_array);
tree gnu_comp_size;
+ bool has_packed_components;
unsigned int max_align;
/* If an alignment is specified, use it as a cap on the component type
/* Try to get a packable form of the component if needed. */
if ((Is_Packed (gnat_array) || Has_Component_Size_Clause (gnat_array))
+ && !is_bit_packed
&& !Has_Aliased_Components (gnat_array)
&& !Strict_Alignment (gnat_type)
- && !has_packed_components
&& RECORD_OR_UNION_TYPE_P (gnu_type)
&& !TYPE_FAT_POINTER_P (gnu_type)
&& tree_fits_uhwi_p (TYPE_SIZE (gnu_type)))
gnu_type = make_packable_type (gnu_type, false, max_align);
has_packed_components = true;
}
+ else
+ has_packed_components = is_bit_packed;
/* Get and validate any specified Component_Size. */
gnu_comp_size
gnu_comp_size = bitsize_unit_node;
/* Honor the component size. This is not needed for bit-packed arrays. */
- if (gnu_comp_size && !Is_Bit_Packed_Array (gnat_array))
+ if (gnu_comp_size && !is_bit_packed)
{
tree orig_type = gnu_type;
orig_type = gnu_type;
gnu_type = maybe_pad_type (gnu_type, gnu_comp_size, 0, gnat_array,
- true, false, definition, true);
+ true, 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
= size_binop (MAX_EXPR, TYPE_SIZE (gnu_type), bitsize_unit_node);
TYPE_PADDING_FOR_COMPONENT (gnu_type)
= maybe_pad_type (gnu_type, gnu_comp_size, 0, gnat_array,
- true, false, definition, true);
+ true, definition, true);
gnu_type = TYPE_PADDING_FOR_COMPONENT (gnu_type);
create_type_decl (TYPE_NAME (gnu_type), gnu_type, true, debug_info_p,
gnat_array);
storage order to the padding type since it is the innermost enclosing
aggregate type around the scalar. */
if (TYPE_IS_PADDING_P (gnu_type)
+ && !is_bit_packed
&& Reverse_Storage_Order (gnat_array)
- && !Is_Bit_Packed_Array (gnat_array)
&& Is_Scalar_Type (gnat_type))
gnu_type = set_reverse_storage_order_on_pad_type (gnu_type);
}
gnu_return_type = maybe_pad_type (gnu_return_type, max_return_size,
- 0, gnat_subprog, false, false,
- definition, true);
+ 0, gnat_subprog, false, definition,
+ true);
/* Declare it now since it will never be declared otherwise. This
is necessary to ensure that its subtrees are properly marked. */
if (align > 0)
gnu_field_type
= maybe_pad_type (gnu_field_type, NULL_TREE, align, gnat_field,
- false, false, definition, true);
+ false, definition, true);
check_ok_for_atomic_type (gnu_field_type, gnat_field, false);
}
orig_field_type = gnu_field_type;
gnu_field_type = maybe_pad_type (gnu_field_type, gnu_size, 0, gnat_field,
- false, false, definition, true);
+ 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
return NULL_TREE;
}
- /* If this is an integral type or a packed array type, the front-end has
- already verified the size, so we need not do it here (which would mean
- checking against the bounds). However, if this is an aliased object,
- it may not be smaller than the type of the object. */
- if ((INTEGRAL_TYPE_P (gnu_type) || TYPE_IS_PACKED_ARRAY_TYPE_P (gnu_type))
+ /* If this is an integral type or a bit-packed array type, the front-end has
+ already verified the size, so we need not do it again (which would mean
+ checking against the bounds). However, if this is an aliased object, it
+ may not be smaller than the type of the object. */
+ if ((INTEGRAL_TYPE_P (gnu_type) || BIT_PACKED_ARRAY_TYPE_P (gnu_type))
&& !(kind == VAR_DECL && Is_Aliased (gnat_object)))
return size;
/* Issue an error either if the old size of the object isn't a constant or
if the new size is smaller than it. The front-end has already verified
- this for scalar and packed array types. */
+ this for scalar and bit-packed array types. */
if (TREE_CODE (old_size) != INTEGER_CST
|| TREE_OVERFLOW (old_size)
|| (AGGREGATE_TYPE_P (gnu_type)
- && !(TREE_CODE (gnu_type) == ARRAY_TYPE
- && TYPE_PACKED_ARRAY_TYPE_P (gnu_type))
+ && !BIT_PACKED_ARRAY_TYPE_P (gnu_type)
&& !(TYPE_IS_PADDING_P (gnu_type)
- && TREE_CODE (TREE_TYPE (TYPE_FIELDS (gnu_type))) == ARRAY_TYPE
- && TYPE_PACKED_ARRAY_TYPE_P
- (TREE_TYPE (TYPE_FIELDS (gnu_type))))
+ && BIT_PACKED_ARRAY_TYPE_P (TREE_TYPE (TYPE_FIELDS (gnu_type))))
&& tree_int_cst_lt (size, old_size)))
{
if (Present (gnat_attr_node))
gnat_to_gnu_entity (Etype (gnat_field), NULL_TREE, false);
}
-/* Associate to GNU_TYPE, the translation of GNAT_ENTITY, which is
- the implementation type of a packed array type (Is_Packed_Array_Impl_Type),
- the original array type if it has been translated. This association is a
- parallel type for GNAT encodings or a debug type for standard DWARF. Note
- that for standard DWARF, we also want to get the original type name. */
+/* Associate to the implementation type of a packed array type specified by
+ GNU_TYPE, which is the translation of GNAT_ENTITY, the original array type
+ if it has been translated. This association is a parallel type for GNAT
+ encodings or a debug type for standard DWARF. Note that for standard DWARF,
+ we also want to get the original type name and therefore we return it. */
-static void
+static tree
associate_original_type_to_packed_array (tree gnu_type, Entity_Id gnat_entity)
{
- Entity_Id gnat_original_array_type
+ const Entity_Id gnat_original_array_type
= Underlying_Type (Original_Array_Type (gnat_entity));
tree gnu_original_array_type;
if (!present_gnu_tree (gnat_original_array_type))
- return;
+ return NULL_TREE;
gnu_original_array_type = gnat_to_gnu_type (gnat_original_array_type);
if (TYPE_IS_DUMMY_P (gnu_original_array_type))
- return;
+ return NULL_TREE;
+
+ gcc_assert (TYPE_IMPL_PACKED_ARRAY_P (gnu_type));
if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
{
- tree original_name = TYPE_NAME (gnu_original_array_type);
+ SET_TYPE_ORIGINAL_PACKED_ARRAY (gnu_type, gnu_original_array_type);
+ tree original_name = TYPE_NAME (gnu_original_array_type);
if (TREE_CODE (original_name) == TYPE_DECL)
original_name = DECL_NAME (original_name);
-
- SET_TYPE_ORIGINAL_PACKED_ARRAY (gnu_type, gnu_original_array_type);
- TYPE_NAME (gnu_type) = original_name;
+ return original_name;
}
else
- add_parallel_type (gnu_type, gnu_original_array_type);
+ {
+ add_parallel_type (gnu_type, gnu_original_array_type);
+ return NULL_TREE;
+ }
}
\f
/* Given a type T, a FIELD_DECL F, and a replacement value R, return an
static tree
gnat_get_debug_type (const_tree type)
{
- if (TYPE_CAN_HAVE_DEBUG_TYPE_P (type) && TYPE_DEBUG_TYPE (type))
- {
- type = TYPE_DEBUG_TYPE (type);
-
- /* ??? The get_debug_type language hook is processed after the array
- descriptor language hook, so if there is an array behind this type,
- the latter is supposed to handle it. Still, we can get here with
- a type we are not supposed to handle (e.g. when the DWARF back-end
- processes the type of a variable), so keep this guard. */
- if (type && TYPE_CAN_HAVE_DEBUG_TYPE_P (type))
- return const_cast<tree> (type);
- }
-
- return NULL_TREE;
+ if (TYPE_CAN_HAVE_DEBUG_TYPE_P (type))
+ return TYPE_DEBUG_TYPE (type);
+ else
+ return NULL_TREE;
}
/* Provide information in INFO for debugging output about the TYPE fixed-point
if (TREE_CODE (scale_factor) == RDIV_EXPR)
{
- const tree num = TREE_OPERAND (scale_factor, 0);
- const tree den = TREE_OPERAND (scale_factor, 1);
+ tree num = TREE_OPERAND (scale_factor, 0);
+ tree den = TREE_OPERAND (scale_factor, 1);
/* See if we have a binary or decimal scale. */
if (TREE_CODE (den) == POWER_EXPR)
{
- const tree base = TREE_OPERAND (den, 0);
- const tree exponent = TREE_OPERAND (den, 1);
+ tree base = TREE_OPERAND (den, 0);
+ tree exponent = TREE_OPERAND (den, 1);
/* We expect the scale factor to be 1 / 2 ** N or 1 / 10 ** N. */
gcc_assert (num == integer_one_node
gnat_get_array_descr_info (const_tree const_type,
struct array_descr_info *info)
{
- bool convention_fortran_p;
- bool is_array = false;
- bool is_fat_ptr = false;
- bool is_packed_array = false;
tree type = const_cast<tree> (const_type);
- const_tree first_dimen = NULL_TREE;
- const_tree last_dimen = NULL_TREE;
- const_tree dimen;
+ tree first_dimen, dimen;
+ bool is_packed_array, is_array, is_fat_ptr;
int i;
/* Temporaries created in the first pass and used in the second one for thin
tree thinptr_template_expr = NULL_TREE;
tree thinptr_bound_field = NULL_TREE;
- /* ??? See gnat_get_debug_type. */
- type = maybe_debug_type (type);
-
/* If we have an implementation type for a packed array, get the orignial
array type. */
if (TYPE_IMPL_PACKED_ARRAY_P (type) && TYPE_ORIGINAL_PACKED_ARRAY (type))
type = TYPE_ORIGINAL_PACKED_ARRAY (type);
is_packed_array = true;
}
+ else
+ is_packed_array = false;
/* First pass: gather all information about this array except everything
related to dimensions. */
&& TYPE_INDEX_TYPE (TYPE_DOMAIN (type)))
{
is_array = true;
+ is_fat_ptr = false;
first_dimen = type;
info->data_location = NULL_TREE;
}
else if (TYPE_IS_FAT_POINTER_P (type)
&& gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
{
- const tree ua_type = TYPE_UNCONSTRAINED_ARRAY (type);
+ tree ua_type = TYPE_UNCONSTRAINED_ARRAY (type);
/* This will be our base object address. */
- const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type);
+ tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type);
/* We assume below that maybe_unconstrained_array returns an INDIRECT_REF
node. */
- const tree ua_val
+ tree ua_val
= maybe_unconstrained_array (build_unary_op (INDIRECT_REF,
ua_type,
placeholder_expr));
+ is_array = false;
is_fat_ptr = true;
first_dimen = TREE_TYPE (ua_val);
/* This will be our base object address. Note that we assume that
pointers to these will actually point to the array field (thin
pointers are shifted). */
- const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type);
- const tree placeholder_addr
- = build_unary_op (ADDR_EXPR, NULL_TREE, placeholder_expr);
+ tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type);
+ tree placeholder_addr
+ = build_unary_op (ADDR_EXPR, NULL_TREE, placeholder_expr);
- const tree bounds_field = TYPE_FIELDS (type);
- const tree bounds_type = TREE_TYPE (bounds_field);
- const tree array_field = DECL_CHAIN (bounds_field);
- const tree array_type = TREE_TYPE (array_field);
+ tree bounds_field = TYPE_FIELDS (type);
+ tree bounds_type = TREE_TYPE (bounds_field);
+ tree array_field = DECL_CHAIN (bounds_field);
+ tree array_type = TREE_TYPE (array_field);
/* Shift the thin pointer address to get the address of the template. */
- const tree shift_amount
+ tree shift_amount
= fold_build1 (NEGATE_EXPR, sizetype, byte_position (array_field));
tree template_addr
= build_binary_op (POINTER_PLUS_EXPR, TREE_TYPE (placeholder_addr),
template_addr
= fold_convert (TYPE_POINTER_TO (bounds_type), template_addr);
+ is_array = false;
+ is_fat_ptr = false;
first_dimen = array_type;
/* The thin pointer is already the pointer to the array data, so there's
template_addr);
thinptr_bound_field = TYPE_FIELDS (bounds_type);
}
+
else
return false;
/* Second pass: compute the remaining information: dimensions and
corresponding bounds. */
- if (TYPE_PACKED (first_dimen))
- is_packed_array = true;
/* If this array has fortran convention, it's arranged in column-major
order, so our view here has reversed dimensions. */
- convention_fortran_p = TYPE_CONVENTION_FORTRAN_P (first_dimen);
+ const bool convention_fortran_p = TYPE_CONVENTION_FORTRAN_P (first_dimen);
+
+ if (TYPE_PACKED (first_dimen))
+ is_packed_array = true;
+
/* ??? For row major ordering, we probably want to emit nothing and
instead specify it as the default in Dw_TAG_compile_unit. */
info->ordering = (convention_fortran_p
? array_descr_ordering_column_major
: array_descr_ordering_row_major);
+ info->rank = NULL_TREE;
- /* Count how many dimensions this array has. */
- for (i = 0, dimen = first_dimen; ; ++i, dimen = TREE_TYPE (dimen))
+ /* Count the number of dimensions and determine the element type. */
+ i = 1;
+ dimen = TREE_TYPE (first_dimen);
+ while (TREE_CODE (dimen) == ARRAY_TYPE && TYPE_MULTI_ARRAY_P (dimen))
{
- if (i > 0
- && (TREE_CODE (dimen) != ARRAY_TYPE
- || !TYPE_MULTI_ARRAY_P (dimen)))
- break;
- last_dimen = dimen;
+ i++;
+ dimen = TREE_TYPE (dimen);
}
-
info->ndimensions = i;
- info->rank = NULL_TREE;
+ info->element_type = dimen;
/* Too many dimensions? Give up generating proper description: yield instead
nested arrays. Note that in this case, this hook is invoked once on each
|| TYPE_MULTI_ARRAY_P (first_dimen))
{
info->ndimensions = 1;
- last_dimen = first_dimen;
+ info->element_type = TREE_TYPE (first_dimen);
}
- info->element_type = TREE_TYPE (last_dimen);
-
- /* Now iterate over all dimensions in source-order and fill the info
+ /* Now iterate over all dimensions in source order and fill the info
structure. */
for (i = (convention_fortran_p ? info->ndimensions - 1 : 0),
dimen = first_dimen;
void
enumerate_modes (void (*f) (const char *, int, int, int, int, int, int, int))
{
- const tree c_types[]
+ tree const c_types[]
= { float_type_node, double_type_node, long_double_type_node };
const char *const c_names[]
= { "float", "double", "long double" };
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;
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);
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);
}
}
+ /* 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));
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. */
&& 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);
}
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);
}
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);
}
&& 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);
}
|| 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);
}
projects / gcc.git / commitdiff