[elephant-cvs] CVS elephant/src/db-bdb
ieslick
ieslick at common-lisp.net
Mon Sep 4 00:09:15 UTC 2006
Update of /project/elephant/cvsroot/elephant/src/db-bdb
In directory clnet:/tmp/cvs-serv14802/src/db-bdb
Modified Files:
bdb-controller.lisp libsleepycat.c sleepycat.lisp
Log Message:
Berkeley DB Backend upgrade & compact API fn, bug fixes
--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2006/07/21 16:28:17 1.10
+++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2006/09/04 00:09:12 1.11
@@ -65,7 +65,8 @@
(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
- :recover recover :recover-fatal recover-fatal)
+ :recover recover :recover-fatal recover-fatal
+ )
(db-env-set-timeout env 100000 :set-transaction-timeout t)
(db-env-set-timeout env 100000 :set-lock-timeout t)
(let ((db (db-create env))
@@ -205,6 +206,22 @@
#+(and (not allegro) port) (port:run-prog "kill" :wait t :args (list "-9" (format nil "~A" pid)))
#+(and sbcl linux) (sb-ext:process-kill "/bin/kill" (list "-9" (format nil "~A" pid))))
+(defmethod optimize-storage ((ctrl bdb-store-controller) &key start-key stop-key
+ (freelist-only nil) (free-space t)
+ &allow-other-keys)
+ "Tell the backend to optimize storage between key values"
+ (with-buffer-streams (start stop end)
+ (if (null start)
+ (db-compact (controller-db ctrl) nil nil end)
+ (progn
+ (serialize start-key start)
+ (db-compact (controller-db ctrl) start
+ (when stop-key (serialize stop-key stop) stop)
+ end
+ :freelist-only freelist-only
+ :free-space free-space)))
+ (values (deserialize end :sc ctrl))))
+
;;
;; Persistent slot protocol
;;
@@ -216,7 +233,7 @@
(serialize name key-buf)
(let ((buf (db-get-key-buffered (controller-db sc)
key-buf value-buf)))
- (if buf (deserialize buf :sc sc)
+ (if buf (deserialize buf :sc sc)
#+cmu
(error 'unbound-slot :instance instance :slot name)
#-cmu
--- /project/elephant/cvsroot/elephant/src/db-bdb/libsleepycat.c 2006/02/19 04:53:00 1.1
+++ /project/elephant/cvsroot/elephant/src/db-bdb/libsleepycat.c 2006/09/04 00:09:12 1.2
@@ -543,6 +543,40 @@
return db->del(db, txnid, &DBTKey, flags);
}
+int db_compact(DB *db, DB_TXN *txnid,
+ char *start, u_int32_t start_size,
+ char *stop, u_int32_t stop_size,
+ u_int32_t flags,
+ char *end, u_int32_t end_length,
+ u_int32_t *end_size) {
+ DBT DBTStart, DBTStop, DBTEnd;
+ int errno;
+
+ memset(&DBTStart, 0, sizeof(DBT));
+ DBTStart.data = start;
+ DBTStart.size = start_size;
+
+ memset(&DBTStop, 0, sizeof(DBT));
+ DBTStop.data = stop;
+ DBTStop.size = stop_size;
+
+ memset(&DBTEnd, 0, sizeof(DBT));
+ DBTEnd.data = end;
+ DBTEnd.ulen = end_length;
+ DBTEnd.flags |= DB_DBT_USERMEM;
+
+ errno = db->compact(db, txnid,
+ &DBTStart,
+ &DBTStop,
+ NULL,
+ flags,
+ &DBTEnd);
+ *end_size = DBTEnd.size;
+
+ return errno;
+}
+
+
/* Cursors */
--- /project/elephant/cvsroot/elephant/src/db-bdb/sleepycat.lisp 2006/04/30 01:03:49 1.5
+++ /project/elephant/cvsroot/elephant/src/db-bdb/sleepycat.lisp 2006/09/04 00:09:12 1.6
@@ -118,34 +118,39 @@
(defconstant DB-QUEUE 4)
(defconstant DB-UNKNOWN 5)
-(defconstant DB_AUTO_COMMIT #x1000000)
-(defconstant DB_JOINENV #x0040000)
-(defconstant DB_INIT_CDB #x0001000)
-(defconstant DB_INIT_LOCK #x0002000)
-(defconstant DB_INIT_LOG #x0004000)
-(defconstant DB_INIT_MPOOL #x0008000)
-(defconstant DB_INIT_REP #x0010000)
-(defconstant DB_INIT_TXN #x0020000)
-(defconstant DB_RECOVER #x0000020)
-(defconstant DB_RECOVER_FATAL #x0200000)
-(defconstant DB_LOCKDOWN #x0080000)
-(defconstant DB_PRIVATE #x0100000)
-(defconstant DB_SYSTEM_MEM #x0400000)
-(defconstant DB_THREAD #x0000040)
-(defconstant DB_FORCE #x0000004)
-(defconstant DB_DEGREE_2 #x2000000)
-(defconstant DB_DIRTY_READ #x4000000)
-(defconstant DB_CREATE #x0000001)
-(defconstant DB_EXCL #x0001000)
-(defconstant DB_NOMMAP #x0000008)
-(defconstant DB_RDONLY #x0000010)
-(defconstant DB_TRUNCATE #x0000080)
-(defconstant DB_TXN_NOSYNC #x0000100)
-(defconstant DB_TXN_NOWAIT #x0001000)
-(defconstant DB_TXN_SYNC #x0002000)
-(defconstant DB_LOCK_NOWAIT #x002)
-(defconstant DB_DUP #x0000002)
-(defconstant DB_DUPSORT #x0000004)
+(defconstant DB_CREATE #x00000001)
+(defconstant DB_LOCK_NOWAIT #x00000002)
+(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_TXN_NOWAIT #x00002000)
+(defconstant DB_TXN_SYNC #x00004000)
+
+(defconstant DB_DUP #x00004000)
+(defconstant DB_DUPSORT #x00008000)
+
+(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)
@@ -175,10 +180,12 @@
(defconstant DB_SEQ_INC #x00000002)
(defconstant DB_SEQ_WRAP #x00000008)
-
(defconstant DB_SET_LOCK_TIMEOUT 29)
(defconstant DB_SET_TXN_TIMEOUT 33)
+(defconstant DB_FREELIST_ONLY #x00002000)
+(defconstant DB_FREE_SPACE #x00004000)
+
(defconstant DB_KEYEMPTY -30997)
(defconstant DB_KEYEXIST -30996)
(defconstant DB_LOCK_DEADLOCK -30995)
@@ -323,12 +330,12 @@
(defmacro flags (&key auto-commit joinenv init-cdb init-lock init-log
init-mpool init-rep init-txn recover recover-fatal lockdown
- private system-mem thread force degree-2 dirty-read create
- excl nommap
+ private system-mem thread force create excl nommap
+ degree-2 read-committed dirty-read read-uncommitted
rdonly truncate txn-nosync txn-nowait txn-sync lock-nowait
dup dup-sort current first get-both get-both-range last next
next-dup next-nodup prev prev-nodup set set-range
- after before keyfirst keylast
+ after before keyfirst keylast freelist-only free-space
no-dup-data no-overwrite nosync position
seq-dec seq-inc seq-wrap set-lock-timeout
set-transaction-timeout)
@@ -351,7 +358,9 @@
,@(when thread `((when ,thread (setq ,flags (logior ,flags DB_THREAD)))))
,@(when force `((when ,force (setq ,flags (logior ,flags DB_FORCE)))))
,@(when degree-2 `((when ,degree-2 (setq ,flags (logior ,flags DB_DEGREE_2)))))
+ ,@(when read-committed `((when ,read-committed (setq ,flags (logior ,flags DB_READ_COMMITTED)))))
,@(when dirty-read `((when ,dirty-read (setq ,flags (logior ,flags DB_DIRTY_READ)))))
+ ,@(when read-uncommitted `((when ,read-uncommitted (setq ,flags (logior ,flags DB_READ_UNCOMMITTED)))))
,@(when create `((when ,create (setq ,flags (logior ,flags DB_CREATE)))))
,@(when excl `((when ,excl (setq ,flags (logior ,flags DB_EXCL)))))
,@(when nommap `((when ,nommap (setq ,flags (logior ,flags DB_NOMMAP)))))
@@ -360,6 +369,8 @@
,@(when txn-nosync `((when ,txn-nosync (setq ,flags (logior ,flags DB_TXN_NOSYNC)))))
,@(when txn-nowait `((when ,txn-nowait (setq ,flags (logior ,flags DB_TXN_NOWAIT)))))
,@(when txn-sync `((when ,txn-sync (setq ,flags (logior ,flags DB_TXN_SYNC)))))
+ ,@(when freelist-only `((when ,freelist-only (setq ,flags (logior ,flags DB_FREELIST_ONLY)))))
+ ,@(when free-space `((when ,free-space (setq ,flags (logior ,flags DB_FREE_SPACE)))))
,@(when lock-nowait `((when ,lock-nowait (setq ,flags (logior ,flags DB_LOCK_NOWAIT)))))
,@(when dup `((when ,dup (setq ,flags (logior ,flags DB_DUP)))))
,@(when dup-sort `((when ,dup-sort (setq ,flags (logior ,flags DB_DUPSORT)))))
@@ -422,10 +433,11 @@
:returning :int)
(wrap-errno db-env-open (dbenvp home flags mode)
- :flags (joinenv init-cdb init-lock init-log
- init-mpool init-rep init-txn
- recover recover-fatal create
- lockdown private system-mem thread)
+ :flags (init-cdb init-lock init-log
+ init-mpool init-rep init-txn
+ recover recover-fatal create
+ lockdown private system-mem thread
+ )
:keys ((mode #o640))
:cstrings (home)
:documentation "Open an environment handle.")
@@ -531,8 +543,9 @@
:returning :int)
(wrap-errno db-open (db transaction file database type flags mode)
- :flags (auto-commit create dirty-read excl nommap
- rdonly thread truncate)
+ :flags (auto-commit create dirty-read read-uncommitted
+ excl nommap rdonly thread truncate
+ )
:keys ((transaction *current-transaction*)
(file +NULL-CHAR+)
(database +NULL-CHAR+)
@@ -624,7 +637,8 @@
(defun db-get-key-buffered (db key-buffer-stream value-buffer-stream
&key (transaction *current-transaction*)
- auto-commit get-both degree-2 dirty-read)
+ auto-commit 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
buffer-stream. On success the buffer-stream is returned for
@@ -632,7 +646,7 @@
(declare (optimize (speed 3) (safety 0))
(type pointer-void db transaction)
(type buffer-stream key-buffer-stream value-buffer-stream)
- (type boolean auto-commit get-both degree-2 dirty-read))
+ (type boolean auto-commit get-both degree-2 read-committed dirty-read read-uncommitted))
(loop
for value-length fixnum = (buffer-stream-length value-buffer-stream)
do
@@ -644,8 +658,8 @@
value-length
(flags :auto-commit auto-commit
:get-both get-both
- :degree-2 degree-2
- :dirty-read dirty-read))
+ :degree-2 (or degree-2 read-committed)
+ :dirty-read (or dirty-read read-uncommitted)))
(declare (type fixnum result-size errno))
(cond
((= errno 0)
@@ -674,7 +688,8 @@
(defun db-get-buffered (db key value-buffer-stream &key
(key-size (length key))
(transaction *current-transaction*)
- auto-commit get-both degree-2 dirty-read)
+ auto-commit 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
buffer-stream. On success the buffer-stream is returned for
@@ -684,19 +699,20 @@
(type string key)
(type buffer-stream value-buffer-stream)
(type fixnum key-size)
- (type boolean auto-commit get-both degree-2 dirty-read))
+ (type boolean auto-commit get-both degree-2 read-committed
+ dirty-read read-uncommitted))
(with-cstring (k key)
(loop
for value-length fixnum = (buffer-stream-length value-buffer-stream)
do
(multiple-value-bind (errno result-size)
(%db-get-buffered db transaction k key-size
- (buffer-stream-buffer value-buffer-stream)
+ (buffer-stream-buffer value-buffer-stream)
value-length
(flags :auto-commit auto-commit
:get-both get-both
- :degree-2 degree-2
- :dirty-read dirty-read))
+ :degree-2 (or degree-2 read-committed)
+ :dirty-read (or dirty-read read-uncommitted)))
(declare (type fixnum result-size errno))
(cond
((= errno 0)
@@ -713,7 +729,8 @@
(defun db-get (db key &key (key-size (length key))
(transaction *current-transaction*)
- auto-commit get-both degree-2 dirty-read)
+ auto-commit 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
is found, NIL is returned."
@@ -721,7 +738,8 @@
(type pointer-void db transaction)
(type string key)
(type fixnum key-size)
- (type boolean auto-commit get-both degree-2 dirty-read))
+ (type boolean auto-commit get-both degree-2 read-committed
+ dirty-read read-uncommitted))
(with-cstring (k key)
(with-buffer-streams (value-buffer-stream)
(loop
@@ -733,8 +751,8 @@
value-length
(flags :auto-commit auto-commit
:get-both get-both
- :degree-2 degree-2
- :dirty-read dirty-read))
+ :degree-2 (or degree-2 read-committed)
+ :dirty-read (or dirty-read read-uncommitted)))
(declare (type fixnum result-size errno))
(cond
((= errno 0)
@@ -904,6 +922,50 @@
(throw 'transaction transaction))
(t (error 'db-error :errno errno)))))
+;; Compaction for BDB 4.4
+
+(def-function ("db_compact" %db-compact)
+ ((db :pointer-void)
+ (txn :pointer-void)
+ (start array-or-pointer-char)
+ (start-size :unsigned-int)
+ (stop array-or-pointer-char)
+ (stop-size :unsigned-int)
+ (flags :unsigned-int)
+ (end array-or-pointer-char)
+ (end-length :unsigned-int)
+ (end-size :unsigned-int :out)))
+
+(defun db-compact (db start stop end &key (transaction *current-transaction*)
+ freelist-only free-space)
+ (declare (optimize (speed 3) (safety 2))
+ (type pointer-void db transaction)
+ (type buffer-stream start stop)
+ (type boolean freelist-only free-space))
+ (loop
+ for end-length fixnum = (buffer-stream-length end)
+ do
+ (multiple-value-bind (errno end-size)
+ (%db-compact db transaction
+ (if start (buffer-stream-buffer start) 0)
+ (if start (buffer-stream-size start) 0)
+ (if stop (buffer-stream-buffer stop) 0)
+ (if stop (buffer-stream-size stop) 0)
+ (flags :freelist-only freelist-only :free-space free-space)
+ (buffer-stream-buffer end)
+ (buffer-stream-length end))
+ (declare (type fixnum errno end-size))
+ (cond ((= errno 0)
+ (setf (buffer-stream-size end) end-size)
+ (return-from db-compact (the buffer-stream end)))
+ ((or (= errno DB_NOTFOUND) (= errno DB_KEYEMPTY))
+ (return-from db-compact nil))
+ ((or (= errno DB_LOCK_DEADLOCK) (= errno DB_LOCK_NOTGRANTED))
+ (throw 'transaction transaction))
+ ((> end-size end-length)
+ (resize-buffer-stream-no-copy end end-size))
+ (t (error 'db-error :errno errno))))))
+
;; Cursors
(def-function ("db_cursor" %db-cursor)
@@ -914,14 +976,14 @@
:returning :pointer-void)
(defun db-cursor (db &key (transaction *current-transaction*)
- degree-2 dirty-read)
+ degree-2 read-committed dirty-read read-uncommitted)
"Create a cursor."
(declare (optimize (speed 3) (safety 0))
(type pointer-void db)
- (type boolean degree-2 dirty-read)
+ (type boolean degree-2 read-committed dirty-read read-uncommitted)
(type pointer-int *errno-buffer*))
- (let* ((curs (%db-cursor db transaction (flags :degree-2 degree-2
- :dirty-read dirty-read)
+ (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)
@@ -990,7 +1052,7 @@
;; prev-nodup : sets nothing
(defun db-cursor-move-buffered (cursor key-buffer-stream value-buffer-stream
&key current first last next next-dup
- next-nodup prev prev-nodup dirty-read)
+ next-nodup prev prev-nodup dirty-read read-uncommitted)
"Move a cursor, returning the key / value pair found.
Supports current, first, last, next, next-dup, next-nodup,
prev, prev-nodup."
@@ -998,7 +1060,7 @@
(type pointer-void cursor)
(type buffer-stream key-buffer-stream value-buffer-stream)
(type boolean current first last next next-dup next-nodup prev
- prev-nodup dirty-read))
+ prev-nodup dirty-read read-uncommitted))
(loop
for key-length fixnum = (buffer-stream-length key-buffer-stream)
for value-length fixnum = (buffer-stream-length value-buffer-stream)
@@ -1017,7 +1079,7 @@
:next-nodup next-nodup
:prev prev
:prev-nodup prev-nodup
- :dirty-read dirty-read))
+ :dirty-read (or dirty-read read-uncommitted)))
(declare (type fixnum errno ret-key-size result-size))
(cond
((= errno 0)
@@ -1037,13 +1099,13 @@
;; set, set-range: sets key
(defun db-cursor-set-buffered (cursor key-buffer-stream value-buffer-stream
- &key set set-range dirty-read)
+ &key set set-range dirty-read read-uncommitted)
"Move a cursor to a key, returning the key / value pair
found. Supports set and set-range."
(declare (optimize (speed 3) (safety 0))
(type pointer-void cursor)
(type buffer-stream key-buffer-stream value-buffer-stream)
- (type boolean set set-range dirty-read))
+ (type boolean set set-range dirty-read read-uncommitted))
(loop
for key-length fixnum = (buffer-stream-length key-buffer-stream)
for value-length fixnum = (buffer-stream-length value-buffer-stream)
@@ -1057,7 +1119,7 @@
0 value-length
(flags :set set
:set-range set-range
- :dirty-read dirty-read))
+ :dirty-read (or dirty-read read-uncommitted)))
(declare (type fixnum errno ret-key-size result-size))
(cond
((= errno 0)
@@ -1078,13 +1140,13 @@
;; get-both, get-both-range : sets both
(defun db-cursor-get-both-buffered (cursor key-buffer-stream
value-buffer-stream
- &key get-both get-both-range dirty-read)
+ &key get-both get-both-range dirty-read read-uncommitted)
"Move a cursor to a key / value pair, returning the key /
value pair found. Supports get-both and get-both-range."
(declare (optimize (speed 3) (safety 0))
(type pointer-void cursor)
(type buffer-stream key-buffer-stream value-buffer-stream)
- (type boolean get-both get-both-range dirty-read))
+ (type boolean get-both get-both-range dirty-read read-uncommitted))
(loop
for key-length fixnum = (buffer-stream-length key-buffer-stream)
for value-length fixnum = (buffer-stream-length value-buffer-stream)
@@ -1099,7 +1161,7 @@
value-length
(flags :get-both get-both
:get-both-range get-both-range
- :dirty-read dirty-read))
+ :dirty-read (or dirty-read read-uncommitted)))
(declare (type fixnum errno ret-key-size result-size))
(cond
((= errno 0)
@@ -1345,18 +1407,18 @@
:returning :pointer-void)
(defun db-transaction-begin (env &key (parent *current-transaction*)
- degree-2 dirty-read txn-nosync txn-nowait
- txn-sync)
+ degree-2 read-committed dirty-read read-uncommitted
+ txn-nosync txn-nowait txn-sync)
"Start a transaction. Transactions may be nested."
(declare (optimize (speed 3) (safety 0))
[58 lines skipped]
More information about the Elephant-cvs
mailing list