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

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