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

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

02 Sep '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv31310/src Modified Files: sleepycat.lisp Log Message: next-oid fix: bug in counters, they weren't using the parent transactions and so were dead locking inside of with-transactions nested transactions are borking -- kword default to with-transactions should be '*current-transaction*, not *current-transaction* -- i want to capture the dynamic, not lexical environment Date: Thu Sep 2 16:47:11 2004 Author: blee Index: elephant/src/sleepycat.lisp diff -u elephant/src/sleepycat.lisp:1.8 elephant/src/sleepycat.lisp:1.9 --- elephant/src/sleepycat.lisp:1.8 Thu Sep 2 09:18:08 2004 +++ elephant/src/sleepycat.lisp Thu Sep 2 16:47:09 2004 @@ -866,7 +866,7 @@ (type boolean txn-nosync txn-sync))) (defmacro with-transaction ((&key transaction environment - (parent *current-transaction*) + (parent '*current-transaction*) (retries 100) dirty-read txn-nosync txn-nowait txn-sync) @@ -1078,14 +1078,15 @@ (def-function ("next_counter" %next-counter) ((env :pointer-void) (db :pointer-void) + (parent :pointer-void) (key array-or-pointer-char) (key-length :unsigned-int) (lockid array-or-pointer-char) (lockid-length :unsigned-int)) :returning :int) -(defun next-counter (env db key key-length lockid lockid-length) - (let ((ret (%next-counter env db key key-length lockid lockid-length))) +(defun next-counter (env db parent key key-length lockid lockid-length) + (let ((ret (%next-counter env db parent key key-length lockid lockid-length))) (if (< ret 0) (error 'db-error :errno ret) ret)))

1 0

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

02 Sep '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv31060/src Modified Files: libsleepycat.c Log Message: next-oid fix: bug in counters, they weren't using the parent transactions and so were dead locking inside of with-transactions Date: Thu Sep 2 16:45:53 2004 Author: blee Index: elephant/src/libsleepycat.c diff -u elephant/src/libsleepycat.c:1.6 elephant/src/libsleepycat.c:1.7 --- elephant/src/libsleepycat.c:1.6 Sun Aug 29 22:39:29 2004 +++ elephant/src/libsleepycat.c Thu Sep 2 16:45:53 2004 @@ -416,7 +416,8 @@ /* Poor man's counters */ -int next_counter(DB_ENV *env, DB *db, char *key, u_int32_t key_length, +int next_counter(DB_ENV *env, DB *db, DB_TXN *parent, + char *key, u_int32_t key_length, char *lockid, u_int32_t lockid_length) { DB_LOCK lock; DBT DBTKey, DBTData; @@ -439,7 +440,7 @@ lockheld = 0; /* Begin the transaction. */ - if ((ret = env->txn_begin(env, NULL, &tid, 0)) != 0) { + if ((ret = env->txn_begin(env, parent, &tid, 0)) != 0) { env->err(env, ret, "DB_ENV->txn_begin"); return (-1); }

1 0

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

02 Sep '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv30449/src Modified Files: controller.lisp Log Message: next-oid fix: bug in counters, they weren't using the parent transactions and so were dead locking inside of with-transactions Date: Thu Sep 2 16:42:38 2004 Author: blee Index: elephant/src/controller.lisp diff -u elephant/src/controller.lisp:1.6 elephant/src/controller.lisp:1.7 --- elephant/src/controller.lisp:1.6 Sun Aug 29 22:37:58 2004 +++ elephant/src/controller.lisp Thu Sep 2 16:42:38 2004 @@ -113,6 +113,7 @@ (defmethod next-oid ((sc store-controller)) (sleepycat::next-counter (controller-environment sc) (controller-db sc) + *current-transaction* %oid-entry %oid-entry-length %oid-lock %oid-lock-length))

1 0

[elephant-cvs] CVS update: elephant/src/classes.lisp
by blee＠common-lisp.net 02 Sep '04

02 Sep '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv30423/src Modified Files: classes.lisp Log Message: typo Date: Thu Sep 2 16:41:25 2004 Author: blee Index: elephant/src/classes.lisp diff -u elephant/src/classes.lisp:1.7 elephant/src/classes.lisp:1.8 --- elephant/src/classes.lisp:1.7 Thu Sep 2 09:09:57 2004 +++ elephant/src/classes.lisp Thu Sep 2 16:41:25 2004 @@ -90,7 +90,7 @@ (return t)))) (loop for slot-def in (class-slots class) unless (initialize-from-initarg slot-def) - when (member (slot-definition-name slot-def) persistent-slot-names :test #'eq) + when (member (slot-definition-name slot-def) persistent-slot-inits :test #'eq) unless (slot-boundp-using-class class instance slot-def) do (let ((initfun (slot-definition-initfunction slot-def)))

1 0

[elephant-cvs] CVS update: elephant/TUTORIAL
by blee＠common-lisp.net 02 Sep '04

02 Sep '04

Update of /project/elephant/cvsroot/elephant In directory common-lisp.net:/tmp/cvs-serv30393 Modified Files: TUTORIAL Log Message: comments on initforms and transactions Date: Thu Sep 2 16:39:12 2004 Author: blee Index: elephant/TUTORIAL diff -u elephant/TUTORIAL:1.4 elephant/TUTORIAL:1.5 --- elephant/TUTORIAL:1.4 Sun Aug 29 22:35:37 2004 +++ elephant/TUTORIAL Thu Sep 2 16:39:12 2004 @@ -250,6 +250,11 @@ you're concerned, cache values. (In the future we will provide automatic value caching.) +Finally, if you for some reason make an instance with a +specified OID which already exists in the database, initargs +take precedence over values in the database, which take +precedences over initforms. + ------------ Transactions ------------ @@ -388,3 +393,21 @@ The serializer is definitely fast on fixnums, strings, and persistent things. It is fairly fast but consing with floats and doubles. YMMV with other values. + +Using *auto-commit* and not "with-transactions" is a great +way to have a huge number of transactions. You'll find that + +(dotimes (i 1000) (add-to-root "key" "value")) + +is way slower than + +(let ((*auto-commit* nil)) + (with-transaction () + (dotimes (i 1000) (add-to-root "key" "value")))) + +since there's only 1 transaction in the latter. + +Use the persistent classes and collections; if you're using +transactions correctly they should be much faster. + +If you don't need transactions you can turn them off.

1 0

[elephant-cvs] CVS update: elephant/tests/testserializer.lisp
by blee＠common-lisp.net 02 Sep '04

02 Sep '04

Update of /project/elephant/cvsroot/elephant/tests In directory common-lisp.net:/tmp/cvs-serv23523/tests Modified Files: testserializer.lisp Log Message: typo Date: Thu Sep 2 09:32:16 2004 Author: blee Index: elephant/tests/testserializer.lisp diff -u elephant/tests/testserializer.lisp:1.1 elephant/tests/testserializer.lisp:1.2 --- elephant/tests/testserializer.lisp:1.1 Mon Aug 30 23:39:59 2004 +++ elephant/tests/testserializer.lisp Thu Sep 2 09:32:16 2004 @@ -16,7 +16,7 @@ (eq nil (cdr g)) (setq h (make-hash-table :test 'eql)) -(setf (gethash 10000000000 h) f) +(prog1 t (setf (gethash 10000000000 h) f)) (setq h2 (test h)) (= 1 (hash-table-count h2)) (prog1 t (setq g (gethash 10000000000 h2)))

1 0

[elephant-cvs] CVS update: elephant/tests/mop-tests.lisp
by blee＠common-lisp.net 02 Sep '04

02 Sep '04

Update of /project/elephant/cvsroot/elephant/tests In directory common-lisp.net:/tmp/cvs-serv22882/tests Modified Files: mop-tests.lisp Log Message: initarg / form tests Date: Thu Sep 2 09:30:13 2004 Author: blee Index: elephant/tests/mop-tests.lisp diff -u elephant/tests/mop-tests.lisp:1.1 elephant/tests/mop-tests.lisp:1.2 --- elephant/tests/mop-tests.lisp:1.1 Mon Aug 30 23:39:09 2004 +++ elephant/tests/mop-tests.lisp Thu Sep 2 09:30:12 2004 @@ -81,4 +81,13 @@ (defclass p-initform-test () ((slot1 :initform 10)) - (:metaclass persistent-metaclass)) \ No newline at end of file + (:metaclass persistent-metaclass)) + +(defclass p-initform-test-2 () + ((slot1 :initarg :slot1 :initform 10)) + (:metaclass persistent-metaclass)) + +(setq pf (make-instance 'p-initform-test-2)) +(slot-value pf 'slot1) +(setq pf (make-instance 'p-initform-test-2 :slot1 20)) +(slot-value pf 'slot1)

1 0

[elephant-cvs] CVS update: elephant/src/utils.lisp
by blee＠common-lisp.net 02 Sep '04

02 Sep '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv20809/src Modified Files: utils.lisp Log Message: reorder, typos Date: Thu Sep 2 09:21:45 2004 Author: blee Index: elephant/src/utils.lisp diff -u elephant/src/utils.lisp:1.2 elephant/src/utils.lisp:1.3 --- elephant/src/utils.lisp:1.2 Sun Aug 29 22:41:55 2004 +++ elephant/src/utils.lisp Thu Sep 2 09:21:45 2004 @@ -73,14 +73,32 @@ ;;; ;;; Thread-local specials +(defparameter *store-controller* nil + "The store controller which persistent objects talk to.") + +;; Specials which control persistent objects +(defvar *auto-commit* T) + +(declaim (type buffer-stream *out-buf* *key-buf* *in-buf*)) + +;; Buffers for going in and out of the DB +(defvar *out-buf* (make-buffer-stream)) +(defvar *key-buf* (make-buffer-stream)) +(defvar *in-buf* (make-buffer-stream)) + +;; Stuff the serializer uses +(defvar *lisp-obj-id* 0) +(defvar *circularity-hash* (make-hash-table :test 'eq)) +#+(or cmu scl sbcl allegro) +(defvar *resourced-byte-spec* (byte 32 0)) + ;; TODO: make this for real! (defun run-elephant-thread (thunk) - (let ((*current-transaction* +NULL-vOID+) + (let ((*current-transaction* +NULL-VOID+) (*errno-buffer* (allocate-foreign-object :int 1)) (*get-buffer* (allocate-foreign-object :char 1)) (*get-buffer-length* 0) - (*store-controller* nil) - ;(*auto-commit* T) which is correct? + (*store-controller* *store-controller*) (*auto-commit* *auto-commit*) (*out-buf* (make-buffer-stream)) (*key-buf* (make-buffer-stream)) @@ -97,26 +115,6 @@ (funcall thunk))) -(defparameter *store-controller* nil - "The store controller which persistent objects talk to.") - -;; Specials which control persistent objects -(defvar *auto-commit* T) - -(declaim (type buffer-stream *out-buf* *key-buf* *in-buf*)) - -;; Buffers for going in and out of the DB -(defvar *out-buf* (make-buffer-stream)) -(defvar *key-buf* (make-buffer-stream)) -(defvar *in-buf* (make-buffer-stream)) - -;; Stuff the serializer uses -(defvar *lisp-obj-id* 0) -(defvar *circularity-hash* (make-hash-table :test 'eq)) -#+(or cmu scl sbcl allegro) -(defvar *resourced-byte-spec* (byte 32 0)) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Macros @@ -125,7 +123,7 @@ (defmacro with-transaction ((&key transaction (environment (controller-environment *store-controller*)) - (parent '*current-transaction*) + (parent *current-transaction*) dirty-read txn-nosync txn-nowait txn-sync) &body body)

1 0

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

02 Sep '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv18343/src Modified Files: sleepycat.lisp Log Message: openmcl, errors on library load failure Date: Thu Sep 2 09:18:08 2004 Author: blee Index: elephant/src/sleepycat.lisp diff -u elephant/src/sleepycat.lisp:1.7 elephant/src/sleepycat.lisp:1.8 --- elephant/src/sleepycat.lisp:1.7 Mon Aug 30 23:36:54 2004 +++ elephant/src/sleepycat.lisp Thu Sep 2 09:18:08 2004 @@ -85,21 +85,29 @@ ;; This one worked for me. There are known issues with ;; Red Hat and Berkeley DB, search google. #+linux - (uffi:load-foreign-library "/lib/tls/libpthread.so.0" :module "pthread") - - ;; Sleepycat: this works on linux - #-bsd - (uffi:load-foreign-library "/usr/local/BerkeleyDB.4.2/lib/libdb.so" - :module "sleepycat") - ;; this works on FreeBSD - #+bsd - (uffi:load-foreign-library "/usr/local/lib/db42/libdb.so" - :module "sleepycat") + (unless + (uffi:load-foreign-library "/lib/tls/libpthread.so.0" :module "pthread") + (error "Couldn't load libpthread!")) + + (unless + (uffi:load-foreign-library + ;; Sleepycat: this works on linux + #+linux + "/usr/local/BerkeleyDB.4.2/lib/libdb.so" + ;; this works on FreeBSD + #+(or bsd freebsd) + "/usr/local/lib/db42/libdb.so" + #+darwin + "/usr/local/BerkeleyDB.4.2/lib/libdb.dylib" + :module "sleepycat") + (error "Couldn't load libdb (Sleepycat)!")) ;; Libsleepycat.so: edit this - (uffi:load-foreign-library - "/usr/local/share/common-lisp/elephant/libsleepycat.so" - :module "libsleepycat") + (unless + (uffi:load-foreign-library + "/usr/local/share/common-lisp/elephant-0.1/libsleepycat.so" + :module "libsleepycat") + (error "Couldn't load libsleepycat!")) ;; fini on user editable part @@ -107,7 +115,7 @@ (def-type pointer-void :pointer-void) (def-foreign-type array-or-pointer-char #+allegro (:array :char) - #+(or cmu sbcl scl) (* :char)) + #+(or cmu sbcl scl openmcl) (* :char)) (def-type array-or-pointer-char array-or-pointer-char) (def-enum DBTYPE ((:BTREE 1) :HASH :QUEUE :RECNO :UNKNOWN)) ) @@ -171,8 +179,8 @@ (defconstant DB_LOCK_NOTGRANTED -30994) (defconstant DB_NOTFOUND -30990) -(defconstant +NULL-VOID+ (make-null-pointer :void)) -(defconstant +NULL-CHAR+ (make-null-pointer :char)) +(defvar +NULL-VOID+ (make-null-pointer :void)) +(defvar +NULL-CHAR+ (make-null-pointer :char)) ;; Buffer management / pointer arithmetic @@ -273,7 +281,7 @@ (dynamic-extent src dest length)) (multiple-value-bind (ivector disp) (ccl::array-data-and-offset src) - (ccl::%copy-ivector-to-ptr src (+ disp src-offset) + (ccl::%copy-ivector-to-ptr ivector (+ disp src-offset) dest dest-offset length))) ;; Lisp version, for kicks. this assumes 8-bit chars! @@ -858,7 +866,7 @@ (type boolean txn-nosync txn-sync))) (defmacro with-transaction ((&key transaction environment - (parent '*current-transaction*) + (parent *current-transaction*) (retries 100) dirty-read txn-nosync txn-nowait txn-sync) @@ -934,12 +942,18 @@ (gen :unsigned-int) (mode DB-LOCKMODE)) +#+openmcl +(ccl:def-foreign-type DB-LOCK (:struct DB-LOCK)) + (def-struct DB-LOCKREQ (op DB-LOCKOP) (mode DB-LOCKMODE) (timeout :unsigned-int) (obj (:array :char)) (lock (* DB-LOCK))) + +#+openmcl +(ccl:def-foreign-type DB-LOCKREQ (:struct DB-LOCKREQ)) (def-function ("db_txn_id" %db-transaction-id) ((transaction :pointer-void))

1 0

[elephant-cvs] CVS update: elephant/src/metaclasses.lisp
by blee＠common-lisp.net 02 Sep '04

02 Sep '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv17181/src Modified Files: metaclasses.lisp Log Message: openmcl Date: Thu Sep 2 09:15:49 2004 Author: blee Index: elephant/src/metaclasses.lisp diff -u elephant/src/metaclasses.lisp:1.3 elephant/src/metaclasses.lisp:1.4 --- elephant/src/metaclasses.lisp:1.3 Mon Aug 30 23:15:12 2004 +++ elephant/src/metaclasses.lisp Thu Sep 2 09:15:48 2004 @@ -83,6 +83,7 @@ (defmethod direct-slot-definition-class ((class persistent-metaclass) &rest initargs) (let ((allocation-key (getf initargs :allocation)) (transient-p (getf initargs :transient))) + (when (consp transient-p) (setq transient-p (car transient-p))) (cond ((and (eq allocation-key :class) transient-p) (find-class 'transient-direct-slot-definition)) ((and (eq allocation-key :class) (not transient-p)) @@ -111,6 +112,7 @@ (defmethod effective-slot-definition-class ((class persistent-metaclass) &rest initargs) (let ((transient-p (getf initargs :transient))) + (when (consp transient-p) (setq transient-p (car transient-p))) (cond (transient-p (find-class 'transient-effective-slot-definition)) (t @@ -138,6 +140,43 @@ (let ((slot-definition (call-next-method))) (ensure-storage-exists class slot-definition slot-name) slot-definition)) + +#+openmcl +(defmethod compute-effective-slot-definition ((class persistent-metaclass) slot-name direct-slot-definitions) + (declare (ignore slot-name)) + (apply #'make-effective-slot-definition class + (compute-effective-slot-definition-initargs + class direct-slot-definitions))) + +#+openmcl +(defmethod compute-effective-slot-definition-initargs ((class slots-class) + direct-slots) + (let* ((name (loop for s in direct-slots + when s + do (return (slot-definition-name s)))) + (initer (dolist (s direct-slots) + (when (%slot-definition-initfunction s) + (return s)))) + (documentor (dolist (s direct-slots) + (when (%slot-definition-documentation s) + (return s)))) + (first (car direct-slots)) + (initargs (let* ((initargs nil)) + (dolist (dslot direct-slots initargs) + (dolist (dslot-arg (%slot-definition-initargs dslot)) + (pushnew dslot-arg initargs :test #'eq)))))) + (list + :name name + :allocation (%slot-definition-allocation first) + :documentation (when documentor (nth-value + 1 + (%slot-definition-documentation + documentor))) + :class (%slot-definition-class first) + :initargs initargs + :initfunction (if initer (%slot-definition-initfunction initer)) + :initform (if initer (%slot-definition-initform initer)) + :type (or (%slot-definition-type first) t)))) (defun ensure-transient-chain (slot-definitions initargs) (declare (ignore initargs))

1 0