source: trunk/abcl/build-abcl.lisp @ 11556

Last change on this file since 11556 was 11556, checked in by Mark Evenson, 13 years ago

Fix the Lisp based build system to include with the new Java classes in src/org/armedbear/util.

Fix 'abcl.asd' to work with the ASDF distributed with SBCL/CLISP by
removing obsoleted ':documentation' keywords. ABCL's version of
'asdf.lisp' is really old, so should be replaced.

Add the location of src/org/armedbear/util classes to the auxillary
jar scripts.

  • Property svn:eol-style set to native
File size: 23.8 KB
Line 
1;;; build-abcl.lisp
2
3#+abcl
4(require 'format)
5
6(defpackage build-abcl
7  (:use "COMMON-LISP")
8  (:export #:build-abcl #:make-dist)
9  #+abcl (:import-from #:extensions #:run-shell-command #:probe-directory)
10  #+allegro (:import-from #:excl #:probe-directory)
11  #+clisp (:import-from #:ext #:probe-directory)
12  )
13
14(in-package #:build-abcl)
15
16(defun safe-namestring (pathname)
17  (let ((string (namestring pathname)))
18    (when (position #\space string)
19      (setf string (concatenate 'string "\"" string "\"")))
20    string))
21
22
23
24;; Platform detection.
25
26(defun platform ()
27  #-clisp
28  (let ((software-type (software-type)))
29    (cond ((search "Linux" software-type)
30           :linux)
31          ((or (search "Mac OS X" software-type) ; abcl
32               (search "Darwin" software-type))  ; sbcl
33           :darwin)
34          ((search "Windows" software-type)
35           :windows)
36          (t
37           :unknown)))
38  #+clisp
39  (cond ((member :win32 *features*)
40         :windows)
41        ((zerop (ext:run-shell-command "uname | grep -i darwin" :output nil))
42         :darwin)
43        ((zerop (ext:run-shell-command "uname | grep -i linux" :output nil))
44         :linux)
45        (t
46         :unknown)))
47
48(defparameter *platform* (platform))
49
50(defparameter *file-separator-char*
51  (if (eq *platform* :windows) #\\ #\/))
52
53(defparameter *path-separator-char*
54  (if (eq *platform* :windows) #\; #\:))
55
56(defmacro with-current-directory ((directory) &body body)
57  `(let ((*default-pathname-defaults* ,directory)
58         #+clisp
59         (old-directory (ext:cd)))
60     #+clisp
61     (ext:cd ,directory)
62     (unwind-protect
63         (progn ,@body)
64       #+clisp
65       (ext:cd old-directory)
66       )))
67
68#+sbcl
69(defun run-shell-command (command &key directory (output *standard-output*))
70  (when directory
71    (setf command (concatenate 'string
72                               "\\cd \""
73                               (namestring (pathname directory))
74                               "\" && "
75                               command)))
76  (sb-ext:process-exit-code
77   (sb-ext:run-program
78    "/bin/sh"
79    (list  "-c" command)
80    :input nil :output output)))
81
82#+cmu
83(defun run-shell-command (command &key directory (output *standard-output*))
84  (when directory
85    (setf command (concatenate 'string
86                               "\\cd \""
87                               (namestring (pathname directory))
88                               "\" && "
89                               command)))
90  (ext::process-exit-code
91   (ext:run-program
92    "/bin/sh"
93    (list  "-c" command)
94    :input nil :output output)))
95
96#+clisp
97(defun run-shell-command (command &key directory (output *standard-output*))
98  (declare (ignore output)) ;; FIXME
99  (let (status old-directory)
100    (when directory
101      (setf old-directory (ext:cd))
102      (ext:cd directory))
103    (unwind-protect
104        (setf status (ext:shell command))
105      (when old-directory
106        (ext:cd old-directory)))
107    (cond ((numberp status)
108           status)
109          ((eq status t)
110           0)
111          (t
112           -1))))
113
114#+lispworks
115(defun run-shell-command (command &key directory (output *standard-output*))
116  (when directory
117    (unless (eq *platform* :windows)
118      (setf command (concatenate 'string
119                                 "\\cd \""
120                                 (namestring (pathname directory))
121                                 "\" && "
122                                 command))))
123  (system:call-system-showing-output command
124                                     :shell-type "/bin/sh"
125                                     :output-stream output))
126
127#+allegro
128(defun run-shell-command (command &key directory (output *standard-output*))
129  (excl:run-shell-command command
130                          :directory directory
131                          :input nil
132                          :output #+ide nil #-ide output))
133
134#+openmcl
135(defun run-shell-command (command &key directory (output *standard-output*))
136  (when directory
137    (setf command (concatenate 'string
138                               "\\cd \""
139                               (namestring (pathname directory))
140                               "\" && "
141                               command)))
142  (multiple-value-bind (status exitcode)
143      (ccl:external-process-status
144       (ccl:run-program
145        "/bin/sh"
146        (list  "-c" command)
147        :wait t :input nil :output output))
148    (declare (ignore status))
149    exitcode))
150
151#+(or sbcl cmu lispworks openmcl)
152(defun probe-directory (pathspec)
153  (let* ((truename (probe-file pathspec)) ; TRUENAME is a pathname.
154         (namestring (and truename (namestring truename)))) ; NAMESTRING is a string.
155    (and namestring
156         (> (length namestring) 0)
157         (eql (char namestring (1- (length namestring))) *file-separator-char*)
158         truename)))
159
160(defparameter *build-root*
161  (make-pathname :device (pathname-device *load-truename*)
162                 :directory (pathname-directory *load-truename*)))
163
164(defparameter *customizations-file*
165  (merge-pathnames "customizations.lisp" *build-root*))
166
167(defparameter *abcl-dir*
168  (merge-pathnames "src/org/armedbear/lisp/" *build-root*))
169
170(defparameter *jdk*           nil)
171(defparameter *java-compiler* nil)
172(defparameter *javac-options* nil)
173(defparameter *jikes-options* nil)
174(defparameter *jar*           nil)
175
176(defvar *classpath*)
177(defvar *java*)
178(defvar *java-compiler-options*)
179(defvar *java-compiler-command-line-prefix*)
180
181(defun initialize-build ()
182  (setf *jdk*           nil
183        *java-compiler* nil
184        *javac-options* nil
185        *jikes-options* nil
186        *jar*           nil)
187  (load *customizations-file*)
188  (setf *java* (probe-file (merge-pathnames (if (eq *platform* :windows)
189                                                "bin\\java.exe"
190                                                "bin/java")
191                                            *jdk*)))
192  (unless *java*
193    (error "Can't find Java executable."))
194  (unless *java-compiler*
195    (setf *java-compiler* (merge-pathnames (if (eq *platform* :windows)
196                                               "bin/javac.exe"
197                                               "bin/javac")
198                                           *jdk*)))
199  (unless *jar*
200    (setf *jar* (merge-pathnames (if (eq *platform* :windows)
201                                     "bin/jar.exe"
202                                     "bin/jar")
203                                 *jdk*)))
204  (let ((classpath-components (list (merge-pathnames "src" *build-root*)
205                                    (if (eq *platform* :darwin)
206                                        #p"/System/Library/Frameworks/JavaVM.framework/Classes/classes.jar"
207                                        (merge-pathnames "jre/lib/rt.jar" *jdk*)))))
208    (setf *classpath*
209          (with-output-to-string (s)
210            (do* ((components classpath-components (cdr components))
211                  (component (car components) (car components)))
212                 ((null components))
213              (princ (safe-namestring component) s)
214              (unless (null (cdr components))
215                (write-char *path-separator-char* s))))))
216  (let ((prefix (concatenate 'string
217                             (safe-namestring *java-compiler*)
218                             " -classpath " *classpath*)))
219    (setf *java-compiler-options*
220          (if (string-equal (pathname-name (pathname *java-compiler*)) "jikes")
221              *jikes-options*
222              *javac-options*))
223    (setf prefix
224          (if *java-compiler-options*
225              (concatenate 'string prefix " " *java-compiler-options* " ")
226              (concatenate 'string prefix " ")))
227    (setf *java-compiler-command-line-prefix* prefix)))
228
229(defun substitute-in-string (string substitutions-alist)
230  (dolist (entry substitutions-alist)
231    (let ((index (search (car entry) string :test #'string=)))
232      (when index
233        (setf string (concatenate 'string
234                                  (subseq string 0 index)
235                                  (cdr entry)
236                                  (subseq string (+ index (length (car entry)))))))))
237  string)
238
239(defun copy-with-substitutions (source-file target-file substitutions-alist)
240  (with-open-file (in source-file :direction :input)
241    (with-open-file (out target-file :direction :output :if-exists :supersede)
242      (loop
243        (let ((string (read-line in nil)))
244          (when (null string)
245            (return))
246          (write-line (substitute-in-string string substitutions-alist) out))))))
247
248(defun build-javac-command-line (source-file)
249  (concatenate 'string
250               *java-compiler-command-line-prefix*
251               (namestring source-file)))
252
253(defun java-compile-file (source-file)
254  (let ((cmdline (build-javac-command-line source-file)))
255    (zerop (run-shell-command cmdline :directory *abcl-dir*))))
256
257(defun make-classes (force batch)
258  (let* ((source-files
259          (append (with-current-directory (*abcl-dir*)
260                    (directory "*.java"))
261                  (with-current-directory ((merge-pathnames "util/" *abcl-dir*))
262                    (directory "*.java"))))
263         (to-do ()))
264    (if force
265        (setf to-do source-files)
266        (dolist (source-file source-files)
267          (let ((class-file (merge-pathnames (make-pathname :type "class"
268                                                            :defaults source-file))))
269            (when (or (null (probe-file class-file))
270                      (>= (file-write-date source-file)
271                          (file-write-date class-file)))
272              (push source-file to-do)))))
273    (format t "~&JDK: ~A~%" *jdk*)
274    (format t "Java compiler: ~A~%" *java-compiler*)
275    (format t "Compiler options: ~A~%~%" (if *java-compiler-options* *java-compiler-options* ""))
276    (finish-output)
277    (cond ((null to-do)
278           (format t "Classes are up to date.~%")
279           (finish-output)
280           t)
281          (t
282           (cond (batch
283                  (let* ((dir (pathname-directory *abcl-dir*))
284                         (cmdline (with-output-to-string (s)
285                                    (princ *java-compiler-command-line-prefix* s)
286                                    (dolist (source-file to-do)
287                                      (princ
288                                       (if (equal (pathname-directory source-file) dir)
289                                           (file-namestring source-file)
290                                           (namestring source-file))
291                                       s)
292                                      (princ #\space s))))
293                         (status (run-shell-command cmdline :directory *abcl-dir*)))
294                    (zerop status)))
295                 (t
296                  (dolist (source-file to-do t)
297                    (unless (java-compile-file source-file)
298                      (format t "Build failed.~%")
299                      (return nil)))))))))
300
301(defun make-jar ()
302  (let ((*default-pathname-defaults* *build-root*)
303        (jar-namestring (namestring *jar*)))
304    (when (position #\space jar-namestring)
305      (setf jar-namestring (concatenate 'string "\"" jar-namestring "\"")))
306    (let ((substitutions-alist (acons "@JAR@" jar-namestring nil))
307          (source-file (if (eq *platform* :windows) "make-jar.bat.in" "make-jar.in"))
308          (target-file (if (eq *platform* :windows) "make-jar.bat"    "make-jar"))
309          (command     (if (eq *platform* :windows) "make-jar.bat"    "sh make-jar")))
310      (copy-with-substitutions source-file target-file substitutions-alist)
311      (let ((status (run-shell-command command :directory *build-root*)))
312        (unless (zerop status)
313          (format t "~A returned ~S~%" command status))
314        status))))
315
316(defun do-compile-system (&key (zip t))
317  (terpri)
318  (finish-output)
319  (let* ((java-namestring (safe-namestring *java*))
320         status)
321    (cond ((eq *platform* :windows)
322           (with-open-file (stream
323                            (merge-pathnames "compile-system.bat" *build-root*)
324                            :direction :output
325                            :if-exists :supersede)
326             (princ java-namestring stream)
327             (write-string " -cp " stream)
328             (princ "src" stream)
329             (write-char #\space stream)
330             (write-string
331              (if zip
332                 "org.armedbear.lisp.Main --eval \"(compile-system :zip t :quit t)\""
333                 "org.armedbear.lisp.Main --eval \"(compile-system :zip nil :quit t)\"")
334              stream)
335             (terpri stream))
336           (setf status
337                 (run-shell-command "compile-system.bat"
338                                    :directory *build-root*)))
339          (t ; Linux
340           (let ((cmdline
341                  (with-output-to-string (s)
342                    (princ java-namestring s)
343                    (write-string " -cp " s)
344                    (princ "src" s)
345                    (write-char #\space s)
346                    (write-string
347                     (if zip
348                         "org.armedbear.lisp.Main --eval \"(compile-system :zip t :quit t)\""
349                         "org.armedbear.lisp.Main --eval \"(compile-system :zip nil :quit t)\"")
350                     s))))
351             (setf status
352                   (run-shell-command cmdline
353                                      :directory *build-root*)))))
354    status))
355
356(defun make-libabcl ()
357  (and (let* ((javah-namestring (namestring (probe-file (merge-pathnames "bin/javah" *jdk*))))
358              (command
359               (format nil "~A -o org/armedbear/lisp/native.h org.armedbear.lisp.Native"
360                       javah-namestring))
361              (status
362               (run-shell-command command :directory (merge-pathnames "src/" *build-root*))))
363         (unless (zerop status)
364           (format t "~A returned ~S~%" command status))
365         (zerop status))
366       (let* ((jdk-namestring (namestring *jdk*))
367              (command
368               (format nil "gcc -shared -o libabcl.so -O -D_REENTRANT -fpic -I~Ainclude -I~Ainclude/~A native.c"
369                       jdk-namestring jdk-namestring
370                       (cond ((eq *platform* :linux)
371                              "linux")
372                             ((search "SunOS" (software-type))
373                              "solaris")
374                             ((search "FreeBSD" (software-type))
375                              "freebsd"))))
376              (status
377               (run-shell-command command :directory *abcl-dir*)))
378         (unless (zerop status)
379           (format t "~A returned ~S~%" command status))
380         (zerop status))))
381
382;; abcl/abcl.bat
383(defun make-launch-script ()
384  ;; Use the -Xss4M and -Xmx256M flags so that the default launch script can be
385  ;; used to build sbcl.
386  (cond ((eq *platform* :windows)
387         (with-open-file (s
388                          (merge-pathnames "abcl.bat" *build-root*)
389                          :direction :output
390                          :if-exists :supersede)
391           (format s "~A -Xss4M -Xmx256M -cp \"~A;~A\" org.armedbear.lisp.Main %1 %2 %3 %4 %5 %6 %7 %8 %9~%"
392                   (safe-namestring *java*)
393                   (namestring (merge-pathnames "src" *build-root*))
394                   (namestring (merge-pathnames "abcl.jar" *build-root*)))))
395        (t
396         (let ((pathname (merge-pathnames "abcl" *build-root*)))
397           (with-open-file (s pathname :direction :output :if-exists :supersede)
398             (if (eq *platform* :linux)
399                 ;; On Linux, set java.library.path for libabcl.so.
400                 (format s "#!/bin/sh~%exec ~A -Xss4M -Xmx256M -Xrs -Djava.library.path=~A -cp ~A:~A org.armedbear.lisp.Main \"$@\"~%"
401                         (safe-namestring *java*)
402                         (safe-namestring *abcl-dir*)
403                         (safe-namestring (merge-pathnames "src" *build-root*))
404                         (safe-namestring (merge-pathnames "abcl.jar" *build-root*)))
405                 ;; Not Linux.
406                 (format s "#!/bin/sh~%exec ~A -Xss4M -Xmx256M -cp ~A:~A org.armedbear.lisp.Main \"$@\"~%"
407                         (safe-namestring *java*)
408                         (safe-namestring (merge-pathnames "src" *build-root*))
409                         (safe-namestring (merge-pathnames "abcl.jar" *build-root*)))))
410           (run-shell-command (format nil "chmod +x ~A" (safe-namestring pathname))
411                              :directory *build-root*)))))
412
413(defun build-stamp ()
414  (multiple-value-bind
415      (second minute hour date month year day daylight-p zone)
416      (decode-universal-time (get-universal-time))
417    (declare (ignore daylight-p))
418    (setf day (nth day '("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun")))
419    (setf month (nth (1- month) '("Jan" "Feb" "Mar" "Apr" "May" "Jun"
420                                  "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")))
421    (setf zone (* zone 100)) ;; FIXME
422    (format nil "~A ~A ~D ~D ~2,'0D:~2,'0D:~2,'0D -~4,'0D"
423            day month date year hour minute second zone)))
424
425(defun make-build-stamp ()
426  (with-open-file (s
427                   (merge-pathnames (make-pathname :name "build"
428                                                   :defaults *abcl-dir*))
429                   :direction :output
430                   :if-exists :supersede)
431    (format s "~A" (build-stamp))))
432
433(defun delete-files (pathnames)
434  (dolist (pathname pathnames)
435    (let ((truename (probe-file pathname)))
436      (when truename
437        (delete-file truename)))))
438
439(defun clean ()
440  (with-current-directory (*build-root*)
441    (delete-files (list "abcl.jar")))
442  (with-current-directory (*abcl-dir*)
443    (delete-files (directory "*.class"))
444    (delete-files (directory "*.abcl"))
445    (delete-files (directory "*.cls"))
446    (delete-files '("native.h" "libabcl.so" "build")))
447  (with-current-directory ((merge-pathnames "java/awt/" *abcl-dir*))
448    (delete-files (directory "*.class"))))
449
450(defun build-abcl (&key force
451                        (batch t)
452                        compile-system
453                        jar
454                        clean
455                        libabcl
456                        full)
457  (let ((start (get-internal-real-time)))
458
459    #+lispworks
460    (when (eq *platform* :windows)
461      (setf batch nil))
462
463    (initialize-build)
464    (format t "~&Platform: ~A~%"
465            (case *platform*
466              (:windows "Windows")
467              (:linux   "Linux")
468              (:darwin  "Mac OS X")
469              (t        (software-type))))
470    (finish-output)
471    ;; clean
472    (when clean
473      (clean))
474    ;; classes
475    (unless (make-classes force batch)
476      (format t "Build failed.~%")
477      (return-from build-abcl nil))
478    ;; COMPILE-SYSTEM
479    (when (or full compile-system)
480      (let* ((zip    (if (or full jar) nil t))
481             (status (do-compile-system :zip zip)))
482        (unless (zerop status)
483          (format t "Build failed.~%")
484          (return-from build-abcl nil))))
485    ;; abcl.jar
486    (when (or full jar)
487      (let ((status (make-jar)))
488        (unless (zerop status)
489          (format t "Build failed.~%")
490          (return-from build-abcl nil))))
491    ;; libabcl.so
492    (when (and (or full libabcl)
493               (or (eq *platform* :linux)
494                   (search "SunOS" (software-type))
495                   (search "FreeBSD" (software-type))))
496      ;; A failure here is not fatal.
497      (make-libabcl))
498    ;; abcl/abcl.bat
499    (make-launch-script)
500    (make-build-stamp)
501    (let ((end (get-internal-real-time)))
502      (format t "Build completed successfully in ~A seconds.~%"
503              (/ (float (- end start)) internal-time-units-per-second)))
504    t))
505
506(defun build-abcl-executable ()
507  (let* ((*default-pathname-defaults* *abcl-dir*)
508         (source-files (directory "*.java"))
509         (cmdline (with-output-to-string (s)
510                    (princ "gcj -g -O0 " s)
511                    (dolist (source-file source-files)
512                      (unless (string= (pathname-name source-file) "Native")
513                        (princ (pathname-name source-file) s)
514                        (princ ".java" s)
515                        (princ #\space s)))
516                    (princ "--main=org.armedbear.lisp.Main -o lisp" s)))
517         (result (run-shell-command cmdline :directory *abcl-dir*)))
518    (zerop result)))
519
520(defvar *copy-verbose* nil)
521
522(defun copy-file (source target)
523  (when *copy-verbose*
524    (format t "~A -> ~A~%" source target))
525  (let ((buffer (make-array 4096 :element-type '(unsigned-byte 8))))
526    (with-open-file (in source :direction :input :element-type '(unsigned-byte 8))
527      (with-open-file (out target :direction :output :element-type '(unsigned-byte 8)
528                           :if-exists :supersede)
529        (loop
530          (let ((end (read-sequence buffer in)))
531            (when (zerop end)
532              (return))
533            (write-sequence buffer out :end end)))))))
534
535(defun copy-files (files source-dir target-dir)
536  (ensure-directories-exist target-dir)
537  (dolist (file files)
538    (copy-file (merge-pathnames file source-dir)
539               (merge-pathnames file target-dir))))
540
541(defun make-dist-dir (version-string)
542  (unless (eq *platform* :linux)
543    (error "MAKE-DIST is only supported on Linux."))
544  (let ((target-root (pathname (concatenate 'string "/var/tmp/" version-string "/"))))
545    (when (probe-directory target-root)
546      (error "Target directory ~S already exists." target-root))
547    (let* ((source-dir *build-root*)
548           (target-dir target-root)
549           (files (list "README"
550                        "COPYING"
551                        "build-abcl.lisp"
552                        "customizations.lisp"
553                        "make-jar.bat.in"
554                        "make-jar.in")))
555      (copy-files files source-dir target-dir))
556    (let* ((source-dir (merge-pathnames "examples/" *build-root*))
557           (target-dir (merge-pathnames "examples/" target-root))
558           (files '("hello.java")))
559      (copy-files files source-dir target-dir))
560    (let* ((source-dir (merge-pathnames "src/" *build-root*))
561           (target-dir (merge-pathnames "src/" target-root))
562           (files '("manifest-abcl")))
563      (copy-files files source-dir target-dir))
564    (let* ((source-dir *abcl-dir*)
565           (target-dir (merge-pathnames "src/org/armedbear/lisp/" target-root))
566           (*default-pathname-defaults* source-dir)
567           (files (mapcar #'file-namestring (append (directory "*.java")
568                                                    (directory "*.lisp")
569                                                    (list "LICENSE" "native.c")))))
570      (copy-files files source-dir target-dir))
571    (let* ((source-dir (merge-pathnames "tests/" *abcl-dir*))
572           (target-dir (merge-pathnames "src/org/armedbear/lisp/tests/" target-root))
573           (*default-pathname-defaults* source-dir)
574           (files (append (mapcar #'file-namestring (directory "*.lisp"))
575                          (list "jl-config.cl"))))
576      (copy-files files source-dir target-dir))
577    (let* ((source-dir (merge-pathnames "java/awt/" *abcl-dir*))
578           (target-dir (merge-pathnames "src/org/armedbear/lisp/java/awt/" target-root))
579           (*default-pathname-defaults* source-dir)
580           (files (mapcar #'file-namestring (directory "*.java"))))
581      (copy-files files source-dir target-dir))
582    target-root))
583
584(defun make-dist (version-string)
585  (let* ((dist-dir (make-dist-dir version-string))
586         (parent-dir (merge-pathnames (make-pathname :directory '(:relative :back))
587                                      dist-dir)))
588    (let* ((command (format nil "tar czf ~A~A.tar.gz ~A"
589                            (namestring parent-dir)
590                            version-string version-string))
591           (status (run-shell-command command :directory parent-dir)))
592      (unless (zerop status)
593        (format t "~A returned ~S~%" command status)))
594    (let* ((command (format nil "zip -q -r ~A~A.zip ~A"
595                            (namestring parent-dir)
596                            version-string version-string))
597           (status (run-shell-command command :directory parent-dir)))
598      (unless (zerop status)
599        (format t "~A returned ~S~%" command status)))))
Note: See TracBrowser for help on using the repository browser.