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

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

Fix our lisp based build for CLISP 2.47 (and hopefully from there onwards).

  • 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          ((or (eq status t) (null status)) ;; clisp 2.47 returns NIL on success
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.