- elephant-cvs@lists.common-lisp.net - mailman3.common-lisp.net

[elephant-cvs] CVS update: elephant/src/elephant.lisp
by blee＠common-lisp.net 28 Aug '04

28 Aug '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv22102/src Modified Files: elephant.lisp Log Message: no with-transaction-retry Date: Sat Aug 28 08:40:18 2004 Author: blee Index: elephant/src/elephant.lisp diff -u elephant/src/elephant.lisp:1.3 elephant/src/elephant.lisp:1.4 --- elephant/src/elephant.lisp:1.3 Fri Aug 27 19:32:10 2004 +++ elephant/src/elephant.lisp Sat Aug 28 08:40:18 2004 @@ -39,7 +39,7 @@ (defpackage elephant (:nicknames ele :ele) (:use common-lisp sleepycat) - (:shadow with-transaction with-transaction-retry) + (:shadow with-transaction) (:export *store-controller* *current-transaction* *auto-commit* store-controller open-controller close-controller with-open-controller controller-path controller-environment @@ -48,7 +48,7 @@ persistent persistent-object persistent-metaclass persistent-collection btree get-value remove-kv db-transaction-begin db-transaction-abort db-transaction-commit - with-transaction with-transaction-retry + with-transaction db-env-set-timeout db-env-get-timeout db-env-set-flags db-env-get-flags db-env-set-lock-detect db-env-get-lock-detect @@ -125,3 +125,20 @@ ) (defsetf get-cache setf-cache) + +;; Good defaults for elephant +(defmacro with-transaction ((&key transaction + (environment (controller-environment + *store-controller*)) + (parent '*current-transaction*) + dirty-read txn-nosync + txn-nowait txn-sync) + &body body) + `(sleepycat:with-transaction (:transaction ,transaction + :environment ,environment + :parent ,parent + :dirty-read ,dirty-read + :txn-nosync ,txn-nosync + :txn-nowait ,txn-nowait + :txn-sync ,txn-sync) + ,@body))

1 0

[elephant-cvs] CVS update: elephant/src/controller.lisp
by blee＠common-lisp.net 28 Aug '04

28 Aug '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv22079/src Modified Files: controller.lisp Log Message: poor man's counters, performance tweaking Date: Sat Aug 28 08:39:56 2004 Author: blee Index: elephant/src/controller.lisp diff -u elephant/src/controller.lisp:1.3 elephant/src/controller.lisp:1.4 --- elephant/src/controller.lisp:1.3 Fri Aug 27 19:31:59 2004 +++ elephant/src/controller.lisp Sat Aug 28 08:39:56 2004 @@ -80,6 +80,33 @@ ;; Should get cached since make-instance calls cache-instance (make-instance class-name :from-oid oid)))) + +;; OID stuff +;; This stuff is all a hack until sequences appear in Sleepycat 4.3 +(defvar %oid-entry (uffi:allocate-foreign-object :char 12)) +(defvar %oid-lock (uffi:allocate-foreign-object :char 16)) + +(eval-when (:load-toplevel) + (loop for c across "%ELEPHANTOID" + for i from 0 to 11 + do (setf (uffi:deref-array %oid-entry '(:array :char) i) + (char-code c))) + (loop for c across "%ELEPHANTOIDLOCK" + for i from 0 to 15 + do (setf (uffi:deref-array %oid-lock '(:array :char) i) + (char-code c))) + ) + +(defvar %oid-entry-length 12) +(defvar %oid-lock-length 16) + +(defmethod next-oid ((sc store-controller)) + (sleepycat::next-counter (controller-environment sc) + (controller-db sc) + %oid-entry %oid-entry-length + %oid-lock %oid-lock-length)) + +;; Open/close (defmethod open-controller ((sc store-controller) &key (recover nil) (recover-fatal nil) (thread t)) "Opens the underlying environment and all the necessary @@ -96,6 +123,13 @@ :auto-commit t :type DB-BTREE :create t :thread thread) (let ((root (make-instance 'btree :from-oid -1))) (setf (slot-value sc 'root) root) + (let ((*auto-commit* t)) + (unless (db-get-key-buffered db %oid-entry %oid-entry-length) + (buffer-write-int 0 *out-buf*) + (db-put-buffered db %oid-entry %oid-entry-length + (buffer-stream-buffer *out-buf*) 4 + :auto-commit t) + (finish-buffer *out-buf*))) sc)))) (defmethod close-controller ((sc store-controller)) @@ -120,47 +154,3 @@ ,@body) (close-controller ,sc))) -(defmacro with-transaction ((&key transaction - (environment (controller-environment - *store-controller*)) - (globally t) - (parent *current-transaction*) - dirty-read txn-nosync - txn-nowait txn-sync) - &body body) - `(sleepycat:with-transaction (:transaction ,transaction - :environment ,environment - :globally ,globally - :parent ,parent - :dirty-read ,dirty-read - :txn-nosync ,txn-nosync - :txn-nowait ,txn-nowait - :txn-sync ,txn-sync) - ,@body)) - -(defmacro with-transaction-retry ((&key transaction environment - (globally t) - (parent *current-transaction*) - (retries 100) - dirty-read txn-nosync - txn-nowait txn-sync) - &body body) - `(sleepycat:with-transaction-retry (:transaction ,transaction - :environment ,environment - :globally ,globally - :parent ,parent - :retries ,retries - :dirty-read ,dirty-read - :txn-nosync ,txn-nosync - :txn-nowait ,txn-nowait - :txn-sync ,txn-sync) - ,@body)) - - -;; This stuff is all a hack until sequences appear in Sleepycat 4.3 -(defconstant max-oid most-positive-fixnum) - -(defmethod next-oid ((sc store-controller)) - (random max-oid)) - - \ No newline at end of file

1 0

[elephant-cvs] CVS update: elephant/src/collections.lisp
by blee＠common-lisp.net 28 Aug '04

28 Aug '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv22059/src Modified Files: collections.lisp Log Message: performance tweaking Date: Sat Aug 28 08:39:31 2004 Author: blee Index: elephant/src/collections.lisp diff -u elephant/src/collections.lisp:1.3 elephant/src/collections.lisp:1.4 --- elephant/src/collections.lisp:1.3 Fri Aug 27 19:32:32 2004 +++ elephant/src/collections.lisp Sat Aug 28 08:39:30 2004 @@ -43,47 +43,37 @@ ;;; equal hashing (except probably for array, hashe, instance keys!) (defclass persistent-collection (persistent) ()) -(defgeneric get-value (key ht &rest args)) -(defgeneric remove-kv (key ht &rest args)) +;(defgeneric get-value (key ht &rest args)) +;(defgeneric remove-kv (key ht &rest args)) ;;; btree access (defclass btree (persistent-collection) ()) -(defmethod get-value (key (ht btree) &rest args) - (declare (ignore args)) +(defmethod get-value (key (ht btree)) + (declare (optimize (speed 3) (safety 0) (space 3))) (buffer-write-int (oid ht) *key-buf*) (let ((key-length (serialize key *key-buf*))) - (handler-case - (values - (deserialize (db-get-key-buffered - (controller-db *store-controller*) - (buffer-stream-buffer *key-buf*) - key-length)) - t) - (db-error (err) - (if (= (db-error-errno err) DB_NOTFOUND) - (values nil nil) - (error err)))))) + (declare (type fixnum key-length)) + (deserialize (db-get-key-buffered + (controller-db *store-controller*) + (buffer-stream-buffer *key-buf*) + key-length)))) -(defmethod (setf get-value) (value key (ht btree) &rest args - &key (transaction *current-transaction*) - (auto-commit *auto-commit*) - &allow-other-keys) - (declare (ignore args)) +(defmethod (setf get-value) (value key (ht btree)) + (declare (optimize (speed 3) (safety 0))) (buffer-write-int (oid ht) *key-buf*) (let ((key-length (serialize key *key-buf*)) (val-length (serialize value *out-buf*))) (db-put-buffered (controller-db *store-controller*) (buffer-stream-buffer *key-buf*) key-length (buffer-stream-buffer *out-buf*) val-length - :transaction transaction - :auto-commit auto-commit))) + :transaction *current-transaction* + :auto-commit *auto-commit*))) -(defmethod remove-kv (key (ht btree) &rest args +(defmethod remove-kv (key (ht btree) &key (transaction *current-transaction*) - (auto-commit *auto-commit*) - &allow-other-keys) - (declare (ignore args)) + (auto-commit *auto-commit*)) + (declare (optimize (speed 3) (safety 0))) (buffer-write-int (oid ht) *key-buf*) (let ((key-length (serialize key *key-buf*))) (db-delete-buffered (controller-db *store-controller*)

1 0

[elephant-cvs] CVS update: elephant/elephant.asd
by blee＠common-lisp.net 28 Aug '04

28 Aug '04

Update of /project/elephant/cvsroot/elephant In directory common-lisp.net:/tmp/cvs-serv20476 Modified Files: elephant.asd Log Message: changed to serial compilation -- still getting weird performance issues with recompilation! Date: Sat Aug 28 08:37:57 2004 Author: blee Index: elephant/elephant.asd diff -u elephant/elephant.asd:1.1 elephant/elephant.asd:1.2 --- elephant/elephant.asd:1.1 Fri Aug 27 19:30:09 2004 +++ elephant/elephant.asd Sat Aug 28 08:37:57 2004 @@ -24,11 +24,12 @@ ((:module :src :components ((:file "sleepycat") - (:file "elephant" :depends-on ("sleepycat")) - (:file "serializer" :depends-on ("elephant")) - (:file "classes" :depends-on ("elephant")) - (:file "controller" :depends-on ("elephant")) - (:file "collections" :depends-on ("elephant"))))) + (:file "elephant") + (:file "classes") + (:file "collections") + (:file "controller") + (:file "serializer")) + :serial t)) :depends-on (:uffi))

1 0

[elephant-cvs] CVS update: elephant/src/sleepycat.lisp
by blee＠common-lisp.net 27 Aug '04

27 Aug '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv13660/src Modified Files: sleepycat.lisp Log Message: license Date: Fri Aug 27 10:32:56 2004 Author: blee Index: elephant/src/sleepycat.lisp diff -u elephant/src/sleepycat.lisp:1.2 elephant/src/sleepycat.lisp:1.3 --- elephant/src/sleepycat.lisp:1.2 Thu Aug 26 19:54:38 2004 +++ elephant/src/sleepycat.lisp Fri Aug 27 10:32:56 2004 @@ -1,13 +1,40 @@ -;; UFFI -;(asdf:operate 'asdf:load-op :uffi) - -;; DSO loading -;(defconstant +path-to-libsleepycat+ -; "/path/to/libsleepycat.so") -;(defconstant +path-to-sleepycat+ -; "/usr/local/lib/db42/libdb.so") -;(uffi:load-foreign-library +path-to-sleepycat+ :module "sleepycat") -;(uffi:load-foreign-library +path-to-libsleepycat+ :module "libsleepycat") +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;; +;;; sleepycat.lisp -- FFI interface to Berkeley DB +;;; +;;; Initial version 8/26/2004 by Ben Lee +;;; <blee(a)common-lisp.net> +;;; +;;; part of +;;; +;;; Elephant: an object-oriented database for Common Lisp +;;; +;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee +;;; <ablumberg(a)common-lisp.net> <blee(a)common-lisp.net> +;;; +;;; This program is free software; you can redistribute it +;;; and/or modify it under the terms of the GNU General +;;; Public License as published by the Free Software +;;; Foundation; either version 2 of the License, or (at +;;; your option) any later version. +;;; +;;; This program is distributed in the hope that it will be +;;; useful, but WITHOUT ANY WARRANTY; without even the +;;; implied warranty of MERCHANTABILITY or FITNESS FOR A +;;; PARTICULAR PURPOSE. See the GNU General Public License +;;; for more details. +;;; +;;; The GNU General Public License can be found in the file +;;; LICENSE which should have been distributed with this +;;; code. It can also be found at +;;; +;;; http://www.opensource.org/licenses/gpl-license.php +;;; +;;; You should have received a copy of the GNU General +;;; Public License along with this program; if not, write +;;; to the Free Software Foundation, Inc., 59 Temple Place, +;;; Suite 330, Boston, MA 02111-1307 USA +;;; (defpackage sleepycat @@ -17,8 +44,8 @@ offset-char-pointer copy-str-to-buf copy-bufs byte-length pointer-int pointer-void array-or-pointer-char db-env-create db-env-close db-env-open db-env-dbremove - db-env-dbrename db-env-remove db-env-set-flags - db-env-get-flags + db-env-dbrename db-env-remove + db-env-set-flags db-env-get-flags db-create db-close db-open db-remove db-rename db-sync db-truncate db-get-key-buffered db-get-buffered db-get db-put-buffered db-put @@ -37,7 +64,71 @@ (in-package "SLEEPYCAT") +;; Constants and Flags +;; eventually write a macro which generates a custom flag function. + +;I don't like the UFFI syntax for enumerations +(defconstant DB-BTREE 1) +(defconstant DB-HASH 2) +(defconstant DB-QUEUE 3) +(defconstant DB-RECNO 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_DIRTY_READ #x2000000) +(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_GET_BOTH 10) +(defconstant DB_SET_LOCK_TIMEOUT 29) +(defconstant DB_SET_TXN_TIMEOUT 33) + +(def-enum lockop ((:DUMP 0) :GET :GET-TIMEOUT :INHERIT + :PUT :PUT-ALL :PUT-OBJ :PUT-READ + :TIMEOUT :TRADE :UPGRADE-WRITE)) + +(def-enum lockmode ((:NG 0) :READ :WRITE :WAIT + :IWRITE :IREAD :IWR :DIRTY :WWRITE)) + +(def-struct db-lockreq + (op lockop) + (mode lockmode) + (timeout :unsigned-int) + (obj (:array :char)) + (lock :pointer-void)) + (eval-when (:compile-toplevel :load-toplevel) + ;; UFFI + ;;(asdf:operate 'asdf:load-op :uffi) + + ;; DSO loading + (defconstant +path-to-libsleepycat+ + "/home/ben/lisp/elephant/libsleepycat.so") + (defconstant +path-to-sleepycat+ + "/usr/local/lib/db42/libdb.so") + (uffi:load-foreign-library +path-to-sleepycat+ :module "sleepycat") + (uffi:load-foreign-library +path-to-libsleepycat+ :module "libsleepycat") + (def-type pointer-int (* :int)) (def-type pointer-void :pointer-void) (def-foreign-type array-or-pointer-char @@ -775,20 +866,6 @@ ;; Locks and timeouts -(def-enum lockop ((:DUMP 0) :GET :GET-TIMEOUT :INHERIT - :PUT :PUT-ALL :PUT-OBJ :PUT-READ - :TIMEOUT :TRADE :UPGRADE-WRITE)) - -(def-enum lockmode ((:NG 0) :READ :WRITE :WAIT - :IWRITE :IREAD :IWR :DIRTY :WWRITE)) - -(def-struct db-lockreq - (op lockop) - (mode lockmode) - (timeout :unsigned-int) - (obj (:array :char)) - (lock :pointer-void)) - (def-function ("db_txn_id" db-transaction-id) ((transaction :pointer-void)) @@ -859,45 +936,6 @@ :returning :int) (wrap-errno db-env-lock-detect (env flags atype) :outs 2) - -;; Constants and Flags -;; eventually write a macro which generates a custom flag function. - -;I don't like the UFFI syntax for enumerations -(defconstant DB-BTREE 1) -(defconstant DB-HASH 2) -(defconstant DB-QUEUE 3) -(defconstant DB-RECNO 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_DIRTY_READ #x2000000) -(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_GET_BOTH 10) -(defconstant DB_SET_LOCK_TIMEOUT 29) -(defconstant DB_SET_TXN_TIMEOUT 33) (defun flags (&key auto-commit

1 0

[elephant-cvs] CVS update: elephant/src/serializer.lisp
by blee＠common-lisp.net 27 Aug '04

27 Aug '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv13643/src Modified Files: serializer.lisp Log Message: license Date: Fri Aug 27 10:32:51 2004 Author: blee Index: elephant/src/serializer.lisp diff -u elephant/src/serializer.lisp:1.2 elephant/src/serializer.lisp:1.3 --- elephant/src/serializer.lisp:1.2 Thu Aug 26 19:57:36 2004 +++ elephant/src/serializer.lisp Fri Aug 27 10:32:51 2004 @@ -1,3 +1,41 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;; +;;; serializer.lisp -- convert Lisp data to/from byte arrays +;;; +;;; Initial version 8/26/2004 by Ben Lee +;;; <blee(a)common-lisp.net> +;;; +;;; part of +;;; +;;; Elephant: an object-oriented database for Common Lisp +;;; +;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee +;;; <ablumberg(a)common-lisp.net> <blee(a)common-lisp.net> +;;; +;;; This program is free software; you can redistribute it +;;; and/or modify it under the terms of the GNU General +;;; Public License as published by the Free Software +;;; Foundation; either version 2 of the License, or (at +;;; your option) any later version. +;;; +;;; This program is distributed in the hope that it will be +;;; useful, but WITHOUT ANY WARRANTY; without even the +;;; implied warranty of MERCHANTABILITY or FITNESS FOR A +;;; PARTICULAR PURPOSE. See the GNU General Public License +;;; for more details. +;;; +;;; The GNU General Public License can be found in the file +;;; LICENSE which should have been distributed with this +;;; code. It can also be found at +;;; +;;; http://www.opensource.org/licenses/gpl-license.php +;;; +;;; You should have received a copy of the GNU General +;;; Public License along with this program; if not, write +;;; to the Free Software Foundation, Inc., 59 Temple Place, +;;; Suite 330, Boston, MA 02111-1307 USA +;;; + (in-package "ELEPHANT") (eval-when (:compile-toplevel :load-toplevel :execute) (use-package "UFFI"))

1 0

[elephant-cvs] CVS update: elephant/src/libsleepycat.c
by blee＠common-lisp.net 27 Aug '04

27 Aug '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv13626/src Modified Files: libsleepycat.c Log Message: license Date: Fri Aug 27 10:32:44 2004 Author: blee Index: elephant/src/libsleepycat.c diff -u elephant/src/libsleepycat.c:1.2 elephant/src/libsleepycat.c:1.3 --- elephant/src/libsleepycat.c:1.2 Thu Aug 26 19:54:43 2004 +++ elephant/src/libsleepycat.c Fri Aug 27 10:32:44 2004 @@ -1,3 +1,41 @@ +/* +;;; +;;; libsleepycat.c -- C wrappers for Sleepycat for FFI +;;; +;;; Initial version 8/26/2004 by Ben Lee +;;; <blee(a)common-lisp.net> +;;; +;;; part of +;;; +;;; Elephant: an object-oriented database for Common Lisp +;;; +;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee +;;; <ablumberg(a)common-lisp.net> <blee(a)common-lisp.net> +;;; +;;; This program is free software; you can redistribute it +;;; and/or modify it under the terms of the GNU General +;;; Public License as published by the Free Software +;;; Foundation; either version 2 of the License, or (at +;;; your option) any later version. +;;; +;;; This program is distributed in the hope that it will be +;;; useful, but WITHOUT ANY WARRANTY; without even the +;;; implied warranty of MERCHANTABILITY or FITNESS FOR A +;;; PARTICULAR PURPOSE. See the GNU General Public License +;;; for more details. +;;; +;;; The GNU General Public License can be found in the file +;;; LICENSE which should have been distributed with this +;;; code. It can also be found at +;;; +;;; http://www.opensource.org/licenses/gpl-license.php +;;; +;;; You should have received a copy of the GNU General +;;; Public License along with this program; if not, write +;;; to the Free Software Foundation, Inc., 59 Temple Place, +;;; Suite 330, Boston, MA 02111-1307 USA +;;; +8? /* Pointer arithmetic utility functions */

1 0

[elephant-cvs] CVS update: elephant/src/collections.lisp
by blee＠common-lisp.net 27 Aug '04

27 Aug '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv13609/src Modified Files: collections.lisp Log Message: license, name changes Date: Fri Aug 27 10:32:32 2004 Author: blee Index: elephant/src/collections.lisp diff -u elephant/src/collections.lisp:1.2 elephant/src/collections.lisp:1.3 --- elephant/src/collections.lisp:1.2 Thu Aug 26 19:58:28 2004 +++ elephant/src/collections.lisp Fri Aug 27 10:32:32 2004 @@ -1,15 +1,53 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;; +;;; collections.lisp -- view Berkeley DBs as Lisp collections +;;; +;;; Initial version 8/26/2004 by Ben Lee +;;; <blee(a)common-lisp.net> +;;; +;;; part of +;;; +;;; Elephant: an object-oriented database for Common Lisp +;;; +;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee +;;; <ablumberg(a)common-lisp.net> <blee(a)common-lisp.net> +;;; +;;; This program is free software; you can redistribute it +;;; and/or modify it under the terms of the GNU General +;;; Public License as published by the Free Software +;;; Foundation; either version 2 of the License, or (at +;;; your option) any later version. +;;; +;;; This program is distributed in the hope that it will be +;;; useful, but WITHOUT ANY WARRANTY; without even the +;;; implied warranty of MERCHANTABILITY or FITNESS FOR A +;;; PARTICULAR PURPOSE. See the GNU General Public License +;;; for more details. +;;; +;;; The GNU General Public License can be found in the file +;;; LICENSE which should have been distributed with this +;;; code. It can also be found at +;;; +;;; http://www.opensource.org/licenses/gpl-license.php +;;; +;;; You should have received a copy of the GNU General +;;; Public License along with this program; if not, write +;;; to the Free Software Foundation, Inc., 59 Temple Place, +;;; Suite 330, Boston, MA 02111-1307 USA +;;; + (in-package "ELEPHANT") ;;; collection types ;;; abstract hash-like collections ;;; equal hashing (except probably for array, hashe, instance keys!) -(defclass collection (persistent) ()) +(defclass persistent-collection (persistent) ()) (defgeneric get-value (key ht &rest args)) (defgeneric remove-kv (key ht &rest args)) ;;; btree access -(defclass btree (collection) ()) +(defclass btree (persistent-collection) ()) (defmethod get-value (key (ht btree) &rest args) (declare (ignore args)) @@ -17,9 +55,10 @@ (let ((key-length (serialize key *key-buf*))) (handler-case (values - (deserialize (db-get-key-buffered (db *store-controller*) - (buffer-stream-buffer *key-buf*) - key-length)) + (deserialize (db-get-key-buffered + (controller-db *store-controller*) + (buffer-stream-buffer *key-buf*) + key-length)) t) (db-error (err) (if (= (db-error-errno err) DB_NOTFOUND) @@ -34,7 +73,7 @@ (buffer-write-int (oid ht) *key-buf*) (let ((key-length (serialize key *key-buf*)) (val-length (serialize value *out-buf*))) - (db-put-buffered (db *store-controller*) + (db-put-buffered (controller-db *store-controller*) (buffer-stream-buffer *key-buf*) key-length (buffer-stream-buffer *out-buf*) val-length :transaction transaction @@ -47,7 +86,7 @@ (declare (ignore args)) (buffer-write-int (oid ht) *key-buf*) (let ((key-length (serialize key *key-buf*))) - (db-delete-buffered (db *store-controller*) + (db-delete-buffered (controller-db *store-controller*) (buffer-stream-buffer *key-buf*) key-length :transaction transaction :auto-commit auto-commit)))

1 0

[elephant-cvs] CVS update: elephant/src/elephant.lisp
by blee＠common-lisp.net 27 Aug '04

27 Aug '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv13592/src Modified Files: elephant.lisp Log Message: license, name changes, with-transaction* defaulters Date: Fri Aug 27 10:32:10 2004 Author: blee Index: elephant/src/elephant.lisp diff -u elephant/src/elephant.lisp:1.2 elephant/src/elephant.lisp:1.3 --- elephant/src/elephant.lisp:1.2 Thu Aug 26 19:57:52 2004 +++ elephant/src/elephant.lisp Fri Aug 27 10:32:10 2004 @@ -1,11 +1,58 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;; +;;; elephant.lisp -- package definition and utilities +;;; +;;; Initial version 8/26/2004 by Ben Lee +;;; <blee(a)common-lisp.net> +;;; +;;; part of +;;; +;;; Elephant: an object-oriented database for Common Lisp +;;; +;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee +;;; <ablumberg(a)common-lisp.net> <blee(a)common-lisp.net> +;;; +;;; This program is free software; you can redistribute it +;;; and/or modify it under the terms of the GNU General +;;; Public License as published by the Free Software +;;; Foundation; either version 2 of the License, or (at +;;; your option) any later version. +;;; +;;; This program is distributed in the hope that it will be +;;; useful, but WITHOUT ANY WARRANTY; without even the +;;; implied warranty of MERCHANTABILITY or FITNESS FOR A +;;; PARTICULAR PURPOSE. See the GNU General Public License +;;; for more details. +;;; +;;; The GNU General Public License can be found in the file +;;; LICENSE which should have been distributed with this +;;; code. It can also be found at +;;; +;;; http://www.opensource.org/licenses/gpl-license.php +;;; +;;; You should have received a copy of the GNU General +;;; Public License along with this program; if not, write +;;; to the Free Software Foundation, Inc., 59 Temple Place, +;;; Suite 330, Boston, MA 02111-1307 USA +;;; + (defpackage elephant (:nicknames ele :ele) (:use common-lisp sleepycat) + (:shadow with-transaction with-transaction-retry) (:export *store-controller* *current-transaction* *auto-commit* store-controller open-controller close-controller - with-open-controller + with-open-controller controller-path controller-environment + controller-db controller-root + add-to-root get-from-root persistent persistent-object persistent-metaclass - with-transaction with-transaction-retry) + persistent-collection btree get-value remove-kv + db-transaction-begin db-transaction-abort db-transaction-commit + with-transaction with-transaction-retry + db-env-set-timeout db-env-get-timeout + db-env-set-flags db-env-get-flags + db-env-set-lock-detect db-env-get-lock-detect + ) #+cmu (:import-from :pcl slot-definition-name @@ -36,7 +83,7 @@ (defparameter *store-controller* nil "The store controller which persistent objects talk to.") -(defvar *auto-commit* nil) +(defvar *auto-commit* T) ;; Portable value-weak hash-tables for the cache: when the @@ -57,7 +104,7 @@ (defun get-cache (key cache) #+(or cmu sbcl scl) (let ((val (gethash key cache))) - (if val (values (weak-pointer-value val) t) + (if val (values (ext:weak-pointer-value val) t) (values nil nil))) #-(or cmu sbcl scl) (gethash key cache) @@ -65,8 +112,8 @@ (defun setf-cache (key cache value) #+(or cmu sbcl scl) - (let ((w (make-weak-pointer value))) - (finalize value #'(lambda () (remhash key cache))) + (let ((w (ext:make-weak-pointer value))) + (ext:finalize value #'(lambda () (remhash key cache))) (setf (gethash key cache) w) value) #+allegro

1 0

[elephant-cvs] CVS update: elephant/src/controller.lisp
by blee＠common-lisp.net 27 Aug '04

27 Aug '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv13575/src Modified Files: controller.lisp Log Message: license, name changes, with-transaction* defaulters Date: Fri Aug 27 10:31:59 2004 Author: blee Index: elephant/src/controller.lisp diff -u elephant/src/controller.lisp:1.2 elephant/src/controller.lisp:1.3 --- elephant/src/controller.lisp:1.2 Thu Aug 26 19:58:09 2004 +++ elephant/src/controller.lisp Fri Aug 27 10:31:59 2004 @@ -1,12 +1,51 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;; +;;; controller.lisp -- Lisp interface to a Berkeley DB store +;;; +;;; Initial version 8/26/2004 by Ben Lee +;;; <blee(a)common-lisp.net> +;;; +;;; part of +;;; +;;; Elephant: an object-oriented database for Common Lisp +;;; +;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee +;;; <ablumberg(a)common-lisp.net> <blee(a)common-lisp.net> +;;; +;;; This program is free software; you can redistribute it +;;; and/or modify it under the terms of the GNU General +;;; Public License as published by the Free Software +;;; Foundation; either version 2 of the License, or (at +;;; your option) any later version. +;;; +;;; This program is distributed in the hope that it will be +;;; useful, but WITHOUT ANY WARRANTY; without even the +;;; implied warranty of MERCHANTABILITY or FITNESS FOR A +;;; PARTICULAR PURPOSE. See the GNU General Public License +;;; for more details. +;;; +;;; The GNU General Public License can be found in the file +;;; LICENSE which should have been distributed with this +;;; code. It can also be found at +;;; +;;; http://www.opensource.org/licenses/gpl-license.php +;;; +;;; You should have received a copy of the GNU General +;;; Public License along with this program; if not, write +;;; to the Free Software Foundation, Inc., 59 Temple Place, +;;; Suite 330, Boston, MA 02111-1307 USA +;;; + (in-package "ELEPHANT") (defclass store-controller () ((path :type (or pathname string) - :reader path + :accessor controller-path :initarg :path) - (environment :type (or null pointer-void) :accessor environment) - (db :type (or null pointer-void) :accessor db) - (root :accessor root) + (environment :type (or null pointer-void) + :accessor controller-environment) + (db :type (or null pointer-void) :accessor controller-db) + (root :reader controller-root) (instance-cache :accessor instance-cache :initform (make-cache-table :test 'eql))) (:documentation "Class of objects responsible for handling @@ -20,11 +59,15 @@ persistables as well (though note collection key semantics!) N.B. this means it (and everything it points to) won't get gc'd." - (setf (get-value key (root sc)) value)) + (setf (get-value key (controller-root sc)) value)) (defmethod get-from-root ((sc store-controller) key) "Get a persistent thing from the root." - (get-value key (root sc))) + (get-value key (controller-root sc))) + +(defmethod remove-from-root ((sc store-controller) key) + "Get a persistent thing from the root." + (remove-kv key (controller-root sc))) (defmethod cache-instance ((sc store-controller) obj) "Register an instance of a user persistent-class with the @@ -32,38 +75,41 @@ (setf (get-cache (oid obj) (instance-cache sc)) obj)) (defmethod get-cached-instance ((sc store-controller) oid class-name) - (let ((obj (get-cache oid (instance-cache sc) nil))) + (let ((obj (get-cache oid (instance-cache sc)))) (if obj obj ;; Should get cached since make-instance calls cache-instance (make-instance class-name :from-oid oid)))) -(defmethod open-controller ((sc store-controller)) +(defmethod open-controller ((sc store-controller) &key (recover nil) + (recover-fatal nil) (thread t)) "Opens the underlying environment and all the necessary database tables." (let ((env (db-env-create))) ;; thread stuff? - (setf (environment sc) env) - (db-env-open env (path sc) :create t :init-txn t :init-lock t - :init-mpool t :init-log t :thread t :recover-fatal t) + (setf (controller-environment sc) env) + (db-env-open env (controller-path sc) :create t :init-txn t :init-lock t + :init-mpool t :init-log t :thread thread + :recover recover :recover-fatal recover-fatal) (let ((db (db-create env))) - (setf (db sc) db) - (db-open db :auto-commit t :type DB-BTREE :create t :thread t) + (setf (controller-db sc) db) + (db-open db :file "%ELEPHANT" :database "%ELEPHANTDB" + :auto-commit t :type DB-BTREE :create t :thread thread) (let ((root (make-instance 'btree :from-oid -1))) - (setf (root sc) root) + (setf (slot-value sc 'root) root) sc)))) (defmethod close-controller ((sc store-controller)) "Close the db handles and environment. Tries to wipe out references to the db handles." ; no root - (setf (root sc) nil) + (setf (slot-value sc 'root) nil) ; clean instance cache (setf (instance-cache sc) (make-cache-table :test 'eql)) ; close environment - (db-close (db sc)) - (setf (db sc) nil) - (db-env-close (environment sc)) - (setf (environment sc) nil) + (db-close (controller-db sc)) + (setf (controller-db sc) nil) + (db-env-close (controller-environment sc)) + (setf (controller-environment sc) nil) nil) (defmacro with-open-controller ((&optional (sc *store-controller*)) @@ -73,6 +119,43 @@ (open-controller ,sc) ,@body) (close-controller ,sc))) + +(defmacro with-transaction ((&key transaction + (environment (controller-environment + *store-controller*)) + (globally t) + (parent *current-transaction*) + dirty-read txn-nosync + txn-nowait txn-sync) + &body body) + `(sleepycat:with-transaction (:transaction ,transaction + :environment ,environment + :globally ,globally + :parent ,parent + :dirty-read ,dirty-read + :txn-nosync ,txn-nosync + :txn-nowait ,txn-nowait + :txn-sync ,txn-sync) + ,@body)) + +(defmacro with-transaction-retry ((&key transaction environment + (globally t) + (parent *current-transaction*) + (retries 100) + dirty-read txn-nosync + txn-nowait txn-sync) + &body body) + `(sleepycat:with-transaction-retry (:transaction ,transaction + :environment ,environment + :globally ,globally + :parent ,parent + :retries ,retries + :dirty-read ,dirty-read + :txn-nosync ,txn-nosync + :txn-nowait ,txn-nowait + :txn-sync ,txn-sync) + ,@body)) + ;; This stuff is all a hack until sequences appear in Sleepycat 4.3 (defconstant max-oid most-positive-fixnum)

1 0