From: William Harold Newman <william.newman@airmail.net>
Date: Thu, 30 May 2002 21:16:12 +0000 (+0000)
Subject: 0.7.4.9:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=f5d911f6484ab98d858ea445e36479cfdc51737b;p=sbcl.git

0.7.4.9:
	partial fix for FIXME: Stop rebinding *STANDARD-INPUT* on
		entry to debugger. (I'd like to do the same for
		*STANDARD-OUTPUT* too, but this part of the FIXME is
		fairly simple, and needed for SLURP, while that part
		is messier, and not needed immediately.)
	added SLURP debugger command
---

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index 66be011..8a7d166 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)
@@ -1158,8 +1162,7 @@ argument")
 
 (!def-debug-command-alias "B" "BOTTOM")
 
-(!def-debug-command "FRAME" (&optional
-			     (n (read-prompting-maybe "frame number: ")))
+(!def-debug-command "FRAME" (&optional (n (read-prompting-maybe)))
   (setf *current-frame*
 	(multiple-value-bind (next-frame-fun limit-string)
 	    (if (< n (sb!di:frame-number *current-frame*))
@@ -1206,7 +1209,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 +1624,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))
diff --git a/version.lisp-expr b/version.lisp-expr
index dd68d41..05e03a5 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; for internal versions, especially for internal versions off the
 ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.4.8"
+"0.7.4.9"