-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
(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
)
(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
(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)