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