X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug.lisp;h=cf7f9dbc5d760a5f2eebdbf1d4f9ab19038dc4df;hb=f409f90c5e8c4c87ed9fa6efdc0e5c1952d94602;hp=bc64c3bf974afa9aa4bfa010164ed34a6c65c197;hpb=e365f2f7a9c66d307b48fee70778f4eaa84bdcc0;p=sbcl.git diff --git a/src/code/debug.lisp b/src/code/debug.lisp index bc64c3b..cf7f9db 100644 --- 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)) ;;;; 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*))) ;;;; 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)