[PATCH] Allow printing of Guile values

[ludo@gnu.org (Ludovic Courtès)]

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

Hi,

The attached patch fixes printing of Guile objects.  It does so by
querying the inferior Guile process for a textual representation of the
values.

Actually, support routines (namely `gdb_print ()') have been in Guile
for a long time, but have never been used by GDB.  I tested it with
Guile 1.8, but it should also work with 1.6, and perhaps even with older
versions.

Example:

  Breakpoint 4, scm_sum (x=0xf2, y=0x6) at numbers.c:3953
  3953      if (SCM_UNBNDP (y))
  (gdb) set language scheme
  Warning: the current language does not match this frame.
  (gdb) frame
  #0  scm_sum (x=60, y=1) at numbers.c:3953
  3953      if (SCM_UNBNDP (y))

Same with non-immediate values:

  Breakpoint 3, deval (x=0xb7c38978, env=0xb7bc7370) at eval.i.c:215
  215   debug.prev = scm_i_last_debug_frame ();
  (gdb) set language scheme
  (gdb) frame
  #0  deval (
      x=(#<variable b7c3dbc0 value: #<primitive-procedure copy-tree>> (#<variable b7c3e5b0 value: #<procedure apply (fun . args)>> #@1+0 (#<variable b7c094c0 value: #<primitive-procedure cdr>> #@0+0))), env=(((exp env) (false-if-exception (stat str)) (((str) "/home/ludo/.guile"))) ((f) #<procedure #f (expr)>))) at eval.i.c:215
  215   debug.prev = scm_i_last_debug_frame ();


It's my first time hacking GDB, so please don't hesitate to correct me
if the patch looks bad.

I have not yet signed copyright assignment papers for GDB.  I will do it
if deemed necessary.

Thanks,
Ludovic.


gdb/ChangeLog

2007-07-20  Ludovic Courtès  <ludo@gnu.org>

	* scm-lang.c (is_scmvalue_type): Don't check for `TYPE_CODE' of
	TYPE since it may lead to wrong results.
	* scm-valprint.c (scm_inferior_print): Use facilities provided
	by the inferior Guile process, namely `gdb_print ()'.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: The patch --]
[-- Type: text/x-patch, Size: 3051 bytes --]

--- scm-lang.c.orig	2007-07-20 10:04:20.000000000 +0200
+++ scm-lang.c	2007-07-20 16:12:47.000000000 +0200
@@ -1,6 +1,6 @@
 /* Scheme/Guile language support routines for GDB, the GNU debugger.
 
-   Copyright (C) 1995, 1996, 1998, 2000, 2001, 2002, 2003, 2004, 2005 Free
+   Copyright (C) 1995, 1996, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2007 Free
    Software Foundation, Inc.
 
    This file is part of GDB.
@@ -59,8 +59,7 @@
 int
 is_scmvalue_type (struct type *type)
 {
-  if (TYPE_CODE (type) == TYPE_CODE_INT
-      && TYPE_NAME (type) && strcmp (TYPE_NAME (type), "SCM") == 0)
+  if (TYPE_NAME (type) && strcmp (TYPE_NAME (type), "SCM") == 0)
     {
       return 1;
     }

--- scm-valprint.c.orig	2007-07-20 16:07:11.000000000 +0200
+++ scm-valprint.c	2007-07-20 16:08:13.000000000 +0200
@@ -1,6 +1,6 @@
 /* Scheme/Guile language support routines for GDB, the GNU debugger.
 
-   Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2005 Free Software
+   Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2005, 2007 Free Software
    Foundation, Inc.
 
    This file is part of GDB.
@@ -31,6 +31,7 @@
 #include "valprint.h"
 #include "gdbcore.h"
 #include "c-lang.h"
+#include "infcall.h"
 
 static void scm_ipruk (char *, LONGEST, struct ui_file *);
 static void scm_scmlist_print (LONGEST, struct ui_file *, int, int,
@@ -39,14 +40,53 @@
 			       int, enum val_prettyprint);
 
 /* Prints the SCM value VALUE by invoking the inferior, if appropraite.
-   Returns >= 0 on succes;  retunr -1 if the inferior cannot/should not
+   Returns >= 0 on success;  return -1 if the inferior cannot/should not
    print VALUE. */
 
 static int
 scm_inferior_print (LONGEST value, struct ui_file *stream, int format,
 		    int deref_ref, int recurse, enum val_prettyprint pretty)
 {
-  return -1;
+  struct value *func, *arg, *result;
+  struct symbol *gdb_output_sym, *gdb_output_len_sym;
+  char *output;
+  int ret, output_len;
+
+  func = find_function_in_inferior ("gdb_print");
+  arg = value_from_longest (builtin_type_CORE_ADDR, value);
+
+  result = call_function_by_hand (func, 1, &arg);
+  ret = (int) value_as_long (result);
+  if (ret == 0)
+    {
+      /* XXX: Should we cache these symbols?  */
+      gdb_output_sym =
+	lookup_symbol_global ("gdb_output", NULL, VAR_DOMAIN,
+			      (struct symtab **) NULL);
+      gdb_output_len_sym =
+	lookup_symbol_global ("gdb_output_length", NULL, VAR_DOMAIN,
+			      (struct symtab **) NULL);
+
+      if ((gdb_output_sym == NULL) || (gdb_output_len_sym == NULL))
+	ret = -1;
+      else
+	{
+	  struct value *remote_buffer;
+
+	  read_memory (SYMBOL_VALUE_ADDRESS (gdb_output_len_sym),
+		       (char *) &output_len, sizeof (output_len));
+
+	  output = (char *) alloca (output_len);
+	  remote_buffer = value_at (builtin_type_CORE_ADDR,
+				    SYMBOL_VALUE_ADDRESS (gdb_output_sym));
+	  read_memory (value_as_address (remote_buffer),
+		       output, output_len);
+
+	  ui_file_write (stream, output, output_len);
+	}
+    }
+
+  return ret;
 }
 
 /* {Names of immediate symbols}