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

Last change on this file since 11752 was 11687, checked in by ehuelsmann, 13 years ago

Remove libabcl.so, which is about setting a SIGINT signal handler.

Note: NetBeans? didn't find any usages of Native.java outside of Native.java (?!).

Did this ever work?!

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