r9431: revert to previous handling arrays on sbcl/cmu

diff --git a/ChangeLog b/ChangeLog
index 13f8e7d86bb498ea6a0b352baf572fbaf20152d8..4c0ea2e0e54dc8981f4c5c617eefd1afa9f8c4b1 100644 (file)
--- 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 5c5b5118a88950ea607a21a9f322c6a8c0768adc..523bd4f72983eadee80b0aa91ef86c6e3bae09ca 100644 (file)
--- 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 6ec32234aaa87792332dc39ebc2bb0a4c65784ed..9de66f9767a4c3495e6eeef54910a0180fdc2d8c 100644 (file)
--- 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 f107ac01d7521076dc3c743b9a93d48127d50acc..3eb0761f522e8a0495473d5397833f20e954b222 100644 (file)
--- 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)