0.8.0.24:

[sbcl.git] / src / code / debug.lisp

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index bc64c3b..cf7f9db 100644 (file)
--- a/src/code/debug.lisp
+++ b/src/code/debug.lisp
@@ -447,9 +447,10 @@ Other commands:
 ;;; ANSI specifies that this macro shall exist, even if only as a
 ;;; trivial placeholder like this.
 (defmacro step (form)
-  "a trivial placeholder implementation of the CL:STEP macro required by
-   the ANSI spec"
-  `(progn
+  "This is a trivial placeholder implementation of the CL:STEP macro required
+   by the ANSI spec, simply expanding to `(LET () ,FORM). A more featureful
+   version would be welcome, we just haven't written it."
+  `(let ()
      ,form))
 \f
 ;;;; BACKTRACE
@@ -791,7 +792,8 @@ reset to ~S."
                 "~&(no restarts: If you didn't do this on purpose, ~
                   please report it as a bug.)~%"))
        (t
-        (format s "~&restarts:~%")
+        (format s "~&restarts (invokable by number or by ~
+                    possibly-abbreviated name):~%")
         (let ((count 0)
               (names-used '(nil))
               (max-name-len 0))
@@ -824,7 +826,7 @@ reset to ~S."
        (*read-suppress* nil))
     (unless (typep *debug-condition* 'step-condition)
       (clear-input *debug-io*))
-    (debug-loop)))
+    (funcall *debug-loop-fun*)))
 \f
 ;;;; DEBUG-LOOP
 
@@ -835,7 +837,7 @@ reset to ~S."
   "When set, avoid calling INVOKE-DEBUGGER recursively when errors occur while
    executing in the debugger.")
 
-(defun debug-loop ()
+(defun debug-loop-fun ()
   (let* ((*debug-command-level* (1+ *debug-command-level*))
         (*real-stack-top* (sb!di:top-frame))
         (*stack-top* (or *stack-top-hint* *real-stack-top*))
@@ -871,33 +873,20 @@ reset to ~S."
                                    level)
                (debug-prompt *debug-io*)
                (force-output *debug-io*)
-               (let ((input (sb!int:get-stream-command *debug-io*)))
-                 (cond (input
-                        (let ((cmd-fun (debug-command-p
-                                        (sb!int:stream-command-name input)
-                                        restart-commands)))
-                          (cond
-                           ((not cmd-fun)
-                            (error "unknown stream-command: ~S" input))
-                           ((consp cmd-fun)
-                            (error "ambiguous debugger command: ~S" cmd-fun))
-                           (t
-                            (apply cmd-fun
-                                   (sb!int:stream-command-args input))))))
+               (let* ((exp (read *debug-io*))
+                      (cmd-fun (debug-command-p exp restart-commands)))
+                 (cond ((not cmd-fun)
+                        (debug-eval-print exp))
+                       ((consp cmd-fun)
+                        (format t "~&Your command, ~S, is ambiguous:~%"
+                                exp)
+                        (dolist (ele cmd-fun)
+                          (format t "   ~A~%" ele)))
                        (t
-                        (let* ((exp (read *debug-io*))
-                               (cmd-fun (debug-command-p exp
-                                                         restart-commands)))
-                          (cond ((not cmd-fun)
-                                 (debug-eval-print exp))
-                                ((consp cmd-fun)
-                                 (format t
-                                         "~&Your command, ~S, is ambiguous:~%"
-                                         exp)
-                                 (dolist (ele cmd-fun)
-                                   (format t "   ~A~%" ele)))
-                                (t
-                                 (funcall cmd-fun)))))))))))))))
+                        (funcall cmd-fun))))))))))))
+
+(defvar *debug-loop-fun* #'debug-loop-fun
+  "a function taking no parameters that starts the low-level debug loop")
 
 ;;; FIXME: We could probably use INTERACTIVE-EVAL for much of this logic.
 (defun debug-eval-print (expr)