1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
;;;; debug.jl -- Lisp debugger (well, single-stepper anyway)
;;; Copyright (C) 1993, 1994 John Harper <john@dcs.warwick.ac.uk>
;;; $Id: debug.jl,v 1.14 1999/12/10 22:38:25 john Exp $
;;; This file is part of Jade.
;;; Jade is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;; Jade is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;; You should have received a copy of the GNU General Public License
;;; along with Jade; see the file COPYING. If not, write to
;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(require 'readline)
(provide 'debug)
;; Form stopped on
(defvar debug-obj nil)
(defvar debug-depth nil)
(defvar debug-last nil)
(defun debug-rep ()
(let
((print-escape t))
(format standard-error "<%d> %S\n" debug-depth debug-obj)
(while t
(let
((input (readline "rep-db? "))
next-last)
(cond ((string-match "^\\s*n" input)
(setq debug-last debug-next)
(debug-next))
((string-match "^\\s*s" input)
(setq debug-last debug-step)
(debug-step))
((string-match "^\\s*c" input)
(setq debug-last debug-continue)
(debug-continue))
((string-match "^\\s*r\\w*\\s+" input)
(debug-set-result
(eval (read-from-string (substring input (match-end))))))
((string-match "^\\s*p\\w*\\s+" input)
(format standard-error "%S\n"
(eval (read-from-string
(substring input (match-end))))))
((string-match "^\\s*b" input)
(debug-backtrace 0))
((string-match "^\\s*f" input)
(format standard-error "<%d> %S\n" debug-depth debug-obj))
((string-match "^\\s*$" input)
(if debug-last
(progn
(debug-last)
(setq next-last debug-last))
(write standard-error "Nothing to repeat\n")))
(t
(write standard-error "\
commands: `n[ext]', `s[tep]', `c[ontinue]', `r[eturn] FORM',
`p[rint] FORM', `b[acktrace]', `f[orm]'\n")))
(setq debug-last next-last)))))
;;;###autoload
(defun debug-entry (debug-obj debug-depth)
(catch 'debug
(debug-rep)))
(defun debug-exit (debug-val debug-depth)
(format standard-error "<%d> => %S\n" debug-depth debug-val))
;;;###autoload
(defun debug-error-entry (error-list)
(format standard-error "*** Error: %s: %S\n"
(or (get (car error-list) 'error-message)
(car error-list)) (cdr error-list))
(debug-backtrace 1)
(catch 'debug
(debug-rep)
nil))
(defun debug-step ()
(interactive)
(if (boundp 'debug-obj)
(throw 'debug (cons 1 debug-obj))
(beep)))
(defun debug-set-result (value)
(interactive "XEval:")
(if (boundp 'debug-obj)
(throw 'debug (cons 4 value))
(beep)))
(defun debug-next ()
(interactive)
(if (boundp 'debug-obj)
(throw 'debug (cons 2 debug-obj))
(beep)))
(defun debug-continue ()
(interactive)
(cond
((boundp 'debug-obj)
(throw 'debug (cons 3 debug-obj)))
((boundp 'error-list)
(throw 'debug))
(t
(beep))))
;; DEPTH is the number of stack frames to discard
(defun debug-backtrace (depth)
(backtrace standard-output)
(write standard-output ?\n))
|
