X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fdebug.lisp;h=faa5279f6a593644e47cb8a58d5425bfc0becd17;hb=1fdd787fcdac403f92d121701aee8738f710f048;hp=66be011b888eb08088333c63bc1a5cb39929c97a;hpb=50462f68bf70faf0bd96de7517643afb740543e6;p=sbcl.git

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index 66be011..faa5279 100644
--- a/src/code/debug.lisp
+++ b/src/code/debug.lisp
@@ -125,7 +125,12 @@ Function and macro commands:
  (SB-DEBUG:ARG n)
     Return the n'th argument in the current frame.
  (SB-DEBUG:VAR string-or-symbol [id])
-    Returns the value of the specified variable in the current frame.")
+    Returns the value of the specified variable in the current frame.
+
+Other commands:
+  SLURP   Discard all pending input on *STANDARD-INPUT*. (This can be
+          useful when the debugger was invoked to handle an error in
+          deeply nested input syntax, and now the reader is confused.)")
 
 ;;; This is used to communicate to DEBUG-LOOP that we are at a step breakpoint.
 (define-condition step-condition (simple-condition) ())
@@ -699,15 +704,14 @@ reset to ~S."
        ;; older debugger code which was written to do i/o on whatever
        ;; stream was in fashion at the time, and not all of it has
        ;; been converted to behave this way. -- WHN 2000-11-16)
-       (let (;; FIXME: The first two bindings here seem wrong,
+       (let (;; FIXME: Rebinding *STANDARD-OUTPUT* here seems wrong,
 	     ;; violating the principle of least surprise, and making
 	     ;; it impossible for the user to do reasonable things
 	     ;; like using PRINT at the debugger prompt to send output
 	     ;; to the program's ordinary (possibly
-	     ;; redirected-to-a-file) *STANDARD-OUTPUT*, or using
-	     ;; PEEK-CHAR or some such thing on the program's ordinary
-	     ;; (possibly also redirected) *STANDARD-INPUT*.
-	     (*standard-input* *debug-io*)
+	     ;; redirected-to-a-file) *STANDARD-OUTPUT*. (CMU CL
+	     ;; used to rebind *STANDARD-INPUT* here too, but that's
+	     ;; been fixed already.)
 	     (*standard-output* *debug-io*)
 	     ;; This seems reasonable: e.g. if the user has redirected
 	     ;; *ERROR-OUTPUT* to some log file, it's probably wrong
@@ -829,7 +833,7 @@ reset to ~S."
 			     (apply cmd-fun
 				    (sb!int:stream-command-args input))))))
 			(t
-			 (let* ((exp (read))
+			 (let* ((exp (read *debug-io*))
 				(cmd-fun (debug-command-p exp
 							  restart-commands)))
 			   (cond ((not cmd-fun)
@@ -1206,7 +1210,7 @@ argument")
       (show-restarts *debug-restarts* *debug-io*)
       (write-string "restart: ")
       (force-output)
-      (setf num (read *standard-input*)))
+      (setf num (read *debug-io*)))
     (let ((restart (typecase num
 		     (unsigned-byte
 		      (nth num *debug-restarts*))
@@ -1621,17 +1625,19 @@ argument")
     (if function
 	(describe function)
 	(format t "can't figure out the function for this frame"))))
+
+(!def-debug-command "SLURP" ()
+  (loop while (read-char-no-hang *standard-input*)))
 
 ;;;; debug loop command utilities
 
-(defun read-prompting-maybe (prompt &optional (in *standard-input*)
-				    (out *standard-output*))
-  (unless (sb!int:listen-skip-whitespace in)
-    (princ prompt out)
-    (force-output out))
-  (read in))
+(defun read-prompting-maybe (prompt)
+  (unless (sb!int:listen-skip-whitespace *debug-io*)
+    (princ prompt)
+    (force-output))
+  (read *debug-io*))
 
-(defun read-if-available (default &optional (stream *standard-input*))
-  (if (sb!int:listen-skip-whitespace stream)
-      (read stream)
+(defun read-if-available (default)
+  (if (sb!int:listen-skip-whitespace *debug-io*)
+      (read *debug-io*)
       default))