X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fstream.lisp;h=5a256a3b7626979e4ffd827b9a140f65f1d0392f;hb=e5e1b41799b814bca18e5f6e5c10b12d06c35c46;hp=43a7fcea5da56ccb78d7c54107d35be6e5435398;hpb=1d46d379bb7a6424524b978f213ef69be5f1ad69;p=sbcl.git

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 43a7fce..5a256a3 100644
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -793,16 +793,7 @@
 			  (&rest streams &aux (current streams)))
 	    (:copier nil))
   ;; The car of this is the substream we are reading from now.
-  current
-  ;; This is a list of all the substreams there ever were. We need to
-  ;; remember them so that we can close them.
-  ;;
-  ;; FIXME: ANSI says this is supposed to be the list of streams that
-  ;; we still have to read from. So either this needs to become a
-  ;; private member %STREAM (with CONCATENATED-STREAM-STREAMS a wrapper
-  ;; around it which discards closed files from the head of the list)
-  ;; or we need to update it as we run out of files.
-  (streams nil :type list :read-only t))
+  (streams nil :type list))
 (def!method print-object ((x concatenated-stream) stream)
   (print-unreadable-object (x stream :type t :identity t)
     (format stream
@@ -822,66 +813,68 @@
 
 (macrolet ((in-fun (name fun)
 	     `(defun ,name (stream eof-error-p eof-value)
-		(do ((current (concatenated-stream-current stream)
-			      (cdr current)))
-		    ((null current)
+		(do ((streams (concatenated-stream-streams stream)
+			      (cdr streams)))
+		    ((null streams)
 		     (eof-or-lose stream eof-error-p eof-value))
-		  (let* ((stream (car current))
+		  (let* ((stream (car streams))
 			 (result (,fun stream nil nil)))
 		    (when result (return result)))
-		  (pop (concatenated-stream-current stream))))))
+		  (pop (concatenated-stream-streams stream))))))
   (in-fun concatenated-in read-char)
   (in-fun concatenated-bin read-byte))
 
 (defun concatenated-n-bin (stream buffer start numbytes eof-errorp)
-  (do ((current (concatenated-stream-current stream) (cdr current))
+  (do ((streams (concatenated-stream-streams stream) (cdr streams))
        (current-start start)
        (remaining-bytes numbytes))
-      ((null current)
+      ((null streams)
        (if eof-errorp
 	   (error 'end-of-file :stream stream)
 	   (- numbytes remaining-bytes)))
-    (let* ((stream (car current))
+    (let* ((stream (car streams))
            (bytes-read (read-n-bytes stream buffer current-start
 	                             remaining-bytes nil)))
       (incf current-start bytes-read)
       (decf remaining-bytes bytes-read)
       (when (zerop remaining-bytes) (return numbytes)))
-    (setf (concatenated-stream-current stream) (cdr current))))
+    (setf (concatenated-stream-streams stream) (cdr streams))))
 
 (defun concatenated-misc (stream operation &optional arg1 arg2)
-  (let ((left (concatenated-stream-current stream)))
-    (when left
-      (let* ((current (car left)))
-	(case operation
-	  (:listen
-	   (loop
-	     (let ((stuff (if (ansi-stream-p current)
-			      (funcall (ansi-stream-misc current) current
-				       :listen)
-			      (stream-misc-dispatch current :listen))))
-	       (cond ((eq stuff :eof)
-		      ;; Advance CURRENT, and try again.
-		      (pop (concatenated-stream-current stream))
-		      (setf current
-			    (car (concatenated-stream-current stream)))
-		      (unless current
-			;; No further streams. EOF.
-			(return :eof)))
-		     (stuff
-		      ;; Stuff's available.
-		      (return t))
-		     (t
-		      ;; Nothing is available yet.
-		      (return nil))))))
-          (:clear-input (clear-input current))
-          (:unread (unread-char arg1 current))
-          (:close
-	   (set-closed-flame stream))
-	  (t
-	   (if (ansi-stream-p current)
-	       (funcall (ansi-stream-misc current) current operation arg1 arg2)
-	       (stream-misc-dispatch current operation arg1 arg2))))))))
+  (let* ((left (concatenated-stream-streams stream))
+	 (current (car left)))
+    (case operation
+      (:listen
+       (unless left
+	 (return-from concatenated-misc :eof))
+       (loop
+	(let ((stuff (if (ansi-stream-p current)
+			 (funcall (ansi-stream-misc current) current
+				  :listen)
+			 (stream-misc-dispatch current :listen))))
+	  (cond ((eq stuff :eof)
+		 ;; Advance STREAMS, and try again.
+		 (pop (concatenated-stream-streams stream))
+		 (setf current
+		       (car (concatenated-stream-streams stream)))
+		 (unless current
+		   ;; No further streams. EOF.
+		   (return :eof)))
+		(stuff
+		 ;; Stuff's available.
+		 (return t))
+		(t
+		 ;; Nothing is available yet.
+		 (return nil))))))
+      (:clear-input (when left (clear-input current)))
+      (:unread (when left (unread-char arg1 current)))
+      (:close
+       (set-closed-flame stream))
+      (t
+       (when left
+	 (if (ansi-stream-p current)
+	     (funcall (ansi-stream-misc current) current operation arg1 arg2)
+	     (stream-misc-dispatch current operation arg1 arg2)))))))
 
 ;;;; echo streams
 
@@ -921,9 +914,12 @@
 		(or (pop (echo-stream-unread-stuff stream))
 		    (let* ((in (echo-stream-input-stream stream))
 			   (out (echo-stream-output-stream stream))
-			   (result (,in-fun in ,@args)))
-		      (,out-fun result out)
-		      result)))))
+			   (result (if eof-error-p
+				       (,in-fun in ,@args)
+				       (,in-fun in nil in))))
+		      (cond
+			((eql result in) eof-value)
+			(t (,out-fun result out) result)))))))
   (in-fun echo-in read-char write-char eof-error-p eof-value)
   (in-fun echo-bin read-byte write-byte eof-error-p eof-value))
 
@@ -1019,6 +1015,7 @@
     ;; 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)))
+    (:close (set-closed-flame stream))
     (:listen (or (/= (the index (string-input-stream-current stream))
 		     (the index (string-input-stream-end stream)))
 		 :eof))
@@ -1130,6 +1127,7 @@
 			      (subseq buffer 0 end))))
 		      arg1))))
 	 (string-output-stream-index stream)))
+    (:close (set-closed-flame stream))
     (:charpos
      (do ((index (1- (the fixnum (string-output-stream-index stream)))
 		 (1- index))