summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-02-17 15:40:34 +0100
committerLudovic Courtès <ludo@gnu.org>2014-02-18 23:04:33 +0100
commit359f46a41cd703fcec187459eb11aacf1b05d76a (patch)
tree9cc68ed88288764bdb8e67f1d8d2dff4397dd691
parent5f4b817df92b30ae32f934f3c2cf83a5990e1895 (diff)
downloadguile-359f46a41cd703fcec187459eb11aacf1b05d76a.tar.gz
Add GDB extension to support Guile.
* libguile/libguile-2.0-gdb.scm: New file. * libguile/Makefile.am (install-data-local): New target. Based on code from GNU libstdc++. (EXTRA_DIST): Add 'libguile-2.0-gdb.scm'. * doc/ref/api-debug.texi (GDB Support): New section.
-rw-r--r--doc/ref/api-debug.texi42
-rw-r--r--libguile/Makefile.am40
-rw-r--r--libguile/libguile-2.0-gdb.scm164
3 files changed, 237 insertions, 9 deletions
diff --git a/doc/ref/api-debug.texi b/doc/ref/api-debug.texi
index f6c706c78..619629b56 100644
--- a/doc/ref/api-debug.texi
+++ b/doc/ref/api-debug.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
-@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2010, 2011, 2012, 2013
+@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2010, 2011, 2012, 2013, 2014
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@@ -17,8 +17,9 @@ infrastructure that builds on top of those calls.
@menu
* Evaluation Model:: Evaluation and the Scheme stack.
* Source Properties:: From expressions to source locations.
-* Programmatic Error Handling:: Debugging when an error occurs.
+* Programmatic Error Handling:: Debugging when an error occurs.
* Traps:: Breakpoints, tracepoints, oh my!
+* GDB Support:: C-level debugging with GDB.
@end menu
@node Evaluation Model
@@ -1351,6 +1352,43 @@ This is a stepping trap, used to implement the ``step'', ``next'',
``step-instruction'', and ``next-instruction'' REPL commands.
@end deffn
+@node GDB Support
+@subsection GDB Support
+
+@cindex GDB support
+
+Sometimes, you may find it necessary to debug Guile applications at the
+C level. Doing so can be tedious, in particular because the debugger is
+oblivious to Guile's @code{SCM} type, and thus unable to display
+@code{SCM} values in any meaningful way:
+
+@example
+(gdb) frame
+#0 scm_display (obj=0xf04310, port=0x6f9f30) at print.c:1437
+@end example
+
+To address that, Guile comes with an extension of the GNU Debugger (GDB)
+that contains a ``pretty-printer'' for @code{SCM} values. With this GDB
+extension, the C frame in the example above shows up like this:
+
+@example
+(gdb) frame
+#0 scm_display (obj=("hello" GDB!), port=#<port file 6f9f30>) at print.c:1437
+@end example
+
+@noindent
+Here GDB was able to decode the list pointed to by @var{obj}, and to
+print it using Scheme's read syntax.
+
+That extension is a @code{.scm} file installed alongside the
+@file{libguile} shared library. When GDB 7.8 or later is installed and
+compiled with support for extensions written in Guile, the extension is
+automatically loaded when debugging a program linked against
+@file{libguile} (@pxref{Auto-loading,,, gdb, Debugging with GDB}). Note
+that the directory where @file{libguile} is installed must be among
+GDB's auto-loading ``safe directories'' (@pxref{Auto-loading safe
+path,,, gdb, Debugging with GDB}).
+
@c Local Variables:
@c TeX-master: "guile.texi"
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index dcbdba12a..c7ceb16c1 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -1,7 +1,7 @@
## Process this file with Automake to create Makefile.in
##
## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007,
-## 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+## 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
@@ -448,6 +448,31 @@ EXTRA_libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = _scm.h \
install-exec-hook:
rm -f $(DESTDIR)$(bindir)/guile-snarf.awk
+install-data-local: libguile-2.0-gdb.scm
+ @$(MKDIR_P) $(DESTDIR)$(libdir)
+## We want to install libguile-2.0-gdb.scm as SOMETHING-gdb.scm.
+## SOMETHING is the full name of the final library. We want to ignore
+## symlinks, the .la file, and any previous -gdb.py file. This is
+## inherently fragile, but there does not seem to be a better option,
+## because libtool hides the real names from us. (Trick courtesy of
+## GNU libstdc++.)
+ @here=`pwd`; cd $(DESTDIR)$(libdir); \
+ for file in libguile-@GUILE_EFFECTIVE_VERSION@*; do \
+ case $$file in \
+ *-gdb.scm) ;; \
+ *.la) ;; \
+ *) if test -h $$file; then \
+ continue; \
+ fi; \
+ libname=$$file;; \
+ esac; \
+ done; \
+ cd $$here; \
+ echo " $(INSTALL_DATA) libguile-2.0-gdb.scm \
+$(DESTDIR)$(libdir)/$$libname-gdb.scm"; \
+ $(INSTALL_DATA) libguile-2.0-gdb.scm \
+ $(DESTDIR)$(libdir)/$$libname-gdb.scm
+
## This is kind of nasty... there are ".c" files that we don't want to
## compile, since they are #included. So instead we list them here.
## Perhaps we can deal with them normally once the merge seems to be
@@ -635,12 +660,13 @@ bin_SCRIPTS = guile-snarf
# and people feel like maintaining them. For now, this is not the case.
noinst_SCRIPTS = guile-snarf-docs
-EXTRA_DIST = ChangeLog-scm ChangeLog-threads \
- ChangeLog-1996-1999 ChangeLog-2000 ChangeLog-2008 \
- guile-func-name-check \
- cpp-E.syms cpp-E.c cpp-SIG.syms cpp-SIG.c \
- c-tokenize.lex \
- scmconfig.h.top libgettext.h unidata_to_charset.pl libguile.map
+EXTRA_DIST = ChangeLog-scm ChangeLog-threads \
+ ChangeLog-1996-1999 ChangeLog-2000 ChangeLog-2008 \
+ guile-func-name-check \
+ cpp-E.syms cpp-E.c cpp-SIG.syms cpp-SIG.c \
+ c-tokenize.lex \
+ scmconfig.h.top libgettext.h unidata_to_charset.pl libguile.map \
+ libguile-2.0-gdb.scm
# $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES) \
# guile-procedures.txt guile.texi
diff --git a/libguile/libguile-2.0-gdb.scm b/libguile/libguile-2.0-gdb.scm
new file mode 100644
index 000000000..fdd5cd81b
--- /dev/null
+++ b/libguile/libguile-2.0-gdb.scm
@@ -0,0 +1,164 @@
+;;; GDB debugging support for Guile.
+;;;
+;;; Copyright 2014 Free Software Foundation, Inc.
+;;;
+;;; This program is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guile-gdb)
+ #:use-module (system base types)
+ #:use-module ((gdb) #:hide (symbol?))
+ #:use-module (gdb printing)
+ #:use-module (srfi srfi-11)
+ #:export (%gdb-memory-backend
+ display-vm-frames))
+
+;;; Commentary:
+;;;
+;;; This file defines GDB extensions to pretty-print 'SCM' objects, and
+;;; to walk Guile's virtual machine stack.
+;;;
+;;; This file is installed under a name that follows the convention that
+;;; allows GDB to auto-load it anytime the user is debugging libguile
+;;; (info "(gdb) objfile-gdbdotext file").
+;;;
+;;; Code:
+
+(define (type-name-from-descriptor descriptor-array type-number)
+ "Return the name of the type TYPE-NUMBER as seen in DESCRIPTOR-ARRAY, or #f
+if the information is not available."
+ (let ((descriptors (lookup-global-symbol descriptor-array)))
+ (and descriptors
+ (let ((code (type-code (symbol-type descriptors))))
+ (or (= TYPE_CODE_ARRAY code)
+ (= TYPE_CODE_PTR code)))
+ (let* ((type-descr (value-subscript (symbol-value descriptors)
+ type-number))
+ (name (value-field type-descr "name")))
+ (value->string name)))))
+
+(define %gdb-memory-backend
+ ;; The GDB back-end to access the inferior's memory.
+ (let ((void* (type-pointer (lookup-type "void"))))
+ (define (dereference-word address)
+ ;; Return the word at ADDRESS.
+ (value->integer
+ (value-dereference (value-cast (make-value address)
+ (type-pointer void*)))))
+
+ (define (open address size)
+ ;; Return a port to the SIZE bytes starting at ADDRESS.
+ (if size
+ (open-memory #:start address #:size size)
+ (open-memory #:start address)))
+
+ (define (type-name kind number)
+ ;; Return the type name of KIND type NUMBER.
+ (type-name-from-descriptor (case kind
+ ((smob) "scm_smobs")
+ ((port) "scm_ptobs"))
+ number))
+
+ (memory-backend dereference-word open type-name)))
+
+
+;;;
+;;; GDB pretty-printer registration.
+;;;
+
+(define scm-value->string
+ (lambda* (value #:optional (backend %gdb-memory-backend))
+ "Return a representation of value VALUE as a string."
+ (object->string (scm->object (value->integer value) backend))))
+
+(define %scm-pretty-printer
+ (make-pretty-printer "SCM"
+ (lambda (pp value)
+ (let ((name (type-name (value-type value))))
+ (and (and name (string=? name "SCM"))
+ (make-pretty-printer-worker
+ #f ; display hint
+ (lambda (printer)
+ (scm-value->string value %gdb-memory-backend))
+ #f))))))
+
+(define* (register-pretty-printer #:optional objfile)
+ (prepend-pretty-printer! objfile %scm-pretty-printer))
+
+(register-pretty-printer)
+
+
+;;;
+;;; VM stack walking.
+;;;
+
+(define (find-vm-engine-frame)
+ "Return the bottom-most frame containing a call to the VM engine."
+ (define (vm-engine-frame? frame)
+ (let ((sym (frame-function frame)))
+ (and sym
+ (member (symbol-name sym)
+ '("vm_debug_engine" "vm_regular_engine")))))
+
+ (let loop ((frame (newest-frame)))
+ (and frame
+ (if (vm-engine-frame? frame)
+ frame
+ (loop (frame-older frame))))))
+
+(define (vm-stack-pointer)
+ "Return the current value of the VM stack pointer or #f."
+ (let ((frame (find-vm-engine-frame)))
+ (and frame
+ (frame-read-var frame "sp"))))
+
+(define (vm-frame-pointer)
+ "Return the current value of the VM frame pointer or #f."
+ (let ((frame (find-vm-engine-frame)))
+ (and frame
+ (frame-read-var frame "fp"))))
+
+(define* (display-vm-frames #:optional (port (current-output-port)))
+ "Display the VM frames on PORT."
+ (define (display-objects start end)
+ ;; Display all the objects (arguments and local variables) located
+ ;; between START and END.
+ (let loop ((number 0)
+ (address start))
+ (when (and (> start 0) (<= address end))
+ (let ((object (dereference-word %gdb-memory-backend address)))
+ ;; TODO: Push onto GDB's value history.
+ (format port " slot ~a -> ~s~%"
+ number (scm->object object %gdb-memory-backend)))
+ (loop (+ 1 number) (+ address %word-size)))))
+
+ (let loop ((number 0)
+ (sp (value->integer (vm-stack-pointer)))
+ (fp (value->integer (vm-frame-pointer))))
+ (unless (zero? fp)
+ (let-values (((ra mvra link proc)
+ (vm-frame fp %gdb-memory-backend)))
+ (format port "#~a ~s~%" number (scm->object proc %gdb-memory-backend))
+ (display-objects fp sp)
+ (loop (+ 1 number) (- fp (* 5 %word-size)) link)))))
+
+;; See libguile/frames.h.
+(define* (vm-frame fp #:optional (backend %gdb-memory-backend))
+ "Return the components of the stack frame at FP."
+ (let ((caller (dereference-word backend (- fp %word-size)))
+ (ra (dereference-word backend (- fp (* 2 %word-size))))
+ (mvra (dereference-word backend (- fp (* 3 %word-size))))
+ (link (dereference-word backend (- fp (* 4 %word-size)))))
+ (values ra mvra link caller)))
+
+;;; libguile-2.0-gdb.scm ends here