1 (in-package #:trivial-backtrace
)
3 (setf (documentation 'print-backtrace-to-stream
'function
)
4 "Send a backtrace of the current error to stream.
6 Stream is assumed to be an open writable file stream or a
7 string-output-stream. Note that `print-backtrace-to-stream`
8 will print a backtrace for whatever the Lisp deems to be the
12 (defun print-condition (condition stream
)
15 "~@<An unhandled error condition has been signalled:~3I ~a~I~:@>~%~%"
18 (defun print-backtrace (error &key
(output nil
) (if-exists :append
)
20 "Send a backtrace for the error `error` to `output`.
22 The keywords arguments are:
24 * :output - where to send the output. This can be:
26 * a string (which is assumed to designate a pathname)
28 * nil to indicate that the backtrace information should be
31 * if-exists - what to do if output designates a pathname and
32 the pathname already exists. Defaults to :append.
34 * verbose - if true, then a message about the backtrace is sent
35 to \\*terminal-io\\*. Defaults to `nil`.
37 If the `output` is nil, the returns the backtrace output as a
38 string. Otherwise, returns nil.
41 (print-condition error
*terminal-io
*))
42 (multiple-value-bind (stream close?
)
44 (null (values (make-string-output-stream) nil
))
45 (string (values (open output
:if-exists if-exists
46 :if-does-not-exist
:create
47 :direction
:output
) t
))
48 (stream (values output nil
)))
51 (print-condition error stream
)
52 (format stream
"~&Date/time: ~a" (date-time-string))
54 (print-backtrace-to-stream stream
)
56 (when (typep stream
'string-stream
)
57 (get-output-stream-string stream
)))
63 (defun print-backtrace-to-stream (stream)
64 (let ((*debug-io
* stream
))
65 (ccl:print-call-history
:detailed-p nil
)))
68 (defun print-backtrace-to-stream (stream)
69 (with-standard-io-syntax
70 (let ((*print-readably
* nil
)
71 (*print-miser-width
* 40)
73 (tpl:*zoom-print-circle
* t
)
74 (tpl:*zoom-print-level
* nil
)
75 (tpl:*zoom-print-length
* nil
))
77 (let ((*terminal-io
* stream
)
78 (*standard-output
* stream
))
79 (tpl:do-command
"zoom"
80 :from-read-eval-print-loop nil
85 (defun print-backtrace-to-stream (stream)
86 (let ((dbg::*debugger-stack
*
87 (dbg::grab-stack nil
:how-many most-positive-fixnum
))
89 (dbg:*debug-print-level
* nil
)
90 (dbg:*debug-print-length
* nil
))
91 (dbg:bug-backtrace nil
)))
94 ;; determine how we're going to access the backtrace in the next
96 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
97 (when (find-symbol "*DEBUG-PRINT-VARIABLE-ALIST*" :sb-debug
)
98 (pushnew :hunchentoot-sbcl-debug-print-variable-alist
*features
*)))
101 (defun print-backtrace-to-stream (stream)
102 (let (#+:hunchentoot-sbcl-debug-print-variable-alist
103 (sb-debug:*debug-print-variable-alist
*
104 (list* '(*print-level
* . nil
)
105 '(*print-length
* . nil
)
106 sb-debug
:*debug-print-variable-alist
*))
107 #-
:hunchentoot-sbcl-debug-print-variable-alist
108 (sb-debug:*debug-print-level
* nil
)
109 #-
:hunchentoot-sbcl-debug-print-variable-alist
110 (sb-debug:*debug-print-length
* nil
))
111 (sb-debug:backtrace most-positive-fixnum stream
)))
114 (defun print-backtrace-to-stream (stream)
115 (system::print-backtrace
:out stream
))
118 (defun print-backtrace-to-stream (stream)
119 (let ((debug:*debug-print-level
* nil
)
120 (debug:*debug-print-length
* nil
))
121 (debug:backtrace most-positive-fixnum stream
)))