X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fstream.lisp;h=925daa75d798f4313118a9b0fd876ba36b02e7d6;hb=dca55270cf662763243dfc8ee207370473da2a6f;hp=5de727108e9dd447daf21302207168e988b21acf;hpb=b5e062b2e6fd068d9a870bf8888d96126887852c;p=sbcl.git diff --git a/src/code/stream.lisp b/src/code/stream.lisp index 5de7271..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,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)) @@ -828,11 +835,11 @@ (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) @@ -841,38 +848,40 @@ (setf (concatenated-stream-streams stream) (cdr streams)))) (defun concatenated-misc (stream operation &optional arg1 arg2) - (let ((left (concatenated-stream-streams 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 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 (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 @@ -881,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) @@ -920,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))))) ;;;; base STRING-STREAM stuff @@ -1013,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)) @@ -1124,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)) @@ -1251,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))) @@ -1656,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)))