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 (defconstant +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
  20 (deftype iobuf-data-vector () 'ub8-simple-vector)
  21
  22 (defstruct (iobuf (:constructor %make-iobuf (data)))
  23   (lock  (bt:make-lock "IObuf lock") :read-only t)
  24   (data  nil :type iobuf-data-vector :read-only t)
  25   (start   0 :type iobuf-index)
  26   (end     0 :type iobuf-index))
  27
  28 (defun make-iobuf-data-vector (size)
  29   (declare (type iobuf-index size))
  30   (make-array size :element-type 'ub8 :initial-element 0))
  31
  32 (defun make-iobuf (&optional (size +default-iobuf-size+))
  33   (check-type size iobuf-index)
  34   (%make-iobuf (make-iobuf-data-vector size)))
  35
  36 (defun iobuf-size (iobuf)
  37   (declare (type iobuf iobuf))
  38   (the iobuf-index (length (iobuf-data iobuf))))
  39
  40 (defun iobuf-available-octets (iobuf)
  41   (declare (type iobuf iobuf))
  42   (- (iobuf-end iobuf)
  43      (iobuf-start iobuf)))
  44
  45 (defun iobuf-available-space (iobuf)
  46   (declare (type iobuf iobuf))
  47   (- (iobuf-size iobuf)
  48      (iobuf-end iobuf)))
  49
  50 (defun iobuf-empty-p (iobuf)
  51   (declare (type iobuf iobuf))
  52   (zerop (iobuf-available-octets iobuf)))
  53
  54 (defun iobuf-full-p (iobuf)
  55   (declare (type iobuf iobuf))
  56   (zerop (iobuf-available-space iobuf)))
  57
  58 (defun iobuf-reset (iobuf)
  59   (declare (type iobuf iobuf))
  60   (setf (iobuf-start iobuf) 0
  61         (iobuf-end iobuf)   0))
  62
  63 (defun iobuf-next-data-zone (iobuf)
  64   (declare (type iobuf iobuf))
  65   (values (iobuf-data iobuf)
  66           (iobuf-start iobuf)
  67           (iobuf-end iobuf)))
  68
  69 (defun iobuf-next-empty-zone (iobuf)
  70   (declare (type iobuf iobuf))
  71   (values (iobuf-data iobuf)
  72           (iobuf-end iobuf)
  73           (iobuf-size iobuf)))
  74 \f
  75
  76 ;;;-------------------------------------------------------------------------
  77 ;;; UNSAFE functions which *DO NOT* check boundaries
  78 ;;; that must be done by their callers
  79 ;;;-------------------------------------------------------------------------
  80
  81 (defun bref (iobuf index)
  82   (declare (type iobuf iobuf)
  83            (type iobuf-index index))
  84   (aref (iobuf-data iobuf) index))
  85
  86 (defun (setf bref) (octet iobuf index)
  87   (declare (type ub8 octet)
  88            (type iobuf iobuf)
  89            (type iobuf-index index))
  90   (setf (aref (iobuf-data iobuf) index) octet))
  91
  92 (defun iobuf-pop-octet (iobuf)
  93   (declare (type iobuf iobuf))
  94   (let ((start (iobuf-start iobuf)))
  95     (prog1 (bref iobuf start)
  96       (setf (iobuf-start iobuf) (1+ start)))))
  97
  98 (defun iobuf-push-octet (iobuf octet)
  99   (declare (type iobuf iobuf)
 100            (type ub8 octet))
 101   (let ((end (iobuf-end iobuf)))
 102     (prog1 (setf (bref iobuf end) octet)
 103       (setf (iobuf-end iobuf) (1+ end)))))
 104
 105 (defun replace-ub8sv->ub8sv (destination source start1 end1 start2 end2)
 106   (declare (type ub8-simple-vector destination source)
 107            (type iobuf-index start1 start2 end1 end2))
 108   (let ((nbytes (min (- end1 start1)
 109                      (- end2 start2))))
 110     (replace destination source
 111              :start1 start1 :end1 end1
 112              :start2 start2 :end2 end2)
 113     (values nbytes)))
 114
 115 (defun replace-ub8sv->ub8cv (destination source start1 end1 start2 end2)
 116   (declare (type ub8-simple-vector source)
 117            (type ub8-complex-vector destination)
 118            (type iobuf-index start1 start2 end1 end2))
 119   (let ((nbytes (min (- end1 start1)
 120                      (- end2 start2))))
 121     (replace destination source
 122              :start1 start1 :end1 end1
 123              :start2 start2 :end2 end2)
 124     (values nbytes)))
 125
 126 (defun replace-ub8cv->ub8sv (destination source start1 end1 start2 end2)
 127   (declare (type ub8-complex-vector source)
 128            (type ub8-simple-vector destination)
 129            (type iobuf-index start1 start2 end1 end2))
 130   (let ((nbytes (min (- end1 start1)
 131                      (- end2 start2))))
 132     (replace destination source
 133              :start1 start1 :end1 end1
 134              :start2 start2 :end2 end2)
 135     (values nbytes)))
 136
 137 (defun iobuf->vector (iobuf vector start end)
 138   (declare (type iobuf iobuf)
 139            (type ub8-vector vector)
 140            (type iobuf-index start end))
 141   (when (iobuf-empty-p iobuf)
 142     (iobuf-reset iobuf))
 143   (multiple-value-bind (iobuf-data data-start data-end)
 144       (iobuf-next-data-zone iobuf)
 145     (declare (type iobuf-index data-start data-end))
 146     (let ((nbytes
 147            (etypecase vector
 148              (ub8-simple-vector
 149               (replace-ub8sv->ub8sv vector iobuf-data
 150                                     start end
 151                                     data-start data-end))
 152              (ub8-complex-vector
 153               (replace-ub8sv->ub8cv vector iobuf-data
 154                                     start end
 155                                     data-start data-end)))))
 156       (setf (iobuf-start iobuf) (+ data-start (the iobuf-index nbytes)))
 157       (values nbytes))))
 158
 159 (defun vector->iobuf (iobuf vector start end)
 160   (declare (type iobuf iobuf)
 161            (type ub8-vector vector)
 162            (type iobuf-index start end))
 163   (when (iobuf-empty-p iobuf)
 164     (iobuf-reset iobuf))
 165   (multiple-value-bind (iobuf-data data-start data-end)
 166       (iobuf-next-empty-zone iobuf)
 167     (declare (type iobuf-index data-start data-end))
 168     (let ((nbytes
 169            (etypecase vector
 170              (ub8-simple-vector
 171               (replace-ub8sv->ub8sv iobuf-data vector
 172                                     data-start data-end
 173                                     start end))
 174              (ub8-complex-vector
 175               (replace-ub8cv->ub8sv iobuf-data vector
 176                                     data-start data-end
 177                                     start end)))))
 178       (setf (iobuf-end iobuf) (+ data-start (the iobuf-index nbytes)))
 179       (values nbytes))))