X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;ds=sidebyside;f=src%2Flibraries.cl;h=29320469a59c7a56352c2c58fcf04d9bdb2c46e9;hb=46fbc92bfdcb2504d863929bde42962275e80e74;hp=f88a20720be8a86e4c620b62e9adf5eaf418590d;hpb=8d16d732a80b76c913f4b62b9fe043af39e5bce2;p=uffi.git diff --git a/src/libraries.cl b/src/libraries.cl index f88a207..2932046 100644 --- a/src/libraries.cl +++ b/src/libraries.cl @@ -1,4 +1,4 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: libraries.cl,v 1.7 2002/04/01 00:52:07 kevin Exp $ +;;;; $Id: libraries.cl,v 1.14 2002/04/06 19:53:08 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -25,22 +25,48 @@ (defun default-foreign-library-type () "Returns string naming default library type for platform" #+(or win32 mswindows) "dll" - #+freebsd "a" - #+linux "so") + #-(or win32 mswindows) "so") -(defun find-foreign-library (name &key directories type) +(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 type - (setq type (default-foreign-library-type))) + (unless types + (setq types (default-foreign-library-type))) + (unless (listp types) + (setq types (list types))) + (unless (listp names) + (setq names (list names))) (unless (listp directories) (setq directories (list directories))) - (dolist (dir directories) - (let ((path (make-pathname :name :type type :directory directory))) - (when (probe-file path) - (return path)))) - nil) + #+(or win32 mswindows) + (unless (listp drive-letters) + (setq drive-letters (list drive-letters))) + #-(or win32 mswindows) + (setq drive-letters '(nil)) + (dolist (drive-letter drive-letters) + (dolist (name names) + (dolist (dir directories) + (dolist (type types) + (let ((path (make-pathname + #+lispworks :host + #+lispworks (when drive-letter drive-letter) + #-lispworks :device + #-lispworks (when drive-letter drive-letter) + :name name + :type type + :directory + (etypecase dir + (pathname + (pathname-directory dir)) + (list + dir) + (string + (pathname-directory + (parse-namestring dir))))))) + (when (probe-file path) + (return-from find-foreign-library path))))))) + nil) (defun load-foreign-library (filename &key module supporting-libraries @@ -57,12 +83,16 @@ library type if type is not specified." (find filename *loaded-libraries* :test #'string-equal)) t ;; return T, but don't reload library (progn - #+cmu (alien:load-foreign filename + #+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)) + supporting-libraries)))) + #+lispworks (fli:register-module module - :connection-style :automatic :real-name filename) #+allegro (load filename)