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@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