public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [RFC PATCH] Debug support for Fortran 90 assumed shape and other descriptor using arrays (PR fortran/22244)
@ 2007-11-12 13:39 Jakub Jelinek
  2007-11-16 11:58 ` [PATCH] " Jakub Jelinek
  0 siblings, 1 reply; 11+ messages in thread
From: Jakub Jelinek @ 2007-11-12 13:39 UTC (permalink / raw)
  To: gcc-patches, fortran; +Cc: Jan Kratochvil, Daniel Jacobowitz

[-- Attachment #1: Type: text/plain, Size: 4534 bytes --]

Hi!

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.

Say for `vary' two dimensional assumed shape argument gfortran with this
patch emits something like below.
DW_OP_push_object_address will insert an address of the variable of that
type, assumed shape argument is a pointer (reference) to the descriptor
structure, so we compute:
(*vary)->data + ((*vary)->offset + (*vary)->dim[0].stride * (*vary)->dim[0].lower_bound
		 + (*vary)->dim[1].stride * (*vary)->dim[1].lower_bound) * sizeof (element_type)
to get at the actual data location (address of vary(low0, low1)).
The addition of stride multiplied lower bounds is needed because gfortran's
data + offset * sizeof (element_type) points to vary (0, 0) rather than
field with all indexes equal to lower bounds.

        .uleb128 0xe    # (DIE (0x254) DW_TAG_array_type)
        .byte   0x17    # DW_AT_data_location
        .byte   0x97    # DW_OP_push_object_address
        .byte   0x6     # DW_OP_deref
        .byte   0x6     # DW_OP_deref
        .byte   0x97    # DW_OP_push_object_address
        .byte   0x6     # DW_OP_deref
        .byte   0x23    # DW_OP_plus_uconst
        .uleb128 0x8
        .byte   0x6     # DW_OP_deref
        .byte   0x97    # DW_OP_push_object_address
        .byte   0x6     # DW_OP_deref
        .byte   0x23    # DW_OP_plus_uconst
        .uleb128 0x18
        .byte   0x6     # DW_OP_deref
        .byte   0x22    # DW_OP_plus
        .byte   0x97    # DW_OP_push_object_address
        .byte   0x6     # DW_OP_deref
        .byte   0x23    # DW_OP_plus_uconst
        .uleb128 0x30
        .byte   0x6     # DW_OP_deref
        .byte   0x22    # DW_OP_plus
        .byte   0x34    # DW_OP_lit4
        .byte   0x1e    # DW_OP_mul
        .byte   0x22    # DW_OP_plus
        .long   0x14c   # DW_AT_type
        .long   0x2a0   # DW_AT_sibling
        .uleb128 0xa    # (DIE (0x275) DW_TAG_subrange_type)
        .byte   0x5     # DW_AT_lower_bound
        .byte   0x97    # DW_OP_push_object_address
        .byte   0x6     # DW_OP_deref
        .byte   0x23    # DW_OP_plus_uconst
        .uleb128 0x20
        .byte   0x6     # DW_OP_deref
        .byte   0x5     # DW_AT_upper_bound
        .byte   0x97    # DW_OP_push_object_address
        .byte   0x6     # DW_OP_deref
        .byte   0x23    # DW_OP_plus_uconst
        .uleb128 0x28
        .byte   0x6     # DW_OP_deref
        .byte   0x7     # DW_AT_byte_stride
        .byte   0x97    # DW_OP_push_object_address
        .byte   0x6     # DW_OP_deref
        .byte   0x23    # DW_OP_plus_uconst
        .uleb128 0x18
        .byte   0x6     # DW_OP_deref
        .byte   0x34    # DW_OP_lit4
        .byte   0x1e    # DW_OP_mul
        .uleb128 0xa    # (DIE (0x28a) DW_TAG_subrange_type)
        .byte   0x5     # DW_AT_lower_bound
        .byte   0x97    # DW_OP_push_object_address
        .byte   0x6     # DW_OP_deref
        .byte   0x23    # DW_OP_plus_uconst
        .uleb128 0x38
        .byte   0x6     # DW_OP_deref
        .byte   0x5     # DW_AT_upper_bound
        .byte   0x97    # DW_OP_push_object_address
        .byte   0x6     # DW_OP_deref
        .byte   0x23    # DW_OP_plus_uconst
        .uleb128 0x40
        .byte   0x6     # DW_OP_deref
        .byte   0x7     # DW_AT_byte_stride
        .byte   0x97    # DW_OP_push_object_address
        .byte   0x6     # DW_OP_deref
        .byte   0x23    # DW_OP_plus_uconst
        .uleb128 0x30
        .byte   0x6     # DW_OP_deref
        .byte   0x34    # DW_OP_lit4
        .byte   0x1e    # DW_OP_mul

gdb doesn't unfortunately support several constructs used there, Jan made a patch
for preliminary DW_OP_push_object_address support over this weekend at least,
but e.g. strides aren't supported at all.  So I'd just appreciate if anybody
could either eyeball this to verify its correct, or try it with some debugger
that already supports both DW_OP_push_object_address and DW_OP_byte_stride
to verify it.

	Jakub

[-- Attachment #2: Z40b --]
[-- Type: text/plain, Size: 16663 bytes --]

2007-11-12  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.
	* trans-types.c: Include dwarf2out.h.
	(gfc_get_array_descr_info): New function.
	* 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-10-08 10:45:01.000000000 +0200
+++ gcc/fortran/trans.h	2007-11-09 21:35:05.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);
--- gcc/fortran/trans-types.c.jj	2007-11-05 09:05:44.000000000 +0100
+++ gcc/fortran/trans-types.c	2007-11-10 01:02:44.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"
 \f
 
 #if (GFC_MAX_DIMENSIONS < 10)
@@ -2121,4 +2122,107 @@ 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, off_total, 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);
+  if (int_size_in_bytes (etype) <= 0)
+    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);
+  t = build2 (POINTER_PLUS_EXPR, ptype, base_decl, offset_off);
+  off_total = build1 (INDIRECT_REF, gfc_array_index_type, t);
+
+  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;
+      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);
+      off_total = build2 (PLUS_EXPR, gfc_array_index_type, off_total, 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);
+    }
+
+  /* DWARF3 expects to use
+     data_location + (index0 - low0) * stride0 + (index1 - low1) * stride1 ...
+     but gfortran uses:
+     d.data + d.offset * sizeof (elem)
+     + index0 * d.dim[0].stride * sizeof (elem)
+     + index1 * d.dim[1].stride * sizeof (elem).  */
+  off_total = build2 (MULT_EXPR, gfc_array_index_type, off_total, elem_size);
+  info->data_location = build2 (POINTER_PLUS_EXPR, ptr_type_node,
+				info->data_location,
+				fold_convert (sizetype, off_total));
+  return true;
+}
+
 #include "gt-fortran-trans-types.h"
--- gcc/fortran/Make-lang.in.jj	2007-10-08 10:45:01.000000000 +0200
+++ gcc/fortran/Make-lang.in	2007-11-09 22:01:34.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/f95-lang.c.jj	2007-09-14 11:54:35.000000000 +0200
+++ gcc/fortran/f95-lang.c	2007-11-09 21:33:18.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/langhooks-def.h.jj	2007-11-02 19:02:47.000000000 +0100
+++ gcc/langhooks-def.h	2007-11-09 17:39:23.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-09 14:29:04.000000000 +0100
+++ gcc/dwarf2out.c	2007-11-10 00:40:24.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:
@@ -11695,6 +11696,151 @@ 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;
+
+  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:
+      loc = descr_info_loc (TREE_OPERAND (val, 0), base_decl);
+      if (!loc)
+	break;
+      if (host_integerp (TREE_OPERAND (val, 1), 1)
+	  && (unsigned HOST_WIDE_INT) tree_low_cst (TREE_OPERAND (val, 1), 1)
+	     < 16384)
+	add_loc_descr (&loc,
+		       new_loc_descr (DW_OP_plus_uconst,
+				      tree_low_cst (TREE_OPERAND (val, 1),
+				      1), 0));
+      else
+	{
+	  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 (DW_OP_plus, 0, 0));
+	}
+      return loc;
+    case MULT_EXPR:
+      loc = descr_info_loc (TREE_OPERAND (val, 0), base_decl);
+      loc2 = descr_info_loc (TREE_OPERAND (val, 1), base_decl);
+      if (!loc || !loc2)
+	break;
+      add_loc_descr (&loc, loc2);
+      add_loc_descr (&loc2, new_loc_descr (DW_OP_mul, 0, 0));
+      return loc;
+    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->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);
+  if (info->data_location)
+    add_descr_info_field (array_die, DW_AT_data_location, info->data_location,
+			  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)
@@ -13071,6 +13217,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;
@@ -13089,6 +13236,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-08-13 15:11:18.000000000 +0200
+++ gcc/dwarf2out.h	2007-11-09 17:47:55.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];
+};
--- gcc/langhooks.h.jj	2007-11-02 19:02:47.000000000 +0100
+++ gcc/langhooks.h	2007-11-09 17:37:44.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/dwarf2.h.jj	2007-08-13 15:11:18.000000000 +0200
+++ gcc/dwarf2.h	2007-11-09 18:02:44.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,

[-- Attachment #3: a4.f90 --]
[-- Type: text/plain, Size: 1291 bytes --]

subroutine baz
  real, allocatable :: varx (:, :, :)
  allocate (varx (1:6, 5:15, 17:28))
  varx(:, :, :) = 6
  varx(1, 5, 17) = 7
  varx(2, 6, 18) = 8
  varx(6, 15, 28) = 9
  deallocate (varx)
end subroutine baz
subroutine foo (vary, varw)
  real :: vary (:, :)
  real :: varw (:, :, :)
  vary(:, :) = 4
  vary(1, 1) = 8
  vary(2, 2) = 9
  vary(1, 3) = 10
  varw(:, :, :) = 5
  varw(1, 1, 1) = 6
  varw(2, 2, 2) = 7
end subroutine foo
subroutine bar (varz)
  real :: varz (*)
  varz(1:3) = 4
  varz(2) = 5
end subroutine bar
program test
  interface
    subroutine foo (vary, varw)
    real :: vary (:, :)
    real :: varw (:, :, :)
    end subroutine
  end interface
  interface
    subroutine bar (varz)
    real :: varz (*)
    end subroutine
  end interface
  real :: x (10, 10), y (5), z(8, 8, 8)
  x(:,:) = 1
  y(:) = 2
  z(:,:,:) = 3
  call baz
  call foo (x, z(2:6, 4:7, 6:8))
  call bar (y)
  if (x (1, 1) .ne. 8 .or. x (2, 2) .ne. 9 .or. x (1, 2) .ne. 4) call abort
  if (x (1, 3) .ne. 10) call abort
  if (z (2, 4, 6) .ne. 6 .or. z (3, 5, 7) .ne. 7 .or. z (2, 4, 7) .ne. 5) call abort
  if (any (y .ne. (/4, 5, 4, 2, 2/))) call abort
  call foo (transpose (x), z)
  if (x (1, 1) .ne. 8 .or. x (2, 2) .ne. 9 .or. x (1, 2) .ne. 4) call abort
  if (x (3, 1) .ne. 10) call abort
end

[-- Attachment #4: a4.s.bz2 --]
[-- Type: application/x-bzip2, Size: 6027 bytes --]

^ permalink raw reply	[flat|nested] 11+ messages in thread
end of thread, other threads:[~2007-12-09 15:13 UTC | newest]

Thread overview: 11+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2007-11-12 13:39 [RFC PATCH] Debug support for Fortran 90 assumed shape and other descriptor using arrays (PR fortran/22244) Jakub Jelinek
2007-11-16 11:58 ` [PATCH] " Jakub Jelinek
2007-11-16 13:24   ` Tobias Burnus
2007-11-16 13:28     ` Jakub Jelinek
2007-11-16 14:01       ` Tobias Burnus
2007-11-16 16:14         ` Jakub Jelinek
2007-11-16 18:09           ` Tobias Burnus
2007-11-16 19:05             ` Tobias Burnus
2007-11-16 19:18               ` Jakub Jelinek
2007-11-16 19:05             ` Jakub Jelinek
2007-12-09 15:13           ` Richard Guenther

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).