ice-9/debugger/commands.scm

   1 ;;;; (ice-9 debugger commands) -- debugger commands
   2
   3 ;;; Copyright (C) 2002 Free Software Foundation, Inc.
   4 ;;;
   5 ;;; This program is free software; you can redistribute it and/or
   6 ;;; modify it under the terms of the GNU General Public License as
   7 ;;; published by the Free Software Foundation; either version 2, or
   8 ;;; (at your option) any later version.
   9 ;;;
  10 ;;; This program 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 ;;; General Public License for more details.
  14 ;;;
  15 ;;; You should have received a copy of the GNU General Public License
  16 ;;; along with this software; see the file COPYING.  If not, write to
  17 ;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  18 ;;; Boston, MA 02111-1307 USA
  19 ;;;
  20 ;;; As a special exception, the Free Software Foundation gives permission
  21 ;;; for additional uses of the text contained in its release of GUILE.
  22 ;;;
  23 ;;; The exception is that, if you link the GUILE library with other files
  24 ;;; to produce an executable, this does not by itself cause the
  25 ;;; resulting executable to be covered by the GNU General Public License.
  26 ;;; Your use of that executable is in no way restricted on account of
  27 ;;; linking the GUILE library code into it.
  28 ;;;
  29 ;;; This exception does not however invalidate any other reasons why
  30 ;;; the executable file might be covered by the GNU General Public License.
  31 ;;;
  32 ;;; This exception applies only to the code released by the
  33 ;;; Free Software Foundation under the name GUILE.  If you copy
  34 ;;; code from other Free Software Foundation releases into a copy of
  35 ;;; GUILE, as the General Public License permits, the exception does
  36 ;;; not apply to the code that you add in this way.  To avoid misleading
  37 ;;; anyone as to the status of such modified files, you must delete
  38 ;;; this exception notice from them.
  39 ;;;
  40 ;;; If you write modifications of your own for GUILE, it is your choice
  41 ;;; whether to permit this exception to apply to your modifications.
  42 ;;; If you do not wish that, delete this exception notice.
  43
  44 (define-module (ice-9 debugger commands)
  45   #:use-module (ice-9 debug)
  46   #:use-module (ice-9 debugger)
  47   #:use-module (ice-9 debugger behaviour)
  48   #:use-module (ice-9 debugger state)
  49   #:use-module (ice-9 debugger utils)
  50   #:export (backtrace
  51             evaluate
  52             info-args
  53             info-frame
  54             position
  55             up
  56             down
  57             frame
  58             continue
  59             finish
  60             trace-finish
  61             next
  62             step))
  63
  64 (define (backtrace state n-frames)
  65   "Print backtrace of all stack frames, or innermost COUNT frames.
  66 With a negative argument, print outermost -COUNT frames.
  67 If the number of frames isn't explicitly given, the debug option
  68 `depth' determines the maximum number of frames printed."
  69   (let ((stack (state-stack state)))
  70     ;; Kludge around lack of call-with-values.
  71     (let ((values
  72            (lambda (start end)
  73              (display-backtrace stack
  74                                 (current-output-port)
  75                                 (if (memq 'backwards (debug-options))
  76                                     start
  77                                     (- end 1))
  78                                 (- end start))
  79              )))
  80       (let ((end (stack-length stack)))
  81         (cond ((not n-frames) ;(>= (abs n-frames) end))
  82                (values 0 (min end (cadr (memq 'depth (debug-options))))))
  83               ((>= n-frames 0)
  84                (values 0 n-frames))
  85               (else
  86                (values (+ end n-frames) end)))))))
  87
  88 (define (eval-handler key . args)
  89   (let ((stack (make-stack #t eval-handler)))
  90     (if (= (length args) 4)
  91         (apply display-error stack (current-error-port) args)
  92         ;; We want display-error to be the "final common pathway"
  93         (catch #t
  94                (lambda ()
  95                  (apply bad-throw key args))
  96                (lambda (key . args)
  97                  (apply display-error stack (current-error-port) args)))))
  98   (throw 'continue))
  99
 100 (define (evaluate state expression)
 101   "Evaluate an expression.
 102 The expression must appear on the same line as the command,
 103 however it may be continued over multiple lines."
 104   (let ((source (frame-source (stack-ref (state-stack state)
 105                                          (state-index state)))))
 106     (if (not source)
 107         (display "No environment for this frame.\n")
 108         (catch 'continue
 109                (lambda ()
 110                  (lazy-catch #t
 111                              (lambda ()
 112                                (let* ((env (memoized-environment source))
 113                                       (value (local-eval expression env)))
 114                                  (display ";value: ")
 115                                  (write value)
 116                                  (newline)))
 117                              eval-handler))
 118                (lambda args args)))))
 119
 120 (define (info-args state)
 121   "Argument variables of current stack frame."
 122   (let ((index (state-index state)))
 123     (let ((frame (stack-ref (state-stack state) index)))
 124       (write-frame-index-long frame)
 125       (write-frame-args-long frame))))
 126
 127 (define (info-frame state)
 128   "All about selected stack frame."
 129   (write-state-long state))
 130
 131 (define (position state)
 132   "Display the position of the current expression."
 133   (let* ((frame (stack-ref (state-stack state) (state-index state)))
 134          (source (frame-source frame)))
 135     (if (not source)
 136         (display "No source available for this frame.")
 137         (let ((position (source-position source)))
 138           (if (not position)
 139               (display "No position information available for this frame.")
 140               (display-position position)))))
 141   (newline))
 142
 143 (define (up state n)
 144   "Move @var{n} frames up the stack.  For positive @var{n}, this
 145 advances toward the outermost frame, to higher frame numbers, to
 146 frames that have existed longer.  @var{n} defaults to one."
 147   (set-stack-index! state (+ (state-index state) (or n 1)))
 148   (write-state-short state))
 149
 150 (define (down state n)
 151   "Move @var{n} frames down the stack.  For positive @var{n}, this
 152 advances toward the innermost frame, to lower frame numbers, to frames
 153 that were created more recently.  @var{n} defaults to one."
 154   (set-stack-index! state (- (state-index state) (or n 1)))
 155   (write-state-short state))
 156
 157 (define (frame state n)
 158   "Select and print a stack frame.
 159 With no argument, print the selected stack frame.  (See also \"info frame\").
 160 An argument specifies the frame to select; it must be a stack-frame number."
 161   (if n (set-stack-index! state (frame-number->index n (state-stack state))))
 162   (write-state-short state))
 163
 164 ;;;; Additional commands that make sense when debugging code that has
 165 ;;;; stopped at a breakpoint.
 166
 167 (define (assert-continuable state)
 168   ;; Check that debugger is in a state where `continuing' makes sense.
 169   ;; If not, signal an error.
 170   (or (memq #:continuable (state-flags state))
 171       (debugger-error "This debug session is not continuable.")))
 172
 173 (define (continue state)
 174   "Continue program execution."
 175   (assert-continuable state)
 176   (debugger-quit))
 177
 178 (define (finish state)
 179   "Continue until evaluation of the current frame is complete, and
 180 print the result obtained."
 181   (assert-continuable state)
 182   (with-reference-frame (stack-ref (state-stack state) (state-index state))
 183     (at-exit (lambda ()
 184                (trace-exit-value)
 185                (debug-here))))
 186   (continue state))
 187
 188 (define (next state n)
 189   "Continue until entry to @var{n}th next frame in same file."
 190   (assert-continuable state)
 191   (with-reference-frame (stack-ref (state-stack state) (state-index state))
 192     (at-next (or n 1) debug-here))
 193   (continue state))
 194
 195 (define (step state n)
 196   "Continue until entry to @var{n}th next frame."
 197   (assert-continuable state)
 198   (at-step (or n 1) debug-here)
 199   ;; An alternative behaviour that might be interesting ...
 200   ;; (with-reference-frame (stack-ref (state-stack state) (state-index state))
 201   ;;   (at-exit (lambda () (at-step (or n 1) debug-here))))
 202   (continue state))
 203
 204 (define (trace-finish state)
 205   "Trace until evaluation of the current frame is complete."
 206   (assert-continuable state)
 207   (with-reference-frame (stack-ref (state-stack state) (state-index state))
 208     (trace-until-exit)
 209     (at-exit debug-here))
 210   (continue state))
 211
 212 ;;; (ice-9 debugger commands) ends here.