[elephant-cvs] CVS elephant/src/db-bdb
ieslick
ieslick at common-lisp.net
Sat Feb 17 12:13:19 UTC 2007
Update of /project/elephant/cvsroot/elephant/src/db-bdb
In directory clnet:/tmp/cvs-serv11213/src/db-bdb
Modified Files:
bdb-collections.lisp bdb-controller.lisp bdb-slots.lisp
berkeley-db.lisp
Log Message:
Final migration fixes for BDB and restructuring of BDB default transaction handling to allow for nested controllers and transactions; migration info
--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2007/02/16 07:11:02 1.19
+++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2007/02/17 12:13:19 1.20
@@ -39,19 +39,22 @@
(buffer-write-oid (oid bt) key-buf)
(serialize key key-buf sc)
(let ((buf (db-get-key-buffered (controller-btrees sc)
- key-buf value-buf)))
+ key-buf value-buf
+ :transaction (my-current-transaction sc))))
(if buf (values (deserialize buf sc) T)
(values nil nil))))))
(defmethod existsp (key (bt bdb-btree))
- (with-buffer-streams (key-buf value-buf)
- (buffer-write-oid (oid bt) key-buf)
- (serialize key key-buf (get-con bt))
- (let ((buf (db-get-key-buffered
- (controller-btrees (get-con bt))
- key-buf value-buf)))
- (if buf t
- nil))))
+ (let ((sc (get-con bt)))
+ (with-buffer-streams (key-buf value-buf)
+ (buffer-write-oid (oid bt) key-buf)
+ (serialize key key-buf sc)
+ (let ((buf (db-get-key-buffered
+ (controller-btrees sc)
+ key-buf value-buf
+ :transaction (my-current-transaction sc))))
+ (if buf t
+ nil)))))
(defmethod (setf get-value) (value key (bt bdb-btree))
@@ -61,16 +64,17 @@
(serialize key key-buf sc)
(serialize value value-buf sc)
(db-put-buffered (controller-btrees sc)
- key-buf value-buf)))
- value)
+ key-buf value-buf
+ :transaction (my-current-transaction sc))))
+ value)
(defmethod remove-kv (key (bt bdb-btree))
(let ((sc (get-con bt)) )
(with-buffer-streams (key-buf)
(buffer-write-oid (oid bt) key-buf)
(serialize key key-buf sc)
- (db-delete-buffered (controller-btrees sc)
- key-buf))))
+ (db-delete-buffered (controller-btrees sc) key-buf
+ :transaction (my-current-transaction sc)))))
(defmethod optimize-layout ((bt bdb-btree) &key (freelist-only t) (free-space nil) &allow-other-keys)
(optimize-layout (get-con bt)
@@ -132,7 +136,8 @@
;; the key/value already exists
(db-put-buffered
(controller-indices sc)
- secondary-buf primary-buf)
+ secondary-buf primary-buf
+ :transaction (my-current-transaction sc))
(reset-buffer-stream primary-buf)
(reset-buffer-stream secondary-buf)))
(let ((key-fn (key-fn index))
@@ -181,7 +186,8 @@
(serialize value value-buf sc)
(ensure-transaction (:store-controller sc)
(db-put-buffered (controller-btrees sc)
- key-buf value-buf)
+ key-buf value-buf
+ :transaction (my-current-transaction sc))
(loop for index being the hash-value of indices
do
(multiple-value-bind (index? secondary-key)
@@ -193,7 +199,8 @@
;; should silently do nothing if the key/value already
;; exists
(db-put-buffered (controller-indices sc)
- secondary-buf key-buf)
+ secondary-buf key-buf
+ :transaction (my-current-transaction sc))
(reset-buffer-stream secondary-buf))))
value))))
)
@@ -220,10 +227,12 @@
;; this is a C performance hack
(db-delete-kv-buffered
(controller-indices (get-con bt))
- secondary-buf key-buf)
+ secondary-buf key-buf
+ :transaction (my-current-transaction sc))
(reset-buffer-stream secondary-buf))))
(db-delete-buffered (controller-btrees (get-con bt))
- key-buf))))))))
+ key-buf
+ :transaction (my-current-transaction sc)))))))))
;; This also needs to build the correct kind of index, and
;; be the correct kind of btree...
@@ -235,14 +244,16 @@
(defmethod get-value (key (bt bdb-btree-index))
"Get the value in the primary DB from a secondary key."
- (with-buffer-streams (key-buf value-buf)
- (buffer-write-oid (oid bt) key-buf)
- (serialize key key-buf (get-con bt))
- (let ((buf (db-get-key-buffered
- (controller-indices-assoc (get-con bt))
- key-buf value-buf)))
- (if buf (values (deserialize buf (get-con bt)) T)
- (values nil nil)))))
+ (let ((sc (get-con bt)))
+ (with-buffer-streams (key-buf value-buf)
+ (buffer-write-oid (oid bt) key-buf)
+ (serialize key key-buf sc)
+ (let ((buf (db-get-key-buffered
+ (controller-indices-assoc sc)
+ key-buf value-buf
+ :transaction (my-current-transaction sc))))
+ (if buf (values (deserialize buf sc) T)
+ (values nil nil))))))
(defmethod get-primary-key (key (bt btree-index))
(let ((sc (get-con bt)))
@@ -251,7 +262,8 @@
(serialize key key-buf sc)
(let ((buf (db-get-key-buffered
(controller-indices sc)
- key-buf value-buf)))
+ key-buf value-buf
+ :transaction (my-current-transaction sc))))
(if buf
(let ((oid (buffer-read-oid buf)))
(values (deserialize buf sc) oid))
@@ -263,10 +275,12 @@
(defmethod make-cursor ((bt bdb-btree))
"Make a cursor from a btree."
- (make-instance 'bdb-cursor
- :btree bt
- :handle (db-cursor (controller-btrees (get-con bt)))
- :oid (oid bt)))
+ (let ((sc (get-con bt)))
+ (make-instance 'bdb-cursor
+ :btree bt
+ :handle (db-cursor (controller-btrees sc)
+ :transaction (my-current-transaction sc))
+ :oid (oid bt))))
(defmethod cursor-close ((cursor bdb-cursor))
(db-cursor-close (cursor-handle cursor))
@@ -461,12 +475,12 @@
(defmethod make-cursor ((bt bdb-btree-index))
"Make a secondary-cursor from a secondary index."
- (make-instance 'bdb-secondary-cursor
- :btree bt
- :handle (db-cursor
- (controller-indices-assoc (get-con bt)))
- :oid (oid bt)))
-
+ (let ((sc (get-con bt)))
+ (make-instance 'bdb-secondary-cursor
+ :btree bt
+ :handle (db-cursor (controller-indices-assoc sc)
+ :transaction (my-current-transaction sc))
+ :oid (oid bt))))
(defmethod cursor-pcurrent ((cursor bdb-secondary-cursor))
(when (cursor-initialized-p cursor)
--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/02/16 17:02:38 1.27
+++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/02/17 12:13:19 1.28
@@ -59,6 +59,15 @@
(otherwise nil))))
;;
+;; Store-specific transaction support
+;;
+
+(defmacro my-current-transaction (sc)
+ (let ((txn-rec *current-transaction*))
+ (if (and txn-rec (eq (transaction-store txn-rec) sc))
+ (transaction-object txn-rec)
+ +NULL-VOID+)))
+;;
;; Open/close
;;
@@ -186,7 +195,8 @@
(with-buffer-streams (key val)
(serialize-database-version-key key)
(let ((buf (db-get-key-buffered (controller-metadata sc)
- key val)))
+ key val
+ :transaction +NULL-VOID+)))
(if buf (deserialize-database-version-value buf)
nil))))
@@ -196,7 +206,8 @@
(serialize-database-version-key key)
(serialize-database-version-value *elephant-code-version* val)
(db-put-buffered (controller-metadata sc)
- key val)
+ key val
+ :transaction +NULL-VOID+)
*elephant-code-version*))
;; (defmethod old-database-version ((sc bdb-store-controller))
@@ -258,23 +269,26 @@
(with-buffer-streams (start stop end)
(if (null start-key)
(progn
- (db-compact (controller-indices ctrl) nil nil end)
- (db-compact (controller-db ctrl) nil nil end)
- (db-compact (controller-btrees ctrl) nil nil end))
+ (db-compact (controller-indices ctrl) nil nil end :transaction +NULL-VOID+)
+ (db-compact (controller-db ctrl) nil nil end :transaction +NULL-VOID+)
+ (db-compact (controller-btrees ctrl) nil nil end :transaction +NULL-VOID+))
(progn
(serialize start-key start ctrl)
(when stop-key (serialize stop-key stop ctrl))
(db-compact (controller-indices ctrl) start
(when stop-key stop) end
:freelist-only freelist-only
- :free-space free-space)
+ :free-space free-space
+ :transaction +NULL-VOID+)
(db-compact (controller-db ctrl) nil
(when stop-key stop) end
:freelist-only freelist-only
- :free-space free-space)
+ :free-space free-space
+ :transaction +NULL-VOID+)
(db-compact (controller-btrees ctrl) nil
(when stop-key stop) end
:freelist-only freelist-only
- :free-space free-space)))
+ :free-space free-space
+ :transaction +NULL-VOID+)))
(values (deserialize end ctrl))))
--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-slots.lisp 2007/02/02 23:51:58 1.2
+++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-slots.lisp 2007/02/17 12:13:19 1.3
@@ -30,7 +30,8 @@
(buffer-write-int (oid instance) key-buf)
(serialize name key-buf sc)
(let ((buf (db-get-key-buffered (controller-db sc)
- key-buf value-buf)))
+ key-buf value-buf
+ :transaction (my-current-transaction sc))))
(if buf (deserialize buf sc)
#+cmu
(error 'unbound-slot :instance instance :slot name)
@@ -44,7 +45,7 @@
(serialize new-value value-buf sc)
(db-put-buffered (controller-db sc)
key-buf value-buf
- :transaction (txn-default *current-transaction*))
+ :transaction (my-current-transaction sc))
new-value))
(defmethod persistent-slot-boundp ((sc bdb-store-controller) instance name)
@@ -52,7 +53,8 @@
(buffer-write-int (oid instance) key-buf)
(serialize name key-buf sc)
(let ((buf (db-get-key-buffered (controller-db sc)
- key-buf value-buf)))
+ key-buf value-buf
+ :transaction (my-current-transaction sc))))
(if buf t nil))))
(defmethod persistent-slot-makunbound ((sc bdb-store-controller) instance name)
@@ -60,4 +62,6 @@
(buffer-write-int (oid instance) key-buf)
(serialize name key-buf sc)
(db-delete-buffered (controller-db sc) key-buf
- :transaction (txn-default *current-transaction*))))
+ :transaction (my-current-transaction sc))))
+
+
--- /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2007/02/16 23:02:51 1.8
+++ /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2007/02/17 12:13:19 1.9
@@ -73,9 +73,9 @@
)
(defmacro txn-default (dvar)
- (let ((dv (gensym)))
- `(let ((,dv ,dvar))
- (if ,dv (transaction-object ,dv) +NULL-VOID+))))
+ `(progn
+ (assert (null ,dvar))
+ +NULL-VOID+))
;;
;; Constants and Flags
More information about the Elephant-cvs
mailing list