Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv6681
Modified Files: scavenge.lisp Log Message: Tweaks to map-heap-words, added some invariant assertions.
Date: Mon Jul 12 00:56:45 2004 Author: ffjeld
Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.13 movitz/losp/muerte/scavenge.lisp:1.14 --- movitz/losp/muerte/scavenge.lisp:1.13 Wed Jul 7 10:37:25 2004 +++ movitz/losp/muerte/scavenge.lisp Mon Jul 12 00:56:45 2004 @@ -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.13 2004/07/07 17:37:25 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.14 2004/07/12 07:56:45 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -27,6 +27,7 @@ ;; circumstances, i.e. when you know there is no outside GC ;; etc. involved.
+(defvar *scan*)
(defun map-heap-words (function start-location end-location) "Map function over each potential pointer word between @@ -49,11 +50,13 @@ (:compile-form (:result-mode :eax) ,x) (:andl #xffff0000 :eax) (:shrl ,(- 16 movitz:+movitz-fixnum-shift+) :eax)))) - (do ((scan start-location (1+ scan))) + (do ((*scan-last* nil) ; Last scanned object, for debugging. + (scan start-location (1+ scan))) ((>= scan end-location)) - (let (;; (*i* i) + (declare (special *scan-last*)) + (let ((*scan* scan) (x (memref scan 0 0 :lisp))) - ;; (declare (special *i*)) + (declare (special *scan*)) (cond ((typep x '(or null fixnum character))) ((scavenge-typep x :illegal) @@ -64,10 +67,12 @@ ;; Just skip the bigits (let* ((bigits (word-upper16 x)) (delta (1+ (logand bigits -2)))) + (setf *scan-last* (%word-offset scan #.(movitz:tag :other))) (incf scan delta))) ((scavenge-typep x :funobj) (assert (evenp scan) () "Scanned #x~Z at odd address #x~X." x scan) + (setf *scan-last* (%word-offset scan #.(movitz:tag :other))) ;; Process code-vector pointer specially.. (let* ((funobj (%word-offset scan #.(movitz:tag :other))) (code-vector (funobj-code-vector funobj)) @@ -86,8 +91,6 @@ (assert (evenp scan) () "Scanned #x~Z at odd address #x~X." x scan) (error "Scanning an infant object ~Z at ~S (end ~S)." x scan end-location)) - ((scavenge-typep x :old-vector) - (error "Scanned old-vector #x~Z at odd address #x~X." x scan)) ((or (scavenge-wide-typep x :basic-vector #.(bt:enum-value 'movitz:movitz-vector-element-type :u8)) (scavenge-wide-typep x :basic-vector @@ -97,18 +100,29 @@ (assert (evenp scan) () "Scanned #x~Z at odd address #x~X." x scan) (let ((len (memref scan 0 1 :lisp))) - ;; (warn "scavenge at #x~X u8 vector len ~D." scan len) + (check-type len positive-fixnum) + (setf *scan-last* (%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 #x~Z at odd address #x~X." x scan) (let ((len (memref scan 0 1 :lisp))) + (check-type len positive-fixnum) + (setf *scan-last* (%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) () "Scanned #x~Z at odd address #x~X." x scan) (let ((len (memref scan 0 1 :lisp))) + (check-type len positive-fixnum) + (setf *scan-last* (%word-offset scan #.(movitz:tag :other))) (incf scan (1+ (logand (1+ len) -2))))) + ((and (scavenge-typep x :basic-vector) + (not (scavenge-wide-typep x :basic-vector + #.(bt:enum-value 'movitz:movitz-vector-element-type :any-t)))) + (error "Scanned unknown basic-vector #x~Z at address #x~X." x scan)) + ((scavenge-typep x :old-vector) + (error "Scanned old-vector #x~Z at address #x~X." x scan)) ((eq x (fixnum-word 3)) (incf scan) (incf scan (memref scan 0 0 :lisp)))