[movitz-cvs] CVS update: movitz/losp/los0-gc.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Thu May 5 20:51:10 UTC 2005
Update of /project/movitz/cvsroot/movitz/losp
In directory common-lisp.net:/tmp/cvs-serv19805
Modified Files:
los0-gc.lisp
Log Message:
Changed order of arguments for %run-time-context-slot, new signature
is (context slot-name), where nil may be used as a designator for
(current-run-time-context).
Date: Thu May 5 22:51:10 2005
Author: ffjeld
Index: movitz/losp/los0-gc.lisp
diff -u movitz/losp/los0-gc.lisp:1.53 movitz/losp/los0-gc.lisp:1.54
--- movitz/losp/los0-gc.lisp:1.53 Thu May 5 21:35:18 2005
+++ movitz/losp/los0-gc.lisp Thu May 5 22:51:09 2005
@@ -10,7 +10,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef at acm.org>
;;;; Created at: Sat Feb 21 17:48:32 2004
;;;;
-;;;; $Id: los0-gc.lisp,v 1.53 2005/05/05 19:35:18 ffjeld Exp $
+;;;; $Id: los0-gc.lisp,v 1.54 2005/05/05 20:51:09 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -78,8 +78,8 @@
(warn "install..")
(install-los0-consing 4)
(warn "nursery: ~Z, other: ~Z"
- (%run-time-context-slot 'muerte::nursery-space)
- (space-other (%run-time-context-slot 'muerte::nursery-space)))
+ (%run-time-context-slot nil 'muerte::nursery-space)
+ (space-other (%run-time-context-slot nil 'muerte::nursery-space)))
(warn "first cons: ~Z" (funcall 'truncate #x100000000 3))
(warn "second cons: ~Z" (funcall 'truncate #x100000000 3))
(halt-cpu)
@@ -243,9 +243,9 @@
(let ((*standard-output* *terminal-io*))
(cond
(*gc-running*
- (let* ((full-space (%run-time-context-slot 'muerte::nursery-space))
+ (let* ((full-space (%run-time-context-slot nil 'muerte::nursery-space))
(hack-space (make-duo-space (duo-space-end-location full-space) 102400)))
- (setf (%run-time-context-slot 'muerte::nursery-space) hack-space)
+ (setf (%run-time-context-slot nil 'muerte::nursery-space) hack-space)
(break "Recursive GC triggered. Full-space: ~Z, hack-space: ~Z"
full-space hack-space)))
(t (let ((*gc-running* t))
@@ -268,16 +268,16 @@
(check-type code-vector code-vector)
(if (eq context (current-run-time-context))
;; The point of this is to not trigger CLOS bootstrapping.
- (setf (%run-time-context-slot ',slot) code-vector)
- (setf (%run-time-context-slot ',slot context) code-vector)))))
+ (setf (%run-time-context-slot nil ',slot) code-vector)
+ (setf (%run-time-context-slot context ',slot) code-vector)))))
(install-primitive los0-fast-cons muerte::fast-cons)
(install-primitive los0-box-u32-ecx muerte::box-u32-ecx)
(install-primitive los0-cons-pointer muerte::cons-pointer)
(install-primitive los0-cons-commit muerte::cons-commit))
(if (eq context (current-run-time-context))
- (setf (%run-time-context-slot 'muerte::nursery-space)
+ (setf (%run-time-context-slot nil 'muerte::nursery-space)
actual-duo-space)
- (setf (%run-time-context-slot 'muerte::nursery-space context)
+ (setf (%run-time-context-slot context 'muerte::nursery-space)
actual-duo-space))
;; Pretend that the heap stops here, so that we don't have to scan
;; the entire tail end of memory, which isn't going to be used.
@@ -294,13 +294,13 @@
(defun report-nursery (x location)
"Write a message if x is inside newspace."
- (when (object-in-space-p (%run-time-context-slot 'nursery-space) x)
+ (when (object-in-space-p (%run-time-context-slot nil 'nursery-space) x)
(format t "~&~Z: ~S: ~S from ~S" x (type-of x) x location))
x)
(defun report-inactive-space (x location)
"Check that x is not pointing into (what is presumably) oldspace."
- (when (object-in-space-p (space-other (%run-time-context-slot 'nursery-space)) x)
+ (when (object-in-space-p (space-other (%run-time-context-slot nil 'nursery-space)) x)
(break "~Z: ~S: ~S from ~S" x (type-of x) x location))
x)
@@ -318,9 +318,9 @@
#+ignore
(defun kill-the-newborns ()
- (let* ((oldspace (%run-time-context-slot 'nursery-space))
+ (let* ((oldspace (%run-time-context-slot nil 'nursery-space))
(newspace (space-other oldspace)))
- (setf (%run-time-context-slot 'nursery-space) newspace)
+ (setf (%run-time-context-slot nil 'nursery-space) newspace)
(flet ((zap-oldspace (x location)
(declare (ignore location))
(if (object-in-space-p oldspace x)
@@ -332,7 +332,7 @@
(values))))
-(defparameter *x* #1000(nil)) ; Have this in static space.
+(defparameter *x* #4000(nil)) ; Have this in static space.
;;;(defparameter *xx* #4000(nil)) ; Have this in static space.
(defparameter *code-vector-foo* 0)
@@ -344,13 +344,13 @@
(setf (fill-pointer *old-code-vectors*) 0)
(multiple-value-bind (newspace oldspace)
(without-interrupts
- (let* ((space0 (%run-time-context-slot 'nursery-space))
+ (let* ((space0 (%run-time-context-slot nil 'nursery-space))
(space1 (space-other space0)))
(check-type space0 (simple-array (unsigned-byte 32) 1))
(check-type space1 (simple-array (unsigned-byte 32) 1))
(assert (eq space0 (space-other space1)))
(assert (= 2 (space-fresh-pointer space1)))
- (setf (%run-time-context-slot 'nursery-space) space1)
+ (setf (%run-time-context-slot nil 'nursery-space) space1)
(values space1 space0)))
;; Evacuate-oldspace is to be mapped over every potential pointer.
(let ((*code-vector-foo* (incf *code-vector-foo* 2))
@@ -458,13 +458,13 @@
old old new new (objects-equalp old new) oldspace newspace i))))))
(map-header-vals (lambda (x y)
(declare (ignore y))
- (when (location-in-object-p (space-other (%run-time-context-slot 'nursery-space))
+ (when (location-in-object-p (space-other (%run-time-context-slot nil 'nursery-space))
(object-location x))
(break "Seeing old object in values-vector: ~Z" x))
x)
#x38 #xb8)
#+ignore
- (let* ((stack (%run-time-context-slot 'muerte::stack-vector))
+ (let* ((stack (%run-time-context-slot nil 'muerte::stack-vector))
(stack-start (- (length stack) (muerte::current-control-stack-depth))))
(do ((i 0 (+ i 3)))
((>= i (length a)))
@@ -538,7 +538,7 @@
(flet ((searcher (x ignore)
(declare (ignore ignore))
(when (and (typep x '(or muerte::tag1 muerte::tag6 muerte::tag7))
- (not (eq x (%run-time-context-slot 'muerte::nursery-space)))
+ (not (eq x (%run-time-context-slot nil 'muerte::nursery-space)))
(location-in-object-p x location)
(not (member x results)))
(push x results)
@@ -554,7 +554,7 @@
(invoke-restart 'muerte::continue-map-header-vals)))))
(dolist (range muerte::%memory-map-roots%)
(map-header-vals #'searcher (car range) (cdr range)))
- (let ((nursery (%run-time-context-slot 'muerte::nursery-space)))
+ (let ((nursery (%run-time-context-slot nil 'muerte::nursery-space)))
(map-header-vals #'searcher
(+ 4 (object-location nursery))
(+ 4 (object-location nursery) (space-fresh-pointer nursery))))
@@ -563,7 +563,7 @@
(defun report-lispval (lispval &optional breakp newspace)
(let* ((location (truncate lispval 4))
- (newspace (or newspace (%run-time-context-slot 'muerte::nursery-space)))
+ (newspace (or newspace (%run-time-context-slot nil 'muerte::nursery-space)))
(oldspace (space-other newspace)))
(cond
((location-in-object-p newspace location)
More information about the Movitz-cvs
mailing list