[movitz-cvs] CVS update: movitz/losp/los0-gc.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	los0-gc.lisp 
Log Message:
Renamed the scavenging operators to map-header-vals and
map-stack-vector. Added map-lisp-vals.

Date: Fri Nov 26 15:59:19 2004
Author: ffjeld

Index: movitz/losp/los0-gc.lisp
diff -u movitz/losp/los0-gc.lisp:1.43 movitz/losp/los0-gc.lisp:1.44
--- movitz/losp/los0-gc.lisp:1.43	Thu Nov 25 19:05:23 2004
+++ movitz/losp/los0-gc.lisp	Fri Nov 26 15:59:18 2004
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Sat Feb 21 17:48:32 2004
 ;;;;                
-;;;; $Id: los0-gc.lisp,v 1.43 2004/11/25 18:05:23 ffjeld Exp $
+;;;; $Id: los0-gc.lisp,v 1.44 2004/11/26 14:59:18 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -304,8 +304,8 @@
 	     (if (object-in-space-p oldspace x)
 		 nil
 	       x)))
-      (map-heap-words #'zap-oldspace 0 (malloc-end))
-      (map-stack-words #'zap-oldspace nil (current-stack-frame))
+      (map-header-vals #'zap-oldspace 0 (malloc-end))
+      (map-stack-vector #'zap-oldspace nil (current-stack-frame))
       (initialize-space oldspace)
       (values))))
 
@@ -354,16 +354,16 @@
 			   forward-x))))))))
       ;; Scavenge roots
       (dolist (range muerte::%memory-map-roots%)
-	(map-heap-words evacuator (car range) (cdr range)))
-      (map-stack-words evacuator nil (current-stack-frame))
+	(map-header-vals evacuator (car range) (cdr range)))
+      (map-stack-vector evacuator nil (current-stack-frame))
       ;; Scan newspace, Cheney style.
       (loop with newspace-location = (+ 2 (object-location newspace))
 	  with scan-pointer = 2
 	  as fresh-pointer = (space-fresh-pointer newspace)
 	  while (< scan-pointer fresh-pointer)
-	  do (map-heap-words evacuator
-			     (+ newspace-location scan-pointer)
-			     (+ newspace-location (space-fresh-pointer newspace)))
+	  do (map-header-vals evacuator
+			      (+ newspace-location scan-pointer)
+			      (+ newspace-location (space-fresh-pointer newspace)))
 	     (setf scan-pointer fresh-pointer))
 
       ;; Consistency check..
@@ -394,13 +394,13 @@
 new object: ~Z: ~S
 oldspace: ~Z, newspace: ~Z, i: ~D"
 			     old old new new oldspace newspace i))))))
-	    (map-heap-words (lambda (x y)
-			      (declare (ignore y))
-			      (when (location-in-object-p (space-other (%run-time-context-slot 'nursery-space))
-							  (object-location x))
-				(break "Seeing old object in values-vector: ~Z" x))
-			      x)
-			    #x38 #xb8)
+	    (map-header-vals (lambda (x y)
+			       (declare (ignore y))
+			       (when (location-in-object-p (space-other (%run-time-context-slot 'nursery-space))
+							   (object-location x))
+				 (break "Seeing old object in values-vector: ~Z" x))
+			       x)
+			     #x38 #xb8)
 	    (let* ((stack (%run-time-context-slot 'muerte::nursery-space))
 		   (stack-start (- (length stack) (muerte::current-control-stack-depth))))
 	      (do ((i 0 (+ i 3)))
@@ -442,14 +442,14 @@
       (handler-bind
 	  ((serious-condition (lambda (c)
 				(when (and continuep
-					   (find-restart 'muerte::continue-map-heap-words))
+					   (find-restart 'muerte::continue-map-header-vals))
 				  (warn "Automatic continue from scanning error: ~A" c)
-				  (invoke-restart 'muerte::continue-map-heap-words)))))
+				  (invoke-restart 'muerte::continue-map-header-vals)))))
 	(dolist (range muerte::%memory-map-roots%)
-	  (map-heap-words #'searcher (car range) (cdr range)))
+	  (map-header-vals #'searcher (car range) (cdr range)))
 	(let ((nursery (%run-time-context-slot 'muerte::nursery-space)))
-	  (map-heap-words #'searcher
-			  (+ 4 (object-location nursery))
-			  (+ 4 (object-location nursery) (space-fresh-pointer nursery))))
-	(map-stack-words #'searcher nil (current-stack-frame))))
+	  (map-header-vals #'searcher
+			   (+ 4 (object-location nursery))
+			   (+ 4 (object-location nursery) (space-fresh-pointer nursery))))
+	(map-stack-vector #'searcher nil (current-stack-frame))))
     results))