- (with-array-data ((data seq) (offset-start start) (offset-end end))
- (if (compatible-vector-and-stream-element-types-p data stream)
- (let* ((numbytes (- end start))
- (bytes-read (read-n-bytes stream data offset-start
- numbytes nil)))
- (if (< bytes-read numbytes)
- (+ start bytes-read)
- end))
- (let ((read-function
- (if (subtypep (stream-element-type stream) 'character)
- ;; If the stream-element-type is CHARACTER,
- ;; this might be a bivalent stream. If the
- ;; sequence is a specialized unsigned-byte
- ;; vector, try to read use binary IO. It'll
- ;; signal an error if stream is an pure
- ;; character stream.
- (if (subtypep (array-element-type data)
- 'unsigned-byte)
- #'ansi-stream-read-byte
- #'ansi-stream-read-char)
- #'ansi-stream-read-byte)))
- (do ((i offset-start (1+ i)))
- ((>= i offset-end) end)
- (declare (type index i))
- (let ((el (funcall read-function stream nil :eof nil)))
- (when (eq el :eof)
- (return (+ start (- i offset-start))))
- (setf (aref data i) el))))))))))
+ (with-array-data ((data seq) (offset-start start) (offset-end end)
+ :check-fill-pointer t)
+ (cond ((compatible-vector-and-stream-element-types-p data stream)
+ (let* ((numbytes (- end start))
+ (bytes-read (read-n-bytes stream data offset-start
+ numbytes nil)))
+ (if (< bytes-read numbytes)
+ (+ start bytes-read)
+ end)))
+ ((and (ansi-stream-cin-buffer stream)
+ (typep seq 'simple-string))
+ (ansi-stream-read-string-from-frc-buffer seq stream
+ start %end))
+ (t
+ (let ((read-function
+ (if (subtypep (stream-element-type stream) 'character)
+ ;; If the stream-element-type is CHARACTER,
+ ;; this might be a bivalent stream. If the
+ ;; sequence is a specialized unsigned-byte
+ ;; vector, try to read use binary IO. It'll
+ ;; signal an error if stream is an pure
+ ;; character stream.
+ (if (subtypep (array-element-type data)
+ 'unsigned-byte)
+ #'ansi-stream-read-byte
+ #'ansi-stream-read-char)
+ #'ansi-stream-read-byte)))
+ (do ((i offset-start (1+ i)))
+ ((>= i offset-end) end)
+ (declare (type index i))
+ (let ((el (funcall read-function stream nil :eof nil)))
+ (when (eq el :eof)
+ (return (+ start (- i offset-start))))
+ (setf (aref data i) el)))))))))))
+
+(defun ansi-stream-read-string-from-frc-buffer (seq stream start %end)
+ (declare (type simple-string seq)
+ (type ansi-stream stream)
+ (type index start)
+ (type (or null index) %end))
+ (let ((needed (- (or %end (length seq))
+ start))
+ (read 0))
+ (prepare-for-fast-read-char stream
+ (declare (ignore %frc-method%))
+ (unless %frc-buffer%
+ (return-from ansi-stream-read-string-from-frc-buffer nil))
+ (labels ((refill-buffer ()
+ (prog1
+ (fast-read-char-refill stream nil nil)
+ (setf %frc-index% (ansi-stream-in-index %frc-stream%))))
+ (add-chunk ()
+ (let* ((end (length %frc-buffer%))
+ (len (min (- end %frc-index%)
+ (- needed read))))
+ (declare (type index end len read needed))
+ (string-dispatch (simple-base-string
+ (simple-array character (*)))
+ seq
+ (replace seq %frc-buffer%
+ :start1 (+ start read)
+ :end1 (+ start read len)
+ :start2 %frc-index%
+ :end2 (+ %frc-index% len)))
+ (incf read len)
+ (incf %frc-index% len)
+ (when (or (eql needed read)
+ (refill-buffer))
+ (done-with-fast-read-char)
+ (return-from ansi-stream-read-string-from-frc-buffer
+ read)))))
+ (declare (inline refill-buffer))
+ (when (and (= %frc-index% +ansi-stream-in-buffer-length+)
+ (refill-buffer))
+ ;; EOF had been reached before we read anything
+ ;; at all. Return the EOF value or signal the error.
+ (done-with-fast-read-char)
+ (return-from ansi-stream-read-string-from-frc-buffer 0))
+ (loop (add-chunk))))))
+