;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; Name: libraries.cl
+;;;; Name: libraries.lisp
;;;; Purpose: UFFI source to load foreign libraries
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: libraries.lisp,v 1.4 2002/10/16 11:56:43 kevin Exp $
+;;;; $Id$
;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :uffi)
+(in-package #:uffi)
(defvar *loaded-libraries* nil
"List of foreign libraries loaded. Used to prevent reloading a library")
(defun default-foreign-library-type ()
"Returns string naming default library type for platform"
- #+(or win32 mswindows) "dll"
- #+macosx "dylib"
- #-(or win32 mswindows macosx) "so"
+ #+(or win32 cygwin mswindows) "dll"
+ #+(or macosx darwin ccl-5.0) "dylib"
+ #-(or win32 cygwin mswindows macosx darwin ccl-5.0) "so"
)
-(defun find-foreign-library (names directories &key types drive-letters)
+(defun foreign-library-types ()
+ "Returns list of string naming possible library types for platform, sorted by preference"
+ #+(or win32 mswindows) '("dll" "lib")
+ #+(or macosx darwin ccl-5.0) '("dylib" "bundle")
+ #-(or win32 mswindows macosx darwin ccl-5.0) '("so" "a" "o")
+)
+
+(defun find-foreign-library (names directories &key types drive-letters)
"Looks for a foreign library. directories can be a single
string or a list of strings of candidate directories. Use default
library type if type is not specified."
(unless types
- (setq types (default-foreign-library-type)))
+ (setq types (foreign-library-types)))
(unless (listp types)
(setq types (list types)))
(unless (listp names)
(dolist (name names)
(dolist (dir directories)
(dolist (type types)
- (let ((path (make-pathname
+ (let ((path (make-pathname
#+lispworks :host
#+lispworks (when drive-letter drive-letter)
#-lispworks :device
#-lispworks (when drive-letter drive-letter)
- :name name
+ :name name
:type type
- :directory
+ :directory
(etypecase dir
(pathname
(pathname-directory dir))
(list
dir)
(string
- (pathname-directory
+ (pathname-directory
(parse-namestring dir)))))))
(when (probe-file path)
(return-from find-foreign-library path)))))))
(defun load-foreign-library (filename &key module supporting-libraries
force-load)
- #+(or allegro lispworks openmcl) (declare (ignore module supporting-libraries))
- #+(or cmu scl sbcl) (declare (ignore module))
-
- (when (and filename (probe-file filename))
- (if (pathnamep filename) ;; ensure filename is a string to check if
- (setq filename (namestring filename))) ; already loaded
+ #+(or allegro openmcl digitool sbcl) (declare (ignore module supporting-libraries))
+ #+(or cmu scl) (declare (ignore module))
+ #+lispworks (declare (ignore supporting-libraries))
+
+ (flet ((load-failure ()
+ (error "Unable to load foreign library \"~A\"." filename)))
+ (when (and filename (or (null (pathname-directory filename))
+ (probe-file filename)))
+ (if (pathnamep filename) ;; ensure filename is a string to check if already loaded
+ (setq filename (namestring (if (null (pathname-directory filename))
+ filename
+ ;; lispworks treats as UNC, so use truename
+ #+(and lispworks win32) (truename filename)
+ #-(and lispworks win32) filename))))
- (if (and (not force-load)
- (find filename *loaded-libraries* :test #'string-equal))
- t ;; return T, but don't reload library
+ (if (and (not force-load)
+ (find filename *loaded-libraries* :test #'string-equal))
+ t ;; return T, but don't reload library
(progn
#+cmu
(let ((type (pathname-type (parse-namestring filename))))
- (if (equal type "so")
- (sys::load-object-file filename)
- (alien:load-foreign filename
- :libraries
- (convert-supporting-libraries-to-string
- supporting-libraries))))
+ (if (string-equal type "so")
+ (unless
+ (sys::load-object-file filename)
+ (load-failure))
+ (alien:load-foreign filename
+ :libraries
+ (convert-supporting-libraries-to-string
+ supporting-libraries))))
#+scl
(let ((type (pathname-type (parse-namestring filename))))
- (alien:load-foreign filename
+ (alien:load-foreign filename
:libraries
(convert-supporting-libraries-to-string
supporting-libraries)))
#+sbcl
- (sb-alien:load-foreign filename
- :libraries
- (convert-supporting-libraries-to-string
- supporting-libraries))
- #+lispworks (fli:register-module module :real-name filename)
+ (handler-case (sb-alien::load-1-foreign filename)
+ (sb-int:unsupported-operator (c)
+ (if (fboundp (intern "LOAD-SHARED-OBJECT" :sb-alien))
+ (funcall (intern "LOAD-SHARED-OBJECT" :sb-alien) filename)
+ (error c))))
+
+ #+lispworks (fli:register-module module :real-name filename
+ :connection-style :immediate)
#+allegro (load filename)
#+openmcl (ccl:open-shared-library filename)
- #+(and mcl (not openmcl)) (ccl:add-to-shared-library-search-path filename t)
-
+ #+digitool (ccl:add-to-shared-library-search-path filename t)
+
(push filename *loaded-libraries*)
- t))))
+ t)))))
(defun convert-supporting-libraries-to-string (libs)
(let (lib-load-list)
projects / uffi.git / blobdiff