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 ;;;-----------------------------------------------------------------------------
   9 ;;; Buffer Classes and Types
  10 ;;;-----------------------------------------------------------------------------
  11
  12 (defclass buffer (device)
  13   ((single-channel :initarg :single-channel :accessor single-channel-buffer-p)
  14    (input-buffer :initarg :input-buffer :accessor input-buffer-of)
  15    (output-buffer :initarg :output-buffer :accessor output-buffer-of)))
  16 \f
  17
  18 ;;;-----------------------------------------------------------------------------
  19 ;;; Buffer Constructors
  20 ;;;-----------------------------------------------------------------------------
  21
  22 (defmethod initialize-instance :after ((buffer buffer) &key single-channel
  23                                        input-buffer-size output-buffer-size)
  24   (if (input-buffer-of buffer)
  25       (check-type (input-buffer-of buffer) iobuf)
  26       (setf (input-buffer-of buffer) (make-iobuf input-buffer-size)))
  27   (unless single-channel
  28     (if (output-buffer-of buffer)
  29         (check-type (output-buffer-of buffer) iobuf)
  30         (setf (output-buffer-of buffer) (make-iobuf output-buffer-size)))))
  31 \f
  32
  33 ;;;-----------------------------------------------------------------------------
  34 ;;; Buffer Generic Functions
  35 ;;;-----------------------------------------------------------------------------
  36
  37 (defgeneric buffer-clear-input (buffer))
  38
  39 (defgeneric buffer-clear-output (buffer))
  40
  41 (defgeneric buffer-flush-output (buffer &optional timeout))
  42 \f
  43
  44 ;;;-----------------------------------------------------------------------------
  45 ;;; Buffer DEVICE-READ
  46 ;;;-----------------------------------------------------------------------------
  47
  48 (defmethod device-read ((device buffer) buffer start end &optional timeout)
  49   (when (= start end) (return-from device-read 0))
  50   (read-octets/buffered device buffer start end timeout))
  51
  52 (defun read-octets/buffered (buffer vector start end timeout)
  53   (declare (type buffer buffer)
  54            (type ub8-simple-vector vector)
  55            (type iobuf-index start end)
  56            (type device-timeout timeout))
  57   (with-accessors ((input-handle input-handle-of)
  58                    (input-buffer input-buffer-of))
  59       buffer
  60     (cond
  61       ((iobuf-empty-p input-buffer)
  62        (let ((nbytes (fill-input-buffer input-handle input-buffer timeout)))
  63          (if (iobuf-empty-p input-buffer)
  64              (if (eql :eof nbytes) :eof 0)
  65              (iobuf->vector input-buffer vector start end))))
  66       (t
  67        (iobuf->vector input-buffer vector start end)))))
  68
  69 (defun fill-input-buffer (input-handle input-buffer timeout)
  70   (multiple-value-bind (data start end)
  71       (iobuf-next-empty-zone input-buffer)
  72     (device-read input-handle data start end timeout)))
  73 \f
  74
  75 ;;;-----------------------------------------------------------------------------
  76 ;;; Buffer DEVICE-WRITE
  77 ;;;-----------------------------------------------------------------------------
  78
  79 (defmethod device-write ((device buffer) buffer start end &optional timeout)
  80   (when (= start end) (return-from device-write 0))
  81   (write-octets/buffered device buffer start end timeout))
  82
  83 (defun write-octets/buffered (buffer vector start end timeout)
  84   (declare (type buffer buffer)
  85            (type ub8-simple-vector vector)
  86            (type iobuf-index start end)
  87            (type device-timeout timeout))
  88   (with-accessors ((output-handle output-handle-of)
  89                    (output-buffer output-buffer-of))
  90       buffer
  91     (vector->iobuf output-buffer vector start end)
  92     (when (iobuf-full-p output-buffer)
  93       (flush-output-buffer output-handle output-buffer timeout))))
  94
  95 (defun flush-output-buffer (output-handle output-buffer timeout)
  96   (multiple-value-bind (data start end)
  97       (iobuf-next-data-zone output-buffer)
  98     (device-write output-handle data start end timeout)))
  99 \f
 100
 101 ;;;-----------------------------------------------------------------------------
 102 ;;; Buffer cleaning
 103 ;;;-----------------------------------------------------------------------------
 104
 105 (defmethod buffer-clear-input ((buffer buffer))
 106   (iobuf-reset (input-buffer-of buffer)))
 107
 108 (defmethod buffer-clear-output ((buffer buffer))
 109   (iobuf-reset (output-buffer-of buffer)))
 110
 111 (defmethod buffer-flush-output ((buffer buffer) &optional timeout)
 112   (with-accessors ((output-handle output-handle-of)
 113                    (output-buffer output-buffer-of))
 114       buffer
 115     (flush-output-buffer output-handle output-buffer timeout)
 116     (iobuf-available-octets output-buffer)))