[rucksack-cvs] CVS rucksack
alemmens
alemmens at common-lisp.net
Sun Feb 3 12:32:21 UTC 2008
Update of /project/rucksack/cvsroot/rucksack
In directory clnet:/tmp/cvs-serv14177
Modified Files:
cache.lisp done.txt garbage-collector.lisp object-table.lisp
objects.lisp rucksack.asd
Log Message:
Version 0.1.15.
Fixed a garbage collector bug reported by Sean Ross. When the garbage
collector deletes object ids from the object table (because the
objects are dead and we may want to reuse their ids later for other
objects), it should also remove that object from the cache. If it
doesn't, there's a possibility that the object id will be reused later
for a new object and the cache wil still refer to the old in-memory
object.
--- /project/rucksack/cvsroot/rucksack/cache.lisp 2008/01/31 20:26:08 1.13
+++ /project/rucksack/cvsroot/rucksack/cache.lisp 2008/02/03 12:32:15 1.14
@@ -1,4 +1,4 @@
-;; $Id: cache.lisp,v 1.13 2008/01/31 20:26:08 alemmens Exp $
+;; $Id: cache.lisp,v 1.14 2008/02/03 12:32:15 alemmens Exp $
(in-package :rucksack)
@@ -36,6 +36,11 @@
(:documentation "Retrieves the object with the given id from the
cache and returns that object."))
+(defgeneric cache-delete-object (object-id cache)
+ (:documentation "Removes an object-id from the cache and from
+the object table, so the object-id can be reused for another object
+later."))
+
(defgeneric cache-commit (cache)
(:documentation "Makes sure that all changes to the cache are
written to disk."))
@@ -84,14 +89,15 @@
;; Clean objects
(objects :initarg :objects
:reader objects
- :documentation "A hash-table (from id to object)
+ :documentation "A hash-table \(from id to object)
containing the youngest committed version of all objects that are
-currently kept in memory but are not dirty. ('The youngest version'
+currently kept in memory but are not dirty. \('The youngest version'
means the version belonging to the youngest committed transaction.)")
(queue :initform (make-instance 'queue) :reader queue
:documentation "A queue of the ids of all non-dirty objects
that are currently in the cache memory. Whenever an object is
-retrieved (i.e. read), it's added to the queue.")
+retrieved (i.e. read), it's added to the queue. If an object-id is
+in this queue, it is not necessarily in the OBJECTS hash-table.")
(last-timestamp :initform (get-universal-time)
:accessor last-timestamp)
(transaction-id-helper :initform -1
@@ -233,7 +239,7 @@
(- (cache-size cache) (cache-count cache)))
;;
-;; Create/get/touch
+;; Create/get/touch/delete
;;
(defmethod cache-create-object (object (cache standard-cache))
@@ -338,6 +344,9 @@
result))))
+(defmethod cache-delete-object (object-id (cache standard-cache))
+ (remhash object-id (objects cache)))
+
;;
;; Queue operations
--- /project/rucksack/cvsroot/rucksack/done.txt 2008/01/31 20:26:08 1.15
+++ /project/rucksack/cvsroot/rucksack/done.txt 2008/02/03 12:32:16 1.16
@@ -1,89 +1,98 @@
+* 2008-02-02 - version 0.1.15
+
+Fixed a garbage collector bug reported by Sean Ross. When the garbage
+collector deletes object ids from the object table (because the
+objects are dead and we may want to reuse their ids later for other
+objects), it should also remove that object from the cache. If it
+doesn't, there's a possibility that the object id will be reused later
+for a new object and the cache wil still refer to the old in-memory
+object.
+
+
* 2008-01-31 - version 0.1.14
-- Class and slot indexes now map directly to objects instead of
- object-ids. This fixes a bug where the garbage collector forgot
- to add all indexed objects to the root set. (Suggested by Sean
- Ross.)
+Class and slot indexes now map directly to objects instead of
+object-ids. This fixes a bug where the garbage collector forgot to
+add all indexed objects to the root set. (Suggested by Sean Ross.)
-- Increase default cache size to 100,000 objects.
+Increase default cache size to 100,000 objects.
* 2008-01-23 - version 0.1.13
-- Add Brad Beveridge's basic unit test suite (modified to work
- with lisp-unit instead of 5am).
+Add Brad Beveridge's basic unit test suite (modified to work with
+lisp-unit instead of 5am).
-- Add Chris Riesbeck's lisp-unit library to help with creating
- unit test suites.
+Add Chris Riesbeck's lisp-unit library to help with creating
+unit test suites.
-- Move all tests to their own directory.
+Move all tests to their own directory.
-- Add P-NREVERSE and P-POSITION for persistent lists.
+Add P-NREVERSE and P-POSITION for persistent lists.
-- Fix bugs in P-REPLACE and P-MAPCAR.
+Fix bugs in P-REPLACE and P-MAPCAR.
* 2008-01-22 - version 0.1.12
-- Use (ARRAY-DIMENSION buffer 0) instead of LENGTH in
- LOAD-BUFFER, because we want to ignore the fill pointer
- here. Thanks to Sean Ross.
+Use (ARRAY-DIMENSION buffer 0) instead of LENGTH in LOAD-BUFFER,
+because we want to ignore the fill pointer here. Thanks to Sean Ross.
* 2008-01-22 - version 0.1.11
-- Fix bug caused by LEAF-DELETE-KEY. Reported and fixed by
- Brad Beveridge.
+Fix bug caused by LEAF-DELETE-KEY. Reported and fixed by Brad
+Beveridge.
-- Fix some typos (:VALUE should be :VALUE=) in index.lisp.
+Fix some typos (:VALUE should be :VALUE=) in index.lisp.
* 2008-01-16 - version 0.1.10
-- When deleting a key from a btree, use the BTREE-KEY= function (not
- P-EQL) to determine the position of the key. Reported and fixed
- by Leonid Novikov.
+When deleting a key from a btree, use the BTREE-KEY= function (not
+P-EQL) to determine the position of the key. Reported and fixed
+by Leonid Novikov.
* 2007-08-12 - version 0.1.9
-- Fix btree bug during btree-delete: if we're deleting the biggest key
- from a leaf, we should update the parents so they'll use the key that
- has now become the biggest. (Henrik Hjelte.)
-
-- Try to signal an error when an incompatible value is given to
- indexed slots, e.g. trying to put a string into a slot with a
- :symbol-index. (Takehiko Abe)
+Fix btree bug during btree-delete: if we're deleting the biggest key
+from a leaf, we should update the parents so they'll use the key that
+has now become the biggest. (Henrik Hjelte.)
+
+Try to signal an error when an incompatible value is given to indexed
+slots, e.g. trying to put a string into a slot with a :symbol-index.
+(Takehiko Abe)
-- Signal an error during when putting duplicate values into a slot for
- which duplicate values are not allowed. (Takehiko Abe)
+Signal an error during when putting duplicate values into a slot for
+which duplicate values are not allowed. (Takehiko Abe)
-- Use BTREE-VALUE-TYPE, not BTREE-KEY-TYPE, when type checking a value
- during BTREE-INSERT. (Takehiko Abe)
+Use BTREE-VALUE-TYPE, not BTREE-KEY-TYPE, when type checking a value
+during BTREE-INSERT. (Takehiko Abe)
-- Wrap COMPILE-FILE calls in a WITH-COMPILATION-UNIT to prevent
- superfluous warnings about undefined functions.
+Wrap COMPILE-FILE calls in a WITH-COMPILATION-UNIT to prevent
+superfluous warnings about undefined functions.
* 2007-03-13 - version 0.1.8
-- Fix a bug in LEAF-DELETE-KEY (thanks to Henrik Hjelte).
+Fix a bug in LEAF-DELETE-KEY (thanks to Henrik Hjelte).
-- Add RUCKSACK-DELETE-OBJECT, RUCKSACK-DELETE-OBJECTS and
- RUCKSACK-ROOT-P (suggested by Henrik Hjelte). I haven't
- tested these functions yet.
+Add RUCKSACK-DELETE-OBJECT, RUCKSACK-DELETE-OBJECTS and
+RUCKSACK-ROOT-P (suggested by Henrik Hjelte). I haven't tested these
+functions yet.
* 2007-01-22 - version 0.1.7
-- Get rid of two SBCL compiler warnings. (Reported by Cyrus Harmon.)
+Get rid of two SBCL compiler warnings. (Reported by Cyrus Harmon.)
* 2007-01-21 - version 0.1.6
-- Added serializing/deserializing of structures. Only works on SBCL.
- (Thanks to Levente Mészáros.)
+Added serializing/deserializing of structures. Only works on SBCL.
+(Thanks to Levente Mészáros.)
* 2006-11-30
@@ -128,9 +137,6 @@
* 2006-08-31
-- Get rid of the Lispworks-specific PROCESS-A-CLASS-OPTION stuff and handle
- the :INDEX class option in a way that's compatible with AMOP.
-
- Write test cases for schema updates and user defined methods for
UPDATE-PERSISTENT-INSTANCE-FOR-REDEFINED-CLASS.
--- /project/rucksack/cvsroot/rucksack/garbage-collector.lisp 2007/01/20 18:17:55 1.21
+++ /project/rucksack/cvsroot/rucksack/garbage-collector.lisp 2008/02/03 12:32:16 1.22
@@ -1,4 +1,4 @@
-;; $Id: garbage-collector.lisp,v 1.21 2007/01/20 18:17:55 alemmens Exp $
+;; $Id: garbage-collector.lisp,v 1.22 2008/02/03 12:32:16 alemmens Exp $
(in-package :rucksack)
@@ -104,8 +104,8 @@
rounded up.)")))
-(defparameter *initial-heap-size* (* 1024 1024)
- "The default initial heap size is 1 MB. ")
+(defparameter *initial-heap-size* (* 10 1024 1024)
+ "The default initial heap size is 10 MB. ")
(defmethod initialize-instance :after ((heap mark-and-sweep-heap)
&key size &allow-other-keys)
@@ -367,17 +367,16 @@
(let* ((free-p (and (integerp block-start) (minusp block-start)))
(block-size (if free-p (- block-start) block-header)))
;; Reclaim dead blocks.
- (when (and (not free-p) ; only non-free blocks
- (not (block-alive-p object-table
- ;; read object ID
- (let ((heap-stream (heap-stream heap)))
- (deserialize heap-stream)
- (deserialize heap-stream))
- block)))
- ;; The block is dead (either because the object is dead
- ;; or because the block contains an old version): return
- ;; the block to its free list.
- (deallocate-block block heap))
+ (when (not free-p) ; only non-free blocks
+ (let* ((heap-stream (heap-stream heap))
+ (object-id (progn
+ (deserialize heap-stream)
+ (deserialize heap-stream))))
+ (when (not (block-alive-p object-table object-id block))
+ ;; The block is dead (either because the object is dead
+ ;; or because the block contains an old version): return
+ ;; the block to its free list.
+ (deallocate-block block heap))))
;;
(incf work-done block-size)
;; Move to next block (if there is one).
@@ -435,8 +434,10 @@
do (progn
;; Hook dead object blocks back into the free list.
(when (eql (object-info object-table object-id) :dead-object)
- (let ((block (object-id-to-block object-id object-table)))
- (deallocate-block block object-table)))
+ (delete-object-id object-table object-id)
+ ;; Don't forget to remove the id->object mapping from
+ ;; the cache! (This was a difficult bug to find.)
+ (cache-delete-object object-id (rucksack-cache (rucksack heap))))
(incf (nr-object-bytes-sweeped heap) object-block-size)))
;;
(when (>= (nr-object-bytes-sweeped heap) (nr-object-bytes heap))
--- /project/rucksack/cvsroot/rucksack/object-table.lisp 2007/01/20 18:17:55 1.4
+++ /project/rucksack/cvsroot/rucksack/object-table.lisp 2008/02/03 12:32:16 1.5
@@ -1,4 +1,4 @@
-;; $Id: object-table.lisp,v 1.4 2007/01/20 18:17:55 alemmens Exp $
+;; $Id: object-table.lisp,v 1.5 2008/02/03 12:32:16 alemmens Exp $
(in-package :rucksack)
@@ -58,7 +58,7 @@
(let* ((block (allocate-block object-table :expand t))
(id (block-to-object-id block object-table)))
(setf (object-info object-table id) :reserved)
- (block-to-object-id block object-table)))
+ id))
(defun delete-object-id (object-table object-id)
"Returns object-id's cell to the free-list."
--- /project/rucksack/cvsroot/rucksack/objects.lisp 2008/01/23 15:43:42 1.19
+++ /project/rucksack/cvsroot/rucksack/objects.lisp 2008/02/03 12:32:16 1.20
@@ -1,4 +1,4 @@
-;; $Id: objects.lisp,v 1.19 2008/01/23 15:43:42 alemmens Exp $
+;; $Id: objects.lisp,v 1.20 2008/02/03 12:32:16 alemmens Exp $
(in-package :rucksack)
@@ -96,9 +96,10 @@
(defmethod print-object ((object persistent-data) stream)
(print-unreadable-object (object stream :type t :identity nil)
- (format stream "#~D~@[ in ~A~]"
+ (format stream "#~D~@[ with transaction id ~D~]"
(slot-value object 'object-id)
- (cache object))))
+ (and (slot-boundp object 'transaction-id)
+ (slot-value object 'transaction-id)))))
(defmethod compute-persistent-slot-names ((class standard-class)
(object persistent-data))
@@ -490,9 +491,10 @@
(defmethod print-object ((object persistent-object) stream)
(print-unreadable-object (object stream :type t :identity nil)
- (format stream "#~D~@[ in ~A~]"
+ (format stream "#~D~@[ with transaction id ~D~]"
(slot-value object 'object-id)
- (cache object))))
+ (transaction-id object))))
+
;; It's a bit stupid that we have to write the same code for three
;; P-EQL methods, but we don't seem to have much choice.
--- /project/rucksack/cvsroot/rucksack/rucksack.asd 2008/01/31 20:26:08 1.16
+++ /project/rucksack/cvsroot/rucksack/rucksack.asd 2008/02/03 12:32:16 1.17
@@ -1,9 +1,9 @@
-;;; $Id: rucksack.asd,v 1.16 2008/01/31 20:26:08 alemmens Exp $
+;;; $Id: rucksack.asd,v 1.17 2008/02/03 12:32:16 alemmens Exp $
(in-package :cl-user)
(asdf:defsystem :rucksack
- :version "0.1.14"
+ :version "0.1.15"
:serial t
:components ((:file "queue")
(:file "package")
More information about the rucksack-cvs
mailing list