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@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)))