[movitz-cvs] CVS update: movitz/losp/muerte/scavenge.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Mon Oct 11 13:53:26 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv30831
Modified Files:
scavenge.lisp
Log Message:
Changed the signature of memref and (setf memref) to use keywords also
for the index and type arguments.
Date: Mon Oct 11 15:53:25 2004
Author: ffjeld
Index: movitz/losp/muerte/scavenge.lisp
diff -u movitz/losp/muerte/scavenge.lisp:1.32 movitz/losp/muerte/scavenge.lisp:1.33
--- movitz/losp/muerte/scavenge.lisp:1.32 Tue Sep 21 15:56:32 2004
+++ movitz/losp/muerte/scavenge.lisp Mon Oct 11 15:53:25 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.32 2004/09/21 13:56:32 ffjeld Exp $
+;;;; $Id: scavenge.lisp,v 1.33 2004/10/11 13:53:25 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -49,7 +49,7 @@
(with-simple-restart (continue-map-heap-words
"Continue map-heap-words at location ~S." (1+ scan))
(let ((*scan* scan)
- (x (memref scan 0 0 :unsigned-byte16)))
+ (x (memref scan 0 :type :unsigned-byte16)))
(declare (special *scan*))
(when verbose
(format *terminal-io* " [at ~S: ~S]" scan x))
@@ -65,7 +65,7 @@
(assert (evenp scan) ()
"Scanned bignum-header ~S at odd location #x~X." x scan)
;; Just skip the bigits
- (let* ((bigits (memref scan 0 1 :unsigned-byte14))
+ (let* ((bigits (memref scan 0 :index 1 :type :unsigned-byte14))
(delta (logior bigits 1)))
(setf *scan-last* (%word-offset scan #.(movitz:tag :other)))
(incf scan delta)))
@@ -76,7 +76,7 @@
((scavenge-typep x :funobj)
(assert (evenp scan) ()
"Scanned funobj-header ~S at odd location #x~X."
- (memref scan 0 0 :unsigned-byte32) scan)
+ (memref scan 0 :type :unsigned-byte32) scan)
(setf *scan-last* (%word-offset scan #.(movitz:tag :other)))
;; Process code-vector pointers specially..
(let* ((funobj (%word-offset scan #.(movitz:tag :other)))
@@ -88,7 +88,7 @@
(check-type new-code-vector code-vector)
(unless (eq code-vector new-code-vector)
(error "Code-vector migration is not implemented.")
- (setf (memref scan 0 -1 :lisp) (%word-offset new-code-vector 2))
+ (setf (memref scan 0 :index -1) (%word-offset new-code-vector 2))
;; Do more stuff here to update code-vectors and jumpers
))
(incf scan (+ 7 num-jumpers)))) ; Don't scan the jumpers.
@@ -104,21 +104,21 @@
#.(bt:enum-value 'movitz:movitz-vector-element-type :code)))
(assert (evenp scan) ()
"Scanned u8-vector-header ~S at odd location #x~X." x scan)
- (let ((len (memref scan 0 1 :lisp)))
+ (let ((len (memref scan 0 :index 1 :type :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 u16-vector-header ~S at odd location #x~X." x scan)
- (let ((len (memref scan 0 1 :lisp)))
+ (let ((len (memref scan 0 :index 1)))
(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 u32-vector-header ~S at odd location #x~X." x scan)
- (let ((len (memref scan 0 1 :lisp)))
+ (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)))
@@ -133,17 +133,17 @@
((eq x 3)
(setf *scan-last* scan)
(incf scan)
- (let ((delta (memref scan 0 0 :lisp)))
+ (let ((delta (memref scan 0)))
(check-type delta positive-fixnum)
;; (warn "at ~S skipping ~S to ~S." scan delta (+ scan delta))
(incf scan delta)))
(t ;; (typep x 'pointer)
- (let* ((old (memref scan 0 0 :lisp))
+ (let* ((old (memref scan 0))
(new (funcall function old scan)))
(when verbose
(format *terminal-io* " [~Z => ~Z]" old new))
(unless (eq old new)
- (setf (memref scan 0 0 :lisp) new)))))))))
+ (setf (memref scan 0) new)))))))))
(values))
(defun map-stack-words (function stack start-frame)
@@ -229,14 +229,14 @@
(dit-frame-ref stack dit-frame :eip :location))
(cond
((let ((x0-tag (ldb (byte 3 0)
- (memref interrupted-esp 0 0 :unsigned-byte8))))
+ (memref interrupted-esp 0 :type :unsigned-byte8))))
(and (member x0-tag '(1 5 6 7))
(location-in-object-p casf-code-vector
- (memref interrupted-esp 0 0 :location))))
+ (memref interrupted-esp 0 :type :location))))
;; When code-vector migration is implemented...
(warn "Scanning at ~S X0 call ~S in ~S."
(dit-frame-ref stack dit-frame :eip :unsigned-byte32)
- (memref interrupted-esp 0 0 :unsigned-byte32)
+ (memref interrupted-esp 0 :type :unsigned-byte32)
(funobj-name casf-funobj))
#+ignore (map-heap-words function (+ interrupted-esp 1) frame)
(when (eq 0 (stack-frame-ref stack frame -1))
@@ -244,14 +244,14 @@
(setf next-frame frame
next-nether-frame (+ interrupted-esp 1 -2)))
((let ((x1-tag (ldb (byte 3 0)
- (memref interrupted-esp 4 0 :unsigned-byte8))))
+ (memref interrupted-esp 4 :type :unsigned-byte8))))
(and (member x1-tag '(1 5 6 7))
(location-in-object-p casf-code-vector
- (memref interrupted-esp 0 1 :location))))
+ (memref interrupted-esp 4 :type :location))))
;; When code-vector migration is implemented...
(warn "Scanning at ~S X1 call ~S in ~S."
(dit-frame-ref stack dit-frame :eip :unsigned-byte32)
- (memref interrupted-esp 0 1 :unsigned-byte32)
+ (memref interrupted-esp 4 :type :unsigned-byte32)
(funobj-name casf-funobj))
(when (eq 0 (stack-frame-ref stack frame -1))
(break "X1 call in DIT-frame."))
@@ -263,10 +263,10 @@
(setf next-frame frame
next-nether-frame (- interrupted-esp 2))
)))
- ((eq casf-frame (memref interrupted-esp 0 0 :location))
+ ((eq casf-frame (memref interrupted-esp 0 :type :location))
;; Situation ii. esp(0)=CASF, esp(1)=code-vector
(assert (location-in-object-p casf-code-vector
- (memref interrupted-esp 0 1 :location))
+ (memref interrupted-esp 4 :type :location))
() "Stack discipline situation ii. invariant broken. CASF=#x~X, ESP=~S, EBP=~S"
casf-frame interrupted-esp interrupted-ebp)
@@ -275,7 +275,7 @@
next-nether-frame (+ interrupted-esp 2 -2)))
(t ;; Situation iii. esp(0)=code-vector.
(assert (location-in-object-p casf-code-vector
- (memref interrupted-esp 0 0 :location))
+ (memref interrupted-esp 0 :type :location))
() "Stack discipline situation iii. invariant broken. CASF=#x~X"
casf-frame)
#+ignore (map-heap-words function (+ interrupted-esp 1) frame)
More information about the Movitz-cvs
mailing list