[rucksack-cvs] CVS rucksack

[alemmens]

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

Modified Files:
	cache.lisp garbage-collector.lisp heap.lisp rucksack.lisp 
Log Message:
Some more work towards getting a working GC.  Also removed some dead code.


--- /project/rucksack/cvsroot/rucksack/cache.lisp	2006/05/20 20:25:32	1.4
+++ /project/rucksack/cvsroot/rucksack/cache.lisp	2006/05/20 21:16:58	1.5
@@ -1,4 +1,4 @@
-;; $Id: cache.lisp,v 1.4 2006/05/20 20:25:32 alemmens Exp $
+;; $Id: cache.lisp,v 1.5 2006/05/20 21:16:58 alemmens Exp $
 
 (in-package :rucksack)
 
@@ -74,6 +74,8 @@
   ;; keep track of different class versions for objects in the heap.
   ((heap :initarg :heap :reader heap)
    (schema-table :initarg :schema-table :reader schema-table)
+   (rucksack :initarg :rucksack :reader rucksack
+             :documentation "Back pointer to the rucksack.")
    ;; Clean objects
    (objects :initarg :objects
             :reader objects
@@ -103,12 +105,7 @@
                  :documentation "A number between 0 and 1.  When the
 cache is full, i.e. when there are at least SIZE (non-dirty) objects
 in the queue, it will be shrunk by removing (1 - SHRINK-RATIO) * SIZE
-objects.")
-   ;;
-   (currently-saved-object :initform nil
-                           :accessor currently-saved-object
-                           :documentation "The object that's currently
-being saved.  This is used by slot-value-using-class & friends.")))
+objects.")))
 
 
 (defmethod print-object ((cache standard-cache) stream)
@@ -164,6 +161,7 @@
                             :class heap-class
                             :if-exists if-exists
                             :if-does-not-exist if-does-not-exist
+                            :rucksack (rucksack cache)
                             :options (list* :object-table object-table
                                             heap-options))
             schema-table (open-schema-table (merge-pathnames "schemas" directory)
@@ -438,14 +436,6 @@
                   (setq younger block
                         block older)))))))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defmacro saving-object ((cache object) &body body)
-  ;; This is used by slot-value-using-class & friends to determine
-  ;; if it should try to dereference proxies.
-  (let ((cache-var (gensym "CACHE")))
-    `(let ((,cache-var ,cache))
-       (setf (currently-saved-object ,cache-var) ,object)
-       (unwind-protect (progn , at body)
-         (setf (currently-saved-object ,cache-var) nil)))))
+
 
--- /project/rucksack/cvsroot/rucksack/garbage-collector.lisp	2006/05/20 15:35:37	1.6
+++ /project/rucksack/cvsroot/rucksack/garbage-collector.lisp	2006/05/20 21:16:58	1.7
@@ -1,4 +1,4 @@
-;; $Id: garbage-collector.lisp,v 1.6 2006/05/20 15:35:37 alemmens Exp $
+;; $Id: garbage-collector.lisp,v 1.7 2006/05/20 21:16:58 alemmens Exp $
 
 (in-package :rucksack)
 
@@ -32,6 +32,7 @@
   ((object-table :initarg :object-table :reader object-table)
    (buffer :initform (make-instance 'serialization-buffer)
            :reader serialization-buffer)
+   (rucksack :initarg :rucksack :reader rucksack)
    ;; Some state used for incremental garbage collection.
    (roots :initarg :roots :initform '() :accessor roots
           :documentation "A list of object-ids of roots that must be marked.")
@@ -107,8 +108,10 @@
            :live-object)))
   ;; In the scanning phase, the object id must be added to the root set to
   ;; guarantee that it will be marked and scanned.
+  ;; DO: This is too simple, because now the object will stay in the root
+  ;; set forever.  We need a separate 
   (when (eql (state heap) :scanning)
-    (add-rucksack-root-id object-id (roots heap))))
+    (push object-id (roots heap))))
 
 ;;
 ;; Hooking into free list methods
@@ -212,7 +215,8 @@
               (setf (nr-object-bytes-marked heap) 0
                     (nr-heap-bytes-scanned heap) 0
                     (nr-heap-bytes-sweeped heap) 0
-                    (nr-object-bytes-sweeped heap) 0)
+                    (nr-object-bytes-sweeped heap) 0
+                    (roots heap) (copy-list (slot-value (rucksack heap) 'roots)))
               (setf (state heap) :marking-object-table))
              (:marking-object-table
               (decf amount (mark-some-objects-in-table heap amount)))
--- /project/rucksack/cvsroot/rucksack/heap.lisp	2006/05/18 12:46:57	1.3
+++ /project/rucksack/cvsroot/rucksack/heap.lisp	2006/05/20 21:16:58	1.4
@@ -1,4 +1,4 @@
-;; $Id: heap.lisp,v 1.3 2006/05/18 12:46:57 alemmens Exp $
+;; $Id: heap.lisp,v 1.4 2006/05/20 21:16:58 alemmens Exp $
 
 (in-package :rucksack)
 
@@ -63,7 +63,7 @@
 
 
 (defun open-heap (pathname
-                  &key (class 'heap) (options '())
+                  &key (class 'heap) rucksack (options '())
                   (if-exists :overwrite) (if-does-not-exist :create))
   (let ((stream (open pathname
                       :element-type '(unsigned-byte 8)
@@ -73,6 +73,7 @@
     (apply #'make-instance
            class
            :stream stream
+           :rucksack rucksack
            options)))
 
 
--- /project/rucksack/cvsroot/rucksack/rucksack.lisp	2006/05/20 15:35:37	1.4
+++ /project/rucksack/cvsroot/rucksack/rucksack.lisp	2006/05/20 21:16:58	1.5
@@ -1,4 +1,4 @@
-;; $Id: rucksack.lisp,v 1.4 2006/05/20 15:35:37 alemmens Exp $
+;; $Id: rucksack.lisp,v 1.5 2006/05/20 21:16:58 alemmens Exp $
 
 (in-package :rucksack)
 
@@ -255,6 +255,7 @@
   (setf (slot-value rucksack 'cache)
         (apply #'open-cache (rucksack-directory rucksack)
                :class cache-class
+               :rucksack rucksack
                cache-args))
   (load-roots rucksack))