src/streams/gray/buffer.lisp

   1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- Foreign memory buffers.
   4 ;;;
   5
   6 (in-package :iolib/streams)
   7
   8 ;;;; Foreign Buffers
   9
  10 (defconstant +bytes-per-iobuf+ (* 4 1024))
  11
  12 ;;; FIXME: make this right
  13 ;;; probably not all SIMPLE-ARRAYs are admissible
  14 ;;; on all implementations
  15 (deftype compatible-lisp-array ()
  16   '(simple-array * (*)))
  17
  18 (defun allocate-iobuf (&optional (size +bytes-per-iobuf+))
  19   (let ((b (%make-iobuf)))
  20     (setf (iobuf-data b) (foreign-alloc :uint8 :count size)
  21           (iobuf-size b) size)
  22     (values b)))
  23
  24 (defun free-iobuf (iobuf)
  25   (unless (null-pointer-p (iobuf-data iobuf))
  26     (foreign-free (iobuf-data iobuf)))
  27   (setf (iobuf-data iobuf) (null-pointer))
  28   (values iobuf))
  29
  30 (defun iobuf-length (iobuf)
  31   (- (iobuf-end iobuf)
  32      (iobuf-start iobuf)))
  33
  34 (defun iobuf-start-pointer (iobuf)
  35   (inc-pointer (iobuf-data iobuf)
  36                (iobuf-start iobuf)))
  37
  38 (defun iobuf-end-pointer (iobuf)
  39   (inc-pointer (iobuf-data iobuf)
  40                (iobuf-end iobuf)))
  41
  42 (defun iobuf-empty-p (iobuf)
  43   (= (iobuf-end iobuf)
  44      (iobuf-start iobuf)))
  45
  46 (defun iobuf-full-p (iobuf)
  47   (= (iobuf-end iobuf)
  48      (iobuf-size iobuf)))
  49
  50 (defun iobuf-end-space-length (iobuf)
  51   (- (iobuf-size iobuf)
  52      (iobuf-end iobuf)))
  53
  54 (defun iobuf-reset (iobuf)
  55   (setf (iobuf-start iobuf) 0
  56         (iobuf-end iobuf)   0))
  57
  58 (defun iobuf-peek (iobuf &optional (offset 0))
  59   (bref iobuf (+ (iobuf-start iobuf) offset)))
  60
  61 (defun iobuf-copy-data-to-start (iobuf)
  62   (declare (type iobuf iobuf))
  63   (isys:memmove
  64    (iobuf-data iobuf)
  65    (inc-pointer (iobuf-data iobuf)
  66                 (iobuf-start iobuf))
  67    (iobuf-length iobuf))
  68   (setf (iobuf-end iobuf) (iobuf-length iobuf))
  69   (setf (iobuf-start iobuf) 0))
  70
  71 (defun iobuf-can-fit-slice-p (iobuf start end)
  72   (<= (- end start) (iobuf-end-space-length iobuf)))
  73
  74 (defun iobuf-append-slice (iobuf array start end)
  75   (let ((slice-length (- end start)))
  76     (iobuf-copy-from-lisp-array array start iobuf
  77                                 (iobuf-end iobuf) slice-length)
  78     (incf (iobuf-end iobuf) slice-length)))
  79
  80 ;;; BREF, (SETF BREF) and BUFFER-COPY *DO NOT* check boundaries
  81 ;;; that must be done by their callers
  82 (defun bref (iobuf index)
  83   (declare (type iobuf iobuf)
  84            (type buffer-index index))
  85   (debug-only (assert (not (minusp index))))
  86   (mem-aref (iobuf-data iobuf) :uint8 index))
  87
  88 (defun (setf bref) (octet iobuf index)
  89   (declare (type (unsigned-byte 8) octet)
  90            (type iobuf iobuf)
  91            (type buffer-index index))
  92   (debug-only
  93     (assert (>= index 0))
  94     (assert (< index (iobuf-size iobuf))))
  95   (setf (mem-aref (iobuf-data iobuf) :uint8 index) octet))
  96
  97 (defun iobuf-copy-from-lisp-array (src soff dst doff length)
  98   (declare (type compatible-lisp-array src)
  99            (type iobuf dst)
 100            (type buffer-index soff doff length))
 101   (debug-only
 102     (assert (>= doff 0))
 103     (assert (>= soff 0))
 104     (assert (<= (+ doff length) (iobuf-size dst))))
 105   (let ((dst-ptr (iobuf-data dst)))
 106     (with-pointer-to-vector-data (src-ptr src)
 107       (isys:memcpy
 108        (inc-pointer dst-ptr doff)
 109        (inc-pointer src-ptr soff)
 110        length))))
 111
 112 (defun iobuf-copy-into-lisp-array (src soff dst doff length)
 113   (declare (type iobuf src)
 114            (type compatible-lisp-array dst)
 115            (type buffer-index soff doff length))
 116   (debug-only
 117     (assert (>= doff 0))
 118     (assert (>= soff 0))
 119     (assert (<= (+ doff length) (length dst))))
 120   (let ((src-ptr (iobuf-data src)))
 121     (with-pointer-to-vector-data (dst-ptr dst)
 122       (isys:memcpy
 123        (inc-pointer dst-ptr doff)
 124        (inc-pointer src-ptr soff)
 125        length))))
 126
 127 (defun iobuf-pop-octet (iobuf)
 128   (declare (type iobuf iobuf))
 129   (debug-only (assert (> (iobuf-length iobuf) 0)))
 130   (let ((start (iobuf-start iobuf)))
 131     (prog1 (bref iobuf start)
 132       (incf (iobuf-start iobuf)))))
 133
 134 (defun iobuf-push-octet (iobuf octet)
 135   (declare (type iobuf iobuf)
 136            (type (unsigned-byte 8) octet))
 137   (debug-only (assert (not (iobuf-full-p iobuf))))
 138   (let ((end (iobuf-end iobuf)))
 139     (prog1 (setf (bref iobuf end) octet)
 140       (incf (iobuf-end iobuf)))))