Commit | Line | Data |
---|---|---|
e80e1c98 MD |
1 | ;;;; Guile Debugger |
2 | ||
8ee7506b | 3 | ;;; Copyright (C) 1999, 2001, 2002 Free Software Foundation, Inc. |
e80e1c98 | 4 | ;;; |
73be1d9e MV |
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 | |
e80e1c98 | 18 | |
8be85ef1 | 19 | (define-module (ice-9 debugger) |
8ee7506b NJ |
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)))))))) | |
8be85ef1 | 123 | |
1a179b03 | 124 | (define (debug) |
8ee7506b | 125 | "Invoke the Guile debugger to explore the context of the last error." |
e80e1c98 MD |
126 | (let ((stack (fluid-ref the-last-stack))) |
127 | (if stack | |
8ee7506b | 128 | (debug-stack stack) |
e80e1c98 MD |
129 | (display "Nothing to debug.\n")))) |
130 | ||
8ee7506b | 131 | (define debug-last-error debug) |
e80e1c98 | 132 | |
8ee7506b NJ |
133 | (define (debugger-error message) |
134 | "Signal a debugger usage error with message @var{message}." | |
135 | (debugger-command-loop-error message)) | |
e80e1c98 | 136 | |
8ee7506b | 137 | (define (debugger-quit) |
e80e1c98 | 138 | "Exit the debugger." |
8ee7506b | 139 | (debugger-command-loop-quit)) |
8b8fd2e3 | 140 | |
8ee7506b | 141 | ;;; {Debugger Input and Output Ports} |
0ea63246 | 142 | |
8ee7506b NJ |
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))))) | |
e80e1c98 | 148 | |
8ee7506b NJ |
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))))) | |
e80e1c98 | 154 | |
8ee7506b | 155 | ;;; (ice-9 debugger) ends here. |