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