[06/11] Fortran dynamic arrays support: DW_FORM_block* execution

[Jan Kratochvil <jan dot kratochvil at redhat dot com>]

Hi,

currently the DWARF support never executed the DW_FORM_block* data.  It could
be possibly moved into `dwarf2block.c'.


Regards,
Jan

2007-11-16  Jan Kratochvil  <jan.kratochvil@redhat.com>

	* dwarf2expr.h (struct dwarf_block): New stub.
	(dwarf_block_exec): New prototype.
	* dwarf2read.c: Include "gdbcore.h" and "exceptions.h".
	(struct dwarf_block_baton, dwarf_block_read_mem, dwarf_block_read_reg)
	(dwarf_block_get_frame_base, dwarf_block_get_tls_address)
	(dwarf_block_exec_core, struct dwarf_block_exec_hook)
	(dwarf_block_exec_hook, dwarf_block_exec): New.
	* Makefile.in: Update dependencies.

Index: sources/gdb/dwarf2expr.h
===================================================================
--- sources.orig/gdb/dwarf2expr.h	2007-11-16 00:34:38.000000000 +0100
+++ sources/gdb/dwarf2expr.h	2007-11-16 00:34:59.000000000 +0100
@@ -122,6 +122,10 @@ struct dwarf_expr_piece
   ULONGEST size;
 };
 
+struct dwarf_block;
+extern CORE_ADDR dwarf_block_exec (struct dwarf_block *dwarf_block,
+				   CORE_ADDR address);
+
 struct dwarf_expr_context *new_dwarf_expr_context (void);
 void free_dwarf_expr_context (struct dwarf_expr_context *ctx);
 
Index: sources/gdb/dwarf2read.c
===================================================================
--- sources.orig/gdb/dwarf2read.c	2007-11-16 00:34:55.000000000 +0100
+++ sources/gdb/dwarf2read.c	2007-11-16 00:34:59.000000000 +0100
@@ -45,6 +45,8 @@
 #include "hashtab.h"
 #include "command.h"
 #include "gdbcmd.h"
+#include "gdbcore.h"
+#include "exceptions.h"
 
 #include <fcntl.h>
 #include "gdb_string.h"
@@ -4914,6 +4916,109 @@ 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_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 is missing here so far.  */
+  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
Index: sources/gdb/Makefile.in
===================================================================
--- sources.orig/gdb/Makefile.in	2007-11-16 00:33:01.000000000 +0100
+++ sources/gdb/Makefile.in	2007-11-16 00:36:04.000000000 +0100
@@ -2005,7 +2005,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) $(gdbcore_h) $(exceptions_h)
 elfread.o: elfread.c $(defs_h) $(bfd_h) $(gdb_string_h) $(elf_bfd_h) \
 	$(elf_mips_h) $(symtab_h) $(symfile_h) $(objfiles_h) $(buildsym_h) \
 	$(stabsread_h) $(gdb_stabs_h) $(complaints_h) $(demangle_h) \