From ieslick at common-lisp.net Mon Sep 4 00:09:12 2006 From: ieslick at common-lisp.net (ieslick) Date: Sun, 3 Sep 2006 20:09:12 -0400 (EDT) Subject: [elephant-cvs] CVS elephant Message-ID: <20060904000912.24D5C43225@common-lisp.net> 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. From ieslick at common-lisp.net Mon Sep 4 00:09:15 2006 From: ieslick at common-lisp.net (ieslick) Date: Sun, 3 Sep 2006 20:09:15 -0400 (EDT) Subject: [elephant-cvs] CVS elephant/src/db-bdb Message-ID: <20060904000915.308364714B@common-lisp.net> 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] From ieslick at common-lisp.net Mon Sep 4 00:09:16 2006 From: ieslick at common-lisp.net (ieslick) Date: Sun, 3 Sep 2006 20:09:16 -0400 (EDT) Subject: [elephant-cvs] CVS elephant/src/elephant Message-ID: <20060904000916.4ADBC48146@common-lisp.net> 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))) From ieslick at common-lisp.net Mon Sep 4 00:09:17 2006 From: ieslick at common-lisp.net (ieslick) Date: Sun, 3 Sep 2006 20:09:17 -0400 (EDT) Subject: [elephant-cvs] CVS elephant/src/memutil Message-ID: <20060904000917.19E3249005@common-lisp.net> Update of /project/elephant/cvsroot/elephant/src/memutil In directory clnet:/tmp/cvs-serv14802/src/memutil Modified Files: memutil.lisp Log Message: Berkeley DB Backend upgrade & compact API fn, bug fixes --- /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2006/07/03 00:36:37 1.8 +++ /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2006/09/04 00:09:16 1.9 @@ -321,11 +321,12 @@ "Return the number of bytes of the internal representation of a string." #+(and allegro ics) - ;; old: `(let ((l (length ,s))) (+ l l)) + ;; old: + ;; `(let ((l (length ,s))) (+ l l)) `(etypecase ,s - (base-string ;; (excl:native-string-sizeof ,s :external-format :unicode)) - (length ,s)) ;; fast 0.6.1 + (base-string (length ,s)) ;; fast 0.6.1 (string (excl:native-string-sizeof ,s :external-format :unicode))) + ;; (excl:native-string-sizeof ,s :external-format :unicode)) #+(or (and sbcl sb-unicode) lispworks) `(etypecase ,s (base-string (length ,s)) From ieslick at common-lisp.net Mon Sep 4 04:56:50 2006 From: ieslick at common-lisp.net (ieslick) Date: Mon, 4 Sep 2006 00:56:50 -0400 (EDT) Subject: [elephant-cvs] CVS elephant/src/db-bdb Message-ID: <20060904045650.892955C4EE@common-lisp.net> Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv7921 Modified Files: bdb-collections.lisp Log Message: Fixed add-index bug leading to incomplete indices --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2006/06/19 00:47:24 1.8 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2006/09/04 04:56:50 1.9 @@ -134,14 +134,18 @@ (reset-buffer-stream primary-buf) (reset-buffer-stream secondary-buf))) (let ((key-fn (key-fn index)) - (last-key nil)) - (loop + (last-key nil) + (continue t)) + (loop while continue + do (with-transaction (:store-controller sc) (with-btree-cursor (cursor bt) (if last-key (cursor-set cursor last-key) (cursor-first cursor)) - (loop for i from 0 upto 1000 do + (loop for i from 0 upto 1000 + while continue + do (multiple-value-bind (valid? k v) (cursor-current cursor) (unless valid? (return-from populate t)) (multiple-value-bind (index? skey) (funcall key-fn index k v) @@ -150,7 +154,8 @@ (declare (ignore v)) (if valid? (setf last-key k) - (return-from populate t)))))))))))) + (setf continue nil)))))))))))) + (defmethod map-indices (fn (bt bdb-indexed-btree)) (maphash fn (indices-cache bt))) From ieslick at common-lisp.net Mon Sep 4 05:01:06 2006 From: ieslick at common-lisp.net (ieslick) Date: Mon, 4 Sep 2006 01:01:06 -0400 (EDT) Subject: [elephant-cvs] CVS elephant Message-ID: <20060904050106.3ABD5671B1@common-lisp.net> Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv8012 Modified Files: TODO Log Message: Added a convenient delete script for cleaning up prior state. BUGFIX: populate created incomplete secondary indices in add-index BUGFIX: generic function mistmatch with new optimize-storage method in bdb --- /project/elephant/cvsroot/elephant/TODO 2006/09/04 00:09:10 1.23 +++ /project/elephant/cvsroot/elephant/TODO 2006/09/04 05:01:05 1.24 @@ -70,6 +70,8 @@ - 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 + - Should we delete slot-values in the db when redefining classes, currently those values + stay around - probably indefinitely unless we GC 0.6.1 - Features COMPLETED to date ---------------------------------- From ieslick at common-lisp.net Mon Sep 4 05:01:07 2006 From: ieslick at common-lisp.net (ieslick) Date: Mon, 4 Sep 2006 01:01:07 -0400 (EDT) Subject: [elephant-cvs] CVS elephant/src/elephant Message-ID: <20060904050107.B22216D029@common-lisp.net> Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv8012/src/elephant Modified Files: controller.lisp serializer.lisp Log Message: Added a convenient delete script for cleaning up prior state. BUGFIX: populate created incomplete secondary indices in add-index BUGFIX: generic function mistmatch with new optimize-storage method in bdb --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2006/09/04 00:09:15 1.12 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2006/09/04 05:01:06 1.13 @@ -323,7 +323,7 @@ (:documentation "Provides a persistent source of unique id's")) -(defgeneric optimize-storage ((sc store-controller) &allow-other-keys) +(defgeneric optimize-storage (sc &key &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.")) --- /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2006/09/04 00:09:15 1.10 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2006/09/04 05:01:06 1.11 @@ -60,16 +60,6 @@ (defconstant +fill-pointer-p+ #x40) (defconstant +adjustable-p+ #x80) -(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 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.") From ieslick at common-lisp.net Mon Sep 4 05:01:07 2006 From: ieslick at common-lisp.net (ieslick) Date: Mon, 4 Sep 2006 01:01:07 -0400 (EDT) Subject: [elephant-cvs] CVS elephant/tests Message-ID: <20060904050107.EA16970210@common-lisp.net> Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv8012/tests Added Files: delscript.sh Log Message: Added a convenient delete script for cleaning up prior state. BUGFIX: populate created incomplete secondary indices in add-index BUGFIX: generic function mistmatch with new optimize-storage method in bdb --- /project/elephant/cvsroot/elephant/tests/delscript.sh 2006/09/04 05:01:07 NONE +++ /project/elephant/cvsroot/elephant/tests/delscript.sh 2006/09/04 05:01:07 1.1 rm testdb/__* rm testdb/%* rm testdb/log* rm testdb2/__* rm testdb2/%* rm testdb2/log* rm testsleepycat/testsleepycat rm testsleepycat/__* rm testsleepycat/log* From ieslick at common-lisp.net Mon Sep 4 05:20:44 2006 From: ieslick at common-lisp.net (ieslick) Date: Mon, 4 Sep 2006 01:20:44 -0400 (EDT) Subject: [elephant-cvs] CVS elephant/tests Message-ID: <20060904052044.09E364817E@common-lisp.net> Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv12920 Modified Files: testsleepycat.lisp Log Message: Fix for spurious error message --- /project/elephant/cvsroot/elephant/tests/testsleepycat.lisp 2006/02/19 04:53:02 1.7 +++ /project/elephant/cvsroot/elephant/tests/testsleepycat.lisp 2006/09/04 05:20:43 1.8 @@ -25,16 +25,16 @@ (setq db (sleepycat::db-create env)) (sleepycat::db-open db :file "testsleepycat" :database "bar" :type SLEEPYCAT::DB-BTREE - :auto-commit t :create t :thread t)) + :auto-commit t :create t :thread t)) (deftest prepares-sleepycat (progn - (if (not (find-package :sleepycat)) - (progn - (format t "sleepycat db not valid, so not runnning test prepares-sleepycat~%") - t) - (finishes (prepare-sleepycat)))) - t) + (if (find-package :sleepycat) + (finishes (prepare-sleepycat)) + (progn + (format t "Berkeley DB not loaded, so not runnning test prepares-sleepycat~%") + t))) + t) #| (deftest put-alot @@ -77,9 +77,9 @@ finally (sleepycat::db-sequence-remove seq :auto-commit t)))) (deftest test-seq1 - (if (not (find-package 'ele-bdb)) + (if (not (find-package :sleepycat)) (progn - (format t "database db not valid, so not runnning test test-seq1~%") + (format t "Berkeley db not loaded, so not runnning test test-seq1~%") t) (finishes (test-sequence1))) t) @@ -117,7 +117,7 @@ (deftest cleansup-sleepycat (if (not db) (progn - (format t "sleepycat db not valid, so not runnning test cleanup-sleepycat~%") + (format t "Berkeley DB not open, so not runnning test cleanup-sleepycat~%") t) (finishes (cleanup-sleepycat))) t) From ieslick at common-lisp.net Mon Sep 4 05:42:43 2006 From: ieslick at common-lisp.net (ieslick) Date: Mon, 4 Sep 2006 01:42:43 -0400 (EDT) Subject: [elephant-cvs] CVS elephant Message-ID: <20060904054243.D469C5F00C@common-lisp.net> Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv17940 Modified Files: TODO Log Message: Further rethink of roadmap and TODO tasks --- /project/elephant/cvsroot/elephant/TODO 2006/09/04 05:01:05 1.24 +++ /project/elephant/cvsroot/elephant/TODO 2006/09/04 05:42:43 1.25 @@ -8,28 +8,19 @@ Bugs or Observations: -Multi-threading operation: -- 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: - 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) -- (From Ben's e-mail) We are storing persistent objects incorrectly. They should be - stored only as OIDs, and we should have a separate OID->class table. This way - change-class can be handled correctly. This also non-trivially compresses storage - in the database as we only need to store oids rather than serialized class names. - [Ian comment: only problem with this is an extra access to oid table each time a - class is deserialized and overall storage is constant. Would make it easy to - invalidate objects though!] +- Remove sleepycat name. Change sleepycat to db-bdb to reflect oracle ownership and avoid + confusion for new users - Delete persistent slot values from the slot store with remove-kv to ensure that there's no data left lying around if you define then redefine a class and add back a persistent slot name that you thought was deleted and it gets the old value by default. +- Cleaner failure modes if operations are performed without repository or without + transaction or auto-commit (Both) -Stores: +Store variables: - Think through default *store-controller* vs. explicit parameter passing referencing all over the APIs - Think about dynamic vs. object based store & transaction resolution? @@ -37,57 +28,74 @@ - Current store specific *current-transaction* stack - Throw condition when store spec is invalid, etc -Transactionalism: -- Cleaner failure modes if operations are performed without repository or without - transaction or auto-commit (Both) +Multi-threading operation: +- Make elephant threads appropriately bind dynamic variables +- Verify that operations such as indexing are thread safe BDB Features: +~ 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. +- Always support locks that timeout? Tradeoffs? +- Roll deprecation of *auto-commit* through code base so leaf functions stop referring to it - Trace all paths to db-put or db-delete and ensure that there is a check or a default with-transaction around the primitive components - write a document clarifying transaction design & assumptions in the backend] Add asserts if *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) -~ 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. -- Always support locks that timeout? Tradeoffs? +- Figure out how to compact a specific btree and/or key-range using optimize-storage. + Probably need to update keyword part of the API + +Indexing efficiency and policies: +- 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? +- Reclaim table storage on index drop? It's nice to be able to reconnect sometimes! + Perhaps an API command that allows explicit dropping of tables for a class and a policy + parameter that determines if this is the default? +- Should we delete slot-values in the db when redefining classes, currently those values + stay around - probably indefinitely unless we GC Performance: - Metering and understanding locking issues. Large transactions seem - to use a lot of locks. In general understanding how to use Sleepycat + to use a lot of locks. In general understanding how to use Berkeley DB efficiently seems like a good thing. (From Ben) - 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/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? - -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 - - Should we delete slot-values in the db when redefining classes, currently those values - stay around - probably indefinitely unless we GC +Test coverage: +- Test for optimize storage method (just add probe-file methods to get file size) +- Multi-threading stress tests? Ensure that there are conflicts and lots of serialization + happening concurrently to make sure that multi-threading is in good shape + +Documentation: +- Add notes about with-transaction usage (abort & commit behavior on exit) +- Add notes about optimize-storage +- Add notes about new BDB 4.4 *auto-commit* behavior. Default for entire store-controller, + will auto create a transaction if none is active if open with :auto-commit t or will + never auto-commit (regardless of operator flags) if it is not. Make sure open-store + defaults to auto-commit and there is a flag to turn it off. 0.6.1 - Features COMPLETED to date ---------------------------------- +x Ensure serialization is multi-threaded and efficient 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] +x Update to support BDB 4.4 + x Add ability from within lisp to reclaim DB space after deleting btree key-value pairs -0.6.2 - Query & indexing expansion (Fall '06) + +0.6.2 - Advanded work, low-hanging fruit (Fall '06) -------------------------------------------------- - - Simple object query language (Ian - orthogonal, on main branch) - - Add needed support (if any) for persistent graph structures & queries (Ian on a branch) + - Port elephant to closer-to-MOP to make it easier to support additional lisps and to + seriously clean up metaclasses.lisp and classes.lisp protocols - A wrapper around migration that emulates a stop-and-copy GC - - Fast serializer port & upgrade strategy 0.6.3 - Documentation & Tools (Winter '06) -------------------------------------------------- @@ -99,21 +107,19 @@ - A guide to dealing with multiple open stores - A guide to performance - An overview of licensing issues... - - Repository browser (Ian - orthogonal, on main branch) - (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.4 - Additional datastructures (?) +0.7.0: Fast In-Memory Database (Not backwards compatible) -------------------------------------------------- - - 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 (Winter '07) --------------------------------------------------- - - A native lisp backend controller (Ian) - - Integrate prevalence-like in-memory database system (Robert?) + - Integrate prevalence-like in-memory database system + - Fast serializer port w/ upgrade strategy and prevalence like storage solution + - Further improve SQL 64-bit serialization performance (if possible) + - (From Ben's e-mail) We are storing persistent objects incorrectly. They should be + stored only as OIDs, and we should have a separate OID->class table. This way + change-class can be handled correctly. This also non-trivially compresses storage + in the database as we only need to store oids rather than serialized class names. + [Ian comment: only problem with this is an extra access to oid table each time a + class is deserialized and overall storage is constant. Would make it easy to + invalidate objects though!] - 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) @@ -122,6 +128,31 @@ - Concurrent mode (for backends that allow multiple processes to connect, current default) - Controller 'switches' - NoSynch - allow transactions to be lost on failure but maintains consistency instead of performance + - Usage model examples + +0.7.1 - Elephant/BDB/SQL Production Release +-------------------------------------------------- + - More work on testing, examples and documentation + - Intent is for this to be a major, long-term supported release prior + to work on the new backend + +0.7.2 - Additional Tools +-------------------------------------------------- + - Add needed support (if any) for persistent graph structures & queries (Ian on a branch) + - Simple object query language (Ian - orthogonal, on main branch) + - Repository browser (Ian - orthogonal, on main branch) + (a simple REPL tool to see what classes are in a repository and + what state they're in...useful for long-lived repositories) + +0.8.0 - Native Backend & Datastructure Library ( +-------------------------------------------------- + - A native lisp backend controller (Ian) + - Native BDB persistent hashes (easy; can do on SQL backends?) + - Support for cheap persistent sets (medium? can do on SQL?) + - Usage model examples + + + ======================================================== ======================================================== From ieslick at common-lisp.net Mon Sep 4 05:42:44 2006 From: ieslick at common-lisp.net (ieslick) Date: Mon, 4 Sep 2006 01:42:44 -0400 (EDT) Subject: [elephant-cvs] CVS elephant/tests Message-ID: <20060904054244.932A15F00C@common-lisp.net> Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv17940/tests Modified Files: testindexing.lisp Log Message: Further rethink of roadmap and TODO tasks --- /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2006/05/06 19:18:01 1.18 +++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2006/09/04 05:42:43 1.19 @@ -74,13 +74,14 @@ ;;(format t "~%basic store: ~A ~A~%" *store-controller* (elephant::controller-spec *store-controller*)) ;; (format t "auto-commit: ~A~%" *auto-commit*) - (when (class-indexedp-by-name 'idx-one ) + (when (class-indexedp-by-name 'idx-one) (disable-class-indexing 'idx-one :errorp nil) (setf (find-class 'idx-one nil) nil)) (defclass idx-one () ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)) (:metaclass persistent-metaclass)) + (defmethod print-object ((obj idx-one) stream) (if (slot-boundp obj 'slot1) (format stream "slot1 = ~A~%" (slot1 obj)) From ieslick at common-lisp.net Tue Sep 5 03:23:17 2006 From: ieslick at common-lisp.net (ieslick) Date: Mon, 4 Sep 2006 23:23:17 -0400 (EDT) Subject: [elephant-cvs] CVS elephant/src/db-bdb Message-ID: <20060905032317.3F7487E003@common-lisp.net> Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv10674/src/db-bdb Modified Files: bdb-controller.lisp sleepycat.lisp Log Message: Extended thread support in thread-safe serializer to other lisps --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2006/09/04 00:09:12 1.11 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2006/09/05 03:23:16 1.12 @@ -212,7 +212,12 @@ "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 + (db-compact (controller-db ctrl) nil nil end) + (db-compact (controller-btrees ctrl) nil nil end) + (db-compact (controller-indices ctrl) nil nil end) + (db-compact (controller-indices-assoc ctrl) nil nil end) + (db-compact (controller-oid-db ctrl) nil nil end)) (progn (serialize start-key start) (db-compact (controller-db ctrl) start --- /project/elephant/cvsroot/elephant/src/db-bdb/sleepycat.lisp 2006/09/04 00:09:12 1.6 +++ /project/elephant/cvsroot/elephant/src/db-bdb/sleepycat.lisp 2006/09/05 03:23:16 1.7 @@ -934,7 +934,8 @@ (flags :unsigned-int) (end array-or-pointer-char) (end-length :unsigned-int) - (end-size :unsigned-int :out))) + (end-size :unsigned-int :out)) + :returning :int) (defun db-compact (db start stop end &key (transaction *current-transaction*) freelist-only free-space) From ieslick at common-lisp.net Tue Sep 5 03:23:18 2006 From: ieslick at common-lisp.net (ieslick) Date: Mon, 4 Sep 2006 23:23:18 -0400 (EDT) Subject: [elephant-cvs] CVS elephant/src/elephant Message-ID: <20060905032318.120F17C006@common-lisp.net> Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv10674/src/elephant Modified Files: serializer.lisp variables.lisp Log Message: Extended thread support in thread-safe serializer to other lisps --- /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2006/09/04 05:01:06 1.11 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2006/09/05 03:23:17 1.12 @@ -60,25 +60,75 @@ (defconstant +fill-pointer-p+ #x40) (defconstant +adjustable-p+ #x80) +;; +;; This may be overkill, but is intended to avoid continually allocating +;; hashes each time we serialize an object. I added some adaptation +;; to keep it from dropping and re-allocating if the user continually saves +;; large collections of objects. However the defaults should handle most +;; apps just fine. The queue is useful because a system with 10 threads +;; will need 10 circularity queues if it is storing large objects +;; + (defvar *circularity-hash-queue* nil "Circularity ids for the serializer.") +;; quick portability hack, do we need to import 'port' or some +;; other thread layer to the elephant dependency list? + +(defun ele-make-lock () + #+allegro (mp::make-process-lock) + #+cmu (mp:make-lock) + #+sbcl (sb-thread:make-mutex) + #+mcl (ccl:make-lock) + #+lispworks (mp:make-lock) + #-(or allegro sbcl cmu lispworks mcl) nil ) + +(defmacro ele-with-lock ((lock) &body body) + #+allegro `(mp:with-process-lock (,lock) , at body) + #+cmu `(mp:with-lock-held (,lock) , at body) + #+sbcl `(sb-thread:with-mutex (,lock) , at body) + #+lispworks `(mp:with-lock (,lock) , at body) + #+mcl `(ccl:with-lock-grabbed (,lock) , at body) + #-(or allegro sbcl cmu lispworks mcl) `(progn , at body) ) + (defvar *circularity-lock* - #+allegro (mp::make-process-lock)) + (ele-make-lock)) + +(defun drop-circularity-hash-p (hash) + "This allows us to tune our memory usage to the application. + If grow-ceiling-p is enabled then we'll slowly adapt to + a growing demand so we balance GC load and reserved memory" + (if (> (hash-table-size hash) *circularity-max-hash-size*) + (if (and *circularity-grow-ceiling-p* + (>= (incf *circularity-adapt-count*) + *circularity-adapt-step-size*)) + (progn + (setf *circularity-max-hash-size* + (ceiling (* *circularity-growth-factor* + *circularity-max-hash-size*))) + nil) + t) + (progn + (decf *circularity-adapt-count* 0.5) + nil))) (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))) + (if (not *circularity-hash-queue*) + (make-hash-table :test 'eq :size 50) + (if *circularity-lock* + (ele-with-lock (*circularity-lock*) + (pop *circularity-hash-queue*)) + (pop *circularity-hash-queue*)))) (defun release-circularity-hash (hash) - (unless (> (hash-table-size hash) 100) + (unless (drop-circularity-hash-p hash) (clrhash hash) - (#+allegro - mp::with-process-lock (*circularity-lock*) - (push hash *circularity-hash-queue*)))) + (if *circularity-lock* + (ele-with-lock (*circularity-lock*) + (push hash *circularity-hash-queue*)) + (push hash *circularity-hash-queue*)))) + + (defun serialize (frob bs) "Serialize a lisp value into a buffer-stream." --- /project/elephant/cvsroot/elephant/src/elephant/variables.lisp 2006/09/04 00:09:15 1.3 +++ /project/elephant/cvsroot/elephant/src/elephant/variables.lisp 2006/09/05 03:23:17 1.4 @@ -43,6 +43,29 @@ Users attempting to directly write this variable will run into an error") +;;;;;;;;;;;;;;;;; +;;;; Serializer optimization parameters + +(defvar *circularity-initial-hash-size* 50 + "This is the default size of the circularity cache used in the serializer") +(defvar *circularity-max-hash-size* 100 + "This is the largest hash table that is maintained by the serializer. Larger + hash tables are dropped from the has queue assuming that it was a one of + transaction or an error.") +(defparameter *circularity-grow-ceiling-p* t + "This enables the system to slowly adapt to larger-than-average lists or other + collections of objects (like large trees) to avoid continually GC'ing large + data structures and reducing total copying over time") +(defparameter *circularity-adapt-step-size* 4 + "How many times we see something over the max in succession before we adapt + to a larger maximum size") +(defparameter *circularity-growth-factor* 0.5 + "How much to increase the max size after each adaptation step") +(defvar *circularity-adapt-count* 0 + "Maintains a count of how many times we've seen a hash table over the appropriate + size. This is reduced by 1/2 each time we don't have one that is oversized.") + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Thread-local specials