[PATCH] Allow printing of Guile values

Ludovic Courtès
2007-07-20T14:35:59Z

[-- 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}