[movitz-cvs] CVS update: movitz/losp/muerte/scavenge.lisp

Frode Vatvedt Fjeld ffjeld at common-lisp.net
Fri Aug 26 22:42:44 UTC 2005


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

Modified Files:
	scavenge.lisp 
Log Message:
Be a bit more conservative about debugging.

Date: Sat Aug 27 00:42:43 2005
Author: ffjeld

Index: movitz/losp/muerte/scavenge.lisp
diff -u movitz/losp/muerte/scavenge.lisp:1.52 movitz/losp/muerte/scavenge.lisp:1.53
--- movitz/losp/muerte/scavenge.lisp:1.52	Fri Aug 26 21:38:19 2005
+++ movitz/losp/muerte/scavenge.lisp	Sat Aug 27 00:42:43 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.52 2005/08/26 19:38:19 ffjeld Exp $
+;;;; $Id: scavenge.lisp,v 1.53 2005/08/26 22:42:43 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -50,7 +50,9 @@
 	       (let ((code (dpb secondary
 				(byte 8 8)
 				(movitz:tag primary))))
-		 `(= ,code ,x))))
+		 `(= ,code ,x)))
+	     (record-scan (x)
+	       #+ignore `(setf *scan-last* ,x)))
     (do ((verbose *map-header-vals-verbose*)
 	 (*scan-last* nil)		; Last scanned object, for debugging.
 	 (scan start-location (1+ scan)))
@@ -79,12 +81,12 @@
 	    ;; Just skip the bigits
 	    (let* ((bigits (memref scan 0 :index 1 :type :unsigned-byte14))
 		   (delta (logior bigits 1)))
-	      (setf *scan-last* (%word-offset scan #.(movitz:tag :other)))
+	      (record-scan (%word-offset scan #.(movitz:tag :other)))
 	      (incf scan delta)))
 	   ((scavenge-typep x :defstruct)
 	    (assert (evenp scan) ()
 	      "Scanned struct-header ~S at odd location #x~X." x scan)
-	    (setf *scan-last* (%word-offset scan #.(movitz:tag :other))))
+	    (record-scan (%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." 
@@ -102,7 +104,7 @@
 	    (assert (evenp scan) ()
 	      "Scanned funobj-header ~S at odd location #x~X." 
 	      (memref scan 0 :type :unsigned-byte32) scan)
-	    (setf *scan-last* (%word-offset scan #.(movitz:tag :other)))
+	    (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)))
@@ -163,14 +165,14 @@
 	      "Scanned u8-vector-header ~S at odd location #x~X." x scan)
 	    (let ((len (memref scan 0 :index 1 :type :lisp)))
 	      (check-type len positive-fixnum)
-	      (setf *scan-last* (%word-offset scan #.(movitz:tag :other)))
+	      (record-scan (%word-offset scan #.(movitz:tag :other)))
 	      (incf scan (1+ (* 2 (truncate (+ 7 len) 8))))))
 	   ((scavenge-wide-typep x :basic-vector #.(bt:enum-value 'movitz:movitz-vector-element-type :u16))
 	    (assert (evenp scan) ()
 	      "Scanned u16-vector-header ~S at odd location #x~X." x scan)
 	    (let ((len (memref scan 0 :index 1)))
 	      (check-type len positive-fixnum)
-	      (setf *scan-last* (%word-offset scan #.(movitz:tag :other)))
+	      (record-scan (%word-offset scan #.(movitz:tag :other)))
 	      (incf scan (1+ (* 2 (truncate (+ 3 len) 4))))))
 	   ((scavenge-wide-typep x :basic-vector #.(bt:enum-value 'movitz:movitz-vector-element-type :u32))
 	    (assert (evenp scan) ()
@@ -178,7 +180,7 @@
 	    (let ((len (memref scan 4)))
 	      (assert (typep len 'positive-fixnum) ()
 		"Scanned basic-vector at ~S with illegal length ~S." scan len)
-	      (setf *scan-last* (%word-offset scan #.(movitz:tag :other)))
+	      (record-scan (%word-offset scan #.(movitz:tag :other)))
 	      (incf scan (1+ (logand (1+ len) -2)))))
 	   ((scavenge-typep x :basic-vector)
 	    (if (or (scavenge-wide-typep x :basic-vector
@@ -187,10 +189,10 @@
 		    (scavenge-wide-typep x :basic-vector
 					 #.(bt:enum-value 'movitz:movitz-vector-element-type
 							  :indirects)))
-		(setf *scan-last* (%word-offset scan #.(movitz:tag :other)))
+		(record-scan (%word-offset scan #.(movitz:tag :other)))
 	      (error "Scanned unknown basic-vector-header ~S at location #x~X." x scan)))
 	   ((and (eq x 3) (eq x2 0))
-	    (setf *scan-last* scan)
+	    (record-scan scan)
 	    (incf scan)
 	    (let ((delta (memref scan 0)))
 	      (check-type delta positive-fixnum)




More information about the Movitz-cvs mailing list