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

Modified Files: classes.lisp classindex.lisp controller.lisp serializer2.lisp Log Message: Henrik's fixes and latest db-lisp updates

--- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/02/04 10:08:27 1.11 +++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/02/12 20:36:45 1.12 @@ -97,7 +97,7 @@ (update-indexed-record instance (indexed-slot-names-from-defs instance)) (if (removed-indexing? instance) (progn - (let ((class-idx (get-value (class-name instance) (controller-class-root *store-controller*)))) + (let ((class-idx (find-class-index (class-name instance)))) (when class-idx (wipe-class-indexing instance class-idx))) (setf (%index-cache instance) nil)) --- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/02/02 23:51:58 1.15 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/02/12 20:36:46 1.16 @@ -72,11 +72,11 @@ (con (get-con instance))) (declare (type fixnum oid)) (if (no-indexing-needed? class instance slot-def oid) - (with-transaction (:store-controller con) + (ensure-transaction (:store-controller con) (persistent-slot-writer con new-value instance slot-name)) (let ((class-idx (find-class-index class))) ;; (format t "Indexing object: ~A oid: ~A~%" instance oid) - (with-transaction (:store-controller con) + (ensure-transaction (:store-controller con) ;; NOTE: Quick and dirty hack to ensure consistency -- needs performance improvement (when (get-value oid class-idx) (remove-kv oid class-idx)) @@ -106,8 +106,7 @@ (when errorp (error "Class ~A is not an indexed class" class)) (if (class-index-cached? class) - ;; we've got a cached reference, just return it - (%index-cache class) + (%index-cache class) ;; we've got a cached reference, just return it (multiple-value-bind (btree found) (get-value (class-name class) (controller-class-root sc)) (if found @@ -431,23 +430,27 @@ nil)))))

+(defun subsets (size list) + (let ((subsets nil)) + (loop for elt in list + for i from 0 do + (when (= 0 (mod i size)) + (setf (car subsets) (nreverse (car subsets))) + (push nil subsets)) + (push elt (car subsets))) + (setf (car subsets) (nreverse (car subsets))) + (nreverse subsets))) + + (defmacro do-subsets ((subset subset-size list) &body body) - (let ((place (gensym)) - (i (gensym))) - `(let ((,place ,list) - (,subset nil)) - (loop while ,place do - (setf ,subset nil) - (loop for ,i from 1 upto ,subset-size do - (if (null ,place) (return) - (push (pop ,place) ,subset))) - ,@body)))) + `(loop for ,subset in (subsets ,subset-size ,list) do + ,@body))

(defun drop-instances (instances &key (sc *store-controller*)) (when instances (assert (consp instances)) (do-subsets (subset 500 instances) - (with-transaction (:store-controller sc) + (ensure-transaction (:store-controller sc) (mapc (lambda (instance) (remove-kv (oid instance) (find-class-index (class-of instance))) (drop-pobject instance)) --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/02/08 23:05:47 1.30 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/02/12 20:36:46 1.31 @@ -143,6 +143,7 @@ "Default version assumption for unmarked databases is 0.6.0" ;; NOTE: It is possible to check for 0.5.0 databases, but it is not ;; implemented now due to the low (none?) number of users still on 0.5.0" + (declare (ignorable sc)) (let ((db-version (call-next-method))) (if db-version db-version '(0 6 0)))) @@ -345,7 +346,7 @@ (apply #'open-controller controller args) (if *store-controller* (progn - (warning "Store controller already set so was not updated") + (warn "Store controller already set so was not updated") controller) (setq *store-controller* controller))))

--- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/08 15:58:26 1.20 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/12 20:36:46 1.21 @@ -165,13 +165,13 @@ (%serialize (frob) (etypecase frob (fixnum - (if (< #.most-positive-fixnum +2^31+) ;; should be compiled away + (if (< #.most-positive-fixnum +2^32+) ;; should be compiled away (progn (buffer-write-byte +fixnum32+ bs) (buffer-write-int32 frob bs)) (progn (assert (< #.most-positive-fixnum +2^64+)) - (if (< (abs frob) +2^32+) + (if (< (abs frob) +2^31+) (progn (buffer-write-byte +fixnum32+ bs) (buffer-write-int32 frob bs))