io.streams/gray/buffer.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- Foreign memory buffers.
   4 ;;;
   5
   6 (in-package :io.streams)
   7
   8 ;;;; Foreign Buffers
   9
  10 (define-constant +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-copy-data-to-start (iobuf)
  59   (declare (type iobuf iobuf))
  60   (nix:memmove
  61    (iobuf-data iobuf)
  62    (inc-pointer (iobuf-data iobuf)
  63                 (iobuf-start iobuf))
  64    (iobuf-length iobuf))
  65   (setf (iobuf-end iobuf) (iobuf-length iobuf))
  66   (setf (iobuf-start iobuf) 0))
  67
  68 ;;; BREF, (SETF BREF) and BUFFER-COPY *DO NOT* check boundaries
  69 ;;; that must be done by their callers
  70 (defun bref (iobuf index)
  71   (declare (type iobuf iobuf)
  72            (type buffer-index index))
  73   (debug-only (assert (not (minusp index))))
  74   (mem-aref (iobuf-data iobuf) :uint8 index))
  75
  76 (defun (setf bref) (octet iobuf index)
  77   (declare (type (unsigned-byte 8) octet)
  78            (type iobuf iobuf)
  79            (type buffer-index index))
  80   (debug-only
  81     (assert (>= index 0))
  82     (assert (< index (iobuf-size iobuf))))
  83   (setf (mem-aref (iobuf-data iobuf) :uint8 index) octet))
  84
  85 (defun iobuf-copy-from-lisp-array (src soff dst doff length)
  86   (declare (type compatible-lisp-array src)
  87            (type iobuf dst)
  88            (type buffer-index soff doff length))
  89   (debug-only
  90     (assert (>= doff 0))
  91     (assert (>= soff 0))
  92     (assert (<= (+ doff length) (iobuf-size dst))))
  93   (let ((dst-ptr (iobuf-data dst)))
  94     (with-pointer-to-vector-data (src-ptr src)
  95       (nix:memcpy
  96        (inc-pointer dst-ptr doff)
  97        (inc-pointer src-ptr soff)
  98        length))))
  99
 100 (defun iobuf-copy-into-lisp-array (src soff dst doff length)
 101   (declare (type iobuf src)
 102            (type compatible-lisp-array dst)
 103            (type buffer-index soff doff length))
 104   (debug-only
 105     (assert (>= doff 0))
 106     (assert (>= soff 0))
 107     (assert (<= (+ doff length) (length dst))))
 108   (let ((src-ptr (iobuf-data src)))
 109     (with-pointer-to-vector-data (dst-ptr dst)
 110       (nix:memcpy
 111        (inc-pointer dst-ptr doff)
 112        (inc-pointer src-ptr soff)
 113        length))))
 114
 115 (defun iobuf-pop-octet (iobuf)
 116   (declare (type iobuf iobuf))
 117   (debug-only (assert (> (iobuf-length iobuf) 0)))
 118   (let ((start (iobuf-start iobuf)))
 119     (prog1 (bref iobuf start)
 120       (incf (iobuf-start iobuf)))))
 121
 122 (defun iobuf-push-octet (iobuf octet)
 123   (declare (type iobuf iobuf)
 124            (type (unsigned-byte 8) octet))
 125   (debug-only (assert (not (iobuf-full-p iobuf))))
 126   (let ((end (iobuf-end iobuf)))
 127     (prog1 (setf (bref iobuf end) octet)
 128       (incf (iobuf-end iobuf)))))