Changeset 5873

Timestamp:

Feb 10, 2007, 9:15:01 PM (18 years ago)

Author:

Gary Byers

Message:

alloc-c-frame vinsn takes "extra" word count, not total byte count.

Fix handling of $undo-x86-c-frame in x862-nlexit. (Need to check the
PPC case, as well.)

File:

• trunk/ccl/compiler/X86/x862.lisp (modified) (6 diffs)

trunk/ccl/compiler/X86/x862.lisp

@@ -4862 +4862 @@
     (with-x86-local-vinsn-macros (seg)
       (when (neq 0 nlevels)
-        (let* ((numnlispareas 0))
-          (declare (fixnum numnlispareas))
-          (flet ((popnlispareas ()
-                   (dotimes (i numnlispareas)
+        (let* ((num-temp-frames 0)
+               (num-c-frames 0))
+          (declare (fixnum numnlispareas num-c-frames))
+          (flet ((pop-temp-frames ()
+                   (dotimes (i num-temp-frames)
                      (! discard-temp-frame)))
+                 (pop-c-frames ()
+                   (dotimes (i num-c-frames)
+                     (! discard-c-frame)))
                  (throw-through-numnthrow-catch-frames ()
                    (when (neq 0 numnthrow)
@@ -4881 +4885 @@
             (while (%i> n dest)
               (cond ((eql $undocatch (setq reason (aref *x862-undo-because* (setq n (%i- n 1)))))
-                     (popnlispareas)
+                     (pop-temp-frames)
+                     (pop-c-frames)
                      (setq numnthrow (%i+ numnthrow 1) lastcatch n))
                     ((eql $undostkblk reason)
                      (throw-through-numnthrow-catch-frames)
-                     (incf numnlispareas))
+                     (incf num-temp-frames))
                     ((eql $undo-x86-c-frame reason)
-                     (! discard-c-frame))))
+                     (throw-through-numnthrow-catch-frames)
+                     (incf num-c-frames))))
             (throw-through-numnthrow-catch-frames)
             (setq i lastcatch)
@@ -4910 +4916 @@
                       (! slide-values))
                     (! adjust-vsp vdiff)))))
-            (setq numnlispareas 0)
+            (setq num-temp-frames 0 num-c-frames 0)
             (while (%i> lastcatch dest)
               (let ((reason (aref *x862-undo-because* (setq lastcatch (%i- lastcatch 1)))))
@@ -4916 +4922 @@
                                                (x862-decode-stack (aref *x862-undo-stack* lastcatch))))
                 (if (eq reason $undostkblk)
-                  (incf numnlispareas))
+                  (incf num-temp-frames))
+                (if (eq reason $undo-x86-c-frame)
+                  (incf num-c-frames))
                 (if (%i> cstack target-cstack)
                   (error "bug: adjust foreign stack ??"))
                 ;; else what's going on? $sp-stkcons, for one thing
                 (setq cstack target-cstack)))
-            (popnlispareas)))
+            (pop-temp-frames)
+            (pop-c-frames)))
         vstack))))
 
@@ -8307 +8316 @@
         (when (zerop total-words)
           (setq simple-foreign-args nil))
-        (! alloc-c-frame (ash (+ 8 (logandc2 (1+ total-words) 1))
-                              *x862-target-fixnum-shift*)))
+        (! alloc-c-frame total-words))
       (x862-open-undo $undo-x86-c-frame)
       (setq ngpr-args 0)
@@ -8421 +8429 @@
         (when (null argspecs)
           (setq simple-foreign-args t))
-        (! alloc-c-frame (ash (+ 8 (logandc2 (1+ total-words) 1))
-                              *x862-target-fixnum-shift*)))
+        (! alloc-c-frame total-words))
       (x862-open-undo $undo-x86-c-frame)
       (setq single-float-offset (+ other-offset nother-words))