[elephant-cvs] CVS elephant/src/db-bdb
ieslick
ieslick at common-lisp.net
Wed Jan 31 20:05:38 UTC 2007
Update of /project/elephant/cvsroot/elephant/src/db-bdb
In directory clnet:/tmp/cvs-serv24260/src/db-bdb
Modified Files:
bdb-collections.lisp bdb-controller.lisp berkeley-db.lisp
libberkeley-db.c
Removed Files:
bdb-symbol-tables.lisp
Log Message:
Upgrade to BDB 4.5; green on Allegro 8.0/Mac OS X
--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2006/12/16 19:35:10 1.11
+++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2007/01/31 20:05:37 1.12
@@ -19,6 +19,8 @@
(in-package :db-bdb)
+(declaim #-elephant-without-optimize (optimize (speed 3) (safety 1) (space 0) (debug 0)))
+
(defclass bdb-btree (btree) ()
(:documentation "A BerkleyDB implementation of a BTree"))
@@ -32,7 +34,6 @@
(make-instance 'bdb-btree :sc sc))
(defmethod get-value (key (bt bdb-btree))
- (declare (optimize (speed 3) (space 0) (safety 0)))
(let ((sc (get-con bt)))
(with-buffer-streams (key-buf value-buf)
(buffer-write-int (oid bt) key-buf)
@@ -43,7 +44,6 @@
(values nil nil))))))
(defmethod existsp (key (bt bdb-btree))
- (declare (optimize (speed 3) (safety 0) (space 0)))
(with-buffer-streams (key-buf value-buf)
(buffer-write-int (oid bt) key-buf)
(serialize key key-buf (get-con bt))
@@ -55,8 +55,6 @@
(defmethod (setf get-value) (value key (bt bdb-btree))
- (declare (optimize (speed 3) (safety 0) (space 0)))
- (assert (or *auto-commit* (not (eq *current-transaction* 0))))
;; (with-transaction ()
(let ((sc (get-con bt)))
(with-buffer-streams (key-buf value-buf)
@@ -64,8 +62,7 @@
(serialize key key-buf sc)
(serialize value value-buf sc)
(db-put-buffered (controller-btrees sc)
- key-buf value-buf
- :auto-commit *auto-commit*)))
+ key-buf value-buf)))
;; )
value)
@@ -85,15 +82,13 @@
;; (write-value))))
(defmethod remove-kv (key (bt bdb-btree))
- (declare (optimize (speed 3) (space 0) (safety 0)))
- (assert (or *auto-commit* (not (eq *current-transaction* 0))))
;; (with-transaction (:store-controller (get-con bt))
(let ((sc (get-con bt)) )
(with-buffer-streams (key-buf)
(buffer-write-int (oid bt) key-buf)
(serialize key key-buf sc)
(db-delete-buffered (controller-btrees sc)
- key-buf :auto-commit *auto-commit*))))
+ key-buf))))
;; Secondary indices
@@ -216,7 +211,6 @@
(defmethod remove-kv (key (bt bdb-indexed-btree))
"Remove a key / value pair, and update secondary indices."
- (declare (optimize (speed 3)))
(let ((sc (get-con bt)))
(with-buffer-streams (key-buf secondary-buf)
(buffer-write-int (oid bt) key-buf)
@@ -252,7 +246,6 @@
(defmethod get-value (key (bt bdb-btree-index))
"Get the value in the primary DB from a secondary key."
- (declare (optimize (speed 3)))
(with-buffer-streams (key-buf value-buf)
(buffer-write-int (oid bt) key-buf)
(serialize key key-buf (get-con bt))
@@ -263,7 +256,6 @@
(values nil nil)))))
(defmethod get-primary-key (key (bt btree-index))
- (declare (optimize (speed 3)))
(let ((sc (get-con bt)))
(with-buffer-streams (key-buf value-buf)
(buffer-write-int (oid bt) key-buf)
@@ -282,19 +274,16 @@
(defmethod make-cursor ((bt bdb-btree))
"Make a cursor from a btree."
- (declare (optimize (speed 3)))
(make-instance 'bdb-cursor
:btree bt
:handle (db-cursor (controller-btrees (get-con bt)))
:oid (oid bt)))
(defmethod cursor-close ((cursor bdb-cursor))
- (declare (optimize (speed 3)))
(db-cursor-close (cursor-handle cursor))
(setf (cursor-initialized-p cursor) nil))
(defmethod cursor-duplicate ((cursor bdb-cursor))
- (declare (optimize (speed 3)))
(make-instance (type-of cursor)
:initialized-p (cursor-initialized-p cursor)
:oid (cursor-oid cursor)
@@ -303,7 +292,6 @@
:position (cursor-initialized-p cursor))))
(defmethod cursor-current ((cursor bdb-cursor))
- (declare (optimize (speed 3)))
(when (cursor-initialized-p cursor)
(let ((sc (get-con (cursor-btree cursor))))
(with-buffer-streams (key-buf value-buf)
@@ -317,7 +305,6 @@
(setf (cursor-initialized-p cursor) nil)))))))
(defmethod cursor-first ((cursor bdb-cursor))
- (declare (optimize (speed 3)))
(let ((sc (get-con (cursor-btree cursor))))
(with-buffer-streams (key-buf value-buf)
(buffer-write-int (cursor-oid cursor) key-buf)
@@ -333,7 +320,6 @@
;;A bit of a hack.....
(defmethod cursor-last ((cursor bdb-cursor))
- (declare (optimize (speed 3)))
(let ((sc (get-con (cursor-btree cursor))))
(with-buffer-streams (key-buf value-buf)
(buffer-write-int (+ (cursor-oid cursor) 1) key-buf)
@@ -361,7 +347,6 @@
(setf (cursor-initialized-p cursor) nil)))))))
(defmethod cursor-next ((cursor bdb-cursor))
- (declare (optimize (speed 3)))
(if (cursor-initialized-p cursor)
(let ((sc (get-con (cursor-btree cursor))))
(with-buffer-streams (key-buf value-buf)
@@ -375,7 +360,6 @@
(cursor-first cursor)))
(defmethod cursor-prev ((cursor bdb-cursor))
- (declare (optimize (speed 3)))
(if (cursor-initialized-p cursor)
(let ((sc (get-con (cursor-btree cursor))))
(with-buffer-streams (key-buf value-buf)
@@ -389,7 +373,6 @@
(cursor-last cursor))))
(defmethod cursor-set ((cursor bdb-cursor) key)
- (declare (optimize (speed 3)))
(let ((sc (get-con (cursor-btree cursor))))
(with-buffer-streams (key-buf value-buf)
(buffer-write-int (cursor-oid cursor) key-buf)
@@ -404,7 +387,6 @@
(setf (cursor-initialized-p cursor) nil))))))
(defmethod cursor-set-range ((cursor bdb-cursor) key)
- (declare (optimize (speed 3)))
(let ((sc (get-con (cursor-btree cursor))))
(with-buffer-streams (key-buf value-buf)
(buffer-write-int (cursor-oid cursor) key-buf)
@@ -419,7 +401,6 @@
(setf (cursor-initialized-p cursor) nil))))))
(defmethod cursor-get-both ((cursor bdb-cursor) key value)
- (declare (optimize (speed 3)))
(let ((sc (get-con (cursor-btree cursor))))
(with-buffer-streams (key-buf value-buf)
(buffer-write-int (cursor-oid cursor) key-buf)
@@ -435,7 +416,6 @@
(setf (cursor-initialized-p cursor) nil))))))
(defmethod cursor-get-both-range ((cursor bdb-cursor) key value)
- (declare (optimize (speed 3)))
(let ((sc (get-con (cursor-btree cursor))))
(with-buffer-streams (key-buf value-buf)
(buffer-write-int (cursor-oid cursor) key-buf)
@@ -450,7 +430,6 @@
(setf (cursor-initialized-p cursor) nil))))))
(defmethod cursor-delete ((cursor bdb-cursor))
- (declare (optimize (speed 3)))
(if (cursor-initialized-p cursor)
(with-buffer-streams (key-buf value-buf)
(multiple-value-bind (key val)
@@ -469,7 +448,6 @@
"Put by cursor. Not particularly useful since primaries
don't support duplicates. Currently doesn't properly move
the cursor."
- (declare (optimize (speed 3)))
(if key-specified-p
(setf (get-value key (cursor-btree cursor)) value)
(if (cursor-initialized-p cursor)
@@ -493,7 +471,6 @@
(defmethod make-cursor ((bt bdb-btree-index))
"Make a secondary-cursor from a secondary index."
- (declare (optimize (speed 3)))
(make-instance 'bdb-secondary-cursor
:btree bt
:handle (db-cursor
@@ -502,7 +479,6 @@
(defmethod cursor-pcurrent ((cursor bdb-secondary-cursor))
- (declare (optimize (speed 3)))
(when (cursor-initialized-p cursor)
(with-buffer-streams (key-buf pkey-buf value-buf)
(multiple-value-bind (key pkey val)
@@ -519,7 +495,6 @@
(setf (cursor-initialized-p cursor) nil))))))
(defmethod cursor-pfirst ((cursor bdb-secondary-cursor))
- (declare (optimize (speed 3)))
(with-buffer-streams (key-buf pkey-buf value-buf)
(buffer-write-int (cursor-oid cursor) key-buf)
(multiple-value-bind (key pkey val)
@@ -536,7 +511,6 @@
;;A bit of a hack.....
(defmethod cursor-plast ((cursor bdb-secondary-cursor))
- (declare (optimize (speed 3)))
(let ((sc (get-con (cursor-btree cursor))))
(with-buffer-streams (key-buf pkey-buf value-buf)
(buffer-write-int (+ (cursor-oid cursor) 1) key-buf)
@@ -568,7 +542,6 @@
(setf (cursor-initialized-p cursor) nil)))))))
(defmethod cursor-pnext ((cursor bdb-secondary-cursor))
- (declare (optimize (speed 3)))
(if (cursor-initialized-p cursor)
(with-buffer-streams (key-buf pkey-buf value-buf)
(multiple-value-bind (key pkey val)
@@ -583,7 +556,6 @@
(cursor-pfirst cursor)))
(defmethod cursor-pprev ((cursor bdb-secondary-cursor))
- (declare (optimize (speed 3)))
(if (cursor-initialized-p cursor)
(with-buffer-streams (key-buf pkey-buf value-buf)
(multiple-value-bind (key pkey val)
@@ -598,7 +570,6 @@
(cursor-plast cursor)))
(defmethod cursor-pset ((cursor bdb-secondary-cursor) key)
- (declare (optimize (speed 3)))
(let ((sc (get-con (cursor-btree cursor))))
(with-buffer-streams (key-buf pkey-buf value-buf)
(buffer-write-int (cursor-oid cursor) key-buf)
@@ -615,7 +586,6 @@
(setf (cursor-initialized-p cursor) nil))))))
(defmethod cursor-pset-range ((cursor bdb-secondary-cursor) key)
- (declare (optimize (speed 3)))
(let ((sc (get-con (cursor-btree cursor))))
(with-buffer-streams (key-buf pkey-buf value-buf)
(buffer-write-int (cursor-oid cursor) key-buf)
@@ -631,7 +601,6 @@
(setf (cursor-initialized-p cursor) nil))))))
(defmethod cursor-pget-both ((cursor bdb-secondary-cursor) key pkey)
- (declare (optimize (speed 3)))
(with-buffer-streams (key-buf pkey-buf value-buf)
(let ((primary-oid (oid (primary (cursor-btree cursor))))
(sc (get-con (cursor-btree cursor))))
@@ -649,7 +618,6 @@
(setf (cursor-initialized-p cursor) nil))))))
(defmethod cursor-pget-both-range ((cursor bdb-secondary-cursor) key pkey)
- (declare (optimize (speed 3)))
(with-buffer-streams (key-buf pkey-buf value-buf)
(let ((primary-oid (oid (primary (cursor-btree cursor))))
(sc (get-con (cursor-btree cursor))))
@@ -668,7 +636,6 @@
(defmethod cursor-delete ((cursor bdb-secondary-cursor))
"Delete by cursor: deletes ALL secondary indices."
- (declare (optimize (speed 3)))
(if (cursor-initialized-p cursor)
(with-buffer-streams (key-buf pkey-buf value-buf)
(multiple-value-bind (key pkey val)
@@ -706,7 +673,6 @@
(error "Puts are forbidden on secondary indices. Try adding to the primary."))
(defmethod cursor-next-dup ((cursor bdb-secondary-cursor))
- (declare (optimize (speed 3)))
(when (cursor-initialized-p cursor)
(with-buffer-streams (key-buf value-buf)
(multiple-value-bind (key val)
@@ -718,7 +684,6 @@
(setf (cursor-initialized-p cursor) nil))))))
(defmethod cursor-next-nodup ((cursor bdb-secondary-cursor))
- (declare (optimize (speed 3)))
(if (cursor-initialized-p cursor)
(with-buffer-streams (key-buf value-buf)
(multiple-value-bind (key val)
@@ -731,7 +696,6 @@
(cursor-first cursor)))
(defmethod cursor-prev-nodup ((cursor bdb-secondary-cursor))
- (declare (optimize (speed 3)))
(if (cursor-initialized-p cursor)
(with-buffer-streams (key-buf value-buf)
(multiple-value-bind (key val)
@@ -744,7 +708,6 @@
(cursor-last cursor)))
(defmethod cursor-pnext-dup ((cursor bdb-secondary-cursor))
- (declare (optimize (speed 3)))
(when (cursor-initialized-p cursor)
(with-buffer-streams (key-buf pkey-buf value-buf)
(multiple-value-bind (key pkey val)
@@ -757,7 +720,6 @@
(setf (cursor-initialized-p cursor) nil))))))
(defmethod cursor-pnext-nodup ((cursor bdb-secondary-cursor))
- (declare (optimize (speed 3)))
(if (cursor-initialized-p cursor)
(with-buffer-streams (key-buf pkey-buf value-buf)
(multiple-value-bind (key pkey val)
@@ -771,16 +733,15 @@
(cursor-pfirst cursor)))
(defmethod cursor-pprev-nodup ((cursor bdb-secondary-cursor))
- (declare (optimize (speed 3)))
(if (cursor-initialized-p cursor)
(with-buffer-streams (key-buf pkey-buf value-buf)
(multiple-value-bind (key pkey val)
(db-cursor-pmove-buffered (cursor-handle cursor) key-buf
pkey-buf value-buf :prev-nodup t)
(if (and key (= (buffer-read-int key) (cursor-oid cursor)))
- (values t (deserialize key (get-con (cursor-btree cursor)))
+ (values t (deserialize key (get-con (cursor-btree cursor)))
(deserialize val (get-con (cursor-btree cursor)))
- (progn (buffer-read-int pkey)
+ (progn (buffer-read-int pkey)
(deserialize pkey (get-con (cursor-btree cursor)))))
(setf (cursor-initialized-p cursor) nil))))
(cursor-plast cursor)))
--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/01/26 14:41:08 1.16
+++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/01/31 20:05:37 1.17
@@ -19,6 +19,8 @@
(in-package :db-bdb)
+(declaim #-elephant-without-optimize (optimize (speed 3) (safety 1) (space 0) (debug 0)))
+
(defclass bdb-store-controller (store-controller)
((db :type (or null pointer-void) :accessor controller-db :initform '())
(environment :type (or null pointer-void)
@@ -61,15 +63,15 @@
;; Open/close
;;
-(defmethod open-controller ((sc bdb-store-controller) &key (recover t)
- (recover-fatal nil) (thread t)
+(defmethod open-controller ((sc bdb-store-controller) &key (recover nil)
+ (recover-fatal nil) (thread t) (errfile nil)
(deadlock-detect nil))
(let ((env (db-env-create)))
- ;; thread stuff?
(setf (controller-environment sc) env)
+ (db-env-set-flags env 0 :auto-commit t)
(db-env-open env (namestring (second (controller-spec sc)))
- :create t :init-txn t :init-lock t
- :init-mpool t :init-log t :thread thread
+ :create t :init-rep nil :init-mpool t :thread thread
+ :init-lock t :init-log t :init-txn t
:recover recover :recover-fatal recover-fatal
)
(db-env-set-timeout env 100000 :set-transaction-timeout t)
@@ -99,7 +101,7 @@
(db-bdb::db-set-lisp-dup-compare indices-assoc (controller-serializer-version sc))
(db-set-flags indices-assoc :dup-sort t)
(db-open indices-assoc :file "%ELEPHANT" :database "%ELEPHANTINDICES"
- :auto-commit t :type DB-UNKNOWN :thread thread :rdonly t)
+ :auto-commit t :type DB-UNKNOWN :thread thread) ;; :rdonly t)
(db-bdb::db-fake-associate btrees indices-assoc :auto-commit t)
(let ((db (db-create env)))
@@ -134,18 +136,14 @@
(setf (slot-value sc 'class-root)
(make-instance 'bdb-btree :from-oid -2 :sc sc))
+ (when errfile
+ (db-set-error-file (controller-db sc) errfile))
+
(when deadlock-detect
(start-deadlock-detector sc))
sc)))
-;; NOTE: This was the easist way to do this. A BDB hash table would be better
-;; and perhaps generally a better thing to export; however I don't want to
-;; go through the effort at this time.
-
-(defparameter *symbol-to-id-table-oid* -3)
-(defparameter *id-to-symbol-table-oid* -4)
-
(defmethod close-controller ((sc bdb-store-controller))
(when (slot-value sc 'root)
(stop-deadlock-detector sc)
--- /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2007/01/22 22:22:35 1.4
+++ /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2007/01/31 20:05:37 1.5
@@ -77,80 +77,85 @@
;; eventually write a macro which generates a custom flag function.
;;
-;I don't like the UFFI syntax for enumerations
+;; Current header file version required: Berkeley DB 4.5
+
+;; I don't like the UFFI syntax for enumerations
(defconstant DB-BTREE 1)
(defconstant DB-HASH 2)
(defconstant DB-RECNO 3)
(defconstant DB-QUEUE 4)
(defconstant DB-UNKNOWN 5)
-(defconstant DB_CREATE #x00000001)
(defconstant DB_LOCK_NOWAIT #x00000002)
+
+(defconstant DB_CREATE #x00000001)
(defconstant DB_FORCE #x00000004)
-(defconstant DB_NOMMAP #x00000008)
-(defconstant DB_RDONLY #x00000010)
-(defconstant DB_RECOVER #x00000020)
-(defconstant DB_THREAD #x00000040)
-(defconstant DB_TRUNCATE #x00000080)
-(defconstant DB_TXN_NOSYNC #x00000100)
-(defconstant DB_EXCL #x00002000)
+(defconstant DB_MULTIVERSION #x00000008)
+(defconstant DB_NOMMAP #x00000010)
+(defconstant DB_RDONLY #x00000020)
+(defconstant DB_RECOVER #x00000040)
+(defconstant DB_THREAD #x00000080)
+(defconstant DB_TRUNCATE #x00000100)
+(defconstant DB_TXN_NOSYNC #x00000200)
+(defconstant DB_TXN_NOT_DURABLE #x00000400)
+(defconstant DB_TXN_WRITE_NOSYNC #x00000800)
+
+(defconstant DB_EXCL #x00004000)
-(defconstant DB_TXN_NOWAIT #x00002000)
-(defconstant DB_TXN_SYNC #x00004000)
+(defconstant DB_TXN_NOWAIT #x00004000)
+(defconstant DB_TXN_SYNC #x00008000)
-(defconstant DB_DUP #x00004000)
-(defconstant DB_DUPSORT #x00008000)
+(defconstant DB_DUP #x00008000)
+(defconstant DB_DUPSORT #x00010000)
(defconstant DB_JOINENV #x00000000)
-(defconstant DB_INIT_CDB #x00002000)
-(defconstant DB_INIT_LOCK #x00004000)
-(defconstant DB_INIT_LOG #x00008000)
-(defconstant DB_INIT_MPOOL #x00010000)
-(defconstant DB_INIT_REP #x00020000)
-(defconstant DB_INIT_TXN #x00040000)
-(defconstant DB_LOCKDOWN #x00080000)
-(defconstant DB_PRIVATE #x00100000)
-(defconstant DB_RECOVER_FATAL #x00200000)
-(defconstant DB_SYSTEM_MEM #x00800000)
-(defconstant DB_AUTO_COMMIT #x01000000)
-(defconstant DB_READ_COMMITTED #x02000000)
-(defconstant DB_DEGREE_2 #x02000000) ;; DEPRECATED, now called DB_READ_COMMITTED
-(defconstant DB_READ_UNCOMMITTED #x04000000)
-(defconstant DB_DIRTY_READ #x04000000) ;; DEPRECATED, now called DB_READ_UNCOMMITTED
-
-(defconstant DB_CURRENT 7)
-(defconstant DB_FIRST 9)
-(defconstant DB_GET_BOTH 10)
-(defconstant DB_GET_BOTH_RANGE 12)
-(defconstant DB_LAST 17)
-(defconstant DB_NEXT 18)
-(defconstant DB_NEXT_DUP 19)
-(defconstant DB_NEXT_NODUP 20)
-(defconstant DB_PREV 25)
-(defconstant DB_PREV_NODUP 26)
-(defconstant DB_SET 28)
-(defconstant DB_SET_RANGE 30)
+(defconstant DB_INIT_CDB #x00004000)
+(defconstant DB_INIT_LOCK #x00008000)
+(defconstant DB_INIT_LOG #x00010000)
+(defconstant DB_INIT_MPOOL #x00020000)
+(defconstant DB_INIT_REP #x00040000)
+(defconstant DB_INIT_TXN #x00080000)
+(defconstant DB_LOCKDOWN #x00100000)
+(defconstant DB_PRIVATE #x00200000)
+(defconstant DB_RECOVER_FATAL #x00400000)
+(defconstant DB_REGISTER #x00800000)
+(defconstant DB_SYSTEM_MEM #x01000000)
+(defconstant DB_AUTO_COMMIT #x02000000)
+(defconstant DB_READ_COMMITTED #x04000000)
+(defconstant DB_DEGREE_2 #x04000000) ;; DEPRECATED, now called DB_READ_COMMITTED
+(defconstant DB_READ_UNCOMMITTED #x08000000)
+(defconstant DB_DIRTY_READ #x08000000) ;; DEPRECATED, now called DB_READ_UNCOMMITTED
(defconstant DB_AFTER 1)
(defconstant DB_BEFORE 3)
-(defconstant DB_KEYFIRST 15)
-(defconstant DB_KEYLAST 16)
+(defconstant DB_CURRENT 6)
+(defconstant DB_FIRST 7)
+(defconstant DB_GET_BOTH 8)
+(defconstant DB_GET_BOTH_RANGE 10)
+(defconstant DB_LAST 15)
+(defconstant DB_NEXT 16)
+(defconstant DB_NEXT_DUP 17)
+(defconstant DB_NEXT_NODUP 18)
+(defconstant DB_PREV 23)
+(defconstant DB_PREV_NODUP 24)
+(defconstant DB_SET 25)
+(defconstant DB_SET_RANGE 27)
+
+(defconstant DB_NODUPDATA 19)
+(defconstant DB_NOOVERWRITE 20)
+(defconstant DB_NOSYNC 21)
-(defconstant DB_NODUPDATA 21)
-(defconstant DB_NOOVERWRITE 22)
-(defconstant DB_NOSYNC 23)
-
-(defconstant DB_POSITION 24)
+(defconstant DB_POSITION 22)
(defconstant DB_SEQ_DEC #x00000001)
(defconstant DB_SEQ_INC #x00000002)
(defconstant DB_SEQ_WRAP #x00000008)
-(defconstant DB_SET_LOCK_TIMEOUT 29)
-(defconstant DB_SET_TXN_TIMEOUT 33)
+(defconstant DB_SET_LOCK_TIMEOUT 26)
+(defconstant DB_SET_TXN_TIMEOUT 30)
-(defconstant DB_FREELIST_ONLY #x00002000)
-(defconstant DB_FREE_SPACE #x00004000)
+(defconstant DB_FREELIST_ONLY #x00004000)
+(defconstant DB_FREE_SPACE #x00008000)
(defconstant DB_KEYEMPTY -30997)
(defconstant DB_KEYEXIST -30996)
@@ -256,7 +261,7 @@
(documentation nil)
(transaction nil))
(let ((wname (if (listp names) (first names) names))
- (fname (if (listp names) (second names)
+ (fname (if (listp names) (second names)
(intern (concatenate 'string "%" (symbol-name names)))))
(wrapper-args (make-wrapper-args args flags keys))
(fun-args (make-fun-args args flags))
@@ -480,6 +485,14 @@
:flags (force)
:documentation "Make a checkpoint.")
+(def-function ("db_set_error_file" %db-set-error-file)
+ ((db :pointer-void)
+ (file :cstring)))
+
+(defun db-set-error-file (db filename)
+ (with-cstrings ((fname filename))
+ (%db-set-error-file db fname)))
+
;; Database
(eval-when (:compile-toplevel :load-toplevel)
@@ -1882,8 +1895,7 @@
:returning :int)
(defun next-counter (env db parent key key-size lockid lockid-size)
- "Get the next element in the counter. To be deprecated
-when 4.3 is released."
+ "Get the next element in the counter. To be deprecated when 4.3 is released."
(let ((ret (%next-counter env db parent key key-size lockid lockid-size)))
(if (< ret 0)
(error 'db-error :errno ret)
--- /project/elephant/cvsroot/elephant/src/db-bdb/libberkeley-db.c 2007/01/22 16:17:43 1.6
+++ /project/elephant/cvsroot/elephant/src/db-bdb/libberkeley-db.c 2007/01/31 20:05:37 1.7
@@ -56,6 +56,7 @@
*/
#include <stdint.h>
+#include <stdio.h>
#include <string.h>
#include <wchar.h>
@@ -173,7 +174,7 @@
DB_ENV *db_env_cr(u_int32_t flags, int *errno) {
DB_ENV *envp;
*errno = db_env_create(&envp, flags);
- return envp;
+ return envp;
}
char * db_strerr(int error) {
@@ -215,6 +216,7 @@
return dbenv->txn_checkpoint(dbenv, kbyte, min, flags);
}
+
/* Database */
DB *db_cr(DB_ENV *dbenv, u_int32_t flags, int *errno) {
@@ -265,6 +267,10 @@
return db->get_pagesize(db, pagesizep);
}
+void db_set_error_file(DB *db, char *filename) {
+ return db->set_errfile(db, fopen(filename, "w+"));
+}
+
/* Accessors */
/* We manage our own buffers (DB_DBT_USERMEM). */
More information about the Elephant-cvs
mailing list