Update of /project/elephant/cvsroot/elephant/src/db-bdb
In directory clnet:/tmp/cvs-serv3271/src/db-bdb
Modified Files:
bdb-collections.lisp bdb-controller.lisp bdb-slots.lisp
bdb-transactions.lisp berkeley-db.lisp
Log Message:
Large changeset to enable thread safety; more *auto-commit* removal; sql class-root fix; new transaction model; cleaned up defaults for *store-controller*
--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2007/02/01 15:19:49 1.13
+++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2007/02/02 23:51:58 1.14
@@ -110,14 +110,14 @@
(defmethod build-btree-index ((sc bdb-store-controller) &key primary key-form)
(make-instance 'bdb-btree-index :primary primary :key-form key-form :sc sc))
-(defmethod add-index ((bt bdb-indexed-btree) &key index-name key-form populate)
+(defmethod add-index ((bt bdb-indexed-btree) &key index-name key-form (populate t))
(let ((sc (get-con bt)))
;; Setting the value of *store-controller* is unfortunately
;; absolutely required at present, I think because the copying
;; of objects is calling "make-instance" without an argument.
;; I am sure I can find a way to make this cleaner, somehow.
(if (and (not (null index-name))
- (symbolp index-name)
+ (symbolp index-name)
(or (symbolp key-form) (listp key-form)))
;; Can it be that this fails?
(let ((ht (indices bt))
--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/02/01 04:03:26 1.19
+++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/02/02 23:51:58 1.20
@@ -62,7 +62,7 @@
;;
(defmethod open-controller ((sc bdb-store-controller) &key (recover nil)
- (recover-fatal nil) (thread t) (errfile nil)
+ (recover-fatal nil) (thread t) ;; (errfile nil)
(deadlock-detect nil))
(let ((env (db-env-create)))
(setf (controller-environment sc) env)
@@ -158,7 +158,7 @@
"Get the next OID."
(declare (type bdb-store-controller sc))
(db-sequence-get-fixnum (controller-oid-seq sc) 1 :transaction +NULL-VOID+
- :auto-commit t :txn-nosync t))
+ :txn-nosync t))
;;
;; Automated Deadlock Support
--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-slots.lisp 2007/01/22 22:22:35 1.1
+++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-slots.lisp 2007/02/02 23:51:58 1.2
@@ -23,8 +23,9 @@
;; Persistent slot protocol implementation
;;
+(declaim #-elephant-without-optimize (optimize (speed 3) (safety 1) (space 0)))
+
(defmethod persistent-slot-reader ((sc bdb-store-controller) instance name)
-;; (declare (optimize (speed 3) (safety 1) (space 1)))
(with-buffer-streams (key-buf value-buf)
(buffer-write-int (oid instance) key-buf)
(serialize name key-buf sc)
@@ -37,20 +38,16 @@
(error 'unbound-slot :instance instance :name name)))))
(defmethod persistent-slot-writer ((sc bdb-store-controller) new-value instance name)
-;; (declare (optimize (speed 3) (safety 1) (space 1)))
-;; (format t "psw -- sc: ~A ct: ~A ac: ~A~%" *store-controller* *current-transaction* *auto-commit*)
(with-buffer-streams (key-buf value-buf)
(buffer-write-int (oid instance) key-buf)
(serialize name key-buf sc)
(serialize new-value value-buf sc)
(db-put-buffered (controller-db sc)
key-buf value-buf
- :transaction *current-transaction*
- :auto-commit *auto-commit*)
+ :transaction (txn-default *current-transaction*))
new-value))
(defmethod persistent-slot-boundp ((sc bdb-store-controller) instance name)
-;; (declare (optimize (speed 3) (safety 1) (space 1)))
(with-buffer-streams (key-buf value-buf)
(buffer-write-int (oid instance) key-buf)
(serialize name key-buf sc)
@@ -59,10 +56,8 @@
(if buf t nil))))
(defmethod persistent-slot-makunbound ((sc bdb-store-controller) instance name)
-;; (declare (optimize (speed 3) (safety 1) (space 1)))
(with-buffer-streams (key-buf)
(buffer-write-int (oid instance) key-buf)
(serialize name key-buf sc)
(db-delete-buffered (controller-db sc) key-buf
- :transaction *current-transaction*
- :auto-commit *auto-commit*)))
+ :transaction (txn-default *current-transaction*))))
--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-transactions.lisp 2006/11/11 18:41:10 1.4
+++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-transactions.lisp 2007/02/02 23:51:58 1.5
@@ -21,11 +21,10 @@
(defmethod execute-transaction ((sc bdb-store-controller) txn-fn
&key
- transaction environment parent
- (retries 100) degree-2
- dirty-read txn-nosync txn-nowait txn-sync)
- (let ((env (if environment environment
- (controller-environment sc))))
+ transaction parent environment
+ (retries 100)
+ degree-2 dirty-read txn-nosync txn-nowait txn-sync)
+ (let ((env (if environment environment (controller-environment sc))))
(loop
for count fixnum from 1 to retries
for success of-type boolean = nil
@@ -33,7 +32,7 @@
(let ((txn
(if transaction transaction
(db-transaction-begin env
- :parent parent
+ :parent (if parent parent +NULL-VOID+)
:degree-2 degree-2
:dirty-read dirty-read
:txn-nosync txn-nosync
@@ -42,20 +41,17 @@
(declare (type pointer-void txn)
(dynamic-extent txn))
(let ((result
- (let ((*current-transaction* txn)
- (*auto-commit* nil))
- (declare (special *current-transaction* *auto-commit*))
-;; (dynamic-extent *current-transaction* *auto-commit*))
+ (let ((*current-transaction* txn))
+ (declare (special *current-transaction*))
(catch 'transaction
(unwind-protect
(prog1
(funcall txn-fn)
(setq success t)
- (db-transaction-commit :transaction txn
- :txn-nosync txn-nosync
- :txn-sync txn-sync))
+ (db-transaction-commit txn :txn-nosync txn-nosync
+ :txn-sync txn-sync))
(unless success
- (db-transaction-abort :transaction txn)))))))
+ (db-transaction-abort txn)))))))
(unless (and (eq result txn) (not success))
(return result))))
finally (error "Too many retries in transaction"))))
@@ -79,6 +75,7 @@
dirty-read
degree-2
&allow-other-keys)
+ (assert (not *current-transaction*))
(db-transaction-begin (controller-environment sc)
:parent parent
:txn-nosync txn-nosync
@@ -88,8 +85,101 @@
:degree-2 degree-2))
-(defmethod controller-commit-transaction ((sc bdb-store-controller) &key transaction &allow-other-keys)
- (db-transaction-commit :transaction transaction))
+(defmethod controller-commit-transaction ((sc bdb-store-controller) transaction &key &allow-other-keys)
+ (assert (not *current-transaction*))
+ (db-transaction-commit transaction))
-(defmethod controller-abort-transaction ((sc bdb-store-controller) &key &allow-other-keys)
- (db-transaction-abort))
\ No newline at end of file
+(defmethod controller-abort-transaction ((sc bdb-store-controller) transaction &key &allow-other-keys)
+ (assert (not *current-transaction*))
+ (db-transaction-abort transaction))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Old versions of with-transaction
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+#|
+(defmacro with-transaction ((&key transaction environment
+ (parent '*current-transaction*)
+ (retries 100)
+ dirty-read read-uncommitted
+ txn-nosync txn-nowait txn-sync)
+ &body body)
+ (let ((txn (if transaction transaction (gensym)))
+ (count (gensym))
+ (result (gensym))
+ (success (gensym)))
+ `(loop
+ for ,count fixnum from 1 to ,retries
+ for ,success of-type boolean = nil
+ do
+ (with-alien ((,txn (* t)
+ (db-transaction-begin ,environment
+ :parent ,parent
+ :dirty-read (or ,dirty-read ,read-uncommitted)
+ :txn-nosync ,txn-nosync
+ :txn-nowait ,txn-nowait
+ :txn-sync ,txn-sync)))
+ (let ((,result
+ (let ((*current-transaction* ,txn))
+ (declare (special *current-transaction*)
+ (dynamic-extent *current-transaction*))
+ (catch 'transaction
+ (unwind-protect
+ (prog1 (progn ,@body)
+ (setq ,success t)
+ (db-transaction-commit :transaction ,txn
+ :txn-nosync ,txn-nosync
+ :txn-sync ,txn-sync))
+ (unless ,success
+ (db-transaction-abort :transaction ,txn)))))))
+ (unless (and (eq ,result ,txn) (not ,success))
+ (return ,result))))
+ finally (error "Too many retries"))))
+
+(defmacro with-transaction ((&key transaction environment
+ (parent '*current-transaction*)
+ (retries 100)
+ degree-2 read-committed
+ dirty-read read-uncommitted
+ txn-nosync txn-nowait txn-sync)
+ &body body)
+ "Execute a body with a transaction in place. On success,
+the transaction is committed. Otherwise, the transaction is
+aborted. If the body deadlocks, the body is re-executed in
+a new transaction, retrying a fixed number of iterations."
+ (let ((txn (if transaction transaction (gensym)))
+ (count (gensym))
+ (result (gensym))
+ (success (gensym)))
+ `(loop
+ for ,count fixnum from 1 to ,retries
+ for ,success of-type boolean = nil
+ do
+ (let ((,txn
+ (db-transaction-begin ,environment
+ :parent ,parent
+ :degree-2 (or ,degree-2 ,read-committed)
+ :dirty-read (or ,dirty-read ,read-uncommitted)
+ :txn-nosync ,txn-nosync
+ :txn-nowait ,txn-nowait
+ :txn-sync ,txn-sync)))
+ (declare (type pointer-void ,txn)
+ (dynamic-extent ,txn))
+ (let ((,result
+ (let ((*current-transaction* ,txn))
+ (declare (special *current-transaction*)
+ (dynamic-extent *current-transaction*))
+ (catch 'transaction
+ (unwind-protect
+ (prog1 (progn ,@body)
+ (setq ,success t)
+ (db-transaction-commit :transaction ,txn
+ :txn-nosync ,txn-nosync
+ :txn-sync ,txn-sync))
+ (unless ,success
+ (db-transaction-abort :transaction ,txn)))))))
+ (unless (and (eq ,result ,txn) (not ,success))
+ (return ,result))))
+ finally (error "Too many retries"))))
+|#
--- /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2007/01/31 22:24:16 1.6
+++ /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2007/02/02 23:51:58 1.7
@@ -72,6 +72,9 @@
)
+(defmacro txn-default (dvar)
+ `(if ,dvar ,dvar +NULL-VOID+))
+
;;
;; Constants and Flags
;; eventually write a macro which generates a custom flag function.
@@ -132,6 +135,8 @@
(defconstant DB_FIRST 7)
(defconstant DB_GET_BOTH 8)
(defconstant DB_GET_BOTH_RANGE 10)
+(defconstant DB_KEYFIRST 13)
+(defconstant DB_KEYLAST 14)
(defconstant DB_LAST 15)
(defconstant DB_NEXT 16)
(defconstant DB_NEXT_DUP 17)
@@ -220,8 +225,6 @@
;; makes flags into keywords
;; makes keyword args, cstring wrappers
-(defvar *errno-buffer* (allocate-foreign-object :int 1))
-
(eval-when (:compile-toplevel)
(defun make-wrapper-args (args flags keys)
(if (or flags keys)
@@ -404,7 +407,7 @@
:returning :int)
(wrap-errno db-env-open (dbenvp home flags mode)
- :flags (init-cdb init-lock init-log
+ :flags (auto-commit init-cdb init-lock init-log
init-mpool init-rep init-txn
recover recover-fatal create
lockdown private system-mem thread
@@ -423,7 +426,7 @@
(wrap-errno db-env-dbremove (env transaction file database flags)
:flags (auto-commit)
- :keys ((transaction *current-transaction*)
+ :keys ((transaction (txn-default *current-transaction*))
(database +NULL-CHAR+))
:cstrings (file database)
:transaction transaction
@@ -440,7 +443,7 @@
(wrap-errno db-env-dbrename (env transaction file database newname flags)
:flags (auto-commit)
- :keys ((transaction *current-transaction*)
+ :keys ((transaction (txn-default *current-transaction*))
(database +NULL-CHAR+))
:cstrings (file database newname)
:transaction transaction
@@ -535,7 +538,7 @@
:flags (auto-commit create dirty-read read-uncommitted
excl nommap rdonly thread truncate
)
- :keys ((transaction *current-transaction*)
+ :keys ((transaction (txn-default *current-transaction*))
(file +NULL-CHAR+)
(database +NULL-CHAR+)
(type DB-UNKNOWN)
@@ -584,7 +587,8 @@
:returning :int)
(wrap-errno db-truncate (db transaction flags) :flags (auto-commit)
- :keys ((transaction *current-transaction*)) :outs 2
+ :keys ((transaction (txn-default *current-transaction*)))
+ :outs 2
:transaction transaction
:documentation "Truncate (erase) a DB.")
@@ -625,8 +629,8 @@
:returning :int)
(defun db-get-key-buffered (db key-buffer-stream value-buffer-stream
- &key (transaction *current-transaction*)
- auto-commit get-both degree-2 read-committed
+ &key (transaction (txn-default *current-transaction*))
+ get-both degree-2 read-committed
dirty-read read-uncommitted)
"Get a key / value pair from a DB. The key is encoded in
a buffer-stream. Space for the value is passed in as a
@@ -634,7 +638,7 @@
decoding, or NIL if nothing was found."
(declare (type pointer-void db transaction)
(type buffer-stream key-buffer-stream value-buffer-stream)
- (type boolean auto-commit get-both degree-2 read-committed dirty-read read-uncommitted))
+ (type boolean get-both degree-2 read-committed dirty-read read-uncommitted))
(loop
for value-length fixnum = (buffer-stream-length value-buffer-stream)
do
@@ -644,8 +648,7 @@
(buffer-stream-size key-buffer-stream)
(buffer-stream-buffer value-buffer-stream)
value-length
- (flags :auto-commit auto-commit
- :get-both get-both
+ (flags :get-both get-both
:degree-2 (or degree-2 read-committed)
:dirty-read (or dirty-read read-uncommitted)))
(declare (type fixnum result-size errno))
@@ -675,8 +678,8 @@
(defun db-get-buffered (db key value-buffer-stream &key
(key-size (length key))
- (transaction *current-transaction*)
- auto-commit get-both degree-2 read-committed
+ (transaction (txn-default *current-transaction*))
+ get-both degree-2 read-committed
dirty-read read-uncommitted)
"Get a key / value pair from a DB. The key is passed as a
string. Space for the value is passed in as a
@@ -686,7 +689,7 @@
(type string key)
(type buffer-stream value-buffer-stream)
(type fixnum key-size)
- (type boolean auto-commit get-both degree-2 read-committed
+ (type boolean get-both degree-2 read-committed
dirty-read read-uncommitted))
(with-cstring (k key)
(loop
@@ -696,8 +699,7 @@
(%db-get-buffered db transaction k key-size
(buffer-stream-buffer value-buffer-stream)
value-length
- (flags :auto-commit auto-commit
- :get-both get-both
+ (flags :get-both get-both
:degree-2 (or degree-2 read-committed)
:dirty-read (or dirty-read read-uncommitted)))
(declare (type fixnum result-size errno))
@@ -715,8 +717,8 @@
(t (error 'db-error :errno errno)))))))
(defun db-get (db key &key (key-size (length key))
- (transaction *current-transaction*)
- auto-commit get-both degree-2 read-committed
+ (transaction (txn-default *current-transaction*))
+ get-both degree-2 read-committed
dirty-read read-uncommitted)
"Get a key / value pair from a DB. The key is passed as a
string, and the value is returned as a string. If nothing
@@ -724,7 +726,7 @@
(declare (type pointer-void db transaction)
(type string key)
(type fixnum key-size)
- (type boolean auto-commit get-both degree-2 read-committed
+ (type boolean get-both degree-2 read-committed
dirty-read read-uncommitted))
(with-cstring (k key)
(with-buffer-streams (value-buffer-stream)
@@ -735,8 +737,7 @@
(%db-get-buffered db transaction k key-size
(buffer-stream-buffer value-buffer-stream)
value-length
- (flags :auto-commit auto-commit
- :get-both get-both
+ (flags :get-both get-both
:degree-2 (or degree-2 read-committed)
:dirty-read (or dirty-read read-uncommitted)))
(declare (type fixnum result-size errno))
@@ -766,21 +767,21 @@
:returning :int)
(defun db-put-buffered (db key-buffer-stream value-buffer-stream
- &key (transaction *current-transaction*) auto-commit
+ &key (transaction (txn-default *current-transaction*))
exists-error-p)
"Put a key / value pair into a DB. The pair are encoded
in buffer-streams. T on success, or nil if the key already
exists and EXISTS-ERROR-P is NIL."
(declare (type pointer-void db transaction)
(type buffer-stream key-buffer-stream value-buffer-stream)
- (type boolean auto-commit exists-error-p))
+ (type boolean exists-error-p))
(let ((errno
(%db-put-buffered db transaction
(buffer-stream-buffer key-buffer-stream)
(buffer-stream-size key-buffer-stream)
(buffer-stream-buffer value-buffer-stream)
(buffer-stream-size value-buffer-stream)
- (flags :auto-commit auto-commit))))
+ 0)))
(declare (type fixnum errno))
(cond ((= errno 0) t)
((and (= errno DB_KEYEXIST) (not exists-error-p))
@@ -800,15 +801,14 @@
:returning :int)
(wrap-errno db-put (db transaction key key-size value value-size flags)
- :flags (auto-commit)
+ :flags ()
:keys ((key-size (length key))
(value-size (length value))
- (transaction *current-transaction*))
+ (transaction (txn-default *current-transaction*)))
:cstrings (key value)
:declarations (declare (type pointer-void db transaction)
(type string key value)
- (type fixnum key-size value-size)
- (type boolean auto-commit))
+ (type fixnum key-size value-size))
:transaction transaction
:documentation
"Put a key / value pair into a DB. The pair are strings.")
@@ -821,18 +821,17 @@
(flags :unsigned-int))
:returning :int)
-(defun db-delete-buffered (db key-buffer-stream &key auto-commit
- (transaction *current-transaction*))
+(defun db-delete-buffered (db key-buffer-stream
+ &key (transaction (txn-default *current-transaction*)))
"Delete a key / value pair from a DB. The key is encoded
in a buffer-stream. T on success, NIL if the key wasn't
found."
(declare (type pointer-void db transaction)
- (type buffer-stream key-buffer-stream)
- (type boolean auto-commit))
+ (type buffer-stream key-buffer-stream))
(let ((errno (%db-delete-buffered db transaction
(buffer-stream-buffer key-buffer-stream)
(buffer-stream-size key-buffer-stream)
- (flags :auto-commit auto-commit))))
+ 0)))
(declare (type fixnum errno))
(cond ((= errno 0) t)
((or (= errno DB_NOTFOUND)
@@ -851,16 +850,16 @@
(flags :unsigned-int))
:returning :int)
-(defun db-delete (db key &key auto-commit (key-size (length key))
- (transaction *current-transaction*))
+(defun db-delete (db key &key (key-size (length key))
+ (transaction (txn-default *current-transaction*)))
"Delete a key / value pair from a DB. The key is a
string. T on success, NIL if the key wasn't found."
(declare (type pointer-void db transaction) (type string key)
- (type fixnum key-size) (type boolean auto-commit))
+ (type fixnum key-size))
(with-cstrings ((key key))
(let ((errno
(%db-delete db transaction key
- key-size (flags :auto-commit auto-commit))))
+ key-size 0)))
(declare (type fixnum errno))
(cond ((= errno 0) t)
((or (= errno DB_NOTFOUND)
@@ -881,7 +880,7 @@
:returning :int)
(defun db-delete-kv-buffered (db key-buffer-stream value-buffer-stream
- &key (transaction *current-transaction*))
+ &key (transaction (txn-default *current-transaction*)))
"Delete a specific key / value pair from a DB with
duplicates. The key and value are encoded as
buffer-streams. T on success, NIL if the key / value pair
@@ -918,7 +917,7 @@
(end-size :unsigned-int :out))
:returning :int)
-(defun db-compact (db start stop end &key (transaction *current-transaction*)
+(defun db-compact (db start stop end &key (transaction (txn-default *current-transaction*))
freelist-only free-space)
(declare (type pointer-void db transaction)
(type buffer-stream start stop)
@@ -956,20 +955,22 @@
(errnop (* :int)))
:returning :pointer-void)
-(defun db-cursor (db &key (transaction *current-transaction*)
+(defun db-cursor (db &key (transaction (txn-default *current-transaction*))
degree-2 read-committed dirty-read read-uncommitted)
"Create a cursor."
(declare (type pointer-void db)
- (type boolean degree-2 read-committed dirty-read read-uncommitted)
- (type pointer-int *errno-buffer*))
- (let* ((curs (%db-cursor db transaction (flags :degree-2 (or degree-2 read-committed)
- :dirty-read (or dirty-read read-uncommitted))
- *errno-buffer*))
- (errno (deref-array *errno-buffer* '(:array :int) 0)))
- (declare (type pointer-void curs)
- (type fixnum errno))
- (if (= errno 0) curs
- (error 'db-error :errno errno))))
+ (type boolean degree-2 read-committed dirty-read read-uncommitted))
+ (let ((errno-buffer (allocate-foreign-object :int 1)))
+ (declare (type pointer-int errno-buffer))
+ (let* ((curs (%db-cursor db transaction
+ (flags :degree-2 (or degree-2 read-committed)
+ :dirty-read (or dirty-read read-uncommitted))
+ errno-buffer))
+ (errno (deref-array errno-buffer '(:array :int) 0)))
+ (declare (type pointer-void curs)
+ (type fixnum errno))
+ (if (= errno 0) curs
+ (error 'db-error :errno errno)))))
(def-function ("db_cursor_close" %db-cursor-close)
((cursor :pointer-void))
@@ -1005,13 +1006,15 @@
(defun db-cursor-duplicate (cursor &key (position t))
"Duplicate a cursor."
(declare (type pointer-void cursor))
- (let* ((newc (%db-cursor-dup cursor (flags :position position)
- *errno-buffer*))
- (errno (deref-array *errno-buffer* '(:array :int) 0)))
- (declare (type pointer-void newc)
- (type fixnum errno))
- (if (= errno 0) newc
- (error 'db-error :errno errno))))
+ (let ((errno-buffer (allocate-foreign-object :int 1)))
+ (declare (type pointer-int errno-buffer))
+ (let* ((newc (%db-cursor-dup cursor (flags :position position)
+ errno-buffer))
+ (errno (deref-array errno-buffer '(:array :int) 0)))
+ (declare (type pointer-void newc)
+ (type fixnum errno))
+ (if (= errno 0) newc
+ (error 'db-error :errno errno)))))
(def-function ("db_cursor_get_raw" %db-cursor-get-key-buffered)
((cursor :pointer-void)
@@ -1377,35 +1380,35 @@
(errno (* :int)))
:returning :pointer-void)
-(defun db-transaction-begin (env &key (parent *current-transaction*)
+(defun db-transaction-begin (env &key parent
degree-2 read-committed dirty-read read-uncommitted
txn-nosync txn-nowait txn-sync)
"Start a transaction. Transactions may be nested."
(declare (type pointer-void env parent)
(type boolean degree-2 read-committed dirty-read read-uncommitted
- txn-nosync txn-nowait txn-sync)
- (type pointer-int *errno-buffer*))
- (let* ((txn
- (%db-txn-begin env parent
- (flags :degree-2 (or degree-2 read-committed)
- :dirty-read (or dirty-read read-uncommitted)
- :txn-nosync txn-nosync
- :txn-nowait txn-nowait
- :txn-sync txn-sync)
- *errno-buffer*))
- (errno (deref-array *errno-buffer* '(:array :int) 0)))
- (declare (type pointer-void txn)
- (type fixnum errno))
- (if (= errno 0)
- txn
- (error 'db-error :errno errno))))
+ txn-nosync txn-nowait txn-sync))
+ (let ((errno-buffer (allocate-foreign-object :int 1)))
+ (declare (type pointer-int errno-buffer))
+ (let* ((txn
+ (%db-txn-begin env parent
+ (flags :degree-2 (or degree-2 read-committed)
+ :dirty-read (or dirty-read read-uncommitted)
+ :txn-nosync txn-nosync
+ :txn-nowait txn-nowait
+ :txn-sync txn-sync)
+ errno-buffer))
+ (errno (deref-array errno-buffer '(:array :int) 0)))
+ (declare (type pointer-void txn)
+ (type fixnum errno))
+ (if (= errno 0)
+ txn
+ (error 'db-error :errno errno)))))
(def-function ("db_txn_abort" %db-txn-abort)
((txn :pointer-void))
:returning :int)
(wrap-errno (db-transaction-abort %db-txn-abort) (transaction)
- :keys ((transaction *current-transaction*))
:declarations (declare (type pointer-void transaction))
:documentation "Abort a transaction.")
@@ -1415,106 +1418,18 @@
:returning :int)
(wrap-errno (db-transaction-commit %db-txn-commit) (transaction flags)
- :keys ((transaction *current-transaction*))
:flags (txn-nosync txn-sync)
:declarations (declare (type pointer-void transaction)
(type boolean txn-nosync txn-sync))
:documentation "Commit a transaction.")
-#|
-(defmacro with-transaction ((&key transaction environment
- (parent '*current-transaction*)
- (retries 100)
- dirty-read read-uncommitted
- txn-nosync txn-nowait txn-sync)
- &body body)
[208 lines skipped]
