Changeset 12620

Timestamp:

04/16/10 13:41:21 (14 years ago)

Author:

Mark Evenson

Message:

Use interpreted form in a FASL if compliation fails.

INTERNAL-COMPILER-ERROR now signals that the form being compiled
should be written to the init FASL to be interpreted rather than being
the object of a SYSTEm:PROXY-PRELOADED-FUNCTION. A further
optimization of this strategy would be to actually not include the
failed compilation unit in the packed FASL.

This patches behavior for stack inconsistencies such as present in
ticket #89.

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• InternalCompilerError.java (added)
• StandardClass.java (modified) (3 diffs)
• Symbol.java (modified) (1 diff)
• compile-file.lisp (modified) (4 diffs)
• compiler-error.lisp (modified) (2 diffs)
• compiler-pass2.lisp (modified) (1 diff)
• make_condition.java (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/StandardClass.java

@@ -495 +495 @@
   public static final StandardClass COMPILER_ERROR =
     addStandardClass(Symbol.COMPILER_ERROR, list(CONDITION));
+    
+  public static final StandardClass INTERNAL_COMPILER_ERROR =
+    addStandardClass(Symbol.INTERNAL_COMPILER_ERROR, list(CONDITION));
 
   public static final StandardClass COMPILER_UNSUPPORTED_FEATURE_ERROR =
@@ -554 +557 @@
     COMPILER_ERROR.setCPL(COMPILER_ERROR, CONDITION, STANDARD_OBJECT,
                           BuiltInClass.CLASS_T);
+    INTERNAL_COMPILER_ERROR.setCPL(INTERNAL_COMPILER_ERROR, CONDITION, STANDARD_OBJECT,
+                                   BuiltInClass.CLASS_T);
     COMPILER_UNSUPPORTED_FEATURE_ERROR.setCPL(COMPILER_UNSUPPORTED_FEATURE_ERROR,
                                               CONDITION, STANDARD_OBJECT,
@@ -676 +681 @@
     CELL_ERROR.finalizeClass();
     COMPILER_ERROR.finalizeClass();
+    INTERNAL_COMPILER_ERROR.finalizeClass();
     COMPILER_UNSUPPORTED_FEATURE_ERROR.finalizeClass();
     CONDITION.finalizeClass();

trunk/abcl/src/org/armedbear/lisp/Symbol.java

@@ -2893 +2893 @@
   public static final Symbol COMPILER_ERROR =
     PACKAGE_EXT.addExternalSymbol("COMPILER-ERROR");
+  public static final Symbol INTERNAL_COMPILER_ERROR =
+    PACKAGE_EXT.addExternalSymbol("INTERNAL-COMPILER-ERROR");
   public static final Symbol COMPILER_UNSUPPORTED_FEATURE_ERROR =
     PACKAGE_EXT.addExternalSymbol("COMPILER-UNSUPPORTED-FEATURE-ERROR");

trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

@@ -146 +146 @@
                                  ,@decls (block ,block-name ,@body)))
                         (classfile (next-classfile-name))
+                        (compilation-failure-p nil)
                         (result (with-open-file
             (f classfile
@@ -151 +152 @@
                :element-type '(unsigned-byte 8)
                :if-exists :supersede)
-          (report-error
-           (jvm:compile-defun name expr nil
-                  classfile f nil))))
-                        (compiled-function (verify-load classfile)))
+                                  (handler-bind 
+                                      ((internal-compiler-error
+                                        #'(lambda (e)
+                                            (setf compilation-failure-p e)
+                                            (continue))))
+                                    (report-error
+                                     (jvm:compile-defun name expr nil
+                                                        classfile f nil)))))
+                        (compiled-function (and (not compilation-failure-p)
+                                                (verify-load classfile))))
        (declare (ignore result))
                    (cond
-                     (compiled-function
+                     ((and (not compilation-failure-p)
+                           compiled-function)
                       (setf form
                             `(fset ',name
@@ -170 +178 @@
                       (format *error-output*
                               "; Unable to compile function ~A~%" name)
+                      (when compilation-failure-p
+                        (format *error-output*
+                                "; ~A~%" compilation-failure-p))
                       (let ((precompiled-function
                              (precompiler:precompile-form expr nil
@@ -514 +525 @@
                   *forms-for-output*)
               (jvm::with-saved-compiler-policy
-                  (jvm::with-file-compilation
-                    (handler-bind ((style-warning #'(lambda (c)
-                                                      (setf warnings-p t)
-                                                      ;; let outer handlers
-                                                      ;; do their thing
-                                                      (signal c)
-                                                      ;; prevent the next
-                                                      ;; handler from running:
-                                                      ;; we're a WARNING subclass
-                                                      (continue)))
-                                   ((or warning
-                                        compiler-error) #'(lambda (c)
+                (jvm::with-file-compilation
+                    (handler-bind ((style-warning 
+                                    #'(lambda (c)
+                                        (setf warnings-p t)
+                                        ;; let outer handlers do their thing
+                                        (signal c)
+                                        ;; prevent the next handler
+                                        ;; from running: we're a
+                                        ;; WARNING subclass
+                                        (continue)))
+                                   ((or warning 
+                                        compiler-error)
+                                    #'(lambda (c)
                                         (declare (ignore c))
                                         (setf warnings-p t

trunk/abcl/src/org/armedbear/lisp/compiler-error.lisp

@@ -36 +36 @@
           compiler-warn
           compiler-error
+          internal-compiler-error
           compiler-unsupported))
 
@@ -55 +56 @@
          :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))
+
 (defun compiler-unsupported (format-control &rest format-arguments)
   (error 'compiler-unsupported-feature-error

trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

@@ -1343 +1343 @@
         (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)))
+                   i instruction-depth (+ depth instruction-stack))
+          (internal-compiler-error "Stack inconsistency detected in ~A." 
+                                   (compiland-name *current-compiland*)))
         (return-from walk-code))
       (let ((opcode (instruction-opcode instruction)))

trunk/abcl/src/org/armedbear/lisp/make_condition.java

@@ -122 +122 @@
         if (symbol == Symbol.COMPILER_ERROR)
             return new CompilerError(initArgs);
+        if (symbol == Symbol.INTERNAL_COMPILER_ERROR)
+            return new InternalCompilerError(initArgs);
         if (symbol == Symbol.COMPILER_UNSUPPORTED_FEATURE_ERROR)
             return new CompilerUnsupportedFeatureError(initArgs);