X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fstream.lisp;h=73180359fcc88090e64746531ab947126e84fe4e;hb=f8893c7c658bf9d9e0757c63e47af2fdea810f04;hp=ac44a9053cd6df6b538f738d83ce6b5294d791d5;hpb=24407d11d34abdaaef6d839fd0b2665c73b0e6d5;p=sbcl.git

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index ac44a90..7318035 100644
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -59,16 +59,16 @@
 
 ;;; stream manipulation functions
 
-(defun input-stream-p (stream)
-  (declare (type stream stream))
+(declaim (inline ansi-stream-input-stream-p))
+(defun ansi-stream-input-stream-p (stream)
+  (declare (type ansi-stream stream))
 
   #!+high-security
   (when (synonym-stream-p stream)
     (setf stream
 	  (symbol-value (synonym-stream-symbol stream))))
 
-  (and (ansi-stream-p stream)
-       (not (eq (ansi-stream-in stream) #'closed-flame))
+  (and (not (eq (ansi-stream-in stream) #'closed-flame))
        ;;; KLUDGE: It's probably not good to have EQ tests on function
        ;;; values like this. What if someone's redefined the function?
        ;;; Is there a better way? (Perhaps just VALID-FOR-INPUT and
@@ -76,37 +76,60 @@
        (or (not (eq (ansi-stream-in stream) #'ill-in))
 	   (not (eq (ansi-stream-bin stream) #'ill-bin)))))
 
-(defun output-stream-p (stream)
+(defun input-stream-p (stream)
   (declare (type stream stream))
+  (and (ansi-stream-p stream)
+       (ansi-stream-input-stream-p stream)))
+
+(declaim (inline ansi-stream-output-stream-p))
+(defun ansi-stream-output-stream-p (stream)
+  (declare (type ansi-stream stream))
 
   #!+high-security
   (when (synonym-stream-p stream)
     (setf stream (symbol-value
 		  (synonym-stream-symbol stream))))
 
-  (and (ansi-stream-p stream)
-       (not (eq (ansi-stream-in stream) #'closed-flame))
+  (and (not (eq (ansi-stream-in stream) #'closed-flame))
        (or (not (eq (ansi-stream-out stream) #'ill-out))
 	   (not (eq (ansi-stream-bout stream) #'ill-bout)))))
 
-(defun open-stream-p (stream)
+(defun output-stream-p (stream)
   (declare (type stream stream))
+
+  (and (ansi-stream-p stream)
+       (ansi-stream-output-stream-p stream)))
+
+(declaim (inline ansi-stream-open-stream-p))
+(defun ansi-stream-open-stream-p (stream)
+  (declare (type ansi-stream stream))
   (not (eq (ansi-stream-in stream) #'closed-flame)))
 
-(defun stream-element-type (stream)
-  (declare (type stream stream))
+(defun open-stream-p (stream)
+  (ansi-stream-open-stream-p stream))
+
+(declaim (inline ansi-stream-element-type))
+(defun ansi-stream-element-type (stream)
+  (declare (type ansi-stream stream))
   (funcall (ansi-stream-misc stream) stream :element-type))
 
+(defun stream-element-type (stream)
+  (ansi-stream-element-type stream))
+
 (defun interactive-stream-p (stream)
   (declare (type stream stream))
   (funcall (ansi-stream-misc stream) stream :interactive-p))
 
-(defun close (stream &key abort)
-  (declare (type stream stream))
+(declaim (inline ansi-stream-close))
+(defun ansi-stream-close (stream abort)
+  (declare (type ansi-stream stream))
   (when (open-stream-p stream)
     (funcall (ansi-stream-misc stream) stream :close abort))
   t)
 
+(defun close (stream &key abort)
+  (ansi-stream-close stream abort))
+
 (defun set-closed-flame (stream)
   (setf (ansi-stream-in stream) #'closed-flame)
   (setf (ansi-stream-bin stream) #'closed-flame)
@@ -122,7 +145,7 @@
 ;;; Call the MISC method with the :FILE-POSITION operation.
 (defun file-position (stream &optional position)
   (declare (type stream stream))
-  (declare (type (or index (member nil :start :end)) position))
+  (declare (type (or index (alien sb!unix:off-t) (member nil :start :end)) position))
   (cond
    (position
     (setf (ansi-stream-in-index stream) +ansi-stream-in-buffer-length+)
@@ -162,13 +185,16 @@
 	   ;; private predicate function..) is ugly and confusing, but
 	   ;; I can't see any other way. -- WHN 2001-04-14
 	   :expected-type '(satisfies stream-associated-with-file-p)
-	   :format-string
+	   :format-control
 	   "~@<The stream ~2I~_~S ~I~_isn't associated with a file.~:>"
 	   :format-arguments (list stream))))
 
 ;;; like FILE-POSITION, only using :FILE-LENGTH
 (defun file-length (stream)
-  (declare (type (or file-stream synonym-stream) stream))
+  ;; FIXME: The following declaration uses yet undefined types, which
+  ;; cause cross-compiler hangup.
+  ;;
+  ;; (declare (type (or file-stream synonym-stream) stream))
   (stream-must-be-associated-with-file stream)
   (funcall (ansi-stream-misc stream) stream :file-length))
 
@@ -306,20 +332,9 @@
 			    eof-value
 			    recursive-p)
   (declare (ignore recursive-p))
-  ;; FIXME: The type of PEEK-TYPE is also declared in a DEFKNOWN, but
-  ;; the compiler doesn't seem to be smart enough to go from there to
-  ;; imposing a type check. Figure out why (because PEEK-TYPE is an
-  ;; &OPTIONAL argument?) and fix it, and then this explicit type
-  ;; check can go away.
-  (unless (typep peek-type '(or character boolean))
-    (error 'simple-type-error
-	   :datum peek-type
-	   :expected-type '(or character boolean)
-	   :format-control "~@<bad PEEK-TYPE=~S, ~_expected ~S~:>"
-	   :format-arguments (list peek-type '(or character boolean))))
   (let ((stream (in-synonym-of stream)))
     (cond ((typep stream 'echo-stream)
-	   (echo-misc stream 
+	   (echo-misc stream
 		      :peek-char
 		      peek-type
 		      (list eof-error-p eof-value)))
@@ -515,29 +530,23 @@
 	(stream-fresh-line stream))))
 
 (defun write-string (string &optional (stream *standard-output*)
-			    &key (start 0) (end nil))
-  (%write-string string stream start (or end (length string)))
-  string)
-
-(defun %write-string (string stream start end)
+			    &key (start 0) end)
   (declare (type string string))
-  (declare (type streamlike stream))
-  (declare (type index start end))
-
   ;; Note that even though you might expect, based on the behavior of
   ;; things like AREF, that the correct upper bound here is
   ;; (ARRAY-DIMENSION STRING 0), the ANSI glossary definitions for
   ;; "bounding index" and "length" indicate that in this case (i.e.
-  ;; for the ANSI-specified functions WRITE-STRING and WRITE-LINE
-  ;; which are implemented in terms of this function), (LENGTH STRING)
-  ;; is the required upper bound. A foolish consistency is the
-  ;; hobgoblin of lesser languages..
-  (unless (<= 0 start end (length string))
-    (error "~@<bad bounding indices START=~W END=~W for ~2I~_~S~:>"
-	   start
-	   end
-	   string))
+  ;; for the ANSI-specified functions WRITE-STRING [and WRITE-LINE]),
+  ;; (LENGTH STRING) is the required upper bound. A foolish
+  ;; consistency is the hobgoblin of lesser languages..
+  (%write-string string stream start (%check-vector-sequence-bounds
+				      string start end))
+  string)
 
+(defun %write-string (string stream start end)
+  (declare (type string string))
+  (declare (type streamlike stream))
+  (declare (type index start end))
   (let ((stream (out-synonym-of stream)))
     (cond ((ansi-stream-p stream)
 	   (if (array-header-p string)
@@ -551,10 +560,13 @@
 	   (stream-write-string stream string start end)))))
 
 (defun write-line (string &optional (stream *standard-output*)
-			  &key (start 0) (end nil))
-  (let ((defaulted-stream (out-synonym-of stream))
-	(defaulted-end (or end (length string))))
-    (%write-string string defaulted-stream start defaulted-end)
+			  &key (start 0) end)
+  (declare (type string string))
+  ;; FIXME: Why is there this difference between the treatments of the
+  ;; STREAM argument in WRITE-STRING and WRITE-LINE?
+  (let ((defaulted-stream (out-synonym-of stream)))
+    (%write-string string defaulted-stream start (%check-vector-sequence-bounds
+						  string start end))
     (write-char #\newline defaulted-stream))
   string)
 
@@ -884,7 +896,7 @@
 		  (let* ((stream (car current))
 			 (result (,fun stream nil nil)))
 		    (when result (return result)))
-		  (setf (concatenated-stream-current stream) current)))))
+		  (pop (concatenated-stream-current stream))))))
   (in-fun concatenated-in read-char)
   (in-fun concatenated-bin read-byte))
 
@@ -1060,43 +1072,48 @@
              (:include ansi-stream)
              (:constructor nil)
              (:copier nil))
-  (string nil :type string))
+  ;; FIXME: This type declaration is true, and will probably continue
+  ;; to be true.  However, note well the comments in DEFTRANSFORM
+  ;; REPLACE, implying that performance of REPLACE is somewhat
+  ;; critical to performance of string streams.  If (VECTOR CHARACTER)
+  ;; ever becomes different from (VECTOR BASE-CHAR), the transform
+  ;; probably needs to be extended.
+  (string (missing-arg) :type (vector character)))
 
 ;;;; STRING-INPUT-STREAM stuff
 
 (defstruct (string-input-stream
 	     (:include string-stream
 		       (in #'string-inch)
-		       (bin #'string-binch)
+		       (bin #'ill-bin)
 		       (n-bin #'string-stream-read-n-bytes)
 		       (misc #'string-in-misc)
-                       (string nil :type simple-string))
+                       (string (missing-arg) :type simple-string))
 	     (:constructor internal-make-string-input-stream
 			   (string current end))
 	     (:copier nil))
-  (current nil :type index)
-  (end nil :type index))
+  (current (missing-arg) :type index)
+  (end (missing-arg) :type index))
 
 (defun string-inch (stream eof-error-p eof-value)
+  (declare (type string-input-stream stream))
   (let ((string (string-input-stream-string stream))
 	(index (string-input-stream-current stream)))
-    (declare (simple-string string) (fixnum index))
-    (cond ((= index (the index (string-input-stream-end stream)))
+    (cond ((>= index (the index (string-input-stream-end stream)))
 	   (eof-or-lose stream eof-error-p eof-value))
 	  (t
 	   (setf (string-input-stream-current stream) (1+ index))
-	   (aref string index)))))
+	   (char string index)))))
 
 (defun string-binch (stream eof-error-p eof-value)
+  (declare (type string-input-stream stream))
   (let ((string (string-input-stream-string stream))
 	(index (string-input-stream-current stream)))
-    (declare (simple-string string)
-	     (type index index))
-    (cond ((= index (the index (string-input-stream-end stream)))
+    (cond ((>= index (the index (string-input-stream-end stream)))
 	   (eof-or-lose stream eof-error-p eof-value))
 	  (t
 	   (setf (string-input-stream-current stream) (1+ index))
-	   (char-code (aref string index))))))
+	   (char-code (char string index))))))
 
 (defun string-stream-read-n-bytes (stream buffer start requested eof-error-p)
   (declare (type string-input-stream stream)
@@ -1105,8 +1122,7 @@
 	 (index (string-input-stream-current stream))
 	 (available (- (string-input-stream-end stream) index))
 	 (copy (min available requested)))
-    (declare (simple-string string)
-	     (type index index available copy))
+    (declare (type simple-string string))
     (when (plusp copy)
       (setf (string-input-stream-current stream)
 	    (truly-the index (+ index copy)))
@@ -1123,36 +1139,43 @@
 	copy)))
 
 (defun string-in-misc (stream operation &optional arg1 arg2)
-  (declare (ignore arg2))
+  (declare (type string-input-stream stream)
+	   (ignore arg2))
   (case operation
     (:file-position
      (if arg1
-	 (setf (string-input-stream-current stream) arg1)
+	 (setf (string-input-stream-current stream)
+	       (case arg1
+		 (:start 0)
+		 (:end (string-input-stream-end stream))
+		 ;; We allow moving position beyond EOF. Errors happen
+		 ;; on read, not move -- or the user may extend the
+		 ;; input string.
+		 (t arg1)))
 	 (string-input-stream-current stream)))
-    (:file-length (length (string-input-stream-string stream)))
+    ;; According to ANSI: "Should signal an error of type type-error
+    ;; if stream is not a stream associated with a file."
+    ;; This is checked by FILE-LENGTH, so no need to do it here either.
+    ;; (:file-length (length (string-input-stream-string stream)))
     (:unread (decf (string-input-stream-current stream)))
-    (:listen (or (/= (the fixnum (string-input-stream-current stream))
-		     (the fixnum (string-input-stream-end stream)))
+    (:listen (or (/= (the index (string-input-stream-current stream))
+		     (the index (string-input-stream-end stream)))
 		 :eof))
-    (:element-type 'base-char)))
+    (:element-type (array-element-type (string-input-stream-string stream)))))
 
-(defun make-string-input-stream (string &optional
-					(start 0) (end (length string)))
+(defun make-string-input-stream (string &optional (start 0) end)
   #!+sb-doc
   "Return an input stream which will supply the characters of STRING between
   START and END in order."
   (declare (type string string)
 	   (type index start)
 	   (type (or index null) end))
-
-  #!+high-security
-  (when (> end (length string))
-    (cerror "Continue with end changed from ~S to ~S"
-	    "Write-string: end (~S) is larger then the length of the string (~S)"
-	    end (1- (length string))))
-
-  (internal-make-string-input-stream (coerce string 'simple-string)
-				     start end))
+  (let ((end (%check-vector-sequence-bounds string start end)))
+    (with-array-data ((string string) (start start) (end end))
+      (internal-make-string-input-stream
+       string ;; now simple
+       start
+       end))))
 
 ;;;; STRING-OUTPUT-STREAM stuff
 
@@ -1162,37 +1185,51 @@
 		      (sout #'string-sout)
 		      (misc #'string-out-misc)
                       ;; The string we throw stuff in.
-                      (string (make-string 40) :type simple-string))
-	    (:constructor make-string-output-stream ())
+                      (string (missing-arg)
+			      :type (simple-array character (*))))
+	    (:constructor make-string-output-stream 
+			  (&key (element-type 'character)
+			   &aux (string (make-string 40))))
 	    (:copier nil))
   ;; Index of the next location to use.
-  (index 0 :type fixnum))
+  (index 0 :type fixnum)
+  ;; Index cache for string-output-stream-last-index
+  (index-cache 0 :type fixnum)
+  ;; Requested element type
+  (element-type 'character))
 
 #!+sb-doc
 (setf (fdocumentation 'make-string-output-stream 'function)
   "Return an output stream which will accumulate all output given it for
    the benefit of the function GET-OUTPUT-STREAM-STRING.")
 
+(defun string-output-stream-last-index (stream)
+  (max (string-output-stream-index stream)
+       (string-output-stream-index-cache stream)))
+
 (defun string-ouch (stream character)
   (let ((current (string-output-stream-index stream))
 	(workspace (string-output-stream-string stream)))
-    (declare (simple-string workspace) (fixnum current))
+    (declare (type (simple-array character (*)) workspace)
+	     (type fixnum current))
     (if (= current (the fixnum (length workspace)))
 	(let ((new-workspace (make-string (* current 2))))
 	  (replace new-workspace workspace)
-	  (setf (aref new-workspace current) character)
-	  (setf (string-output-stream-string stream) new-workspace))
+	  (setf (aref new-workspace current) character
+		(string-output-stream-string stream) new-workspace))
 	(setf (aref workspace current) character))
     (setf (string-output-stream-index stream) (1+ current))))
 
 (defun string-sout (stream string start end)
-  (declare (simple-string string) (fixnum start end))
-  (let* ((current (string-output-stream-index stream))
+  (declare (type simple-string string)
+	   (type fixnum start end))
+  (let* ((string (coerce string '(simple-array character (*))))
+	 (current (string-output-stream-index stream))
 	 (length (- end start))
 	 (dst-end (+ length current))
 	 (workspace (string-output-stream-string stream)))
-    (declare (simple-string workspace)
-	     (fixnum current length dst-end))
+    (declare (type (simple-array character (*)) workspace string)
+	     (type fixnum current length dst-end))
     (if (> dst-end (the fixnum (length workspace)))
 	(let ((new-workspace (make-string (+ (* current 2) length))))
 	  (replace new-workspace workspace :end2 current)
@@ -1209,7 +1246,25 @@
   (declare (ignore arg2))
   (case operation
     (:file-position
-     (if (null arg1)
+     (if arg1
+	 (let ((end (string-output-stream-last-index stream)))
+	   (setf (string-output-stream-index-cache stream) end
+		 (string-output-stream-index stream)
+		 (case arg1
+		   (:start 0)
+		   (:end end)
+		   (t
+		    ;; We allow moving beyond the end of stream,
+		    ;; implicitly extending the output stream.
+		    (let ((buffer (string-output-stream-string stream)))
+		      (when (> arg1 (length buffer))
+			(setf (string-output-stream-string stream)
+			      (make-string
+			       arg1 :element-type (array-element-type buffer))
+			      (subseq (string-output-stream-string stream)
+				      0 end)
+			      (subseq buffer 0 end))))
+		      arg1))))
 	 (string-output-stream-index stream)))
     (:charpos
      (do ((index (1- (the fixnum (string-output-stream-index stream)))
@@ -1217,20 +1272,32 @@
 	  (count 0 (1+ count))
 	  (string (string-output-stream-string stream)))
 	 ((< index 0) count)
-       (declare (simple-string string)
-		(fixnum index count))
+       (declare (type (simple-array character (*)) string)
+		(type fixnum index count))
        (if (char= (schar string index) #\newline)
 	   (return count))))
-    (:element-type 'base-char)))
+    (:element-type (array-element-type (string-output-stream-string stream)))))
 
 ;;; Return a string of all the characters sent to a stream made by
 ;;; MAKE-STRING-OUTPUT-STREAM since the last call to this function.
 (defun get-output-stream-string (stream)
   (declare (type string-output-stream stream))
-  (let* ((length (string-output-stream-index stream))
-	 (result (make-string length)))
-    (replace result (string-output-stream-string stream))
-    (setf (string-output-stream-index stream) 0)
+  (let* ((length (string-output-stream-last-index stream))
+	 (element-type (string-output-stream-element-type stream))
+	 (result 
+	  (case element-type
+	    ;; Overwhelmingly common case; can be inlined.
+	    ((character) (make-string length))
+	    (t (make-string length :element-type element-type)))))
+    ;; For the benefit of the REPLACE transform, let's do this, so
+    ;; that the common case isn't ludicrously expensive.
+    (etypecase result 
+      ((simple-array character (*)) 
+       (replace result (string-output-stream-string stream)))
+      ((simple-array nil (*))
+       (replace result (string-output-stream-string stream))))
+    (setf (string-output-stream-index stream) 0
+	  (string-output-stream-index-cache stream) 0)
     result))
 
 ;;; Dump the characters buffer up in IN-STREAM to OUT-STREAM as
@@ -1239,8 +1306,9 @@
   (%write-string (string-output-stream-string in-stream)
 		 out-stream
 		 0
-		 (string-output-stream-index in-stream))
-  (setf (string-output-stream-index in-stream) 0))
+		 (string-output-stream-last-index in-stream))
+  (setf (string-output-stream-index in-stream) 0
+	(string-output-stream-index-cache in-stream) 0))
 
 ;;;; fill-pointer streams
 
@@ -1249,7 +1317,7 @@
 ;;; WITH-OUTPUT-TO-STRING.
 
 (deftype string-with-fill-pointer ()
-  '(and string
+  '(and (vector character)
 	(satisfies array-has-fill-pointer-p)))
 
 (defstruct (fill-pointer-output-stream
@@ -1259,7 +1327,7 @@
 		      (misc #'fill-pointer-misc)
                       ;; a string with a fill pointer where we stuff
                       ;; the stuff we write
-                      (string (error "missing argument")
+                      (string (missing-arg)
                               :type string-with-fill-pointer
                               :read-only t))
 	    (:constructor make-fill-pointer-output-stream (string))
@@ -1271,7 +1339,7 @@
 	 (current+1 (1+ current)))
     (declare (fixnum current))
     (with-array-data ((workspace buffer) (start) (end))
-      (declare (simple-string workspace))
+      (declare (type (simple-array character (*)) workspace))
       (let ((offset-current (+ start current)))
 	(declare (fixnum offset-current))
 	(if (= offset-current end)
@@ -1280,8 +1348,8 @@
 	      (declare (simple-string new-workspace))
 	      (%byte-blt workspace start
 			 new-workspace 0 current)
-	      (setf workspace new-workspace)
-	      (setf offset-current current)
+	      (setf workspace new-workspace
+		    offset-current current)
 	      (set-array-header buffer workspace new-length
 				current+1 0 new-length nil))
 	    (setf (fill-pointer buffer) current+1))
@@ -1290,20 +1358,23 @@
 
 (defun fill-pointer-sout (stream string start end)
   (declare (simple-string string) (fixnum start end))
-  (let* ((buffer (fill-pointer-output-stream-string stream))
+  (let* ((string (if (typep string '(simple-array character (*)))
+		     string
+		     (coerce string '(simple-array character (*)))))
+	 (buffer (fill-pointer-output-stream-string stream))
 	 (current (fill-pointer buffer))
 	 (string-len (- end start))
 	 (dst-end (+ string-len current)))
     (declare (fixnum current dst-end string-len))
     (with-array-data ((workspace buffer) (dst-start) (dst-length))
-      (declare (simple-string workspace))
+      (declare (type (simple-array character (*)) workspace))
       (let ((offset-dst-end (+ dst-start dst-end))
 	    (offset-current (+ dst-start current)))
 	(declare (fixnum offset-dst-end offset-current))
 	(if (> offset-dst-end dst-length)
 	    (let* ((new-length (+ (the fixnum (* current 2)) string-len))
 		   (new-workspace (make-string new-length)))
-	      (declare (simple-string new-workspace))
+	      (declare (type (simple-array character (*)) new-workspace))
 	      (%byte-blt workspace dst-start
 			 new-workspace 0 current)
 	      (setf workspace new-workspace)
@@ -1324,6 +1395,25 @@
 (defun fill-pointer-misc (stream operation &optional arg1 arg2)
   (declare (ignore arg1 arg2))
   (case operation
+    (:file-position
+     (let ((buffer (fill-pointer-output-stream-string stream)))
+       (if arg1
+	   (setf (fill-pointer buffer)
+		 (case arg1
+		   (:start 0)
+		   ;; Fill-pointer is always at fill-pointer we will
+		   ;; make :END move to the end of the actual string.
+		   (:end (array-total-size buffer))
+		   ;; We allow moving beyond the end of string if the
+		   ;; string is adjustable.
+		   (t (when (>= arg1 (array-total-size buffer))
+			(if (adjustable-array-p buffer)
+			    (adjust-array buffer arg1)
+			    (error "Cannot move FILE-POSITION beyond the end ~
+                                    of WITH-OUTPUT-TO-STRING stream ~
+                                    constructed with non-adjustable string.")))
+		      arg1)))
+	   (fill-pointer buffer))))
     (:charpos
      (let* ((buffer (fill-pointer-output-stream-string stream))
 	    (current (fill-pointer buffer)))
@@ -1334,7 +1424,8 @@
 	   (if found
 	       (- end (the fixnum found))
 	       current)))))
-     (:element-type 'base-char)))
+     (:element-type (array-element-type
+		     (fill-pointer-output-stream-string stream)))))
 
 ;;;; indenting streams
 
@@ -1656,40 +1747,9 @@
 	(funcall (ansi-stream-sout target) target str 0 len)
 	(stream-write-string target str 0 len))))
 
-;;;; stream commands
-
-(defstruct (stream-command (:constructor make-stream-command
-					 (name &optional args))
-			   (:copier nil))
-  (name nil :type symbol)
-  (args nil :type list))
-(def!method print-object ((obj stream-command) str)
-  (print-unreadable-object (obj str :type t :identity t)
-    (prin1 (stream-command-name obj) str)))
-
-;;; Take a stream and wait for text or a command to appear on it. If
-;;; text appears before a command, return NIL, otherwise return a
-;;; command.
-;;;
-;;; We can't simply call the stream's misc method because NIL is an
-;;; ambiguous return value: does it mean text arrived, or does it mean
-;;; the stream's misc method had no :GET-COMMAND implementation? We
-;;; can't return NIL until there is text input. We don't need to loop
-;;; because any stream implementing :GET-COMMAND would wait until it
-;;; had some input. If the LISTEN fails, then we have some stream we
-;;; must wait on.
-(defun get-stream-command (stream)
-  (let ((cmdp (funcall (ansi-stream-misc stream) stream :get-command)))
-    (cond (cmdp)
-	  ((listen stream)
-	   nil)
-	  (t
-	   ;; This waits for input and returns NIL when it arrives.
-	   (unread-char (read-char stream) stream)))))
-
 ;;;; READ-SEQUENCE
 
-(defun read-sequence (seq stream &key (start 0) (end nil))
+(defun read-sequence (seq stream &key (start 0) end)
   #!+sb-doc
   "Destructively modify SEQ by reading elements from STREAM.
   That part of SEQ bounded by START and END is destructively modified by