chiark - git - mdw - clg/blob - tools/asdf-extensions.lisp

   1 (in-package :asdf)
   2
   3 (export '*dso-extension*)
   4
   5 (defparameter *dso-extension*
   6  #-(or darwin win32)"so" #+darwin"dylib" #+win32"dll")
   7
   8
   9 ;;; The following code is more or less copied frm sb-bsd-sockets.asd,
  10 ;;; but extended to allow flags to be set in a general way
  11
  12 (defclass unix-dso (module)
  13   ((ldflags :initform nil :initarg :ldflags)))
  14
  15 (defun unix-name (pathname)
  16   (namestring
  17    (typecase pathname
  18      (logical-pathname (translate-logical-pathname pathname))
  19      (t pathname))))
  20
  21 (defmethod input-files ((operation compile-op) (dso unix-dso))
  22   (mapcar #'component-pathname (module-components dso)))
  23
  24 (defmethod output-files ((operation compile-op) (dso unix-dso))
  25   (let ((dir (component-pathname dso)))
  26     (list
  27      (make-pathname :type *dso-extension*
  28                     :name (car (last (pathname-directory dir)))
  29                     :directory (butlast (pathname-directory dir))
  30                     :defaults dir))))
  31
  32 (defmethod perform :after ((operation compile-op) (dso unix-dso))
  33   (let ((output (first (output-files operation dso)))
  34         (inputs (mapcar #'unix-name
  35                  (mapcan #'(lambda (c)
  36                              (output-files operation c))
  37                   (module-components dso)))))
  38     (unless (zerop
  39              (run-shell-command "gcc ~A -o ~S ~{~S~^ ~} ~{~A~^ ~}"
  40               #-(or darwin win32)"-shared"
  41               #+darwin "-bundle"
  42               #+win32
  43               (format nil "-shared -Wl,--out-implib,~S"
  44                (unix-name
  45                 (make-pathname
  46                  :type "a"
  47                  :name (format nil "lib~Adll" (pathname-name output))
  48                  :defaults output)))
  49               (unix-name output)
  50               inputs
  51               (slot-value dso 'ldflags)))
  52       (error 'operation-error :operation operation :component dso))))
  53
  54 #+clisp
  55 (defvar *loaded-libraries* ())
  56
  57 (defun load-dso (filename)
  58   #+sbcl(sb-alien:load-shared-object filename)
  59   #+cmu(ext:load-foreign filename)
  60   #+clisp
  61   (unless (find filename *loaded-libraries* :test #'equal)
  62     (ffi::foreign-library (namestring filename))
  63     (push filename *loaded-libraries*)))
  64
  65
  66 (defmethod perform ((o load-op) (c unix-dso))
  67   (let ((co (make-instance 'compile-op)))
  68     (let ((filename (car (output-files co c))))
  69       (load-dso filename))))
  70
  71
  72
  73 (defclass c-source-file (source-file)
  74   ((cflags :initform nil :initarg :cflags)
  75    (optimization :initform 2 :initarg :optimization)
  76    (definitions :initform nil :initarg :definitions)
  77    (include-paths :initform nil :initarg :include-paths)))
  78
  79
  80 (defmethod output-files ((op compile-op) (c c-source-file))
  81   (list (make-pathname :type "o" :defaults (component-pathname c))))
  82
  83
  84 (defmethod perform ((op compile-op) (c c-source-file))
  85   (unless
  86       (= 0 (run-shell-command "gcc ~A~{ ~A~} -o ~S -c ~S"
  87             #-win32 "-fPIC"
  88             #+win32 "-DBUILD_DLL"
  89             (nconc
  90              (when (slot-value c 'optimization)
  91                (list (format nil "-O~A" (slot-value c 'optimization))))
  92              (loop
  93               for symbol in (slot-value c 'definitions)
  94               collect (format nil "-D~A" symbol))
  95              (loop
  96               for path in (slot-value c 'include-paths)
  97               collect (format nil "-I~A" path))
  98              (slot-value c 'cflags))
  99             (unix-name (first (output-files op c)))
 100             (unix-name (component-pathname c))))
 101     (error 'operation-error :operation op :component c)))
 102
 103
 104 (defmethod perform ((operation load-op) (c c-source-file))
 105   t)
 106
 107
 108 ;;; Shared libraries
 109
 110 (defclass library (component)
 111   ((libdir :initarg :libdir)
 112    (libname :initarg :libname :initform nil)))
 113
 114
 115 (defun split-path (path)
 116   (labels ((split (path)
 117              (unless (zerop (length path))
 118                (let ((slash (position #\/ path)))
 119                  (if slash
 120                      (cons (subseq path 0 slash) (split (subseq path (1+ slash))))
 121                    (list path))))))
 122     (if (and (not (zerop (length path))) (char= (char path 0) #\/))
 123         (cons :absolute (split (subseq path 1)))
 124       (cons :relative (split path)))))
 125
 126
 127 (defmethod component-pathname ((lib library))
 128   (make-pathname :type *dso-extension*
 129                  :name (or (slot-value lib 'libname) (component-name lib))
 130                  :directory (split-path (slot-value lib 'libdir))))
 131
 132 ;; --fix: is UNIX-NAME really necessary for win32?  i know it will bomb
 133 ;;        without using it while doing (ASDF:OOS 'ASDF:LOAD-OP :GLIB) but
 134 ;;        loading the complete pathname for libglib-2.0-0.dll with
 135 ;;        SB-ALIEN:LOAD-SHARED-OBJECT by hand won't explode.  weird.
 136 ;;         - cph 18-May-2007
 137 (defmethod perform ((o load-op) (c library))
 138   (load-dso #-win32 (component-pathname c)
 139             #+win32 (unix-name (component-pathname c))))
 140
 141 (defmethod perform ((operation operation) (c library))
 142   nil)
 143
 144 (defmethod operation-done-p ((o load-op) (c library))
 145   #+sbcl(find (sb-ext::unix-namestring (component-pathname c)) sb-alien::*shared-objects* :key #'sb-alien::shared-object-file :test #'equal)
 146   #+cmu(rassoc (unix::unix-namestring (component-pathname c))
 147         system::*global-table*
 148         :key #'(lambda (pathname)
 149                  (when pathname (unix::unix-namestring pathname)))
 150         :test #'equal)
 151   #+clisp(find (component-pathname c) *loaded-libraries* :test #'equal))
 152
 153 (defmethod operation-done-p ((o operation) (c library))
 154   t)