- (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 ~
- ~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)))))))))
+ (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)))))
+
+ (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))
+ ))))