gcc/ada/ChangeLog:
* gcc-interface/decl.c (gnat_to_gnu_entity): When
-fgnat-encodings-minimal, do not add ___XUP/XUT suffixes to type
names and do not generate ___XA parallel types.
* gcc-interface/misc.c (gnat_get_array_descr_info): Match fat
and thin pointers and generate the corresponding array type
descriptions.
--
Pierre-Marie de Rodat
>From 27e94b46e4873b175682848e87ccc60bec9f98b2 Mon Sep 17 00:00:00 2001
From: derodat <derodat@f8352e7e-cb20-0410-8ce7-b5d9e71c585c>
Date: Fri, 3 Oct 2014 09:57:06 +0000
Subject: [PATCH 5/8] DWARF: describe Ada dynamic arrays as proper arrays
gcc/ada/ChangeLog:
* gcc-interface/decl.c (gnat_to_gnu_entity): When
-fgnat-encodings-minimal, do not add ___XUP/XUT suffixes to type
names and do not generate ___XA parallel types.
* gcc-interface/misc.c (gnat_get_array_descr_info): Match fat
and thin pointers and generate the corresponding array type
descriptions.
---
gcc/ada/gcc-interface/decl.c | 42 ++++++----
gcc/ada/gcc-interface/misc.c | 183 +++++++++++++++++++++++++++++++++++++------
2 files changed, 186 insertions(+), 39 deletions(-)
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index b629a7f..48b06f4 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -2280,22 +2280,31 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
create_type_decl (create_concat_name (gnat_entity, "XUA"), tem,
artificial_p, debug_info_p, gnat_entity);
- /* Give the fat pointer type a name. If this is a packed array, tell
- the debugger how to interpret the underlying bits. */
+ /* 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;
- create_type_decl (create_concat_name (gnat_name, "XUP"), gnu_fat_type,
- artificial_p, debug_info_p, gnat_entity);
+ if (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL)
+ gnu_entity_name = create_concat_name (gnat_name, "XUP");
+ create_type_decl (gnu_entity_name, gnu_fat_type, artificial_p,
+ debug_info_p, gnat_entity);
/* Create the type to be designated by thin pointers: a record type for
the array and its template. We used to shift the fields to have the
template at a negative offset, but this was somewhat of a kludge; we
now shift thin pointer values explicitly but only those which have a
- TYPE_UNCONSTRAINED_ARRAY attached to the designated RECORD_TYPE. */
- tem = build_unc_object_type (gnu_template_type, tem,
- create_concat_name (gnat_name, "XUT"),
+ TYPE_UNCONSTRAINED_ARRAY attached to the designated RECORD_TYPE.
+ Note that GDB can handle standard DWARF information for them, so we
+ don't have to name them as a GNAT encoding, except if specifically
+ asked to. */
+ if (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL)
+ gnu_entity_name = create_concat_name (gnat_name, "XUT");
+ else
+ gnu_entity_name = get_entity_name (gnat_name);
+ tem = build_unc_object_type (gnu_template_type, tem, gnu_entity_name,
debug_info_p);
SET_TYPE_UNCONSTRAINED_ARRAY (tem, gnu_type);
@@ -2528,14 +2537,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* We need special types for debugging information to point to
the index types if they have variable bounds, are not integer
- types or are biased. */
- if (TREE_CODE (gnu_orig_min) != INTEGER_CST
- || TREE_CODE (gnu_orig_max) != INTEGER_CST
- || TREE_CODE (gnu_index_type) != INTEGER_TYPE
- || (TREE_TYPE (gnu_index_type)
- && TREE_CODE (TREE_TYPE (gnu_index_type))
- != INTEGER_TYPE)
- || TYPE_BIASED_REPRESENTATION_P (gnu_index_type))
+ types, are biased or are wider than sizetype. These are GNAT
+ encodings, so we have to include them only when all encodings
+ are requested. */
+ if (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL
+ && (TREE_CODE (gnu_orig_min) != INTEGER_CST
+ || TREE_CODE (gnu_orig_max) != INTEGER_CST
+ || TREE_CODE (gnu_index_type) != INTEGER_TYPE
+ || (TREE_TYPE (gnu_index_type)
+ && TREE_CODE (TREE_TYPE (gnu_index_type))
+ != INTEGER_TYPE)
+ || TYPE_BIASED_REPRESENTATION_P (gnu_index_type)))
need_index_type_struct = true;
}
diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c
index d146051..318f566 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -731,38 +731,130 @@ static bool
gnat_get_array_descr_info (const_tree type, struct array_descr_info *info)
{
bool convention_fortran_p;
- tree index_type;
+ bool is_array = false;
+ bool is_fat_ptr = false;
- const_tree dimen = NULL_TREE;
+ const tree type_ = const_cast<tree> (type);
+
+ const_tree first_dimen = NULL_TREE;
const_tree last_dimen = NULL_TREE;
+ const_tree dimen;
int i;
- if (TREE_CODE (type) != ARRAY_TYPE
- || !TYPE_DOMAIN (type)
- || !TYPE_INDEX_TYPE (TYPE_DOMAIN (type)))
+ /* Temporaries created in the first pass and used in the second one for thin
+ pointers. The first one is an expression that yields the template record
+ from the base address (i.e. the PLACEHOLDER_EXPR). The second one is just
+ a cursor through this record's fields. */
+ tree thinptr_template_expr = NULL_TREE;
+ tree thinptr_bound_field = NULL_TREE;
+
+ /* First pass: gather all information about this array except everything
+ related to dimensions. */
+
+ /* Only handle ARRAY_TYPE nodes that come from GNAT. */
+ if (TREE_CODE (type) == ARRAY_TYPE
+ && TYPE_DOMAIN (type)
+ && TYPE_INDEX_TYPE (TYPE_DOMAIN (type)))
+ {
+ is_array = true;
+ first_dimen = type;
+ info->data_location = NULL_TREE;
+ }
+
+ else if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL
+ && TYPE_IS_FAT_POINTER_P (type))
+ {
+ const tree ua_type = TYPE_UNCONSTRAINED_ARRAY (type_);
+
+ /* This will be our base object address. */
+ const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type_);
+
+ /* We assume below that maybe_unconstrained_array returns an INDIRECT_REF
+ node. */
+ const tree ua_val
+ = maybe_unconstrained_array (build_unary_op (INDIRECT_REF,
+ ua_type,
+ placeholder_expr));
+
+ is_fat_ptr = true;
+ first_dimen = TREE_TYPE (ua_val);
+
+ /* Get the *address* of the array, not the array itself. */
+ info->data_location = TREE_OPERAND (ua_val, 0);
+ }
+
+ /* Unlike fat pointers (which appear for unconstrained arrays passed in
+ argument), thin pointers are used only for array access types, so we want
+ them to appear in the debug info as pointers to an array type. That's why
+ we match only the RECORD_TYPE here instead of the POINTER_TYPE with the
+ TYPE_IS_THIN_POINTER_P predicate. */
+ else if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL
+ && TREE_CODE (type) == RECORD_TYPE
+ && TYPE_CONTAINS_TEMPLATE_P (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);
+
+ 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);
+
+ /* Shift the thin pointer address to get the address of the template. */
+ const 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),
+ placeholder_addr, shift_amount);
+ template_addr
+ = fold_convert (TYPE_POINTER_TO (bounds_type), template_addr);
+
+ first_dimen = array_type;
+
+ /* The thin pointer is already the pointer to the array data, so there's
+ no need for a specific "data location" expression. */
+ info->data_location = NULL_TREE;
+
+ thinptr_template_expr = build_unary_op (INDIRECT_REF,
+ bounds_type,
+ template_addr);
+ thinptr_bound_field = TYPE_FIELDS (bounds_type);
+ }
+ else
return false;
- /* Count how many dimentions this array has. */
- for (i = 0, dimen = type; ; ++i, dimen = TREE_TYPE (dimen))
- if (i > 0
- && (TREE_CODE (dimen) != ARRAY_TYPE
- || !TYPE_MULTI_ARRAY_P (dimen)))
- break;
- info->ndimensions = i;
- convention_fortran_p = TYPE_CONVENTION_FORTRAN_P (type);
+ /* Second pass: compute the remaining information: dimensions and
+ corresponding bounds. */
- /* TODO: For row major ordering, we probably want to emit nothing and
+ /* 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);
+ /* TODO??? 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->base_decl = NULL_TREE;
- info->data_location = NULL_TREE;
- info->allocated = NULL_TREE;
- info->associated = NULL_TREE;
+ /* 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->element_type = TREE_TYPE (last_dimen);
+
+ /* Now iterate over all dimensions in source-order and fill the info
+ structure. */
for (i = (convention_fortran_p ? info->ndimensions - 1 : 0),
- dimen = type;
+ dimen = first_dimen;
0 <= i && i < info->ndimensions;
@@ -770,15 +862,58 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info)
dimen = TREE_TYPE (dimen))
{
/* We are interested in the stored bounds for the debug info. */
- index_type = TYPE_INDEX_TYPE (TYPE_DOMAIN (dimen));
+ tree index_type = TYPE_INDEX_TYPE (TYPE_DOMAIN (dimen));
+ if (is_array || is_fat_ptr)
+ {
+ /* GDB does not handle very well the self-referencial bound
+ expressions we are able to generate here for XUA types (they are
+ used only by XUP encodings) so avoid them in this case. Note that
+ there are two cases where we generate self-referencial bound
+ expressions: arrays that are constrained by record discriminants
+ and XUA types. */
+ const bool is_xua_type =
+ (TREE_CODE (TYPE_CONTEXT (first_dimen)) != RECORD_TYPE
+ && contains_placeholder_p (TYPE_MIN_VALUE (index_type)));
+
+ if (is_xua_type && gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL)
+ {
+ info->dimen[i].lower_bound = NULL_TREE;
+ info->dimen[i].upper_bound = NULL_TREE;
+ }
+ else
+ {
+ info->dimen[i].lower_bound = TYPE_MIN_VALUE (index_type);
+ info->dimen[i].upper_bound = TYPE_MAX_VALUE (index_type);
+ }
+ }
+
+ /* This is a thin pointer. */
+ else
+ {
+ info->dimen[i].lower_bound
+ = build_component_ref (thinptr_template_expr, NULL_TREE,
+ thinptr_bound_field, false);
+ thinptr_bound_field = DECL_CHAIN (thinptr_bound_field);
+
+ info->dimen[i].upper_bound
+ = build_component_ref (thinptr_template_expr, NULL_TREE,
+ thinptr_bound_field, false);
+ thinptr_bound_field = DECL_CHAIN (thinptr_bound_field);
+ }
+
+ /* The DWARF back-end will output exactly INDEX_TYPE as the array index'
+ "root" type, so pell subtypes when possible. */
+ while (TREE_TYPE (index_type) != NULL_TREE
+ && !subrange_type_for_debug_p (index_type, NULL, NULL))
+ index_type = TREE_TYPE (index_type);
info->dimen[i].bounds_type = index_type;
- info->dimen[i].lower_bound = TYPE_MIN_VALUE (index_type);
- info->dimen[i].upper_bound = TYPE_MAX_VALUE (index_type);
- last_dimen = dimen;
+ info->dimen[i].stride = NULL_TREE;
}
- info->element_type = TREE_TYPE (last_dimen);
+ /* These are Fortran-specific fields. They make no sense here. */
+ 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
--
2.4.5
