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