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

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Tue Aug 14 03:36:11 2012
New Revision: 14082

Log:
Close #236: fix the COMPILE part of the issue.

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

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Tue Aug 14 01:01:40 2012	(r14081)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Tue Aug 14 03:36:11 2012	(r14082)
@@ -7341,23 +7341,23 @@
 generated class."
   (aver (eq (car form) 'LAMBDA))
   (catch 'compile-defun-abort
-    (let* ((class-file (make-abcl-class-file :pathname filespec))
-           (*compiler-error-bailout*
-            `(lambda ()
-               (compile-1
-                (make-compiland :name ',name
-                                :lambda-expression (make-compiler-error-form ',form)
-                                :class-file
-                                (make-abcl-class-file :pathname ,filespec))
-                ,stream)))
-           (*compile-file-environment* environment))
-      (compile-1 (make-compiland :name name
-                                 :lambda-expression
-                                 (precompiler:precompile-form form t
-                                                              environment)
-                                 :class-file class-file)
-                 stream)
-      class-file)))
+    (flet ((compiler-bailout ()
+             (let ((class-file (make-abcl-class-file :pathname filespec))
+                   (error-form (make-compiler-error-form form)))
+               (compile-1 (make-compiland :name name
+                                          :lambda-expression error-form
+                                          :class-file class-file)
+                          stream)
+               class-file)))
+      (let* ((class-file (make-abcl-class-file :pathname filespec))
+             (*compiler-error-bailout* #'compiler-bailout)
+             (*compile-file-environment* environment)
+             (precompiled-form (pre:precompile-form form t environment)))
+        (compile-1 (make-compiland :name name
+                                   :lambda-expression precompiled-form
+                                   :class-file class-file)
+                   stream)
+        class-file))))
 
 (defvar *catch-errors* t)