From 6d02be94ee3643b17460b0a41ddb93ca588acf82 Mon Sep 17 00:00:00 2001
From: derodat <derodat@f8352e7e-cb20-0410-8ce7-b5d9e71c585c>
Date: Thu, 18 Dec 2014 12:45:52 +0000
Subject: [PATCH 8/8] 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.
---
gcc/ada/gcc-interface/ada-tree.h | 26 ++++++++
gcc/ada/gcc-interface/decl.c | 80 +++++++++++++++++++-----
gcc/ada/gcc-interface/misc.c | 131 ++++++++++++++++++++++++++++++++++-----
gcc/ada/gcc-interface/utils.c | 12 +++-
4 files changed, 220 insertions(+), 29 deletions(-)
@@ -183,6 +183,17 @@ do { \
/* True if TYPE can alias any other types. */
#define TYPE_UNIVERSAL_ALIASING_P(NODE) TYPE_LANG_FLAG_6 (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.
@@ -370,6 +381,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
@@ -1802,9 +1802,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:
@@ -1837,6 +1838,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);
@@ -1881,8 +1886,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);
}
@@ -2237,6 +2247,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);
@@ -2599,6 +2616,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);
@@ -2673,17 +2701,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)));
}
@@ -2694,6 +2725,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))
@@ -2750,6 +2788,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;
@@ -8779,12 +8818,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));
@@ -8798,7 +8839,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;
--
2.6.2