[rucksack-cvs] CVS rucksack
alemmens
alemmens at common-lisp.net
Wed May 24 20:45:09 UTC 2006
Update of /project/rucksack/cvsroot/rucksack
In directory clnet:/tmp/cvs-serv20084/rucksack
Modified Files:
garbage-collector.lisp heap.lisp internals.txt objects.lisp
Log Message:
Fixed enough garbage collector bugs to get the TEST-CREATE, TEST-LOAD
and TEST-UPDATE functions running.
--- /project/rucksack/cvsroot/rucksack/garbage-collector.lisp 2006/05/21 21:00:03 1.9
+++ /project/rucksack/cvsroot/rucksack/garbage-collector.lisp 2006/05/24 20:45:09 1.10
@@ -1,4 +1,4 @@
-;; $Id: garbage-collector.lisp,v 1.9 2006/05/21 21:00:03 alemmens Exp $
+;; $Id: garbage-collector.lisp,v 1.10 2006/05/24 20:45:09 alemmens Exp $
(in-package :rucksack)
@@ -87,7 +87,7 @@
(defmethod initialize-block (block block-size (heap mark-and-sweep-heap))
- ;; This is called by a free list heap while allocating a block.
+ ;; This is called by a free list heap while creating free blocks.
;; Write the block size (as a negative number) in the start of the
;; block (just behind the header) to indicate that this is a free
;; block. This is necessary for the sweep phase of a mark-and-sweep
@@ -115,25 +115,20 @@
;; Hooking into free list methods
;;
-(defmethod allocate-block :after ((heap mark-and-sweep-heap)
- &key size &allow-other-keys)
+(defmethod gc-work-for-size ((heap mark-and-sweep-heap) size)
;; The garbage collector needs to be ready when there's no more free space
;; left in the heap. So when SIZE octets are allocated, the garbage collector
- ;; needs to collect a proportional amount of octets:
+ ;; needs to collect a proportional amount of bytes:
;;
;; Size / Free = Work / WorkLeft
;;
;; or: Work = (Size / Free) * WorkLeft
;;
(let* ((free (free-space heap))
- (work-left (work-left heap))
- (work (if (>= size free)
- work-left
- ;; Use FLOOR, not CEILING so we don't do any work
- ;; when there's ridiculously little to do anyway.
- (* (floor size free) work-left))))
- (when (> work 0)
- (collect-some-garbage heap work))))
+ (work-left (work-left heap)))
+ (if (>= size free)
+ work-left
+ (floor (* size work-left) free))))
(defmethod free-space ((heap mark-and-sweep-heap))
@@ -201,6 +196,11 @@
(loop until (eql (state heap) :ready)
do (collect-some-garbage heap 1024)))
+(defmethod finish-garbage-collection ((heap mark-and-sweep-heap))
+ ;; Make sure that the garbage collector is in the :ready state.
+ (loop until (eql (state heap) :ready)
+ do (collect-some-garbage heap (* 512 1024))))
+
(defmethod collect-some-garbage ((heap mark-and-sweep-heap) amount)
;; Collect at least the specified amount of garbage
;; (i.e. mark or sweep at least the specified amount of octets).
@@ -251,7 +251,7 @@
(< work-done amount))
do (progn
(when (eql (object-info object-table object-id) :live-object)
- ;; Don't touch free blocks.
+ ;; Don't touch free or reserved blocks.
(setf (object-info object-table object-id) :dead-object))
(incf (nr-object-bytes-marked heap) object-block-size)
(incf work-done object-block-size)))
--- /project/rucksack/cvsroot/rucksack/heap.lisp 2006/05/21 21:00:03 1.5
+++ /project/rucksack/cvsroot/rucksack/heap.lisp 2006/05/24 20:45:09 1.6
@@ -1,4 +1,4 @@
-;; $Id: heap.lisp,v 1.5 2006/05/21 21:00:03 alemmens Exp $
+;; $Id: heap.lisp,v 1.6 2006/05/24 20:45:09 alemmens Exp $
(in-package :rucksack)
@@ -114,9 +114,10 @@
;;
(defmethod expand-heap ((heap heap) block-size)
- ;; Expands the heap and returns an uninitialized block of the
- ;; specified size. Signals a continuable error if this makes
- ;; the heap exceed its maximum size.
+ ;; Creates (and initializes) a block of the specified size by expanding
+ ;; the heap. The block is not hooked into the free list yet. Returns
+ ;; the new block (but signals a continuable error if expanding the heap
+ ;; would make it exceed its maximum size.
(let ((new-block (heap-end heap))
(max-size (max-heap-size heap)))
(when (and max-size (> (+ new-block block-size) max-size))
@@ -128,7 +129,8 @@
max-size)))
;;
(incf (heap-end heap) block-size)
- ;; Return the new block.
+ ;; Initialize and return the new block.
+ (initialize-block new-block block-size heap)
new-block))
--- /project/rucksack/cvsroot/rucksack/internals.txt 2006/05/20 15:36:18 1.1
+++ /project/rucksack/cvsroot/rucksack/internals.txt 2006/05/24 20:45:09 1.2
@@ -52,7 +52,11 @@
.. : the negative of the block size
... : free space
+[ALLOCATED BUT NOT YET OCCUPIED BLOCK]
+ 0- 8: block size
+ .. : ???
+
--- /project/rucksack/cvsroot/rucksack/objects.lisp 2006/05/20 15:07:28 1.3
+++ /project/rucksack/cvsroot/rucksack/objects.lisp 2006/05/24 20:45:09 1.4
@@ -1,4 +1,4 @@
-;; $Id: objects.lisp,v 1.3 2006/05/20 15:07:28 alemmens Exp $
+;; $Id: objects.lisp,v 1.4 2006/05/24 20:45:09 alemmens Exp $
(in-package :rucksack)
@@ -490,14 +490,17 @@
(serialize (slot-value object slot-name) buffer)
(serialize-marker +unbound-slot+ buffer))))
;; Allocate a heap block of the right size.
- (let ((block (allocate-block heap
- :size (+ (buffer-count buffer)
- (block-header-size heap)))))
- ;; And save the serialized buffer in the block.
+ (let* ((size (+ (buffer-count buffer)
+ (block-header-size heap)))
+ (block (allocate-block heap :size size)))
+ ;; Save the serialized buffer in the block.
(save-buffer buffer (heap-stream heap)
:file-position (+ block (block-header-size heap)))
;; Let the garbage collector do its thing after an object is
- ;; written to the heap.
+ ;; written to the heap. (Not earlier, otherwise the GC may
+ ;; see objects that are neither free nor completely saved and
+ ;; it doesn't know how to deal with those.)
+ (collect-some-garbage heap (gc-work-for-size heap size))
(handle-written-object object-id block heap)
;; Return the block.
block)))
More information about the rucksack-cvs
mailing list