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 ui-client)
  23   #:use-module (ice-9 debugger utils)
  24   #:use-module (ice-9 format)
  25   #:export (debug-stack
  26             debug
  27             debug-last-error
  28             debugger-error
  29             debugger-quit
  30             debugger-input-port
  31             debugger-output-port
  32             debug-on-error)
  33   #:no-backtrace)
  34
  35 ;;; The old (ice-9 debugger) has been factored into its constituent
  36 ;;; parts:
  37 ;;;
  38 ;;; (ice-9 debugger) - public interface to all of the following
  39 ;;;
  40 ;;; (... commands) - procedures implementing the guts of the commands
  41 ;;;                  provided by the interactive debugger
  42 ;;;
  43 ;;; (... command-loop) - binding these commands into the interactive
  44 ;;;                      debugger command loop
  45 ;;;
  46 ;;; (... state) - implementation of an object that tracks current
  47 ;;;               debugger state
  48 ;;;
  49 ;;; (... utils) - utilities for printing out frame and stack
  50 ;;;               information in various formats
  51 ;;;
  52 ;;; The division between (... commands) and (... command-loop) exists
  53 ;;; because I (NJ) have another generic command loop implementation
  54 ;;; under development, and I want to be able to switch easily between
  55 ;;; that and the command loop implementation here.  Thus the
  56 ;;; procedures in this file delegate to a debugger command loop
  57 ;;; implementation via the `debugger-command-loop-*' interface.  The
  58 ;;; (ice-9 debugger command-loop) implementation can be replaced by
  59 ;;; any other that implements the `debugger-command-loop-*' interface
  60 ;;; simply by changing the relevant #:use-module line above.
  61 ;;;
  62 ;;; The following new parts add breakpoint support:
  63 ;;;
  64 ;;; (... behaviour) - codification of the things that can happen when
  65 ;;;                   a breakpoint is hit, regardless of the type of
  66 ;;;                   the breakpoint
  67 ;;;
  68 ;;; (... breakpoints) - management of breakpoints in general
  69 ;;;
  70 ;;; (... breakpoints procedural) - breakpoints that trigger upon
  71 ;;;                                application of a specified
  72 ;;;                                procedure
  73 ;;;
  74 ;;; (... breakpoints source) - breakpoints that trigger upon
  75 ;;;                            evaluation of a specific source
  76 ;;;                            expression
  77 ;;;
  78 ;;; (... trap-hooks) - a (slightly) higher-level abstraction of
  79 ;;;                    Guile's evaluator traps interface
  80 ;;;
  81 ;;; (... trc) - generic tracing interface for debugging tricky code
  82 ;;;             using the `printf' method :-)
  83 ;;;
  84 ;;; Note that (... breakpoints range) doesn't work yet.  If loaded, it
  85 ;;; seems to cause some kind of explosion in the GOOPS method cache
  86 ;;; calculation code.
  87 ;;;
  88 ;;; - Neil Jerram <neil@ossau.uklinux.net> 2002-10-26
  89
  90 (define *not-yet-introduced* #t)
  91
  92 (define (debug-stack stack . flags)
  93   "Invoke the Guile debugger to explore the specified @var{stack}.
  94
  95 @var{flags}, if present, are keywords indicating characteristics of
  96 the debugging session: the valid keywords are as follows.
  97
  98 @table @code
  99 @item #:continuable
 100 Indicates that the debugger is being invoked from a context (such as
 101 an evaluator trap handler) where it is possible to return from the
 102 debugger and continue normal code execution.  This enables the
 103 @dfn{continuing execution} commands, for example @code{continue} and
 104 @code{step}.
 105
 106 @item #:with-introduction
 107 Indicates that the debugger should display an introductory message.
 108 @end table"
 109   (start-stack 'debugger
 110     (let ((state (apply make-state stack 0 flags)))
 111       (with-input-from-port (debugger-input-port)
 112         (lambda ()
 113           (with-output-to-port (debugger-output-port)
 114             (lambda ()
 115               (if (or *not-yet-introduced*
 116                       (memq #:with-introduction flags))
 117                   (let ((ssize (stack-length stack)))
 118                     (display "This is the Guile debugger -- for help, type `help'.\n")
 119                     (set! *not-yet-introduced* #f)
 120                     (if (= ssize 1)
 121                         (display "There is 1 frame on the stack.\n\n")
 122                         (format #t "There are ~A frames on the stack.\n\n" ssize))))
 123               (write-state-short state)
 124               (if (ui-connected?)
 125                   (ui-command-loop state)
 126                   (debugger-command-loop state)))))))))
 127
 128 (define (debug)
 129   "Invoke the Guile debugger to explore the context of the last error."
 130   (let ((stack (fluid-ref the-last-stack)))
 131     (if stack
 132         (debug-stack stack)
 133         (display "Nothing to debug.\n"))))
 134
 135 (define debug-last-error debug)
 136
 137 (define (debugger-error message)
 138   "Signal a debugger usage error with message @var{message}."
 139   (debugger-command-loop-error message))
 140
 141 (define (debugger-quit)
 142   "Exit the debugger."
 143   (debugger-command-loop-quit))
 144
 145 ;;; {Debugger Input and Output Ports}
 146
 147 (define debugger-input-port
 148   (let ((input-port (current-input-port)))
 149     (make-procedure-with-setter
 150      (lambda () input-port)
 151      (lambda (port) (set! input-port port)))))
 152
 153 (define debugger-output-port
 154   (let ((output-port (current-output-port)))
 155     (make-procedure-with-setter
 156      (lambda () output-port)
 157      (lambda (port) (set! output-port port)))))
 158
 159 ;;; {Debug on Error}
 160
 161 (define default-default-lazy-handler default-lazy-handler)
 162
 163 (define (debug-on-error syms)
 164   "Enable or disable debug on error."
 165   (set! default-lazy-handler
 166         (if syms
 167             (lambda (key . args)
 168               (or (memq key syms)
 169                   (debug-stack (make-stack #t lazy-handler-dispatch)
 170                                #:with-introduction
 171                                #:continuable))
 172               (apply default-default-lazy-handler key args))
 173             default-default-lazy-handler)))
 174
 175 ;;; (ice-9 debugger) ends here.