[PATCH] Debug support for Fortran 90 assumed shape and other descriptor using arrays (PR fortran/22244)
Jakub Jelinek
jakub@redhat.com
Fri Nov 16 11:58:00 GMT 2007
Hi!
On Mon, Nov 12, 2007 at 05:46:03AM -0500, Jakub Jelinek wrote:
> gfortran since my last patch at least emits useful debug info
> for normal multi-dimensional arrays and arrays with lower bound different
> than 0, including I believe assumed size arrays.
> But it doesn't handle assumed shape arrays, allocatable and pointer arrays
> that use descriptors.
> For these DWARF3 has quite detailed example how can they be efficiently
> described in D.2.1. The following patch tries to implement that.
> I chose to use a langhook, because this would be terribly hard to express
> in a generic way, we'd need new tree types for that and, as we want to
> describe it using the DW_push_object_address magic, quite cumbersome.
Here is the final version of the patch which fixes a bunch of errors in the
debuginfo emitted by earlier patch, add supports for DW_AT_associated and
DW_AT_allocated DWARF3 attributes and also adds support for assumed-size
arrays.
Jan Kratochvil posted a series of corresponding GDB patches in
http://sources.redhat.com/ml/gdb-patches/2007-11/msg00317.html
http://sources.redhat.com/ml/gdb-patches/2007-11/msg00315.html
http://sources.redhat.com/ml/gdb-patches/2007-11/msg00316.html
http://sources.redhat.com/ml/gdb-patches/2007-11/msg00318.html
http://sources.redhat.com/ml/gdb-patches/2007-11/msg00319.html
http://sources.redhat.com/ml/gdb-patches/2007-11/msg00320.html
http://sources.redhat.com/ml/gdb-patches/2007-11/msg00322.html
http://sources.redhat.com/ml/gdb-patches/2007-11/msg00321.html
http://sources.redhat.com/ml/gdb-patches/2007-11/msg00326.html
http://sources.redhat.com/ml/gdb-patches/2007-11/msg00323.html
http://sources.redhat.com/ml/gdb-patches/2007-11/msg00324.html
http://sources.redhat.com/ml/gdb-patches/2007-11/msg00325.html
Bootstrapped/regtested on i686-linux and ppc64-linux (and x86_64-linux
bootstrap is pending), ok for trunk?
2007-11-16 Jakub Jelinek <jakub@redhat.com>
PR fortran/22244
* langhooks-def.h (LANG_HOOKS_GET_ARRAY_DESCR_INFO): Define.
(LANG_HOOKS_FOR_TYPES_INITIALIZER): Add it.
* langhooks.h (struct array_descr_info): Forward declaration.
(struct lang_hooks_for_types): Add get_array_descr_info field.
* dwarf2.h (DW_AT_bit_stride, DW_AT_byte_stride): New.
(DW_AT_stride_size, DW_AT_stride): Keep around for Dwarf2
compatibility.
* dwarf2out.h (struct array_descr_info): New type.
* dwarf2out.c (dwarf_attr_name): Rename DW_AT_stride to
DW_AT_byte_stride and DW_AT_stride_size to DW_AT_bit_size.
(descr_info_loc, add_descr_info_field, gen_descr_array_type_die):
New functions.
(gen_type_die_with_usage): Call lang_hooks.types.get_array_descr_info
and gen_descr_array_type_die.
* trans.h (struct array_descr_info): Forward declaration.
(gfc_get_array_descr_info): New prototype.
(enum gfc_array_kind): New type.
(struct lang_type): Add akind field.
(GFC_TYPE_ARRAY_AKIND): Define.
* trans-types.c: Include dwarf2out.h.
(gfc_build_array_type): Add akind argument. Adjust
gfc_get_array_type_bounds call.
(gfc_get_nodesc_array_type): Include proper debug info even for
assumed-size arrays.
(gfc_get_array_type_bounds): Add akind argument, set
GFC_TYPE_ARRAY_AKIND to it.
(gfc_sym_type, gfc_get_derived_type): Adjust gfc_build_array_type
callers.
(gfc_get_array_descr_info): New function.
* trans-array.c (gfc_trans_create_temp_array,
gfc_conv_expr_descriptor): Adjust gfc_get_array_type_bounds
callers.
* trans-stmt.c (gfc_trans_pointer_assign_need_temp): Likewise.
* trans-types.h (gfc_get_array_type_bounds): Adjust prototype.
* Make-lang.in (fortran/trans-types.o): Depend on dwarf2out.h.
* f95-lang.c (LANG_HOOKS_GET_ARRAY_DESCR_INFO): Define.
--- gcc/fortran/trans.h.jj 2007-11-13 17:06:40.000000000 +0100
+++ gcc/fortran/trans.h 2007-11-13 17:10:08.000000000 +0100
@@ -483,6 +483,8 @@ tree poplevel (int, int, int);
tree getdecls (void);
tree gfc_truthvalue_conversion (tree);
tree gfc_builtin_function (tree);
+struct array_descr_info;
+bool gfc_get_array_descr_info (const_tree, struct array_descr_info *);
/* In trans-openmp.c */
bool gfc_omp_privatize_by_reference (const_tree);
@@ -569,10 +571,19 @@ extern GTY(()) tree gfor_fndecl_sr_kind;
/* G95-specific declaration information. */
+enum gfc_array_kind
+{
+ GFC_ARRAY_UNKNOWN,
+ GFC_ARRAY_ASSUMED_SHAPE,
+ GFC_ARRAY_ALLOCATABLE,
+ GFC_ARRAY_POINTER
+};
+
/* Array types only. */
struct lang_type GTY(())
{
int rank;
+ enum gfc_array_kind akind;
tree lbound[GFC_MAX_DIMENSIONS];
tree ubound[GFC_MAX_DIMENSIONS];
tree stride[GFC_MAX_DIMENSIONS];
@@ -626,7 +637,8 @@ struct lang_decl GTY(())
#define GFC_TYPE_ARRAY_RANK(node) (TYPE_LANG_SPECIFIC(node)->rank)
#define GFC_TYPE_ARRAY_SIZE(node) (TYPE_LANG_SPECIFIC(node)->size)
#define GFC_TYPE_ARRAY_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->offset)
-/* Code should use gfc_get_dtype instead of accesig this directly. It may
+#define GFC_TYPE_ARRAY_AKIND(node) (TYPE_LANG_SPECIFIC(node)->akind)
+/* Code should use gfc_get_dtype instead of accesing this directly. It may
not be known when the type is created. */
#define GFC_TYPE_ARRAY_DTYPE(node) (TYPE_LANG_SPECIFIC(node)->dtype)
#define GFC_TYPE_ARRAY_DATAPTR_TYPE(node) \
--- gcc/fortran/trans-stmt.c.jj 2007-11-13 17:06:40.000000000 +0100
+++ gcc/fortran/trans-stmt.c 2007-11-13 17:10:08.000000000 +0100
@@ -2525,7 +2525,8 @@ gfc_trans_pointer_assign_need_temp (gfc_
/* Make a new descriptor. */
parmtype = gfc_get_element_type (TREE_TYPE (desc));
parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen,
- loop.from, loop.to, 1);
+ loop.from, loop.to, 1,
+ GFC_ARRAY_UNKNOWN);
/* Allocate temporary for nested forall construct. */
tmp1 = allocate_temp_for_forall_nest (nested_forall_info, parmtype,
--- gcc/fortran/f95-lang.c.jj 2007-11-13 17:06:40.000000000 +0100
+++ gcc/fortran/f95-lang.c 2007-11-13 17:10:08.000000000 +0100
@@ -120,6 +120,7 @@ static alias_set_type gfc_get_alias_set
#undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE
#undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES
#undef LANG_HOOKS_BUILTIN_FUNCTION
+#undef LANG_HOOKS_GET_ARRAY_DESCR_INFO
/* Define lang hooks. */
#define LANG_HOOKS_NAME "GNU F95"
@@ -143,6 +144,7 @@ static alias_set_type gfc_get_alias_set
#define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \
gfc_omp_firstprivatize_type_sizes
#define LANG_HOOKS_BUILTIN_FUNCTION gfc_builtin_function
+#define LANG_HOOKS_GET_ARRAY_DESCR_INFO gfc_get_array_descr_info
const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
--- gcc/fortran/Make-lang.in.jj 2007-11-13 17:06:40.000000000 +0100
+++ gcc/fortran/Make-lang.in 2007-11-13 17:10:08.000000000 +0100
@@ -312,7 +312,7 @@ fortran/trans-decl.o: $(GFORTRAN_TRANS_D
$(CGRAPH_H) $(TARGET_H) $(FUNCTION_H) $(FLAGS_H) $(RTL_H) $(TREE_GIMPLE_H) \
$(TREE_DUMP_H)
fortran/trans-types.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-types.h \
- $(REAL_H) toplev.h $(TARGET_H) $(FLAGS_H)
+ $(REAL_H) toplev.h $(TARGET_H) $(FLAGS_H) dwarf2out.h
fortran/trans-const.o: $(GFORTRAN_TRANS_DEPS)
fortran/trans-expr.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h
fortran/trans-stmt.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h
--- gcc/fortran/trans-types.c.jj 2007-11-13 17:06:40.000000000 +0100
+++ gcc/fortran/trans-types.c 2007-11-14 15:24:57.000000000 +0100
@@ -37,6 +37,7 @@ along with GCC; see the file COPYING3.
#include "trans-const.h"
#include "real.h"
#include "flags.h"
+#include "dwarf2out.h"
#if (GFC_MAX_DIMENSIONS < 10)
@@ -1047,7 +1048,8 @@ gfc_is_nodesc_array (gfc_symbol * sym)
/* Create an array descriptor type. */
static tree
-gfc_build_array_type (tree type, gfc_array_spec * as)
+gfc_build_array_type (tree type, gfc_array_spec * as,
+ enum gfc_array_kind akind)
{
tree lbound[GFC_MAX_DIMENSIONS];
tree ubound[GFC_MAX_DIMENSIONS];
@@ -1063,7 +1065,9 @@ gfc_build_array_type (tree type, gfc_arr
ubound[n] = gfc_conv_array_bound (as->upper[n]);
}
- return gfc_get_array_type_bounds (type, as->rank, lbound, ubound, 0);
+ if (as->type == AS_ASSUMED_SHAPE)
+ akind = GFC_ARRAY_ASSUMED_SHAPE;
+ return gfc_get_array_type_bounds (type, as->rank, lbound, ubound, 0, akind);
}
/* Returns the struct descriptor_dimension type. */
@@ -1246,7 +1250,7 @@ gfc_get_nodesc_array_type (tree etype, g
if (expr->expr_type == EXPR_CONSTANT)
{
tmp = gfc_conv_mpz_to_tree (expr->value.integer,
- gfc_index_integer_kind);
+ gfc_index_integer_kind);
}
else
{
@@ -1338,7 +1342,7 @@ gfc_get_nodesc_array_type (tree etype, g
/* In debug info represent packed arrays as multi-dimensional
if they have rank > 1 and with proper bounds, instead of flat
arrays. */
- if (known_stride && write_symbols != NO_DEBUG)
+ if (known_offset && write_symbols != NO_DEBUG)
{
tree gtype = etype, rtype, type_decl;
@@ -1428,7 +1432,8 @@ gfc_get_array_descriptor_base (int dimen
tree
gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound,
- tree * ubound, int packed)
+ tree * ubound, int packed,
+ enum gfc_array_kind akind)
{
char name[8 + GFC_RANK_DIGITS + GFC_MAX_SYMBOL_LEN];
tree fat_type, base_type, arraytype, lower, upper, stride, tmp;
@@ -1455,6 +1460,7 @@ gfc_get_array_type_bounds (tree etype, i
GFC_TYPE_ARRAY_RANK (fat_type) = dimen;
GFC_TYPE_ARRAY_DTYPE (fat_type) = NULL_TREE;
+ GFC_TYPE_ARRAY_AKIND (fat_type) = akind;
/* Build an array descriptor record type. */
if (packed != 0)
@@ -1573,9 +1579,14 @@ gfc_sym_type (gfc_symbol * sym)
}
}
else
- {
- type = gfc_build_array_type (type, sym->as);
- }
+ {
+ enum gfc_array_kind akind = GFC_ARRAY_UNKNOWN;
+ if (sym->attr.pointer)
+ akind = GFC_ARRAY_POINTER;
+ else if (sym->attr.allocatable)
+ akind = GFC_ARRAY_ALLOCATABLE;
+ type = gfc_build_array_type (type, sym->as, akind);
+ }
}
else
{
@@ -1801,9 +1812,14 @@ gfc_get_derived_type (gfc_symbol * deriv
{
if (c->pointer || c->allocatable)
{
+ enum gfc_array_kind akind;
+ if (c->pointer)
+ akind = GFC_ARRAY_POINTER;
+ else
+ akind = GFC_ARRAY_ALLOCATABLE;
/* Pointers to arrays aren't actually pointer types. The
descriptors are separate, but the data is common. */
- field_type = gfc_build_array_type (field_type, c->as);
+ field_type = gfc_build_array_type (field_type, c->as, akind);
}
else
field_type = gfc_get_nodesc_array_type (field_type, c->as,
@@ -2121,4 +2137,124 @@ gfc_type_for_mode (enum machine_mode mod
return NULL_TREE;
}
+/* Return TRUE if TYPE is a type with a hidden descriptor, fill in INFO
+ in that case. */
+
+bool
+gfc_get_array_descr_info (const_tree type, struct array_descr_info *info)
+{
+ int rank, dim;
+ bool indirect = false;
+ tree etype, ptype, field, t, base_decl;
+ tree data_off, offset_off, dim_off, dim_size, elem_size;
+ tree lower_suboff, upper_suboff, stride_suboff;
+
+ if (! GFC_DESCRIPTOR_TYPE_P (type))
+ {
+ if (! POINTER_TYPE_P (type))
+ return false;
+ type = TREE_TYPE (type);
+ if (! GFC_DESCRIPTOR_TYPE_P (type))
+ return false;
+ indirect = true;
+ }
+
+ rank = GFC_TYPE_ARRAY_RANK (type);
+ if (rank >= (int) (sizeof (info->dimen) / sizeof (info->dimen[0])))
+ return false;
+
+ etype = GFC_TYPE_ARRAY_DATAPTR_TYPE (type);
+ gcc_assert (POINTER_TYPE_P (etype));
+ etype = TREE_TYPE (etype);
+ gcc_assert (TREE_CODE (etype) == ARRAY_TYPE);
+ etype = TREE_TYPE (etype);
+ /* Can't handle variable sized elements yet. */
+ if (int_size_in_bytes (etype) <= 0)
+ return false;
+ /* Nor non-constant lower bounds in assumed shape arrays. */
+ if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE)
+ {
+ for (dim = 0; dim < rank; dim++)
+ if (GFC_TYPE_ARRAY_LBOUND (type, dim) == NULL_TREE
+ || TREE_CODE (GFC_TYPE_ARRAY_LBOUND (type, dim)) != INTEGER_CST)
+ return false;
+ }
+
+ memset (info, '\0', sizeof (*info));
+ info->ndimensions = rank;
+ info->element_type = etype;
+ ptype = build_pointer_type (gfc_array_index_type);
+ if (indirect)
+ {
+ info->base_decl = build_decl (VAR_DECL, NULL_TREE,
+ build_pointer_type (ptype));
+ base_decl = build1 (INDIRECT_REF, ptype, info->base_decl);
+ }
+ else
+ info->base_decl = base_decl = build_decl (VAR_DECL, NULL_TREE, ptype);
+
+ elem_size = fold_convert (gfc_array_index_type, TYPE_SIZE_UNIT (etype));
+ field = TYPE_FIELDS (TYPE_MAIN_VARIANT (type));
+ data_off = byte_position (field);
+ field = TREE_CHAIN (field);
+ offset_off = byte_position (field);
+ field = TREE_CHAIN (field);
+ field = TREE_CHAIN (field);
+ dim_off = byte_position (field);
+ dim_size = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (field)));
+ field = TYPE_FIELDS (TREE_TYPE (TREE_TYPE (field)));
+ stride_suboff = byte_position (field);
+ field = TREE_CHAIN (field);
+ lower_suboff = byte_position (field);
+ field = TREE_CHAIN (field);
+ upper_suboff = byte_position (field);
+
+ t = base_decl;
+ if (!integer_zerop (data_off))
+ t = build2 (POINTER_PLUS_EXPR, ptype, t, data_off);
+ t = build1 (NOP_EXPR, build_pointer_type (ptr_type_node), t);
+ info->data_location = build1 (INDIRECT_REF, ptr_type_node, t);
+ if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
+ info->allocated = build2 (NE_EXPR, boolean_type_node,
+ info->data_location, null_pointer_node);
+ else if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER)
+ info->associated = build2 (NE_EXPR, boolean_type_node,
+ info->data_location, null_pointer_node);
+
+ for (dim = 0; dim < rank; dim++)
+ {
+ t = build2 (POINTER_PLUS_EXPR, ptype, base_decl,
+ size_binop (PLUS_EXPR, dim_off, lower_suboff));
+ t = build1 (INDIRECT_REF, gfc_array_index_type, t);
+ info->dimen[dim].lower_bound = t;
+ t = build2 (POINTER_PLUS_EXPR, ptype, base_decl,
+ size_binop (PLUS_EXPR, dim_off, upper_suboff));
+ t = build1 (INDIRECT_REF, gfc_array_index_type, t);
+ info->dimen[dim].upper_bound = t;
+ if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE)
+ {
+ /* Assumed shape arrays have known lower bounds. */
+ info->dimen[dim].upper_bound
+ = build2 (MINUS_EXPR, gfc_array_index_type,
+ info->dimen[dim].upper_bound,
+ info->dimen[dim].lower_bound);
+ info->dimen[dim].lower_bound
+ = fold_convert (gfc_array_index_type,
+ GFC_TYPE_ARRAY_LBOUND (type, dim));
+ info->dimen[dim].upper_bound
+ = build2 (PLUS_EXPR, gfc_array_index_type,
+ info->dimen[dim].lower_bound,
+ info->dimen[dim].upper_bound);
+ }
+ t = build2 (POINTER_PLUS_EXPR, ptype, base_decl,
+ size_binop (PLUS_EXPR, dim_off, stride_suboff));
+ t = build1 (INDIRECT_REF, gfc_array_index_type, t);
+ t = build2 (MULT_EXPR, gfc_array_index_type, t, elem_size);
+ info->dimen[dim].stride = t;
+ dim_off = size_binop (PLUS_EXPR, dim_off, dim_size);
+ }
+
+ return true;
+}
+
#include "gt-fortran-trans-types.h"
--- gcc/fortran/trans-array.c.jj 2007-11-13 17:06:40.000000000 +0100
+++ gcc/fortran/trans-array.c 2007-11-13 17:10:08.000000000 +0100
@@ -608,7 +608,8 @@ gfc_trans_create_temp_array (stmtblock_t
/* Initialize the descriptor. */
type =
- gfc_get_array_type_bounds (eltype, info->dimen, loop->from, loop->to, 1);
+ gfc_get_array_type_bounds (eltype, info->dimen, loop->from, loop->to, 1,
+ GFC_ARRAY_UNKNOWN);
desc = gfc_create_var (type, "atmp");
GFC_DECL_PACKED_ARRAY (desc) = 1;
@@ -4788,7 +4789,8 @@ gfc_conv_expr_descriptor (gfc_se * se, g
/* Otherwise make a new one. */
parmtype = gfc_get_element_type (TREE_TYPE (desc));
parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen,
- loop.from, loop.to, 0);
+ loop.from, loop.to, 0,
+ GFC_ARRAY_UNKNOWN);
parm = gfc_create_var (parmtype, "parm");
}
--- gcc/fortran/trans-types.h.jj 2007-11-13 17:06:40.000000000 +0100
+++ gcc/fortran/trans-types.h 2007-11-13 17:10:08.000000000 +0100
@@ -67,7 +67,8 @@ tree gfc_type_for_size (unsigned, int);
tree gfc_type_for_mode (enum machine_mode, int);
tree gfc_get_element_type (tree);
-tree gfc_get_array_type_bounds (tree, int, tree *, tree *, int);
+tree gfc_get_array_type_bounds (tree, int, tree *, tree *, int,
+ enum gfc_array_kind);
tree gfc_get_nodesc_array_type (tree, gfc_array_spec *, gfc_packed);
/* Add a field of given name and type to a UNION_TYPE or RECORD_TYPE. */
--- gcc/dwarf2.h.jj 2007-11-13 17:06:40.000000000 +0100
+++ gcc/dwarf2.h 2007-11-13 17:10:08.000000000 +0100
@@ -274,7 +274,8 @@ enum dwarf_attribute
DW_AT_prototyped = 0x27,
DW_AT_return_addr = 0x2a,
DW_AT_start_scope = 0x2c,
- DW_AT_stride_size = 0x2e,
+ DW_AT_bit_stride = 0x2e,
+ DW_AT_stride_size = DW_AT_bit_stride,
DW_AT_upper_bound = 0x2f,
DW_AT_abstract_origin = 0x31,
DW_AT_accessibility = 0x32,
@@ -309,7 +310,8 @@ enum dwarf_attribute
DW_AT_allocated = 0x4e,
DW_AT_associated = 0x4f,
DW_AT_data_location = 0x50,
- DW_AT_stride = 0x51,
+ DW_AT_byte_stride = 0x51,
+ DW_AT_stride = DW_AT_byte_stride,
DW_AT_entry_pc = 0x52,
DW_AT_use_UTF8 = 0x53,
DW_AT_extension = 0x54,
--- gcc/langhooks.h.jj 2007-11-13 17:06:40.000000000 +0100
+++ gcc/langhooks.h 2007-11-13 17:10:08.000000000 +0100
@@ -28,6 +28,8 @@ struct diagnostic_info;
struct gimplify_omp_ctx;
+struct array_descr_info;
+
/* A print hook for print_tree (). */
typedef void (*lang_print_tree_hook) (FILE *, tree, int indent);
@@ -136,6 +138,10 @@ struct lang_hooks_for_types
FUNCTION_TYPEs. */
bool (*type_hash_eq) (const_tree, const_tree);
+ /* Return TRUE if TYPE uses a hidden descriptor and fills in information
+ for the debugger about the array bounds, strides, etc. */
+ bool (*get_array_descr_info) (const_tree, struct array_descr_info *);
+
/* Nonzero if types that are identical are to be hashed so that only
one copy is kept. If a language requires unique types for each
user-specified type, such as Ada, this should be set to TRUE. */
--- gcc/langhooks-def.h.jj 2007-11-13 17:06:40.000000000 +0100
+++ gcc/langhooks-def.h 2007-11-13 17:10:08.000000000 +0100
@@ -180,6 +180,7 @@ extern tree lhd_make_node (enum tree_cod
#define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \
lhd_omp_firstprivatize_type_sizes
#define LANG_HOOKS_TYPE_HASH_EQ NULL
+#define LANG_HOOKS_GET_ARRAY_DESCR_INFO NULL
#define LANG_HOOKS_HASH_TYPES true
#define LANG_HOOKS_FOR_TYPES_INITIALIZER { \
@@ -193,6 +194,7 @@ extern tree lhd_make_node (enum tree_cod
LANG_HOOKS_TYPE_MAX_SIZE, \
LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES, \
LANG_HOOKS_TYPE_HASH_EQ, \
+ LANG_HOOKS_GET_ARRAY_DESCR_INFO, \
LANG_HOOKS_HASH_TYPES \
}
--- gcc/dwarf2out.c.jj 2007-11-13 17:06:40.000000000 +0100
+++ gcc/dwarf2out.c 2007-11-13 17:10:08.000000000 +0100
@@ -4263,6 +4263,7 @@ static tree member_declared_type (const_
static const char *decl_start_label (tree);
#endif
static void gen_array_type_die (tree, dw_die_ref);
+static void gen_descr_array_type_die (tree, struct array_descr_info *, dw_die_ref);
#if 0
static void gen_entry_point_die (tree, dw_die_ref);
#endif
@@ -4669,8 +4670,8 @@ dwarf_attr_name (unsigned int attr)
return "DW_AT_return_addr";
case DW_AT_start_scope:
return "DW_AT_start_scope";
- case DW_AT_stride_size:
- return "DW_AT_stride_size";
+ case DW_AT_bit_stride:
+ return "DW_AT_bit_stride";
case DW_AT_upper_bound:
return "DW_AT_upper_bound";
case DW_AT_abstract_origin:
@@ -4738,8 +4739,8 @@ dwarf_attr_name (unsigned int attr)
return "DW_AT_associated";
case DW_AT_data_location:
return "DW_AT_data_location";
- case DW_AT_stride:
- return "DW_AT_stride";
+ case DW_AT_byte_stride:
+ return "DW_AT_byte_stride";
case DW_AT_entry_pc:
return "DW_AT_entry_pc";
case DW_AT_use_UTF8:
@@ -11675,6 +11676,163 @@ gen_array_type_die (tree type, dw_die_re
add_pubtype (type, array_die);
}
+static dw_loc_descr_ref
+descr_info_loc (tree val, tree base_decl)
+{
+ HOST_WIDE_INT size;
+ dw_loc_descr_ref loc, loc2;
+ enum dwarf_location_atom op;
+
+ if (val == base_decl)
+ return new_loc_descr (DW_OP_push_object_address, 0, 0);
+
+ switch (TREE_CODE (val))
+ {
+ case NOP_EXPR:
+ case CONVERT_EXPR:
+ return descr_info_loc (TREE_OPERAND (val, 0), base_decl);
+ case INTEGER_CST:
+ if (host_integerp (val, 0))
+ return int_loc_descriptor (tree_low_cst (val, 0));
+ break;
+ case INDIRECT_REF:
+ size = int_size_in_bytes (TREE_TYPE (val));
+ if (size < 0)
+ break;
+ loc = descr_info_loc (TREE_OPERAND (val, 0), base_decl);
+ if (!loc)
+ break;
+ if (size == DWARF2_ADDR_SIZE)
+ add_loc_descr (&loc, new_loc_descr (DW_OP_deref, 0, 0));
+ else
+ add_loc_descr (&loc, new_loc_descr (DW_OP_deref_size, size, 0));
+ return loc;
+ case POINTER_PLUS_EXPR:
+ case PLUS_EXPR:
+ if (host_integerp (TREE_OPERAND (val, 1), 1)
+ && (unsigned HOST_WIDE_INT) tree_low_cst (TREE_OPERAND (val, 1), 1)
+ < 16384)
+ {
+ loc = descr_info_loc (TREE_OPERAND (val, 0), base_decl);
+ if (!loc)
+ break;
+ add_loc_descr (&loc,
+ new_loc_descr (DW_OP_plus_uconst,
+ tree_low_cst (TREE_OPERAND (val, 1),
+ 1), 0));
+ }
+ else
+ {
+ op = DW_OP_plus;
+ do_binop:
+ loc = descr_info_loc (TREE_OPERAND (val, 0), base_decl);
+ if (!loc)
+ break;
+ loc2 = descr_info_loc (TREE_OPERAND (val, 1), base_decl);
+ if (!loc2)
+ break;
+ add_loc_descr (&loc, loc2);
+ add_loc_descr (&loc2, new_loc_descr (op, 0, 0));
+ }
+ return loc;
+ case MINUS_EXPR:
+ op = DW_OP_minus;
+ goto do_binop;
+ case MULT_EXPR:
+ op = DW_OP_mul;
+ goto do_binop;
+ case EQ_EXPR:
+ op = DW_OP_eq;
+ goto do_binop;
+ case NE_EXPR:
+ op = DW_OP_ne;
+ goto do_binop;
+ default:
+ break;
+ }
+ return NULL;
+}
+
+static void
+add_descr_info_field (dw_die_ref die, enum dwarf_attribute attr,
+ tree val, tree base_decl)
+{
+ dw_loc_descr_ref loc;
+
+ if (host_integerp (val, 0))
+ {
+ add_AT_unsigned (die, attr, tree_low_cst (val, 0));
+ return;
+ }
+
+ loc = descr_info_loc (val, base_decl);
+ if (!loc)
+ return;
+
+ add_AT_loc (die, attr, loc);
+}
+
+/* This routine generates DIE for array with hidden descriptor, details
+ are filled into *info by a langhook. */
+
+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 array_die;
+ int dim;
+
+ array_die = new_die (DW_TAG_array_type, scope_die, type);
+ add_name_attribute (array_die, type_tag (type));
+ equate_type_number_to_die (type, array_die);
+
+ if (info->data_location)
+ add_descr_info_field (array_die, DW_AT_data_location, info->data_location,
+ info->base_decl);
+ if (info->associated)
+ add_descr_info_field (array_die, DW_AT_associated, info->associated,
+ info->base_decl);
+ if (info->allocated)
+ add_descr_info_field (array_die, DW_AT_allocated, info->allocated,
+ info->base_decl);
+
+ for (dim = 0; dim < info->ndimensions; dim++)
+ {
+ dw_die_ref subrange_die
+ = new_die (DW_TAG_subrange_type, array_die, NULL);
+
+ if (info->dimen[dim].lower_bound)
+ {
+ /* If it is the default value, omit it. */
+ if ((is_c_family () || is_java ())
+ && integer_zerop (info->dimen[dim].lower_bound))
+ ;
+ else if (is_fortran ()
+ && integer_onep (info->dimen[dim].lower_bound))
+ ;
+ else
+ add_descr_info_field (subrange_die, DW_AT_lower_bound,
+ info->dimen[dim].lower_bound,
+ info->base_decl);
+ }
+ if (info->dimen[dim].upper_bound)
+ add_descr_info_field (subrange_die, DW_AT_upper_bound,
+ info->dimen[dim].upper_bound,
+ info->base_decl);
+ if (info->dimen[dim].stride)
+ add_descr_info_field (subrange_die, DW_AT_byte_stride,
+ info->dimen[dim].stride,
+ info->base_decl);
+ }
+
+ gen_type_die (info->element_type, context_die);
+ add_type_attribute (array_die, info->element_type, 0, 0, context_die);
+
+ if (get_AT (array_die, DW_AT_name))
+ add_pubtype (type, array_die);
+}
+
#if 0
static void
gen_entry_point_die (tree decl, dw_die_ref context_die)
@@ -13051,6 +13209,7 @@ gen_type_die_with_usage (tree type, dw_d
enum debug_info_usage usage)
{
int need_pop;
+ struct array_descr_info info;
if (type == NULL_TREE || type == error_mark_node)
return;
@@ -13069,6 +13228,16 @@ gen_type_die_with_usage (tree type, dw_d
return;
}
+ /* 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))
+ {
+ gen_descr_array_type_die (type, &info, context_die);
+ TREE_ASM_WRITTEN (type) = 1;
+ return;
+ }
+
/* We are going to output a DIE to represent the unqualified version
of this type (i.e. without any const or volatile qualifiers) so
get the main variant (i.e. the unqualified version) of this type
--- gcc/dwarf2out.h.jj 2007-11-13 17:06:40.000000000 +0100
+++ gcc/dwarf2out.h 2007-11-13 17:10:08.000000000 +0100
@@ -25,3 +25,19 @@ extern void debug_dwarf (void);
struct die_struct;
extern void debug_dwarf_die (struct die_struct *);
extern void dwarf2out_set_demangle_name_func (const char *(*) (const char *));
+
+struct array_descr_info
+{
+ int ndimensions;
+ tree element_type;
+ tree base_decl;
+ tree data_location;
+ tree allocated;
+ tree associated;
+ struct array_descr_dimen
+ {
+ tree lower_bound;
+ tree upper_bound;
+ tree stride;
+ } dimen[10];
+};
Jakub
More information about the Gcc-patches
mailing list