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

Fix small issues with -fgnat-encodings=minimal 

This is the mode where the GNAT compiler does not use special encodings
in the debug info to describe some Ada constructs, for example packed
array types.

	* gcc-interface/ada-tree.h (TYPE_PACKED_ARRAY_TYPE_P): Rename into...
	(TYPE_BIT_PACKED_ARRAY_TYPE_P): ...this.
	(TYPE_IS_PACKED_ARRAY_TYPE_P): Rename into...
	(BIT_PACKED_ARRAY_TYPE_P): ...this.
	(TYPE_IMPL_PACKED_ARRAY_P): Adjust to above renaming.
	* gcc-interface/gigi.h (maybe_pad_type): Remove IS_USER_TYPE..
	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Variable>: Adjust
	call to maybe_pad_type.
	<E_Ordinary_Fixed_Point_Type>: Remove const qualifiers for tree.
	<E_Signed_Integer_Subtype>: Remove redundant test and redundant call
	to associate_original_type_to_packed_array.  Turn into assertion.
	Call associate_original_type_to_packed_array and modify
	gnu_entity_name accordingly.  Explicitly set the parallel type
	for GNAT encodings.
	Call create_type_decl in the misaligned case before maybe_pad_type.
	<E_Array_Type>: Do not use the name of the implementation type for
	a packed array when not using GNAT encodings.
	<E_Array_Subtype>: Move around setting flags. Use the result of the
	call to associate_original_type_to_packed_array for gnu_entity_name.
	<E_Record_Subtype>: Create XVS type and XVZ variable only if debug
	info is requested for the type.
	Call create_type_decl if a padded type was created for a type entity
	(gnat_to_gnu_component_type): Use local variable and adjust calls to
	maybe_pad_type.
	(gnat_to_gnu_subprog_type): Adjust call to maybe_pad_type.
	(gnat_to_gnu_field): Likewise.
	(validate_size): Adjust to renaming of macro.
	(set_rm_size): Likewise.
	(associate_original_type_to_packed_array): Adjust return type and
	return the name of the original type if GNAT encodings are not used
	* gcc-interface/misc.c (gnat_get_debug_typ): Remove obsolete stuff.
	(gnat_get_fixed_point_type_info): Remove const qualifiers for tree.
	(gnat_get_array_descr_info): Likewise and set variables lazily.
	Remove call to maybe_debug_type.  Simplify a few computations.
	(enumerate_modes): Remove const qualifier for tree.
	* gcc-interface/utils.c (make_type_from_size): Adjust to renaming.
	(maybe_pad_type): Remove IS_USER_TYPE parameter and adjust.  Remove
	specific code for implementation types for packed arrays.
	(compute_deferred_decl_context): Remove const qualifier for tree.
	(convert): Adjust call to maybe_pad_type.
	(unchecked_convert): Likewise.
	* gcc-interface/utils2.c (is_simple_additive_expressio): Likewise.
This commit is contained in:
Eric Botcazou 2020-05-09 23:04:38 +02:00
parent 2448ee85a8
commit 1e3cabd45d
7 changed files with 250 additions and 211 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
gcc/ada/ChangeLog
View File

@ -1,3 +1,47 @@
2020-05-09 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/ada-tree.h (TYPE_PACKED_ARRAY_TYPE_P): Rename into...
(TYPE_BIT_PACKED_ARRAY_TYPE_P): ...this.
(TYPE_IS_PACKED_ARRAY_TYPE_P): Rename into...
(BIT_PACKED_ARRAY_TYPE_P): ...this.
(TYPE_IMPL_PACKED_ARRAY_P): Adjust to above renaming.
* gcc-interface/gigi.h (maybe_pad_type): Remove IS_USER_TYPE parameter.
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Variable>: Adjust call
to maybe_pad_type.
<E_Ordinary_Fixed_Point_Type>: Remove const qualifiers for tree.
<E_Signed_Integer_Subtype>: Remove redundant test and redundant call
to associate_original_type_to_packed_array. Turn test into assertion.
Call associate_original_type_to_packed_array and modify gnu_entity_name
accordingly. Explicitly set the parallel type for GNAT encodings.
Call create_type_decl in the misaligned case before maybe_pad_type.
<E_Array_Type>: Do not use the name of the implementation type for a
packed array when not using GNAT encodings.
<E_Array_Subtype>: Move around setting flags. Use the result of the
call to associate_original_type_to_packed_array for gnu_entity_name.
<E_Record_Subtype>: Create XVS type and XVZ variable only if debug
info is requested for the type.
Call create_type_decl if a padded type was created for a type entity.
(gnat_to_gnu_component_type): Use local variable and adjust calls to
maybe_pad_type.
(gnat_to_gnu_subprog_type): Adjust call to maybe_pad_type.
(gnat_to_gnu_field): Likewise.
(validate_size): Adjust to renaming of macro.
(set_rm_size): Likewise.
(associate_original_type_to_packed_array): Adjust return type and
return the name of the original type if GNAT encodings are not used.
* gcc-interface/misc.c (gnat_get_debug_typ): Remove obsolete stuff.
(gnat_get_fixed_point_type_info): Remove const qualifiers for tree.
(gnat_get_array_descr_info): Likewise and set variables lazily.
Remove call to maybe_debug_type. Simplify a few computations.
(enumerate_modes): Remove const qualifier for tree.
* gcc-interface/utils.c (make_type_from_size): Adjust to renaming.
(maybe_pad_type): Remove IS_USER_TYPE parameter and adjust. Remove
specific code for implementation types for packed arrays.
(compute_deferred_decl_context): Remove const qualifier for tree.
(convert): Adjust call to maybe_pad_type.
(unchecked_convert): Likewise.
* gcc-interface/utils2.c (is_simple_additive_expressio): Likewise.
2020-05-09 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/utils2.c (build_binary_op) <ARRAY_RANGE_REF>: Use

14
gcc/ada/gcc-interface/ada-tree.h
View File

@ -73,15 +73,15 @@ do { \
#define TYPE_IS_FAT_POINTER_P(NODE) \
(TREE_CODE (NODE) == RECORD_TYPE && TYPE_FAT_POINTER_P (NODE))
/* For integral types and array types, nonzero if this is a packed array type
used for bit-packed types. Such types should not be extended to a larger
size or validated against a specified size. */
#define TYPE_PACKED_ARRAY_TYPE_P(NODE) \
/* For integral types and array types, nonzero if this is an implementation
type for a bit-packed array type. Such types should not be extended to a
larger size or validated against a specified size. */
#define TYPE_BIT_PACKED_ARRAY_TYPE_P(NODE) \
TYPE_LANG_FLAG_0 (TREE_CHECK2 (NODE, INTEGER_TYPE, ARRAY_TYPE))
#define TYPE_IS_PACKED_ARRAY_TYPE_P(NODE) \
#define BIT_PACKED_ARRAY_TYPE_P(NODE) \
((TREE_CODE (NODE) == INTEGER_TYPE || TREE_CODE (NODE) == ARRAY_TYPE) \
&& TYPE_PACKED_ARRAY_TYPE_P (NODE))
&& TYPE_BIT_PACKED_ARRAY_TYPE_P (NODE))
/* For FUNCTION_TYPE and METHOD_TYPE, nonzero if the function returns by
direct reference, i.e. the callee returns a pointer to a memory location
@ -196,7 +196,7 @@ do { \
types. */
#define TYPE_IMPL_PACKED_ARRAY_P(NODE) \
((TREE_CODE (NODE) == ARRAY_TYPE && TYPE_PACKED (NODE)) \
|| (TREE_CODE (NODE) == INTEGER_TYPE && TYPE_PACKED_ARRAY_TYPE_P (NODE)))
|| (TREE_CODE (NODE) == INTEGER_TYPE && TYPE_BIT_PACKED_ARRAY_TYPE_P (NODE)))
/* True for types that can hold a debug type. */
#define TYPE_CAN_HAVE_DEBUG_TYPE_P(NODE) (!TYPE_IMPL_PACKED_ARRAY_P (NODE))

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

@ -248,7 +248,7 @@ static tree create_variant_part_from (tree, vec<variant_desc>, tree,
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
@ -987,7 +987,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
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
@ -1754,9 +1754,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
{
/* 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
@ -1774,10 +1774,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
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,
@ -1856,8 +1856,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
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. */
@ -1934,11 +1933,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
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. */
@ -1960,19 +1954,30 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
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;
@ -2011,15 +2016,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
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));
}
}
@ -2033,9 +2038,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
/* 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);
@ -2112,7 +2121,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
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;
@ -2378,13 +2387,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
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)
@ -2752,6 +2763,24 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
}
}
/* 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
@ -2786,44 +2815,32 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
}
/* 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);
@ -3511,7 +3528,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
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
@ -4352,15 +4370,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
&& 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;
if (TYPE_IS_PADDING_P (gnu_type))
gnu_entity_name = TYPE_IDENTIFIER (gnu_type);
gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity,
false, definition, false);
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. */
@ -5107,9 +5130,10 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition,
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
@ -5123,9 +5147,9 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition,
/* 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)))
@ -5133,6 +5157,8 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition,
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
@ -5155,7 +5181,7 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition,
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;
@ -5166,7 +5192,7 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition,
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
@ -5193,7 +5219,7 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition,
= 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);
@ -5209,8 +5235,8 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition,
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);
@ -5846,8 +5872,8 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
}
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. */
@ -7193,7 +7219,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
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);
}
@ -7354,7 +7380,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
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
@ -8959,11 +8985,11 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
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;
@ -9061,16 +9087,13 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity)
/* 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))
@ -10025,39 +10048,43 @@ copy_and_substitute_in_layout (Entity_Id gnat_new_type,
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;
}
}
/* Given a type T, a FIELD_DECL F, and a replacement value R, return an

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

@ -138,14 +138,12 @@ extern tree make_type_from_size (tree type, tree size_tree, bool for_biased);
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. */
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 set_rm_size);
bool definition, bool set_rm_size);
/* Return true if padded TYPE was built with an RM size. */
extern bool pad_type_has_rm_size (tree type);

106
gcc/ada/gcc-interface/misc.c
View File

@ -602,20 +602,10 @@ gnat_enum_underlying_base_type (const_tree)
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
@ -650,14 +640,14 @@ gnat_get_fixed_point_type_info (const_tree type,
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
@ -786,14 +776,9 @@ static bool
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
@ -803,9 +788,6 @@ gnat_get_array_descr_info (const_tree const_type,
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))
@ -813,6 +795,8 @@ gnat_get_array_descr_info (const_tree const_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. */
@ -823,6 +807,7 @@ gnat_get_array_descr_info (const_tree const_type,
&& TYPE_INDEX_TYPE (TYPE_DOMAIN (type)))
{
is_array = true;
is_fat_ptr = false;
first_dimen = type;
info->data_location = NULL_TREE;
}
@ -830,18 +815,19 @@ gnat_get_array_descr_info (const_tree const_type,
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);
@ -861,17 +847,17 @@ gnat_get_array_descr_info (const_tree const_type,
/* 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),
@ -879,6 +865,8 @@ gnat_get_array_descr_info (const_tree const_type,
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
@ -890,36 +878,38 @@ gnat_get_array_descr_info (const_tree const_type,
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);
/* Count how many dimensions this array has. */
for (i = 0, dimen = first_dimen; ; ++i, dimen = TREE_TYPE (dimen))
{
if (i > 0
&& (TREE_CODE (dimen) != ARRAY_TYPE
|| !TYPE_MULTI_ARRAY_P (dimen)))
break;
last_dimen = dimen;
}
info->ndimensions = i;
info->rank = NULL_TREE;
/* 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))
{
i++;
dimen = TREE_TYPE (dimen);
}
info->ndimensions = i;
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
intermediate array type: be consistent and output nested arrays for all
@ -928,12 +918,10 @@ gnat_get_array_descr_info (const_tree const_type,
|| 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;
@ -1186,7 +1174,7 @@ must_pass_by_ref (tree gnu_type)
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" };

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

@ -1332,9 +1332,9 @@ make_type_from_size (tree type, tree size_tree, bool for_biased)
if (size == 0)
size = 1;
/* Only do something if the type isn't a packed array type and doesn't
already have the proper size and the size isn't too large. */
if (TYPE_IS_PACKED_ARRAY_TYPE_P (type)
/* Only do something if the type is not a bit-packed array type and does
not already have the proper size and the size is not too large. */
if (BIT_PACKED_ARRAY_TYPE_P (type)
|| (TYPE_PRECISION (type) == size && biased_p == for_biased)
|| size > LONG_LONG_TYPE_SIZE)
break;
@ -1457,15 +1457,14 @@ canonicalize_pad_type (tree type)
if needed. We have already verified that SIZE and ALIGN are large enough.
GNAT_ENTITY is used to name the resulting record and to issue a warning.
IS_COMPONENT_TYPE is true if this is being done for the component type of
an array. IS_USER_TYPE is true if the original type needs to be completed.
DEFINITION is true if this type is being defined. SET_RM_SIZE is true if
the RM size of the resulting type is to be set to SIZE too; in this case,
the padded type is canonicalized before being returned. */
an array. DEFINITION is true if this type is being defined. SET_RM_SIZE
is true if the RM size of the resulting type is to be set to SIZE too; in
this case, the padded type is canonicalized before being returned. */
tree
maybe_pad_type (tree type, tree size, unsigned int align,
Entity_Id gnat_entity, bool is_component_type,
bool is_user_type, bool definition, bool set_rm_size)
bool definition, bool set_rm_size)
{
tree orig_size = TYPE_SIZE (type);
unsigned int orig_align = TYPE_ALIGN (type);
@ -1509,31 +1508,13 @@ maybe_pad_type (tree type, tree size, unsigned int align,
if (align == 0 && !size)
return type;
/* If requested, complete the original type and give it a name. */
if (is_user_type)
create_type_decl (get_entity_name (gnat_entity), type,
!Comes_From_Source (gnat_entity),
!(TYPE_NAME (type)
&& TREE_CODE (TYPE_NAME (type)) == TYPE_DECL
&& DECL_IGNORED_P (TYPE_NAME (type))),
gnat_entity);
/* We used to modify the record in place in some cases, but that could
generate incorrect debugging information. So make a new record
type and name. */
record = make_node (RECORD_TYPE);
TYPE_PADDING_P (record) = 1;
/* ??? Padding types around packed array implementation types will be
considered as root types in the array descriptor language hook (see
gnat_get_array_descr_info). Give them the original packed array type
name so that the one coming from sources appears in the debugging
information. */
if (TYPE_IMPL_PACKED_ARRAY_P (type)
&& TYPE_ORIGINAL_PACKED_ARRAY (type)
&& gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
TYPE_NAME (record) = TYPE_NAME (TYPE_ORIGINAL_PACKED_ARRAY (type));
else if (Present (gnat_entity))
if (Present (gnat_entity))
TYPE_NAME (record) = create_concat_name (gnat_entity, "PAD");
SET_TYPE_ALIGN (record, align ? align : orig_align);
@ -1601,6 +1582,7 @@ maybe_pad_type (tree type, tree size, unsigned int align,
}
}
/* Make the inner type the debug type of the padded type. */
if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
SET_TYPE_DEBUG_TYPE (record, maybe_debug_type (type));
@ -3229,7 +3211,7 @@ compute_deferred_decl_context (Entity_Id gnat_scope)
if (TREE_CODE (context) == TYPE_DECL)
{
const tree context_type = TREE_TYPE (context);
tree context_type = TREE_TYPE (context);
/* Skip dummy types: only the final ones can appear in the context
chain. */
@ -4875,7 +4857,7 @@ convert (tree type, tree expr)
&& smaller_form_type_p (etype, type))
{
expr = convert (maybe_pad_type (etype, TYPE_SIZE (type), 0, Empty,
false, false, false, true),
false, false, true),
expr);
return build1 (VIEW_CONVERT_EXPR, type, expr);
}
@ -5495,14 +5477,14 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
if (c < 0)
{
expr = convert (maybe_pad_type (etype, TYPE_SIZE (type), 0, Empty,
false, false, false, true),
false, false, true),
expr);
expr = unchecked_convert (type, expr, notrunc_p);
}
else
{
tree rec_type = maybe_pad_type (type, TYPE_SIZE (etype), 0, Empty,
false, false, false, true);
false, false, true);
expr = unchecked_convert (rec_type, expr, notrunc_p);
expr = build_component_ref (expr, TYPE_FIELDS (rec_type), false);
}
@ -5520,14 +5502,14 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
if (c < 0)
{
expr = convert (maybe_pad_type (etype, new_size, 0, Empty,
false, false, false, true),
false, false, true),
expr);
expr = unchecked_convert (type, expr, notrunc_p);
}
else
{
tree rec_type = maybe_pad_type (type, TYPE_SIZE (etype), 0, Empty,
false, false, false, true);
false, false, true);
expr = unchecked_convert (rec_type, expr, notrunc_p);
expr = build_component_ref (expr, TYPE_FIELDS (rec_type), false);
}
@ -5572,7 +5554,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
&& TYPE_ALIGN (etype) < TYPE_ALIGN (type))
{
expr = convert (maybe_pad_type (etype, NULL_TREE, TYPE_ALIGN (type),
Empty, false, false, false, true),
Empty, false, false, true),
expr);
return unchecked_convert (type, expr, notrunc_p);
}
@ -5589,7 +5571,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
|| tree_int_cst_lt (TYPE_SIZE (etype), TYPE_SIZE (type))))
{
expr = convert (maybe_pad_type (etype, TYPE_SIZE (type), 0,
Empty, false, false, false, true),
Empty, false, false, true),
expr);
return unchecked_convert (type, expr, notrunc_p);
}

2
gcc/ada/gcc-interface/utils2.c
View File

@ -2927,7 +2927,7 @@ is_simple_additive_expression (tree expr, tree *add, tree *cst, bool *minus_p)
tree
gnat_invariant_expr (tree expr)
{
const tree type = TREE_TYPE (expr);
tree type = TREE_TYPE (expr);
tree add, cst;
bool minus_p;