src/libraries.cl

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          libraries.cl
   6 ;;;; Purpose:       UFFI source to load foreign libraries
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Feb 2002
   9 ;;;;
  10 ;;;; Copyright (c) 2002 Kevin M. Rosenberg
  11 ;;;;
  12 ;;;; $Id: libraries.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
  13 ;;;;
  14 ;;;; This file is part of the UFFI.
  15 ;;;;
  16 ;;;; UFFI is free software; you can redistribute it and/or modify
  17 ;;;; it under the terms of the GNU General Public License (version 2) as
  18 ;;;; published by the Free Software Foundation.
  19 ;;;;
  20 ;;;; UFFI is distributed in the hope that it will be useful,
  21 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;;;; GNU General Public License for more details.
  24 ;;;;
  25 ;;;; You should have received a copy of the GNU General Public License
  26 ;;;; along with UFFI; if not, write to the Free Software
  27 ;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  28 ;;;; *************************************************************************
  29
  30 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
  31 (in-package :uffi)
  32
  33 (defvar *loaded-libraries* nil
  34   "List of foreign libraries loaded. Used to prevent reloading a library")
  35
  36 (defun load-foreign-library (filename module supporting-libraries)
  37   #+allegro (declare (ignore module supporting-libraries))
  38   #+lispworks  (declare (ignore supporting-libraries))
  39   #+cmu (declare (ignore module))
  40
  41   (when (and filename (probe-file filename))
  42     (if (find filename *loaded-libraries* :test #'string-equal)
  43         t ;; return T, but don't reload library
  44       (progn
  45         #+cmu (alien:load-foreign filename
  46                                   :libraries
  47                                   (convert-supporting-libraries-to-string
  48                                    supporting-libraries))
  49         #+lispworks (fli:register-module module :connection-style :automatic
  50                                          :real-name filename)
  51         #+allegro (load filename)
  52
  53         (push filename *loaded-libraries*))))
  54   )
  55
  56 (defun convert-supporting-libraries-to-string (libs)
  57   (let (lib-load-list)
  58     (dolist (lib libs)
  59       (push (format nil "-l~A" lib) lib-load-list))
  60     (nreverse lib-load-list)))