- (let* ((array-type (array-type type))
- (local-type (convert-from-uffi-type array-type :allocation))
- (accessor (first (macroexpand `(ccl:pref obj ,local-type)))))
- `(,accessor
- ,obj
- (* (the fixnum ,i) ,(size-of-foreign-type local-type))))
- )
-
+ (defun array-type (type)
+ (let ((result type))
+ (when (listp type)
+ (let ((type-list (if (eq (car type) 'quote) (nth 1 type) type)))
+ (when (and (listp type-list) (eq (car type-list) :array))
+ (setf result (cadr type-list)))))
+ result))
+
+
+ (defmacro deref-array (obj type i)
+ "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)
+ #+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
+ (let* ((array-type (array-type type))
+ (local-type (convert-from-uffi-type array-type :allocation))
+ (element-size-in-bits (ccl::%foreign-type-or-record-size local-type :bits)))
+ (ccl::%foreign-access-form
+ obj
+ (ccl::%foreign-type-or-record local-type)
+ `(* ,i ,element-size-in-bits)
+ nil))
+ #+(and mcl (not openmcl))
+ (let* ((array-type (array-type type))
+ (local-type (convert-from-uffi-type array-type :allocation))
+ (accessor (first (macroexpand `(ccl:pref obj ,local-type)))))
+ `(,accessor
+ ,obj
+ (* (the fixnum ,i) ,(size-of-foreign-type local-type))))
+ ))
+