elephant-cvs

elephant-cvs@common-lisp.net

858 discussions

[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

[elephant-cvs] CVS update: elephant/src/elephant.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-serv16598/src Modified Files: elephant.lisp Log Message: openmcl Date: Thu Sep 2 09:10:34 2004 Author: blee Index: elephant/src/elephant.lisp diff -u elephant/src/elephant.lisp:1.7 elephant/src/elephant.lisp:1.8 --- elephant/src/elephant.lisp:1.7 Mon Aug 30 23:14:49 2004 +++ elephant/src/elephant.lisp Thu Sep 2 09:10:34 2004 @@ -43,7 +43,6 @@ (defpackage elephant (:nicknames ele :ele) (:use common-lisp sleepycat) - (:shadow #:with-transaction) (:export #:*store-controller* #:*current-transaction* #:*auto-commit* #:open-store #:close-store #:store-controller #:open-controller #:close-controller @@ -75,6 +74,7 @@ slot-value-using-class slot-boundp-using-class slot-definition-allocation + slot-definition-initargs compute-slots initialize-internal-slot-functions @@ -105,6 +105,7 @@ slot-value-using-class slot-boundp-using-class slot-definition-allocation + slot-definition-initargs compute-slots) #+sbcl (:import-from :sb-pcl @@ -136,17 +137,55 @@ slot-value-using-class slot-boundp-using-class slot-definition-allocation + slot-definition-initargs compute-slots) #+allegro (:import-from :excl compute-effective-slot-definition-initargs) - #+openmcl - (:import-from :openmcl-mop + #+openmcl + (:import-from :ccl + validate-superclass + standard-slot-definition + standard-direct-slot-definition + standard-effective-slot-definition + direct-slot-definition-class + effective-slot-definition-class slot-definition-name - compute-slots) + slot-definition-initfunction + compute-effective-slot-definition + class-slots + slot-value-using-class + slot-boundp-using-class + slot-definition-allocation + slot-definition-initargs + compute-slots + ;; This stuff we need until we resolve the :transient + ;; slot specifier stuff + make-effective-slot-definition + slots-class + %slot-definition-initfunction + %slot-definition-documentation + %slot-definition-initargs + %slot-definition-initform + %slot-definition-allocation + %slot-definition-class + %slot-definition-type) #+lispworks (:import-from :clos + validate-superclass + standard-slot-definition + standard-direct-slot-definition + standard-effective-slot-definition + direct-slot-definition-class + effective-slot-definition-class slot-definition-name + slot-definition-initfunction + compute-effective-slot-definition + class-slots + slot-value-using-class + slot-boundp-using-class + slot-definition-allocation + slot-definition-initargs compute-slots) )

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-serv16566/src Modified Files: classes.lisp Log Message: openmcl, fixed shared-initialize, slot-mkunbound Date: Thu Sep 2 09:09:57 2004 Author: blee Index: elephant/src/classes.lisp diff -u elephant/src/classes.lisp:1.6 elephant/src/classes.lisp:1.7 --- elephant/src/classes.lisp:1.6 Mon Aug 30 23:14:25 2004 +++ elephant/src/classes.lisp Thu Sep 2 09:09:57 2004 @@ -67,26 +67,37 @@ (call-next-method)))) (defmethod shared-initialize :around ((instance persistent-object) slot-names &rest initargs &key &allow-other-keys) + "This seems to be necessary because it is typical for implementations to optimize setting the slots via initforms and initargs in such a way that slot-value-using-class et al aren't used." (let* ((class (class-of instance)) (persistent-slot-names (persistent-slot-names class))) (flet ((persistent-slot-p (item) (member item persistent-slot-names :test #'eq))) (let ((transient-slot-inits - (if (eq slot-names t) + (if (eq slot-names t) ; t means all slots (transient-slot-names class) (remove-if #'persistent-slot-p slot-names))) (persistent-slot-inits (if (eq slot-names t) persistent-slot-names (remove-if-not #'persistent-slot-p slot-names)))) - (loop for slot-def in (class-slots class) - when (member (slot-definition-name slot-def) - persistent-slot-inits) - unless (slot-boundp-using-class class instance slot-def) - do - (let ((initfun (slot-definition-initfunction slot-def))) - (when initfun - (setf (slot-value-using-class class instance slot-def) - (funcall initfun))))) + ;; initialize the persistent slots + (flet ((initialize-from-initarg (slot-def) + (loop for initarg in initargs + with slot-initargs = (slot-definition-initargs slot-def) + when (member initarg slot-initargs :test #'eq) + do + (setf (slot-value-using-class class instance slot-def) + (getf initargs initarg)) + (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) + unless (slot-boundp-using-class class instance slot-def) + do + (let ((initfun (slot-definition-initfunction slot-def))) + (when initfun + (setf (slot-value-using-class class instance slot-def) + (funcall initfun)))))) + ;; let the implementation initialize the transient slots (apply #'call-next-method instance transient-slot-inits initargs))))) (defmethod slot-value-using-class :around (class (instance persistent-object) (slot-def persistent-slot-definition)) @@ -107,11 +118,11 @@ (defmethod slot-makunbound-using-class :around (class (instance persistent-object) (slot-def persistent-slot-definition)) (declare (ignore class)) (buffer-write-int (oid instance) *key-buf*) - (let* ((key-length (serialize (slot-definition-name slot-def) *key-buf*)) - (buf (db-delete-buffered - (controller-db *store-controller*) - (buffer-stream-buffer *key-buf*) - key-length - :transaction *current-transaction* - :auto-commit *auto-commit*))))) + (let ((key-length (serialize (slot-definition-name slot-def) *key-buf*))) + (db-delete-buffered + (controller-db *store-controller*) + (buffer-stream-buffer *key-buf*) + key-length + :transaction *current-transaction* + :auto-commit *auto-commit*)))

1 0

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

02 Sep '04

Update of /project/elephant/cvsroot/elephant In directory common-lisp.net:/tmp/cvs-serv16480 Modified Files: TODO Log Message: notes from rtoy on bignums Date: Thu Sep 2 09:05:36 2004 Author: blee Index: elephant/TODO diff -u elephant/TODO:1.1 elephant/TODO:1.2 --- elephant/TODO:1.1 Mon Aug 30 23:41:34 2004 +++ elephant/TODO Thu Sep 2 09:05:36 2004 @@ -14,7 +14,9 @@ Lispworks stuff (fli:replace-foreign-array...) -bignum fix +bignum fix: CMUCL / SBCL use %bignum-ref. OpenMCL: check +that ldb is non-consing (i think it is), look at +%ldb-fixnum-from-bignum) serialize lambdas, closures, packages.....

1 0

← Newer
1
...
75
76
77
78
79
80
81
...
86
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

elephant-cvs