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

Modified Files: los0-gc.lisp Log Message: *** empty log message *** Date: Thu Sep 16 10:55:00 2004 Author: ffjeld

Index: movitz/losp/los0-gc.lisp diff -u movitz/losp/los0-gc.lisp:1.36 movitz/losp/los0-gc.lisp:1.37 --- movitz/losp/los0-gc.lisp:1.36 Wed Sep 15 12:22:57 2004 +++ movitz/losp/los0-gc.lisp Thu Sep 16 10:55:00 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Sat Feb 21 17:48:32 2004 ;;;; -;;;; $Id: los0-gc.lisp,v 1.36 2004/09/15 10:22:57 ffjeld Exp $ +;;;; $Id: los0-gc.lisp,v 1.37 2004/09/16 08:55:00 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -205,8 +205,6 @@ (:jae '(:sub-program () (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) (:edi (:edi-offset atomically-status)))) - (:movl :edx (#x1000000)) - (:addl :eax (#x1000000)) (:int 113) ; This interrupt can be retried. (:jmp 'retry-cons))) (:movl ,(dpb movitz:+movitz-fixnum-factor+ @@ -320,9 +318,7 @@ (install-primitive los0-fast-cons muerte::fast-cons) (install-primitive los0-box-u32-ecx muerte::box-u32-ecx) (install-primitive los0-get-cons-pointer muerte::get-cons-pointer) - (install-primitive los0-cons-commit muerte::cons-commit) - #+ignore (install-primitive los0-malloc-pointer-words muerte::malloc-pointer-words) - #+ignore (install-primitive los0-malloc-non-pointer-words muerte::malloc-non-pointer-words)) + (install-primitive los0-cons-commit muerte::cons-commit)) (if (eq context (current-run-time-context)) (setf (%run-time-context-slot 'muerte::nursery-space) actual-duo-space) @@ -380,6 +376,8 @@

(defparameter *x* #4000()) ; Have this in static space. +(defparameter *xx* #4000()) ; Have this in static space. +

(defun stop-and-copy (&optional evacuator) (setf (fill-pointer *x*) 0) @@ -428,7 +426,6 @@ (assert (vector-push (%object-lispval forward-x) a)))) (setf (memref (object-location x) 0 0 :lisp) forward-x) forward-x)))))))) - (setf *gc-stack* (muerte::copy-current-control-stack)) ;; Scavenge roots (dolist (range muerte::%memory-map-roots%) (map-heap-words evacuator (car range) (cdr range))) @@ -479,7 +476,10 @@ ~/muerte:pprint-clumps/, freed: ~/muerte:pprint-clumps/.~%" old-size new-size (- old-size new-size)))) (initialize-space oldspace) - (fill oldspace #x13 :start 2))) + (fill oldspace #x13 :start 2) + (setf *gc-stack* (muerte::copy-current-control-stack)) + (setf (fill-pointer *xx*) (fill-pointer *x*)) + (replace *xx* *x*))) (values))