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