io.streams/zeta/iobuf.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- I/O buffers.
   4 ;;;
   5
   6 (in-package :io.zeta-streams)
   7
   8 (declaim (optimize speed))
   9
  10 ;;;-------------------------------------------------------------------------
  11 ;;; Foreign Buffers
  12 ;;;-------------------------------------------------------------------------
  13
  14 (define-constant +default-iobuf-size+ (* 8 1024))
  15
  16 ;; almost 128 MB: large enough for a stream buffer,
  17 ;; but small enough to fit into a fixnum
  18 (deftype iobuf-index () '(unsigned-byte 27))
  19 (deftype iobuf-length () '(integer 0 #.(expt 2 27)))
  20
  21 (deftype iobuf-data-vector () 'ub8-simple-vector)
  22
  23 (defstruct (iobuf (:constructor %make-iobuf (data)))
  24   (lock (bt:make-lock "IObuf lock") :read-only t)
  25   (data nil :type iobuf-data-vector :read-only t)
  26   (start 0 :type iobuf-index)
  27   (end 0 :type iobuf-index))
  28
  29 (defun make-iobuf-data-vector (size)
  30   (declare (type iobuf-index size))
  31   (make-array size :element-type 'ub8 :initial-element 0))
  32
  33 (defun make-iobuf (&optional size)
  34   (check-type size (or null iobuf-index))
  35   (%make-iobuf (make-iobuf-data-vector (or size +default-iobuf-size+))))
  36
  37 (defun iobuf-size (iobuf)
  38   (declare (type iobuf iobuf))
  39   (length (iobuf-data iobuf)))
  40
  41 (defun iobuf-available-octets (iobuf)
  42   (declare (type iobuf iobuf))
  43   (- (iobuf-end iobuf)
  44      (iobuf-start iobuf)))
  45
  46 (defun iobuf-empty-p (iobuf)
  47   (declare (type iobuf iobuf))
  48   (zerop (iobuf-available-octets iobuf)))
  49
  50 (defun iobuf-full-p (iobuf)
  51   (declare (type iobuf iobuf))
  52   (= (iobuf-end iobuf)
  53      (iobuf-size iobuf)))
  54
  55 (defun iobuf-reset (iobuf)
  56   (declare (type iobuf iobuf))
  57   (setf (iobuf-start iobuf) 0
  58         (iobuf-end iobuf)   0))
  59
  60 (defun iobuf-next-data-zone (iobuf)
  61   (declare (type iobuf iobuf))
  62   (values (iobuf-data iobuf)
  63           (iobuf-start iobuf)
  64           (iobuf-end iobuf)))
  65
  66 (defun iobuf-next-empty-zone (iobuf)
  67   (declare (type iobuf iobuf))
  68   (values (iobuf-data iobuf)
  69           (iobuf-end iobuf)
  70           (iobuf-size iobuf)))
  71 \f
  72
  73 ;;;-------------------------------------------------------------------------
  74 ;;; UNSAFE functions which *DO NOT* check boundaries
  75 ;;; that must be done by their callers
  76 ;;;-------------------------------------------------------------------------
  77
  78 (defun bref (iobuf index)
  79   (declare (type iobuf iobuf)
  80            (type iobuf-index index))
  81   (aref (iobuf-data iobuf) index))
  82
  83 (defun (setf bref) (octet iobuf index)
  84   (declare (type ub8 octet)
  85            (type iobuf iobuf)
  86            (type iobuf-index index))
  87   (setf (aref (iobuf-data iobuf) index) octet))
  88
  89 (defun iobuf-pop-octet (iobuf)
  90   (declare (type iobuf iobuf))
  91   (let ((start (iobuf-start iobuf)))
  92     (prog1 (bref iobuf start)
  93       (setf (iobuf-start iobuf) (1+ start)))))
  94
  95 (defun iobuf-push-octet (iobuf octet)
  96   (declare (type iobuf iobuf)
  97            (type ub8 octet))
  98   (let ((end (iobuf-end iobuf)))
  99     (prog1 (setf (bref iobuf end) octet)
 100       (setf (iobuf-end iobuf) (1+ end)))))
 101
 102 (defun replace-ub8 (destination source start1 end1 start2 end2)
 103   (declare (type ub8-simple-vector destination source)
 104            (type iobuf-index start1 start2 end1 end2))
 105   (let ((nbytes (min (- end1 start1)
 106                      (- end2 start2))))
 107     (replace destination source
 108              :start1 start1 :end1 end1
 109              :start2 start2 :end2 end2)
 110     (values nbytes)))
 111
 112 (defun iobuf->vector (iobuf vector start end)
 113   (declare (type iobuf iobuf)
 114            (type ub8-simple-vector vector)
 115            (type iobuf-index start end))
 116   (when (iobuf-empty-p iobuf)
 117     (iobuf-reset iobuf))
 118   (multiple-value-bind (iobuf-data data-start data-end)
 119       (iobuf-next-data-zone iobuf)
 120     (let ((nbytes
 121            (replace-ub8 vector iobuf-data start end data-start data-end)))
 122       (setf (iobuf-start iobuf) (+ data-start nbytes))
 123       (values nbytes))))
 124
 125 (defun vector->iobuf (iobuf vector start end)
 126   (declare (type iobuf iobuf)
 127            (type ub8-simple-vector vector)
 128            (type iobuf-index start end))
 129   (when (iobuf-empty-p iobuf)
 130     (iobuf-reset iobuf))
 131   (multiple-value-bind (iobuf-data data-start data-end)
 132       (iobuf-next-empty-zone iobuf)
 133     (let ((nbytes
 134            (replace-ub8 iobuf-data vector data-start data-end start end)))
 135       (setf (iobuf-end iobuf) (+ data-start nbytes))
 136       (values nbytes))))