Changeset 8461

Timestamp:

Feb 10, 2008, 10:54:25 PM (17 years ago)

Author:

Gary Byers

Message:

Fix X862-NLEXIT: don't pop foreign/temp frames if nthrow already
did, try to coalesce nthrow calls, only adjust stacks after last
catch.

File:

• trunk/source/compiler/X86/x862.lisp (modified) (3 diffs)

trunk/source/compiler/X86/x862.lisp

@@ -4939 +4939 @@
          (cstack *x862-cstack*)
          (vstack *x862-vstack*)
-         (target-cstack)
          (target-vstack)
          (lastcatch n)
-         (i nil)
          (returning (eq xfer $backend-return))
          (junk1 nil)
@@ -4972 +4970 @@
                      (setq numnthrow 0)
                      (multiple-value-setq (junk1 cstack vstack)
-                       (x862-decode-stack (aref *x862-undo-stack* lastcatch))))))
+                       (x862-decode-stack (aref *x862-undo-stack* lastcatch)))))
+                 (find-last-catch ()
+                   (do* ((n n)
+                         (reasons *x862-undo-because*))
+                        ((= n dest))
+                     (declare (fixnum n))
+                     (when (eql $undocatch (aref reasons (decf n)))
+                       (incf numnthrow)
+                       (setq lastcatch n)))))
+                            
+            (find-last-catch)
+            (throw-through-numnthrow-catch-frames)
+            (setq n lastcatch)
             (while (%i> n dest)
-              (cond ((eql $undocatch (setq reason (aref *x862-undo-because* (setq n (%i- n 1)))))
-                     (pop-temp-frames)
-                     (pop-c-frames)
-                     (setq numnthrow (%i+ numnthrow 1) lastcatch n))
-                    ((eql $undostkblk reason)
-                     (throw-through-numnthrow-catch-frames)
+              (setq reason (aref *x862-undo-because* (setq n (%i- n 1))))
+              (cond ((eql $undostkblk reason)
                      (incf num-temp-frames))
                     ((eql $undo-x86-c-frame reason)
-                     (throw-through-numnthrow-catch-frames)
-                     (incf num-c-frames))))
-            (throw-through-numnthrow-catch-frames)
-            (setq i lastcatch)
-            (while (%i> i dest)
-              (let ((reason (aref *x862-undo-because* (setq i (%i- i 1)))))
-                (if (or (eql reason $undospecial)
+                     (incf num-c-frames))
+                    ((or (eql reason $undospecial)
                         (eql reason $undointerruptlevel))
                   (push reason unbind))))
@@ -5008 +5009 @@
                       (! slide-values))
                     (! adjust-vsp vdiff)))))
-            (setq num-temp-frames 0 num-c-frames 0)
-            (while (%i> lastcatch dest)
-              (let ((reason (aref *x862-undo-because* (setq lastcatch (%i- lastcatch 1)))))
-                (setq target-cstack (nth-value 1
-                                               (x862-decode-stack (aref *x862-undo-stack* lastcatch))))
-                (if (eq reason $undostkblk)
-                  (incf num-temp-frames))
-                (if (eq reason $undo-x86-c-frame)
-                  (incf num-c-frames))
-                (if (%i> cstack target-cstack)
-                  (compiler-bug "bug: adjust foreign stack ??"))
-                ;; else what's going on? $sp-stkcons, for one thing
-                (setq cstack target-cstack)))
             (pop-temp-frames)
             (pop-c-frames)))