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 (declaim (inline allocate-iobuf free-iobuf
  19                  iobuf-length iobuf-start-pointer
  20                  iobuf-end-pointer iobuf-end-space-length
  21                  iobuf-empty-p iobuf-full-p
  22                  iobuf-reset iobuf-copy-data-to-start
  23                  bref (setf bref) iobuf-copy
  24                  iobuf-pop-octet iobuf-push-octet))
  25
  26 (defun allocate-iobuf (&optional (size +bytes-per-iobuf+))
  27   (let ((b (%make-iobuf)))
  28     (setf (iobuf-data b) (foreign-alloc :uint8 :count size)
  29           (iobuf-size b) size)
  30     (values b)))
  31
  32 (defun free-iobuf (iobuf)
  33   (foreign-free (iobuf-data iobuf))
  34   (setf (iobuf-data iobuf) (null-pointer))
  35   (values iobuf))
  36
  37 (defun iobuf-length (iobuf)
  38   (- (iobuf-end iobuf)
  39      (iobuf-start iobuf)))
  40
  41 (defun iobuf-start-pointer (iobuf)
  42   (inc-pointer (iobuf-data iobuf)
  43                (iobuf-start iobuf)))
  44
  45 (defun iobuf-end-pointer (iobuf)
  46   (inc-pointer (iobuf-data iobuf)
  47                (iobuf-end iobuf)))
  48
  49 (defun iobuf-empty-p (iobuf)
  50   (= (iobuf-end iobuf)
  51      (iobuf-start iobuf)))
  52
  53 (defun iobuf-full-p (iobuf)
  54   (= (iobuf-end iobuf)
  55      (iobuf-size iobuf)))
  56
  57 (defun iobuf-end-space-length (iobuf)
  58   (- (iobuf-size iobuf)
  59      (iobuf-end iobuf)))
  60
  61 (defun iobuf-reset (iobuf)
  62   (setf (iobuf-start iobuf) 0
  63         (iobuf-end iobuf)   0))
  64
  65 (defun iobuf-copy-data-to-start (iobuf)
  66   (declare (type iobuf iobuf))
  67   (nix:memmove
  68    (iobuf-data iobuf)
  69    (inc-pointer (iobuf-data iobuf)
  70                 (iobuf-start iobuf))
  71    (iobuf-length iobuf))
  72   (setf (iobuf-end iobuf) (iobuf-length iobuf))
  73   (setf (iobuf-start iobuf) 0))
  74
  75 ;;; BREF, (SETF BREF) and BUFFER-COPY *DO NOT* check boundaries
  76 ;;; that must be done by their callers
  77 (defun bref (iobuf index)
  78   (declare (type iobuf iobuf)
  79            (type buffer-index index))
  80   (mem-aref (iobuf-data iobuf) :uint8 index))
  81
  82 (defun (setf bref) (octet iobuf index)
  83   (declare (type (unsigned-byte 8) octet)
  84            (type iobuf iobuf)
  85            (type buffer-index index))
  86   (setf (mem-aref (iobuf-data iobuf) :uint8 index) octet))
  87
  88 (defun iobuf-copy-from-lisp-array (src soff dst doff length)
  89   (declare (type compatible-lisp-array src)
  90            (type iobuf dst)
  91            (type buffer-index soff doff length))
  92   (let ((dst-ptr (iobuf-data dst)))
  93     (with-pointer-to-vector-data (src-ptr src)
  94       (nix:memcpy
  95        (inc-pointer dst-ptr doff)
  96        (inc-pointer src-ptr soff)
  97        length))))
  98
  99 (defun iobuf-copy-into-lisp-array (src soff dst doff length)
 100   (declare (type iobuf src)
 101            (type compatible-lisp-array dst)
 102            (type buffer-index soff doff length))
 103   (let ((src-ptr (iobuf-data src)))
 104     (with-pointer-to-vector-data (dst-ptr dst)
 105       (nix:memcpy
 106        (inc-pointer dst-ptr doff)
 107        (inc-pointer src-ptr soff)
 108        length))))
 109
 110 (defun iobuf-pop-octet (iobuf)
 111   (declare (type iobuf iobuf))
 112   (let ((start (iobuf-start iobuf)))
 113     (prog1 (bref iobuf start)
 114       (incf (iobuf-start iobuf)))))
 115
 116 (defun iobuf-push-octet (iobuf octet)
 117   (declare (type iobuf iobuf)
 118            (type (unsigned-byte 8) octet))
 119   (let ((end (iobuf-end iobuf)))
 120     (prog1 (setf (bref iobuf end) octet)
 121       (incf (iobuf-end iobuf)))))