September 2006 - elephant-cvs@common-lisp.net

[elephant-cvs] CVS elephant/src/elephant
by ieslick 04 Sep '06

04 Sep '06

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv14802/src/elephant Modified Files: controller.lisp package.lisp serializer.lisp variables.lisp Log Message: Berkeley DB Backend upgrade & compact API fn, bug fixes --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2006/06/19 01:03:30 1.11 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2006/09/04 00:09:15 1.12 @@ -323,12 +323,19 @@ (:documentation "Provides a persistent source of unique id's")) +(defgeneric optimize-storage ((sc store-controller) &allow-other-keys) + (:documentation + "Tell the backend to reclaim any storage caused by key deletion, if possible. + This should default to return space to the filesystem rather than just to the free list.")) + ;; Handling dbconnection specs (defmethod close-controller :after ((sc store-controller)) "Delete connection spec so object ops on cached db info fail" (remhash (controller-spec sc) *dbconnection-spec*)) + + ;; Low-level support for metaclass protocol (defgeneric persistent-slot-reader (sc instance name) --- /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2006/04/26 17:53:44 1.1 +++ /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2006/09/04 00:09:15 1.2 @@ -31,7 +31,7 @@ #:store-controller #:open-store #:close-store #:with-open-store #:add-to-root #:get-from-root #:remove-from-root #:root-existsp - #:flush-instance-cache + #:flush-instance-cache #:optimize-storage #:with-transaction #:start-ele-transaction #:commit-transaction #:abort-transaction --- /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2006/07/21 16:32:45 1.9 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2006/09/04 00:09:15 1.10 @@ -14,7 +14,7 @@ ;;; (http://opensource.franz.com/preamble.html) also known as the LLGPL. ;;; -(in-package "ELEPHANT") +(in-package :elephant) (declaim (inline int-byte-spec ;serialize deserialize @@ -55,6 +55,7 @@ (defconstant +hash-table+ 17) (defconstant +object+ 18) (defconstant +array+ 19) +(defconstant +struct+ 20) (defconstant +fill-pointer-p+ #x40) (defconstant +adjustable-p+ #x80) @@ -62,21 +63,41 @@ (defun clear-circularity-hash () "This handles the case where we store an object with lots of object references. CLRHASH then starts to dominate - performance as it has to visit ever spot in the table so + performance as it has to visit every spot in the table so we're better off GCing the old table than clearing it" (declare (optimize (speed 3) (safety 0))) (if (> (hash-table-size *circularity-hash*) 100) (setf *circularity-hash* (make-hash-table :test 'eq :size 50)) (clrhash *circularity-hash*))) +(defvar *circularity-hash-queue* nil + "Circularity ids for the serializer.") + +(defvar *circularity-lock* + #+allegro (mp::make-process-lock)) + +(defun get-circularity-hash () + (if *circularity-hash-queue* + (#+allegro + mp::with-process-lock (*circularity-lock*) + (pop *circularity-hash-queue*)) + (make-hash-table :test 'eq :size 50))) + +(defun release-circularity-hash (hash) + (unless (> (hash-table-size hash) 100) + (clrhash hash) + (#+allegro + mp::with-process-lock (*circularity-lock*) + (push hash *circularity-hash-queue*)))) + (defun serialize (frob bs) "Serialize a lisp value into a buffer-stream." (declare (optimize (speed 3) (safety 0)) (type buffer-stream bs)) - (setq *lisp-obj-id* 0) - (clear-circularity-hash) - (labels - ((%serialize (frob) + (let ((*lisp-obj-id* 0) + (*circularity-hash* (get-circularity-hash))) + (labels + ((%serialize (frob) (declare (optimize (speed 3) (safety 0))) (etypecase frob (fixnum @@ -89,6 +110,7 @@ (declare (type string s) (dynamic-extent s)) (buffer-write-byte #+(and allegro ics) +;; +ucs2-symbol+ (etypecase s (base-string +ucs1-symbol+) ;; +ucs1-symbol+ (string +ucs2-symbol+)) @@ -223,6 +245,19 @@ (%serialize (/ (length svs) 2)) (loop for item in svs do (%serialize item))))))) +;; (structure-object +;; (buffer-write-byte +struct+ bs) +;; (let ((idp (gethash frob *circularity-hash*))) +;; (if idp (buffer-write-int idp bs) +;; (progn +;; (buffer-write-int (incf *lisp-obj-id*) bs) +;; (setf (gethash frbo *circularity-hash*) *lisp-obj-id*) +;; (%serialize (type-of frob)) +;; (let ((svs (slots-and-values frob))) +;; (declare (dynamic-extent svs)) +;; (%serialize (/ (length svs) 2)) +;; (loop for item in svs +;; do (%serialize item))))))) (array (buffer-write-byte +array+ bs) (let ((idp (gethash frob *circularity-hash*))) @@ -249,7 +284,8 @@ (%serialize (row-major-aref frob i))))))) ))) (%serialize frob) - bs)) + (release-circularity-hash *circularity-hash*) + bs))) (defun slots-and-values (o) (declare (optimize (speed 3) (safety 0))) @@ -268,12 +304,14 @@ "Deserialize a lisp value from a buffer-stream." (declare (optimize (speed 3) (safety 0)) (type (or null buffer-stream) buf-str)) - (labels + (let ((*circularity-hash* (get-circularity-hash))) + (labels ((%deserialize (bs) (declare (optimize (speed 3) (safety 0)) (type buffer-stream bs)) (let ((tag (buffer-read-byte bs))) (declare (type foreign-char tag)) +;; (format t "Tag: ~A~%" tag) (cond ((= tag +fixnum+) (buffer-read-fixnum bs)) @@ -416,9 +454,9 @@ (etypecase buf-str (null (return-from deserialize nil)) (buffer-stream - (setq *lisp-obj-id* 0) - (clear-circularity-hash) - (%deserialize buf-str))))) + (let ((result (%deserialize buf-str))) + (release-circularity-hash *circularity-hash*) + result)))))) (defun deserialize-bignum (bs length positive) (declare (optimize (speed 3) (safety 0)) --- /project/elephant/cvsroot/elephant/src/elephant/variables.lisp 2006/04/26 17:53:44 1.2 +++ /project/elephant/cvsroot/elephant/src/elephant/variables.lisp 2006/09/04 00:09:15 1.3 @@ -59,13 +59,6 @@ (defvar *current-transaction* +NULL-VOID+ "The transaction which is currently in effect.") -;; Stuff the serializer uses -(defvar *lisp-obj-id* 0 - "Circularity ids for the serializer.") - -(defvar *circularity-hash* (make-hash-table :test 'eq) - "Circularity hash for the serializer.") - #+(or cmu sbcl allegro) (defvar *resourced-byte-spec* (byte 32 0) "Byte specs on CMUCL, SBCL and Allegro are conses.") @@ -89,14 +82,11 @@ ;; (*auto-commit* *auto-commit*) ;; (*transaction-stack* ;; (make-array 0 :adjustable t :fill-pointer t)) -;; (*lisp-obj-id* 0) -;; (*circularity-hash* (make-hash-table :test 'eq)) ;; #+(or cmu sbcl allegro) ;; (*resourced-byte-spec* (byte 32 0))) ;; (declare (special *current-transaction* sleepycat::*errno-buffer* ;; sleepycat::*buffer-streams* ;; *store-controller* *auto-commit* *transaction-stack* -;; *lisp-obj-id* *circularity-hash* ;; #+(or cmu sbcl allegro) *resourced-byte-spec*)) ;; (funcall thunk)))

1 0

[elephant-cvs] CVS elephant/src/db-bdb
by ieslick 04 Sep '06

04 Sep '06

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]

1 0

[elephant-cvs] CVS elephant
by ieslick 04 Sep '06

04 Sep '06

Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv14802 Modified Files: Makefile TODO config.lisp Added Files: UPGRADE-BDB Log Message: Berkeley DB Backend upgrade & compact API fn, bug fixes --- /project/elephant/cvsroot/elephant/Makefile 2006/02/19 17:25:52 1.11 +++ /project/elephant/cvsroot/elephant/Makefile 2006/09/04 00:09:10 1.12 @@ -26,13 +26,17 @@ $(UTILSRC)/libmemutil.$(EXT): $(UTILSRC)/libmemutil.c gcc $(SHARED) -Wall -fPIC -O3 -o $@ $< -lm +clean: + rm $(UTILSRC)/libmemutil.$(EXT) + rm $(BDBSRC)/libsleepycat.$(EXT) + # # NON BDB PLATFORMS SHOULDN'T NEED TO COMPILE LIBSLEEPYCAT # SO ONLY EDIT THIS IF YOU WANT TO USE BDB! # # But I will assume that Linux is more common? -DB43DIR=/usr/local/BerkeleyDB.4.3/ +DB43DIR=/usr/local/BerkeleyDB.4.4/ # Dan Knapp contributed this line, which came form OS X? # DB43DIR=/sw # Other example paths --- /project/elephant/cvsroot/elephant/TODO 2006/04/26 17:53:43 1.22 +++ /project/elephant/cvsroot/elephant/TODO 2006/09/04 00:09:10 1.23 @@ -1,33 +1,19 @@ -April 23, 2006 +September 1st, 2006 -Ongoing release plan notes +Ongoing release plan notes: -Features completed in 0.6.0: ------------------------------------ -x Add a class-indexing class option to the metaclass so we can maintain class instances - index without any secondary indices or indexed slots -x Upgrade solution to 0.6.0, DB properties & version tag for future upgrades -x Validate migration -x Documentation update -x Indexing tutorial and tutorial review - - -0.6.1 - performance, safety and portability --------------------------------------------------- +0.6.1 - performance, safety and portability (end of Summer?) +----------------------------------------------------------- Bugs or Observations: -- BDB overwrite of values makes DB grow - [So far I can only find that it grows on the 2nd write, but not after that...artifact of - page allocation or caching of memory pools?] -- FEATURE: Investigate BDB record size; it's 2x larger than expected? - [Need a good test for this to follow up] Multi-threading operation: -- Make elephant thread bound variables dynamic and modifiable by backends +- Make elephant thread-bound variables dynamic and modifiable by backends +- Ensure serialization is multi-threaded - Verify that operations such as indexing are thread safe -Stability +Stability: - Review all the NOTE comments in the code - Remove build gensym warnings in sleepycat - Port elephant to closer-to-MOP to make it easier to support additional lisps (Both) @@ -62,10 +48,9 @@ *auto-index* is false and we're not in a transaction to help users avoid lockups in bdb? Should be able to turn off for performance but it will help catch missing with-transaction statemetns in user code. (Both) -- Determine how to detect deadlock conditions as an optional run-safe mode? -- Automatically run db_deadlock when opening a bdb backend? Requires path to +~ Automatically run db_deadlock when opening a bdb backend? Requires path to functions and ability to launch shell command. Closing the store stops the - sub-process. + sub-process. - Always support locks that timeout? Tradeoffs? Performance: @@ -75,23 +60,35 @@ - Add dependency information into secondary index callback functions so that we can more easily compute which indices need to be updated to avoid the global remove/add in order to maintain consistency (Ian) -- Improve SQL serializer performance (Robert) +- Improve SQL serializer performance (Robert/Ian) Indexing features: - Add :inverse-reader to slot options to create a named method that indexes into objects based on slot values. Is this a GF or defun? Do we dispatch on class name or bake it in? -0.6.3 - Query & indexing expansion +Compliance and Efficiency: + - Update to support BDB 4.4 + - Add ability from within lisp to reclaim DB space after deleting btree key-value pairs + - Reclaim table storage on index drop + +0.6.1 - Features COMPLETED to date +---------------------------------- +x Determine how to detect deadlock conditions as an optional run-safe mode? +x BDB overwrite of values makes DB grow + [So far I can only find that it grows on the 2nd write, but not after that...artifact of + page allocation or caching of memory pools?] +x FEATURE: Investigate BDB record size; it's 2x larger than expected? + [Ditto above] + +0.6.2 - Query & indexing expansion (Fall '06) -------------------------------------------------- - - simple object query language (Ian - orthogonal, on main branch) + - Simple object query language (Ian - orthogonal, on main branch) - Add needed support (if any) for persistent graph structures & queries (Ian on a branch) - A wrapper around migration that emulates a stop-and-copy GC + - Fast serializer port & upgrade strategy -0.6.4 - Compliance & Documentation +0.6.3 - Documentation & Tools (Winter '06) -------------------------------------------------- - - Update to support BDB 4.4 - - Add ability from within lisp to reclaim DB space after deleting btree key-value pairs - - Reclaim table storage on index drop - Tutorial example rethink: update the blog tutorial using indexed objects to create different views as well as integrating something like logging for admin or version control purposes. @@ -104,17 +101,17 @@ (a simple REPL tool to see what classes are in a repository and what state they're in...useful for long-lived repositories) -0.6.5 - Additional datastructures? +0.6.4 - Additional datastructures (?) -------------------------------------------------- - Native BDB persistent hashes (easy; can do on SQL backends?) - Support for cheap persistent sets (medium? can do on SQL?) Some placeholders & dreams features below... :) -0.7+: Major features +0.7+: Major features (Winter '07) -------------------------------------------------- - - A backend controller for AllegroCache (Ian) - - Prevalence-like in-memory database system (Robert?) + - A native lisp backend controller (Ian) + - Integrate prevalence-like in-memory database system (Robert?) - Richer controller modes: - Single-user mode (cache values in instance slots for fast reads, write-through) - Prevalence mode (read/write to normal slots except on object creation or synch) @@ -124,20 +121,25 @@ - Controller 'switches' - NoSynch - allow transactions to be lost on failure but maintains consistency instead of performance -0.8 - Lisp Backend? --------------------------------------------------- - - A native BTree implementation in CommonLisp (prototype on Allegro's BTree implementation for ACache) - - ======================================================== ======================================================== -Resolved issues: -- On class change, new slots should have their initform values pushed +June 20, 2006: + +Features completed in 0.6.0: +----------------------------------- +x Add a class-indexing class option to the metaclass so we can maintain class instances + index without any secondary indices or indexed slots +x Upgrade solution to 0.6.0, DB properties & version tag for future upgrades +x Validate migration +x Documentation update +x Indexing tutorial and tutorial review +x On class change, new slots should have their initform values pushed into the slot value as if the slot was being created the first time (currently this doesn't happen) [fixed in 0.6.0-rc1] -Feb. 4, 2006 + +Feb. 4, 2006: As of 0.5.0, we have seem to have a stable suite on ACL, SBCL, and OpenMCL. @@ -150,18 +152,14 @@ 3) The SQL serializer could be made more efficiently very easily, greatly enhancing the speed of that as a back-end. - In general, Elephant is very usable and modestly robust, but heavier use, better documentation, and a good example application would help it a lot. - - - - Merge in the todos from the source and the NOTES! -October 19, 2005 + +October 19, 2005: The SQL back-end stuff has only been tested with Postgress and SBCL. @@ -176,16 +174,15 @@ make things MUCH faster. -new counters in 4.3 (october) - +Notes from original developers at time of handoff: +(minus stuff recorded elsewhwere) +-------------------------------------------------- understand the profiler / timer, tweak performance of CLOS stuff tweak performance of transactions! dynamic-extent in CMUCL / SBCL. -more documentation: texinfo NOTES. - equality joins have to be done on the lisp side: end-of-table is not the same as end-of-btree. @@ -202,14 +199,6 @@ openmcl lispy pointer arithmetic (profile sap-alien, etc). profile CMUCL / SBCL sap arithmetic. -performance hacks: class / slot to ID - -tests tests tests - -this is not particularly a bug but: if you redefine the -persistent-object class, you will mess up any existing -persistent classes you've made. - CMUCL, SBCL, Allegro? (NOT OpenMCL) can directly pass memory like foreign arrays. Use these instead of foreign arrays? @@ -220,6 +209,3 @@ cursor-put : move the cursor after insert. change :transient flag to an allocation type (fix CMUCL!) - -make update-class-for-redefined-class work. (persistent -slots are class allocated, this is bad.) --- /project/elephant/cvsroot/elephant/config.lisp 2006/04/30 01:03:48 1.3 +++ /project/elephant/cvsroot/elephant/config.lisp 2006/09/04 00:09:11 1.4 @@ -36,7 +36,7 @@ ;; for Fink (OS X) -- but I will assume Linux more common... ;; "/sw/lib/libdb-4.3.dylib" ;; a possible manual install - "/usr/local/BerkeleyDB.4.3/lib/libdb.dylib") + "/usr/local/BerkeleyDB.4.4/lib/libdb.dylib") (defparameter *sleepycat-pthreads-path* #-linux nil ;; don't open on non-linux environments --- /project/elephant/cvsroot/elephant/UPGRADE-BDB 2006/09/04 00:09:12 NONE +++ /project/elephant/cvsroot/elephant/UPGRADE-BDB 2006/09/04 00:09:12 1.1 Version 0.6.0 of Elephant using the BDB backend depends on Berkeley DB 4.3. As for September 3rd, 2006, the current CVS is now dependant on Berkeley DB 4.4. If you already have a database based on 0.6.0 or a HEAD prior to September 3rd, you'll need to take the following steps to upgrade your BDB databases to work with my latest checkin. (NOTE: Allegro users may have additional work to do, please check e-mail logs on this topic) 1) Install BDB 4.4.20 or later just as you installed BDB 4.3 2) Pull the latest HEAD from CVS 3) Update config.lisp and Makefile in elephant root to point to the appropriate directories 4) Rebuild elephant C libraries In the root directory: > make clean > make > make bdb 5) Upgrade your database directory (only log files need updating) >From Sleepycat documentation: 1. Shut down the old version of the application. 2. Run recovery on the database environment using the DB_ENV->open method or the db_recover utility. 3. Remove any Berkeley DB environment using the DB_ENV->remove method or an appropriate system utility. 4. Archive the database environment for catastrophic recovery. See Archival procedures for more information. 5. Recompile and install the new version of the application. 6. Force a checkpoint using the DB_ENV->txn_checkpoint method or the db_checkpoint utility. 7. Restart the application. A known good procedure: 1. Cleanly exit lisp/elephant application 2. Run 'db_recover' in database directory using 4.3 tools 3. This will remove the environment 3.b (optional) Run 'db_checkpoint -1' and 'db_archive -d' to checkpoint and update db files to latest log. This will snapshot the DB and allow you to backup less data, but it makes catastrophic recovery to any time before the snapshot impossible as you are deleting history with the '-d' option so exclude that if you are conservative or aren't sure what you're doing. 4. Copy your database files and all log files to a backup 5. Run 'db_checkpoint -1' using 4.4 tools (ignore error message) 6. Restart lisp, reload application and ensure that the latest elephant source has been fully recompiled 6) Connect to your DB, all should be well! This procedure worked for my Mac OS X upgrade from BDB 4.3 using the latest HEAD on a very large, complex DB.

1 0