diff options
author | Ludovic Courtès <ludo@gnu.org> | 2014-02-17 15:40:34 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2014-02-18 23:04:33 +0100 |
commit | 359f46a41cd703fcec187459eb11aacf1b05d76a (patch) | |
tree | 9cc68ed88288764bdb8e67f1d8d2dff4397dd691 | |
parent | 5f4b817df92b30ae32f934f3c2cf83a5990e1895 (diff) | |
download | guile-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.texi | 42 | ||||
-rw-r--r-- | libguile/Makefile.am | 40 | ||||
-rw-r--r-- | libguile/libguile-2.0-gdb.scm | 164 |
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 |