X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/d33e712baf74fc969d1c34172b01f66a5f6bbab9..4769576f381e72d2bc169a23e33b1c897f59e6e7:/gffi/memory.lisp

diff --git a/gffi/memory.lisp b/gffi/memory.lisp
index c753434..7c8f458 100644
--- a/gffi/memory.lisp
+++ b/gffi/memory.lisp
@@ -20,7 +20,7 @@
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
-;; $Id: memory.lisp,v 1.6 2007-10-17 17:04:56 espen Exp $
+;; $Id: memory.lisp,v 1.8 2008-04-29 22:11:35 espen Exp $
 
 
 (in-package "GFFI")
@@ -258,8 +258,8 @@
    value))
 
 
-(defparameter *memory-allocator* nil)
-(defparameter *memory-deallocator* nil)
+(defvar *memory-allocator* nil)
+(defvar *memory-deallocator* nil)
 
 (defun allocate-memory (size)
   (if *memory-allocator*
@@ -277,7 +277,7 @@
   #-(or cmu sbcl)
   (loop
    for offset below length
-   do (setf (ref-uint-88 to offset) (ref-uint-8 from offset)))
+   do (setf (ref-uint-8 to offset) (ref-uint-8 from offset)))
   to)
 
 (defun clear-memory (from length &optional (offset 0))
@@ -297,23 +297,26 @@
   t)
 
 (defmacro with-memory ((var size) &body body)
-  #-clisp
-  (if (and #+(or cmu sbcl)t (constantp size))
-      (let ((memory (make-symbol "MEMORY"))
-	    (size (eval size)))
-	`(with-alien ((,memory (array #+sbcl(sb-alien:unsigned 8) #+cmu(alien:unsigned 8) ,size)))
-	   (let ((,var (alien-sap ,memory)))
-	     (clear-memory ,var ,size)
-	     ,@body)))
-    `(let ((,var (allocate-memory ,size)))
-       (unwind-protect
-	   (progn ,@body)
-	 (deallocate-memory ,var))))
-  #+clisp
-  (let ((memory (make-symbol "MEMORY")))	   
-    `(ffi:with-foreign-object (,memory `(ffi:c-array ffi:uint8 ,,size))
-       (let ((,var (ffi:foreign-address ,memory)))
-	 ,@body))))
+  (cond
+    #+(or cmu sbcl)
+    ((constantp size)
+     (let ((memory (make-symbol "MEMORY"))
+	   (size (eval size)))
+       `(with-alien ((,memory (array #+sbcl(sb-alien:unsigned 8) #+cmu(alien:unsigned 8) ,size)))
+	  (let ((,var (alien-sap ,memory)))
+	    (clear-memory ,var ,size)
+	    ,@body))))
+    (t
+     #-clisp
+     `(let ((,var (allocate-memory ,size)))
+	(unwind-protect
+	     (progn ,@body)
+	  (deallocate-memory ,var)))
+     #+clisp
+     (let ((memory (make-symbol "MEMORY")))	   
+       `(ffi:with-foreign-object (,memory `(ffi:c-array ffi:uint8 ,,size))
+	  (let ((,var (ffi:foreign-address ,memory)))
+	    ,@body))))))
 
 (defmacro with-pointer ((var &optional (pointer '(make-pointer 0))) &body body)
   "Binds POINTER to VAR in a way which makes it possible to pass the location of VAR to in foreign function call."
@@ -377,3 +380,9 @@
 	   ((#-big-endian :big #+big-endian :little)
 	    (,set-swapped location offset value)
 	    value))))))
+
+#+cmu
+(defmacro with-pinned-objects (objects &body body)
+  (declare (ignore objects))
+  `(without-gcing ,@body))
+