77dd2192 |
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 | |