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

   1 (in-package :asdf)
   2
   3 (defun concatenate-strings (strings &optional delimiter)
   4   (if (not (rest strings))
   5       (first strings)
   6     (concatenate
   7      'string
   8      (first strings)
   9      (if delimiter (string delimiter) "")
  10      (concatenate-strings (rest strings) delimiter))))
  11
  12 ;;; The following code is more or less copied frm sb-bsd-sockets.asd,
  13 ;;; but extended to allow flags set in a general way
  14
  15 (defclass unix-dso (module) ())
  16 (defun unix-name (pathname)
  17   (namestring
  18    (typecase pathname
  19      (logical-pathname (translate-logical-pathname pathname))
  20      (t pathname))))
  21
  22 (defmethod asdf::input-files ((operation compile-op) (dso unix-dso))
  23   (mapcar #'component-pathname (module-components dso)))
  24
  25 (defmethod output-files ((operation compile-op) (dso unix-dso))
  26   (let ((dir (component-pathname dso)))
  27     (list
  28      (make-pathname :type "so"
  29                     :name (car (last (pathname-directory dir)))
  30                     :directory (butlast (pathname-directory dir))
  31                     :defaults dir))))
  32
  33
  34 (defmethod perform :after ((operation compile-op) (dso unix-dso))
  35   (let ((dso-name (unix-name (car (output-files operation dso)))))
  36     (unless (zerop
  37              (run-shell-command
  38               "gcc ~A -o ~S ~{~S ~}"
  39               (concatenate 'string
  40 ;;                         (sb-ext:posix-getenv "EXTRA_LDFLAGS")
  41 ;;                         " "
  42                            #+sunos "-shared -lresolv -lsocket -lnsl"
  43                            #+darwin "-bundle"
  44                            #-(or darwin sunos) "-shared")
  45               dso-name
  46               (mapcar #'unix-name
  47                       (mapcan (lambda (c)
  48                                 (output-files operation c))
  49                               (module-components dso)))))
  50       (error 'operation-error :operation operation :component dso))))
  51
  52 (defmethod perform ((o load-op) (c unix-dso))
  53   (let ((co (make-instance 'compile-op)))
  54     (let ((filename (car (output-files co c))))
  55       #+cmu (ext:load-foreign filename)
  56       #+sbcl (sb-alien:load-shared-object filename))))
  57
  58
  59
  60 (defclass c-source-file (source-file)
  61   ((cflags :initform nil :initarg :cflags)
  62    (optimization :initform 2 :initarg :optimization)
  63    (definitions :initform nil :initarg :definitions)
  64    (include-paths :initform nil :initarg :include-paths)))
  65
  66
  67 (defmethod output-files ((op compile-op) (c c-source-file))
  68   (list
  69    (make-pathname :type "o" :defaults
  70                   (component-pathname c))))
  71
  72
  73 (defmethod perform ((op compile-op) (c c-source-file))
  74   (unless
  75       (= 0 (run-shell-command "gcc ~A -o ~S -c ~S"
  76             (concatenate-strings
  77              (append
  78               (list "-fPIC")
  79               (when (slot-value c 'optimization)
  80                 (list (format nil "-O~A" (slot-value c 'optimization))))
  81               (loop
  82                for symbol in (slot-value c 'definitions)
  83                collect (format nil "-D~A" symbol))
  84               (loop
  85                for path in (slot-value c 'include-paths)
  86                collect (format nil "-I~A" path))
  87               (slot-value c 'cflags))
  88              #\sp)
  89             (unix-name (car (output-files op c)))
  90             (unix-name (component-pathname c))))
  91     (error 'operation-error :operation op :component c)))
  92
  93
  94 (defmethod perform ((operation load-op) (c c-source-file))
  95   t)
  96
  97