io.streams/gray-stream-methods.lisp

   1 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
   2
   3 ;;   Copyright (C) 2007 Stelian Ionescu
   4 ;;
   5 ;;   This code is free software; you can redistribute it and/or
   6 ;;   modify it under the terms of the version 2.1 of
   7 ;;   the GNU Lesser General Public License as published by
   8 ;;   the Free Software Foundation, as clarified by the
   9 ;;   preamble found here:
  10 ;;       http://opensource.franz.com/preamble.html
  11 ;;
  12 ;;   This program is distributed in the hope that it will be useful,
  13 ;;   but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;   GNU General Public License for more details.
  16 ;;
  17 ;;   You should have received a copy of the GNU Lesser General
  18 ;;   Public License along with this library; if not, write to the
  19 ;;   Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
  20 ;;   Boston, MA 02110-1301, USA
  21
  22 (in-package :io.streams)
  23
  24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25 ;;                         ;;
  26 ;; Instance Initialization ;;
  27 ;;                         ;;
  28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29
  30 ;; TODO: use the buffer pool
  31 ;; TODO: handle instance reinitialization
  32 (defmethod shared-initialize :after ((s dual-channel-gray-stream) slot-names
  33                                      &key (input-buffer-size +bytes-per-iobuf+)
  34                                      (output-buffer-size +bytes-per-iobuf+)
  35                                      (external-format :default))
  36   (declare (ignore slot-names))
  37   (check-type input-buffer-size buffer-index)
  38   (check-type output-buffer-size buffer-index)
  39   (when (open-stream-p s) (close s))
  40   (with-accessors ((ib input-buffer-of) (ob output-buffer-of)
  41                    (ef external-format-of)) s
  42     (setf ib (allocate-iobuf input-buffer-size)
  43           ob (allocate-iobuf output-buffer-size)
  44           ef external-format)))
  45 \f
  46 ;;;;;;;;;;;;;;;;;;;;
  47 ;;                ;;
  48 ;; Common Methods ;;
  49 ;;                ;;
  50 ;;;;;;;;;;;;;;;;;;;;
  51
  52 (defmethod stream-element-type ((stream dual-channel-gray-stream))
  53   '(unsigned-byte 8))
  54
  55 ;; TODO: use the buffer pool
  56 (defmethod close :around ((stream dual-channel-gray-stream) &key abort)
  57   (with-accessors ((ib input-buffer-of)
  58                    (ob output-buffer-of)) stream
  59     (unless (or abort (null ib)) (finish-output stream))
  60     (when ib (free-iobuf ib))
  61     (when ob (free-iobuf ob))
  62     (setf ib nil ob nil))
  63   (call-next-method)
  64   (values stream))
  65
  66 (defmethod close ((stream dual-channel-gray-stream) &key abort)
  67   (declare (ignore stream abort)))
  68
  69 (defmethod (setf external-format-of) (external-format (stream dual-channel-gray-stream))
  70   (setf (slot-value stream 'external-format)
  71         (ensure-external-format external-format)))
  72 \f
  73 ;;;;;;;;;;;;;;;;;;;
  74 ;;               ;;
  75 ;; Input Methods ;;
  76 ;;               ;;
  77 ;;;;;;;;;;;;;;;;;;;
  78
  79 (defmethod stream-clear-input ((stream dual-channel-gray-stream))
  80   (with-accessors ((ib input-buffer-of)) stream
  81     (iobuf-reset ib)
  82     nil))
  83
  84 (defun %fill-ibuf (buf fd &optional timeout)
  85   (when timeout
  86     (let ((readablep
  87            (iomux:wait-until-fd-ready fd :read timeout)))
  88       (unless readablep
  89         (return-from %fill-ibuf :timeout))))
  90   (let ((num (et:repeat-upon-eintr
  91                (et:read fd (iobuf-end-pointer buf)
  92                         (iobuf-end-space-length buf)))))
  93     (if (zerop num)
  94         :eof
  95         (incf (iobuf-end buf) num))))
  96
  97 (defun %read-into-simple-array-ub8 (stream array start end)
  98   (declare (type dual-channel-gray-stream stream))
  99   (with-accessors ((ib input-buffer-of)
 100                    (fd input-fd-of)) stream
 101     (let ((octets-needed (- end start)))
 102       (loop :with array-offset := start
 103             :for octets-in-buffer := (iobuf-length ib)
 104             :for nbytes := (min octets-needed octets-in-buffer)
 105          :when (plusp nbytes) :do
 106            (iobuf-copy-into-lisp-array ib (iobuf-start ib)
 107                                        array array-offset nbytes)
 108            (incf array-offset nbytes)
 109            (decf octets-needed nbytes)
 110            (incf (iobuf-start ib) nbytes)
 111          :if (zerop octets-needed) :do (loop-finish)
 112          :else :do (iobuf-reset ib)
 113          :when (eql :eof (%fill-ibuf ib fd)) :do (loop-finish)
 114          :finally (return array-offset)))))
 115
 116 (defun %read-into-string (stream string start end)
 117   (declare (type dual-channel-gray-stream stream))
 118   (loop :for offset :from start :below end
 119         :for char := (stream-read-char stream)
 120      :if (eql char :eof) :do (loop-finish)
 121      :else :do (setf (char string offset) char)
 122      :finally (return offset)))
 123
 124 (defun %read-into-vector (stream vector start end)
 125   (declare (type dual-channel-gray-stream stream))
 126   (loop :for offset :from start :below end
 127         :for octet := (stream-read-byte stream)
 128      :if (eql octet :eof) :do (loop-finish)
 129      :else :do (setf (aref vector offset) octet)
 130      :finally (return offset)))
 131
 132 #-clisp
 133 (defmethod #-openmcl stream-read-sequence
 134            #+openmcl stream-read-vector
 135            #-lispworks
 136            ((stream dual-channel-gray-stream) seq
 137             &optional (start 0) end)
 138            #+lispworks
 139            ((stream dual-channel-gray-stream) seq start end)
 140   (setf (values start end) (%check-bounds seq start end))
 141   (when (< start end)
 142     (etypecase seq
 143       (ub8-sarray
 144        (%read-into-simple-array-ub8 stream seq start end))
 145       (string
 146        (%read-into-string stream seq start end))
 147       (ub8-vector
 148        (%read-into-vector stream seq start end)))))
 149
 150 #+clisp
 151 (defmethod stream-read-byte-sequence ((stream dual-channel-gray-stream) seq
 152                                       &optional (start 0) end
 153                                       no-hang interactive)
 154   (declare (ignore no-hang interactive))
 155   (setf (values start end) (%check-bounds seq start end))
 156   (when (< start end)
 157     (etypecase seq
 158       (ub8-sarray
 159        (%read-into-simple-array-ub8 stream seq start end))
 160       (ub8-vector
 161        (%read-into-vector stream seq start end)))))
 162
 163 #+clisp
 164 (defmethod stream-read-char-sequence ((stream dual-channel-gray-stream) seq
 165                                       &optional (start 0) end)
 166   (setf (values start end) (%check-bounds seq start end))
 167   (when (< start end)
 168     (etypecase seq
 169       (string
 170        (%read-into-string stream seq start end)))))
 171 \f
 172 ;;;;;;;;;;;;;;;;;;;;
 173 ;;                ;;
 174 ;; Output Methods ;;
 175 ;;                ;;
 176 ;;;;;;;;;;;;;;;;;;;;
 177
 178 (defun %write-n-bytes (buf fd nbytes &optional timeout)
 179   (declare (type stream-buffer buf))
 180   (let ((bytes-written 0))
 181     (labels ((write-once ()
 182                (let ((num (handler-case
 183                               (et:repeat-upon-condition-decreasing-timeout
 184                                   ((et:eintr) timeout-var timeout)
 185                                 (prog1
 186                                     (et:write fd (inc-pointer buf bytes-written) nbytes)
 187                                   (when (and timeout-var (zerop timeout-var))
 188                                     (return-from %write-n-bytes (values nil :timeout)))))
 189                             (et:epipe ()
 190                               (return-from %write-n-bytes (values nil :eof))))))
 191                  (unless (zerop num) (incf bytes-written num))))
 192              (write-or-return ()
 193                (unless (write-once)
 194                  (when (errorp)
 195                    ;; FIXME signal something better -- maybe analyze the status
 196                    (return-from %write-n-bytes (values nil :fail)))))
 197              (buffer-emptyp () (= bytes-written nbytes))
 198              (errorp () (handler-case (iomux:wait-until-fd-ready fd :write)
 199                           (iomux:poll-error ()))))
 200       (loop :until (buffer-emptyp) :do (write-or-return)
 201          :finally (return (values t bytes-written))))))
 202
 203 (defun %flush-obuf (buf fd &optional timeout)
 204   (declare (type iobuf buf))
 205   (let ((bytes-written 0))
 206     (labels ((write-once ()
 207                (let ((num (handler-case
 208                               (et:repeat-upon-condition-decreasing-timeout
 209                                   ((et:eintr) timeout-var timeout)
 210                                 (prog1
 211                                     (et:write fd (iobuf-start-pointer buf)
 212                                               (iobuf-length buf))
 213                                   (when (and timeout-var (zerop timeout-var))
 214                                     (return-from %flush-obuf (values nil :timeout)))))
 215                             (et:epipe ()
 216                               (return-from %flush-obuf (values nil :eof))))))
 217                  (unless (zerop num)
 218                    (incf (iobuf-start buf) num)
 219                    (incf bytes-written num))))
 220              (write-or-return ()
 221                (unless (write-once)
 222                  (when (errorp)
 223                    ;; FIXME signal something better -- maybe analyze the status
 224                    (return-from %flush-obuf (values nil :fail)))))
 225              (buffer-emptyp ()
 226                (when (iobuf-empty-p buf)
 227                  (iobuf-reset buf) t))
 228              (errorp () (handler-case (iomux:wait-until-fd-ready fd :write)
 229                           (iomux:poll-error ()))))
 230       (loop :until (buffer-emptyp) :do (write-or-return)
 231          :finally (return (values t bytes-written))))))
 232
 233 ;; TODO: add timeout support
 234 (defun %flush-obuf-if-needed (stream)
 235   (declare (type dual-channel-gray-stream stream))
 236   (with-accessors ((fd output-fd-of) (ob output-buffer-of)
 237                    (must-flush-output-p must-flush-output-p)) stream
 238     (when (or must-flush-output-p (iobuf-full-p ob))
 239       (%flush-obuf ob fd)
 240       (setf must-flush-output-p nil))))
 241
 242 (defmethod stream-clear-output ((stream dual-channel-gray-stream))
 243   (with-accessors ((ob output-buffer-of)
 244                    (must-flush-output-p must-flush-output-p)
 245                    (fd output-fd-of)) stream
 246     (iobuf-reset ob)
 247     (setf must-flush-output-p nil)
 248     nil))
 249
 250 (defmethod stream-finish-output ((stream dual-channel-gray-stream))
 251   (with-accessors ((ob output-buffer-of)
 252                    (must-flush-output-p must-flush-output-p)
 253                    (fd output-fd-of)) stream
 254     (%flush-obuf ob fd)
 255     (setf must-flush-output-p nil)
 256     nil))
 257
 258 (defmethod stream-force-output ((stream dual-channel-gray-stream))
 259   (setf (must-flush-output-p stream) t))
 260
 261 (defun %write-simple-array-ub8 (stream array start end)
 262   (declare (type dual-channel-gray-stream stream))
 263   (with-accessors ((ob output-buffer-of)
 264                    (fd output-fd-of)) stream
 265     (let ((octets-needed (- end start)))
 266       (if (<= octets-needed (iobuf-end-space-length ob))
 267           (progn
 268             (iobuf-copy-from-lisp-array array start ob
 269                                         (iobuf-end ob) octets-needed)
 270             (incf (iobuf-end ob) octets-needed)
 271             (%flush-obuf-if-needed stream))
 272           (with-pointer-to-vector-data (ptr array)
 273             (%flush-obuf ob fd)
 274             (let ((ret (%write-n-bytes (inc-pointer ptr start)
 275                                        fd octets-needed)))
 276               (when (numberp ret)
 277                 (incf (iobuf-end ob) octets-needed)))))
 278       (values array))))
 279
 280 (defun %write-vector-ub8 (stream vector start end)
 281   (declare (type dual-channel-gray-stream stream))
 282   (%write-simple-array-ub8 stream (coerce vector 'ub8-sarray) start end))
 283
 284 (defun %write-vector (stream vector start end)
 285   (declare (type dual-channel-gray-stream stream))
 286   (loop :for offset :from start :below end
 287         :for octet := (aref vector offset)
 288      :do (stream-write-byte stream octet)
 289      :finally (return vector)))
 290
 291 #-clisp
 292 (defmethod #-openmcl stream-write-sequence
 293            #+openmcl stream-write-vector
 294            #-lispworks
 295            ((stream dual-channel-gray-stream) seq
 296             &optional (start 0) end)
 297            #+lispworks
 298            ((stream dual-channel-gray-stream) seq start end)
 299   (setf (values start end) (%check-bounds seq start end))
 300   (when (< start end)
 301     (etypecase seq
 302       (ub8-sarray
 303        (%write-simple-array-ub8 stream seq start end))
 304       (string
 305        (stream-write-string stream seq start end))
 306       (ub8-vector
 307        (%write-vector-ub8 stream seq start end))
 308       (vector
 309        (%write-vector stream seq start end)))))
 310
 311 #+clisp
 312 (defmethod stream-write-byte-sequence ((stream dual-channel-gray-stream) seq
 313                                        &optional (start 0) end
 314                                        no-hang interactive)
 315   (declare (ignore no-hang interactive))
 316   (setf (values start end) (%check-bounds seq start end))
 317   (when (< start end)
 318     (etypecase seq
 319       (ub8-sarray
 320        (%write-simple-array-ub8 stream seq start end))
 321       (ub8-vector
 322        (%write-vector-ub8 stream seq start end))
 323       (vector
 324        (%write-vector stream seq start end)))))
 325
 326 #+clisp
 327 (defmethod stream-write-char-sequence ((stream dual-channel-gray-stream) seq
 328                                        &optional (start 0) end)
 329   (setf (values start end) (%check-bounds seq start end))
 330   (when (< start end)
 331     (etypecase seq
 332       (string
 333        (stream-write-string stream seq start end)))))
 334 \f
 335 ;;;;;;;;;;;;;;;;;;;;;
 336 ;;                 ;;
 337 ;; Character Input ;;
 338 ;;                 ;;
 339 ;;;;;;;;;;;;;;;;;;;;;
 340
 341 (defun maybe-find-line-ending (fd ib ef)
 342   (let* ((start-off (iobuf-start ib))
 343          (char-code (bref ib start-off)))
 344     (block nil
 345       (ecase (ioenc:ef-line-terminator ef)
 346         (:unix (when (= char-code (char-code #\Linefeed))
 347                  (incf (iobuf-start ib))
 348                  (return #\Newline)))
 349         (:mac (when (= char-code (char-code #\Return))
 350                 (incf (iobuf-start ib))
 351                 (return #\Newline)))
 352         (:dos (when (= char-code (char-code #\Return))
 353                 (when (and (= (iobuf-length ib) 1)
 354                            (eql (%fill-ibuf ib fd) :eof))
 355                   (incf (iobuf-start ib))
 356                   (return #\Return))
 357                 (when (= (bref ib (1+ start-off))
 358                          (char-code #\Linefeed))
 359                   (incf (iobuf-start ib) 2)
 360                   (return #\Newline))))))))
 361
 362 (define-constant +max-octets-per-char+ 6)
 363
 364 ;; FIXME: currently we return :EOF when read(2) returns 0
 365 ;;        we should distinguish hard end-of-files(EOF and buffer empty)
 366 ;;        from soft end-of-files(EOF and *some* bytes still in the buffer
 367 ;;        but not enough to make a full character)
 368 (defmethod stream-read-char ((stream dual-channel-gray-stream))
 369   (with-accessors ((fd input-fd-of) (ib input-buffer-of)
 370                    (unread-index ibuf-unread-index-of)
 371                    (ef external-format-of)) stream
 372     (flet ((decode-one-char (str ib ef)
 373              (ioenc::%octets-to-string (iobuf-data ib) str (iobuf-start ib)
 374                                        (iobuf-end ib) ef 1)))
 375       (setf unread-index (iobuf-start ib))
 376       (let ((str (make-string 1))
 377             (ret nil))
 378         (flet ((fill-buf-or-eof ()
 379                  (setf ret (%fill-ibuf ib fd))
 380                  (when (eql ret :eof)
 381                    (return-from stream-read-char :eof))))
 382           (cond ((zerop (iobuf-length ib))
 383                  (iobuf-reset ib)
 384                  (fill-buf-or-eof))
 385                 ;; Some encodings such as CESU or Java's modified UTF-8 take
 386                 ;; as much as 6 bytes per character. Make sure we have enough
 387                 ;; space to collect read-ahead bytes if required.
 388                 ((< 0 (iobuf-end-space-length ib) +max-octets-per-char+)
 389                  (iobuf-copy-data-to-start ib)
 390                  (setf unread-index 0)))
 391           ;; line-end handling
 392           (return-if stream-read-char (maybe-find-line-ending fd ib ef))
 393           (tagbody :start
 394              (handler-case
 395                  (setf ret (nth-value 1 (decode-one-char str ib ef)))
 396                (end-of-input-in-character ()
 397                  (fill-buf-or-eof)
 398                  (go :start)))
 399              (incf (iobuf-start ib) ret))
 400           (char str 0))))))
 401
 402 (defun maybe-find-line-ending-no-hang (fd ib ef)
 403   (declare (ignore fd))
 404   (let* ((start-off (iobuf-start ib))
 405          (char-code (bref ib start-off)))
 406     (block nil
 407       (ecase (ioenc:ef-line-terminator ef)
 408         (:unix (when (= char-code (char-code #\Linefeed))
 409                  (incf (iobuf-start ib))
 410                  (return #\Newline)))
 411         (:mac (when (= char-code (char-code #\Return))
 412                 (incf (iobuf-start ib))
 413                 (return #\Newline)))
 414         (:dos (when (= char-code (char-code #\Return))
 415                 (when (= (iobuf-length ib) 1)
 416                   (incf (iobuf-start ib))
 417                   (return :starvation))
 418                 (when (= (bref ib (1+ start-off))
 419                          (char-code #\Linefeed))
 420                   (incf (iobuf-start ib) 2)
 421                   (return #\Newline))))))))
 422
 423 (defmethod stream-read-char-no-hang ((stream dual-channel-gray-stream))
 424   (with-accessors ((fd input-fd-of) (ib input-buffer-of)
 425                    (ef external-format-of)) stream
 426     (let ((str (make-string 1))
 427           (ret nil)
 428           (eof nil))
 429       (block nil
 430         (when (< 0 (iobuf-end-space-length ib) 4)
 431           (iobuf-copy-data-to-start ib))
 432         (when (and (iomux:fd-ready-p fd :read)
 433                    (eql :eof (%fill-ibuf ib fd)))
 434           (setf eof t))
 435         (when (zerop (iobuf-length ib))
 436           (return (if eof :eof nil)))
 437         ;; line-end handling
 438         (let ((line-end
 439                (maybe-find-line-ending-no-hang fd ib ef)))
 440           (cond ((eql line-end :starvation)
 441                  (return (if eof #\Return nil)))
 442                 ((characterp line-end)
 443                  (return line-end))))
 444         ;; octet decoding
 445         (handler-case
 446             (setf ret (nth-value 1 (ioenc::%octets-to-string
 447                                     (iobuf-data ib) str
 448                                     (iobuf-start ib)
 449                                     (iobuf-end ib) ef 1)))
 450           (end-of-input-in-character ()
 451             (return nil)))
 452         (incf (iobuf-start ib) ret)
 453         (char str 0)))))
 454
 455 (defun %stream-unread-char (stream)
 456   (declare (type dual-channel-gray-stream stream))
 457   (with-accessors ((ib input-buffer-of)
 458                    (unread-index ibuf-unread-index-of)) stream
 459     (symbol-macrolet ((start (iobuf-start ib)))
 460       (cond
 461         ((> start unread-index)
 462          (setf start unread-index))
 463         (t
 464          (error "No uncommitted character to unread")))))
 465   nil)
 466
 467 (defmethod stream-unread-char ((stream dual-channel-gray-stream) character)
 468   ;; unreading anything but the latest character is wrong,
 469   ;; but checking is not mandated by the standard
 470   #+iolib-debug
 471   (progn
 472     (%stream-unread-char stream)
 473     (unless (ignore-errors (eql (stream-read-char stream) character))
 474       (error "Trying to unread wrong character ~S" character)))
 475   #-iolib-debug
 476   (declare (ignore character))
 477   #-iolib-debug
 478   (%stream-unread-char stream))
 479
 480 (defmethod stream-peek-char ((stream dual-channel-gray-stream))
 481   (let ((char (stream-read-char stream)))
 482     (cond ((eql char :eof) :eof)
 483           (t (%stream-unread-char stream)
 484              (values char)))))
 485
 486 ;; (defmethod stream-read-line ((stream dual-channel-gray-stream))
 487 ;;   )
 488
 489 (defmethod stream-listen ((stream dual-channel-gray-stream))
 490   (let ((char (stream-read-char-no-hang stream)))
 491     (cond ((characterp char)
 492            (stream-unread-char stream char)
 493            t)
 494           ((eql char :eof)
 495            nil)
 496           (t t))))
 497 \f
 498 ;;;;;;;;;;;;;;;;;;;;;;
 499 ;;                  ;;
 500 ;; Character Output ;;
 501 ;;                  ;;
 502 ;;;;;;;;;;;;;;;;;;;;;;
 503
 504 (defmethod stream-write-char ((stream dual-channel-gray-stream)
 505                               (character character))
 506   (%flush-obuf-if-needed stream)
 507   (if (char= character #\Newline)
 508       (%write-line-terminator stream (ioenc:ef-line-terminator (external-format-of stream)))
 509       ;; FIXME: avoid consing a string here. At worst, declare it dynamic-extent
 510       (stream-write-string stream (make-string 1 :initial-element character))))
 511
 512 (defmethod stream-line-column ((stream dual-channel-gray-stream))
 513   0)
 514
 515 (defmethod stream-start-line-p ((stream dual-channel-gray-stream))
 516   (values nil))
 517
 518 (defmethod stream-terpri ((stream dual-channel-gray-stream))
 519   (write-char #\Newline stream) nil)
 520
 521 (defmethod stream-fresh-line ((stream dual-channel-gray-stream))
 522   (write-char #\Newline stream) t)
 523
 524 (define-constant +unix-line-terminator+
 525     (make-array 1 :element-type 'ub8 :initial-contents '(10)))
 526 (define-constant +dos-line-terminator+
 527     (make-array 2 :element-type 'ub8 :initial-contents '(13 10)))
 528 (define-constant +mac-line-terminator+
 529     (make-array 1 :element-type 'ub8 :initial-contents '(13)))
 530
 531 (defun %write-line-terminator (stream line-terminator)
 532   (case line-terminator
 533     (:unix (%write-simple-array-ub8 stream +unix-line-terminator+ 0 1))
 534     (:dos  (%write-simple-array-ub8 stream +dos-line-terminator+  0 2))
 535     (:mac  (%write-simple-array-ub8 stream +mac-line-terminator+  0 1))))
 536
 537 (defmethod stream-write-string ((stream dual-channel-gray-stream)
 538                                 (string string)
 539                                 &optional (start 0) end)
 540   (setf (values start end) (%check-bounds string start end))
 541   (when (< start end)
 542     (let* ((octets nil)
 543            (ef (external-format-of stream))
 544            (line-terminator (ioenc:ef-line-terminator ef)))
 545       (loop :for off1 := start :then (1+ off2)
 546             :for nl-off := (position #\Newline string :start off1)
 547             :for off2 := (or nl-off end)
 548          :when nl-off :do (%write-line-terminator stream line-terminator)
 549          :when (> off2 off1) :do
 550          (setf octets (ioenc:string-to-octets
 551                        string :start off1 :end off2
 552                        :external-format ef))
 553          (%write-simple-array-ub8 stream octets 0 (length octets))
 554          :while (< off2 end))))
 555   (values string))
 556 \f
 557 ;;;;;;;;;;;;;;;;;;
 558 ;;              ;;
 559 ;; Binary Input ;;
 560 ;;              ;;
 561 ;;;;;;;;;;;;;;;;;;
 562
 563 (defmethod stream-read-byte ((stream dual-channel-gray-stream))
 564   (with-accessors ((fd input-fd-of)
 565                    (ib input-buffer-of)) stream
 566     (flet ((fill-buf-or-eof ()
 567              (iobuf-reset ib)
 568              (when (eql :eof (%fill-ibuf ib fd))
 569                (return-from stream-read-byte :eof))))
 570       (when (zerop (iobuf-length ib))
 571         (fill-buf-or-eof))
 572       (iobuf-pop-octet ib))))
 573 \f
 574 ;;;;;;;;;;;;;;;;;;;
 575 ;;               ;;
 576 ;; Binary Output ;;
 577 ;;               ;;
 578 ;;;;;;;;;;;;;;;;;;;
 579
 580 (defmethod stream-write-byte ((stream dual-channel-gray-stream) integer)
 581   (check-type integer ub8 "an unsigned 8-bit value")
 582   (with-accessors ((ob output-buffer-of)) stream
 583     (%flush-obuf-if-needed stream)
 584     (iobuf-push-octet ob integer)))