Hi!
Attached is a hasty patch to enable CFFI-SYS:%FOREIGN-FUNCALL and
CFFI-SYS:%FOREIGN-FUNCALL-POINTER for LispWorks. The idea is to
create one foreign funcallable per signature and cache those in a hash
table. I took a quick glance at the source code of CMUCL's
ALIEN-FUNCALL and my impression (not really understanding the details)
was that CMUCL actually does something similar internally - it creates
a "stub" if necessary, depending on the types. As you can observe at
the REPL it compiles /something/ when ALIEN-FUNCALL is called.
Granted, it is kind of ugly to call FLI:DEFINE-FOREIGN-FUNCALLABLE in
non-top-level position but I think this solution is better than
nothing. It looks to me as if FOREIGN-FUNCALL is mostly intended for
interactive use and for "one-shot" invocations - correct me if I'm
wrong.
I don't know if CMUCL's "stubs" will ever be garbage-collected, the
foreign funcallables in my patch certainly won't. I don't expect this
to be a big problem, though.
I tried the CFFI test suite and it basically ran through with three
exceptions - FUNCALL.FLOAT, DEREF.FLOAT.2, and DEREF.FLOAT.3. My
guess is that these are due to LispWorks identifying FLOAT and
DOUBLE-FLOAT and are not related to my patch.
Two minor quibbles, unrelated:
1. The documentation says it is only about the cffi-luis branch but it
seems to me that the main branch and cffi-luis are almost identical
- or did I miss something?
2. This form
(define-foreign-library libcurl
(:unix (:or "libcurl.so.3" "libcurl.so"))
(t (:default "libcurl")))
in the (very nice, BTW) tutorial didn't work for me on Linux,
neither with LispWorks nor with CMUCL. I had to remove the second
(:UNIX) line to make it work.
[EMAIL PROTECTED]:~$ ls -l /usr/lib/libcurl*
lrwxrwxrwx 1 root root 16 Dec 28 19:29 /usr/lib/libcurl.so.3 ->
libcurl.so.3.0.0
-rw-r--r-- 1 root root 196632 Dec 7 12:39 /usr/lib/libcurl.so.3.0.0
Cheers,
Edi.
diff -ru cffi.orig/src/cffi-lispworks.lisp cffi/src/cffi-lispworks.lisp
--- cffi.orig/src/cffi-lispworks.lisp 2006-01-12 16:38:28.000000000 +0100
+++ cffi/src/cffi-lispworks.lisp 2006-01-15 00:00:05.000000000 +0100
@@ -41,6 +41,7 @@
#:foreign-free
#:with-foreign-pointer
#:%foreign-funcall
+ #:%foreign-funcall-pointer
#:%foreign-type-alignment
#:%foreign-type-size
#:%load-foreign-library
@@ -61,7 +62,7 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
(mapc (lambda (feature) (pushnew feature *features*))
'(;; Backend features.
-
+ cffi-features:foreign-funcall
;; OS/CPU features.
#+darwin cffi-features:darwin
#+unix cffi-features:unix
@@ -182,6 +183,11 @@
;;;# Calling Foreign Functions
+(defvar *foreign-funcallable-cache* (make-hash-table :test 'equal)
+ "Caches foreign funcallables created by %FOREIGN-FUNCALL or
+%FOREIGN-FUNCALL-POINTER. We only need to have one per each
+signature.")
+
(defun foreign-funcall-type-and-args (args)
"Returns a list of types, list of args and return type."
(let ((return-type :void))
@@ -191,9 +197,44 @@
else do (setf return-type (convert-foreign-type type))
finally (return (values types fargs return-type)))))
+(defmacro %%foreign-funcall (foreign-function &rest args)
+ "Does the actual work for %FOREIGN-FUNCALL-POINTER and
+%FOREIGN-FUNCALL. Checks if a foreign funcallable which fits ARGS
+already exists and creates and caches it if necessary. Finally calls
+it."
+ (multiple-value-bind (types fargs rettype)
+ (foreign-funcall-type-and-args args)
+ (with-unique-names (signature internal-name create-ff get-ff)
+ `(let ((,signature (list ,rettype ,@types)))
+ (labels ((,create-ff ()
+ "Creates a foreign funcallable for the signature."
+ (format t "~&Creating foreign funcallable for signatur ~S -> ~S~%"
+ ',types ,rettype)
+ ;; yes, ugly, this most likely wants to be a
+ ;; top-level form...
+ (fli:define-foreign-funcallable ,internal-name
+ ,(loop for type in types
+ collect (list (gensym) type))
+ :result-type ,rettype)
+ ',internal-name)
+ (,get-ff ()
+ "Returns a foreign funcallable for the signature -
+either from the cache or newly created."
+ (or (gethash ,signature *foreign-funcallable-cache*)
+ ;; (SETF GETHASH) is supposed to be thread-safe
+ (setf (gethash ,signature *foreign-funcallable-cache*)
+ (,create-ff)))))
+ ;; now call it
+ (funcall (,get-ff) ,foreign-function ,@fargs))))))
+
(defmacro %foreign-funcall (name &rest args)
- "Call a foreign function NAME passing arguments ARGS."
- `(format t "~&;; Calling ~A with args ~S.~%" ,name ',args))
+ "Calls a foreign function named NAME passing arguments ARGS."
+ `(%%foreign-funcall (fli:make-pointer :symbol-name ,name)
+ ,@args))
+
+(defmacro %foreign-funcall-pointer (ptr &rest args)
+ "Calls a foreign function pointed at by PTR passing arguments ARGS."
+ `(%%foreign-funcall ,ptr ,@args))
(defun defcfun-helper-forms (name lisp-name rettype args types)
"Return 2 values for DEFCFUN. A prelude form and a caller form."
_______________________________________________
cffi-devel mailing list
cffi-devel@common-lisp.net
http://common-lisp.net/cgi-bin/mailman/listinfo/cffi-devel
