[movitz-cvs] CVS update: movitz/losp/muerte/scavenge.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv19141

Modified Files:
	scavenge.lisp 
Log Message:
Fixed a number of stack-scavenging bugs.

Date: Wed Feb  2 08:50:57 2005
Author: ffjeld

Index: movitz/losp/muerte/scavenge.lisp
diff -u movitz/losp/muerte/scavenge.lisp:1.45 movitz/losp/muerte/scavenge.lisp:1.46
--- movitz/losp/muerte/scavenge.lisp:1.45	Mon Jan 31 18:54:03 2005
+++ movitz/losp/muerte/scavenge.lisp	Wed Feb  2 08:50:57 2005
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Mon Mar 29 14:54:08 2004
 ;;;;                
-;;;; $Id: scavenge.lisp,v 1.45 2005/01/31 17:54:03 ffjeld Exp $
+;;;; $Id: scavenge.lisp,v 1.46 2005/02/02 07:50:57 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -175,7 +175,7 @@
 	     (when (location-in-object-p code-vector location)
 	       (return code-vector))))))
 
-(defun scavenge-find-code-vector (location casf-funobj esi &optional primitive-function-p)
+(defun scavenge-find-code-vector (location casf-funobj esi &optional primitive-function-p edx)
   (flet ((match-funobj (funobj location)
 	   (cond
 	    ((not (typep funobj 'function))
@@ -203,7 +203,9 @@
 	 ((match-funobj esi location))
 	 (t (break "DIT returns outside DIT??")))))
      ((match-funobj casf-funobj location))
-     ((match-funobj esi location))
+     ((match-funobj esi location))      
+     ((match-funobj edx location)
+      (break "Trampoline/EDX situation?"))
      ((not (typep casf-funobj 'function))
       (break "Unknown funobj/frame-type: ~S" casf-funobj))
      ((location-in-object-p (%run-time-context-slot 'dynamic-jump-next) location)
@@ -302,7 +304,7 @@
 					 0 interrupted-esi
 					 nil))
 	     (new-code-vector (map-stack-instruction-pointer function eip-index old-code-vector)))
-	;;
+	;; (when atomically (we should be more clever about the stack..))
 	(multiple-value-bind (x0-location x0-tag)
 	    (stack-frame-ref nil next-frame-bottom 0 :signed-byte30+2)
 	  (cond
@@ -316,7 +318,9 @@
 		(symbol-value 'ret-trampoline)))
 	    (let* ((old-x0-code-vector
 		    (scavenge-find-code-vector (stack-frame-ref nil next-eip-index 0 :location)
-					       casf-funobj interrupted-esi t)))
+					       casf-funobj interrupted-esi t
+					       (unless secondary-register-mode-p
+						 (dit-frame-ref nil dit-frame :edx)))))
 	      (map-stack-instruction-pointer function next-eip-index old-x0-code-vector))
 	    (setf next-eip-index next-frame-bottom
 		  next-frame-bottom (1+ next-frame-bottom)))
@@ -328,7 +332,10 @@
 			   (location-in-object-p casf-code-vector x1-location))
 		  (let* ((old-x1-code-vector
 			  (scavenge-find-code-vector (stack-frame-ref nil next-eip-index 0 :location)
-						     casf-funobj interrupted-esi t)))
+						     casf-funobj
+						     (unless secondary-register-mode-p
+						       interrupted-esi)
+						     t)))
 		    (map-stack-instruction-pointer function next-eip-index old-x1-code-vector))
 		  (setf next-eip-index (+ 1 next-frame-bottom)
 			next-frame-bottom (+ 2 next-frame-bottom)))))))