patch: def-foreign-var support for openmcl

James Bielman <[email protected]> Thu, 31 Mar 2005 17:45:52 -0800
Newsgroups gmane.lisp.uffi.devel
Message-ID <[email protected]>
Hi,

Here's a patch that adds support for DEF-FOREIGN-VAR on OpenMCL.

The foreign-var tests that use modify macros on foreign structures
still fail because of evaluation problems with UFFI:GET-SLOT-VALUE,
but I think this is still reasonably correct.  It is also more consy
than it could be but not terribly so (16 bytes per access, compared
to 80 or so for SBCL).

This patch also conditionalizes out a second definition of the
WITH-CAST-POINTER macro that shadows the correct definition.

Tested on Darwin OpenMCL 0.14.3, I don't know about LinuxPPC or MCL.

James

--- objects.lisp.orig	2005-03-31 16:10:54.000000000 -0800
+++ objects.lisp	2005-03-31 16:14:03.000000000 -0800
@@ -238,9 +238,9 @@
   `(let ((,binding-name ,pointer))
     ,@body))
 
-#-(or lispworks cmu scl sbcl allegro)
+#-(or lispworks cmu scl sbcl allegro openmcl)
 (defmacro with-cast-pointer ((binding-name pointer type) &body body)
-  (declare (ignore binding-name pointer type))
+  (declare (ignore binding-name pointer type body))
   '(error "WITH-CAST-POINTER not (yet) implemented for ~A"
           (lisp-implementation-type)))
 
@@ -266,7 +266,12 @@
                                     :module ,module)
       (define-symbol-macro ,lisp-name (fli:dereference (,lisp-name)
                                                         :copy-foreign-object nil)))
-    #-(or allegro cmu scl sbcl lispworks)
+    #+(and openmcl darwinppc-target)
+    (setf foreign-name (concatenate 'string "_" foreign-name))
+    #+openmcl
+    `(define-symbol-macro ,lisp-name
+       (deref-pointer (ccl:foreign-symbol-address ,foreign-name) ,var-type))
+    #-(or allegro cmu scl sbcl lispworks openmcl)
     `(define-symbol-macro ,lisp-name
       '(error "DEF-FOREIGN-VAR not (yet) defined for ~A"
         (lisp-implementation-type)))))