Changeset 11704 for trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Timestamp:

03/13/09 22:21:13 (14 years ago)

Author:

ehuelsmann

Message:

Restore lastSpecialBinding upon exception-driven LET/LET* block exit.

File:

• trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (modified) (3 diffs)

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

@@ -4469 +4469 @@
          (form (block-form block))
          (*visible-variables* *visible-variables*)
-         (specialp nil))
+         (specialp nil)
+         (label-START (gensym))
+         (label-END (gensym))
+         (label-EXIT (gensym)))
     ;; Walk the variable list looking for special bindings and unused lexicals.
     (dolist (variable (block-vars block))
@@ -4482 +4485 @@
       (emit-push-current-thread)
       (emit 'getfield +lisp-thread-class+ "lastSpecialBinding" +lisp-special-binding+)
-      (astore (block-environment-register block)))
+      (astore (block-environment-register block))
+      (label label-START))
     (propagate-vars block)
     (ecase (car form)
@@ -4497 +4501 @@
       (compile-progn-body (cddr form) target representation))
     (when specialp
+      (emit 'goto label-EXIT)
+      (label label-END)
       ;; Restore dynamic environment.
       (aload *thread*)
       (aload (block-environment-register block))
-      (emit 'putfield +lisp-thread-class+ "lastSpecialBinding" +lisp-special-binding+))))
+      (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
+            +lisp-special-binding+)
+      (emit 'athrow)
+
+      (label label-EXIT)
+      (aload *thread*)
+      (aload (block-environment-register block))
+      (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
+            +lisp-special-binding+)
+
+      (push (make-handler :from label-START
+                          :to label-END
+                          :code label-END
+                          :catch-type 0) *handlers*))))
 
 (defun p2-locally (form target representation)