[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