io.streams/zeta/internal.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- Foreign memory buffers.
   4 ;;;
   5
   6 (in-package :io.zeta-streams)
   7
   8 (declaim (optimize speed))
   9
  10 ;;;; Foreign Buffers
  11
  12 (define-constant +default-iobuf-size+ 4096)
  13
  14 ;;; almost 128 MB: large enough for a stream buffer,
  15 ;;; but small enough to fit into a fixnum
  16 (deftype iobuf-index () '(unsigned-byte 27))
  17 (deftype iobuf-length () '(integer 0 #.(expt 2 27)))
  18
  19 (deftype iobuf-buffer () 'ub8-sarray)
  20
  21 (defparameter *empty-array* (make-array 0 :element-type 'ub8))
  22
  23 (defstruct (iobuf (:constructor %make-iobuf ()))
  24   (data *empty-array* :type iobuf-buffer)
  25   (start 0 :type iobuf-index)
  26   (end 0 :type iobuf-index))
  27
  28 (defun make-iobuf (&optional size)
  29   (declare (type (or null iobuf-index) size))
  30   (let ((b (%make-iobuf)))
  31     (setf (iobuf-data b) (make-array (or size +default-iobuf-size+)
  32                                      :element-type 'ub8
  33                                      :initial-element 0))
  34     (values b)))
  35
  36 (defun iobuf-size (iobuf)
  37   (declare (type iobuf iobuf))
  38   (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-empty-p (iobuf)
  46   (declare (type iobuf iobuf))
  47   (= (iobuf-start iobuf)
  48      (iobuf-end iobuf)))
  49
  50 (defun iobuf-reset (iobuf)
  51   (declare (type iobuf iobuf))
  52   (setf (iobuf-start iobuf) 0
  53         (iobuf-end iobuf)   0))
  54 \f
  55
  56 ;;;
  57 ;;; UNSAFE functions which *DO NOT* check boundaries
  58 ;;; that must be done by their callers
  59 ;;;
  60
  61 (defun bref (iobuf index)
  62   (declare (type iobuf iobuf)
  63            (type iobuf-index index))
  64   (aref (iobuf-data iobuf) index))
  65
  66 (defun (setf bref) (octet iobuf index)
  67   (declare (type ub8 octet)
  68            (type iobuf iobuf)
  69            (type iobuf-index index))
  70   (setf (aref (iobuf-data iobuf) index) octet))
  71
  72 (defun iobuf-pop-octet (iobuf)
  73   (declare (type iobuf iobuf))
  74   (let ((start (iobuf-start iobuf)))
  75     (prog1 (bref iobuf start)
  76       (incf (iobuf-start iobuf)))))
  77
  78 (defun iobuf-push-octet (iobuf octet)
  79   (declare (type iobuf iobuf)
  80            (type ub8 octet))
  81   (let ((end (iobuf-end iobuf)))
  82     (prog1 (setf (bref iobuf end) octet)
  83       (incf (iobuf-end iobuf)))))
  84
  85 (defun replace-ub8 (destination source start1 end1 start2 end2)
  86   (declare (type iobuf-buffer destination source)
  87            (type iobuf-index start1 start2 end1 end2))
  88   (let ((nbytes (min (- end1 start1)
  89                      (- end2 start2))))
  90     (replace destination source
  91              :start1 start1 :end1 end1
  92              :start2 start2 :end2 end2)
  93     (values destination nbytes)))
  94
  95 (defun iobuf->array (array iobuf start end)
  96   (declare (type iobuf-buffer array)
  97            (type iobuf iobuf)
  98            (type iobuf-index start end))
  99   (let ((nbytes
 100          (nth-value 1 (replace-ub8 array (iobuf-data iobuf)
 101                                    start end
 102                                    (iobuf-start iobuf)
 103                                    (iobuf-end iobuf)))))
 104     (incf (iobuf-start iobuf) nbytes)
 105     (values nbytes)))
 106
 107 (defun array->iobuf (iobuf array start end)
 108   (declare (type iobuf-buffer array)
 109            (type iobuf iobuf)
 110            (type iobuf-index start end))
 111   (let ((nbytes
 112          (nth-value 1 (replace-ub8 (iobuf-data iobuf) array
 113                                    (iobuf-start iobuf)
 114                                    (iobuf-end iobuf)
 115                                    start end))))
 116     (incf (iobuf-end iobuf) nbytes)
 117     (values nbytes)))