Changeset 13041

Timestamp:

11/21/10 19:40:25 (12 years ago)

Author:

Mark Evenson

Message:

Reworked Lisp-based build now works for ecl.

Based on a patch from Pascal J. Bourguignon.

Refactored elements of Lisp-based build to improve error handling and
present more of a informative view of what is occuring.

Location:

trunk/abcl

Files:

• build-abcl.lisp (modified) (17 diffs)
• build-from-lisp.sh (modified) (2 diffs)

trunk/abcl/build-abcl.lisp

@@ -22 +22 @@
 
 (defun safe-namestring (pathname)
-  (let* ((string (namestring pathname))
-         (len (length string)))
+  (let ((string (namestring pathname)))
     (when (position #\space string)
       (setf string (concatenate 'string "\""
@@ -70 +69 @@
   (cond ((member :win32 *features*)
          :windows)
-        ((zerop (ext:run-shell-command "uname | grep -i darwin" :output nil))
+        ((equal 0 (ext:run-shell-command "uname | grep -i darwin" :output nil))
          :darwin)
-        ((zerop (ext:run-shell-command "uname | grep -i linux" :output nil))
+        ((equal 0 (ext:run-shell-command "uname | grep -i linux" :output nil))
          :linux)
         (t
@@ -95 +94 @@
                                command)))
   (sb-ext:process-exit-code
-   (sb-ext:run-program
+   (sb-ext:run-program 
     "/bin/sh"
     (list  "-c" command)
@@ -169 +168 @@
     exitcode))
 
-#+(or sbcl cmu lispworks openmcl)
+#+ecl 
+(defun run-shell-command (command &key directory (output *standard-output*))
+  (when directory
+    (if (member :windows *features*)
+        (error "Unimplemented.")
+        (setf command (concatenate 'string
+                                   "\\cd \""
+                                   (namestring (pathname directory))
+                                   "\" && "
+                                   command))))
+  (ext:system command))
+  ;; (multiple-value-bind (stream exit details)
+  ;;     (ext:run-program 
+  ;;      "/bin/sh" (list "-c" command)
+  ;;      :input nil :output :stream :error :output)
+  ;;   (declare (ignore details))
+  ;;   (loop for line = (read-line stream nil)
+  ;;      while line do (format output "~A~%" line))
+  ;;   exit))
+
+
+#+(or sbcl cmu lispworks openmcl ecl)
 (defun probe-directory (pathspec)
   (let* ((truename (probe-file pathspec)) ; TRUENAME is a pathname.
@@ -286 +306 @@
 (defun java-compile-file (source-file)
   (let ((cmdline (build-javac-command-line source-file)))
-    (zerop (run-shell-command cmdline :directory *abcl-dir*))))
-
-(defun make-classes (force batch)
+    (equal 0 (run-shell-command cmdline :directory *abcl-dir*))))
+
+(defun do-compile-classes (force batch)
   (let* ((source-files
           (remove-if-not
@@ -300 +320 @@
                  (or force
                      (file-newer name output-name))))
-           (mapcan #'(lambda (default)
-                       (directory (merge-pathnames "*.java"
-                                                   default)))
-                   (list *abcl-dir*
-                         (merge-pathnames "util/" *abcl-dir*))))))
+           (directory (merge-pathnames "**/*.java" *source-root*)))))
     (format t "~&JDK: ~A~%" *jdk*)
     (format t "Java compiler: ~A~%" *java-compiler*)
     (format t "Compiler options: ~A~%~%" (if *java-compiler-options* *java-compiler-options* ""))
+    (format t "~&Compiling Java sources...")
     (finish-output)
     (cond ((null source-files)
@@ -316 +333 @@
            (cond (batch
                   (ensure-directories-exist *build-root*)
-                  (let* ((dir (pathname-directory *abcl-dir*))
-                         (cmdline (with-output-to-string (s)
+                  (let* ((cmdline (with-output-to-string (s)
                                     (princ *java-compiler-command-line-prefix* s)
                                     (princ " -d " s)
@@ -323 +339 @@
                                     (princ #\Space s)
                                     (dolist (source-file source-files)
-                                      (princ
-                                       (safe-namestring
-                                        (if (equal (pathname-directory source-file) dir)
-                                            (file-namestring source-file)
-                                            (namestring source-file)))
-                                       s)
+                                      (princ (safe-namestring (namestring source-file)) s)
                                       (princ #\space s))))
-                         (status (run-shell-command cmdline :directory *abcl-dir*)))
-                    (zerop status)))
+                         (status (run-shell-command cmdline :directory *tree-root*)))
+                    (format t "  done.~%")
+                    (equal 0 status)))
                  (t
                   (ensure-directories-exist *build-root*)
@@ -351 +363 @@
       (ensure-directories-exist *dist-root*)
       (let ((status (run-shell-command command :directory *tree-root*)))
-        (unless (zerop status)
+        (unless (equal 0 status)
           (format t "~A returned ~S~%" command status))
         status))))
 
 (defun do-compile-system (&key (zip t))
+  (format t "~&Compiling Lisp sources...")
   (terpri)
   (finish-output)
@@ -380 +393 @@
                           output-path)))
     (ensure-directories-exist output-path)
-    (setf status
-          (run-shell-command cmdline
-                             :directory *tree-root*))
+    (setf status (run-shell-command cmdline :directory *tree-root*))
+    (format t " done.~%")
     status))
 
@@ -434 +446 @@
 
 (defun clean ()
+  (format t "~&Cleaning compilation results."
   (dolist (f (list (list *tree-root* "abcl.jar" "abcl.bat" "make-jar.bat"
                          "compile-system.bat")
@@ -482 +495 @@
     (when clean
       (clean))
-    ;; classes
-    (unless (make-classes force batch)
+    ;; Compile Java source into classes
+    (unless (do-compile-classes force batch)
       (format t "Build failed.~%")
       (return-from build-abcl nil))
@@ -490 +503 @@
       (let* ((zip    (if (or full jar) nil t))
              (status (do-compile-system :zip zip)))
-        (unless (zerop status)
+        (unless (equal 0 status)
           (format t "Build failed.~%")
           (return-from build-abcl nil))))
@@ -496 +509 @@
     (when (or full jar)
       (let ((status (make-jar)))
-        (unless (zerop status)
+        (unless (equal 0 status)
           (format t "Build failed.~%")
           (return-from build-abcl nil))))
@@ -519 +532 @@
                     (princ "--main=org.armedbear.lisp.Main -o lisp" s)))
          (result (run-shell-command cmdline :directory *abcl-dir*)))
-    (zerop result)))
+    (equal 0 result)))
 
 (defvar *copy-verbose* nil)
@@ -592 +605 @@
                             version-string version-string))
            (status (run-shell-command command :directory parent-dir)))
-      (unless (zerop status)
+      (unless (equal 0 status)
         (format t "~A returned ~S~%" command status)))
     (let* ((command (format nil "zip -q -r ~A~A.zip ~A"
@@ -598 +611 @@
                             version-string version-string))
            (status (run-shell-command command :directory parent-dir)))
-      (unless (zerop status)
+      (unless (equal 0 status)
         (format t "~A returned ~S~%" command status)))))

trunk/abcl/build-from-lisp.sh

@@ -73 +73 @@
 }
 
+ecl()
+{
+    exec "$1" -norc -load "$2" -eval "(progn $3 (ext:quit))"
+}
+
 clisp()
 { 
@@ -121 +126 @@
         notimplemented "$IMPL" "$FILE" "$FORM" ;;
     ecl*)
-        notimplemented "$IMPL" "$FILE" "$FORM" ;;
+        ecl   "$IMPL" "$FILE" "$FORM"          ;;
     alisp*)
         notimplemented "$IMPL" "$FILE" "$FORM" ;;