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

[Erik Huelsmann]

Author: ehuelsmann
Date: Sun May  3 15:01:53 2009
New Revision: 11823

Log:
Revert r11814 (fix for stack inconsistencies),
because it breaks in other horrible ways.

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 15:01:53 2009
@@ -7871,10 +7871,12 @@
            (exception-register (allocate-register))
            (result-register (allocate-register))
            (values-register (allocate-register))
+           (return-address-register (allocate-register))
            (BEGIN-PROTECTED-RANGE (gensym))
            (END-PROTECTED-RANGE (gensym))
            (HANDLER (gensym))
-           (EXIT (gensym)))
+           (EXIT (gensym))
+           (CLEANUP (gensym)))
       ;; Make sure there are no leftover multiple return values from previous calls.
       (emit-clear-values)
 
@@ -7886,17 +7888,21 @@
           (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))
+      (emit 'jsr CLEANUP)
       (emit 'goto EXIT) ; Jump over handler.
       (label HANDLER) ; Start of exception handler.
       ;; The Throwable object is on the runtime stack. Stack depth is 1.
       (astore exception-register)
-      (dolist (subform cleanup-forms)
-        (compile-form subform nil nil))
+      (emit 'jsr CLEANUP) ; Call cleanup forms.
       (maybe-emit-clear-values cleanup-forms)
       (aload exception-register)
       (emit 'athrow) ; Re-throw exception.
+      (label CLEANUP) ; Cleanup forms.
+      ;; Return address is on stack here.
+      (astore return-address-register)
+      (dolist (subform cleanup-forms)
+        (compile-form subform nil nil))
+      (emit 'ret return-address-register)
       (label EXIT)
       ;; Restore multiple values returned by protected form.
       (unless (single-valued-p protected-form)