From fd405c886a22392634af58832d31cc809a1abd19 Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Sat, 30 Oct 2004 17:20:46 +0000
Subject: [PATCH] r10123: fix for openmcl

---
 src/aggregates.lisp | 75 +++++++++++++++++++++++----------------------
 1 file changed, 39 insertions(+), 36 deletions(-)

diff --git a/src/aggregates.lisp b/src/aggregates.lisp
index acfda5e..9aa76b0 100644
--- 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)
-- 
2.34.1