Skip to content
Newer
Older
100644 69 lines (58 sloc) 2.45 KB
a947e04 Added my untracked files. BTW, switched to ASDF format for the package.
Zach Smith authored May 5, 2008
1
2 (in-package :cl-user)
3
4 (defun backtrace-with-extra-info (&key (start 1) (end 20))
5 (swank-backend::call-with-debugging-environment
6 (lambda ()
7 (loop for i from start to (length (swank-backend::compute-backtrace
8 start end ))
9 do (ignore-errors (print-frame i)) ))))
10
11 (defun print-frame (i)
12 (destructuring-bind (&key file position &allow-other-keys)
13 (apply #'append
14 (remove-if #'atom
15 (swank-backend:frame-source-location-for-emacs i) ))
16 (let* ((frame (swank-backend::nth-frame i))
17 (line-number (find-line-position file position frame)) )
18 (format t "~2@a: ~s~%~
19 ~:[~*~;~:[~2:* At ~a (unknown line)~*~%~;~
20 ~2:* At ~a:~a~%~]~]~
21 ~:[~*~; Local variables:~%~{ ~a = ~s~%~}~]"
22 i
23 (sb-debug::frame-call (swank-backend::nth-frame i))
24 file line-number
25 (swank-backend::frame-locals i)
26 (mapcan (lambda (x)
27 ;; Filter out local variables whose variables we
28 ;; don't know
29 (unless (eql (getf x :value) :<not-available>)
30 (list (getf x :name) (getf x :value)) ))
31 (swank-backend::frame-locals i) )))))
32
33 (defun find-line-position (file char-offset frame)
34 ;; It would be nice if SBCL stored line number information i
35 ;; addition to form path information by default. Since it doesn't
36 ;; we need to use Swank to map the source path to a character
37 ;; offset, and then map the character offset to a line number.
38 (ignore-errors
39 (let* ((location (sb-di::frame-code-location frame))
40 (debug-source (sb-di::code-location-debug-source location))
41 (line (with-open-file (stream file)
42 (1+ (loop repeat char-offset
43 count (eql (read-char stream) #\Newline) )))))
44 (format nil "~:[~a (file modified)~;~a~]"
45 (= (file-write-date file)
46 (sb-di::debug-source-created debug-source) )
47 line ))))
48
49 #| Examples
50
51 (declaim (optimize debug))
52 (defun foo (x)
53 (let ((y (+ x 3)))
54 (backtrace)
55 (backtrace-with-extra-info)
56 (+ x y) ))
57 (defmethod bar ((n fixnum) (y (eql 1)))
58 (foo (+ y n)) )
59
60 (foo 4)
61
62 (declaim (optimize (speed 0) (debug 3)))
63 (defun total (x tot)
64 (total (cdr x) (+ tot (car x))) )
65
66 (total '(1 2 3 4) 0)
67
68 |#
Something went wrong with that request. Please try again.