[movitz-cvs] CVS update: movitz/losp/muerte/scavenge.lisp - movitz-cvs@common-lisp.net - mailman3.common-lisp.net

13 Jul 2004

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv31488
Modified Files:
    scavenge.lisp 
Log Message:
Some debugging tweaks to map-heap-words.
Date: Mon Jul 12 19:37:36 2004
Author: ffjeld
Index: movitz/losp/muerte/scavenge.lisp
diff -u movitz/losp/muerte/scavenge.lisp:1.15 movitz/losp/muerte/scavenge.lisp:1.16

--- movitz/losp/muerte/scavenge.lisp:1.15	Mon Jul 12 04:09:34 2004
+++ movitz/losp/muerte/scavenge.lisp	Mon Jul 12 19:37:36 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.15 2004/07/12 11:09:34 ffjeld Exp $
+;;;; $Id: scavenge.lisp,v 1.16 2004/07/13 02:37:36 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
@@ -63,7 +63,7 @@
      (error "Illegal word ~Z at ~S." x scan))
     ((scavenge-typep x :bignum)
      (assert (evenp scan) ()
-	    "Scanned #x~Z at odd address #x~X." x scan)
+	    "Scanned ~Z at odd address #x~X." x scan)
      ;; Just skip the bigits
      (let* ((bigits (word-bigits x))
    	 (delta (1+ (logand bigits -2))))
@@ -71,9 +71,9 @@
        (incf scan delta)))
     ((scavenge-typep x :funobj)
      (assert (evenp scan) ()
-	    "Scanned #x~Z at odd address #x~X." x scan)
+	    "Scanned ~Z at odd address #x~X." x scan)
      (setf *scan-last* (%word-offset scan #.(movitz:tag :other)))
-	  ;; Process code-vector pointer specially..
+	  ;; Process code-vector pointers specially..
      (let* ((funobj (%word-offset scan #.(movitz:tag :other)))
    	 (code-vector (funobj-code-vector funobj))
    	 (num-jumpers (funobj-num-jumpers funobj)))
@@ -98,21 +98,21 @@
          (scavenge-wide-typep x :basic-vector
    			   #.(bt:enum-value 'movitz:movitz-vector-element-type :code)))
      (assert (evenp scan) ()
-	    "Scanned #x~Z at odd address #x~X." x scan)
+	    "Scanned ~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 (+ 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)
+	    "Scanned ~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)
+	    "Scanned ~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)))
@@ -125,7 +125,9 @@
      (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)))
+	  (let ((delta (memref scan 0 0 :lisp)))
+	    (check-type delta positive-fixnum)
+	    (incf scan delta)))
     ((typep x 'pointer)
      (let ((new (funcall function x scan)))
        (unless (eq new x)

    