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

Modified Files: scavenge.lisp Log Message: In scavenge-find-code-vector, fixed the situation when the DIT shared an inclomplete stack-frame with the handler.

Date: Wed Jan 26 05:46:14 2005 Author: ffjeld

Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.40 movitz/losp/muerte/scavenge.lisp:1.41 --- movitz/losp/muerte/scavenge.lisp:1.40 Tue Jan 25 05:56:18 2005 +++ movitz/losp/muerte/scavenge.lisp Wed Jan 26 05:46:14 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Mon Mar 29 14:54:08 2004 ;;;; -;;;; $Id: scavenge.lisp,v 1.40 2005/01/25 13:56:18 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.41 2005/01/26 13:46:14 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -168,23 +168,11 @@ (+ start-frame 1) map-region))

-;;;(defun map-code-vector-slot (function stack slot casf-funobj) -;;; (let ((casf-code-vector (if (eq 0 casf-funobj) -;;; (symbol-value 'default-interrupt-trampoline) -;;; (funobj-code-vector casf-funobj))) -;;; (eip-location (stack-frame-ref stack slot 0 :location))) -;;; (cond -;;; ((location-in-object-p casf-code-vector eip-location) -;;; (let ((new (funcall function casf-code-vector nil))) -;;; (when (not (eq new casf-code-vector)) -;;; ;; Perform some pointer arithmetics.. -;;; (let ((offset (- (stack-frame-ref stack slot 0 :unsigned-byte32) -;;; (%object-lispval casf-code-vector)))) -;;; (break "Code-vector for ~S moved, offset is ~D." casf-code-vector offset)))))))) - (defun scavenge-find-code-vector (location casf-funobj esi &optional searchp) (flet ((match-funobj (funobj location) (cond + ((not (typep funobj 'function)) + nil) ((let ((x (funobj-code-vector casf-funobj))) (and (location-in-object-p x location) x))) ((let ((x (funobj-code-vector%1op casf-funobj))) @@ -202,12 +190,13 @@ (cond ((eq 0 casf-funobj) (let ((dit-code-vector (symbol-value 'default-interrupt-trampoline))) - (if (location-in-object-p dit-code-vector location) - dit-code-vector - (break "DIT returns outside DIT??")))) - ((and (typep esi 'function) - (match-funobj esi location))) + (cond + ((location-in-object-p dit-code-vector location) + dit-code-vector) + ((match-funobj esi)) + (t (break "DIT returns outside DIT??"))))) ((match-funobj casf-funobj location)) + ((match-funobj esi location)) ((not (typep casf-funobj 'function)) (break "Unknown funobj/frame-type: ~S" casf-funobj)) ((when searchp @@ -275,6 +264,7 @@ (= 0 (ldb (byte 2 0) atomically))) ;; Interrupt occurred inside an (non-pf) atomically, so none of the ;; GC-root registers are active. + #+ignore (setf (dit-frame-ref nil dit-frame :eax) nil (dit-frame-ref nil dit-frame :ebx) nil (dit-frame-ref nil dit-frame :edx) nil