Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv20577
Modified Files: los0-gc.lisp Log Message: Some tweaking of GC messages etc.
Date: Wed Jul 14 17:27:13 2004 Author: ffjeld
Index: movitz/losp/los0-gc.lisp diff -u movitz/losp/los0-gc.lisp:1.25 movitz/losp/los0-gc.lisp:1.26 --- movitz/losp/los0-gc.lisp:1.25 Tue Jul 13 06:02:45 2004 +++ movitz/losp/los0-gc.lisp Wed Jul 14 17:27:13 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.25 2004/07/13 13:02:45 ffjeld Exp $ +;;;; $Id: los0-gc.lisp,v 1.26 2004/07/15 00:27:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -18,14 +18,14 @@
(in-package muerte.init)
-(defconstant +space-size+ #xfffd) - -(defun make-space (location) +(defvar *gc-quiet* nil) + +(defun make-space (location size) "Make a space vector at a fixed location." (assert (evenp location)) (macrolet ((x (index) `(memref location 0 ,index :unsigned-byte32))) - (setf (x 1) (* #.movitz:+movitz-fixnum-factor+ +space-size+) + (setf (x 1) (* #.movitz:+movitz-fixnum-factor+ size) (x 0) #.(cl:dpb (bt:enum-value 'movitz:movitz-vector-element-type :u32) (cl:byte 8 8) (bt:enum-value 'movitz:other-type-byte :basic-vector)))) @@ -247,12 +247,16 @@ (setf (exception-handler 113) (lambda (exception interrupt-frame) (declare (ignore exception interrupt-frame)) - (format t "~&;; GC.. ") + (unless *gc-quiet* + (format t "~&;; GC.. ")) (stop-and-copy) ;; This is a nice opportunity to poll the keyboard.. - (case (muerte.x86-pc.keyboard:poll-char) - ((#\esc) - (break "Los0 GC keyboard poll."))))) + (loop + (case (muerte.x86-pc.keyboard:poll-char) + ((#\esc) + (break "Los0 GC keyboard poll.")) + ((nil) + (return)))))) (let ((conser (symbol-value 'los0-fast-cons))) (check-type conser vector) (setf (%run-time-context-slot 'muerte::fast-cons) @@ -406,10 +410,11 @@ "Fail: i=~D, x: ~S/~Z, y: ~S/~Z, o: ~Z, n: ~Z" i x x y y oldspace newspace)))
;; GC completed, oldspace is evacuated. - (let ((old-size (truncate (- (space-fresh-pointer oldspace) 2) 2)) - (new-size (truncate (- (space-fresh-pointer newspace) 2) 2))) - (format t "Old space: ~/muerte:pprint-clumps/, new space: ~ + (unless *gc-quiet* + (let ((old-size (truncate (- (space-fresh-pointer oldspace) 2) 2)) + (new-size (truncate (- (space-fresh-pointer newspace) 2) 2))) + (format t "Old space: ~/muerte:pprint-clumps/, new space: ~ ~/muerte:pprint-clumps/, freed: ~/muerte:pprint-clumps/.~%" - old-size new-size (- old-size new-size))) + old-size new-size (- old-size new-size)))) (initialize-space oldspace)))) (values))