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

Last change on this file since 11681 was 11681, checked in by ehuelsmann, 12 years ago

*nix compilation fixes for Lisp based build.

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