This is the mail archive of the gdb-patches@sourceware.org mailing list for the GDB project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[broken patch] Debug support for Fortran 90 assumed shape and other descriptor using arrays (PR fortran/22244)


Hi,

On Mon, 12 Nov 2007 11:46:03 +0100, Jakub Jelinek wrote:
...
> 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.

as Jakub announced the patch attaching it here, going to send an update to it.
It is only a GDB-6.5 patch but its port to HEAD is very simple.
It partially implements:
 * DW_FORM_block* evaluation.
 * Dynamic array bounds (by DW_FORM_block*).
 * DW_AT_data_location support.
 * DW_FORM_block* for DW_AT_lower_bound, DW_AT_upper_bound,
                      DW_AT_data_location, (DW_AT_stride)

and it still needs to implement:
 * DW_AT_stride support.

It works at least for dynamically allocated VARX (and some data access):
(gdb) ptype varx
type = real*4 (6,5:15,17:28)

There is a design problem that GDB deals with the TYPE already without any
relation to the original variable - this is clearly the failure for:
  (gdb) ptype dynamic_array_variable
I tried to patch there a general TYPE->VARIABLE binding at the VALUE_TYPE time
first so that it clones TYPE to a new TYPE bound to VARIABLE (sharing the same
MAIN_TYPE) but it is not fully backward compatible for existing code as it
makes the same abstract TYPE and VARIABLE-bound TYPE two different objects.

Another design problem is that TYPE_LENGTH (and other macros) is defined as
`type->length' while it needs to behave dynamically now.  Unfortunately the
same macro is currently used everywhere both as the setter (lvalue) and the
getter.  The getter should be a DWARF-resolving function while the setter needs
to be lvalue for an assignment.



Regards,
Jan
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/Makefile.in gdb-6.5/gdb/Makefile.in
--- gdb-6.5-orig/gdb/Makefile.in	2007-11-10 23:06:05.000000000 +0100
+++ gdb-6.5/gdb/Makefile.in	2007-11-10 23:22:49.000000000 +0100
@@ -1948,7 +1948,7 @@ dwarf2read.o: dwarf2read.c $(defs_h) $(b
 	$(expression_h) $(filenames_h) $(macrotab_h) $(language_h) \
 	$(complaints_h) $(bcache_h) $(dwarf2expr_h) $(dwarf2loc_h) \
 	$(cp_support_h) $(hashtab_h) $(command_h) $(gdbcmd_h) \
-	$(gdb_string_h) $(gdb_assert_h)
+	$(gdb_string_h) $(gdb_assert_h) $(value_h) $(gdbcore_h) $(exceptions_h)
 dwarfread.o: dwarfread.c $(defs_h) $(symtab_h) $(gdbtypes_h) $(objfiles_h) \
 	$(elf_dwarf_h) $(buildsym_h) $(demangle_h) $(expression_h) \
 	$(language_h) $(complaints_h) $(gdb_string_h)
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/ada-lang.c gdb-6.5/gdb/ada-lang.c
--- gdb-6.5-orig/gdb/ada-lang.c	2006-01-12 09:36:29.000000000 +0100
+++ gdb-6.5/gdb/ada-lang.c	2007-11-10 23:22:49.000000000 +0100
@@ -9560,6 +9560,14 @@ static const struct exp_descriptor ada_e
   ada_evaluate_subexp
 };
 
+static void
+ada_print_type_with_address (struct type *type0, CORE_ADDR address,
+			     char *varstring, struct ui_file *stream, int show,
+			     int level)
+{
+  ada_print_type (type0, varstring, stream, show, level);
+}
+
 const struct language_defn ada_language_defn = {
   "ada",                        /* Language name */
   language_ada,
@@ -9577,7 +9585,7 @@ const struct language_defn ada_language_
   ada_printstr,                 /* Function to print string constant */
   emit_char,                    /* Function to print single char (not used) */
   ada_create_fundamental_type,  /* Create fundamental type in this language */
-  ada_print_type,               /* Print a type using appropriate syntax */
+  ada_print_type_with_address,  /* Print a type using appropriate syntax */
   ada_val_print,                /* Print a value using appropriate syntax */
   ada_value_print,              /* Print a top-level value */
   NULL,                         /* Language specific skip_trampoline */
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/c-lang.c gdb-6.5/gdb/c-lang.c
--- gdb-6.5-orig/gdb/c-lang.c	2005-12-17 23:33:59.000000000 +0100
+++ gdb-6.5/gdb/c-lang.c	2007-11-10 23:22:49.000000000 +0100
@@ -563,6 +563,14 @@ c_language_arch_info (struct gdbarch *gd
   lai->primitive_type_vector [c_primitive_type_double_complex] = builtin->builtin_double_complex;
 };
 
+void
+c_print_type_with_address (struct type *type, CORE_ADDR address,
+			   char *varstring, struct ui_file *stream, int show,
+			   int level)
+{
+  c_print_type (type, varstring, stream, show, level);
+}
+
 const struct language_defn c_language_defn =
 {
   "c",				/* Language name */
@@ -580,7 +588,7 @@ const struct language_defn c_language_de
   c_printstr,			/* Function to print string constant */
   c_emit_char,			/* Print a single char */
   c_create_fundamental_type,	/* Create fundamental type in this language */
-  c_print_type,			/* Print a type using appropriate syntax */
+  c_print_type_with_address,	/* Print a type using appropriate syntax */
   c_val_print,			/* Print a value using appropriate syntax */
   c_value_print,		/* Print a top-level value */
   NULL,				/* Language specific skip_trampoline */
@@ -639,7 +647,7 @@ const struct language_defn cplus_languag
   c_printstr,			/* Function to print string constant */
   c_emit_char,			/* Print a single char */
   c_create_fundamental_type,	/* Create fundamental type in this language */
-  c_print_type,			/* Print a type using appropriate syntax */
+  c_print_type_with_address,	/* Print a type using appropriate syntax */
   c_val_print,			/* Print a value using appropriate syntax */
   c_value_print,		/* Print a top-level value */
   NULL,				/* Language specific skip_trampoline */
@@ -675,7 +683,7 @@ const struct language_defn asm_language_
   c_printstr,			/* Function to print string constant */
   c_emit_char,			/* Print a single char */
   c_create_fundamental_type,	/* Create fundamental type in this language */
-  c_print_type,			/* Print a type using appropriate syntax */
+  c_print_type_with_address,	/* Print a type using appropriate syntax */
   c_val_print,			/* Print a value using appropriate syntax */
   c_value_print,		/* Print a top-level value */
   NULL,				/* Language specific skip_trampoline */
@@ -716,7 +724,7 @@ const struct language_defn minimal_langu
   c_printstr,			/* Function to print string constant */
   c_emit_char,			/* Print a single char */
   c_create_fundamental_type,	/* Create fundamental type in this language */
-  c_print_type,			/* Print a type using appropriate syntax */
+  c_print_type_with_address,	/* Print a type using appropriate syntax */
   c_val_print,			/* Print a value using appropriate syntax */
   c_value_print,		/* Print a top-level value */
   NULL,				/* Language specific skip_trampoline */
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/c-lang.h gdb-6.5/gdb/c-lang.h
--- gdb-6.5-orig/gdb/c-lang.h	2005-12-17 23:33:59.000000000 +0100
+++ gdb-6.5/gdb/c-lang.h	2007-11-10 23:22:49.000000000 +0100
@@ -38,6 +38,9 @@ extern void c_error (char *);	/* Defined
 /* Defined in c-typeprint.c */
 extern void c_print_type (struct type *, char *, struct ui_file *, int,
 			  int);
+extern void c_print_type_with_address (struct type *type, CORE_ADDR address,
+				       char *varstring, struct ui_file *stream,
+				       int show, int level);
 
 extern int c_val_print (struct type *, const gdb_byte *, int, CORE_ADDR,
 			struct ui_file *, int, int, int,
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/dwarf2expr.c gdb-6.5/gdb/dwarf2expr.c
--- gdb-6.5-orig/gdb/dwarf2expr.c	2007-11-10 23:06:04.000000000 +0100
+++ gdb-6.5/gdb/dwarf2expr.c	2007-11-10 23:22:49.000000000 +0100
@@ -706,6 +706,13 @@ execute_stack_op (struct dwarf_expr_cont
           }
           goto no_push;
 
+	case DW_OP_push_object_address:
+	  if (ctx->get_object_address == NULL)
+	    error (_("DWARF-2 expression error: DW_OP_push_object_address must "
+	           "have a value to push."));
+	  result = (ctx->get_object_address) (ctx->baton);
+	  break;
+
 	default:
 	  error (_("Unhandled dwarf expression opcode 0x%x"), op);
 	}
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/dwarf2expr.h gdb-6.5/gdb/dwarf2expr.h
--- gdb-6.5-orig/gdb/dwarf2expr.h	2005-12-17 23:33:59.000000000 +0100
+++ gdb-6.5/gdb/dwarf2expr.h	2007-11-10 23:22:49.000000000 +0100
@@ -62,10 +62,10 @@ struct dwarf_expr_context
      The result must be live until the current expression evaluation
      is complete.  */
   unsigned char *(*get_subr) (void *baton, off_t offset, size_t *length);
+#endif
 
   /* Return the `object address' for DW_OP_push_object_address.  */
   CORE_ADDR (*get_object_address) (void *baton);
-#endif
 
   /* The current depth of dwarf expression recursion, via DW_OP_call*,
      DW_OP_fbreg, DW_OP_push_object_address, etc., and the maximum
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/dwarf2read.c gdb-6.5/gdb/dwarf2read.c
--- gdb-6.5-orig/gdb/dwarf2read.c	2007-11-10 23:06:04.000000000 +0100
+++ gdb-6.5/gdb/dwarf2read.c	2007-11-11 12:24:29.000000000 +0100
@@ -49,6 +49,9 @@
 #include "top.h"
 #include "command.h"
 #include "gdbcmd.h"
+#include "value.h"
+#include "gdbcore.h"
+#include "exceptions.h"
 
 #include <fcntl.h>
 #include "gdb_string.h"
@@ -1001,7 +1004,7 @@ static void store_in_ref_table (unsigned
 static unsigned int dwarf2_get_ref_die_offset (struct attribute *,
 					       struct dwarf2_cu *);
 
-static int dwarf2_get_attr_constant_value (struct attribute *, int);
+static int dwarf2_get_attr_constant_value (struct attribute *, int *);
 
 static struct die_info *follow_die_ref (struct die_info *,
 					struct attribute *,
@@ -4135,6 +4138,7 @@ read_array_type (struct die_info *die, s
   struct attribute *attr;
   int ndim = 0;
   struct cleanup *back_to;
+  struct dwarf_block *data_location;
 
   /* Return if we've already decoded this type. */
   if (die->type)
@@ -4181,6 +4185,12 @@ read_array_type (struct die_info *die, s
       child_die = sibling_die (child_die);
     }
 
+  attr = dwarf2_attr (die, DW_AT_data_location, cu);
+  if (attr)
+    data_location = DW_BLOCK (attr);
+  else
+    data_location = NULL;
+
   /* Dwarf2 dimensions are output from left to right, create the
      necessary array types in backwards order.  */
 
@@ -4190,12 +4200,18 @@ read_array_type (struct die_info *die, s
     {
       int i = 0;
       while (i < ndim)
-	type = create_array_type (NULL, type, range_types[i++]);
+	{
+	  type = create_array_type (NULL, type, range_types[i++]);
+	  TYPE_DATA_LOCATION (type) = data_location;
+	}
     }
   else
     {
       while (ndim-- > 0)
-	type = create_array_type (NULL, type, range_types[ndim]);
+	{
+	  type = create_array_type (NULL, type, range_types[ndim]);
+	  TYPE_DATA_LOCATION (type) = data_location;
+	}
     }
 
   /* Understand Dwarf2 support for vector types (like they occur on
@@ -4787,6 +4803,120 @@ read_base_type (struct die_info *die, st
   set_die_type (die, type, cu);
 }
 
+/* ------------------------------------------------------------------------ */
+/* `DW_FORM_block*' expression evaluation.  dwarf2block.c would be better.  */
+
+/* This is the baton used when performing dwarf2 DW_BLOCK evaluation.  */
+struct dwarf_block_baton
+{
+  CORE_ADDR address;
+};
+
+/* Read memory at ADDR (length LEN) into BUF.  */
+
+static void
+dwarf_block_read_mem (void *baton, gdb_byte *buf, CORE_ADDR addr, size_t len)
+{
+  read_memory (addr, buf, len);
+}
+
+static CORE_ADDR
+dwarf_block_object_address (void *baton)
+{
+  struct dwarf_block_baton *debaton = baton;
+
+  if (debaton->address == 0)
+    error (_("Cannot resolve DW_OP_push_object_address for a missing object"));
+
+  return debaton->address;
+}
+
+static CORE_ADDR
+dwarf_block_read_reg (void *baton, int regnum)
+{
+  error (_("Unsupported operation for DW_FORM_block*: %s"), "read_reg");
+  return 0;
+}
+
+static void
+dwarf_block_get_frame_base (void *baton, gdb_byte **start, size_t *length)
+{
+  error (_("Unsupported operation for DW_FORM_block*: %s"), "get_frame_base");
+}
+
+static CORE_ADDR
+dwarf_block_get_tls_address (void *baton, CORE_ADDR offset)
+{
+  error (_("Unsupported operation for DW_FORM_block*: %s"), "get_tls_address");
+  return 0;
+}
+
+static CORE_ADDR dwarf_block_exec_core (struct dwarf_block *dwarf_block,
+					CORE_ADDR address)
+{
+  struct dwarf_expr_context *ctx;
+  struct dwarf_block_baton baton;
+  struct cleanup *back_to;
+  CORE_ADDR retval;
+
+  back_to = make_cleanup (null_cleanup, 0);
+
+  baton.address = address;
+
+  ctx = new_dwarf_expr_context ();
+  back_to = make_cleanup ((make_cleanup_ftype *) free_dwarf_expr_context, ctx);
+  ctx->baton = &baton;
+  ctx->read_mem = dwarf_block_read_mem;
+  ctx->get_object_address = dwarf_block_object_address;
+  ctx->read_reg = dwarf_block_read_reg;
+  ctx->get_frame_base = dwarf_block_get_frame_base;
+  ctx->get_tls_address = dwarf_block_get_tls_address;
+
+  dwarf_expr_eval (ctx, dwarf_block->data, dwarf_block->size);
+
+  if (ctx->num_pieces > 0)
+    error (_("DW_OP_piece is an unsupported result for DW_FORM_block*"));
+  if (ctx->in_reg)
+    error (_("DW_OP_reg* is an unsupported result for DW_FORM_block*"));
+
+  retval = dwarf_expr_fetch (ctx, 0);
+
+  do_cleanups (back_to);
+
+  return retval;
+}
+
+struct dwarf_block_exec_hook
+  {
+    struct dwarf_block *dwarf_block;
+    CORE_ADDR address;
+    CORE_ADDR retval;
+  };
+static int dwarf_block_exec_hook (void *data_pointer)
+{
+  struct dwarf_block_exec_hook *data = data_pointer;
+
+  data->retval = dwarf_block_exec_core (data->dwarf_block, data->address);
+
+  return 1;
+}
+
+CORE_ADDR dwarf_block_exec (struct dwarf_block *dwarf_block, CORE_ADDR address)
+{
+  struct dwarf_block_exec_hook data;
+
+  data.dwarf_block = dwarf_block;
+  data.address = address;
+
+  if (!catch_errors (dwarf_block_exec_hook, &data, "", RETURN_MASK_ALL))
+    return 0;
+
+  return data.retval;
+}
+
+/* `DW_FORM_block*' expression evaluation end.  */
+/* ------------------------------------------------------------------------ */
+
 /* Read the given DW_AT_subrange DIE.  */
 
 static void
@@ -4794,9 +4924,9 @@ read_subrange_type (struct die_info *die
 {
   struct type *base_type;
   struct type *range_type;
-  struct attribute *attr;
-  int low = 0;
-  int high = -1;
+  struct attribute *attr, *attr_low, *attr_high;
+  int low, high;
+  int low_nonconst = 0, high_nonconst = 0;
   
   /* If we have already decoded this die, then nothing more to do.  */
   if (die->type)
@@ -4813,43 +4943,37 @@ read_subrange_type (struct die_info *die
   if (TYPE_CODE (base_type) == TYPE_CODE_VOID)
     base_type = alloc_type (NULL);
 
-  if (cu->language == language_fortran)
+  attr_low = dwarf2_attr (die, DW_AT_lower_bound, cu);
+  if (attr_low)
+    low_nonconst = !dwarf2_get_attr_constant_value (attr_low, &low);
+  else if (cu->language == language_fortran)
     { 
       /* FORTRAN implies a lower bound of 1, if not given.  */
       low = 1;
     }
+  else
+    low = 0;
 
-  /* FIXME: For variable sized arrays either of these could be
-     a variable rather than a constant value.  We'll allow it,
-     but we don't know how to handle it.  */
-  attr = dwarf2_attr (die, DW_AT_lower_bound, cu);
-  if (attr)
-    low = dwarf2_get_attr_constant_value (attr, 0);
-
-  attr = dwarf2_attr (die, DW_AT_upper_bound, cu);
-  if (attr)
-    {       
-      if (attr->form == DW_FORM_block1)
-        {
-          /* GCC encodes arrays with unspecified or dynamic length
-             with a DW_FORM_block1 attribute.
-             FIXME: GDB does not yet know how to handle dynamic
-             arrays properly, treat them as arrays with unspecified
-             length for now.
-
-             FIXME: jimb/2003-09-22: GDB does not really know
-             how to handle arrays of unspecified length
-             either; we just represent them as zero-length
-             arrays.  Choose an appropriate upper bound given
-             the lower bound we've computed above.  */
-          high = low - 1;
-        }
-      else
-        high = dwarf2_get_attr_constant_value (attr, 1);
-    }
+  attr_high = dwarf2_attr (die, DW_AT_upper_bound, cu);
+  if (attr_high)
+    high_nonconst = !dwarf2_get_attr_constant_value (attr_high, &high);
+  else
+    high = low - 1;
 
   range_type = create_range_type (NULL, base_type, low, high);
 
+  /* Override the possibly invalid LOW/HIGH from CREATE_RANGE_TYPE.  */
+  if (low_nonconst)
+    {
+      TYPE_FIELD_STATIC_KIND (range_type, 0) = 1;
+      TYPE_FIELD_DWARF_BLOCK (range_type, 0) = DW_BLOCK (attr_low);
+    }
+  if (high_nonconst)
+    {
+      TYPE_FIELD_STATIC_KIND (range_type, 1) = 1;
+      TYPE_FIELD_DWARF_BLOCK (range_type, 1) = DW_BLOCK (attr_high);
+    }
+
   attr = dwarf2_attr (die, DW_AT_name, cu);
   if (attr && DW_STRING (attr))
     TYPE_NAME (range_type) = DW_STRING (attr);
@@ -8565,26 +8689,29 @@ dwarf2_get_ref_die_offset (struct attrib
   return result;
 }
 
-/* Return the constant value held by the given attribute.  Return -1
-   if the value held by the attribute is not constant.  */
+/* Return 1 and in *VAL_RETURN the constant value held by the given attribute.
+   Return 0 if the value held by the attribute is not constant.  */
 
 static int
-dwarf2_get_attr_constant_value (struct attribute *attr, int default_value)
+dwarf2_get_attr_constant_value (struct attribute *attr, int *val_return)
 {
   if (attr->form == DW_FORM_sdata)
-    return DW_SND (attr);
-  else if (attr->form == DW_FORM_udata
-           || attr->form == DW_FORM_data1
-           || attr->form == DW_FORM_data2
-           || attr->form == DW_FORM_data4
-           || attr->form == DW_FORM_data8)
-    return DW_UNSND (attr);
-  else
     {
-      complaint (&symfile_complaints, _("Attribute value is not a constant (%s)"),
-                 dwarf_form_name (attr->form));
-      return default_value;
+      *val_return = DW_SND (attr);
+      return 1;
     }
+  if (attr->form == DW_FORM_udata
+      || attr->form == DW_FORM_data1
+      || attr->form == DW_FORM_data2
+      || attr->form == DW_FORM_data4
+      || attr->form == DW_FORM_data8)
+    {
+      *val_return = DW_UNSND (attr);
+      return 1;
+    }
+  complaint (&symfile_complaints, _("Attribute value is not a constant (%s)"),
+             dwarf_form_name (attr->form));
+  return 0;
 }
 
 static struct die_info *
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/eval.c gdb-6.5/gdb/eval.c
--- gdb-6.5-orig/gdb/eval.c	2007-11-10 23:06:04.000000000 +0100
+++ gdb-6.5/gdb/eval.c	2007-11-11 12:03:38.000000000 +0100
@@ -1675,11 +1675,13 @@ evaluate_subexp_standard (struct type *e
 	/* Internal type of array is arranged right to left */
 	for (i = 0; i < nargs; i++)
 	  {
-	    retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
+	    retcode = f77_get_dynamic_upperbound (tmp_type,
+						  VALUE_ADDRESS (arg1), &upper);
 	    if (retcode == BOUND_FETCH_ERROR)
 	      error (_("Cannot obtain dynamic upper bound"));
 
-	    retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
+	    retcode = f77_get_dynamic_lowerbound (tmp_type,
+						  VALUE_ADDRESS (arg1), &lower);
 	    if (retcode == BOUND_FETCH_ERROR)
 	      error (_("Cannot obtain dynamic lower bound"));
 
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/f-lang.c gdb-6.5/gdb/f-lang.c
--- gdb-6.5-orig/gdb/f-lang.c	2005-12-17 23:33:59.000000000 +0100
+++ gdb-6.5/gdb/f-lang.c	2007-11-10 23:22:49.000000000 +0100
@@ -470,7 +470,7 @@ const struct language_defn f_language_de
   f_printstr,			/* function to print string constant */
   f_emit_char,			/* Function to print a single character */
   f_create_fundamental_type,	/* Create fundamental type in this language */
-  f_print_type,			/* Print a type using appropriate syntax */
+  f_print_type_with_address,	/* Print a type using appropriate syntax */
   f_val_print,			/* Print a value using appropriate syntax */
   c_value_print,		/* FIXME */
   NULL,				/* Language specific skip_trampoline */
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/f-lang.h gdb-6.5/gdb/f-lang.h
--- gdb-6.5-orig/gdb/f-lang.h	2005-12-17 23:33:59.000000000 +0100
+++ gdb-6.5/gdb/f-lang.h	2007-11-10 23:22:49.000000000 +0100
@@ -27,8 +27,8 @@ extern int f_parse (void);
 
 extern void f_error (char *);	/* Defined in f-exp.y */
 
-extern void f_print_type (struct type *, char *, struct ui_file *, int,
-			  int);
+extern void f_print_type_with_address (struct type *, CORE_ADDR, char *,
+				       struct ui_file *, int, int);
 
 extern int f_val_print (struct type *, const gdb_byte *, int, CORE_ADDR,
 			struct ui_file *, int, int, int,
@@ -99,9 +99,9 @@ extern SAVED_F77_COMMON_PTR find_common_
 extern char *real_main_name;	/* Name of main function */
 extern int real_main_c_value;	/* C_value field of main function */
 
-extern int f77_get_dynamic_upperbound (struct type *, int *);
+extern int f77_get_dynamic_upperbound (struct type *, CORE_ADDR, int *);
 
-extern int f77_get_dynamic_lowerbound (struct type *, int *);
+extern int f77_get_dynamic_lowerbound (struct type *, CORE_ADDR, int *);
 
 extern void f77_get_dynamic_array_length (struct type *);
 
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/f-typeprint.c gdb-6.5/gdb/f-typeprint.c
--- gdb-6.5-orig/gdb/f-typeprint.c	2006-03-01 02:37:26.000000000 +0100
+++ gdb-6.5/gdb/f-typeprint.c	2007-11-10 23:22:49.000000000 +0100
@@ -44,8 +44,8 @@ static void f_type_print_args (struct ty
 static void print_equivalent_f77_float_type (int level, struct type *,
 					     struct ui_file *);
 
-static void f_type_print_varspec_suffix (struct type *, struct ui_file *,
-					 int, int, int);
+static void f_type_print_varspec_suffix (struct type *, CORE_ADDR,
+					 struct ui_file *, int, int, int);
 
 void f_type_print_varspec_prefix (struct type *, struct ui_file *,
 				  int, int);
@@ -56,8 +56,9 @@ void f_type_print_base (struct type *, s
 /* LEVEL is the depth to indent lines by.  */
 
 void
-f_print_type (struct type *type, char *varstring, struct ui_file *stream,
-	      int show, int level)
+f_print_type_with_address (struct type *type, CORE_ADDR address,
+			   char *varstring, struct ui_file *stream, int show,
+			   int level)
 {
   enum type_code code;
   int demangled_args;
@@ -84,7 +85,7 @@ f_print_type (struct type *type, char *v
      so don't print an additional pair of ()'s */
 
   demangled_args = varstring[strlen (varstring) - 1] == ')';
-  f_type_print_varspec_suffix (type, stream, show, 0, demangled_args);
+  f_type_print_varspec_suffix (type, address, stream, show, 0, demangled_args);
 }
 
 /* Print any asterisks or open-parentheses needed before the
@@ -153,8 +154,9 @@ f_type_print_varspec_prefix (struct type
    Args work like c_type_print_varspec_prefix.  */
 
 static void
-f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
-			     int show, int passed_a_ptr, int demangled_args)
+f_type_print_varspec_suffix (struct type *type, CORE_ADDR address,
+			     struct ui_file *stream, int show, int passed_a_ptr,
+			     int demangled_args)
 {
   int upper_bound, lower_bound;
   int lower_bound_was_default = 0;
@@ -178,9 +180,10 @@ f_type_print_varspec_suffix (struct type
 	fprintf_filtered (stream, "(");
 
       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
-	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
+	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), address, stream,
+				     0, 0, 0);
 
-      retcode = f77_get_dynamic_lowerbound (type, &lower_bound);
+      retcode = f77_get_dynamic_lowerbound (type, address, &lower_bound);
 
       lower_bound_was_default = 0;
 
@@ -203,7 +206,7 @@ f_type_print_varspec_suffix (struct type
 	fprintf_filtered (stream, "*");
       else
 	{
-	  retcode = f77_get_dynamic_upperbound (type, &upper_bound);
+	  retcode = f77_get_dynamic_upperbound (type, address, &upper_bound);
 
 	  if (retcode == BOUND_FETCH_ERROR)
 	    fprintf_filtered (stream, "???");
@@ -212,7 +215,8 @@ f_type_print_varspec_suffix (struct type
 	}
 
       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
-	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
+	f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), address, stream,
+				     0, 0, 0);
       if (arrayprint_recurse_level == 1)
 	fprintf_filtered (stream, ")");
       else
@@ -222,12 +226,13 @@ f_type_print_varspec_suffix (struct type
 
     case TYPE_CODE_PTR:
     case TYPE_CODE_REF:
-      f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0);
+      f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), address, stream, 0,
+				   1, 0);
       fprintf_filtered (stream, ")");
       break;
 
     case TYPE_CODE_FUNC:
-      f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
+      f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), address, stream, 0,
 				   passed_a_ptr, 0);
       if (passed_a_ptr)
 	fprintf_filtered (stream, ")");
@@ -385,7 +390,7 @@ f_type_print_base (struct type *type, st
 	fprintfi_filtered (level, stream, "character*(*)");
       else
 	{
-	  retcode = f77_get_dynamic_upperbound (type, &upper_bound);
+	  retcode = f77_get_dynamic_upperbound (type, 0, &upper_bound);
 
 	  if (retcode == BOUND_FETCH_ERROR)
 	    fprintf_filtered (stream, "character*???");
@@ -400,7 +405,8 @@ f_type_print_base (struct type *type, st
       fputs_filtered ("\n", stream);
       for (index = 0; index < TYPE_NFIELDS (type); index++)
 	{
-	  f_print_type (TYPE_FIELD_TYPE (type, index), "", stream, show, level + 4);
+	  f_print_type_with_address (TYPE_FIELD_TYPE (type, index), 0, "", stream,
+				     show, level + 4);
 	  fputs_filtered (" :: ", stream);
 	  fputs_filtered (TYPE_FIELD_NAME (type, index), stream);
 	  fputs_filtered ("\n", stream);
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/f-valprint.c gdb-6.5/gdb/f-valprint.c
--- gdb-6.5-orig/gdb/f-valprint.c	2006-02-24 08:26:10.000000000 +0100
+++ gdb-6.5/gdb/f-valprint.c	2007-11-10 23:22:49.000000000 +0100
@@ -44,8 +44,8 @@ static int there_is_a_visible_common_nam
 extern void _initialize_f_valprint (void);
 static void info_common_command (char *, int);
 static void list_all_visible_commons (char *);
-static void f77_create_arrayprint_offset_tbl (struct type *,
-					      struct ui_file *);
+static void f77_create_arrayprint_offset_tbl (struct type *, struct ui_file *,
+					      CORE_ADDR address);
 static void f77_get_dynamic_length_of_aggregate (struct type *);
 
 int f77_array_offset_tbl[MAX_FORTRAN_DIMS + 1][2];
@@ -62,8 +62,11 @@ int f77_array_offset_tbl[MAX_FORTRAN_DIM
 
 #define F77_DIM_OFFSET(n) (f77_array_offset_tbl[n][0])
 
+/* ADDRESS is the value address at the inferior.  */
+
 int
-f77_get_dynamic_lowerbound (struct type *type, int *lower_bound)
+f77_get_dynamic_lowerbound (struct type *type, CORE_ADDR address,
+			    int *lower_bound)
 {
   CORE_ADDR current_frame_addr;
   CORE_ADDR ptr_to_lower_bound;
@@ -87,7 +90,7 @@ f77_get_dynamic_lowerbound (struct type 
       break;
 
     case BOUND_SIMPLE:
-      *lower_bound = TYPE_ARRAY_LOWER_BOUND_VALUE (type);
+      *lower_bound = TYPE_ARRAY_LOWER_BOUND_VALUE_WITH_ADDRESS (type, address);
       break;
 
     case BOUND_CANNOT_BE_DETERMINED:
@@ -120,8 +123,11 @@ f77_get_dynamic_lowerbound (struct type 
   return BOUND_FETCH_OK;
 }
 
+/* ADDRESS is the value address at the inferior.  */
+
 int
-f77_get_dynamic_upperbound (struct type *type, int *upper_bound)
+f77_get_dynamic_upperbound (struct type *type, CORE_ADDR address,
+			    int *upper_bound)
 {
   CORE_ADDR current_frame_addr = 0;
   CORE_ADDR ptr_to_upper_bound;
@@ -145,7 +151,7 @@ f77_get_dynamic_upperbound (struct type 
       break;
 
     case BOUND_SIMPLE:
-      *upper_bound = TYPE_ARRAY_UPPER_BOUND_VALUE (type);
+      *upper_bound = TYPE_ARRAY_UPPER_BOUND_VALUE_WITH_ADDRESS (type, address);
       break;
 
     case BOUND_CANNOT_BE_DETERMINED:
@@ -154,7 +160,7 @@ f77_get_dynamic_upperbound (struct type 
          1 element.If the user wants to see more elements, let 
          him manually ask for 'em and we'll subscript the 
          array and show him */
-      f77_get_dynamic_lowerbound (type, upper_bound);
+      f77_get_dynamic_lowerbound (type, 0, upper_bound);
       break;
 
     case BOUND_BY_REF_ON_STACK:
@@ -206,11 +212,11 @@ f77_get_dynamic_length_of_aggregate (str
     f77_get_dynamic_length_of_aggregate (TYPE_TARGET_TYPE (type));
 
   /* Recursion ends here, start setting up lengths.  */
-  retcode = f77_get_dynamic_lowerbound (type, &lower_bound);
+  retcode = f77_get_dynamic_lowerbound (type, 0, &lower_bound);
   if (retcode == BOUND_FETCH_ERROR)
     error (_("Cannot obtain valid array lower bound"));
 
-  retcode = f77_get_dynamic_upperbound (type, &upper_bound);
+  retcode = f77_get_dynamic_upperbound (type, 0, &upper_bound);
   if (retcode == BOUND_FETCH_ERROR)
     error (_("Cannot obtain valid array upper bound"));
 
@@ -221,10 +227,11 @@ f77_get_dynamic_length_of_aggregate (str
 }
 
 /* Function that sets up the array offset,size table for the array 
-   type "type".  */
+   type "type".  ADDRESS is the value address at the inferior.  */
 
 static void
-f77_create_arrayprint_offset_tbl (struct type *type, struct ui_file *stream)
+f77_create_arrayprint_offset_tbl (struct type *type, struct ui_file *stream,
+				  CORE_ADDR address)
 {
   struct type *tmp_type;
   int eltlen;
@@ -238,11 +245,11 @@ f77_create_arrayprint_offset_tbl (struct
       if (TYPE_ARRAY_UPPER_BOUND_TYPE (tmp_type) == BOUND_CANNOT_BE_DETERMINED)
 	fprintf_filtered (stream, "<assumed size array> ");
 
-      retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
+      retcode = f77_get_dynamic_upperbound (tmp_type, address, &upper);
       if (retcode == BOUND_FETCH_ERROR)
 	error (_("Cannot obtain dynamic upper bound"));
 
-      retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
+      retcode = f77_get_dynamic_lowerbound (tmp_type, address, &lower);
       if (retcode == BOUND_FETCH_ERROR)
 	error (_("Cannot obtain dynamic lower bound"));
 
@@ -337,7 +344,7 @@ f77_print_array (struct type *type, cons
      offset table to get at the various row's elements. The 
      offset table contains entries for both offset and subarray size. */
 
-  f77_create_arrayprint_offset_tbl (type, stream);
+  f77_create_arrayprint_offset_tbl (type, stream, address);
 
   f77_print_array_1 (1, ndimensions, type, valaddr, address, stream, format,
 		     deref_ref, recurse, pretty, &elts);
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/gdbtypes.c gdb-6.5/gdb/gdbtypes.c
--- gdb-6.5-orig/gdb/gdbtypes.c	2006-03-01 20:34:46.000000000 +0100
+++ gdb-6.5/gdb/gdbtypes.c	2007-11-10 23:22:49.000000000 +0100
@@ -675,8 +675,8 @@ create_range_type (struct type *result_t
   TYPE_FIELDS (result_type) = (struct field *)
     TYPE_ALLOC (result_type, 2 * sizeof (struct field));
   memset (TYPE_FIELDS (result_type), 0, 2 * sizeof (struct field));
-  TYPE_FIELD_BITPOS (result_type, 0) = low_bound;
-  TYPE_FIELD_BITPOS (result_type, 1) = high_bound;
+  TYPE_LOW_BOUND_RAW (result_type) = low_bound;
+  TYPE_HIGH_BOUND_RAW (result_type) = high_bound;
   TYPE_FIELD_TYPE (result_type, 0) = builtin_type_int;	/* FIXME */
   TYPE_FIELD_TYPE (result_type, 1) = builtin_type_int;	/* FIXME */
 
@@ -768,19 +768,22 @@ struct type *
 create_array_type (struct type *result_type, struct type *element_type,
 		   struct type *range_type)
 {
-  LONGEST low_bound, high_bound;
-
   if (result_type == NULL)
     {
       result_type = alloc_type (TYPE_OBJFILE (range_type));
     }
   TYPE_CODE (result_type) = TYPE_CODE_ARRAY;
   TYPE_TARGET_TYPE (result_type) = element_type;
-  if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
-    low_bound = high_bound = 0;
   CHECK_TYPEDEF (element_type);
-  TYPE_LENGTH (result_type) =
-    TYPE_LENGTH (element_type) * (high_bound - low_bound + 1);
+  /* Dynamically sized arrays cannot be computed now as we may have forward
+     DWARF references here.  */
+  if (TYPE_FIELD_STATIC_KIND (range_type, 0) == 1
+      || TYPE_FIELD_STATIC_KIND (range_type, 1) == 1)
+    TYPE_LENGTH (result_type) = 0;
+  else
+    TYPE_LENGTH (result_type) = TYPE_LENGTH (element_type)
+				* (TYPE_HIGH_BOUND (range_type)
+				   - TYPE_LOW_BOUND (range_type) + 1);
   TYPE_NFIELDS (result_type) = 1;
   TYPE_FIELDS (result_type) =
     (struct field *) TYPE_ALLOC (result_type, sizeof (struct field));
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/gdbtypes.h gdb-6.5/gdb/gdbtypes.h
--- gdb-6.5-orig/gdb/gdbtypes.h	2006-02-02 00:14:10.000000000 +0100
+++ gdb-6.5/gdb/gdbtypes.h	2007-11-11 11:48:14.000000000 +0100
@@ -393,6 +393,9 @@ struct main_type
 
   short vptr_fieldno;
 
+  /* For DW_AT_data_location.  Passed to DWARF_BLOCK_EXEC.  */
+  struct dwarf_block *data_location;
+
   /* For structure and union types, a description of each field.
      For set and pascal array types, there is one "field",
      whose type is the domain type of the set or array.
@@ -427,6 +430,9 @@ struct main_type
 
       CORE_ADDR physaddr;
       char *physname;
+
+      /* For dynamically-sized arrays.  Passed to DWARF_BLOCK_EXEC.  */
+      struct dwarf_block *dwarf_block;
     }
     loc;
 
@@ -437,7 +443,8 @@ struct main_type
 
     /* This flag is zero for non-static fields, 1 for fields whose location
        is specified by the label loc.physname, and 2 for fields whose location
-       is specified by loc.physaddr.  */
+       is specified by loc.physaddr.
+       For range bounds 0 is for loc.bitpos and 1 is for loc.dwarf_block.  */
 
     unsigned int static_kind : 2;
 
@@ -811,13 +818,34 @@ extern void allocate_cplus_struct_type (
    type, you need to do TYPE_CODE (check_type (this_type)). */
 #define TYPE_CODE(thistype) TYPE_MAIN_TYPE(thistype)->code
 #define TYPE_NFIELDS(thistype) TYPE_MAIN_TYPE(thistype)->nfields
+#define TYPE_DATA_LOCATION(thistype) TYPE_MAIN_TYPE(thistype)->data_location
 #define TYPE_FIELDS(thistype) TYPE_MAIN_TYPE(thistype)->fields
 #define TYPE_TEMPLATE_ARGS(thistype) TYPE_CPLUS_SPECIFIC(thistype)->template_args
 #define TYPE_INSTANTIATIONS(thistype) TYPE_CPLUS_SPECIFIC(thistype)->instantiations
 
 #define TYPE_INDEX_TYPE(type) TYPE_FIELD_TYPE (type, 0)
-#define TYPE_LOW_BOUND(range_type) TYPE_FIELD_BITPOS (range_type, 0)
-#define TYPE_HIGH_BOUND(range_type) TYPE_FIELD_BITPOS (range_type, 1)
+#define TYPE_LOW_BOUND_RAW(range_type) TYPE_FIELD_BITPOS (range_type, 0)
+#define TYPE_HIGH_BOUND_RAW(range_type) TYPE_FIELD_BITPOS (range_type, 1)
+extern CORE_ADDR dwarf_block_exec (struct dwarf_block *dwarf_block,
+				   CORE_ADDR address);
+#define TYPE_LOWHIGH_BOUND_WITH_ADDRESS(range_type, fieldno, address)	    \
+  ({									    \
+    struct type *_type = (range_type);					    \
+    int retval;								    \
+									    \
+    if (TYPE_FIELD_STATIC_KIND (_type, (fieldno)) == 1)			    \
+      retval = dwarf_block_exec (TYPE_FIELD_DWARF_BLOCK (_type,	(fieldno)), \
+				 (address));				    \
+    else								    \
+      retval = TYPE_FIELD_BITPOS (_type, (fieldno));			    \
+    retval;								    \
+  })
+#define TYPE_LOW_BOUND_WITH_ADDRESS(range_type, address) \
+  TYPE_LOWHIGH_BOUND_WITH_ADDRESS ((range_type), 0, (address))
+#define TYPE_HIGH_BOUND_WITH_ADDRESS(range_type, address) \
+  TYPE_LOWHIGH_BOUND_WITH_ADDRESS ((range_type), 1, (address))
+#define TYPE_LOW_BOUND(range_type) TYPE_LOW_BOUND_WITH_ADDRESS (range_type, 0)
+#define TYPE_HIGH_BOUND(range_type) TYPE_HIGH_BOUND_WITH_ADDRESS (range_type, 0)
 
 /* Moto-specific stuff for FORTRAN arrays */
 
@@ -826,11 +854,14 @@ extern void allocate_cplus_struct_type (
 #define TYPE_ARRAY_LOWER_BOUND_TYPE(thistype) \
 	TYPE_MAIN_TYPE(thistype)->lower_bound_type
 
-#define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \
-   (TYPE_FIELD_BITPOS((TYPE_FIELD_TYPE((arraytype),0)),1))
-
+#define TYPE_ARRAY_LOWER_BOUND_VALUE_WITH_ADDRESS(arraytype, address) \
+  (TYPE_LOW_BOUND_WITH_ADDRESS(TYPE_INDEX_TYPE(arraytype), (address)))
+#define TYPE_ARRAY_UPPER_BOUND_VALUE_WITH_ADDRESS(arraytype, address) \
+  (TYPE_HIGH_BOUND_WITH_ADDRESS(TYPE_INDEX_TYPE(arraytype), (address)))
 #define TYPE_ARRAY_LOWER_BOUND_VALUE(arraytype) \
-   (TYPE_FIELD_BITPOS((TYPE_FIELD_TYPE((arraytype),0)),0))
+  TYPE_ARRAY_LOWER_BOUND_VALUE_WITH_ADDRESS ((arraytype), 0)
+#define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \
+  TYPE_ARRAY_UPPER_BOUND_VALUE_WITH_ADDRESS ((arraytype), 0)
 
 /* C++ */
 
@@ -860,6 +891,7 @@ extern void allocate_cplus_struct_type (
 #define FIELD_TYPE(thisfld) ((thisfld).type)
 #define FIELD_NAME(thisfld) ((thisfld).name)
 #define FIELD_BITPOS(thisfld) ((thisfld).loc.bitpos)
+#define FIELD_DWARF_BLOCK(thisfld) ((thisfld).loc.dwarf_block)
 #define FIELD_ARTIFICIAL(thisfld) ((thisfld).artificial)
 #define FIELD_BITSIZE(thisfld) ((thisfld).bitsize)
 #define FIELD_STATIC_KIND(thisfld) ((thisfld).static_kind)
@@ -873,6 +905,7 @@ extern void allocate_cplus_struct_type (
 #define TYPE_FIELD_TYPE(thistype, n) FIELD_TYPE(TYPE_FIELD(thistype, n))
 #define TYPE_FIELD_NAME(thistype, n) FIELD_NAME(TYPE_FIELD(thistype, n))
 #define TYPE_FIELD_BITPOS(thistype, n) FIELD_BITPOS(TYPE_FIELD(thistype,n))
+#define TYPE_FIELD_DWARF_BLOCK(thistype, n) FIELD_DWARF_BLOCK(TYPE_FIELD(thistype,n))
 #define TYPE_FIELD_ARTIFICIAL(thistype, n) FIELD_ARTIFICIAL(TYPE_FIELD(thistype,n))
 #define TYPE_FIELD_BITSIZE(thistype, n) FIELD_BITSIZE(TYPE_FIELD(thistype,n))
 #define TYPE_FIELD_PACKED(thistype, n) (FIELD_BITSIZE(TYPE_FIELD(thistype,n))!=0)
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/jv-lang.c gdb-6.5/gdb/jv-lang.c
--- gdb-6.5-orig/gdb/jv-lang.c	2005-12-17 23:34:01.000000000 +0100
+++ gdb-6.5/gdb/jv-lang.c	2007-11-10 23:22:49.000000000 +0100
@@ -1082,6 +1082,14 @@ const struct exp_descriptor exp_descript
   evaluate_subexp_java
 };
 
+static void
+java_print_type_with_address (struct type *type, CORE_ADDR address,
+			      char *varstring, struct ui_file *stream,
+			      int show, int level)
+{
+  return java_print_type (type, varstring, stream, show, level);
+}
+
 const struct language_defn java_language_defn =
 {
   "java",			/* Language name */
@@ -1099,7 +1107,7 @@ const struct language_defn java_language
   c_printstr,			/* Function to print string constant */
   java_emit_char,		/* Function to print a single character */
   java_create_fundamental_type,	/* Create fundamental type in this language */
-  java_print_type,		/* Print a type using appropriate syntax */
+  java_print_type_with_address,	/* Print a type using appropriate syntax */
   java_val_print,		/* Print a value using appropriate syntax */
   java_value_print,		/* Print a top-level value */
   NULL,				/* Language specific skip_trampoline */
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/language.c gdb-6.5/gdb/language.c
--- gdb-6.5-orig/gdb/language.c	2005-12-17 23:34:01.000000000 +0100
+++ gdb-6.5/gdb/language.c	2007-11-10 23:22:49.000000000 +0100
@@ -72,8 +72,8 @@ static void unk_lang_printchar (int c, s
 
 static struct type *unk_lang_create_fundamental_type (struct objfile *, int);
 
-static void unk_lang_print_type (struct type *, char *, struct ui_file *,
-				 int, int);
+static void unk_lang_print_type (struct type *, CORE_ADDR, char *,
+				 struct ui_file *, int, int);
 
 static int unk_lang_value_print (struct value *, struct ui_file *, int, enum val_prettyprint);
 
@@ -1108,8 +1108,8 @@ unk_lang_create_fundamental_type (struct
 }
 
 static void
-unk_lang_print_type (struct type *type, char *varstring, struct ui_file *stream,
-		     int show, int level)
+unk_lang_print_type (struct type *type, CORE_ADDR address, char *varstring,
+		     struct ui_file *stream, int show, int level)
 {
   error (_("internal error - unimplemented function unk_lang_print_type called."));
 }
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/language.h gdb-6.5/gdb/language.h
--- gdb-6.5-orig/gdb/language.h	2005-12-17 23:34:01.000000000 +0100
+++ gdb-6.5/gdb/language.h	2007-11-10 23:22:49.000000000 +0100
@@ -203,8 +203,8 @@ struct language_defn
 
     /* Print a type using syntax appropriate for this language. */
 
-    void (*la_print_type) (struct type *, char *, struct ui_file *, int,
-			   int);
+    void (*la_print_type_with_address) (struct type *, CORE_ADDR, char *,
+					struct ui_file *, int, int);
 
     /* Print a value using syntax appropriate for this language. */
 
@@ -352,8 +352,11 @@ extern enum language set_language (enum 
 #define create_fundamental_type(objfile,typeid) \
   (current_language->la_fund_type(objfile, typeid))
 
+#define LA_PRINT_TYPE_WITH_ADDRESS(type,adress,varstring,stream,show,level) \
+  (current_language->la_print_type_with_address(type,address,varstring,stream,show,level))
+
 #define LA_PRINT_TYPE(type,varstring,stream,show,level) \
-  (current_language->la_print_type(type,varstring,stream,show,level))
+  (current_language->la_print_type_with_address(type,0,varstring,stream,show,level))
 
 #define LA_VAL_PRINT(type,valaddr,offset,addr,stream,fmt,deref,recurse,pretty) \
   (current_language->la_val_print(type,valaddr,offset,addr,stream,fmt,deref, \
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/m2-lang.c gdb-6.5/gdb/m2-lang.c
--- gdb-6.5-orig/gdb/m2-lang.c	2005-12-17 23:34:01.000000000 +0100
+++ gdb-6.5/gdb/m2-lang.c	2007-11-10 23:22:49.000000000 +0100
@@ -405,6 +405,14 @@ struct type **const (m2_builtin_types[])
     0
 };
 
+static void
+m2_print_type_with_address (struct type *type, CORE_ADDR address,
+			    char *varstring, struct ui_file *stream, int show,
+			    int level)
+{
+  m2_print_type (type, varstring, stream, show, level);
+}
+
 const struct language_defn m2_language_defn =
 {
   "modula-2",
@@ -422,7 +430,7 @@ const struct language_defn m2_language_d
   m2_printstr,			/* function to print string constant */
   m2_emit_char,			/* Function to print a single character */
   m2_create_fundamental_type,	/* Create fundamental type in this language */
-  m2_print_type,		/* Print a type using appropriate syntax */
+  m2_print_type_with_address,	/* Print a type using appropriate syntax */
   m2_val_print,			/* Print a value using appropriate syntax */
   c_value_print,		/* Print a top-level value */
   NULL,				/* Language specific skip_trampoline */
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/objc-lang.c gdb-6.5/gdb/objc-lang.c
--- gdb-6.5-orig/gdb/objc-lang.c	2005-12-17 23:34:01.000000000 +0100
+++ gdb-6.5/gdb/objc-lang.c	2007-11-10 23:22:49.000000000 +0100
@@ -669,7 +669,7 @@ const struct language_defn objc_language
   objc_printstr,		/* Function to print string constant */
   objc_emit_char,
   objc_create_fundamental_type,	/* Create fundamental type in this language */
-  c_print_type,			/* Print a type using appropriate syntax */
+  c_print_type_with_address,	/* Print a type using appropriate syntax */
   c_val_print,			/* Print a value using appropriate syntax */
   c_value_print,		/* Print a top-level value */
   objc_skip_trampoline, 	/* Language specific skip_trampoline */
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/p-lang.c gdb-6.5/gdb/p-lang.c
--- gdb-6.5-orig/gdb/p-lang.c	2005-12-17 23:34:01.000000000 +0100
+++ gdb-6.5/gdb/p-lang.c	2007-11-10 23:22:49.000000000 +0100
@@ -446,6 +446,14 @@ struct type **const (pascal_builtin_type
     0
 };
 
+static void
+pascal_print_type_with_address (struct type *type, CORE_ADDR address,
+				char *varstring, struct ui_file *stream,
+				int show, int level)
+{
+  return pascal_print_type (type, varstring, stream, show, level);
+}
+
 const struct language_defn pascal_language_defn =
 {
   "pascal",			/* Language name */
@@ -463,7 +471,7 @@ const struct language_defn pascal_langua
   pascal_printstr,		/* Function to print string constant */
   pascal_emit_char,		/* Print a single char */
   pascal_create_fundamental_type,	/* Create fundamental type in this language */
-  pascal_print_type,		/* Print a type using appropriate syntax */
+  pascal_print_type_with_address,	/* Print a type using appropriate syntax */
   pascal_val_print,		/* Print a value using appropriate syntax */
   pascal_value_print,		/* Print a top-level value */
   NULL,				/* Language specific skip_trampoline */
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/scm-lang.c gdb-6.5/gdb/scm-lang.c
--- gdb-6.5-orig/gdb/scm-lang.c	2005-12-17 23:34:02.000000000 +0100
+++ gdb-6.5/gdb/scm-lang.c	2007-11-10 23:22:49.000000000 +0100
@@ -254,7 +254,7 @@ const struct language_defn scm_language_
   scm_printstr,			/* Function to print string constant */
   NULL,				/* Function to print a single character */
   NULL,				/* Create fundamental type in this language */
-  c_print_type,			/* Print a type using appropriate syntax */
+  c_print_type_with_address,	/* Print a type using appropriate syntax */
   scm_val_print,		/* Print a value using appropriate syntax */
   scm_value_print,		/* Print a top-level value */
   NULL,				/* Language specific skip_trampoline */
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/typeprint.c gdb-6.5/gdb/typeprint.c
--- gdb-6.5-orig/gdb/typeprint.c	2006-02-18 21:47:54.000000000 +0100
+++ gdb-6.5/gdb/typeprint.c	2007-11-10 23:22:49.000000000 +0100
@@ -101,6 +101,13 @@ typedef_print (struct type *type, struct
    If SHOW is negative, we never show the details of elements' types.  */
 
 void
+type_print_with_address (struct type *type, CORE_ADDR address, char *varstring,
+			 struct ui_file *stream, int show)
+{
+  LA_PRINT_TYPE_WITH_ADDRESS (type, address, varstring, stream, show, 0);
+}
+
+void
 type_print (struct type *type, char *varstring, struct ui_file *stream,
 	    int show)
 {
@@ -158,13 +165,14 @@ whatis_exp (char *exp, int show)
   if (real_type)
     {
       printf_filtered ("/* real type = ");
-      type_print (real_type, "", gdb_stdout, -1);
+      type_print_with_address (real_type, VALUE_ADDRESS (val), "", gdb_stdout,
+			       -1);
       if (! full)
         printf_filtered (" (incomplete object)");
       printf_filtered (" */\n");    
     }
 
-  type_print (type, "", gdb_stdout, show);
+  type_print_with_address (type, VALUE_ADDRESS (val), "", gdb_stdout, show);
   printf_filtered ("\n");
 
   if (exp)
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/valops.c gdb-6.5/gdb/valops.c
--- gdb-6.5-orig/gdb/valops.c	2007-11-10 23:06:04.000000000 +0100
+++ gdb-6.5/gdb/valops.c	2007-11-11 12:39:11.000000000 +0100
@@ -507,7 +507,7 @@ value_at_lazy (struct type *type, CORE_A
 int
 value_fetch_lazy (struct value *val)
 {
-  CORE_ADDR addr = VALUE_ADDRESS (val) + value_offset (val);
+  CORE_ADDR addr = value_address_get (val) + value_offset (val);
   int length = TYPE_LENGTH (value_enclosing_type (val));
 
   struct type *type = value_type (val);
@@ -830,7 +830,7 @@ value_coerce_array (struct value *arg1)
     error (_("Attempt to take address of value not located in memory."));
 
   return value_from_pointer (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
-			     (VALUE_ADDRESS (arg1) + value_offset (arg1)));
+			     (value_address_get (arg1) + value_offset (arg1)));
 }
 
 /* Given a value which is a function, return a value which is a pointer
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/value.c gdb-6.5/gdb/value.c
--- gdb-6.5-orig/gdb/value.c	2006-03-31 12:36:18.000000000 +0200
+++ gdb-6.5/gdb/value.c	2007-11-11 11:52:58.000000000 +0100
@@ -426,6 +426,17 @@ deprecated_value_address_hack (struct va
   return &value->location.address;
 }
 
+CORE_ADDR value_address_get (struct value *val)
+{
+  struct type *type = value_type (val);
+  CORE_ADDR retval;
+
+  retval = VALUE_ADDRESS (val);
+  if (TYPE_DATA_LOCATION (type) != NULL)
+    retval = dwarf_block_exec (TYPE_DATA_LOCATION (type), retval);
+  return retval;
+}
+
 struct internalvar **
 deprecated_value_internalvar_hack (struct value *value)
 {
diff -u -X /home/jkratoch/.diffi.list -rup gdb-6.5-orig/gdb/value.h gdb-6.5/gdb/value.h
--- gdb-6.5-orig/gdb/value.h	2006-03-31 12:36:18.000000000 +0200
+++ gdb-6.5/gdb/value.h	2007-11-11 11:52:15.000000000 +0100
@@ -206,6 +206,8 @@ extern enum lval_type *deprecated_value_
    structure.  */
 extern CORE_ADDR *deprecated_value_address_hack (struct value *);
 #define VALUE_ADDRESS(val) (*deprecated_value_address_hack (val))
+/* Like VALUE_ADDRESS but respect also the MAIN_TYPE->DATA_LOCATION field.  */
+extern CORE_ADDR value_address_get (struct value *val);
 
 /* Pointer to internal variable.  */
 extern struct internalvar **deprecated_value_internalvar_hack (struct value *);
@@ -456,6 +458,10 @@ extern int record_latest_value (struct v
 extern void modify_field (gdb_byte *addr, LONGEST fieldval, int bitpos,
 			  int bitsize);
 
+extern void type_print_with_address (struct type *type, CORE_ADDR address,
+				     char *varstring, struct ui_file *stream,
+				     int show);
+
 extern void type_print (struct type *type, char *varstring,
 			struct ui_file *stream, int show);
 

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]