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

[Erik Huelsmann]

Author: ehuelsmann
Date: Sun May  3 17:00:28 2009
New Revision: 11827

Log:
P2-CATCH: Do what we do in P1-CATCH, which is binding
the CATCH block during compilation of the body.

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	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Sun May  3 17:00:28 2009
@@ -7792,11 +7792,12 @@
       (aload tag-register)
       (emit-invokevirtual +lisp-thread-class+ "pushCatchTag"
                           (lisp-object-arg-types 1) nil)
-      ; Stack depth is 0.
-      (label BEGIN-PROTECTED-RANGE) ; Start of protected range.
-      (compile-progn-body (cddr form) target) ; Implicit PROGN.
-      (label END-PROTECTED-RANGE) ; End of protected range.
-      (emit 'goto EXIT) ; Jump over handlers.
+      (let ((*blocks* (cons block *blocks*)))
+        ; Stack depth is 0.
+        (label BEGIN-PROTECTED-RANGE) ; Start of protected range.
+        (compile-progn-body (cddr form) target) ; Implicit PROGN.
+        (label END-PROTECTED-RANGE) ; End of protected range.
+        (emit 'goto EXIT)) ; Jump over handlers.
       (label THROW-HANDLER) ; Start of handler for THROW.
       ;; The Throw object is on the runtime stack. Stack depth is 1.
       (emit 'dup) ; Stack depth is 2.