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

[Erik Huelsmann]

Author: ehuelsmann
Date: Sat May  2 18:06:36 2009
New Revision: 11816

Log:
Selectively clear values in UNWIND-PROTECT:
don't clear if the protected form returns a single value.

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	Sat May  2 18:06:36 2009
@@ -7874,9 +7874,10 @@
       (let* ((*blocks* (cons block *blocks*)))
         (label BEGIN-PROTECTED-RANGE)
         (compile-form protected-form result-register nil)
-        (emit-push-current-thread)
-        (emit 'getfield +lisp-thread-class+ "_values" +lisp-object-array+)
-        (astore values-register)
+        (unless (single-valued-p protected-form)
+          (emit-push-current-thread)
+          (emit 'getfield +lisp-thread-class+ "_values" +lisp-object-array+)
+          (astore values-register))
         (label END-PROTECTED-RANGE))
       (dolist (subform cleanup-forms)
         (compile-form subform nil nil))
@@ -7886,14 +7887,15 @@
       (astore exception-register)
       (dolist (subform cleanup-forms)
         (compile-form subform nil nil))
-      (emit-clear-values)
+      (maybe-emit-clear-values cleanup-forms)
       (aload exception-register)
       (emit 'athrow) ; Re-throw exception.
       (label EXIT)
       ;; Restore multiple values returned by protected form.
-      (emit-push-current-thread)
-      (aload values-register)
-      (emit 'putfield +lisp-thread-class+ "_values" +lisp-object-array+)
+      (unless (single-valued-p protected-form)
+        (emit-push-current-thread)
+        (aload values-register)
+        (emit 'putfield +lisp-thread-class+ "_values" +lisp-object-array+))
       ;; Result.
       (aload result-register)
       (emit-move-from-stack target)