io.streams/zeta/buffer.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- Device buffers.
   4 ;;;
   5
   6 (in-package :io.zeta-streams)
   7
   8 (defclass filter (dual-channel-device) ())
   9
  10 (defclass device-buffer (filter)
  11   ((input-buffer :initarg :input-buffer :accessor input-buffer-of)
  12    (output-buffer :initarg :output-buffer :accessor output-buffer-of)))
  13
  14 (defmethod initialize-instance :after ((filter filter) &key
  15                                        input-buffer-size output-buffer-size)
  16   (if (input-buffer-of filter)
  17       (check-type (input-buffer-of filter) iobuf)
  18       (setf (input-buffer-of filter) (make-iobuf input-buffer-size)))
  19   (if (output-buffer-of filter)
  20       (check-type (output-buffer-of filter) iobuf)
  21       (setf (output-buffer-of filter) (make-iobuf output-buffer-size))))
  22 \f
  23
  24 ;;;-----------------------------------------------------------------------------
  25 ;;; Buffered DEVICE-READ
  26 ;;;-----------------------------------------------------------------------------
  27
  28 (defmethod device-read ((device device-buffer) buffer start end &optional (timeout nil timeoutp))
  29   (when (= start end) (return-from device-read 0))
  30   (let* ((timeout (if timeoutp timeout (input-timeout-of (input-handle-of device))))
  31          (nbytes (read-octets/buffered (input-handle-of device) buffer start end timeout)))
  32     (cond
  33       ((eql :eof nbytes) (return-from device-read :eof))
  34       ((plusp nbytes) (incf (device-position device) nbytes)))
  35     (values nbytes)))
  36
  37 (defun fill-input-buffer (input-handle input-buffer timeout)
  38   (declare (type device input-handle)
  39            (type iobuf input-buffer)
  40            (type device-timeout timeout))
  41   (device-read input-handle (iobuf-data input-buffer)
  42                (iobuf-end input-buffer) (iobuf-size input-buffer)
  43                timeout))
  44
  45 (defun read-octets/buffered (device buffer start end timeout)
  46   (declare (type device-buffer device)
  47            (type iobuf-buffer buffer)
  48            (type iobuf-index start end)
  49            (type device-timeout timeout))
  50   (with-accessors ((input-handle input-handle-of)
  51                    (input-buffer input-buffer-of))
  52       device
  53     (cond
  54       ((iobuf-empty-p input-buffer)
  55        (iobuf-reset input-buffer)
  56        (let ((nbytes (fill-input-buffer input-handle input-buffer timeout)))
  57          (if (iobuf-empty-p input-buffer)
  58              (if (eql :eof nbytes) :eof 0)
  59              (iobuf->array buffer input-buffer start end))))
  60       (t
  61        (iobuf->array buffer input-buffer start end)))))
  62 \f
  63
  64 ;;;-----------------------------------------------------------------------------
  65 ;;; Buffered DEVICE-WRITE
  66 ;;;-----------------------------------------------------------------------------
  67
  68 (defmethod device-write ((device device-buffer) buffer start end &optional (timeout nil timeoutp))
  69   (when (= start end) (return-from device-write 0))
  70   (let* ((timeout (if timeoutp timeout (output-timeout-of (output-handle-of device))))
  71          (nbytes (write-octets/buffered (output-handle-of device) buffer start end timeout)))
  72     (cond
  73       ((eql :eof nbytes) (return-from device-write :eof))
  74       ((plusp nbytes) (incf (device-position device) nbytes)))
  75     (values nbytes)))