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 ;;;; 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-data-vector () 'ub8-simple-vector)
  20
  21 (defstruct (iobuf (:constructor %make-iobuf (data)))
  22   (data nil :type iobuf-data-vector :read-only t)
  23   (start 0 :type iobuf-index)
  24   (end 0 :type iobuf-index))
  25
  26 (defun make-iobuf-data-vector (size)
  27   (declare (type iobuf-index size))
  28   (make-array size :element-type 'ub8 :initial-element 0))
  29
  30 (defun make-iobuf (&optional size)
  31   (declare (type (or null iobuf-index) size))
  32   (%make-iobuf (make-iobuf-data-vector (or size +default-iobuf-size+))))
  33
  34 (defun iobuf-size (iobuf)
  35   (declare (type iobuf iobuf))
  36   (length (iobuf-data iobuf)))
  37
  38 (defun iobuf-available-octets (iobuf)
  39   (declare (type iobuf iobuf))
  40   (- (iobuf-end iobuf)
  41      (iobuf-start iobuf)))
  42
  43 (defun iobuf-empty-p (iobuf)
  44   (declare (type iobuf iobuf))
  45   (= (iobuf-start iobuf)
  46      (iobuf-end iobuf)))
  47
  48 (defun iobuf-full-p (iobuf)
  49   (declare (type iobuf iobuf))
  50   (= (iobuf-end iobuf)
  51      (iobuf-size iobuf)))
  52
  53 (defun iobuf-reset (iobuf)
  54   (declare (type iobuf iobuf))
  55   (setf (iobuf-start iobuf) 0
  56         (iobuf-end iobuf)   0))
  57
  58 (defun iobuf-next-data-zone (iobuf)
  59   (declare (type iobuf iobuf))
  60   (values (iobuf-data iobuf)
  61           (iobuf-start iobuf)
  62           (iobuf-end iobuf)))
  63
  64 (defun iobuf-next-empty-zone (iobuf)
  65   (declare (type iobuf iobuf))
  66   (values (iobuf-data iobuf)
  67           (iobuf-end iobuf)
  68           (iobuf-size iobuf)))
  69 \f
  70
  71 ;;;
  72 ;;; UNSAFE functions which *DO NOT* check boundaries
  73 ;;; that must be done by their callers
  74 ;;;
  75
  76 (defun bref (iobuf index)
  77   (declare (type iobuf iobuf)
  78            (type iobuf-index index))
  79   (aref (iobuf-data iobuf) index))
  80
  81 (defun (setf bref) (octet iobuf index)
  82   (declare (type ub8 octet)
  83            (type iobuf iobuf)
  84            (type iobuf-index index))
  85   (setf (aref (iobuf-data iobuf) index) octet))
  86
  87 (defun iobuf-pop-octet (iobuf)
  88   (declare (type iobuf iobuf))
  89   (let ((start (iobuf-start iobuf)))
  90     (prog1 (bref iobuf start)
  91       (setf (iobuf-start iobuf) (1+ start)))))
  92
  93 (defun iobuf-push-octet (iobuf octet)
  94   (declare (type iobuf iobuf)
  95            (type ub8 octet))
  96   (let ((end (iobuf-end iobuf)))
  97     (prog1 (setf (bref iobuf end) octet)
  98       (setf (iobuf-end iobuf) (1+ end)))))
  99
 100 (defun replace-ub8 (destination source start1 end1 start2 end2)
 101   (declare (type ub8-simple-vector destination source)
 102            (type iobuf-index start1 start2 end1 end2))
 103   (let ((nbytes (min (- end1 start1)
 104                      (- end2 start2))))
 105     (replace destination source
 106              :start1 start1 :end1 end1
 107              :start2 start2 :end2 end2)
 108     (values nbytes)))
 109
 110 (defun iobuf->vector (iobuf vector start end)
 111   (declare (type iobuf iobuf)
 112            (type ub8-simple-vector vector)
 113            (type iobuf-index start end))
 114   (when (iobuf-empty-p iobuf)
 115     (iobuf-reset iobuf))
 116   (multiple-value-bind (iobuf-data data-start data-end)
 117       (iobuf-next-data-zone iobuf)
 118     (let ((nbytes
 119            (replace-ub8 vector iobuf-data start end data-start data-end)))
 120       (setf (iobuf-start iobuf) (+ data-start nbytes))
 121       (values nbytes))))
 122
 123 (defun vector->iobuf (iobuf vector start end)
 124   (declare (type iobuf iobuf)
 125            (type ub8-simple-vector vector)
 126            (type iobuf-index start end))
 127   (when (iobuf-empty-p iobuf)
 128     (iobuf-reset iobuf))
 129   (multiple-value-bind (iobuf-data data-start data-end)
 130       (iobuf-next-empty-zone iobuf)
 131     (let ((nbytes
 132            (replace-ub8 iobuf-data vector data-start data-end start end)))
 133       (setf (iobuf-end iobuf) (+ data-end nbytes))
 134       (values nbytes))))