[rucksack-cvs] CVS rucksack
alemmens
alemmens at common-lisp.net
Wed May 27 14:26:25 UTC 2009
Update of /project/rucksack/cvsroot/rucksack
In directory cl-net:/tmp/cvs-serv29574
Modified Files:
cache.lisp rucksack.asd rucksack.lisp transactions.lisp
Log Message:
* 2009-05-27 - version 0.1.20
Fix a bug in the creation of transaction-ids (bug reported by Klaus Harbo).
--- /project/rucksack/cvsroot/rucksack/cache.lisp 2008/02/11 12:47:52 1.15
+++ /project/rucksack/cvsroot/rucksack/cache.lisp 2009/05/27 14:26:25 1.16
@@ -1,4 +1,4 @@
-;; $Id: cache.lisp,v 1.15 2008/02/11 12:47:52 alemmens Exp $
+;; $Id: cache.lisp,v 1.16 2009/05/27 14:26:25 alemmens Exp $
(in-package :rucksack)
@@ -67,9 +67,7 @@
cache."))
-(defgeneric make-transaction-id (cache)
- (:documentation "Returns a new transaction ID. The result is an
-integer greater than all previous IDs."))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -137,17 +135,7 @@
(pathname (heap-stream (heap cache)))
(cache-count cache))))
-
-(defmethod make-transaction-id ((cache standard-cache))
- ;; This would allow for up to 100 transactions per millisecond
- ;; The result is a bignum but it at least fits in 8 octets and
- ;; can thus be serialized with SERIALIZE-BYTE-64.
- (let ((timestamp (get-universal-time)))
- (when (> timestamp (last-timestamp cache))
- (setf (last-timestamp cache) timestamp
- (transaction-id-helper cache) -1))
- (+ (* timestamp 100000)
- (mod (incf (transaction-id-helper cache)) 1000000))))
+
;;
;; Open/close/initialize
--- /project/rucksack/cvsroot/rucksack/rucksack.asd 2008/03/02 22:29:05 1.20
+++ /project/rucksack/cvsroot/rucksack/rucksack.asd 2009/05/27 14:26:25 1.21
@@ -1,9 +1,9 @@
-;;; $Id: rucksack.asd,v 1.20 2008/03/02 22:29:05 alemmens Exp $
+;;; $Id: rucksack.asd,v 1.21 2009/05/27 14:26:25 alemmens Exp $
(in-package :cl-user)
(asdf:defsystem :rucksack
- :version "0.1.18"
+ :version "0.1.20"
:serial t
:components ((:file "queue")
(:file "package")
--- /project/rucksack/cvsroot/rucksack/rucksack.lisp 2008/03/31 18:51:50 1.26
+++ /project/rucksack/cvsroot/rucksack/rucksack.lisp 2009/05/27 14:26:25 1.27
@@ -1,4 +1,4 @@
-;; $Id: rucksack.lisp,v 1.26 2008/03/31 18:51:50 alemmens Exp $
+;; $Id: rucksack.lisp,v 1.27 2009/05/27 14:26:25 alemmens Exp $
(in-package :rucksack)
@@ -319,6 +319,9 @@
;; Normal exit from the above block -- we selected the RETRY restart.
))))
+
+
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Rucksacks
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -331,19 +334,25 @@
((cache :reader rucksack-cache)
(directory :initarg :directory :reader rucksack-directory)
(roots :initform '()
- :documentation
- "A list with the object ids of all root objects, i.e. the objects
-from which the garbage collector can reach all live objects.")
+ :documentation "A list with the object ids of all root
+objects, i.e. the objects from which the garbage collector can reach
+all live objects.")
(roots-changed-p :initform nil :accessor roots-changed-p)
+ (highest-transaction-id :initform 0
+ :accessor highest-transaction-id
+ :type integer
+ :documentation "The highest transaction ID
+in the entire rucksack. This is saved together with the roots.")
;; Indexes
- (class-index-table :documentation
- "The object id of a btree mapping class names to class indexes. Each
-class index contains the ids of all instances from a class; it maps
-object ids to objects.")
- (slot-index-tables :documentation
- "The object id of a btree mapping class names to slot index tables,
-where each slot index table is a btree mapping slot names to slot
-indexes. Each slot index maps slot values to objects.")))
+ (class-index-table
+ :documentation "The object id of a btree mapping class names to
+class indexes. Each class index contains the ids of all instances
+from a class; it maps object ids to objects.")
+ (slot-index-tables
+ :documentation "The object id of a btree mapping class names to
+slot index tables, where each slot index table is a btree mapping slot
+names to slot indexes. Each slot index maps slot values to
+objects.")))
(defmethod print-object ((rucksack rucksack) stream)
(print-unreadable-object (rucksack stream :type t :identity t)
@@ -416,19 +425,25 @@
(defun load-roots (rucksack)
- ;; Read roots (i.e. object ids) from the roots file (if there is one).
- ;; Also load the (object ids of the) class and slot index tables.
+ ;; Read roots (i.e. object ids) from the roots file (if there is
+ ;; one). Also load the highest transaction id and the (object ids
+ ;; of the) class and slot index tables.
(let ((roots-file (rucksack-roots-pathname rucksack)))
(when (probe-file roots-file)
- (destructuring-bind (root-list class-index slot-index)
+ (destructuring-bind (root-list class-index slot-index
+ &optional
+ ;; Added in version 0.1.20.
+ highest-transaction)
(load-objects roots-file)
- (with-slots (roots class-index-table slot-index-tables)
+ (with-slots (roots class-index-table slot-index-tables highest-transaction-id)
rucksack
(setf roots root-list)
(when class-index
(setf class-index-table class-index))
(when slot-index
- (setf slot-index-tables slot-index))))))
+ (setf slot-index-tables slot-index))
+ (when highest-transaction
+ (setf highest-transaction-id highest-transaction))))))
rucksack)
@@ -437,7 +452,8 @@
(and (slot-boundp rucksack 'class-index-table)
(slot-value rucksack 'class-index-table))
(and (slot-boundp rucksack 'slot-index-tables)
- (slot-value rucksack 'slot-index-tables)))
+ (slot-value rucksack 'slot-index-tables))
+ (slot-value rucksack 'highest-transaction-id))
(rucksack-roots-pathname rucksack))
(setf (roots-changed-p rucksack) nil))
@@ -578,6 +594,10 @@
(load-roots rucksack)
(setf (roots-changed-p rucksack) nil))
+;;
+;; Some small stuff
+;;
+
(defmacro with-rucksack ((rucksack directory &rest args) &body body)
`(let* ((*rucksack* *rucksack*)
(,rucksack (open-rucksack ,directory , at args)))
--- /project/rucksack/cvsroot/rucksack/transactions.lisp 2008/01/16 15:08:21 1.14
+++ /project/rucksack/cvsroot/rucksack/transactions.lisp 2009/05/27 14:26:25 1.15
@@ -1,4 +1,4 @@
-;; $Id: transactions.lisp,v 1.14 2008/01/16 15:08:21 alemmens Exp $
+;; $Id: transactions.lisp,v 1.15 2009/05/27 14:26:25 alemmens Exp $
(in-package :rucksack)
@@ -133,7 +133,7 @@
(rucksack standard-rucksack)
&key &allow-other-keys)
;; Create new transaction.
- (let* ((id (make-transaction-id cache))
+ (let* ((id (incf (highest-transaction-id rucksack)))
(transaction (make-instance 'standard-transaction :id id)))
;; Add to open transactions.
(open-transaction cache transaction)
@@ -234,10 +234,11 @@
(let ((cache (rucksack-cache rucksack)))
(finish-heap-output (heap cache))
(finish-heap-output (object-table (heap cache)))
- ;; NOTE: I'm not totally sure that saving the roots and schema table
- ;; for each transaction commit is necessary, but it probably is. So
- ;; let's play safe for now.
- (save-roots-if-necessary rucksack)
+ ;; NOTE: I'm not totally sure that saving the schema table for
+ ;; each transaction commit is necessary, but it probably is. So
+ ;; let's play safe for now. We definitely need to save the roots,
+ ;; because the highest transaction-id is part of the roots file.
+ (save-roots rucksack)
(save-schema-table-if-necessary (schema-table cache))))
More information about the rucksack-cvs
mailing list