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
)
89 (iobuf-length iobuf
)))
91 ;;; BREF, (SETF BREF) and BUFFER-COPY *DO NOT* check boundaries
92 ;;; that must be done by their callers
93 (defun bref (iobuf index
)
94 (declare (type iobuf iobuf
)
95 (type buffer-index index
))
96 (mem-aref (iobuf-data iobuf
) :uint8 index
))
98 (defun (setf bref
) (octet iobuf index
)
99 (declare (type (unsigned-byte 8) octet
)
101 (type buffer-index index
))
102 (setf (mem-aref (iobuf-data iobuf
) :uint8 index
) octet
))
104 (defun iobuf-copy-from-lisp-array (src soff dst doff length
)
105 (declare (type compatible-lisp-array src
)
107 (type buffer-index soff doff length
))
108 (let ((dst-ptr (iobuf-data dst
)))
109 (with-pointer-to-vector-data (src-ptr src
)
111 (inc-pointer dst-ptr doff
)
112 (inc-pointer src-ptr soff
)
115 (defun iobuf-copy-into-lisp-array (src soff dst doff length
)
116 (declare (type iobuf src
)
117 (type compatible-lisp-array dst
)
118 (type buffer-index soff doff length
))
119 (let ((src-ptr (iobuf-data src
)))
120 (with-pointer-to-vector-data (dst-ptr dst
)
122 (inc-pointer dst-ptr doff
)
123 (inc-pointer src-ptr soff
)
126 (defun iobuf-pop-octet (iobuf)
127 (declare (type iobuf iobuf
))
128 (let ((start (iobuf-start iobuf
)))
129 (prog1 (bref iobuf start
)
130 (incf (iobuf-start iobuf
)))))
132 (defun iobuf-push-octet (iobuf octet
)
133 (declare (type iobuf iobuf
)
134 (type (unsigned-byte 8) octet
))
135 (let ((end (iobuf-end iobuf
)))
136 (prog1 (setf (bref iobuf end
) octet
)
137 (incf (iobuf-end iobuf
)))))
141 (defstruct (iobuf-pool (:constructor make-iobuf-pool
())
143 (iobufs nil
:type list
)
144 (count 0 :type unsigned-byte
))
146 (defvar *available-iobufs
* (make-iobuf-pool))
149 ;; (defvar *iobuf-lock* (bordeaux-threads:make-lock "NET.SOCKETS STREAMS BUFFER POOL LOCK"))
151 ;;; FIXME: using a lock-free queue would be better
152 (defun next-available-iobuf ()
154 ;; (bordeaux-threads:with-lock-held (*iobuf-lock*)
155 ;; (if (iobuf-pool-iobufs *available-iobufs*)
157 ;; (pop (iobuf-pool-iobufs *available-iobufs*))
158 ;; (decf (iobuf-pool-count *available-iobufs*)))
161 (if (iobuf-pool-iobufs *available-iobufs
*)
163 (pop (iobuf-pool-iobufs *available-iobufs
*))
164 (decf (iobuf-pool-count *available-iobufs
*)))