[elephant-cvs] CVS elephant/src/elephant

[ieslick]

Update of /project/elephant/cvsroot/elephant/src/elephant
In directory clnet:/tmp/cvs-serv4997/src/elephant

Modified Files:
	classes.lisp collections.lisp controller.lisp package.lisp 
	pset.lisp variables.lisp 
Log Message:
Export bdb performance tweaks; lots more documentation; new ops for libberkeley-db

--- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/04/24 16:39:30	1.31
+++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/04/25 02:28:01	1.32
@@ -186,10 +186,12 @@
 ;;
 
 (defmethod change-class ((inst persistent) (class t) &rest rest)
-  (error "Changing a persistent instance's class to a non-persistent class is not currently allowed"))
+  (cerror "Ignore and continue?"
+          "Changing a persistent instance's class to a non-persistent class is not currently allowed"))
 
 (defmethod change-class ((inst standard-object) (class persistent-metaclass) &rest rest)
-  (error "Changing a standard instance to a persistent instance is not supported"))
+  (cerror "Ignore and continue?" 
+          "Changing a standard instance to a persistent instance is not supported"))
 
 (defmethod update-instance-for-different-class :around ((previous persistent) (current persistent) &rest initargs &key)
   (let* ((old-class (class-of previous))
--- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/04/24 03:02:27	1.25
+++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2007/04/25 02:28:01	1.26
@@ -354,7 +354,7 @@
 (defun lisp-compare-equal (a b)
   (equal a b))
 
-(defgeneric map-btree (fn btree &rest args &key start end value)
+(defgeneric map-btree (fn btree &rest args &key start end value &allow-other-keys)
   (:documentation   "Map btree maps over a btree from the value start to the value of end.
    If values are not provided, then it maps over all values.  BTrees 
    do not have duplicates, but map-btree can also be used with indices
@@ -365,9 +365,9 @@
 ;; function orders by type tag and nil is the highest valued type tag so nils are the last
 ;; possible element in a btree ordered by value.
 
-(defmethod map-btree (fn (btree btree) &rest args &key start end (value nil value-set-p))
+(defmethod map-btree (fn (btree btree) &rest args &key start end (value nil value-set-p) &allow-other-keys)
   (let ((end (if value-set-p value end)))
-    (ensure-transaction (:store-controller (get-con btree))
+    (ensure-transaction (:store-controller (get-con btree) :degree-2 *map-using-degree2*)
       (with-btree-cursor (curs btree)
 	(multiple-value-bind (exists? key value)
 	    (cond (value-set-p
@@ -386,7 +386,7 @@
 		   (funcall fn k v)
 		   (return nil)))))))))
 
-(defgeneric map-index (fn index &rest args &key start end value from-end collect)
+(defgeneric map-index (fn index &rest args &key start end value from-end collect &allow-other-keys)
   (:documentation "Map-index is like map-btree but for secondary indices, it
    takes a function of three arguments: key, value and primary
    key.  As with map-btree the keyword arguments start and end
@@ -398,7 +398,8 @@
    and end."))
 
 (defmethod map-index (fn (index btree-index) &rest args 
-		      &key start end (value nil value-set-p) from-end collect)
+		      &key start end (value nil value-set-p) from-end collect 
+		      &allow-other-keys)
   (declare (dynamic-extent args))
   (unless (or (null start) (null end) (lisp-compare<= start end))
     (error "map-index called with start = ~A and end = ~A. Start must be less than or equal to end according to elephant::lisp-compare<=."
@@ -410,7 +411,7 @@
 	     (push (funcall fn k v pk) results)))
       (let ((fn (if collect #'collector fn)))
       (declare (dynamic-extent (function collector)))
-      (ensure-transaction (:store-controller sc)
+      (ensure-transaction (:store-controller sc :degree-2 *map-using-degree2*)
 	(with-btree-cursor (cur index)
 	  (labels ((continue-p (key) 
 		     ;; Do we go to the next value?
--- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp	2007/04/23 02:26:53	1.49
+++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp	2007/04/25 02:28:01	1.50
@@ -133,6 +133,11 @@
    name
    (asdf:find-system :elephant)))
 
+(defun initialize-user-parameters ()
+  (loop for (keyword variable) in *user-configurable-parameters* do
+       (awhen (get-user-configuration-parameter keyword)
+	 (setf variable it))))
+
 ;;
 ;; COMMON STORE CONTROLLER FUNCTIONALITY
 ;;
@@ -465,6 +470,8 @@
    their *store-controller* to a given dynamic context or wrap each store-specific op in
    a transaction using with or ensure transaction"
   (assert (consp spec))
+  ;; Ensure that parameters are set
+  (initialize-user-parameters)
   (let ((controller (get-controller spec)))
     (apply #'open-controller controller args)
     (if *store-controller*
--- /project/elephant/cvsroot/elephant/src/elephant/package.lisp	2007/04/22 03:35:09	1.32
+++ /project/elephant/cvsroot/elephant/src/elephant/package.lisp	2007/04/25 02:28:02	1.33
@@ -208,7 +208,7 @@
    #:persistent #:persistent-object #:persistent-metaclass #:defpclass
    #:persistent-collection #:drop-pobject
 
-   #:pset #:make-pset #:insert-item #:remove-item #:map-pset #:find-item #:pset-list
+   #:pset #:make-pset #:insert-item #:remove-item #:map-pset #:find-item #:pset-list #:drop-pset
 
    #:btree #:make-btree
    #:get-value #:remove-kv #:existsp
--- /project/elephant/cvsroot/elephant/src/elephant/pset.lisp	2007/04/12 02:47:33	1.2
+++ /project/elephant/cvsroot/elephant/src/elephant/pset.lisp	2007/04/25 02:28:02	1.3
@@ -54,6 +54,9 @@
   (:documentation "Construct an empty default pset or backend specific pset.
                    This is an internal function used by make-pset"))
 
+(defgeneric drop-pset (pset)
+  (:documentation "Release pset storage to database for reuse"))
+
 ;; NOTE: Other operators?
 ;; - Efficient union, intersection and difference fn's exploiting an underlying
 ;;   sorted order?
@@ -117,6 +120,16 @@
 		   (push item list))
 		 (pset-btree pset)))
     list))
+
+(defmethod drop-pset ((pset default-pset))
+  (ensure-transaction (:store-controller *store-controller*)
+    (with-btree-cursor (cur (pset-btree pset))
+      (loop for exists? = (cursor-first cur)
+	    then (cursor-next cur)
+	    while exists?
+            do (cursor-delete cur)))))
+            
+            
 	  
 	   
 
--- /project/elephant/cvsroot/elephant/src/elephant/variables.lisp	2007/04/24 12:58:10	1.16
+++ /project/elephant/cvsroot/elephant/src/elephant/variables.lisp	2007/04/25 02:28:02	1.17
@@ -39,11 +39,32 @@
    error")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; General support for user configurable parameters
+
+(defvar *user-configurable-parameters*
+  '((:map-using-degree2 *map-using-degree2*)
+    (:berkeley-db-cachesize *berkeley-db-cachesize*)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;; Optimization parameters
 
 (defvar *circularity-initial-hash-size* 50
   "This is the default size of the circularity cache used in the serializer")
 
+(defparameter *map-using-degree2* t
+  "This parameter enables an optimization for the Berkeley DB data store
+   that allows a map operator to walk over a btree without locking all
+   read data, it only locks written objects and the current object")
+
+(defvar *berkeley-db-cachesize* 10485760
+  "This parameter controls the size of the berkeley db data store page
+   cache.  This parameter can be increased by to 4GB on 32-bit machines
+   and much larger on other machines.  Using the db_stat utility to identify
+   cache hit frequency on your application is a good way to tune this number.
+   The default is 20 megabytes specified in bytes.  If you need to specify
+   Gigbyte + cache sizes, talk to the developers!  This is ignored for
+   existing databases that were created with different parameters")
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Legacy Thread-local specials