r10123: fix for openmcl

diff --git a/src/aggregates.lisp b/src/aggregates.lisp
index acfda5e48002c299759066eeb7c707410d292b63..9aa76b03586e880ddb1a0805065d327388719006 100644 (file)
--- a/src/aggregates.lisp
+++ b/src/aggregates.lisp
@@ -147,42 +147,45 @@ of the enum-name name, separator-string, and field-name"
      (ccl:%int-to-ptr (+ (ccl:%ptr-to-int ,obj) (the fixnum (ccl::foreign-record-field-offset field)))))  
 )
 
-; so we could allow '(:array :long) or deref with other type like :long only
-#+mcl
-(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))))
-  )
-
+;; necessary to eval at compile time for openmcl to compile convert-from-foreign-usb8
+;; below
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  ;; so we could allow '(:array :long) or deref with other type like :long only
+  #+mcl
+  (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))))
+    ))
+  
 ; this expands to the %set-xx functions which has different params than %put-xx
 #+(and mcl (not openmcl))
 (defmacro deref-array-set (obj type i value)