From 38bdd9ccd063be4b3e0658a880a705ccb0cfdeb1 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Thu, 10 Jun 2004 06:18:06 +0000 Subject: [PATCH] r9575: fix WITH-FOREIGN-OBJECT macro for cmu --- debian/changelog | 6 ++++++ src/aggregates.lisp | 2 +- src/objects.lisp | 13 +++++++++---- 3 files changed, 16 insertions(+), 5 deletions(-) diff --git a/debian/changelog b/debian/changelog index 295401c..192408a 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-uffi (1.4.21-1) unstable; urgency=low + + * Fix for WITH-FOREIGN-OBJECT macro on CMUCL + + -- Kevin M. Rosenberg Thu, 10 Jun 2004 00:17:31 -0600 + cl-uffi (1.4.20-1) unstable; urgency=low * New upstream diff --git a/src/aggregates.lisp b/src/aggregates.lisp index 523bd4f..70d3ad2 100644 --- a/src/aggregates.lisp +++ b/src/aggregates.lisp @@ -161,7 +161,7 @@ of the enum-name name, separator-string, and field-name" "Returns a field from a row" #+(or lispworks cmu sbcl scl) (declare (ignore type)) #+(or cmu scl) `(alien:deref ,obj ,i) - #+sbcl `(sb-alien:deref ,obj ,i) + #+sbcl `(sb-alien:deref ,obj ,i) #+lispworks `(fli:dereference ,obj :index ,i :copy-foreign-object nil) #+allegro `(ff:fslot-value-typed (quote ,(convert-from-uffi-type type :type)) :c ,obj ,i) #+openmcl diff --git a/src/objects.lisp b/src/objects.lisp index 9de66f9..5761132 100644 --- a/src/objects.lisp +++ b/src/objects.lisp @@ -166,10 +166,15 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated." (progn ,@body) (free-foreign-object ,var))) #+(or cmu scl) - (let ((obj (gensym))) - `(alien:with-alien ((,obj ,(convert-from-uffi-type (eval type) :allocate))) - (let ((,var (alien:addr ,obj))) - ,@body))) + (let ((obj (gensym)) + (ctype (convert-from-uffi-type (eval type) :allocate))) + (if (and (consp ctype) (eq 'array (car ctype))) + `(alien:with-alien ((,obj ,ctype)) + (let* ((,var ,obj)) + ,@body)) + `(alien:with-alien ((,obj ,ctype)) + (let* ((,var (alien:addr ,obj))) + ,@body)))) #+sbcl (let ((obj (gensym)) (ctype (convert-from-uffi-type (eval type) :allocate))) -- 2.34.1