[Sorry; I accidentally sent the last email before finishing it (C-c C-c
instead of C-c C-e).]
The problem:
Using the excellent cffi-wrappers on platforms that are not Allegro does
not work well with delivery, because the path to the generated shared
object (presumably near the source code) is hardcoded into the image,
and the image will crash very early, before entering user code if this
shared object is not available.
The solution:
Close all shared libraries before delivery. After delivery reopen them,
searching *foreign-library-directories*.
Brief summary of the patch:
(1) The wrapper generation code is changed to use define-foreign-library
and not to explicitly wedge the path into the library name, but to put
the directory where it is generated into *foreign-library-directories*.
(2) cffi:close-all-foreign-libraries closes all open defined foreign
libraries. Call this before delivery.
(3) (cffi:do-reload-all-compile-time-open-libraries) is a macro that
will load all the required libraries again. Put this in your main
function.
What I want:
Feedback and comments; maybe this patch touches too much? Apparently
Stelian started doing something a little similar but half finished? If
it looks viable for the mainline, we can add test cases and
documentation.
Examples:
Here are a couple of example build procedures that add the application's
binary directory to *foreign-library-directories*, so that the .so files
can be put there. (Maybe it would be better to fully set
*foreign-library-directories*.)
I have tested it on AMD64 Linux Lispworks and SBCL.
For example, Lispworks:
(compile
(defun main ()
(setf *debugger-hook* 'mtsnmp::mtsnmp-debugger-hook)
(pushnew (make-pathname :name nil :type nil :version nil
:defaults (truename (first
sys:*line-arguments-list*)))
cffi:*foreign-library-directories* :test 'equalp)
(handler-case
(progn
(cffi:do-reload-all-compile-time-open-libraries)
(prog1 (apply 'my-application:main sys:*line-arguments-list*)
(finish-output)))
(condition (c)
(ignore-errors
(format *error-output* "Error: ~A~&" c)
(finish-output *error-output*))
(lispworks:quit :status 1)))
(lispworks:quit :status 0)))
(cffi:close-all-foreign-libraries)
(deliver 'main
(multiple-value-bind
(second minute hour date month year day daylight-p zone)
(get-decoded-time)
(format nil "binaries/~4,'0D~2,'0D~2,'0D-~2,'0D~2,'0D-~A-~A-~A"
year
month
date
hour
minute
(lisp-implementation-type)
(lisp-implementation-version) (expt 2 (ceiling (log (log
most-positive-fixnum 2) 2)))))
1
:multiprocessing t
:keep-eval t
:keep-conditions :all
:keep-top-level nil
:keep-debug-mode nil)
For example, SBCL
(in-package #:cl-user)
(defun main ()
(unwind-protect
(handler-case
(progn
(pushnew (make-pathname :name nil :type nil :version nil
:defaults (truename (first *posix-argv*)))
cffi:*foreign-library-directories* :test 'equalp)
(cffi:do-reload-all-compile-time-open-libraries)
(apply 'my-application:main *posix-argv*)
(sb-ext:quit :unix-status 0))
(condition (c)
(ignore-errors
(format *error-output* "Error: ~A~&" c))
(sb-ext:quit :unix-status 1)))
(sb-ext:quit :unix-status 100)))
(defun make-image ()
(sb-ext:disable-debugger)
(cffi:close-all-foreign-libraries)
(sb-ext:save-lisp-and-die
(multiple-value-bind
(second minute hour date month year)
(get-decoded-time)
(declare (ignore second))
(format nil "binaries/~4,'0D~2,'0D~2,'0D-~2,'0D~2,'0D-~A-~A-~A"
year
month
date
hour
minute
(lisp-implementation-type)
(lisp-implementation-version) (expt 2 (ceiling (log (log
most-positive-fixnum 2) 2)))))
:executable t
:toplevel 'main
:purify t))
(make-image)
diff -rN -u old-cffi/grovel/asdf.lisp new-cffi/grovel/asdf.lisp
--- old-cffi/grovel/asdf.lisp 2009-07-17 16:41:06.000000000 +0900
+++ new-cffi/grovel/asdf.lisp 2009-07-17 16:41:06.000000000 +0900
@@ -30,11 +30,21 @@
(in-package #:cffi-grovel)
+(defvar *wrapper-shared-library-pathname-defaults* nil)
+
(defun ensure-pathname (thing)
(if (typep thing 'logical-pathname)
(translate-logical-pathname thing)
(pathname thing)))
+(defun add-directory-for-generated-library-to-cffi-library-path (component
+ &optional (compile-op
+ (make-instance 'asdf:compile-op )))
+ (let ((output-defaults (or *wrapper-shared-library-pathname-defaults*
+ (ensure-pathname (car (asdf:output-files compile-op component))))))
+ (pushnew (make-pathname :name nil :type nil :version nil
+ :defaults output-defaults) cffi::*foreign-library-directories* :test 'equalp)))
+
(defclass cc-flags-mixin ()
((cc-flags :initform nil :accessor cc-flags-of :initarg :cc-flags)))
@@ -59,9 +69,10 @@
:output-file output-file)))
(defmethod asdf:perform ((op asdf:load-source-op) (c grovel-file))
- (load (process-grovel-file
- (asdf:component-pathname c)
- (ensure-pathname (car (asdf:output-files op c))))))
+ (let ((output-file (ensure-pathname (car (asdf:output-files op c)))))
+ (load (process-grovel-file
+ (asdf:component-pathname c)
+ output-file))))
;;;# ASDF component: WRAPPER-FILE
@@ -74,11 +85,18 @@
that are subsequently compiled and/or loaded."))
(defmethod asdf:perform ((op asdf:compile-op) (c wrapper-file))
+ (add-directory-for-generated-library-to-cffi-library-path c)
(let ((output-file (ensure-pathname (car (asdf:output-files op c)))))
- (compile-file (process-wrapper-file (asdf:component-pathname c) output-file)
+ (compile-file (process-wrapper-file (asdf:component-pathname c)
+ (or *wrapper-shared-library-pathname-defaults* output-file))
:output-file output-file)))
(defmethod asdf:perform ((op asdf:load-source-op) (c wrapper-file))
- (load (process-wrapper-file
- (asdf:component-pathname c)
- (ensure-pathname (car (asdf:output-files op c))))))
+ (add-directory-for-generated-library-to-cffi-library-path c)
+ (let ((output-file (ensure-pathname (car (asdf:output-files op c)))))
+ (load (process-wrapper-file
+ (asdf:component-pathname c)
+ output-file))))
+
+(defmethod asdf:perform :before ((op asdf:load-op) (c wrapper-file))
+ (add-directory-for-generated-library-to-cffi-library-path c))
diff -rN -u old-cffi/grovel/grovel.lisp new-cffi/grovel/grovel.lisp
--- old-cffi/grovel/grovel.lisp 2009-07-17 16:41:06.000000000 +0900
+++ new-cffi/grovel/grovel.lisp 2009-07-17 16:41:06.000000000 +0900
@@ -652,15 +652,25 @@
(values c-file (nreverse *lisp-forms*))))
(defun generate-bindings-file (lib-file lisp-forms output-defaults)
- (let ((lisp-file (tmp-lisp-filename output-defaults)))
- (with-open-file (out lisp-file :direction :output :if-exists :supersede)
- (format out ";;;; This file was automatically generated by cffi-grovel.~%~
+ (let ((lisp-file (tmp-lisp-filename output-defaults))
+ (library-name (alexandria:symbolicate 'cffi-wrapper-lib- (pathname-name lib-file))))
+ (with-standard-io-syntax
+ (with-open-file (out lisp-file :direction :output :if-exists :supersede)
+ (format out ";;;; This file was automatically generated by cffi-grovel.~%~
;;;; Do not edit by hand.~%")
- (let ((*package* (find-package '#:cl)))
- (format out "~%~S~%" `(cffi:load-foreign-library ,lib-file)))
- (dolist (form lisp-forms)
- (print form out))
- (terpri out))
+ (format out "~%~{~S~%~}~%"
+ `((cffi:define-foreign-library ,library-name
+ (t (:or
+ ,(format nil "~A" (make-pathname
+ :type (pathname-type lib-file)
+ :name (pathname-name lib-file)))
+
+ ,(pathname-name lib-file)
+ )))
+ (cffi:load-foreign-library ',library-name)))
+ (dolist (form lisp-forms)
+ (print form out))
+ (terpri out)))
lisp-file))
(defun lib-filename (defaults)
@@ -669,7 +679,7 @@
;;; *PACKAGE* is rebound so that the IN-PACKAGE form can set it during
;;; *the extent of a given wrapper file.
-(defun process-wrapper-file (input-file &optional (output-defaults input-file))
+(defun process-wrapper-file (input-file output-defaults)
(with-standard-io-syntax
(let ((lib-file (lib-filename output-defaults)))
(multiple-value-bind (c-file lisp-forms)
diff -rN -u old-cffi/src/cffi-sbcl.lisp new-cffi/src/cffi-sbcl.lisp
--- old-cffi/src/cffi-sbcl.lisp 2009-07-17 16:41:06.000000000 +0900
+++ new-cffi/src/cffi-sbcl.lisp 2009-07-17 16:41:06.000000000 +0900
@@ -324,7 +324,7 @@
(defun %load-foreign-library (name path)
"Load a foreign library."
(declare (ignore name))
- (load-shared-object path))
+ (load-shared-object path :dont-save t))
;;; SBCL 1.0.21.15 renamed SB-ALIEN::SHARED-OBJECT-FILE but introduced
;;; SB-ALIEN:UNLOAD-SHARED-OBJECT which we can use instead.
diff -rN -u old-cffi/src/libraries.lisp new-cffi/src/libraries.lisp
--- old-cffi/src/libraries.lisp 2009-07-17 16:41:06.000000000 +0900
+++ new-cffi/src/libraries.lisp 2009-07-17 16:41:06.000000000 +0900
@@ -104,7 +104,7 @@
(defclass foreign-library ()
((spec :initarg :spec)
(options :initform nil :initarg :options)
- (handle :initarg :handle :accessor foreign-library-handle)))
+ (handle :initarg ::handle :accessor foreign-library-handle)))
(defun get-foreign-library (lib)
"Look up a library by NAME, signalling an error if not found."
@@ -113,6 +113,10 @@
(or (gethash lib *foreign-libraries*)
(error "Undefined foreign library: ~S" lib))))
+(defun foreign-library-loaded-p (lib)
+ (let ((lib (get-foreign-library lib)))
+ (and (slot-boundp lib 'handle) (foreign-library-handle lib))))
+
(defun (setf get-foreign-library) (value name)
(setf (gethash name *foreign-libraries*) value))
@@ -211,7 +215,7 @@
(return-from try-foreign-library-alternatives handle)))
;; Perhaps we should show the error messages we got for each
;; alternative if we can figure out a nice way to do that.
- (fl-error "Unable to load any of the alternatives:~% ~S" library-list))
+ (fl-error "Unable to load the ~A foreign library; the alternatives tried were:~% ~S" name library-list))
(defparameter *cffi-feature-suffix-map*
'((:windows . ".dll")
@@ -254,12 +258,16 @@
(let* ((lib (get-foreign-library library))
(spec (foreign-library-spec lib)))
(when spec
- (setf (foreign-library-handle lib)
- (load-foreign-library-helper library spec))
+ (unless (foreign-library-loaded-p lib)
+ (setf (foreign-library-handle lib)
+ (load-foreign-library-helper library spec)))
+ (assert (foreign-library-loaded-p lib))
lib)))
(t
- (make-instance 'foreign-library :spec (list (list library))
- :handle (load-foreign-library-helper nil library))))
+ (let ((lib (make-instance 'foreign-library :spec (list (list library))
+ :handle (load-foreign-library-helper nil library))))
+ (assert (foreign-library-loaded-p lib))
+ lib)))
;; Offer these restarts that will retry the call to
;; LOAD-FOREIGN-LIBRARY.
(retry ()
@@ -282,3 +290,39 @@
(%close-foreign-library (foreign-library-handle lib))
(setf (foreign-library-handle lib) nil)
t)))
+
+(defun list-open-library-names ()
+ (loop for name being the hash-keys of *foreign-libraries* using (hash-value lib)
+ when (foreign-library-loaded-p lib)
+ collect name))
+
+(defun load-foreign-libraries (list)
+ ;; we have no way of checking the dependencies between libraries
+ ;; so load all of them in the list, and if at least one succeeded, keep going
+ (labels ((load-at-least-one (list)
+ (let ((list (remove-if 'foreign-library-loaded-p list)))
+ (when list
+ (let (one-success)
+ (loop for lib in list do
+
+ ;; muffle warnings to avoid printing messages
+ ;; about undefined symbols etc. in the trial
+ ;; phase
+ (handler-bind ((warning #'muffle-warning))
+ (ignore-errors (load-foreign-library lib)
+ (setf one-success t))))
+
+ (unless one-success
+ ;; this will probably raise the error again, but if not then fine, we have loaded it
+ (loop for lib in list do
+ (load-foreign-library lib))))
+
+ (load-at-least-one list)))))
+ (load-at-least-one list)))
+
+(defun close-all-foreign-libraries ()
+ (mapcar 'close-foreign-library (list-open-library-names)))
+
+(defmacro do-reload-all-compile-time-open-libraries ()
+ `(load-foreign-libraries ',(list-open-library-names)))
+
diff -rN -u old-cffi/src/package.lisp new-cffi/src/package.lisp
--- old-cffi/src/package.lisp 2009-07-17 16:41:06.000000000 +0900
+++ new-cffi/src/package.lisp 2009-07-17 16:41:06.000000000 +0900
@@ -79,6 +79,9 @@
#:load-foreign-library-error
#:use-foreign-library
#:close-foreign-library
+ #:do-reload-all-compile-time-open-libraries
+ #:close-all-foreign-libraries
+ #:list-open-library-names
;; Callbacks.
#:callback
_______________________________________________
cffi-devel mailing list
cffi-devel@common-lisp.net
http://common-lisp.net/cgi-bin/mailman/listinfo/cffi-devel
