mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-11 06:20:23 +02:00
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.
This commit is contained in:
Ludovic Courtès
parent
5f4b817df9
commit
359f46a41c
3 changed files with 237 additions and 9 deletions
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
164
libguile/libguile-2.0-gdb.scm
Normal file
164
libguile/libguile-2.0-gdb.scm
Normal file
|
|
@ -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
|
||||
Loading…
Add table
Add a link
Reference in a new issue