module/ice-9/debugger.scm

   1 ;;;; Guile Debugger
   2
   3 ;;; Copyright (C) 1999, 2001, 2002, 2006 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 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             debug-on-error)
  32   #:no-backtrace)
  33
  34 ;;; The old (ice-9 debugger) has been factored into its constituent
  35 ;;; parts:
  36 ;;;
  37 ;;; (ice-9 debugger) - public interface to all of the following
  38 ;;;
  39 ;;; (... commands) - procedures implementing the guts of the commands
  40 ;;;                  provided by the interactive debugger
  41 ;;;
  42 ;;; (... command-loop) - binding these commands into the interactive
  43 ;;;                      debugger command loop
  44 ;;;
  45 ;;; (... state) - implementation of an object that tracks current
  46 ;;;               debugger state
  47 ;;;
  48 ;;; (... utils) - utilities for printing out frame and stack
  49 ;;;               information in various formats
  50 ;;;
  51 ;;; The division between (... commands) and (... command-loop) exists
  52 ;;; because I (NJ) have another generic command loop implementation
  53 ;;; under development, and I want to be able to switch easily between
  54 ;;; that and the command loop implementation here.  Thus the
  55 ;;; procedures in this file delegate to a debugger command loop
  56 ;;; implementation via the `debugger-command-loop-*' interface.  The
  57 ;;; (ice-9 debugger command-loop) implementation can be replaced by
  58 ;;; any other that implements the `debugger-command-loop-*' interface
  59 ;;; simply by changing the relevant #:use-module line above.
  60 ;;;
  61 ;;; - Neil Jerram <neil@ossau.uklinux.net> 2002-10-26, updated 2005-07-09
  62
  63 (define *not-yet-introduced* #t)
  64
  65 (define (debug-stack stack . flags)
  66   "Invoke the Guile debugger to explore the specified @var{stack}.
  67
  68 @var{flags}, if present, are keywords indicating characteristics of
  69 the debugging session: the valid keywords are as follows.
  70
  71 @table @code
  72 @item #:continuable
  73 Indicates that the debugger is being invoked from a context (such as
  74 an evaluator trap handler) where it is possible to return from the
  75 debugger and continue normal code execution.  This enables the
  76 @dfn{continuing execution} commands, for example @code{continue} and
  77 @code{step}.
  78
  79 @item #:with-introduction
  80 Indicates that the debugger should display an introductory message.
  81 @end table"
  82   (start-stack 'debugger
  83     (let ((state (apply make-state stack 0 flags)))
  84       (with-input-from-port (debugger-input-port)
  85         (lambda ()
  86           (with-output-to-port (debugger-output-port)
  87             (lambda ()
  88               (if (or *not-yet-introduced*
  89                       (memq #:with-introduction flags))
  90                   (let ((ssize (stack-length stack)))
  91                     (display "This is the Guile debugger -- for help, type `help'.\n")
  92                     (set! *not-yet-introduced* #f)
  93                     (if (= ssize 1)
  94                         (display "There is 1 frame on the stack.\n\n")
  95                         (format #t "There are ~A frames on the stack.\n\n" ssize))))
  96               (write-state-short state)
  97               (debugger-command-loop state))))))))
  98
  99 (define (debug)
 100   "Invoke the Guile debugger to explore the context of the last error."
 101   (let ((stack (fluid-ref the-last-stack)))
 102     (if stack
 103         (debug-stack stack)
 104         (display "Nothing to debug.\n"))))
 105
 106 (define debug-last-error debug)
 107
 108 (define (debugger-error message)
 109   "Signal a debugger usage error with message @var{message}."
 110   (debugger-command-loop-error message))
 111
 112 (define (debugger-quit)
 113   "Exit the debugger."
 114   (debugger-command-loop-quit))
 115
 116 ;;; {Debugger Input and Output Ports}
 117
 118 (define debugger-input-port
 119   (let ((input-port (current-input-port)))
 120     (make-procedure-with-setter
 121      (lambda () input-port)
 122      (lambda (port) (set! input-port port)))))
 123
 124 (define debugger-output-port
 125   (let ((output-port (current-output-port)))
 126     (make-procedure-with-setter
 127      (lambda () output-port)
 128      (lambda (port) (set! output-port port)))))
 129
 130 ;;; {Debug on Error}
 131
 132 (define (debug-on-error syms)
 133   "Enable or disable debug on error."
 134   (set! pre-unwind-handler-dispatch
 135         (if syms
 136             (lambda (key . args)
 137               (if (memq key syms)
 138                   (begin
 139                     (debug-stack (make-stack #t pre-unwind-handler-dispatch)
 140                                  #:with-introduction
 141                                  #:continuable)
 142                     (throw 'abort key)))
 143               (apply default-pre-unwind-handler key args))
 144             default-pre-unwind-handler)))
 145
 146 ;;; (ice-9 debugger) ends here.