- (%uninitialized stream))
- ((and (eq kind :open)
- (not (any-stream-instance-flags stream :input :output)))
- (sb-kernel:closed-flame stream))
- ((and (or (eq kind :input) (eq kind :io))
- (not (any-stream-instance-flags stream :input)))
- (sb-kernel:ill-in stream))
- ((and (or (eq kind :output) (eq kind :io))
- (not (any-stream-instance-flags stream :output)))
- (sb-kernel:ill-out stream)))))
+ (%uninitialized stream))
+ ((and (eq kind :open)
+ (not (any-stream-instance-flags stream :input :output)))
+ (sb-kernel:closed-flame stream))
+ ((and (or (eq kind :input) (eq kind :io))
+ (not (any-stream-instance-flags stream :input)))
+ (sb-kernel:ill-in stream))
+ ((and (or (eq kind :output) (eq kind :io))
+ (not (any-stream-instance-flags stream :output)))
+ (sb-kernel:ill-out stream)))))
- (setf (sm last-char-read-size stream) 0)
- (setf (sm buffpos stream) 0 ; set pointer to 0 to force a read
- (sm buffer-ptr stream) 0)
- (setf (sm charpos stream) nil)
- (remove-stream-instance-flags stream :eof)
- (setf (device-file-position stream) position))
- ;; Just report current position
- (let ((posn (device-file-position stream)))
- (when posn
- (when (sm handler stream)
- (dolist (queued (sm pending stream))
- (incf posn (- (the sb-int:index (third queued))
- (the sb-int:index (second queued))))))
- (etypecase stream
- (single-channel-simple-stream
+ (setf (sm last-char-read-size stream) 0)
+ (setf (sm buffpos stream) 0 ; set pointer to 0 to force a read
+ (sm buffer-ptr stream) 0)
+ (setf (sm charpos stream) nil)
+ (remove-stream-instance-flags stream :eof)
+ (setf (device-file-position stream) position))
+ ;; Just report current position
+ (let ((posn (device-file-position stream)))
+ (when posn
+ (when (sm handler stream)
+ (dolist (queued (sm pending stream))
+ (incf posn (- (the sb-int:index (third queued))
+ (the sb-int:index (second queued))))))
+ (etypecase stream
+ (single-channel-simple-stream
- (declare (ignore octet))
- (incf count)))
- (etypecase object
- (character
- (let ((x nil))
- (char-to-octets (sm external-format stream) object x #'fn)))
- (string
- (let ((x nil)
- (ef (sm external-format stream)))
- (dotimes (i (length object))
- (declare (type sb-int:index i))
- (char-to-octets ef (char object i) x #'fn))))))
+ (declare (ignore octet))
+ (incf count)))
+ (etypecase object
+ (character
+ (let ((x nil))
+ (char-to-octets (sm external-format stream) object x #'fn)))
+ (string
+ (let ((x nil)
+ (ef (sm external-format stream)))
+ (dotimes (i (length object))
+ (declare (type sb-int:index i))
+ (char-to-octets ef (char object i) x #'fn))))))
- (cbuf (make-string 80)) ; current buffer
- (bufs (list cbuf)) ; list of buffers
- (tail bufs) ; last cons of bufs list
- (index 0) ; current index in current buffer
- (total 0)) ; total characters
+ (cbuf (make-string 80)) ; current buffer
+ (bufs (list cbuf)) ; list of buffers
+ (tail bufs) ; last cons of bufs list
+ (index 0) ; current index in current buffer
+ (total 0)) ; total characters
- (multiple-value-bind (chars done)
- (funcall-stm-handler j-read-chars encap cbuf
- #\Newline index (length cbuf) t)
- (declare (type sb-int:index chars))
- (incf index chars)
- (incf total chars)
- (when (and (eq done :eof) (zerop total))
- (if eof-error-p
- (error 'end-of-file :stream stream)
- (return (values eof-value t))))
- (when done
- ;; If there's only one buffer in use, return it directly
- (when (null (cdr bufs))
- (return (values (sb-kernel:shrink-vector cbuf total)
- (eq done :eof))))
- ;; If total fits in final buffer, use it
- (when (<= total (length cbuf))
- (replace cbuf cbuf :start1 (- total index) :end2 index)
- (let ((idx 0))
- (declare (type sb-int:index idx))
- (do ((list bufs (cdr list)))
- ((eq list tail))
- (let ((buf (car list)))
- (declare (type simple-string buf))
- (replace cbuf buf :start1 idx)
- (incf idx (length buf)))))
- (return (values (sb-kernel:shrink-vector cbuf total)
- (eq done :eof))))
- ;; Allocate new string of appropriate length
- (let ((string (make-string total))
- (index 0))
- (declare (type sb-int:index index))
- (dolist (buf bufs)
- (declare (type simple-string buf))
- (replace string buf :start1 index)
- (incf index (length buf)))
- (return (values string (eq done :eof)))))
- (when (>= index (length cbuf))
- (setf cbuf (make-string (the sb-int:index (* 2 index))))
- (setf index 0)
- (setf (cdr tail) (cons cbuf nil))
- (setf tail (cdr tail))))))))
+ (multiple-value-bind (chars done)
+ (funcall-stm-handler j-read-chars encap cbuf
+ #\Newline index (length cbuf) t)
+ (declare (type sb-int:index chars))
+ (incf index chars)
+ (incf total chars)
+ (when (and (eq done :eof) (zerop total))
+ (if eof-error-p
+ (error 'end-of-file :stream stream)
+ (return (values eof-value t))))
+ (when done
+ ;; If there's only one buffer in use, return it directly
+ (when (null (cdr bufs))
+ (return (values (sb-kernel:shrink-vector cbuf total)
+ (eq done :eof))))
+ ;; If total fits in final buffer, use it
+ (when (<= total (length cbuf))
+ (replace cbuf cbuf :start1 (- total index) :end2 index)
+ (let ((idx 0))
+ (declare (type sb-int:index idx))
+ (do ((list bufs (cdr list)))
+ ((eq list tail))
+ (let ((buf (car list)))
+ (declare (type simple-string buf))
+ (replace cbuf buf :start1 idx)
+ (incf idx (length buf)))))
+ (return (values (sb-kernel:shrink-vector cbuf total)
+ (eq done :eof))))
+ ;; Allocate new string of appropriate length
+ (let ((string (make-string total))
+ (index 0))
+ (declare (type sb-int:index index))
+ (dolist (buf bufs)
+ (declare (type simple-string buf))
+ (replace string buf :start1 index)
+ (incf index (length buf)))
+ (return (values string (eq done :eof)))))
+ (when (>= index (length cbuf))
+ (setf cbuf (make-string (the sb-int:index (* 2 index))))
+ (setf index 0)
+ (setf (cdr tail) (cons cbuf nil))
+ (setf tail (cdr tail))))))))
- ((characterp peek-type)
- (do ((char char (funcall-stm-handler j-read-char encap
- eof-error-p
- stream t)))
- ((or (eq char stream) (char= char peek-type))
- (unless (eq char stream)
- (funcall-stm-handler j-unread-char encap t))
- (if (eq char stream) eof-value char))))
- ((eq peek-type t)
- (do ((char char (funcall-stm-handler j-read-char encap
- eof-error-p
- stream t)))
- ((or (eq char stream)
- (not (sb-impl::whitespacep char)))
- (unless (eq char stream)
- (funcall-stm-handler j-unread-char encap t))
- (if (eq char stream) eof-value char))))
- (t
- (funcall-stm-handler j-unread-char encap t)
- char)))))
+ ((characterp peek-type)
+ (do ((char char (funcall-stm-handler j-read-char encap
+ eof-error-p
+ stream t)))
+ ((or (eq char stream) (char= char peek-type))
+ (unless (eq char stream)
+ (funcall-stm-handler j-unread-char encap t))
+ (if (eq char stream) eof-value char))))
+ ((eq peek-type t)
+ (do ((char char (funcall-stm-handler j-read-char encap
+ eof-error-p
+ stream t)))
+ ((or (eq char stream)
+ (not (sb-impl::whitespace[2]p char)))
+ (unless (eq char stream)
+ (funcall-stm-handler j-unread-char encap t))
+ (if (eq char stream) eof-value char))))
+ (t
+ (funcall-stm-handler j-unread-char encap t)
+ char)))))
- (funcall-stm-handler j-listen (sm melded-stream stream))
- (or (< (sm buffpos stream) (sm buffer-ptr stream))
- (when (or (not (any-stream-instance-flags stream :dual :string))
- (>= (sm mode stream) 0)) ;; device-connected @@ single-channel
- (let ((lcrs (sm last-char-read-size stream)))
- (unwind-protect
- (progn
- (setf (sm last-char-read-size stream) (1+ lcrs))
- (plusp (refill-buffer stream nil)))
- (setf (sm last-char-read-size stream) lcrs))))))))
+ (funcall-stm-handler j-listen (sm melded-stream stream))
+ (or (< (sm buffpos stream) (sm buffer-ptr stream))
+ ;; Attempt buffer refill
+ (let ((lcrs (sm last-char-read-size stream)))
+ (when (and (not (any-stream-instance-flags stream :dual :string))
+ (>= (sm mode stream) 0))
+ ;; single-channel stream dirty -> write data before reading
+ (flush-buffer stream nil))
+ (>= (refill-buffer stream nil) width))))))
- (do ((char (sb-gray:stream-read-char stream)
- (sb-gray:stream-read-char stream)))
- ((or (eq char :eof) (char= char peek-type))
- (cond ((eq char :eof)
- (sb-impl::eof-or-lose stream eof-error-p eof-value))
- (t
- (sb-gray:stream-unread-char stream char)
- char)))))
- ((eq peek-type t)
- (do ((char (sb-gray:stream-read-char stream)
- (sb-gray:stream-read-char stream)))
- ((or (eq char :eof) (not (sb-impl::whitespacep char)))
- (cond ((eq char :eof)
- (sb-impl::eof-or-lose stream eof-error-p eof-value))
- (t
- (sb-gray:stream-unread-char stream char)
- char)))))
- (t
- (let ((char (sb-gray:stream-peek-char stream)))
- (if (eq char :eof)
- (sb-impl::eof-or-lose stream eof-error-p eof-value)
- char))))))))
+ (do ((char (sb-gray:stream-read-char stream)
+ (sb-gray:stream-read-char stream)))
+ ((or (eq char :eof) (char= char peek-type))
+ (cond ((eq char :eof)
+ (sb-impl::eof-or-lose stream eof-error-p eof-value))
+ (t
+ (sb-gray:stream-unread-char stream char)
+ char)))))
+ ((eq peek-type t)
+ (do ((char (sb-gray:stream-read-char stream)
+ (sb-gray:stream-read-char stream)))
+ ((or (eq char :eof) (not (sb-impl::whitespace[2]p char)))
+ (cond ((eq char :eof)
+ (sb-impl::eof-or-lose stream eof-error-p eof-value))
+ (t
+ (sb-gray:stream-unread-char stream char)
+ char)))))
+ (t
+ (let ((char (sb-gray:stream-peek-char stream)))
+ (if (eq char :eof)
+ (sb-impl::eof-or-lose stream eof-error-p eof-value)
+ char))))))))