1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
3 ;;; --- Foreign memory buffers.
6 (in-package :iolib.streams
)
10 (defconstant +bytes-per-iobuf
+ (* 4 1024))
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 * (*)))
18 (defun allocate-iobuf (&optional
(size +bytes-per-iobuf
+))
19 (let ((b (%make-iobuf
)))
20 (setf (iobuf-data b
) (foreign-alloc :uint8
:count size
)
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))
30 (defun iobuf-length (iobuf)
34 (defun iobuf-start-pointer (iobuf)
35 (inc-pointer (iobuf-data iobuf
)
38 (defun iobuf-end-pointer (iobuf)
39 (inc-pointer (iobuf-data iobuf
)
42 (defun iobuf-empty-p (iobuf)
46 (defun iobuf-full-p (iobuf)
50 (defun iobuf-end-space-length (iobuf)
54 (defun iobuf-reset (iobuf)
55 (setf (iobuf-start iobuf
) 0
58 (defun iobuf-peek (iobuf &optional
(offset 0))
59 (bref iobuf
(+ (iobuf-start iobuf
) offset
)))
61 (defun iobuf-copy-data-to-start (iobuf)
62 (declare (type iobuf iobuf
))
65 (inc-pointer (iobuf-data iobuf
)
68 (setf (iobuf-end iobuf
) (iobuf-length iobuf
))
69 (setf (iobuf-start iobuf
) 0))
71 (defun iobuf-can-fit-slice-p (iobuf start end
)
72 (<= (- end start
) (iobuf-end-space-length iobuf
)))
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
)))
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
))
88 (defun (setf bref
) (octet iobuf index
)
89 (declare (type (unsigned-byte 8) octet
)
91 (type buffer-index index
))
94 (assert (< index
(iobuf-size iobuf
))))
95 (setf (mem-aref (iobuf-data iobuf
) :uint8 index
) octet
))
97 (defun iobuf-copy-from-lisp-array (src soff dst doff length
)
98 (declare (type compatible-lisp-array src
)
100 (type buffer-index soff doff length
))
104 (assert (<= (+ doff length
) (iobuf-size dst
))))
105 (let ((dst-ptr (iobuf-data dst
)))
106 (with-pointer-to-vector-data (src-ptr src
)
108 (inc-pointer dst-ptr doff
)
109 (inc-pointer src-ptr soff
)
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
))
119 (assert (<= (+ doff length
) (length dst
))))
120 (let ((src-ptr (iobuf-data src
)))
121 (with-pointer-to-vector-data (dst-ptr dst
)
123 (inc-pointer dst-ptr doff
)
124 (inc-pointer src-ptr soff
)
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
)))))
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
)))))