On Wed, Sep 03, 2014 at 10:36:21AM +0200, Pierre-Marie de Rodat wrote:
> --- a/gcc/dwarf2out.c
> +++ b/gcc/dwarf2out.c
> @@ -17359,18 +17359,36 @@ static void
> gen_descr_array_type_die (tree type, struct array_descr_info *info,
> dw_die_ref context_die)
> {
> - dw_die_ref scope_die = scope_die_for (type, context_die);
> + dw_die_ref scope_die;
> dw_die_ref array_die;
> int dim;
>
> + /* Instead of producing a dedicated DW_TAG_array_type DIE for this type,
> let
> + the circuitry wrap the main variant with DIEs for qualifiers (for
> + instance: DW_TAG_const_type, ...). */
> + if (type != TYPE_MAIN_VARIANT (type))
> + {
> + gen_type_die (TYPE_MAIN_VARIANT (type), context_die);
> + return;
> + }
I don't like this, can you explain why? I'd say that if you only want
to see TYPE_MAIN_VARIANT here, it should be responsibility of the callers
to ensure that.
> @@ -19941,7 +19991,8 @@ gen_type_die_with_usage (tree type, dw_die_ref
> context_die,
> /* If this is an array type with hidden descriptor, handle it first. */
> if (!TREE_ASM_WRITTEN (type)
> && lang_hooks.types.get_array_descr_info
> - && lang_hooks.types.get_array_descr_info (type, &info)
> + && lang_hooks.types.get_array_descr_info (type,
> + init_array_descr_info (&info))
Just memset it to 0 instead?
> + enum array_descr_ordering ordering;
> tree element_type;
> tree base_decl;
> tree data_location;
> tree allocated;
> tree associated;
> +
Why the extra vertical space?
> struct array_descr_dimen
> {
> >From 0d683ca8c1fcf8d780928f1cd629e7a99651c9c0 Mon Sep 17 00:00:00 2001
> From: Pierre-Marie de Rodat <dero...@adacore.com>
> Date: Wed, 3 Sep 2014 09:46:25 +0200
> Subject: [PATCH 2/5] Enable the array descr language hook for all DWARF
> versions
>
> * dwarf2out.c (gen_type_die_with_usage): Enable the array lang-hook
> even when (dwarf_version < 3 && dwarf_strict).
> (gen_descr_array_die): Do not output DW_AT_data_locationn,
> DW_AT_associated, DW_AT_allocated and DW_AT_byte_stride DWARF
> attributes when (dwarf_version < 3 && dwarf_strict).
This patch sounds very wrong. DW_OP_push_object_address is not in DWARF2
either, and that is the basis of all the fields, so there is really nothing
you can really output correctly for DWARF2. It isn't the default on sane
targets, where GCC defaults to DWARF4 these days, so why bother?
> #include "real.h"
> #include "function.h" /* For pass_by_reference. */
> +#include "dwarf2out.h"
>
> #include "ada.h"
> #include "adadecode.h"
> @@ -626,6 +627,64 @@ gnat_type_max_size (const_tree gnu_type)
> return max_unitsize;
> }
>
> +/* 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)
> +{
> + bool convention_fortran_p;
> + tree index_type;
> +
> + const_tree dimen, last_dimen;
> + int i;
> +
> + if (TREE_CODE (type) != ARRAY_TYPE
> + || !TYPE_DOMAIN (type)
> + || !TYPE_INDEX_TYPE (TYPE_DOMAIN (type)))
> + 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);
> +
> + /* 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;
> +
> + for (i = (convention_fortran_p ? info->ndimensions - 1 : 0),
> + dimen = type;
> +
> + 0 <= i && i < info->ndimensions;
> +
> + i += (convention_fortran_p ? -1 : 1),
> + dimen = TREE_TYPE (dimen))
> + {
> + /* We are interested in the stored bounds for the debug info. */
> + index_type = TYPE_INDEX_TYPE (TYPE_DOMAIN (dimen));
> +
> + 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->element_type = TREE_TYPE (last_dimen);
> +
> + return true;
> +}
> +
> /* GNU_TYPE is a subtype of an integral type. Set LOWVAL to the low bound
> and HIGHVAL to the high bound, respectively. */
>
> @@ -916,6 +975,8 @@ gnat_init_ts (void)
> #define LANG_HOOKS_TYPE_FOR_SIZE gnat_type_for_size
> #undef LANG_HOOKS_TYPES_COMPATIBLE_P
> #define LANG_HOOKS_TYPES_COMPATIBLE_P gnat_types_compatible_p
> +#undef LANG_HOOKS_GET_ARRAY_DESCR_INFO
> +#define LANG_HOOKS_GET_ARRAY_DESCR_INFO gnat_get_array_descr_info
> #undef LANG_HOOKS_GET_SUBRANGE_BOUNDS
> #define LANG_HOOKS_GET_SUBRANGE_BOUNDS gnat_get_subrange_bounds
> #undef LANG_HOOKS_DESCRIPTIVE_TYPE
> --
> 2.1.0
>
> >From 166fcbad8529818e492c57b7b9091799bf3ae72d Mon Sep 17 00:00:00 2001
> From: Pierre-Marie de Rodat <dero...@adacore.com>
> Date: Wed, 3 Sep 2014 09:46:29 +0200
> Subject: [PATCH 4/5] Add a few debug utilities for DWARF expressions
>
> * dwarf2out.c (print_loc_descr): New.
> (print_dw_val): New.
> (print_attribute): New.
> (print_loc_descr): New.
> (print_die): Use print_dw_val.
> (debug_dwarf_loc_descr): New.
> * dwarf2out.h (debug_dwarf_loc_descr): New declaration.
> ---
> gcc/dwarf2out.c | 277
> +++++++++++++++++++++++++++++++++++---------------------
> gcc/dwarf2out.h | 1 +
> 2 files changed, 176 insertions(+), 102 deletions(-)
>
> diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c
> index 78a470f..1638da4 100644
> --- a/gcc/dwarf2out.c
> +++ b/gcc/dwarf2out.c
> @@ -5337,6 +5337,172 @@ print_signature (FILE *outfile, char *sig)
> fprintf (outfile, "%02x", sig[i] & 0xff);
> }
>
> +static void print_loc_descr (dw_loc_descr_ref, FILE *);
> +
> +/* Print the value associated to the VAL DWARF value node to OUTFILE. If
> + RECURSE, output location descriptor operations. */
> +
> +static void
> +print_dw_val (dw_val_node *val, bool recurse, FILE *outfile)
> +{
> + switch (val->val_class)
> + {
> + case dw_val_class_addr:
> + fprintf (outfile, "address");
> + break;
> + case dw_val_class_offset:
> + fprintf (outfile, "offset");
> + break;
> + case dw_val_class_loc:
> + fprintf (outfile, "location descriptor");
> + if (val->v.val_loc == NULL)
> + fprintf (outfile, " -> <null>\n");
> + else if (recurse)
> + {
> + fprintf (outfile, ":\n");
> + print_indent += 4;
> + print_loc_descr (val->v.val_loc, outfile);
> + print_indent -= 4;
> + }
> + else
> + fprintf (outfile, " (%p)\n", (void *) val->v.val_loc);
> + break;
> + case dw_val_class_loc_list:
> + fprintf (outfile, "location list -> label:%s",
> + val->v.val_loc_list->ll_symbol);
> + break;
> + case dw_val_class_range_list:
> + fprintf (outfile, "range list");
> + break;
> + case dw_val_class_const:
> + fprintf (outfile, HOST_WIDE_INT_PRINT_DEC, val->v.val_int);
> + break;
> + case dw_val_class_unsigned_const:
> + fprintf (outfile, HOST_WIDE_INT_PRINT_UNSIGNED, val->v.val_unsigned);
> + break;
> + case dw_val_class_const_double:
> + fprintf (outfile, "constant ("HOST_WIDE_INT_PRINT_DEC","\
> + HOST_WIDE_INT_PRINT_UNSIGNED")",
> + val->v.val_double.high,
> + val->v.val_double.low);
> + break;
> + case dw_val_class_wide_int:
> + {
> + int i = val->v.val_wide->get_len ();
> + fprintf (outfile, "constant (");
> + gcc_assert (i > 0);
> + if (val->v.val_wide->elt (i - 1) == 0)
> + fprintf (outfile, "0x");
> + fprintf (outfile, HOST_WIDE_INT_PRINT_HEX,
> + val->v.val_wide->elt (--i));
> + while (--i >= 0)
> + fprintf (outfile, HOST_WIDE_INT_PRINT_PADDED_HEX,
> + val->v.val_wide->elt (i));
> + fprintf (outfile, ")");
> + break;
> + }
> + case dw_val_class_vec:
> + fprintf (outfile, "floating-point or vector constant");
> + break;
> + case dw_val_class_flag:
> + fprintf (outfile, "%u", val->v.val_flag);
> + break;
> + case dw_val_class_die_ref:
> + if (val->v.val_die_ref.die != NULL)
> + {
> + dw_die_ref die = val->v.val_die_ref.die;
> +
> + if (die->comdat_type_p)
> + {
> + fprintf (outfile, "die -> signature: ");
> + print_signature (outfile,
> + die->die_id.die_type_node->signature);
> + }
> + else if (die->die_id.die_symbol)
> + fprintf (outfile, "die -> label: %s", die->die_id.die_symbol);
> + else
> + fprintf (outfile, "die -> %ld", die->die_offset);
> + fprintf (outfile, " (%p)", (void *) die);
> + }
> + else
> + fprintf (outfile, "die -> <null>");
> + break;
> + case dw_val_class_vms_delta:
> + fprintf (outfile, "delta: @slotcount(%s-%s)",
> + val->v.val_vms_delta.lbl2, val->v.val_vms_delta.lbl1);
> + break;
> + case dw_val_class_lbl_id:
> + case dw_val_class_lineptr:
> + case dw_val_class_macptr:
> + case dw_val_class_high_pc:
> + fprintf (outfile, "label: %s", val->v.val_lbl_id);
> + break;
> + case dw_val_class_str:
> + if (val->v.val_str->str != NULL)
> + fprintf (outfile, "\"%s\"", val->v.val_str->str);
> + else
> + fprintf (outfile, "<null>");
> + break;
> + case dw_val_class_file:
> + fprintf (outfile, "\"%s\" (%d)", val->v.val_file->filename,
> + val->v.val_file->emitted_number);
> + break;
> + case dw_val_class_data8:
> + {
> + int i;
> +
> + for (i = 0; i < 8; i++)
> + fprintf (outfile, "%02x", val->v.val_data8[i]);
> + break;
> + }
> + default:
> + break;
> + }
> +}
> +
> +/* Likewise, for a DIE attribute. */
> +
> +static void
> +print_attribute (dw_attr_ref a, bool recurse, FILE *outfile)
> +{
> + print_dw_val (&a->dw_attr_val, recurse, outfile);
> +}
> +
> +/* Print the list of operands in the LOC location description to OUTFILE.
> This
> + routine is a debugging aid only. */
> +
> +static void
> +print_loc_descr (dw_loc_descr_ref loc, FILE *outfile)
> +{
> + dw_loc_descr_ref l = loc;
> +
> + if (loc == NULL)
> + {
> + print_spaces (outfile);
> + fprintf (outfile, "<null>\n");
> + return;
> + }
> +
> + for (l = loc; l != NULL; l = l->dw_loc_next)
> + {
> + print_spaces (outfile);
> + fprintf (outfile, "(%p) %s",
> + (void *) l,
> + dwarf_stack_op_name (l->dw_loc_opc));
> + if (l->dw_loc_oprnd1.val_class != dw_val_class_none)
> + {
> + fprintf (outfile, " ");
> + print_dw_val (&l->dw_loc_oprnd1, false, outfile);
> + }
> + if (l->dw_loc_oprnd2.val_class != dw_val_class_none)
> + {
> + fprintf (outfile, ", ");
> + print_dw_val (&l->dw_loc_oprnd2, false, outfile);
> + }
> + fprintf (outfile, "\n");
> + }
> +}
> +
> /* Print the information associated with a given DIE, and its children.
> This routine is a debugging aid only. */
>
> @@ -5369,108 +5535,7 @@ print_die (dw_die_ref die, FILE *outfile)
> print_spaces (outfile);
> fprintf (outfile, " %s: ", dwarf_attr_name (a->dw_attr));
>
> - switch (AT_class (a))
> - {
> - case dw_val_class_addr:
> - fprintf (outfile, "address");
> - break;
> - case dw_val_class_offset:
> - fprintf (outfile, "offset");
> - break;
> - case dw_val_class_loc:
> - fprintf (outfile, "location descriptor");
> - break;
> - case dw_val_class_loc_list:
> - fprintf (outfile, "location list -> label:%s",
> - AT_loc_list (a)->ll_symbol);
> - break;
> - case dw_val_class_range_list:
> - fprintf (outfile, "range list");
> - break;
> - case dw_val_class_const:
> - fprintf (outfile, HOST_WIDE_INT_PRINT_DEC, AT_int (a));
> - break;
> - case dw_val_class_unsigned_const:
> - fprintf (outfile, HOST_WIDE_INT_PRINT_UNSIGNED, AT_unsigned (a));
> - break;
> - case dw_val_class_const_double:
> - fprintf (outfile, "constant ("HOST_WIDE_INT_PRINT_DEC","\
> - HOST_WIDE_INT_PRINT_UNSIGNED")",
> - a->dw_attr_val.v.val_double.high,
> - a->dw_attr_val.v.val_double.low);
> - break;
> - case dw_val_class_wide_int:
> - {
> - int i = a->dw_attr_val.v.val_wide->get_len ();
> - fprintf (outfile, "constant (");
> - gcc_assert (i > 0);
> - if (a->dw_attr_val.v.val_wide->elt (i - 1) == 0)
> - fprintf (outfile, "0x");
> - fprintf (outfile, HOST_WIDE_INT_PRINT_HEX,
> - a->dw_attr_val.v.val_wide->elt (--i));
> - while (--i >= 0)
> - fprintf (outfile, HOST_WIDE_INT_PRINT_PADDED_HEX,
> - a->dw_attr_val.v.val_wide->elt (i));
> - fprintf (outfile, ")");
> - break;
> - }
> - case dw_val_class_vec:
> - fprintf (outfile, "floating-point or vector constant");
> - break;
> - case dw_val_class_flag:
> - fprintf (outfile, "%u", AT_flag (a));
> - break;
> - case dw_val_class_die_ref:
> - if (AT_ref (a) != NULL)
> - {
> - if (AT_ref (a)->comdat_type_p)
> - {
> - fprintf (outfile, "die -> signature: ");
> - print_signature (outfile,
> - AT_ref (a)->die_id.die_type_node->signature);
> - }
> - else if (AT_ref (a)->die_id.die_symbol)
> - fprintf (outfile, "die -> label: %s",
> - AT_ref (a)->die_id.die_symbol);
> - else
> - fprintf (outfile, "die -> %ld", AT_ref (a)->die_offset);
> - fprintf (outfile, " (%p)", (void *) AT_ref (a));
> - }
> - else
> - fprintf (outfile, "die -> <null>");
> - break;
> - case dw_val_class_vms_delta:
> - fprintf (outfile, "delta: @slotcount(%s-%s)",
> - AT_vms_delta2 (a), AT_vms_delta1 (a));
> - break;
> - case dw_val_class_lbl_id:
> - case dw_val_class_lineptr:
> - case dw_val_class_macptr:
> - case dw_val_class_high_pc:
> - fprintf (outfile, "label: %s", AT_lbl (a));
> - break;
> - case dw_val_class_str:
> - if (AT_string (a) != NULL)
> - fprintf (outfile, "\"%s\"", AT_string (a));
> - else
> - fprintf (outfile, "<null>");
> - break;
> - case dw_val_class_file:
> - fprintf (outfile, "\"%s\" (%d)", AT_file (a)->filename,
> - AT_file (a)->emitted_number);
> - break;
> - case dw_val_class_data8:
> - {
> - int i;
> -
> - for (i = 0; i < 8; i++)
> - fprintf (outfile, "%02x", a->dw_attr_val.v.val_data8[i]);
> - break;
> - }
> - default:
> - break;
> - }
> -
> + print_attribute (a, true, outfile);
> fprintf (outfile, "\n");
> }
>
> @@ -5484,6 +5549,14 @@ print_die (dw_die_ref die, FILE *outfile)
> fprintf (outfile, "\n");
> }
>
> +/* Print the list of operations in the LOC location description. */
> +
> +DEBUG_FUNCTION void
> +debug_dwarf_loc_descr (dw_loc_descr_ref loc)
> +{
> + print_loc_descr (loc, stderr);
> +}
> +
> /* Print the information collected for a given DIE. */
>
> DEBUG_FUNCTION void
> diff --git a/gcc/dwarf2out.h b/gcc/dwarf2out.h
> index 8b03e78..fbcb70a 100644
> --- a/gcc/dwarf2out.h
> +++ b/gcc/dwarf2out.h
> @@ -254,6 +254,7 @@ extern void dwarf2out_emit_cfi (dw_cfi_ref cfi);
> extern void debug_dwarf (void);
> struct die_struct;
> extern void debug_dwarf_die (struct die_struct *);
> +extern void debug_dwarf_loc_descr (dw_loc_descr_ref);
> extern void debug (die_struct &ref);
> extern void debug (die_struct *ptr);
> extern void dwarf2out_set_demangle_name_func (const char *(*) (const char
> *));
> --
> 2.1.0
>
> >From e029b9300c58a0ffbfa1b7f81381a937a60b27fd Mon Sep 17 00:00:00 2001
> From: Pierre-Marie de Rodat <dero...@adacore.com>
> Date: Wed, 3 Sep 2014 09:46:32 +0200
> Subject: [PATCH 5/5] dwarf2out.c: do not short-circuit add_bound_info in array
> lang-hook
>
> gcc/
> * dwarf2out.h (struct array_descr_info): Remove the base_decl field.
> * dwarf2out.c (init_array_descr_info): Update accordingly.
> (enum dw_scalar_form): New.
> (add_scalar_info): New.
> (loc_list_from_tree): Handle PLACEHOLDER_EXPR nodes for
> type-related expressions.
> (add_bound_info): Use add_scalar_info.
> (descr_info_loc): Remove.
> (add_descr_info_field): Remove.
> (gen_descr_array_type_die): Switch add_descr_info_field calls
> into add_scalar_info/add_bound_info ones.
>
> gcc/ada/
> * gcc-interface/misc.c (gnat_get_array_descr_info): Remove base_decl
> initialization.
>
> gcc/fortran/
> * trans-types.c (gfc_get_array_descr_info): Use PLACEHOLDER_EXPR nodes
> instead of VAR_DECL ones in type-related expressions. Remove base_decl
> initialization.
Ugh, I must say I don't like PLACEHOLDER_EXPRs at all.
Jakub
