X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Flibraries.cl;fp=src%2Flibraries.cl;h=0000000000000000000000000000000000000000;hb=1ab81b8bacd3df5ac0558eb0deb6fee8decd6b27;hp=29320469a59c7a56352c2c58fcf04d9bdb2c46e9;hpb=4464cb9bed614c141d39ffaf72328cfc4d5a1452;p=uffi.git diff --git a/src/libraries.cl b/src/libraries.cl deleted file mode 100644 index 2932046..0000000 --- a/src/libraries.cl +++ /dev/null @@ -1,107 +0,0 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: libraries.cl -;;;; Purpose: UFFI source to load foreign libraries -;;;; Programmer: Kevin M. Rosenberg -;;;; Date Started: Feb 2002 -;;;; -;;;; $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 -;;;; -;;;; 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) - -(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" - #-(or win32 mswindows) "so") - -(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))) - (unless (listp types) - (setq types (list types))) - (unless (listp names) - (setq names (list names))) - (unless (listp directories) - (setq directories (list directories))) - #+(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 - force-load) - #+allegro (declare (ignore module supporting-libraries)) - #+lispworks (declare (ignore supporting-libraries)) - #+cmu (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 - - (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)))) - - #+lispworks (fli:register-module module - :real-name filename) - #+allegro (load filename) - - (push filename *loaded-libraries*) - t))) - ) - -(defun convert-supporting-libraries-to-string (libs) - (let (lib-load-list) - (dolist (lib libs) - (push (format nil "-l~A" lib) lib-load-list)) - (nreverse lib-load-list)))