source: tags/0.14.1/j/build-abcl.lisp

Last change on this file was 11354, checked in by ehuelsmann, 16 years ago

More steps toward a release:

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