io.streams/gray/gray-stream-methods.lisp

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