[elephant-cvs] CVS elephant/src/elephant

[ieslick]

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

Modified Files:
	classindex.lisp collections.lisp controller.lisp 
	serializer.lisp transactions.lisp 
Log Message:

Various edits and fixes on the way to 0.6.1



--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2006/04/30 01:01:05	1.12
+++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2006/06/19 01:03:30	1.13
@@ -257,12 +257,12 @@
 	    slot-name (class-name class))
       (progn
 	(when update-class (register-indexed-slot class slot-name))
-	(with-transaction (:store-controller sc)
+;;	(with-transaction (:store-controller sc)
 	  (add-index (find-class-index class :sc sc)
 		     :index-name slot-name 
 		     :key-form (make-slot-key-form class slot-name)
 		     :populate populate))
-	t)))
+	t))
 
 (defmethod remove-class-slot-index ((class symbol) slot-name &key (sc *store-controller*))
   (remove-class-slot-index (find-class class) slot-name :sc sc))
@@ -289,11 +289,11 @@
 	(error "Duplicate derived index requested named ~A on class ~A" name (class-name class))
 	(progn
 	  (when update-class (register-derived-index class name))
-	  (with-transaction (:store-controller sc)
+;;	  (with-transaction (:store-controller sc)
 	    (add-index class-idx
 		       :index-name (make-derived-name name)
 		       :key-form (make-derived-key-form derived-defun)
-		       :populate populate))))))
+		       :populate populate)))))
 
 (defmethod remove-class-derived-index ((class symbol) name &key (sc *store-controller*))
   (remove-class-derived-index (find-class class) name :sc sc))
--- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2006/04/26 17:53:44	1.4
+++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp	2006/06/19 01:03:30	1.5
@@ -348,6 +348,12 @@
   (map-btree #'(lambda (k v) (format t "k ~A / v ~A~%" k v)) bt)
   )
 
+(defun btree-keys (bt)
+  (format t "BTREE keys for ~A~%" bt)
+  (map-btree #'(lambda (k v) 
+		 (format t "key ~A / value type ~A~%" k (type-of v)))
+	     bt))
+
 (defun btree-differ (x y)
   (let ((cx1 (make-cursor x)) 
 	(cy1 (make-cursor y))
--- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp	2006/05/06 19:19:26	1.10
+++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp	2006/06/19 01:03:30	1.11
@@ -113,13 +113,12 @@
 ;; Open a Store
 ;;
 
-(defun open-store (spec &key (recover nil) (recover-fatal nil) (thread t))
+(defun open-store (spec &rest args)
   "Conveniently open a store controller."
   (assert (consp spec))
   (setq *store-controller* (get-controller spec))
   (ensure-marked-version
-   (open-controller *store-controller* :recover recover 
-		    :recover-fatal recover-fatal :thread thread)))
+   (apply #'open-controller *store-controller* args)))
 
 (defun close-store (&optional sc)
   "Conveniently close the store controller."
@@ -303,7 +302,7 @@
 ;; STORE CONTROLLER PROTOCOL
 ;; 
 
-(defgeneric open-controller (sc &key recover recover-fatal thread)
+(defgeneric open-controller (sc &key recover recover-fatal thread &allow-other-keys)
   (:documentation 
    "Opens the underlying environment and all the necessary
 database tables."))
--- /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp	2006/05/06 19:21:23	1.6
+++ /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp	2006/06/19 01:03:30	1.7
@@ -90,7 +90,7 @@
 	      (buffer-write-byte 
 	       #+(and allegro ics)
 	       (etypecase s
-		 (base-string +ucs2-symbol+) ;; +ucs1-symbol+
+		 (base-string +ucs1-symbol+) ;; +ucs1-symbol+
 		 (string +ucs2-symbol+))
 	       #+(or (and sbcl sb-unicode) lispworks)
 	       (etypecase s 
@@ -110,7 +110,7 @@
 	    (buffer-write-byte 
 	     #+(and allegro ics)
 	     (etypecase frob
-	       (base-string +ucs2-string+)  ;; +ucs1-string+
+	       (base-string +ucs1-string+)  ;; +ucs1-string+
 	       (string +ucs2-string+))
 	     #+(or (and sbcl sb-unicode) lispworks)
 	     (etypecase frob
@@ -152,7 +152,7 @@
 	      (buffer-write-byte 
 	       #+(and allegro ics) 
 	       (etypecase s
-		 (base-string +ucs2-pathname+) ;;  +ucs1-pathname+
+		 (base-string +ucs1-pathname+) ;;  +ucs1-pathname+
 		 (string +ucs2-pathname+))
 	       #+(or (and sbcl sb-unicode) lispworks)
 	       (etypecase s 
--- /project/elephant/cvsroot/elephant/src/elephant/transactions.lisp	2006/04/26 17:53:44	1.2
+++ /project/elephant/cvsroot/elephant/src/elephant/transactions.lisp	2006/06/19 01:03:30	1.3
@@ -33,7 +33,7 @@
  				  (parent '*current-transaction*)
  				  degree-2 dirty-read txn-nosync
 				  txn-nowait txn-sync
- 				  (retries 100))
+ 				  (retries 200))
 			     &body body)
   "Execute a body with a transaction in place.  On success,
    the transaction is committed.  Otherwise, the transaction is