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