1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Indent-tabs-mode: NIL -*-
3 ;;; buffer.lisp --- Foreign memory buffers.
5 ;;; Copyright (C) 2006-2007, Stelian Ionescu <sionescu@common-lisp.net>
7 ;;; This code is free software; you can redistribute it and/or
8 ;;; modify it under the terms of the version 2.1 of
9 ;;; the GNU Lesser General Public License as published by
10 ;;; the Free Software Foundation, as clarified by the
11 ;;; preamble found here:
12 ;;; http://opensource.franz.com/preamble.html
14 ;;; This program is distributed in the hope that it will be useful,
15 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;;; GNU General Public License for more details.
19 ;;; You should have received a copy of the GNU Lesser General
20 ;;; Public License along with this library; if not, write to the
21 ;;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
22 ;;; Boston, MA 02110-1301, USA
24 (in-package :io.streams
)
28 (define-constant +bytes-per-iobuf
+ (* 4 1024))
30 ;;; FIXME: make this right
31 ;;; probably not all SIMPLE-ARRAYs are admissible
32 ;;; on all implementations
33 (deftype compatible-lisp-array
()
34 '(simple-array * (*)))
36 (declaim (inline allocate-iobuf free-iobuf
37 iobuf-length iobuf-start-pointer
38 iobuf-end-pointer iobuf-end-space-length
39 iobuf-empty-p iobuf-full-p
40 iobuf-reset iobuf-copy-data-to-start
41 bref
(setf bref
) iobuf-copy
42 iobuf-pop-octet iobuf-push-octet
))
44 (defun allocate-iobuf (&optional
(size +bytes-per-iobuf
+))
45 (let ((b (%make-iobuf
)))
46 (setf (iobuf-data b
) (foreign-alloc :uint8
:count size
)
50 (defun free-iobuf (iobuf)
51 (foreign-free (iobuf-data iobuf
))
52 (setf (iobuf-data iobuf
) (null-pointer))
55 (defun iobuf-length (iobuf)
59 (defun iobuf-start-pointer (iobuf)
60 (inc-pointer (iobuf-data iobuf
)
63 (defun iobuf-end-pointer (iobuf)
64 (inc-pointer (iobuf-data iobuf
)
67 (defun iobuf-empty-p (iobuf)
71 (defun iobuf-full-p (iobuf)
75 (defun iobuf-end-space-length (iobuf)
79 (defun iobuf-reset (iobuf)
80 (setf (iobuf-start iobuf
) 0
83 (defun iobuf-copy-data-to-start (iobuf)
84 (declare (type iobuf iobuf
))
87 (inc-pointer (iobuf-data iobuf
)
90 (setf (iobuf-end iobuf
) (iobuf-length iobuf
))
91 (setf (iobuf-start iobuf
) 0))
93 ;;; BREF, (SETF BREF) and BUFFER-COPY *DO NOT* check boundaries
94 ;;; that must be done by their callers
95 (defun bref (iobuf index
)
96 (declare (type iobuf iobuf
)
97 (type buffer-index index
))
98 (mem-aref (iobuf-data iobuf
) :uint8 index
))
100 (defun (setf bref
) (octet iobuf index
)
101 (declare (type (unsigned-byte 8) octet
)
103 (type buffer-index index
))
104 (setf (mem-aref (iobuf-data iobuf
) :uint8 index
) octet
))
106 (defun iobuf-copy-from-lisp-array (src soff dst doff length
)
107 (declare (type compatible-lisp-array src
)
109 (type buffer-index soff doff length
))
110 (let ((dst-ptr (iobuf-data dst
)))
111 (with-pointer-to-vector-data (src-ptr src
)
113 (inc-pointer dst-ptr doff
)
114 (inc-pointer src-ptr soff
)
117 (defun iobuf-copy-into-lisp-array (src soff dst doff length
)
118 (declare (type iobuf src
)
119 (type compatible-lisp-array dst
)
120 (type buffer-index soff doff length
))
121 (let ((src-ptr (iobuf-data src
)))
122 (with-pointer-to-vector-data (dst-ptr dst
)
124 (inc-pointer dst-ptr doff
)
125 (inc-pointer src-ptr soff
)
128 (defun iobuf-pop-octet (iobuf)
129 (declare (type iobuf iobuf
))
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 (let ((end (iobuf-end iobuf
)))
138 (prog1 (setf (bref iobuf end
) octet
)
139 (incf (iobuf-end iobuf
)))))