[movitz-cvs] CVS movitz/losp/muerte

[ffjeld]

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