ab15c5d9 |
1 | (in-package :asdf) |
2 | |
65d26e3e |
3 | (export '*dso-extension*) |
4 | |
3f246c3a |
5 | (defparameter *dso-extension* |
6 | #-(and darwin win32)"so" #+darwin"dylib" #+win32"dll") |
65d26e3e |
7 | |
81814a23 |
8 | |
ab15c5d9 |
9 | ;;; The following code is more or less copied frm sb-bsd-sockets.asd, |
3d36c5d6 |
10 | ;;; but extended to allow flags to be set in a general way |
ab15c5d9 |
11 | |
f729cb9b |
12 | (defclass unix-dso (module) |
13 | ((ldflags :initform nil :initarg :ldflags))) |
14 | |
ab15c5d9 |
15 | (defun unix-name (pathname) |
16 | (namestring |
17 | (typecase pathname |
18 | (logical-pathname (translate-logical-pathname pathname)) |
19 | (t pathname)))) |
20 | |
81814a23 |
21 | (defmethod input-files ((operation compile-op) (dso unix-dso)) |
ab15c5d9 |
22 | (mapcar #'component-pathname (module-components dso))) |
23 | |
24 | (defmethod output-files ((operation compile-op) (dso unix-dso)) |
25 | (let ((dir (component-pathname dso))) |
26 | (list |
65d26e3e |
27 | (make-pathname :type *dso-extension* |
ab15c5d9 |
28 | :name (car (last (pathname-directory dir))) |
29 | :directory (butlast (pathname-directory dir)) |
30 | :defaults dir)))) |
31 | |
ab15c5d9 |
32 | (defmethod perform :after ((operation compile-op) (dso unix-dso)) |
3f246c3a |
33 | (let ((output (first (output-files operation dso))) |
34 | (inputs (mapcar #'unix-name |
35 | (mapcan #'(lambda (c) |
36 | (output-files operation c)) |
37 | (module-components dso))))) |
ab15c5d9 |
38 | (unless (zerop |
3f246c3a |
39 | (run-shell-command "gcc ~A~{ ~A~} -o ~S~{ ~S~}" |
40 | #-(and darwin win32)"-shared" |
41 | #+darwin "-bundle" |
42 | #+win32 |
43 | (format nil "-shared -Wl,--out-implib,~S" |
44 | (unix-name |
45 | (make-pathname |
46 | :type "a" |
47 | :name (format nil "lib~Adll" (pathname-name output)) |
48 | :defaults output))) |
49 | (slot-value dso 'ldflags) |
50 | (unix-name output) |
51 | inputs)) |
ab15c5d9 |
52 | (error 'operation-error :operation operation :component dso)))) |
53 | |
5eda2e76 |
54 | #+clisp |
55 | (defvar *loaded-libraries* ()) |
3d36c5d6 |
56 | |
57 | (defun load-dso (filename) |
58 | #+sbcl(sb-alien:load-shared-object filename) |
5eda2e76 |
59 | #+cmu(ext:load-foreign filename) |
60 | #+clisp |
61 | (unless (find filename *loaded-libraries* :test #'equal) |
62 | (ffi::foreign-library (namestring filename)) |
63 | (push filename *loaded-libraries*))) |
81814a23 |
64 | |
65 | |
ab15c5d9 |
66 | (defmethod perform ((o load-op) (c unix-dso)) |
67 | (let ((co (make-instance 'compile-op))) |
68 | (let ((filename (car (output-files co c)))) |
81814a23 |
69 | (load-dso filename)))) |
ab15c5d9 |
70 | |
71 | |
72 | |
73 | (defclass c-source-file (source-file) |
74 | ((cflags :initform nil :initarg :cflags) |
75 | (optimization :initform 2 :initarg :optimization) |
76 | (definitions :initform nil :initarg :definitions) |
77 | (include-paths :initform nil :initarg :include-paths))) |
78 | |
79 | |
80 | (defmethod output-files ((op compile-op) (c c-source-file)) |
3d36c5d6 |
81 | (list (make-pathname :type "o" :defaults (component-pathname c)))) |
ab15c5d9 |
82 | |
83 | |
84 | (defmethod perform ((op compile-op) (c c-source-file)) |
85 | (unless |
3f246c3a |
86 | (= 0 (run-shell-command "gcc ~A~{ ~A~} -o ~S -c ~S" |
87 | #-win32 "-fPIC" |
88 | #+win32 "-DBUILD_DLL" |
89 | (nconc |
90 | (when (slot-value c 'optimization) |
91 | (list (format nil "-O~A" (slot-value c 'optimization)))) |
92 | (loop |
93 | for symbol in (slot-value c 'definitions) |
94 | collect (format nil "-D~A" symbol)) |
95 | (loop |
96 | for path in (slot-value c 'include-paths) |
97 | collect (format nil "-I~A" path)) |
98 | (slot-value c 'cflags)) |
99 | (unix-name (first (output-files op c))) |
ab15c5d9 |
100 | (unix-name (component-pathname c)))) |
101 | (error 'operation-error :operation op :component c))) |
102 | |
103 | |
104 | (defmethod perform ((operation load-op) (c c-source-file)) |
105 | t) |
106 | |
107 | |
9025e0d1 |
108 | ;;; Shared libraries |
81814a23 |
109 | |
9025e0d1 |
110 | (defclass library (component) |
d1237548 |
111 | ((libdir :initarg :libdir) |
112 | (libname :initarg :libname :initform nil))) |
81814a23 |
113 | |
114 | |
b008da5a |
115 | (defun split-path (path) |
116 | (labels ((split (path) |
117 | (unless (zerop (length path)) |
118 | (let ((slash (position #\/ path))) |
119 | (if slash |
120 | (cons (subseq path 0 slash) (split (subseq path (1+ slash)))) |
121 | (list path)))))) |
122 | (if (and (not (zerop (length path))) (char= (char path 0) #\/)) |
123 | (cons :absolute (split (subseq path 1))) |
124 | (cons :relative (split path))))) |
125 | |
81814a23 |
126 | |
127 | (defmethod component-pathname ((lib library)) |
65d26e3e |
128 | (make-pathname :type *dso-extension* |
d1237548 |
129 | :name (or (slot-value lib 'libname) (component-name lib)) |
b008da5a |
130 | :directory (split-path (slot-value lib 'libdir)))) |
81814a23 |
131 | |
3f246c3a |
132 | ;; --fix: is UNIX-NAME really necessary for win32? i know it will bomb |
133 | ;; without using it while doing (ASDF:OOS 'ASDF:LOAD-OP :GLIB) but |
134 | ;; loading the complete pathname for libglib-2.0-0.dll with |
135 | ;; SB-ALIEN:LOAD-SHARED-OBJECT by hand won't explode. weird. |
136 | ;; - cph 18-May-2007 |
81814a23 |
137 | (defmethod perform ((o load-op) (c library)) |
3f246c3a |
138 | (load-dso #-win32 (component-pathname c) |
139 | #+win32 (unix-name (component-pathname c)))) |
9025e0d1 |
140 | |
141 | (defmethod perform ((operation operation) (c library)) |
142 | nil) |
143 | |
144 | (defmethod operation-done-p ((o load-op) (c library)) |
145 | #+sbcl(find (sb-ext::unix-namestring (component-pathname c)) sb-alien::*shared-objects* :key #'sb-alien::shared-object-file :test #'equal) |
146 | #+cmu(rassoc (unix::unix-namestring (component-pathname c)) |
147 | system::*global-table* |
148 | :key #'(lambda (pathname) |
149 | (when pathname (unix::unix-namestring pathname))) |
5eda2e76 |
150 | :test #'equal) |
151 | #+clisp(find (component-pathname c) *loaded-libraries* :test #'equal)) |
9025e0d1 |
152 | |
153 | (defmethod operation-done-p ((o operation) (c library)) |
154 | t) |