Changeset 11705

Timestamp:

03/14/09 20:18:57 (15 years ago)

Author:

ehuelsmann

Message:

Make MULTIPLE-VALUE-BIND restore its specials environment upon unexpected exit conditions
(eg Java exceptions); related to ticket #52.

File:

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

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

@@ -4089 +4089 @@
          (vars (second form))
          (bind-special-p nil)
-         (variables (block-vars block)))
+         (variables (block-vars block))
+         (label-START (gensym))
+         (label-END (gensym))
+         (label-EXIT (gensym)))
     (dolist (variable variables)
       (let ((special-p (variable-special-p variable)))
@@ -4104 +4107 @@
       (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))
     ;; Make sure there are no leftover values from previous calls.
     (emit-clear-values)
@@ -4161 +4165 @@
     (compile-progn-body (cdddr form) target)
     (when bind-special-p
-      ;; Restore dynamic environment.
+      (emit 'goto label-EXIT)
+      (label label-END)
       (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)
+
+      ;; Restore dynamic environment.
+      (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 propagate-vars (block)