[bknr-cvs] r2267 - in branches/trunk-reorg/bknr/datastore/src: . data
bknr at bknr.net
bknr at bknr.net
Mon Nov 12 06:38:33 UTC 2007
Author: hhubner
Date: 2007-11-12 01:38:32 -0500 (Mon, 12 Nov 2007)
New Revision: 2267
Removed:
branches/trunk-reorg/bknr/datastore/src/data/random-mixin.lisp
Modified:
branches/trunk-reorg/bknr/datastore/src/bknr-datastore.asd
branches/trunk-reorg/bknr/datastore/src/data/package.lisp
branches/trunk-reorg/bknr/datastore/src/data/txn.lisp
Log:
Integrated store random state maintenance into the baseline store code, as the
API does not allow for clean implementation as a subsystem.
Modified: branches/trunk-reorg/bknr/datastore/src/bknr-datastore.asd
===================================================================
--- branches/trunk-reorg/bknr/datastore/src/bknr-datastore.asd 2007-11-11 21:35:49 UTC (rev 2266)
+++ branches/trunk-reorg/bknr/datastore/src/bknr-datastore.asd 2007-11-12 06:38:32 UTC (rev 2267)
@@ -26,5 +26,4 @@
(:file "encoding" :depends-on ("package"))
(:file "txn" :depends-on ("encoding" "package"))
(:file "object" :depends-on ("txn" "package"))
- (:file "blob" :depends-on ("txn" "object" "package"))
- (:file "random-mixin" :depends-on ("package" "txn"))))))
+ (:file "blob" :depends-on ("txn" "object" "package"))))))
Modified: branches/trunk-reorg/bknr/datastore/src/data/package.lisp
===================================================================
--- branches/trunk-reorg/bknr/datastore/src/data/package.lisp 2007-11-11 21:35:49 UTC (rev 2266)
+++ branches/trunk-reorg/bknr/datastore/src/data/package.lisp 2007-11-12 06:38:32 UTC (rev 2267)
@@ -15,7 +15,6 @@
;; store
#:store
#:mp-store
- #:random-store-mixin
#:store-guard
#:store-state
#:open-store
@@ -103,6 +102,5 @@
#:store-object-subsystem
#:blob-subsystem
- #:random-mixin-subsystem
#:find-refs))
Deleted: branches/trunk-reorg/bknr/datastore/src/data/random-mixin.lisp
===================================================================
--- branches/trunk-reorg/bknr/datastore/src/data/random-mixin.lisp 2007-11-11 21:35:49 UTC (rev 2266)
+++ branches/trunk-reorg/bknr/datastore/src/data/random-mixin.lisp 2007-11-12 06:38:32 UTC (rev 2267)
@@ -1,70 +0,0 @@
-(in-package :bknr.datastore)
-
-;; The intended use of this mixin class
-;; is something like this:
-
-;; (in-package :bknr.user)
-
-;; (defclass mystore (mp-store random-store-mixin)
-;; ())
-
-;; (open-store "/tmp/db_123/" :class-name 'mystore
-;; :subsystems (list (make-instance 'store-object-subsystem)
-;; (make-instance 'random-mixin-subsystem)))
-
-(defclass random-store-mixin ()
- ((random-state :accessor random-state-of :initform (make-random-state t))))
-
-(defun random-subsystem-pathname (store)
- (make-pathname :name "random-state" :defaults (ensure-store-current-directory store)))
-
-(defmethod initialize-instance :after ((store random-store-mixin) &rest initargs)
- (declare (ignore initargs))
- (let ((random-mixin-subsystem (find 'random-mixin-subsystem
- (store-subsystems store)
- :key #'type-of)))
- (assert random-mixin-subsystem nil "Store ~S needs to have a random-mixin-subsystem."
- store)
- (unless (probe-file (random-subsystem-pathname store))
- (snapshot-subsystem store random-mixin-subsystem))))
-
-(defmethod restore-store :after ((store random-store-mixin) &key until)
- (declare (ignore until))
- ;; During restore, we use the random state of the store (see
- ;; restore-subsystem below). Once finished with the restore, we
- ;; save the current random state to be the store's random state:
- (setf (random-state-of store) *random-state*))
-
-(defmethod execute-transaction :around ((executor random-store-mixin) transaction)
- (declare (ignore transaction))
- (let ((*random-state* (random-state-of executor)))
- (call-next-method)))
-
-(defclass random-mixin-subsystem ()
- ())
-
-(defmethod snapshot-subsystem ((store random-store-mixin)
- (subsystem random-mixin-subsystem))
- (with-open-file (s (random-subsystem-pathname store)
- :direction :output
- :if-exists :supersede)
- (with-standard-io-syntax
- (prin1 (random-state-of store) s))))
-
-(defmethod restore-subsystem ((store random-store-mixin)
- (subsystem random-mixin-subsystem) &key
- until)
- (declare (ignore until))
- (let* ((random-state-pathname (random-subsystem-pathname store)))
- (prog1
- (if (probe-file random-state-pathname)
- (with-open-file (s random-state-pathname :direction :input)
- (let ((random-state (read s)))
- (setf (random-state-of store) random-state)))
- (progn
- (format *trace-output* "Initializing random state of store.~%")
- (setf (random-state-of store) (make-random-state t))))
- ;; Set global random state to the state of the store, so that
- ;; the transactions that are restored afterwards are in the
- ;; correct random context.
- (setf *random-state* (random-state-of store)))))
Modified: branches/trunk-reorg/bknr/datastore/src/data/txn.lisp
===================================================================
--- branches/trunk-reorg/bknr/datastore/src/data/txn.lisp 2007-11-11 21:35:49 UTC (rev 2266)
+++ branches/trunk-reorg/bknr/datastore/src/data/txn.lisp 2007-11-12 06:38:32 UTC (rev 2267)
@@ -5,6 +5,9 @@
(defvar *store-debug* nil
"Trace and time execution of transactions")
+(defvar *store-random-state* nil
+ "Random state of the store")
+
;;; conditions
(define-condition not-in-transaction (error)
@@ -28,6 +31,8 @@
:initform :closed
:documentation "State of the datastore, can be either :closed, :opened or :read-only")
(transaction-log-stream :accessor store-transaction-log-stream :initform nil)
+ (random-state :accessor store-random-state
+ :initform nil)
(guard :reader store-guard
:initarg :guard)
(log-guard :reader store-log-guard
@@ -77,6 +82,7 @@
(setf *store* store)
(let ((store-existed-p (probe-file (store-current-directory store))))
(ensure-store-current-directory store)
+ (ensure-store-random-state store)
(dolist (subsystem (store-subsystems store))
(when *store-debug*
(format *trace-output* "Initializing subsystem ~A of ~A~%" subsystem store))
@@ -126,6 +132,25 @@
(defmethod ensure-store-current-directory ((store store))
(ensure-directories-exist (store-current-directory store)))
+(defmethod store-random-state-pathname ((store store))
+ (merge-pathnames #P"random-state" (store-current-directory store)))
+
+(defmethod ensure-store-random-state ((store store))
+ (if (probe-file (store-random-state-pathname store))
+ (with-open-file (f (store-random-state-pathname store))
+ (format t "reading store random state~%")
+ (setf (store-random-state store) (read f)))
+ (with-open-file (f (store-random-state-pathname store) :direction :output :if-does-not-exist :create)
+ (format t "initializing store random state~%")
+ (with-standard-io-syntax
+ (prin1 (setf (store-random-state store) (make-random-state t)) f)))))
+
+(defmethod update-store-random-state ((store store))
+ (format t "saving store random state~%")
+ (with-open-file (f (store-random-state-pathname store) :direction :output :if-does-not-exist :create)
+ (with-standard-io-syntax
+ (prin1 (store-random-state store) f))))
+
(defgeneric store-transaction-log-pathname (store-or-directory)
(:documentation "Return the pathname of the current transaction log of STORE"))
@@ -273,7 +298,8 @@
(tagbody
again
(restart-case
- (let ((start-time (get-internal-run-time)))
+ (let ((start-time (get-internal-run-time))
+ (*random-state* (store-random-state *store*)))
(setf retval (call-next-method))
(setf execution-time (- (get-internal-run-time) start-time)))
(retry-transaction ()
@@ -448,14 +474,16 @@
(let ((error t))
(unwind-protect
(with-store-state (:snapshot)
- (dolist (subsystem (store-subsystems store))
- (when *store-debug*
- (format *trace-output* "Snapshotting subsystem ~A of ~A~%" subsystem store))
- (snapshot-subsystem store subsystem)
- (when *store-debug*
- (format *trace-output* "Successfully snapshotted ~A of ~A~%" subsystem store)))
- (setf (store-transaction-run-time store) 0)
- (setf error nil))
+ (let ((*random-state* (store-random-state store)))
+ (dolist (subsystem (store-subsystems store))
+ (when *store-debug*
+ (format *trace-output* "Snapshotting subsystem ~A of ~A~%" subsystem store))
+ (snapshot-subsystem store subsystem)
+ (when *store-debug*
+ (format *trace-output* "Successfully snapshotted ~A of ~A~%" subsystem store)))
+ (setf (store-transaction-run-time store) 0)
+ (setf error nil))
+ (update-store-random-state store))
(when error
(warn "Restoring backup ~A to current."
backup-directory)
@@ -510,6 +538,7 @@
(restore-store *store* :until until))
(defmethod restore-store ((store store) &key until)
+ (ensure-store-random-state store)
(format *trace-output* "restoring ~A~%" store)
(let ((*store* store))
(setf (store-state store) :opened)
More information about the Bknr-cvs
mailing list