X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fstream.lisp;h=925daa75d798f4313118a9b0fd876ba36b02e7d6;hb=dca55270cf662763243dfc8ee207370473da2a6f;hp=43a7fcea5da56ccb78d7c54107d35be6e5435398;hpb=1d46d379bb7a6424524b978f213ef69be5f1ad69;p=sbcl.git diff --git a/src/code/stream.lisp b/src/code/stream.lisp index 43a7fce..925daa7 100644 --- 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,20 +797,10 @@ (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. - 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 +820,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 @@ -890,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) @@ -921,11 +921,44 @@ (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)) + +(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))))) ;;;; base STRING-STREAM stuff @@ -1019,6 +1052,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 +1164,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)) @@ -1257,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))) @@ -1662,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)))