- (multiple-value-bind (routine type size read-n-characters
- normalized-external-format)
- (pick-input-routine target-type
- (fd-stream-external-format fd-stream))
- (when normalized-external-format
- (setf (fd-stream-external-format fd-stream)
- normalized-external-format))
- (unless routine
- (error "could not find any input routine for ~S" target-type))
- (setf (fd-stream-ibuf-sap fd-stream) (next-available-buffer))
- (setf (fd-stream-ibuf-length fd-stream) bytes-per-buffer)
- (setf (fd-stream-ibuf-tail fd-stream) 0)
- (if character-stream-p
- (setf (fd-stream-in fd-stream) routine
- (fd-stream-bin fd-stream) #'ill-bin)
- (setf (fd-stream-in fd-stream) #'ill-in
- (fd-stream-bin fd-stream) routine))
- (when (eql size 1)
- (setf (fd-stream-n-bin fd-stream)
- (if character-stream-p
- read-n-characters
- #'fd-stream-read-n-bytes))
- (when (and buffer-p
- ;; We only create this buffer for streams of type
- ;; (unsigned-byte 8). Because there's no buffer, the
- ;; other element-types will dispatch to the appropriate
- ;; input (output) routine in fast-read-byte.
- (or character-stream-p
- (equal target-type '(unsigned-byte 8)))
- (not output-p) ; temporary disable on :io streams
- #+(or)
- (or (eq type 'unsigned-byte)
- (eq type :default)))
- (if character-stream-p
- (setf (ansi-stream-cin-buffer fd-stream)
- (make-array +ansi-stream-in-buffer-length+
- :element-type 'character))
- (setf (ansi-stream-in-buffer fd-stream)
- (make-array +ansi-stream-in-buffer-length+
- :element-type '(unsigned-byte 8))))))
- (setf input-size size)
- (setf input-type type)))
+ (when (or (not character-stream-p) bivalent-stream-p)
+ (multiple-value-setq (bin-routine bin-type bin-size read-n-characters
+ normalized-external-format)
+ (pick-input-routine (if bivalent-stream-p '(unsigned-byte 8)
+ target-type)
+ external-format))
+ (unless bin-routine
+ (error "could not find any input routine for ~S" target-type)))
+ (when character-stream-p
+ (multiple-value-setq (cin-routine cin-type cin-size read-n-characters
+ normalized-external-format)
+ (pick-input-routine target-type external-format))
+ (unless cin-routine
+ (error "could not find any input routine for ~S" target-type)))
+ (setf (fd-stream-in fd-stream) cin-routine
+ (fd-stream-bin fd-stream) bin-routine)
+ ;; character type gets preferential treatment
+ (setf input-size (or cin-size bin-size))
+ (setf input-type (or cin-type bin-type))
+ (when normalized-external-format
+ (setf (fd-stream-external-format fd-stream)
+ normalized-external-format))
+ (when (= (or cin-size 1) (or bin-size 1) 1)
+ (setf (fd-stream-n-bin fd-stream) ;XXX
+ (if (and character-stream-p (not bivalent-stream-p))
+ read-n-characters
+ #'fd-stream-read-n-bytes))
+ ;; Sometimes turn on fast-read-char/fast-read-byte. Switch on
+ ;; for character and (unsigned-byte 8) streams. In these
+ ;; cases, fast-read-* will read from the
+ ;; ansi-stream-(c)in-buffer, saving function calls.
+ ;; Otherwise, the various data-reading functions in the stream
+ ;; structure will be called.
+ (when (and buffer-p
+ (not bivalent-stream-p)
+ ;; temporary disable on :io streams
+ (not output-p))
+ (cond (character-stream-p
+ (setf (ansi-stream-cin-buffer fd-stream)
+ (make-array +ansi-stream-in-buffer-length+
+ :element-type 'character)))
+ ((equal target-type '(unsigned-byte 8))
+ (setf (ansi-stream-in-buffer fd-stream)
+ (make-array +ansi-stream-in-buffer-length+
+ :element-type '(unsigned-byte 8))))))))