0.8.10.14:

[sbcl.git] / src / code / stream.lisp

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 5a256a3..925daa7 100644 (file)
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -629,6 +629,14 @@
             ((null streams) res)
           (when (null (cdr streams))
             (setq res (stream-element-type (car streams)))))))
+      (:file-position
+       (if arg1
+          (let ((res (or (eql arg1 :start) (eql arg1 0))))
+            (dolist (stream streams res)
+              (setq res (file-position stream arg1))))
+          (let ((res 0))
+            (dolist (stream streams res)
+              (setq res (file-position stream))))))
       (:close
        (set-closed-flame stream))
       (t
@@ -789,8 +797,7 @@
                      (bin #'concatenated-bin)
                      (n-bin #'concatenated-n-bin)
                      (misc #'concatenated-misc))
-           (:constructor %make-concatenated-stream
-                         (&rest streams &aux (current streams)))
+           (:constructor %make-concatenated-stream (&rest streams))
            (:copier nil))
   ;; The car of this is the substream we are reading from now.
   (streams nil :type list))
@@ -883,7 +890,7 @@
                      (in #'echo-in)
                      (bin #'echo-bin)
                      (misc #'echo-misc)
-                     (n-bin #'ill-bin))
+                     (n-bin #'echo-n-bin))
            (:constructor %make-echo-stream (input-stream output-stream))
            (:copier nil))
   unread-stuff)
@@ -922,6 +929,36 @@
                        (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))
+
+(defun echo-n-bin (stream buffer start numbytes eof-error-p)
+  (let ((new-start start)
+       (read 0))
+    (loop
+     (let ((thing (pop (echo-stream-unread-stuff stream))))
+       (cond
+        (thing
+         (setf (aref buffer new-start) thing)
+         (incf new-start)
+         (incf read)
+         (when (= read numbytes)
+           (return-from echo-n-bin numbytes)))
+        (t (return nil)))))
+    (let ((bytes-read (read-n-bytes (echo-stream-input-stream stream) buffer
+                                   new-start (- numbytes read) nil)))
+      (cond
+       ((not eof-error-p)
+        (write-sequence buffer (echo-stream-output-stream stream)
+                        :start new-start :end (+ new-start bytes-read))
+        (+ bytes-read read))
+       ((> numbytes (+ read bytes-read))
+        (write-sequence buffer (echo-stream-output-stream stream)
+                        :start new-start :end (+ new-start bytes-read))
+        (error 'end-of-file :stream stream))
+       (t
+        (write-sequence buffer (echo-stream-output-stream stream)
+                        :start new-start :end (+ new-start bytes-read))
+        (aver (= numbytes (+ new-start bytes-read)))
+        numbytes)))))
 \f
 ;;;; base STRING-STREAM stuff
 
@@ -1255,7 +1292,7 @@
     dst-end))
 
 (defun fill-pointer-misc (stream operation &optional arg1 arg2)
-  (declare (ignore arg1 arg2))
+  (declare (ignore arg2))
   (case operation
     (:file-position
      (let ((buffer (fill-pointer-output-stream-string stream)))
@@ -1660,11 +1697,8 @@
                (simple-array (signed-byte 8) (*))
                simple-string)
            (let* ((numbytes (- end start))
-                  (bytes-read (sb!sys:read-n-bytes stream
-                                                   data
-                                                   offset-start
-                                                   numbytes
-                                                   nil)))
+                  (bytes-read (read-n-bytes stream data offset-start
+                                            numbytes nil)))
              (if (< bytes-read numbytes)
                  (+ start bytes-read)
                  end)))