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]