Commit 2d595887 by Pierre-Marie de Rodat Committed by Pierre-Marie de Rodat

DWARF: describe properly Ada packed arrays

gcc/ada/ChangeLog:

	* gcc-interface/ada-tree.h
	(TYPE_IMPLEMENTS_PACKED_ARRAY_P, TYPE_CAN_HAVE_DEBUG_TYPE_P,
	TYPE_ORIGINAL_PACKED_ARRAY, SET_TYPE_ORIGINAL_PACKED_ARRAY): New
	macros.
	* gcc-interface/decl.c (add_parallel_type_for_packed_array):
	Rename to associate_original_type_to_packed_array.  When
	-fgnat-encodings=minimal, set original packed array type as so
	instead of as a parallel type to the implementation type.  In
	this case, also rename the implementation type to the name of
	the original array type.
	(gnat_to_gnu_entity): Update invocations to
	add_parallel_type_for_packed_array.  Tag ARRAY_TYPE nodes for
	packed arrays with the TYPE_PACKED flag.
	When -fgnat-encodings=minimal:
	  - strip ___XP suffixes in packed arrays' names;
	  - set the debug type for padding records around packed arrays
	    to the packed array;
	  - do not attach ___XUP types as parallel types of constrained
	    array types.
	* gcc-interface/misc.c (gnat_print_type): Update to handle
	orignal packed arrays.
	(gnat_get_debug_type): Update to reject packed arrays
	implementation types.
	(get_array_bit_stride): New.
	(gnat_get_array_descr_info): Add packed arrays handling.
	* gcc-interface/utils.c (maybe_pad_type): When
	-fgnat-encodings=minimal, set the name of the padding type to
	the one of the original packed type, if any.  Fix TYPE_DECL
	peeling around the name of the input type.

From-SVN: r231768
parent 69c5f9d7
2015-12-17 Pierre-Marie de Rodat <derodat@adacore.com>
* gcc-interface/ada-tree.h
(TYPE_IMPLEMENTS_PACKED_ARRAY_P, TYPE_CAN_HAVE_DEBUG_TYPE_P,
TYPE_ORIGINAL_PACKED_ARRAY, SET_TYPE_ORIGINAL_PACKED_ARRAY): New
macros.
* gcc-interface/decl.c (add_parallel_type_for_packed_array):
Rename to associate_original_type_to_packed_array. When
-fgnat-encodings=minimal, set original packed array type as so
instead of as a parallel type to the implementation type. In
this case, also rename the implementation type to the name of
the original array type.
(gnat_to_gnu_entity): Update invocations to
add_parallel_type_for_packed_array. Tag ARRAY_TYPE nodes for
packed arrays with the TYPE_PACKED flag.
When -fgnat-encodings=minimal:
- strip ___XP suffixes in packed arrays' names;
- set the debug type for padding records around packed arrays
to the packed array;
- do not attach ___XUP types as parallel types of constrained
array types.
* gcc-interface/misc.c (gnat_print_type): Update to handle
orignal packed arrays.
(gnat_get_debug_type): Update to reject packed arrays
implementation types.
(get_array_bit_stride): New.
(gnat_get_array_descr_info): Add packed arrays handling.
* gcc-interface/utils.c (maybe_pad_type): When
-fgnat-encodings=minimal, set the name of the padding type to
the one of the original packed type, if any. Fix TYPE_DECL
peeling around the name of the input type.
2015-12-17 Pierre-Marie de Rodat <derodat@adacore.com>
* gcc-interface/misc.c (gnat_get_type_bias): New.
(LANG_HOOKS_GET_TYPE_BIAS): Redefine macro to implement the
get_type_bias language hook.
......
......@@ -187,6 +187,17 @@ do { \
alignment value the type ought to have. */
#define TYPE_MAX_ALIGN(NODE) (TYPE_PRECISION (RECORD_OR_UNION_CHECK (NODE)))
/* True for types that implement a packed array and for original packed array
types. */
#define TYPE_IMPLEMENTS_PACKED_ARRAY_P(NODE) \
((TREE_CODE (NODE) == ARRAY_TYPE && TYPE_PACKED (NODE)) \
|| (TREE_CODE (NODE) == INTEGER_TYPE && TYPE_PACKED_ARRAY_TYPE_P (NODE))) \
/* True for types that can hold a debug type. */
#define TYPE_CAN_HAVE_DEBUG_TYPE_P(NODE) \
(!TYPE_IMPLEMENTS_PACKED_ARRAY_P (NODE) \
&& TYPE_DEBUG_TYPE (NODE) != NULL_TREE)
/* For an UNCONSTRAINED_ARRAY_TYPE, this is the record containing both the
template and the object.
......@@ -374,6 +385,21 @@ do { \
#define SET_TYPE_SCALE_FACTOR(NODE, X) \
SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X)
/* For types with TYPE_CAN_HAVE_DEBUG_TYPE_P, this is the type to use in
debugging information. */
#define TYPE_DEBUG_TYPE(NODE) \
GET_TYPE_LANG_SPECIFIC2(NODE)
#define SET_TYPE_DEBUG_TYPE(NODE, X) \
SET_TYPE_LANG_SPECIFIC2(NODE, X)
/* For types with TYPE_IMPLEMENTS_PACKED_ARRAY_P, this is the original packed
array type. Note that this predicate is trou for original packed array
types, so these cannot have a debug type. */
#define TYPE_ORIGINAL_PACKED_ARRAY(NODE) \
GET_TYPE_LANG_SPECIFIC2(NODE)
#define SET_TYPE_ORIGINAL_PACKED_ARRAY(NODE, X) \
SET_TYPE_LANG_SPECIFIC2(NODE, X)
/* Flags added to decl nodes. */
......
......@@ -195,7 +195,7 @@ static tree get_rep_part (tree);
static tree create_variant_part_from (tree, vec<variant_desc> , tree,
tree, vec<subst_pair> );
static void copy_and_substitute_in_size (tree, tree, vec<subst_pair> );
static void add_parallel_type_for_packed_array (tree, Entity_Id);
static void 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
......@@ -1806,9 +1806,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int 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 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))
add_parallel_type_for_packed_array (gnu_type, gnat_entity);
associate_original_type_to_packed_array (gnu_type, gnat_entity);
discrete_type:
......@@ -1841,6 +1842,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
UI_To_gnu (RM_Size (gnat_entity), bitsizetype));
TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = 1;
/* Strip the ___XP suffix for standard DWARF. */
if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
gnu_entity_name = TYPE_NAME (gnu_type);
/* Create a stripped-down declaration, mainly for debugging. */
create_type_decl (gnu_entity_name, gnu_type, true, debug_info_p,
gnat_entity);
......@@ -1885,8 +1890,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
if (debug_info_p)
{
/* Make the original array type a parallel type. */
add_parallel_type_for_packed_array (gnu_type, gnat_entity);
/* 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);
rest_of_record_type_compilation (gnu_type);
}
......@@ -2241,6 +2251,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
TYPE_CONVENTION_FORTRAN_P (tem) = convention_fortran_p;
/* 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 (tem)
= (Is_Packed (gnat_entity)
|| Is_Packed_Array_Impl_Type (gnat_entity));
if (Treat_As_Volatile (gnat_entity))
tem = change_qualified_type (tem, TYPE_QUAL_VOLATILE);
......@@ -2603,6 +2620,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
TYPE_NONALIASED_COMPONENT (gnu_type) = 1;
}
/* Strip the ___XP suffix for standard DWARF. */
if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL
&& Is_Packed_Array_Impl_Type (gnat_entity))
{
Entity_Id gnat_original_array_type
= Underlying_Type (Original_Array_Type (gnat_entity));
gnu_entity_name
= get_entity_name (gnat_original_array_type);
}
/* Attach the TYPE_STUB_DECL in case we have a parallel type. */
TYPE_STUB_DECL (gnu_type)
= create_type_stub_decl (gnu_entity_name, gnu_type);
......@@ -2677,17 +2705,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
}
/* If this is a packed array type, make the original array type a
parallel type. Otherwise, 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 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. */
if (debug_info_p)
{
if (Is_Packed_Array_Impl_Type (gnat_entity))
add_parallel_type_for_packed_array (gnu_type, gnat_entity);
associate_original_type_to_packed_array (gnu_type,
gnat_entity);
else
{
tree gnu_base_decl
= gnat_to_gnu_entity (Etype (gnat_entity), NULL_TREE, 0);
if (!DECL_ARTIFICIAL (gnu_base_decl))
if (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL
&& !DECL_ARTIFICIAL (gnu_base_decl))
add_parallel_type (gnu_type,
TREE_TYPE (TREE_TYPE (gnu_base_decl)));
}
......@@ -2698,6 +2729,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
= (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 size is self-referential and the maximum size doesn't
overflow, use it. */
if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
......@@ -2754,6 +2792,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
NULL_TREE, 0);
this_made_decl = true;
gnu_type = TREE_TYPE (gnu_decl);
save_gnu_tree (gnat_entity, NULL_TREE, false);
gnu_inner = gnu_type;
......@@ -8832,12 +8871,14 @@ copy_and_substitute_in_size (tree new_type, tree old_type,
TYPE_SIZE_UNIT (new_type) = variable_size (TYPE_SIZE_UNIT (new_type));
}
/* Add a parallel type to GNU_TYPE, the translation of GNAT_ENTITY, which is
the implementation type of a packed array type (Is_Packed_Array_Impl_Type).
The parallel type is the original array type if it has been translated. */
/* 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. */
static void
add_parallel_type_for_packed_array (tree gnu_type, Entity_Id gnat_entity)
associate_original_type_to_packed_array (tree gnu_type, Entity_Id gnat_entity)
{
Entity_Id gnat_original_array_type
= Underlying_Type (Original_Array_Type (gnat_entity));
......@@ -8851,7 +8892,18 @@ add_parallel_type_for_packed_array (tree gnu_type, Entity_Id gnat_entity)
if (TYPE_IS_DUMMY_P (gnu_original_array_type))
return;
add_parallel_type (gnu_type, gnu_original_array_type);
if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
{
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;
}
else
add_parallel_type (gnu_type, gnu_original_array_type);
}
/* Given a type T, a FIELD_DECL F, and a replacement value R, return a
......
......@@ -528,9 +528,12 @@ gnat_print_type (FILE *file, tree node, int indent)
break;
}
if (TYPE_DEBUG_TYPE (node) != NULL_TREE)
print_node_brief (file, "debug type", TYPE_DEBUG_TYPE (node),
indent + 4);
if (TYPE_CAN_HAVE_DEBUG_TYPE_P (node) && TYPE_DEBUG_TYPE (node) != NULL_TREE)
print_node_brief (file, "debug type", TYPE_DEBUG_TYPE (node), indent + 4);
else if (TYPE_IMPLEMENTS_PACKED_ARRAY_P (node)
&& TYPE_ORIGINAL_PACKED_ARRAY (node) != NULL_TREE)
print_node_brief (file, "original packed array",
TYPE_ORIGINAL_PACKED_ARRAY (node), indent + 4);
}
/* Return the name to be printed for DECL. */
......@@ -578,7 +581,18 @@ gnat_descriptive_type (const_tree type)
static tree
gnat_get_debug_type (const_tree type)
{
return TYPE_DEBUG_TYPE (type);
if (TYPE_CAN_HAVE_DEBUG_TYPE_P (type))
{
type = TYPE_DEBUG_TYPE (type);
/* ??? Kludge: 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 (when the DWARF back-end
processes the type of a variable), so keep this guard. */
if (type != NULL_TREE && !TYPE_IMPLEMENTS_PACKED_ARRAY_P (type))
return const_cast<tree> (type);
}
return NULL_TREE;
}
/* Provide information in INFO for debugging output about the TYPE fixed-point
......@@ -732,17 +746,21 @@ gnat_type_max_size (const_tree gnu_type)
return max_unitsize;
}
static tree get_array_bit_stride (tree comp_type);
/* Provide information in INFO for debug output about the TYPE array type.
Return whether TYPE is handled. */
static bool
gnat_get_array_descr_info (const_tree type, struct array_descr_info *info)
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;
const tree type_ = const_cast<tree> (type);
tree type = const_cast<tree> (const_type);
const_tree first_dimen = NULL_TREE;
const_tree last_dimen = NULL_TREE;
......@@ -756,6 +774,20 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info)
tree thinptr_template_expr = NULL_TREE;
tree thinptr_bound_field = NULL_TREE;
/* ??? Kludge: see gnat_get_debug_type. */
if (TYPE_CAN_HAVE_DEBUG_TYPE_P (type)
&& TYPE_DEBUG_TYPE (type) != NULL_TREE)
type = TYPE_DEBUG_TYPE (type);
/* If we have an implementation type for a packed array, get the orignial
array type. */
if (TYPE_IMPLEMENTS_PACKED_ARRAY_P (type)
&& TYPE_ORIGINAL_PACKED_ARRAY (type) != NULL_TREE)
{
is_packed_array = true;
type = TYPE_ORIGINAL_PACKED_ARRAY (type);
}
/* First pass: gather all information about this array except everything
related to dimensions. */
......@@ -772,10 +804,10 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info)
else if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL
&& TYPE_IS_FAT_POINTER_P (type))
{
const tree ua_type = TYPE_UNCONSTRAINED_ARRAY (type_);
const tree ua_type = TYPE_UNCONSTRAINED_ARRAY (type);
/* This will be our base object address. */
const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type_);
const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type);
/* We assume below that maybe_unconstrained_array returns an INDIRECT_REF
node. */
......@@ -803,7 +835,7 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info)
/* 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_expr = build0 (PLACEHOLDER_EXPR, type);
const tree placeholder_addr
= build_unary_op (ADDR_EXPR, NULL_TREE, placeholder_expr);
......@@ -838,6 +870,8 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info)
/* 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);
......@@ -937,13 +971,13 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info)
info->allocated = NULL_TREE;
info->associated = NULL_TREE;
/* When arrays contain dynamically-sized elements, we usually wrap them in
padding types, or we create constrained types for them. Then, if such
types are stripped in the debugging information output, the debugger needs
a way to know the size that is reserved for each element. This is why we
emit a stride in such situations. */
if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
{
/* When arrays contain dynamically-sized elements, we usually wrap them
in padding types, or we create constrained types for them. Then, if
such types are stripped in the debugging information output, the
debugger needs a way to know the size that is reserved for each
element. This is why we emit a stride in such situations. */
tree source_element_type = info->element_type;
while (1)
......@@ -962,11 +996,80 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info)
info->stride = TYPE_SIZE_UNIT (info->element_type);
info->stride_in_bits = false;
}
/* We need to specify a bit stride when it does not correspond to the
natural size of the contained elements. ??? Note that we do not
support packed records and nested packed arrays. */
else if (is_packed_array)
{
info->stride = get_array_bit_stride (info->element_type);
info->stride_in_bits = true;
}
}
return true;
}
/* Given the component type COMP_TYPE of a packed array, return an expression
that computes the bit stride of this packed array. Return NULL_TREE when
unsuccessful. */
static tree
get_array_bit_stride (tree comp_type)
{
struct array_descr_info info;
tree stride;
/* Simple case: the array contains an integral type: return its RM size. */
if (INTEGRAL_TYPE_P (comp_type))
return TYPE_RM_SIZE (comp_type);
/* Otherwise, see if this is an array we can analyze. */
memset (&info, 0, sizeof (info));
if (!gnat_get_array_descr_info (comp_type, &info)
|| info.stride == NULL_TREE)
/* If it's not, give it up. */
return NULL_TREE;
/* Otherwise, the array stride is the inner array's stride multiplied by the
number of elements it contains. Note that if the inner array is not
packed, then the stride is "natural" and thus does not deserve an
attribute. */
stride = info.stride;
if (!info.stride_in_bits)
{
stride = fold_convert (bitsizetype, stride);
stride = build_binary_op (MULT_EXPR, bitsizetype,
stride, build_int_cstu (bitsizetype, 8));
}
for (int i = 0; i < info.ndimensions; ++i)
{
tree count;
if (info.dimen[i].lower_bound == NULL_TREE
|| info.dimen[i].upper_bound == NULL_TREE)
return NULL_TREE;
/* Put in count an expression that computes the length of this
dimension. */
count = build_binary_op (MINUS_EXPR, sbitsizetype,
fold_convert (sbitsizetype,
info.dimen[i].upper_bound),
fold_convert (sbitsizetype,
info.dimen[i].lower_bound)),
count = build_binary_op (PLUS_EXPR, sbitsizetype,
count, build_int_cstu (sbitsizetype, 1));
count = build_binary_op (MAX_EXPR, sbitsizetype,
count,
build_int_cstu (sbitsizetype, 0));
count = fold_convert (bitsizetype, count);
stride = build_binary_op (MULT_EXPR, bitsizetype, stride, count);
}
return stride;
}
/* GNU_TYPE is a subtype of an integral type. Set LOWVAL to the low bound
and HIGHVAL to the high bound, respectively. */
......
......@@ -1281,7 +1281,17 @@ maybe_pad_type (tree type, tree size, unsigned int align,
if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
SET_TYPE_DEBUG_TYPE (record, type);
if (Present (gnat_entity))
/* ??? Kludge: 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 (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL
&& TYPE_IMPLEMENTS_PACKED_ARRAY_P (type)
&& TYPE_ORIGINAL_PACKED_ARRAY (type) != NULL_TREE)
TYPE_NAME (record)
= TYPE_NAME (TYPE_ORIGINAL_PACKED_ARRAY (type));
else if (Present (gnat_entity))
TYPE_NAME (record) = create_concat_name (gnat_entity, "PAD");
TYPE_ALIGN (record) = align ? align : orig_align;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment