(throw 'debug-loop-catcher nil))))
(fresh-line)
;;(sb-debug::print-frame-call sb-debug::*current-frame* :verbosity 2)
- (loop
- (catch 'debug-loop-catcher
- (handler-bind ((error (lambda (condition)
- (when sb-debug::*flush-debug-errors*
- (clear-input *debug-io*)
- (princ condition)
- ;; FIXME: Doing input on *DEBUG-IO*
- ;; and output on T seems broken.
- (format t
- "~&error flushed (because ~
+ (loop ;; only valid to way to exit invoke-debugger is by a restart
+ (catch 'debug-loop-catcher
+ (handler-bind ((error (lambda (condition)
+ (when sb-debug::*flush-debug-errors*
+ (clear-input *debug-io*)
+ (princ condition)
+ ;; FIXME: Doing input on *DEBUG-IO*
+ ;; and output on T seems broken.
+ (format t
+ "~&error flushed (because ~
~S is set)"
- 'sb-debug::*flush-debug-errors*)
- (sb-int:/show0 "throwing DEBUG-LOOP-CATCHER")
- (throw 'debug-loop-catcher nil)))))
- ;; We have to bind LEVEL for the restart function created by
- ;; WITH-SIMPLE-RESTART.
- (let ((level sb-debug::*debug-command-level*)
- (restart-commands (sb-debug::make-restart-commands)))
- (with-simple-restart (abort
- "~@<Reduce debugger level (to debug level ~W).~@:>"
- level)
- (sb-impl::repl :continuable continuable)))))))))
+ 'sb-debug::*flush-debug-errors*)
+ (sb-int:/show0 "throwing DEBUG-LOOP-CATCHER")
+ (throw 'debug-loop-catcher nil)))))
+
+ (if (zerop *break-level*) ; restart added by SBCL
+ (repl :continuable continuable)
+ (let ((level *break-level*))
+ (with-simple-restart
+ (abort "~@<Reduce debugger level (to break level ~W).~@:>"
+ level)
+ (let ((sb-debug::*debug-restarts* (compute-restarts)))
+ (repl :continuable continuable)))))))
+ (throw 'repl-catcher (values :debug :exit))
+ ))))
(defun continuable-break-p ()
(when (boundp 'sb-debug::*debug-loop-fun*)
(setq sb-debug::*debug-loop-fun* #'debug-loop))
-#||
+(defun print-restarts ()
+ ;; (format *output* "~&Restart actions (select using :continue)~%")
+ (format *standard-output* "~&Restart actions (select using :continue)~%")
+ (let ((restarts (compute-restarts)))
+ (dotimes (i (length restarts))
+ (format *standard-output* "~&~2D: ~A~%" i (nth i restarts)))))
+
+
+#+ignore
(defun debugger (condition)
"Enter the debugger."
(let ((old-hook *debugger-hook*))
(when (boundp 'sb-debug::*invoke-debugger-fun*)
(setq sb-debug::*invoke-debugger-fun* #'debugger))
+#+ignore
(defun print-condition (condition)
(format *output* "~&Error: ~A~%" condition))
+#+ignore
(defun print-condition-type (condition)
(format *output* "~& [Condition type: ~A]~%" (type-of condition)))
-
-(defun print-restarts ()
- (format *output* "~&Restart actions (select using :continue)~%")
- (let ((restarts (compute-restarts)))
- (dotimes (i (length restarts))
- (format *output* "~&~2D: ~A~%" i (nth i restarts)))))
-
+
+#+ignore
(defun %debugger (condition)
(print-condition condition)
(print-condition-type condition)
(acldebug-loop))
+#+ignore
(defun acldebug-loop ()
(let ((continuable (continuable-break-p)))
(if continuable
(aclrepl :continuable t)
- (let ((level sb-impl::*break-level*))
- (with-simple-restart (abort
- "~@<Reduce debugger level (to debug level ~W).~@:>"
- level)
+ (let ((level *break-level*))
+ (with-simple-restart
+ (abort "~@<Reduce debugger level (to debug level ~W).~@:>" level)
(loop
- (sb-impl::repl)))))))
-
-||#
+ (repl)))))))