[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-serv19956

Modified Files:
	scavenge.lisp 
Log Message:
Changed order of arguments for %run-time-context-slot, new signature
is (context slot-name), where nil may be used as a designator for
(current-run-time-context).

Date: Thu May  5 22:51:55 2005
Author: ffjeld

Index: movitz/losp/muerte/scavenge.lisp
diff -u movitz/losp/muerte/scavenge.lisp:1.49 movitz/losp/muerte/scavenge.lisp:1.50
--- movitz/losp/muerte/scavenge.lisp:1.49	Wed Mar  9 08:24:16 2005
+++ movitz/losp/muerte/scavenge.lisp	Thu May  5 22:51:55 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.49 2005/03/09 07:24:16 ffjeld Exp $
+;;;; $Id: scavenge.lisp,v 1.50 2005/05/05 20:51:55 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -84,6 +84,19 @@
 	    (assert (evenp scan) ()
 	      "Scanned struct-header ~S at odd location #x~X." x scan)
 	    (setf *scan-last* (%word-offset scan #.(movitz:tag :other))))
+	   ((scavenge-typep x :run-time-context)
+	    (assert (evenp scan) ()
+	      "Scanned run-time-context-header ~S at odd location #x~X." 
+	      (memref scan 0 :type :unsigned-byte32) scan)
+	    (incf scan)
+	    (let ((non-lispvals #.(cl:truncate (cl:+ -4 (bt:slot-offset 'movitz::movitz-run-time-context
+									'movitz::pointer-start)
+						     (movitz::image-nil-word movitz:*image*))
+					       4))
+		  (end (+ scan #.(movitz::movitz-type-word-size 'movitz::movitz-run-time-context))))
+	      (incf scan non-lispvals)
+	      (map-lisp-vals function scan (1+ end))
+	      (setf scan end)))
 	   ((scavenge-typep x :funobj)
 	    (assert (evenp scan) ()
 	      "Scanned funobj-header ~S at odd location #x~X." 
@@ -213,7 +226,9 @@
 (defun scavenge-find-pf (function location)
   (loop for (slot-name type) in (slot-value (class-of (current-run-time-context)) 'slot-map)
       do (when (eq type 'code-vector-word)
-	   (let ((it (scavenge-match-code-vector function (%run-time-context-slot slot-name) location)))
+	   (let ((it (scavenge-match-code-vector function
+						 (%run-time-context-slot nil slot-name)
+						 location)))
 	     (when it (return it))))))
 
 (defun scavenge-find-code-vector (function location casf-funobj esi &optional primitive-function-p edx)
@@ -234,7 +249,9 @@
 		    (scavenge-match-code-vector function x location)))))))
     (cond
      ((scavenge-match-code-vector function (symbol-value 'ret-trampoline) location))
-     ((scavenge-match-code-vector function (%run-time-context-slot 'dynamic-jump-next) location))
+     ((scavenge-match-code-vector function
+				  (%run-time-context-slot nil 'dynamic-jump-next)
+				  location))
      ((eq 0 casf-funobj)
       (let ((dit-code-vector (symbol-value 'default-interrupt-trampoline)))
 	(cond