[rucksack-cvs] CVS rucksack

[alemmens]

Update of /project/rucksack/cvsroot/rucksack
In directory clnet:/tmp/cvs-serv3026/rucksack

Modified Files:
	garbage-collector.lisp heap.lisp rucksack.lisp 
Log Message:
Some more garbage collector fixes.


--- /project/rucksack/cvsroot/rucksack/garbage-collector.lisp	2006/05/20 21:19:56	1.8
+++ /project/rucksack/cvsroot/rucksack/garbage-collector.lisp	2006/05/21 21:00:03	1.9
@@ -1,4 +1,4 @@
-;; $Id: garbage-collector.lisp,v 1.8 2006/05/20 21:19:56 alemmens Exp $
+;; $Id: garbage-collector.lisp,v 1.9 2006/05/21 21:00:03 alemmens Exp $
 
 (in-package :rucksack)
 
@@ -194,10 +194,9 @@
 ;; Collect some garbage
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defmethod collect-garbage ((heap mark-and-sweep-heap) roots)
+(defmethod collect-garbage ((heap mark-and-sweep-heap))
   ;; A simple test of COLLECT-SOME-GARBAGE: keep collecting 1024 bytes of
   ;; garbage until the garbage collector is ready.
-  (setf (roots heap) (mapcar #'object-id roots))
   (setf (state heap) :starting)
   (loop until (eql (state heap) :ready)
         do (collect-some-garbage heap 1024)))
@@ -214,7 +213,9 @@
                     (nr-heap-bytes-scanned heap) 0
                     (nr-heap-bytes-sweeped heap) 0
                     (nr-object-bytes-sweeped heap) 0
-                    (roots heap) (copy-list (slot-value (rucksack heap) 'roots)))
+                    ;; We don't need to copy the roots, because we're not
+                    ;; going to modify the list (just push and pop).
+                    (roots heap) (slot-value (rucksack heap) 'roots))
               (setf (state heap) :marking-object-table))
              (:marking-object-table
               (decf amount (mark-some-objects-in-table heap amount)))
@@ -281,16 +282,21 @@
 
 (defmethod mark-root ((heap mark-and-sweep-heap) (object-id integer))
   ;; Returns the number of octets scanned.
-  (let* ((object-table (object-table heap))
-         (block (object-heap-position object-table object-id))
-         (buffer (load-block heap block :skip-header t)))
-    (setf (object-info object-table object-id) :live-object)
-    (scan-object object-id buffer heap)
-    ;; Keep track of statistics.
-    (let ((block-size (block-size block heap)))
-      (incf (nr-heap-bytes-scanned heap) block-size)
-      ;; Return the amount of work done.
-      block-size)))
+  (let ((object-table (object-table heap)))
+    (if (eql (object-info object-table object-id) :reserved)
+        ;; Reserved objects aren't written to the heap yet (they just
+        ;; have an object table entry), so we don't need to scan them
+        ;; for child objects
+        0
+      (let* ((block (object-heap-position object-table object-id))
+             (buffer (load-block heap block :skip-header t)))
+        (setf (object-info object-table object-id) :live-object)
+        (scan-object object-id buffer heap)
+        ;; Keep track of statistics.
+        (let ((block-size (block-size block heap)))
+          (incf (nr-heap-bytes-scanned heap) block-size)
+          ;; Return the amount of work done.
+          block-size)))))
 
 
 (defmethod load-block ((heap mark-and-sweep-heap) block
@@ -302,6 +308,7 @@
   (load-buffer buffer
                (heap-stream heap)
                (block-size block heap)
+               :eof-error-p nil
                :file-position (if skip-header
                                   (+ block (block-header-size heap))
                                 block)))
--- /project/rucksack/cvsroot/rucksack/heap.lisp	2006/05/20 21:16:58	1.4
+++ /project/rucksack/cvsroot/rucksack/heap.lisp	2006/05/21 21:00:03	1.5
@@ -1,4 +1,4 @@
-;; $Id: heap.lisp,v 1.4 2006/05/20 21:16:58 alemmens Exp $
+;; $Id: heap.lisp,v 1.5 2006/05/21 21:00:03 alemmens Exp $
 
 (in-package :rucksack)
 
@@ -503,7 +503,8 @@
       (file-position stream file-position))
     (write-sequence contents stream :end (buffer-count buffer))))
 
-(defmethod load-buffer ((buffer buffer) stream nr-octets &key file-position)
+(defmethod load-buffer ((buffer buffer) stream nr-octets
+                        &key file-position eof-error-p)
   (with-slots (contents)
       buffer
     ;; If the buffer isn't big enough, make a bigger buffer.
@@ -517,7 +518,8 @@
     (when file-position
       (file-position stream file-position))
     (setf (fill-pointer contents) nr-octets)
-    (when (< (read-sequence contents stream :end nr-octets) nr-octets)
+    (when (and (< (read-sequence contents stream :end nr-octets) nr-octets)
+               eof-error-p)
       (error "Unexpected end of file while loading a buffer of ~D octets."
              nr-octets)))
   buffer)
--- /project/rucksack/cvsroot/rucksack/rucksack.lisp	2006/05/20 21:16:58	1.5
+++ /project/rucksack/cvsroot/rucksack/rucksack.lisp	2006/05/21 21:00:03	1.6
@@ -1,4 +1,4 @@
-;; $Id: rucksack.lisp,v 1.5 2006/05/20 21:16:58 alemmens Exp $
+;; $Id: rucksack.lisp,v 1.6 2006/05/21 21:00:03 alemmens Exp $
 
 (in-package :rucksack)
 
@@ -280,6 +280,12 @@
   (push object-id (slot-value rucksack 'roots))
   (setf (roots-changed-p rucksack) t))
 
+(defmethod delete-rucksack-root (object (rucksack standard-rucksack))
+  (with-slots (roots)
+      rucksack
+    (setf roots (delete (object-id object) roots)
+          (roots-changed-p rucksack) t)))
+
 (defmethod map-rucksack-roots (function (rucksack standard-rucksack))
   (loop for root-id in (slot-value rucksack 'roots)
         do (funcall function
@@ -396,8 +402,7 @@
 
 
 (defun test-garbage-collector (rucksack)
-  (collect-garbage (heap (rucksack-cache rucksack))
-                   (rucksack-roots rucksack)))
+  (collect-garbage (heap (rucksack-cache rucksack))))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;