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

[Frode Vatvedt Fjeld]

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

Modified Files:
	scavenge.lisp 
Log Message:
Rearranged vector objects a bit. Changed map-heap-words
accordingly. Also fixed some serious bugs in map-heap-words.

Date: Fri Jun 11 16:26:14 2004
Author: ffjeld

Index: movitz/losp/muerte/scavenge.lisp
diff -u movitz/losp/muerte/scavenge.lisp:1.9 movitz/losp/muerte/scavenge.lisp:1.10
--- movitz/losp/muerte/scavenge.lisp:1.9	Thu Jun 10 12:29:45 2004
+++ movitz/losp/muerte/scavenge.lisp	Fri Jun 11 16:26:14 2004
@@ -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.9 2004/06/10 19:29:45 ffjeld Exp $
+;;;; $Id: scavenge.lisp,v 1.10 2004/06/11 23:26:14 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -42,7 +42,13 @@
 				(movitz:tag primary))))
 		 `(with-inline-assembly (:returns :boolean-zf=1)
 		    (:compile-form (:result-mode :eax) ,x)
-		    (:cmpw ,code :ax)))))
+		    (:cmpw ,code :ax))))
+	     (word-upper16 (x)
+	       "Consider x as a 32-bit integer, and return the upper 16 bits (as a fixnum)."
+	       `(with-inline-assembly (:returns :eax)
+		  (:compile-form (:result-mode :eax) ,x)
+		  (:andl #xffff0000 :eax)
+		  (:shrl ,(- 16 movitz:+movitz-fixnum-shift+) :eax))))
     (do ((scan start-location (1+ scan)))
 	((>= scan end-location))
       (let (;; (*i* i)
@@ -53,11 +59,11 @@
 	 ((scavenge-typep x :illegal)
 	  (error "Illegal word ~Z at ~S." x scan))
 	 ((scavenge-typep x :bignum)
+	  (assert (evenp scan))
 	  ;; Just skip the bigits
-	  (let* ((bigits (memref scan 2 0 :unsigned-byte16))
-		 (size (+ 2 (logand bigits -2))))
-	    (assert (and (plusp bigits) (evenp size)))
-	    (incf scan size)))
+	  (let* ((bigits (word-upper16 x))
+		 (delta (1+ (logand bigits -2))))
+	    (incf scan delta)))
 	 ((scavenge-typep x :funobj)
 	  ;; Process code-vector pointer specially..
 	  (let* ((funobj (%word-offset scan #.(movitz:tag :other)))
@@ -79,14 +85,14 @@
 				   #.(bt:enum-value 'movitz:movitz-vector-element-type :u8))
 	      (scavenge-wide-typep x :vector
 				   #.(bt:enum-value 'movitz:movitz-vector-element-type :character)))
-	  (let ((len (memref scan 2 0 :unsigned-byte16)))
+	  (let ((len (word-upper16 x)))
 	    (incf scan (1+ (* 2 (truncate (+ 7 len) 8))))))
 	 ((scavenge-wide-typep x :vector #.(bt:enum-value 'movitz:movitz-vector-element-type :u16))
-	  (let ((len (memref scan 2 0 :unsigned-byte16)))
+	  (let ((len (word-upper16 x)))
 	    (incf scan (1+ (* 2 (truncate (+ 3 len) 4))))))
 	 ((scavenge-wide-typep x :vector #.(bt:enum-value 'movitz:movitz-vector-element-type :u32))
-	  (let ((len (memref scan 2 0 :unsigned-byte16)))
-	    (incf scan (1+ (* 2 (truncate (+ 1 len) 2))))))
+	  (let ((len (word-upper16 x)))
+	    (incf scan (1+ (logand (1+ len) -2)))))
 	 ((eq x (fixnum-word 3))
 	  (incf scan)
 	  (incf scan (memref scan 0 0 :lisp)))