[elephant-cvs] CVS elephant/src/elephant

[ieslick]

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)))
-	  , at body))))
+  `(loop for ,subset in (subsets ,subset-size ,list) do
+	, at 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))