[armedbear-cvs] r12622 - trunk/abcl/src/org/armedbear/lisp

[Mark Evenson]

Author: mevenson
Date: Sun Apr 18 05:26:22 2010
New Revision: 12622

Log:
Restore buildable trunk arising from ASDF2 compilation.



Modified:
   trunk/abcl/src/org/armedbear/lisp/compile-file.lisp
   trunk/abcl/src/org/armedbear/lisp/compiler-error.lisp
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compile-file.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compile-file.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compile-file.lisp	Sun Apr 18 05:26:22 2010
@@ -145,7 +145,7 @@
                  (let* ((expr `(lambda ,lambda-list
                                  , at decls (block ,block-name , at body)))
                         (classfile (next-classfile-name))
-                        (compilation-failure-p nil)
+                        (internal-compiler-errors nil)
                         (result (with-open-file
 				    (f classfile
 				       :direction :output
@@ -154,16 +154,17 @@
                                   (handler-bind 
                                       ((internal-compiler-error
                                         #'(lambda (e)
-                                            (setf compilation-failure-p e)
+                                            (push e internal-compiler-errors)
                                             (continue))))
                                     (report-error
                                      (jvm:compile-defun name expr nil
                                                         classfile f nil)))))
-                        (compiled-function (and (not compilation-failure-p)
-                                                (verify-load classfile))))
+                        (compiled-function (if (not internal-compiler-errors)
+                                               (verify-load classfile)
+                                               nil)))
 		   (declare (ignore result))
                    (cond
-                     ((and (not compilation-failure-p)
+                     ((and (not internal-compiler-errors)
                            compiled-function)
                       (setf form
                             `(fset ',name
@@ -176,10 +177,11 @@
                      (t
                       ;; FIXME Should be a warning or error of some sort...
                       (format *error-output*
-                              "; Unable to compile function ~A~%" name)
-                      (when compilation-failure-p
-                        (format *error-output*
-                                "; ~A~%" compilation-failure-p))
+                              "; Unable to compile function ~A.  Using interpreted form instead.~%" name)
+                      (when internal-compiler-errors
+                        (dolist (e internal-compiler-errors)
+                          (format *error-output*
+                                  "; ~A~%" e)))
                       (let ((precompiled-function
                              (precompiler:precompile-form expr nil
                                               *compile-file-environment*)))

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-error.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-error.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-error.lisp	Sun Apr 18 05:26:22 2010
@@ -56,9 +56,10 @@
          :format-arguments format-arguments))
 
 (defun internal-compiler-error (format-control &rest format-arguments)
-  (signal 'internal-compiler-error
-         :format-control format-control
-         :format-arguments format-arguments))
+  (cerror "Eventually use interpreted form instead" 
+          'internal-compiler-error
+          :format-control format-control
+          :format-arguments format-arguments))
 
 (defun compiler-unsupported (format-control &rest format-arguments)
   (error 'compiler-unsupported-feature-error

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Sun Apr 18 05:26:22 2010
@@ -1341,10 +1341,10 @@
       (declare (type fixnum instruction-stack))
       (when instruction-depth
         (unless (= (the fixnum instruction-depth) (the fixnum (+ depth instruction-stack)))
-          (format t "~&Stack inconsistency at index ~D: found ~S, expected ~S.~%"
-                   i instruction-depth (+ depth instruction-stack))
-          (internal-compiler-error "Stack inconsistency detected in ~A." 
-                                   (compiland-name *current-compiland*)))
+          (internal-compiler-error 
+           "Stack inconsistency detected in ~A at index ~D: found ~S, expected ~S." 
+           (compiland-name *current-compiland*)
+           i instruction-depth (+ depth instruction-stack)))
         (return-from walk-code))
       (let ((opcode (instruction-opcode instruction)))
         (setf depth (+ depth instruction-stack))