[rucksack-cvs] CVS rucksack

[alemmens]

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

Modified Files:
	garbage-collector.lisp test.lisp 
Log Message:
Added a WITH-TRANSACTION to TEST-LOAD and TEST-UPDATE.
Changed BLOCK-ALIVE-P: it's now too conservative instead of not
conservative enough.  This still needs fixing.


--- /project/rucksack/cvsroot/rucksack/garbage-collector.lisp	2006/05/18 22:21:51	1.4
+++ /project/rucksack/cvsroot/rucksack/garbage-collector.lisp	2006/05/20 10:33:49	1.5
@@ -1,4 +1,4 @@
-;; $Id: garbage-collector.lisp,v 1.4 2006/05/18 22:21:51 alemmens Exp $
+;; $Id: garbage-collector.lisp,v 1.5 2006/05/20 10:33:49 alemmens Exp $
 
 (in-package :rucksack)
 
@@ -355,11 +355,10 @@
     work-done))
 
 (defmethod block-alive-p ((object-table object-table) object-id block)
-  "Returns true iff the object is alive and the most recent object version
-is in the given block."
-  (and (eql (object-info object-table object-id) :live-object)
-       (= (object-heap-position object-table object-id)
-          block)))
+  "Returns true iff the object in the block is alive."
+  ;; DO: Some versions of this object may not be reachable anymore.
+  ;; Those should be considered dead.
+  (member (object-info object-table object-id) '(:reserved :live-object)))
 
 (defun read-block-start (heap position)
   ;; All blocks start the same way: 8 bytes for the block header
--- /project/rucksack/cvsroot/rucksack/test.lisp	2006/05/16 22:01:27	1.2
+++ /project/rucksack/cvsroot/rucksack/test.lisp	2006/05/20 10:33:50	1.3
@@ -1,4 +1,4 @@
-;; $Id: test.lisp,v 1.2 2006/05/16 22:01:27 alemmens Exp $
+;; $Id: test.lisp,v 1.3 2006/05/20 10:33:50 alemmens Exp $
 
 (in-package :test-rucksack)
 
@@ -87,22 +87,24 @@
 (defun test-update (&key (new-age 27) (directory *persons-directory*))
   "Test updating all persons by changing their age."
   (with-rucksack (rucksack directory)
-    (map-rucksack-roots (lambda (person)
-                          (setf (age person) new-age))
-                        rucksack)))
+    (with-transaction ()
+      (map-rucksack-roots (lambda (person)
+                            (setf (age person) new-age))
+                          rucksack))))
 
 (defun test-load (&key (directory *persons-directory*))
   "Test loading all persons by computing their average age."
   (with-rucksack (rucksack directory)
-    (let ((nr-persons 0)
-          (total-age 0))
-      (map-rucksack-roots (lambda (person)
-                            (incf nr-persons)
-                            (incf total-age (age person)))
-                          rucksack)
-      ;; Return the average age as a float.
-      ;; (An average age of 1200/75 doesn't seem right.)
-      (coerce (/ total-age nr-persons) 'float))))
+    (with-transaction ()
+      (let ((nr-persons 0)
+            (total-age 0))
+        (map-rucksack-roots (lambda (person)
+                              (incf nr-persons)
+                              (incf total-age (age person)))
+                            rucksack)
+        ;; Return the average age as a float.
+        ;; (An average age of 1200/75 doesn't seem right.)
+        (coerce (/ total-age nr-persons) 'float)))))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;