From alemmens at common-lisp.net Wed May 27 14:26:25 2009 From: alemmens at common-lisp.net (alemmens) Date: Wed, 27 May 2009 10:26:25 -0400 Subject: [rucksack-cvs] CVS rucksack Message-ID: 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)))) From alemmens at common-lisp.net Wed May 27 14:26:25 2009 From: alemmens at common-lisp.net (alemmens) Date: Wed, 27 May 2009 10:26:25 -0400 Subject: [rucksack-cvs] CVS rucksack/doc Message-ID: Update of /project/rucksack/cvsroot/rucksack/doc In directory cl-net:/tmp/cvs-serv29574/doc Modified Files: done.txt 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/doc/done.txt 2008/03/31 18:51:49 1.3 +++ /project/rucksack/cvsroot/rucksack/doc/done.txt 2009/05/27 14:26:25 1.4 @@ -1,3 +1,9 @@ +* 2009-05-27 - version 0.1.20 + +Fix a bug in the creation of transaction-ids (bug reported by Klaus +Harbo). + + * 2008-03-31 - version 0.1.19 Don't use wildcards but delete only the four rucksack files when