runtime/ffi: Add plugin-available?. Eliminate free variable ref.

diff --git a/src/runtime/ffi.scm b/src/runtime/ffi.scm
index f0adc4b90363663f17ec1912af42bf67cd603c6c..a242a86d688203c0a8821238d0b89dc5e61b9572 100644 (file)
--- a/src/runtime/ffi.scm
+++ b/src/runtime/ffi.scm
@@ -245,7 +245,7 @@ USA.
       unspecific
       (let* ((library (%alien-function/library afunc))
             (name (%alien-function/name afunc))
-            (pathname (dlopen-pathname library))
+            (pathname (plugin-pathname library))
             (handle (or (find-dld-handle
                          (lambda (h)
                            (pathname=? pathname (dld-handle-pathname h))))
@@ -256,16 +256,20 @@ USA.
            (error:bad-range-argument afunc 'alien-function-cache!))
        (set-%alien-function/band-id! afunc band-id))))
 
-(define (dlopen-pathname library)
-  (or (libtool-pathname library)
+(define (plugin-available? name)
+  (let ((path (ignore-errors (lambda () (plugin-pathname name)))))
+    (and (pathname? path)
+        (file-loadable? path))))
+
+(define (plugin-pathname name)
+  (or (libtool-pathname name)
       (system-library-pathname
-       (pathname-new-type (string-append library"-shim")
-                         "so"))
-      (error "Could not find module:" library)))
+       (pathname-new-type (string-append name"-shim") "so"))
+      (error "Could not find plugin:" name)))
 
-(define (libtool-pathname library)
+(define (libtool-pathname name)
   (let ((la-pathname (system-library-pathname
-                     (pathname-new-type (string-append library"-shim")
+                     (pathname-new-type (string-append name"-shim")
                                         "la"))))
     (let ((dlname (libtool-dlname la-pathname))
          (dirname (directory-pathname la-pathname)))
@@ -580,7 +584,7 @@ USA.
 
 (define (generate-shim library #!optional prefix)
   (load-ffi-quietly)
-  (c-generate library prefix))
+  ((environment-lookup (->environment '(ffi)) 'c-generate) library prefix))
 
 (define (update-optiondb directory)
   (load-ffi-quietly)

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 5337ebc2943da8308241ee8793865a5493599cb0..8f0b7313afd9c3c61a2877b48605a7bbdf90027f 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3395,48 +3395,49 @@ USA.
   (parent (runtime))
   (files "ffi")
   (export ()
-         make-alien
-         copy-alien
-         alien/ctype
-         set-alien/ctype!
-         c-cast
-         alien?
-         alien-null?
+         alien-byte-increment
+         alien-byte-increment!
+         alien-function/name
+         alien-function?
+         alien-hash
          alien-null!
+         alien-null?
          alien/address-string
-         null-alien
+         alien/ctype
          alien=?
-         alien-hash
-         copy-alien-address!
-         alien-function?
-         alien-function/name
-         alien-byte-increment
-         alien-byte-increment!
-         error:not-alien
-         guarantee-alien-function
-         error:not-alien-function
-         guarantee-alien
+         alien?
+         c-cast
+         c-enum-name
+         c-peek-bytes
          c-peek-cstring
          c-peek-cstring!
          c-peek-cstringp
          c-peek-cstringp!
-         c-peek-bytes
+         c-poke-bytes
          c-poke-pointer
          c-poke-pointer!
          c-poke-string
          c-poke-string!
-         c-poke-bytes
-         c-enum-name
          call-alien
+         copy-alien
+         copy-alien-address!
+         de-register-c-callback
+         error:not-alien
+         error:not-alien-function
+         free
+         generate-shim
+         guarantee-alien
+         guarantee-alien-function
+         make-alien
          make-alien-to-free
          malloc
-         free
-         register-c-callback
-         de-register-c-callback
+         null-alien
          outf-error
-         generate-shim
-         update-optiondb
-         update-html-index)
+         plugin-available?
+         register-c-callback
+         set-alien/ctype!
+         update-html-index
+         update-optiondb)        
   (initialization (initialize-package!)))
 
 (define-package (runtime program-copier)