(defun %write-string (string stream start end)
(declare (type string string))
- (declare (type streamlike stream))
+ (declare (type stream-designator stream))
(declare (type index start end))
(let ((stream (out-synonym-of stream)))
(cond ((ansi-stream-p stream)
((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
(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
(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)))))))
\f
;;;; echo streams
(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)
(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)))))
\f
;;;; base STRING-STREAM stuff
;; 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))
(declare (type string string)
(type index start)
(type (or index null) end))
- (let ((end (%check-vector-sequence-bounds string start end)))
+ (let* ((string (coerce string '(simple-array character (*))))
+ (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
(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))
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)))
(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)))
projects / sbcl.git / blobdiff