src/streams/zeta/iobuf.lisp

   1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- I/O buffers.
   4 ;;;
   5
   6 (in-package :iolib.zstreams)
   7
   8 (eval-when (:compile-toplevel)
   9   (declaim (optimize speed)))
  10
  11 ;;;-------------------------------------------------------------------------
  12 ;;; Foreign Buffers
  13 ;;;-------------------------------------------------------------------------
  14
  15 (defconstant +default-iobuf-size+ (* 8 1024))
  16
  17 ;; almost 128 MB: large enough for a stream buffer,
  18 ;; but small enough to fit into a fixnum
  19 (deftype iobuf-index () '(unsigned-byte 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 +default-iobuf-size+))
  34   (check-type size iobuf-index)
  35   (%make-iobuf (make-iobuf-data-vector size)))
  36
  37 (defun iobuf-size (iobuf)
  38   (declare (type iobuf iobuf))
  39   (the iobuf-index (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-available-space (iobuf)
  47   (declare (type iobuf iobuf))
  48   (- (iobuf-size iobuf)
  49      (iobuf-end iobuf)))
  50
  51 (defun iobuf-empty-p (iobuf)
  52   (declare (type iobuf iobuf))
  53   (zerop (iobuf-available-octets iobuf)))
  54
  55 (defun iobuf-full-p (iobuf)
  56   (declare (type iobuf iobuf))
  57   (zerop (iobuf-available-space iobuf)))
  58
  59 (defun iobuf-reset (iobuf)
  60   (declare (type iobuf iobuf))
  61   (setf (iobuf-start iobuf) 0
  62         (iobuf-end iobuf)   0))
  63
  64 (defun iobuf-next-data-zone (iobuf)
  65   (declare (type iobuf iobuf))
  66   (values (iobuf-data iobuf)
  67           (iobuf-start iobuf)
  68           (iobuf-end iobuf)))
  69
  70 (defun iobuf-next-empty-zone (iobuf)
  71   (declare (type iobuf iobuf))
  72   (values (iobuf-data iobuf)
  73           (iobuf-end iobuf)
  74           (iobuf-size iobuf)))
  75 \f
  76
  77 ;;;-------------------------------------------------------------------------
  78 ;;; UNSAFE functions which *DO NOT* check boundaries
  79 ;;; that must be done by their callers
  80 ;;;-------------------------------------------------------------------------
  81
  82 (defun bref (iobuf index)
  83   (declare (type iobuf iobuf)
  84            (type iobuf-index index))
  85   (aref (iobuf-data iobuf) index))
  86
  87 (defun (setf bref) (octet iobuf index)
  88   (declare (type ub8 octet)
  89            (type iobuf iobuf)
  90            (type iobuf-index index))
  91   (setf (aref (iobuf-data iobuf) index) octet))
  92
  93 (defun iobuf-pop-octet (iobuf)
  94   (declare (type iobuf iobuf))
  95   (let ((start (iobuf-start iobuf)))
  96     (prog1 (bref iobuf start)
  97       (setf (iobuf-start iobuf) (1+ start)))))
  98
  99 (defun iobuf-push-octet (iobuf octet)
 100   (declare (type iobuf iobuf)
 101            (type ub8 octet))
 102   (let ((end (iobuf-end iobuf)))
 103     (prog1 (setf (bref iobuf end) octet)
 104       (setf (iobuf-end iobuf) (1+ end)))))
 105
 106 (defun replace-ub8sv->ub8sv (destination source start1 end1 start2 end2)
 107   (declare (type ub8-simple-vector destination source)
 108            (type iobuf-index start1 start2 end1 end2))
 109   (let ((nbytes (min (- end1 start1)
 110                      (- end2 start2))))
 111     (replace destination source
 112              :start1 start1 :end1 end1
 113              :start2 start2 :end2 end2)
 114     (values nbytes)))
 115
 116 (defun replace-ub8sv->ub8cv (destination source start1 end1 start2 end2)
 117   (declare (type ub8-simple-vector source)
 118            (type ub8-complex-vector destination)
 119            (type iobuf-index start1 start2 end1 end2))
 120   (let ((nbytes (min (- end1 start1)
 121                      (- end2 start2))))
 122     (replace destination source
 123              :start1 start1 :end1 end1
 124              :start2 start2 :end2 end2)
 125     (values nbytes)))
 126
 127 (defun replace-ub8cv->ub8sv (destination source start1 end1 start2 end2)
 128   (declare (type ub8-complex-vector source)
 129            (type ub8-simple-vector destination)
 130            (type iobuf-index start1 start2 end1 end2))
 131   (let ((nbytes (min (- end1 start1)
 132                      (- end2 start2))))
 133     (replace destination source
 134              :start1 start1 :end1 end1
 135              :start2 start2 :end2 end2)
 136     (values nbytes)))
 137
 138 (defun iobuf->vector (iobuf vector start end)
 139   (declare (type iobuf iobuf)
 140            (type ub8-vector vector)
 141            (type iobuf-index start end))
 142   (when (iobuf-empty-p iobuf)
 143     (iobuf-reset iobuf))
 144   (multiple-value-bind (iobuf-data data-start data-end)
 145       (iobuf-next-data-zone iobuf)
 146     (declare (type iobuf-index data-start data-end))
 147     (let ((nbytes
 148            (etypecase vector
 149              (ub8-simple-vector
 150               (replace-ub8sv->ub8sv vector iobuf-data
 151                                     start end
 152                                     data-start data-end))
 153              (ub8-complex-vector
 154               (replace-ub8sv->ub8cv vector iobuf-data
 155                                     start end
 156                                     data-start data-end)))))
 157       (setf (iobuf-start iobuf) (+ data-start (the iobuf-index nbytes)))
 158       (values nbytes))))
 159
 160 (defun vector->iobuf (iobuf vector start end)
 161   (declare (type iobuf iobuf)
 162            (type ub8-vector vector)
 163            (type iobuf-index start end))
 164   (when (iobuf-empty-p iobuf)
 165     (iobuf-reset iobuf))
 166   (multiple-value-bind (iobuf-data data-start data-end)
 167       (iobuf-next-empty-zone iobuf)
 168     (declare (type iobuf-index data-start data-end))
 169     (let ((nbytes
 170            (etypecase vector
 171              (ub8-simple-vector
 172               (replace-ub8sv->ub8sv iobuf-data vector
 173                                     data-start data-end
 174                                     start end))
 175              (ub8-complex-vector
 176               (replace-ub8cv->ub8sv iobuf-data vector
 177                                     data-start data-end
 178                                     start end)))))
 179       (setf (iobuf-end iobuf) (+ data-start (the iobuf-index nbytes)))
 180       (values nbytes))))