1 | ;;;; Historic cross platform build infrastructure |
---|
2 | ;;;; N.b. currently unused in favor of canonicalizing build.xml |
---|
3 | |
---|
4 | (in-package :abcl/build) |
---|
5 | |
---|
6 | (defun chop-end-from-char (string char) |
---|
7 | "Chops off the character at the end of `string' if it matches char" |
---|
8 | (let ((len (length string))) |
---|
9 | (if (eql char (char string (1- len))) |
---|
10 | (subseq string 0 (1- len)) |
---|
11 | string))) |
---|
12 | |
---|
13 | (defun safe-namestring (pathname) |
---|
14 | (let ((string (namestring pathname))) |
---|
15 | (when (position #\space string) |
---|
16 | (setf string (concatenate 'string "\"" |
---|
17 | (chop-end-from-char string #\\) |
---|
18 | "\""))) |
---|
19 | string)) |
---|
20 | |
---|
21 | (defun child-pathname (pathname parent) |
---|
22 | "Returns `pathname' relative to `parent', assuming that it |
---|
23 | is infact a child of it while being rooted at the same root as `parent'." |
---|
24 | (let ((path-dir (pathname-directory pathname)) |
---|
25 | (parent-dir (pathname-directory parent))) |
---|
26 | (do ((p1 path-dir (cdr p1)) |
---|
27 | (p2 parent-dir (cdr p2))) |
---|
28 | ((or (endp p2) (not (equal (car p1) (car p2)))) |
---|
29 | (when (endp p2) |
---|
30 | (make-pathname :directory (cons :relative p1) |
---|
31 | :defaults pathname)))))) |
---|
32 | |
---|
33 | |
---|
34 | (defun file-newer (orig artifact) |
---|
35 | "Compares file date/time of `orig' and `artifact', returning |
---|
36 | `NIL' if `orig' is newer than `artifact'." |
---|
37 | (or (null (probe-file artifact)) |
---|
38 | (> (file-write-date orig) |
---|
39 | (file-write-date artifact)))) |
---|
40 | |
---|
41 | (defparameter *file-separator-char* |
---|
42 | (if (uiop:os-windows-p) #\\ #\/)) |
---|
43 | |
---|
44 | (defparameter *path-separator-char* |
---|
45 | (if (uiop:os-windows-p) #\; #\:)) |
---|
46 | |
---|
47 | (defparameter *tree-root* |
---|
48 | (make-pathname :device (pathname-device *load-truename*) |
---|
49 | :directory (pathname-directory *load-truename*))) |
---|
50 | (defparameter *build-root* |
---|
51 | (merge-pathnames "build/classes/" *tree-root*)) |
---|
52 | (defparameter *source-root* |
---|
53 | (merge-pathnames "src/" *tree-root*)) |
---|
54 | (defparameter *dist-root* |
---|
55 | (merge-pathnames "dist/" *tree-root*)) |
---|
56 | |
---|
57 | (defparameter *customizations-file* |
---|
58 | (merge-pathnames "customizations.lisp" *tree-root*)) |
---|
59 | |
---|
60 | (defparameter *abcl-dir* |
---|
61 | (merge-pathnames "src/org/armedbear/lisp/" *tree-root*)) |
---|
62 | |
---|
63 | (defparameter *jdk* nil) |
---|
64 | (defparameter *java-compiler* nil) |
---|
65 | (defparameter *javac-options* nil) |
---|
66 | (defparameter *jikes-options* nil) |
---|
67 | (defparameter *jar* nil) |
---|
68 | |
---|
69 | (defvar *classpath*) |
---|
70 | (defvar *java*) |
---|
71 | (defvar *java-compiler-options*) |
---|
72 | (defvar *java-compiler-command-line-prefix*) |
---|
73 | |
---|
74 | (defun initialize-build () |
---|
75 | ;;; FIXME: highly breakable; user shouldn't be reading |
---|
76 | (load (asdf:system-relative-pathname :build-abcl |
---|
77 | "src/org/abcl/lisp/build/customizations-default.lisp")) |
---|
78 | (setf *java* |
---|
79 | (introspect-path-for "java")) |
---|
80 | |
---|
81 | (unless *java* |
---|
82 | (error "Can't find Java executable.")) |
---|
83 | (unless *java-compiler* |
---|
84 | (setf *java-compiler* (introspect-path-for "java"))) |
---|
85 | (unless *jar* |
---|
86 | (setf *jar* (introspect-path-for "jar"))) |
---|
87 | (let ((classpath-components (list *source-root* |
---|
88 | (if (uiop:os-macosx-p) |
---|
89 | #p"/System/Library/Frameworks/JavaVM.framework/Classes/classes.jar" |
---|
90 | (merge-pathnames "jre/lib/rt.jar" *jdk*))))) |
---|
91 | (setf *classpath* |
---|
92 | (with-output-to-string (s) |
---|
93 | (do* ((components classpath-components (cdr components)) |
---|
94 | (component (car components) (car components))) |
---|
95 | ((null components)) |
---|
96 | (princ (safe-namestring component) s) |
---|
97 | (unless (null (cdr components)) |
---|
98 | (write-char *path-separator-char* s)))))) |
---|
99 | (let ((prefix (concatenate 'string |
---|
100 | (safe-namestring *java-compiler*) |
---|
101 | " -classpath " *classpath*))) |
---|
102 | (setf *java-compiler-options* |
---|
103 | (if (string-equal (pathname-name (pathname *java-compiler*)) "jikes") |
---|
104 | *jikes-options* |
---|
105 | *javac-options*)) |
---|
106 | (setf prefix |
---|
107 | (if *java-compiler-options* |
---|
108 | (concatenate 'string prefix " " *java-compiler-options* " ") |
---|
109 | (concatenate 'string prefix " "))) |
---|
110 | (setf *java-compiler-command-line-prefix* prefix))) |
---|
111 | |
---|
112 | (defun substitute-in-string (string substitutions-alist) |
---|
113 | (dolist (entry substitutions-alist) |
---|
114 | (loop named replace |
---|
115 | for index = (search (car entry) string :test #'string=) |
---|
116 | do |
---|
117 | (unless index |
---|
118 | (return-from replace)) |
---|
119 | (setf string (concatenate 'string |
---|
120 | (subseq string 0 index) |
---|
121 | (cdr entry) |
---|
122 | (subseq string (+ index (length (car entry)))))))) |
---|
123 | string) |
---|
124 | |
---|
125 | (defun copy-with-substitutions (source-file target-file substitutions-alist) |
---|
126 | (with-open-file (in source-file :direction :input) |
---|
127 | (with-open-file (out target-file :direction :output :if-exists :supersede) |
---|
128 | (loop |
---|
129 | (let ((string (read-line in nil))) |
---|
130 | (when (null string) |
---|
131 | (return)) |
---|
132 | (write-line (substitute-in-string string substitutions-alist) out)))))) |
---|
133 | |
---|
134 | (defun build-javac-command-line (source-file) |
---|
135 | (concatenate 'string |
---|
136 | *java-compiler-command-line-prefix* |
---|
137 | " -d " |
---|
138 | (safe-namestring *build-root*) |
---|
139 | " " |
---|
140 | (namestring source-file))) |
---|
141 | |
---|
142 | (defun java-compile-file (source-file) |
---|
143 | (let ((command-line (build-javac-command-line source-file))) |
---|
144 | |
---|
145 | ;; TODO: detect failure of invocation |
---|
146 | (values |
---|
147 | (uiop:run-program command-line |
---|
148 | :directory *abcl-dir* |
---|
149 | :output :string)) |
---|
150 | command-line)) |
---|
151 | |
---|
152 | (defun do-compile-classes (force batch) |
---|
153 | (let* ((source-files |
---|
154 | (remove-if-not |
---|
155 | #'(lambda (name) |
---|
156 | (let ((output-name |
---|
157 | (merge-pathnames |
---|
158 | (make-pathname :type "class" |
---|
159 | :defaults (child-pathname name |
---|
160 | *source-root*)) |
---|
161 | *build-root*))) |
---|
162 | (or force |
---|
163 | (file-newer name output-name)))) |
---|
164 | (directory (merge-pathnames "**/*.java" *source-root*))))) |
---|
165 | (format t "~&JDK: ~A~%" *jdk*) |
---|
166 | (format t "Java compiler: ~A~%" *java-compiler*) |
---|
167 | (format t "Compiler options: ~A~%~%" (if *java-compiler-options* *java-compiler-options* "")) |
---|
168 | (format t "~&Compiling Java sources...") |
---|
169 | (finish-output) |
---|
170 | (cond ((null source-files) |
---|
171 | (format t "Classes are up to date.~%") |
---|
172 | (finish-output) |
---|
173 | t) |
---|
174 | (t |
---|
175 | (cond (batch |
---|
176 | (ensure-directories-exist *build-root*) |
---|
177 | (let* ((cmdline (with-output-to-string (s) |
---|
178 | (princ *java-compiler-command-line-prefix* s) |
---|
179 | (princ " -d " s) |
---|
180 | (princ (safe-namestring *build-root*) s) |
---|
181 | (princ #\Space s) |
---|
182 | (dolist (source-file source-files) |
---|
183 | (princ (safe-namestring (namestring source-file)) s) |
---|
184 | (princ #\space s)))) |
---|
185 | (status (run-shell-command cmdline :directory *tree-root*))) |
---|
186 | (format t " done.~%") |
---|
187 | (equal 0 status))) |
---|
188 | (t |
---|
189 | (ensure-directories-exist *build-root*) |
---|
190 | (dolist (source-file source-files t) |
---|
191 | (unless (java-compile-file (safe-namestring source-file)) |
---|
192 | (format t "Build failed.~%") |
---|
193 | (return nil))))))))) |
---|
194 | |
---|
195 | (defun make-jar () |
---|
196 | (let ((*default-pathname-defaults* *tree-root*) |
---|
197 | (jar-namestring (namestring *jar*))) |
---|
198 | (when (position #\space jar-namestring) |
---|
199 | (setf jar-namestring (concatenate 'string "\"" jar-namestring "\""))) |
---|
200 | (let ((substitutions-alist (acons "@JAR@" jar-namestring nil)) |
---|
201 | (source-file (if (uiop:os-windows-p) "make-jar.bat.in" "make-jar.in")) |
---|
202 | (target-file (if (uiop:os-windows-p) "make-jar.bat" "make-jar")) |
---|
203 | (command (if (uiop:os-windows-p) "make-jar.bat" "sh make-jar"))) |
---|
204 | (copy-with-substitutions source-file target-file substitutions-alist) |
---|
205 | (ensure-directories-exist *dist-root*) |
---|
206 | (let ((status (run-shell-command command :directory *tree-root*))) |
---|
207 | (unless (equal 0 status) |
---|
208 | (format t "~A returned ~S~%" command status)) |
---|
209 | status)))) |
---|
210 | |
---|
211 | (defun do-compile-system (&key (zip t)) |
---|
212 | (format t "~&Compiling Lisp sources...") |
---|
213 | (terpri) |
---|
214 | (finish-output) |
---|
215 | (let* ((java-namestring (safe-namestring *java*)) |
---|
216 | status |
---|
217 | (abcl-home (substitute-in-string |
---|
218 | (namestring *abcl-dir*) |
---|
219 | (when (uiop:os-windows-p) |
---|
220 | '(("\\" . "/") |
---|
221 | ("/" . "\\\\"))))) |
---|
222 | (output-path (substitute-in-string |
---|
223 | (namestring |
---|
224 | (merge-pathnames "build/classes/org/armedbear/lisp/" |
---|
225 | *tree-root*)) |
---|
226 | (when (uiop:os-windows-p) |
---|
227 | '(("\\" . "/"))))) |
---|
228 | (cmdline (format nil |
---|
229 | "~A -cp build/classes -Dabcl.home=\"~A\" ~ |
---|
230 | org.armedbear.lisp.Main --noinit --nosystem ~ |
---|
231 | --eval \"(compile-system :zip ~A :quit t :output-path \\\"~A\\\")\"~%" |
---|
232 | java-namestring |
---|
233 | abcl-home |
---|
234 | (not (not zip)) ;; because that ensures T or NIL |
---|
235 | output-path))) |
---|
236 | (ensure-directories-exist output-path) |
---|
237 | (setf status (run-shell-command cmdline :directory *tree-root*)) |
---|
238 | (format t " done.~%") |
---|
239 | status)) |
---|
240 | |
---|
241 | |
---|
242 | ;; abcl/abcl.bat |
---|
243 | (defun make-launch-script () |
---|
244 | ;; Use the -Xss4M and -Xmx256M flags so that the default launch script can be |
---|
245 | ;; used to build sbcl. |
---|
246 | (cond ((uiop:os-windows-p) |
---|
247 | (with-open-file (s |
---|
248 | (merge-pathnames "abcl.bat" *tree-root*) |
---|
249 | :direction :output |
---|
250 | :if-exists :supersede) |
---|
251 | (format s "~A -Xss4M -Xmx256M -cp \"~A\" org.armedbear.lisp.Main %1 %2 %3 %4 %5 %6 %7 %8 %9~%" |
---|
252 | (safe-namestring *java*) |
---|
253 | (namestring (merge-pathnames "dist\\abcl.jar" *tree-root*))))) |
---|
254 | (t |
---|
255 | (let ((pathname (merge-pathnames "abcl" *tree-root*))) |
---|
256 | (with-open-file (s pathname :direction :output :if-exists :supersede) |
---|
257 | (format s "#!/bin/sh~%exec ~A -Xss4M -Xmx256M -cp ~A org.armedbear.lisp.Main \"$@\"~%" |
---|
258 | (safe-namestring *java*) |
---|
259 | (safe-namestring (merge-pathnames "abcl.jar" *dist-root*)))) |
---|
260 | (run-shell-command (format nil "chmod +x ~A" (safe-namestring pathname)) |
---|
261 | :directory *tree-root*))))) |
---|
262 | |
---|
263 | (defun build-stamp () |
---|
264 | (multiple-value-bind |
---|
265 | (second minute hour date month year day daylight-p zone) |
---|
266 | (decode-universal-time (get-universal-time)) |
---|
267 | (declare (ignore daylight-p)) |
---|
268 | (setf day (nth day '("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun"))) |
---|
269 | (setf month (nth (1- month) '("Jan" "Feb" "Mar" "Apr" "May" "Jun" |
---|
270 | "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))) |
---|
271 | (setf zone (* zone 100)) ;; FIXME |
---|
272 | (format nil "~A ~A ~D ~D ~2,'0D:~2,'0D:~2,'0D -~4,'0D" |
---|
273 | day month date year hour minute second zone))) |
---|
274 | |
---|
275 | (defun make-build-stamp () |
---|
276 | (with-open-file (s |
---|
277 | (merge-pathnames (make-pathname :name "build" |
---|
278 | :defaults *abcl-dir*)) |
---|
279 | :direction :output |
---|
280 | :if-exists :supersede) |
---|
281 | (format s "~A" (build-stamp)))) |
---|
282 | |
---|
283 | (defun delete-files (pathnames) |
---|
284 | (dolist (pathname pathnames) |
---|
285 | (let ((truename (probe-file pathname))) |
---|
286 | (when truename |
---|
287 | (delete-file truename))))) |
---|
288 | |
---|
289 | (defun clean () |
---|
290 | (format t "~&Cleaning compilation results.") |
---|
291 | (dolist (f (list (list *tree-root* "abcl.jar" "abcl.bat" "make-jar.bat" |
---|
292 | "compile-system.bat") |
---|
293 | ;; as of 0.14 'compile-system.bat' isn't created anymore |
---|
294 | ;; as of 0.14 'abcl.jar' is always created in dist/ |
---|
295 | (list *abcl-dir* "*.class" "*.abcl" "*.cls" |
---|
296 | "native.h" "libabcl.so" "build") |
---|
297 | ;; as of 0.14, native.h and libabcl.so have been removed |
---|
298 | (list (merge-pathnames "util/" *abcl-dir*) "*.class") |
---|
299 | (list (merge-pathnames "build/classes/org/armedbear/lisp/" |
---|
300 | *tree-root*) |
---|
301 | "*.class" "*.abcl" "*.cls" |
---|
302 | "native.h" "libabcl.so" "build") |
---|
303 | (list (merge-pathnames |
---|
304 | "build/classes/org/armedbear/lisp/util/" |
---|
305 | *tree-root*) |
---|
306 | "*.class" "*.abcl" "*.cls") |
---|
307 | (list *dist-root* "*.jar" "*.class" "*.abcl" "*.cls") |
---|
308 | (list (merge-pathnames "java/awt/" *abcl-dir*) |
---|
309 | "*.class"))) |
---|
310 | (let ((default (car f))) |
---|
311 | (when (probe-directory default) |
---|
312 | (delete-files (mapcan #'(lambda (name) |
---|
313 | (directory (merge-pathnames name default))) |
---|
314 | (cdr f))))))) |
---|
315 | #+(or) |
---|
316 | (defun build-abcl (&key force |
---|
317 | (batch t) |
---|
318 | compile-system |
---|
319 | jar |
---|
320 | clean |
---|
321 | full) |
---|
322 | (let ((start (get-internal-real-time))) |
---|
323 | |
---|
324 | #+lispworks |
---|
325 | (when (uiop:os-windows-p) |
---|
326 | (setf batch nil)) |
---|
327 | |
---|
328 | (initialize-build) |
---|
329 | (format t "~&Platform: ~A~%" (software-type)) |
---|
330 | (finish-output) |
---|
331 | ;; clean |
---|
332 | (when clean |
---|
333 | (clean)) |
---|
334 | ;; Compile Java source into classes |
---|
335 | (unless (do-compile-classes force batch) |
---|
336 | (format t "Build failed.~%") |
---|
337 | (return-from build-abcl nil)) |
---|
338 | ;; COMPILE-SYSTEM |
---|
339 | (when (or full compile-system) |
---|
340 | (let* ((zip (if (or full jar) nil t)) |
---|
341 | (status (do-compile-system :zip zip))) |
---|
342 | (unless (equal 0 status) |
---|
343 | (format t "Build failed.~%") |
---|
344 | (return-from build-abcl nil)))) |
---|
345 | ;; abcl.jar |
---|
346 | (when (or full jar) |
---|
347 | (let ((status (make-jar))) |
---|
348 | (unless (equal 0 status) |
---|
349 | (format t "Build failed.~%") |
---|
350 | (return-from build-abcl nil)))) |
---|
351 | ;; abcl/abcl.bat |
---|
352 | (make-launch-script) |
---|
353 | (make-build-stamp) |
---|
354 | (let ((end (get-internal-real-time))) |
---|
355 | (format t "Build completed successfully in ~A seconds.~%" |
---|
356 | (/ (float (- end start)) internal-time-units-per-second))) |
---|
357 | t)) |
---|
358 | |
---|
359 | (defun build-abcl-executable () |
---|
360 | (let* ((*default-pathname-defaults* *abcl-dir*) |
---|
361 | (source-files (directory "*.java")) |
---|
362 | (cmdline (with-output-to-string (s) |
---|
363 | (princ "gcj -g -O0 " s) |
---|
364 | (dolist (source-file source-files) |
---|
365 | (unless (string= (pathname-name source-file) "Native") |
---|
366 | (princ (pathname-name source-file) s) |
---|
367 | (princ ".java" s) |
---|
368 | (princ #\space s))) |
---|
369 | (princ "--main=org.armedbear.lisp.Main -o lisp" s))) |
---|
370 | (result (run-shell-command cmdline :directory *abcl-dir*))) |
---|
371 | (equal 0 result))) |
---|
372 | |
---|
373 | (defvar *copy-verbose* nil) |
---|
374 | |
---|
375 | (defun copy-file (source target) |
---|
376 | (when *copy-verbose* |
---|
377 | (format t "~A -> ~A~%" source target)) |
---|
378 | (let ((buffer (make-array 4096 :element-type '(unsigned-byte 8)))) |
---|
379 | (with-open-file (in source :direction :input :element-type '(unsigned-byte 8)) |
---|
380 | (with-open-file (out target :direction :output :element-type '(unsigned-byte 8) |
---|
381 | :if-exists :supersede) |
---|
382 | (loop |
---|
383 | (let ((end (read-sequence buffer in))) |
---|
384 | (when (zerop end) |
---|
385 | (return)) |
---|
386 | (write-sequence buffer out :end end))))))) |
---|
387 | |
---|
388 | (defun copy-files (files source-dir target-dir) |
---|
389 | (ensure-directories-exist target-dir) |
---|
390 | (dolist (file files) |
---|
391 | (copy-file (merge-pathnames file source-dir) |
---|
392 | (merge-pathnames file target-dir)))) |
---|
393 | |
---|
394 | (defun make-dist-dir (version-string) |
---|
395 | (unless (uiop:os-unix-p) |
---|
396 | (error "MAKE-DIST is only supported on Unices.")) |
---|
397 | (let ((target-root (pathname (concatenate 'string "/var/tmp/" version-string "/")))) |
---|
398 | (when (probe-directory target-root) |
---|
399 | (error "Target directory ~S already exists." target-root)) |
---|
400 | (let* ((source-dir *tree-root*) |
---|
401 | (target-dir target-root) |
---|
402 | (files (list "README" |
---|
403 | "COPYING" |
---|
404 | "build-abcl.lisp" |
---|
405 | "customizations.lisp" |
---|
406 | "make-jar.bat.in" |
---|
407 | "make-jar.in"))) |
---|
408 | (copy-files files source-dir target-dir)) |
---|
409 | (let* ((source-dir (merge-pathnames "examples/" *tree-root*)) |
---|
410 | (target-dir (merge-pathnames "examples/" target-root)) |
---|
411 | (files '("hello.java"))) |
---|
412 | (copy-files files source-dir target-dir)) |
---|
413 | (let* ((target-dir (merge-pathnames "src/" target-root)) |
---|
414 | (files '("manifest-abcl"))) |
---|
415 | (copy-files files *source-root* target-dir)) |
---|
416 | (let* ((source-dir *abcl-dir*) |
---|
417 | (target-dir (merge-pathnames "src/org/armedbear/lisp/" target-root)) |
---|
418 | (*default-pathname-defaults* source-dir) |
---|
419 | (files (mapcar #'file-namestring (append (directory "*.java") |
---|
420 | (directory "*.lisp") |
---|
421 | (list "LICENSE" "native.c"))))) |
---|
422 | (copy-files files source-dir target-dir)) |
---|
423 | (let* ((source-dir (merge-pathnames "tests/" *abcl-dir*)) |
---|
424 | (target-dir (merge-pathnames "src/org/armedbear/lisp/tests/" target-root)) |
---|
425 | (*default-pathname-defaults* source-dir) |
---|
426 | (files (append (mapcar #'file-namestring (directory "*.lisp")) |
---|
427 | (list "jl-config.cl")))) |
---|
428 | (copy-files files source-dir target-dir)) |
---|
429 | (let* ((source-dir (merge-pathnames "java/awt/" *abcl-dir*)) |
---|
430 | (target-dir (merge-pathnames "src/org/armedbear/lisp/java/awt/" target-root)) |
---|
431 | (*default-pathname-defaults* source-dir) |
---|
432 | (files (mapcar #'file-namestring (directory "*.java")))) |
---|
433 | (copy-files files source-dir target-dir)) |
---|
434 | target-root)) |
---|
435 | |
---|
436 | #+(or) |
---|
437 | (defun make-dist (version-string) |
---|
438 | (let* ((dist-dir (make-dist-dir version-string)) |
---|
439 | (parent-dir (merge-pathnames (make-pathname :directory '(:relative :back)) |
---|
440 | dist-dir))) |
---|
441 | (let* ((command (format nil "tar czf ~A~A.tar.gz ~A" |
---|
442 | (namestring parent-dir) |
---|
443 | version-string version-string)) |
---|
444 | (status (run-shell-command command :directory parent-dir))) |
---|
445 | (unless (equal 0 status) |
---|
446 | (format t "~A returned ~S~%" command status))) |
---|
447 | (let* ((command (format nil "zip -q -r ~A~A.zip ~A" |
---|
448 | (namestring parent-dir) |
---|
449 | version-string version-string)) |
---|
450 | (status (run-shell-command command :directory parent-dir))) |
---|
451 | (unless (equal 0 status) |
---|
452 | (format t "~A returned ~S~%" command status))))) |
---|