Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv29180
Modified Files: scavenge.lisp Log Message: In map-header-vals fix scanning of not-entirely-initialized funobjs. Add map-header-vals*, mostly as a debugging tool.
--- /project/movitz/cvsroot/movitz/losp/muerte/scavenge.lisp 2007/03/16 22:13:55 1.59 +++ /project/movitz/cvsroot/movitz/losp/muerte/scavenge.lisp 2007/04/05 21:12:19 1.60 @@ -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.59 2007/03/16 22:13:55 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.60 2007/04/05 21:12:19 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -40,6 +40,11 @@ (unless (eq object new-object) (setf (memref location 0) new-object)))))))
+(defun map-header-vals* (function &optional (vector (%run-time-context-slot nil 'nursery-space))) + (check-type vector (vector (unsigned-byte 32))) + (let ((location (+ 2 (object-location vector)))) + (map-header-vals function location (+ location (length vector))))) + (defun map-header-vals (function start-location end-location) "Map function over each potential pointer word between start-location and end-location." @@ -106,7 +111,9 @@ (record-scan (%word-offset scan #.(movitz:tag :other))) ;; Process code-vector pointers specially.. (let* ((old-code-vector (memref (incf scan) 0 :type :code-vector)) - (new-code-vector (map-instruction-pointer function scan old-code-vector))) + (new-code-vector (if (eq 0 old-code-vector) + 0 ; i.e. a non-initialized funobj. + (map-instruction-pointer function scan old-code-vector)))) (cond ((not (eq new-code-vector old-code-vector)) ;; Code-vector%1op