ice-9/debugger.scm

   1 ;;;; Guile Debugger
   2
   3 ;;; Copyright (C) 1999, 2001, 2002 Free Software Foundation, Inc.
   4 ;;;
   5 ;; This library is free software; you can redistribute it and/or
   6 ;; modify it under the terms of the GNU Lesser General Public
   7 ;; License as published by the Free Software Foundation; either
   8 ;; version 2.1 of the License, or (at your option) any later version.
   9 ;;
  10 ;; This library is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;; Lesser General Public License for more details.
  14 ;;
  15 ;; You should have received a copy of the GNU Lesser General Public
  16 ;; License along with this library; if not, write to the Free Software
  17 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  18
  19 (define-module (ice-9 debugger)
  20   #:use-module (ice-9 debugger command-loop)
  21   #:use-module (ice-9 debugger state)
  22   #:use-module (ice-9 debugger utils)
  23   #:use-module (ice-9 format)
  24   #:export (debug-stack
  25             debug
  26             debug-last-error
  27             debugger-error
  28             debugger-quit
  29             debugger-input-port
  30             debugger-output-port)
  31   #:no-backtrace)
  32
  33 ;;; The old (ice-9 debugger) has been factored into its constituent
  34 ;;; parts:
  35 ;;;
  36 ;;; (ice-9 debugger) - public interface to all of the following
  37 ;;;
  38 ;;; (... commands) - procedures implementing the guts of the commands
  39 ;;;                  provided by the interactive debugger
  40 ;;;
  41 ;;; (... command-loop) - binding these commands into the interactive
  42 ;;;                      debugger command loop
  43 ;;;
  44 ;;; (... state) - implementation of an object that tracks current
  45 ;;;               debugger state
  46 ;;;
  47 ;;; (... utils) - utilities for printing out frame and stack
  48 ;;;               information in various formats
  49 ;;;
  50 ;;; The division between (... commands) and (... command-loop) exists
  51 ;;; because I (NJ) have another generic command loop implementation
  52 ;;; under development, and I want to be able to switch easily between
  53 ;;; that and the command loop implementation here.  Thus the
  54 ;;; procedures in this file delegate to a debugger command loop
  55 ;;; implementation via the `debugger-command-loop-*' interface.  The
  56 ;;; (ice-9 debugger command-loop) implementation can be replaced by
  57 ;;; any other that implements the `debugger-command-loop-*' interface
  58 ;;; simply by changing the relevant #:use-module line above.
  59 ;;;
  60 ;;; The following new parts add breakpoint support:
  61 ;;;
  62 ;;; (... behaviour) - codification of the things that can happen when
  63 ;;;                   a breakpoint is hit, regardless of the type of
  64 ;;;                   the breakpoint
  65 ;;;
  66 ;;; (... breakpoints) - management of breakpoints in general
  67 ;;;
  68 ;;; (... breakpoints procedural) - breakpoints that trigger upon
  69 ;;;                                application of a specified
  70 ;;;                                procedure
  71 ;;;
  72 ;;; (... breakpoints source) - breakpoints that trigger upon
  73 ;;;                            evaluation of a specific source
  74 ;;;                            expression
  75 ;;;
  76 ;;; (... trap-hooks) - a (slightly) higher-level abstraction of
  77 ;;;                    Guile's evaluator traps interface
  78 ;;;
  79 ;;; (... trc) - generic tracing interface for debugging tricky code
  80 ;;;             using the `printf' method :-)
  81 ;;;
  82 ;;; Note that (... breakpoints range) doesn't work yet.  If loaded, it
  83 ;;; seems to cause some kind of explosion in the GOOPS method cache
  84 ;;; calculation code.
  85 ;;;
  86 ;;; - Neil Jerram <neil@ossau.uklinux.net> 2002-10-26
  87
  88 (define *not-yet-introduced* #t)
  89
  90 (define (debug-stack stack . flags)
  91   "Invoke the Guile debugger to explore the specified @var{stack}.
  92
  93 @var{flags}, if present, are keywords indicating characteristics of
  94 the debugging session: the valid keywords are as follows.
  95
  96 @table @code
  97 @item #:continuable
  98 Indicates that the debugger is being invoked from a context (such as
  99 an evaluator trap handler) where it is possible to return from the
 100 debugger and continue normal code execution.  This enables the
 101 @dfn{continuing execution} commands, for example @code{continue} and
 102 @code{step}.
 103
 104 @item #:with-introduction
 105 Indicates that the debugger should display an introductory message.
 106 @end table"
 107   (start-stack 'debugger
 108     (let ((state (apply make-state stack 0 flags)))
 109       (with-input-from-port (debugger-input-port)
 110         (lambda ()
 111           (with-output-to-port (debugger-output-port)
 112             (lambda ()
 113               (if (or *not-yet-introduced*
 114                       (memq #:with-introduction flags))
 115                   (let ((ssize (stack-length stack)))
 116                     (display "This is the Guile debugger -- for help, type `help'.\n")
 117                     (set! *not-yet-introduced* #f)
 118                     (if (= ssize 1)
 119                         (display "There is 1 frame on the stack.\n\n")
 120                         (format #t "There are ~A frames on the stack.\n\n" ssize))))
 121               (write-state-short state)
 122               (debugger-command-loop state))))))))
 123
 124 (define (debug)
 125   "Invoke the Guile debugger to explore the context of the last error."
 126   (let ((stack (fluid-ref the-last-stack)))
 127     (if stack
 128         (debug-stack stack)
 129         (display "Nothing to debug.\n"))))
 130
 131 (define debug-last-error debug)
 132
 133 (define (debugger-error message)
 134   "Signal a debugger usage error with message @var{message}."
 135   (debugger-command-loop-error message))
 136
 137 (define (debugger-quit)
 138   "Exit the debugger."
 139   (debugger-command-loop-quit))
 140
 141 ;;; {Debugger Input and Output Ports}
 142
 143 (define debugger-input-port
 144   (let ((input-port (current-input-port)))
 145     (make-procedure-with-setter
 146      (lambda () input-port)
 147      (lambda (port) (set! input-port port)))))
 148
 149 (define debugger-output-port
 150   (let ((output-port (current-output-port)))
 151     (make-procedure-with-setter
 152      (lambda () output-port)
 153      (lambda (port) (set! output-port port)))))
 154
 155 ;;; (ice-9 debugger) ends here.