From 0dbc9821c1d1f665a914585dcef97199e8334bf3 Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Sun, 23 May 2004 00:27:10 +0000
Subject: [PATCH] r9431: revert to previous handling arrays on sbcl/cmu

---
 ChangeLog           |  6 ------
 src/aggregates.lisp | 12 +++---------
 src/objects.lisp    | 16 ++--------------
 src/primitives.lisp | 28 +++++++++-------------------
 4 files changed, 14 insertions(+), 48 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 13f8e7d..4c0ea2e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,9 +1,3 @@
-2004-05-20 Kevin Rosenberg (kevin@rosenberg.net)
-	* Version 1.5.0 released
-	* Reworked array allocation and dereferencing for cmu/sbcl for greater
-	consistancy/robustness. Hopefully, this won't break any packages that use
-	UFFI, but the change does slightly change the alien types of foreign variables.
-
 2004-04-15 Kevin Rosenberg (kevin@rosenberg.net)
 	* src/objects.lisp: Add new functions:
 	MAKE-POINTER and POINTER-ADDRESS
diff --git a/src/aggregates.lisp b/src/aggregates.lisp
index 5c5b511..523bd4f 100644
--- a/src/aggregates.lisp
+++ b/src/aggregates.lisp
@@ -159,15 +159,9 @@ of the enum-name name, separator-string, and field-name"
 
 (defmacro deref-array (obj type i)
   "Returns a field from a row"
-  #+(or lispworks scl) (declare (ignore type))
-  #+(or cmu scl)  `(alien:deref
-		    (alien:cast
-		     ,obj
-		     ,(convert-from-uffi-type type :declare)) ,i)
-  #+sbcl `(sb-alien:deref
-	   (sb-alien:cast 
-	    ,obj
-	    ,(convert-from-uffi-type type :declare)) ,i)
+  #+(or lispworks cmu sbcl scl) (declare (ignore type))
+  #+(or cmu scl)  `(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 6ec3223..9de66f9 100644
--- a/src/objects.lisp
+++ b/src/objects.lisp
@@ -51,21 +51,9 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated."
 	)
       (progn
 	#+(or cmu scl)
-	(if (integerp size)
-	    `(alien:cast
-	      (alien:make-alien ,(convert-from-uffi-type (eval type) :allocation) ,size)
-	      (array ,(convert-from-uffi-type (eval type) :allocation) ,size))
-	    `(alien:cast
-	      (alien:make-alien ,(convert-from-uffi-type (eval type) :allocation) ,size)
-	      (array ,(convert-from-uffi-type (eval type) :allocation) nil)))
+	`(alien:make-alien ,(convert-from-uffi-type (eval type) :allocation) ,size)
 	#+sbcl
-	(if (integerp size)
-	    `(sb-alien:cast
-	      (sb-alien:make-alien ,(convert-from-uffi-type (eval type) :allocation) ,size)
-	      (array ,(convert-from-uffi-type (eval type) :allocation) ,size))
-	    `(sb-alien:cast
-	      (sb-alien:make-alien ,(convert-from-uffi-type (eval type) :allocation) ,size)
-	      (array ,(convert-from-uffi-type (eval type) :allocation) nil)))
+	`(sb-alien:make-alien ,(convert-from-uffi-type (eval type) :allocation) ,size)
 	#+lispworks
 	`(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate) :nelems ,size)
 	#+allegro
diff --git a/src/primitives.lisp b/src/primitives.lisp
index f107ac0..3eb0761 100644
--- a/src/primitives.lisp
+++ b/src/primitives.lisp
@@ -258,26 +258,16 @@ supports takes advantage of this optimization."
        (t
 	(basic-convert-from-uffi-type type)))
     (let ((sub-type (car type)))
-      (cond
-       ((eq sub-type 'cl:quote)
-	(convert-from-uffi-type (cadr type) context))
-       #+sbcl
-       ((and (eq sub-type :array)
-	     (or (eq context :declare) (eq context :routine))
-	     (= 2 (length type)))
-	`(sb-alien:array ,(%convert-from-uffi-type (second type) context) nil))
-       #+cmu
-       ((and (eq sub-type :array)
-	     (or (eq context :declare) (eq context :routine))
-	     (= 2 (length type)))
-	`(alien:array ,(%convert-from-uffi-type (second type) context) nil))
-       ((eq sub-type :struct-pointer)
-	#+mcl `(:* (:struct ,(%convert-from-uffi-type (cadr type) :struct)))
-	#-mcl (%convert-from-uffi-type (list '* (second type)) :struct)
-	)
-	((eq sub-type :struct)
+      (case sub-type
+	(cl:quote
+	 (convert-from-uffi-type (cadr type) context))
+	(:struct-pointer
+	 #+mcl `(:* (:struct ,(%convert-from-uffi-type (cadr type) :struct)))
+	 #-mcl (%convert-from-uffi-type (list '* (cadr type)) :struct)
+	 )
+	(:struct
 	 #+mcl `(:struct ,(%convert-from-uffi-type (cadr type) :struct))
-	 #-mcl (%convert-from-uffi-type (second type) :struct)
+	 #-mcl (%convert-from-uffi-type (cadr type) :struct)
 	 )
 	(t
 	 (cons (%convert-from-uffi-type (first type) context) 
-- 
2.34.1