Update of /project/elephant/cvsroot/elephant/src In directory common-lisp:/tmp/cvs-serv6576/src
Modified Files: Tag: ELEPHANT-0-4-1-rc1-IAN IAN-TODO classes.lisp controller.lisp index-utils.lisp indexing.lisp Log Message:
There may be a bug or two left, but the major locking problems have been resolved. Interactions due to reconnecting to databases can be problematic (i.e. indexing a new object when a cursor is walking the indices for that object leads to deadlock in the bdb code where the cursor has a read lock on an index that the persistent indexing wanted to write)
More tests needed, but the system appears largely stable now.
--- /project/elephant/cvsroot/elephant/src/classes.lisp 2006/01/30 04:55:00 1.16.2.5 +++ /project/elephant/cvsroot/elephant/src/classes.lisp 2006/02/02 21:48:38 1.16.2.6 @@ -79,20 +79,30 @@ metaclass.") (:metaclass persistent-metaclass))
-(defmethod initialize-instance ((instance persistent-object) &rest initargs) +;;(defmethod print-object ((obj persistent) stream) + +(defmethod initialize-instance ((instance persistent-object) &rest initargs &key from-oid &allow-other-keys) (declare (ignore initargs)) (if (indexed (class-of instance)) - (progn - (inhibit-indexing (oid instance)) - (unwind-protect - (progn - (call-next-method) - (uninhibit-indexing (oid instance)) - (let ((class-index (find-class-index (class-of instance)))) - (with-transaction () - (setf (get-value (oid instance) class-index) instance)))) - (uninhibit-indexing (oid instance)))) - (call-next-method))) + (progn + (let ((oid (oid instance))) + (declare (type fixnum oid)) + (inhibit-indexing oid) + (unwind-protect + (call-next-method) + (uninhibit-indexing oid)) + ;; Inhibit indexing if the object already was defined (ie being created from an oid) + ;; as it should be indexed already. This hack avoids a deadlock situation where we + ;; write the class or index page that we are currently reading via a cursor without + ;; going through the cursor abstraction. There has to be a better way to do this. + (when (not from-oid) + (let ((class-index (find-class-index (class-of instance)))) + (when class-index +;; (format t "Indexing initial instance: ~A :: ~A~%" oid instance) + (with-transaction () + (setf (get-value oid class-index) instance))))))) + ;; else + (call-next-method)))
(defmethod shared-initialize :around ((class persistent-metaclass) slot-names &rest args &key direct-superclasses) "Ensures we inherit from persistent-object." --- /project/elephant/cvsroot/elephant/src/controller.lisp 2006/01/29 04:57:20 1.14.2.2 +++ /project/elephant/cvsroot/elephant/src/controller.lisp 2006/02/02 21:48:38 1.14.2.3 @@ -56,15 +56,17 @@ )
(defun get-controller (spec) - (let ((store-controllers nil)) - (dolist (s *strategies*) - (let ((sc (funcall s spec))) - (if sc - (push sc store-controllers)))) - (if (not (= (length store-controllers) 1)) - (error "Strategy resolution for this spec completely failed!") - (car store-controllers)) - )) + (let ((cached-sc (gethash spec *dbconnection-spec*))) + (if cached-sc cached-sc + (let ((store-controllers nil)) + (dolist (s *strategies*) + (let ((sc (funcall s spec))) + (if sc + (push sc store-controllers)))) + (if (not (= (length store-controllers) 1)) + (error "Strategy resolution for this spec completely failed!") + (car store-controllers)) + ))))
(defclass store-controller () @@ -359,7 +361,7 @@ (setf (slot-value sc 'class-root) nil) (setf (slot-value sc 'root) nil) ;; clean instance cache - (setf (instance-cache sc) (make-cache-table :test 'eql)) + (reset-instance-cache sc) ;; close handles / environment (db-sequence-close (controller-oid-seq sc)) (setf (controller-oid-seq sc) nil) @@ -375,7 +377,10 @@ (setf (controller-db sc) nil) (db-env-close (controller-environment sc)) (setf (controller-environment sc) nil) - nil)) + nil) + ;; Delete connection spec so object ops on cached db info fail + (remhash (controller-path *store-controller*) *dbconnection-spec*)) +
;; Do these things need to take &rest arguments? (defmethod build-btree ((sc bdb-store-controller)) @@ -426,23 +431,25 @@ the controller unconditionally on exit." `(unwind-protect (progn - (let (*store-controller* (open-controller ,sc)) + (let ((*store-controller* (open-controller ,sc))) (declare (special *store-controller*)) ,@body)) (close-controller ,sc)))
(defun close-store () "Conveniently close the store controller." + (declare (special *store-controller*)) (if *store-controller* - (close-controller *store-controller*))) + (progn + (close-controller *store-controller*) + (setf *store-controller* nil))))
(defmacro with-open-store ((spec) &body body) "Executes the body with an open controller, unconditionally closing the controller on exit." - `(let ((*store-controller* - (get-controller ,spec))) + `(let ((*store-controller* (get-controller ,spec))) (declare (special *store-controller*)) -;; (open-controller *store-controller*) + (open-controller *store-controller*) (unwind-protect (progn ,@body) (close-controller *store-controller*))))