1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
3 ;;; libraries.lisp --- Finding and loading foreign libraries.
5 ;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
6 ;;; Copyright (C) 2006-2007, Luis Oliveira <loliveira@common-lisp.net>
8 ;;; Permission is hereby granted, free of charge, to any person
9 ;;; obtaining a copy of this software and associated documentation
10 ;;; files (the "Software"), to deal in the Software without
11 ;;; restriction, including without limitation the rights to use, copy,
12 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
13 ;;; of the Software, and to permit persons to whom the Software is
14 ;;; furnished to do so, subject to the following conditions:
16 ;;; The above copyright notice and this permission notice shall be
17 ;;; included in all copies or substantial portions of the Software.
19 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
20 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
21 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
22 ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
23 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
24 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
25 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
26 ;;; DEALINGS IN THE SOFTWARE.
31 ;;;# Finding Foreign Libraries
33 ;;; We offer two ways for the user of a CFFI library to define
34 ;;; his/her own library directories: *FOREIGN-LIBRARY-DIRECTORIES*
35 ;;; for regular libraries and *DARWIN-FRAMEWORK-DIRECTORIES* for
36 ;;; Darwin frameworks.
38 ;;; These two special variables behave similarly to
39 ;;; ASDF:*CENTRAL-REGISTRY* as its arguments are evaluated before
40 ;;; being used. We used our MINI-EVAL instead of the full-blown EVAL
43 ;;; Only after failing to find a library through the normal ways
44 ;;; (eg: on Linux LD_LIBRARY_PATH, /etc/ld.so.cache, /usr/lib/, /lib)
45 ;;; do we try to find the library ourselves.
47 (defvar *foreign-library-directories
* '()
48 "List onto which user-defined library paths can be pushed.")
50 (defvar *darwin-framework-directories
*
51 '((merge-pathnames #p
"Library/Frameworks/" (user-homedir-pathname))
52 #p
"/Library/Frameworks/"
53 #p
"/System/Library/Frameworks/")
54 "List of directories where Frameworks are searched for.")
56 (defun mini-eval (form)
57 "Simple EVAL-like function to evaluate the elements of
58 *FOREIGN-LIBRARY-DIRECTORIES* and *DARWIN-FRAMEWORK-DIRECTORIES*."
60 (cons (apply (car form
) (mapcar #'mini-eval
(cdr form
))))
61 (symbol (symbol-value form
))
64 (defun find-file (path directories
)
65 "Searches for PATH in a list of DIRECTORIES and returns the first it finds."
66 (some (lambda (directory) (probe-file (merge-pathnames path directory
)))
69 (defun find-darwin-framework (framework-name)
70 "Searches for FRAMEWORK-NAME in *DARWIN-FRAMEWORK-DIRECTORIES*."
71 (dolist (framework-directory *darwin-framework-directories
*)
72 (let ((path (make-pathname
75 (append (pathname-directory (mini-eval framework-directory
))
76 (list (format nil
"~A.framework" framework-name
))))))
77 (when (probe-file path
)
78 (return-from find-darwin-framework path
)))))
80 ;;;# Defining Foreign Libraries
82 ;;; Foreign libraries can be defined using the
83 ;;; DEFINE-FOREIGN-LIBRARY macro. Example usage:
85 ;;; (define-foreign-library opengl
86 ;;; (:darwin (:framework "OpenGL"))
87 ;;; (:unix (:or "libGL.so" "libGL.so.1"
88 ;;; #p"/myhome/mylibGL.so"))
89 ;;; (:windows "opengl32.dll")
90 ;;; ;; an hypothetical example of a particular platform
91 ;;; ((:and :some-system :some-cpu) "libGL-support.lib")
92 ;;; ;; if no other clauses apply, this one will and a type will be
93 ;;; ;; automagically appended to the name passed to :default
94 ;;; (t (:default "libGL")))
96 ;;; This information is stored in the *FOREIGN-LIBRARIES* hashtable
97 ;;; and when the library is loaded through LOAD-FOREIGN-LIBRARY (or
98 ;;; USE-FOREIGN-LIBRARY) the first clause matched by CFFI-FEATURE-P is
101 (defvar *foreign-libraries
* (make-hash-table :test
'eq
)
102 "Hashtable of defined libraries.")
104 (defclass foreign-library
()
105 ((spec :initarg
:spec
)
106 (options :initform nil
:initarg
:options
)
107 (handle :initarg
:handle
:accessor foreign-library-handle
)))
109 (defun get-foreign-library (lib)
110 "Look up a library by NAME, signalling an error if not found."
111 (if (typep lib
'foreign-library
)
113 (or (gethash lib
*foreign-libraries
*)
114 (error "Undefined foreign library: ~S" lib
))))
116 (defun (setf get-foreign-library
) (value name
)
117 (setf (gethash name
*foreign-libraries
*) value
))
119 (defun %foreign-library-spec
(lib)
120 (assoc-if #'cffi-feature-p
(slot-value lib
'spec
)))
122 (defun foreign-library-spec (lib)
123 (second (%foreign-library-spec lib
)))
125 (defun foreign-library-options (lib)
126 (append (cddr (%foreign-library-spec lib
))
127 (slot-value lib
'options
)))
129 ;;; Warn about unkown options.
130 (defmethod initialize-instance :after
((lib foreign-library
) &key
)
132 on
(append (slot-value lib
'options
)
133 (mapcan (lambda (x) (copy-list (cddr x
)))
134 (slot-value lib
'spec
)))
136 when
(not (member opt
'(:cconv
:calling-convention
)))
137 do
(warn "Unkown option: ~A" opt
)))
139 (defmacro define-foreign-library
(name-and-options &body pairs
)
140 "Defines a foreign library NAME that can be posteriorly used with
141 the USE-FOREIGN-LIBRARY macro."
142 (destructuring-bind (name . options
)
143 (ensure-list name-and-options
)
145 (setf (get-foreign-library ',name
)
146 (make-instance 'foreign-library
147 :spec
',pairs
:options
',options
))
150 ;;;# LOAD-FOREIGN-LIBRARY-ERROR condition
152 ;;; The various helper functions that load foreign libraries can
153 ;;; signal this error when something goes wrong. We ignore the host's
154 ;;; error. We should probably reuse its error message.
156 (define-condition load-foreign-library-error
(simple-error)
159 (defun read-new-value ()
160 (format *query-io
* "~&Enter a new value (unevaluated): ")
161 (force-output *query-io
*)
164 (defun fl-error (control &rest arguments
)
165 (error 'load-foreign-library-error
166 :format-control control
167 :format-arguments arguments
))
169 ;;;# Loading Foreign Libraries
171 (defun load-darwin-framework (name framework-name
)
172 "Tries to find and load a darwin framework in one of the directories
173 in *DARWIN-FRAMEWORK-DIRECTORIES*. If unable to find FRAMEWORK-NAME,
174 it signals a LOAD-FOREIGN-LIBRARY-ERROR."
175 (let ((framework (find-darwin-framework framework-name
)))
177 (load-foreign-library-path name
(native-namestring framework
))
178 (fl-error "Unable to find framework ~A" framework-name
))))
180 (defun report-simple-error (name error
)
181 (fl-error "Unable to load foreign library (~A).~% ~A"
183 (format nil
"~?" (simple-condition-format-control error
)
184 (simple-condition-format-arguments error
))))
186 ;;; FIXME: haven't double checked whether all Lisps signal a
187 ;;; SIMPLE-ERROR on %load-foreign-library failure. In any case they
188 ;;; should be throwing a more specific error.
189 (defun load-foreign-library-path (name path
)
190 "Tries to load PATH using %LOAD-FOREIGN-LIBRARY which should try and
191 find it using the OS's usual methods. If that fails we try to find it
194 (%load-foreign-library name path
)
196 (if-let (file (find-file path
*foreign-library-directories
*))
198 (%load-foreign-library name
(native-namestring file
))
199 (simple-error (error)
200 (report-simple-error name error
)))
201 (report-simple-error name error
)))))
203 (defun try-foreign-library-alternatives (name library-list
)
204 "Goes through a list of alternatives and only signals an error when
205 none of alternatives were successfully loaded."
206 (dolist (lib library-list
)
207 (when-let (handle (ignore-errors (load-foreign-library-helper name lib
)))
208 (return-from try-foreign-library-alternatives handle
)))
209 ;; Perhaps we should show the error messages we got for each
210 ;; alternative if we can figure out a nice way to do that.
211 (fl-error "Unable to load any of the alternatives:~% ~S" library-list
))
213 (defparameter *cffi-feature-suffix-map
*
214 '((cffi-features:windows .
".dll")
215 (cffi-features:darwin .
".dylib")
216 (cffi-features:unix .
".so")
218 "Mapping of OS feature keywords to shared library suffixes.")
220 (defun default-library-suffix ()
221 "Return a string to use as default library suffix based on the
222 operating system. This is used to implement the :DEFAULT option.
223 This will need to be extended as we test on more OSes."
224 (or (cdr (assoc-if #'cffi-feature-p
*cffi-feature-suffix-map
*))
225 (fl-error "Unable to determine the default library suffix on this OS.")))
227 (defun load-foreign-library-helper (name thing
)
230 (load-foreign-library-path name thing
))
232 (load-foreign-library-path name
(namestring thing
)))
235 (:framework
(load-darwin-framework name
(second thing
)))
237 (unless (stringp (second thing
))
238 (fl-error "Argument to :DEFAULT must be a string."))
239 (load-foreign-library-path
240 name
(concatenate 'string
(second thing
) (default-library-suffix))))
241 (:or
(try-foreign-library-alternatives name
(rest thing
)))))))
243 (defun load-foreign-library (library)
244 "Loads a foreign LIBRARY which can be a symbol denoting a library defined
245 through DEFINE-FOREIGN-LIBRARY; a pathname or string in which case we try to
246 load it directly first then search for it in *FOREIGN-LIBRARY-DIRECTORIES*;
247 or finally list: either (:or lib1 lib2) or (:framework <framework-name>)."
251 (let* ((lib (get-foreign-library library
))
252 (spec (foreign-library-spec lib
)))
254 (setf (foreign-library-handle lib
)
255 (load-foreign-library-helper library spec
))
258 (make-instance 'foreign-library
:spec
(list (list library
))
259 :handle
(load-foreign-library-helper nil library
))))
260 ;; Offer these restarts that will retry the call to
261 ;; LOAD-FOREIGN-LIBRARY.
263 :report
"Try loading the foreign library again."
264 (load-foreign-library library
))
265 (use-value (new-library)
266 :report
"Use another library instead."
267 :interactive read-new-value
268 (load-foreign-library new-library
))))
270 (defmacro use-foreign-library
(name)
271 `(load-foreign-library ',name
))
273 ;;;# Closing Foreign Libraries
275 (defun close-foreign-library (library)
276 "Closes a foreign library."
277 (let ((lib (get-foreign-library library
)))
278 (when (foreign-library-handle lib
)
279 (%close-foreign-library
(foreign-library-handle lib
))
280 (setf (foreign-library-handle lib
) nil
)