77dd2192 |
1 | (in-package :asdf) |
2 | |
ac3ab7d4 |
3 | (export '(*absolute-paths-as-default* *dso-extension* |
4 | *operation* *system* *component*)) |
34abe734 |
5 | |
a4263d6d |
6 | (defparameter *dso-extension* |
e6ab30c2 |
7 | #-(or darwin win32)"so" #+darwin"dylib" #+win32"dll") |
34abe734 |
8 | |
ac3ab7d4 |
9 | (defparameter *absolute-paths-as-default* nil) |
1a9c1e08 |
10 | |
57f6526c |
11 | ;;; The following code is more or less copied from sb-bsd-sockets.asd, |
12 | ;;; but extended to allow flags to be set in a general way. The class |
b133c3a7 |
13 | ;;; has been renamed from unix-dso to shared-object as this code is no |
14 | ;;; longer specific to unix |
77dd2192 |
15 | |
57f6526c |
16 | (defclass shared-object (module) |
b133c3a7 |
17 | ((ldflags :initform nil :initarg :ldflags) |
ac3ab7d4 |
18 | (absolute :initform *absolute-paths-as-default* |
19 | :initarg :absolute :reader absolute-p))) |
57f6526c |
20 | |
21 | (defun ensure-namestring (pathname) |
77dd2192 |
22 | (namestring |
23 | (typecase pathname |
24 | (logical-pathname (translate-logical-pathname pathname)) |
25 | (t pathname)))) |
26 | |
57f6526c |
27 | (defmethod input-files ((operation compile-op) (dso shared-object)) |
77dd2192 |
28 | (mapcar #'component-pathname (module-components dso))) |
29 | |
57f6526c |
30 | (defmethod output-files ((operation compile-op) (dso shared-object)) |
77dd2192 |
31 | (let ((dir (component-pathname dso))) |
32 | (list |
34abe734 |
33 | (make-pathname :type *dso-extension* |
b6f51030 |
34 | :name (component-name dso) |
77dd2192 |
35 | :directory (butlast (pathname-directory dir)) |
36 | :defaults dir)))) |
37 | |
57f6526c |
38 | (defmethod perform :after ((operation compile-op) (dso shared-object)) |
a4263d6d |
39 | (let ((output (first (output-files operation dso))) |
57f6526c |
40 | (inputs (mapcar #'ensure-namestring |
a4263d6d |
41 | (mapcan #'(lambda (c) |
42 | (output-files operation c)) |
43 | (module-components dso))))) |
77dd2192 |
44 | (unless (zerop |
e6ab30c2 |
45 | (run-shell-command "gcc ~A -o ~S ~{~S~^ ~} ~{~A~^ ~}" |
46 | #-(or darwin win32)"-shared" |
a4263d6d |
47 | #+darwin "-bundle" |
48 | #+win32 |
49 | (format nil "-shared -Wl,--out-implib,~S" |
57f6526c |
50 | (ensure-namestring |
a4263d6d |
51 | (make-pathname |
52 | :type "a" |
53 | :name (format nil "lib~Adll" (pathname-name output)) |
54 | :defaults output))) |
57f6526c |
55 | (ensure-namestring output) |
e6ab30c2 |
56 | inputs |
57 | (slot-value dso 'ldflags))) |
77dd2192 |
58 | (error 'operation-error :operation operation :component dso)))) |
59 | |
dfdb198f |
60 | #+clisp |
61 | (defvar *loaded-libraries* ()) |
73572c12 |
62 | |
b133c3a7 |
63 | (defun load-shared-object (pathname &optional (absolute-p t)) |
64 | (let* ((namestring (ensure-namestring pathname)) |
65 | (directory (namestring (pathname-sans-name+type namestring))) |
66 | (name+type (subseq namestring (length directory)))) |
67 | #+sbcl |
68 | (progn |
69 | (sb-alien:load-shared-object namestring) |
70 | (unless absolute-p |
71 | (let ((shared-object (find namestring sb-alien::*shared-objects* |
72 | :key #'sb-alien::shared-object-file |
73 | :test #'equal))) |
74 | (setf (sb-alien::shared-object-file shared-object) name+type)))) |
75 | #+cmu |
76 | (progn |
77 | (ext:load-foreign namestring) |
78 | (unless absolute-p |
79 | (let ((shared-object (rassoc namestring system::*global-table* |
80 | :test #'equal))) |
81 | (setf (cdr shared-object) name+type)))) |
82 | #+clisp |
83 | (progn |
57f6526c |
84 | (ffi::foreign-library namestring) |
b133c3a7 |
85 | (pushnew |
86 | (if absolute-p namestring name+type) |
87 | *loaded-libraries* :test #'string=)))) |
1a9c1e08 |
88 | |
89 | |
b133c3a7 |
90 | (defmethod perform ((o load-op) (dso shared-object)) |
77dd2192 |
91 | (let ((co (make-instance 'compile-op))) |
b133c3a7 |
92 | (let ((pathname (car (output-files co dso)))) |
93 | (load-shared-object pathname (absolute-p dso))))) |
77dd2192 |
94 | |
95 | |
96 | |
97 | (defclass c-source-file (source-file) |
98 | ((cflags :initform nil :initarg :cflags) |
99 | (optimization :initform 2 :initarg :optimization) |
100 | (definitions :initform nil :initarg :definitions) |
101 | (include-paths :initform nil :initarg :include-paths))) |
102 | |
103 | |
104 | (defmethod output-files ((op compile-op) (c c-source-file)) |
73572c12 |
105 | (list (make-pathname :type "o" :defaults (component-pathname c)))) |
77dd2192 |
106 | |
107 | |
108 | (defmethod perform ((op compile-op) (c c-source-file)) |
109 | (unless |
a4263d6d |
110 | (= 0 (run-shell-command "gcc ~A~{ ~A~} -o ~S -c ~S" |
111 | #-win32 "-fPIC" |
112 | #+win32 "-DBUILD_DLL" |
113 | (nconc |
114 | (when (slot-value c 'optimization) |
115 | (list (format nil "-O~A" (slot-value c 'optimization)))) |
116 | (loop |
117 | for symbol in (slot-value c 'definitions) |
118 | collect (format nil "-D~A" symbol)) |
119 | (loop |
120 | for path in (slot-value c 'include-paths) |
121 | collect (format nil "-I~A" path)) |
122 | (slot-value c 'cflags)) |
57f6526c |
123 | (ensure-namestring (first (output-files op c))) |
124 | (ensure-namestring (component-pathname c)))) |
77dd2192 |
125 | (error 'operation-error :operation op :component c))) |
126 | |
127 | |
128 | (defmethod perform ((operation load-op) (c c-source-file)) |
129 | t) |
130 | |
131 | |
fd9d29a4 |
132 | ;;; Shared libraries |
1a9c1e08 |
133 | |
fd9d29a4 |
134 | (defclass library (component) |
57f6526c |
135 | ((libdir :initarg :libdir :initform nil) |
b133c3a7 |
136 | (libname :initarg :libname :initform nil) |
ac3ab7d4 |
137 | (absolute :initform *absolute-paths-as-default* |
138 | :initarg :absolute :reader absolute-p))) |
1a9c1e08 |
139 | |
140 | |
3e9e71e7 |
141 | (defun split-path (path) |
142 | (labels ((split (path) |
143 | (unless (zerop (length path)) |
144 | (let ((slash (position #\/ path))) |
145 | (if slash |
146 | (cons (subseq path 0 slash) (split (subseq path (1+ slash)))) |
147 | (list path)))))) |
148 | (if (and (not (zerop (length path))) (char= (char path 0) #\/)) |
149 | (cons :absolute (split (subseq path 1))) |
150 | (cons :relative (split path))))) |
151 | |
1a9c1e08 |
152 | |
153 | (defmethod component-pathname ((lib library)) |
34abe734 |
154 | (make-pathname :type *dso-extension* |
1dfea3ab |
155 | :name (or (slot-value lib 'libname) (component-name lib)) |
3e9e71e7 |
156 | :directory (split-path (slot-value lib 'libdir)))) |
1a9c1e08 |
157 | |
b133c3a7 |
158 | (defmethod perform ((o load-op) (lib library)) |
159 | (load-shared-object (component-pathname lib) (absolute-p lib))) |
fd9d29a4 |
160 | |
b133c3a7 |
161 | (defmethod perform ((operation operation) (lib library)) |
fd9d29a4 |
162 | nil) |
163 | |
b133c3a7 |
164 | (defmethod operation-done-p ((o load-op) (lib library)) |
165 | (let* ((namestring (ensure-namestring (component-pathname lib))) |
166 | (directory (namestring (pathname-sans-name+type namestring))) |
167 | (name+type (subseq namestring (length directory))) |
168 | (stored-name (if (absolute-p lib) namestring name+type))) |
169 | |
170 | #+sbcl(find stored-name sb-alien::*shared-objects* :key #'sb-alien::shared-object-file :test #'equal) |
171 | #+cmu(rassoc stored-name system::*global-table* :test #'equal) |
172 | #+clisp(find stored-name *loaded-libraries* :test #'equal))) |
fd9d29a4 |
173 | |
b133c3a7 |
174 | (defmethod operation-done-p ((o operation) (lib library)) |
fd9d29a4 |
175 | t) |
90309986 |
176 | |
177 | |
178 | ;;; Binding of dynamic variables during perform |
179 | |
180 | (defvar *operation* nil) |
181 | (defvar *system* nil) |
182 | (defvar *component* nil) |
183 | |
184 | (defmethod perform :around ((operation operation) (c component)) |
185 | (let ((*operation* operation) |
186 | (*component* c) |
187 | (*system* (component-system c))) |
188 | (call-next-method))) |