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 from sb-bsd-sockets.asd,
  10 ;;; but extended to allow flags to be set in a general way. The class
  11 ;;; has been renamed from unix-dso to shared-object as this code no
  12 ;;; longer is unix specific
  13
  14 (defclass shared-object (module)
  15   ((ldflags :initform nil :initarg :ldflags)))
  16
  17 ;; For backwards compatibility
  18 (defclass unix-dso (shared-object)
  19   ())
  20
  21 (defun ensure-namestring (pathname)
  22   (namestring
  23    (typecase pathname
  24      (logical-pathname (translate-logical-pathname pathname))
  25      (t pathname))))
  26
  27 (defmethod input-files ((operation compile-op) (dso shared-object))
  28   (mapcar #'component-pathname (module-components dso)))
  29
  30 (defmethod output-files ((operation compile-op) (dso shared-object))
  31   (let ((dir (component-pathname dso)))
  32     (list
  33      (make-pathname :type *dso-extension*
  34                     :name (component-name dso)
  35                     :directory (butlast (pathname-directory dir))
  36                     :defaults dir))))
  37
  38 (defmethod perform :after ((operation compile-op) (dso shared-object))
  39   (let ((output (first (output-files operation dso)))
  40         (inputs (mapcar #'ensure-namestring
  41                  (mapcan #'(lambda (c)
  42                              (output-files operation c))
  43                   (module-components dso)))))
  44     (unless (zerop
  45              (run-shell-command "gcc ~A -o ~S ~{~S~^ ~} ~{~A~^ ~}"
  46               #-(or darwin win32)"-shared"
  47               #+darwin "-bundle"
  48               #+win32
  49               (format nil "-shared -Wl,--out-implib,~S"
  50                (ensure-namestring
  51                 (make-pathname
  52                  :type "a"
  53                  :name (format nil "lib~Adll" (pathname-name output))
  54                  :defaults output)))
  55               (ensure-namestring output)
  56               inputs
  57               (slot-value dso 'ldflags)))
  58       (error 'operation-error :operation operation :component dso))))
  59
  60 #+clisp
  61 (defvar *loaded-libraries* ())
  62
  63 (defun load-shared-object (pathname)
  64   (let ((namestring (ensure-namestring pathname)))
  65     #+sbcl(sb-alien:load-shared-object namestring)
  66     #+cmu(ext:load-foreign namestring)
  67     #+clisp
  68     (unless (find namestring *loaded-libraries* :test #'equal)
  69       (ffi::foreign-library namestring)
  70       (push namestring *loaded-libraries*))))
  71
  72
  73 (defmethod perform ((o load-op) (c shared-object))
  74   (let ((co (make-instance 'compile-op)))
  75     (let ((pathname (car (output-files co c))))
  76       (load-shared-object pathname))))
  77
  78
  79
  80 (defclass c-source-file (source-file)
  81   ((cflags :initform nil :initarg :cflags)
  82    (optimization :initform 2 :initarg :optimization)
  83    (definitions :initform nil :initarg :definitions)
  84    (include-paths :initform nil :initarg :include-paths)))
  85
  86
  87 (defmethod output-files ((op compile-op) (c c-source-file))
  88   (list (make-pathname :type "o" :defaults (component-pathname c))))
  89
  90
  91 (defmethod perform ((op compile-op) (c c-source-file))
  92   (unless
  93       (= 0 (run-shell-command "gcc ~A~{ ~A~} -o ~S -c ~S"
  94             #-win32 "-fPIC"
  95             #+win32 "-DBUILD_DLL"
  96             (nconc
  97              (when (slot-value c 'optimization)
  98                (list (format nil "-O~A" (slot-value c 'optimization))))
  99              (loop
 100               for symbol in (slot-value c 'definitions)
 101               collect (format nil "-D~A" symbol))
 102              (loop
 103               for path in (slot-value c 'include-paths)
 104               collect (format nil "-I~A" path))
 105              (slot-value c 'cflags))
 106             (ensure-namestring (first (output-files op c)))
 107             (ensure-namestring (component-pathname c))))
 108     (error 'operation-error :operation op :component c)))
 109
 110
 111 (defmethod perform ((operation load-op) (c c-source-file))
 112   t)
 113
 114
 115 ;;; Shared libraries
 116
 117 (defclass library (component)
 118   ((libdir :initarg :libdir :initform nil)
 119    (libname :initarg :libname :initform nil)))
 120
 121
 122 (defun split-path (path)
 123   (labels ((split (path)
 124              (unless (zerop (length path))
 125                (let ((slash (position #\/ path)))
 126                  (if slash
 127                      (cons (subseq path 0 slash) (split (subseq path (1+ slash))))
 128                    (list path))))))
 129     (if (and (not (zerop (length path))) (char= (char path 0) #\/))
 130         (cons :absolute (split (subseq path 1)))
 131       (cons :relative (split path)))))
 132
 133
 134 (defmethod component-pathname ((lib library))
 135   (make-pathname :type *dso-extension*
 136                  :name (or (slot-value lib 'libname) (component-name lib))
 137                  :directory (split-path (slot-value lib 'libdir))))
 138
 139 (defmethod perform ((o load-op) (c library))
 140   (load-shared-object (component-pathname c)))
 141
 142 (defmethod perform ((operation operation) (c library))
 143   nil)
 144
 145 (defmethod operation-done-p ((o load-op) (c library))
 146   (let ((namestring (ensure-namestring (component-pathname c))))
 147     #+sbcl(find namestring sb-alien::*shared-objects* :key #'sb-alien::shared-object-file :test #'equal)
 148     #+cmu(rassoc namestring system::*global-table* :test #'equal)
 149     #+clisp(find namestring *loaded-libraries* :test #'equal)))
 150
 151 (defmethod operation-done-p ((o operation) (c library))
 152   t)