[elephant-cvs] CVS elephant/src/elephant
ieslick
ieslick at common-lisp.net
Sat Apr 28 02:31:31 UTC 2007
Update of /project/elephant/cvsroot/elephant/src/elephant
In directory clnet:/tmp/cvs-serv16753/src/elephant
Modified Files:
classindex.lisp collections.lisp controller.lisp package.lisp
transactions.lisp
Log Message:
Cleaning up root directory files; map-index performance enhancement, index api cleanup, ensure transaction fix, alpha quality documentation draft
--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/04/24 12:58:10 1.39
+++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/04/28 02:31:15 1.40
@@ -84,11 +84,23 @@
(let ((class (find-class class-name nil)))
(when class (indexed class))))
+(define-condition persistent-class-not-indexed (error)
+ ((class-obj :initarg :class :initarg nil :reader unindexed-class-obj)))
+
+(defun signal-class-not-indexed (class)
+ (cerror "Ignore and continue?"
+ 'persistent-class-not-indexed
+ :format-control "Class ~A is not enabled for indexing"
+ :format-arguments (list (class-name class))
+ :class class))
+
+;; (define-condition
+
(defmethod find-class-index ((class persistent-metaclass) &key (sc *store-controller*) (errorp t))
(ensure-finalized class)
(if (not (indexed class))
(when errorp
- (error "Class ~A is not an indexed class" class))
+ (signal-class-not-indexed class))
(if (class-index-cached? class)
(%index-cache class) ;; we've got a cached reference, just return it
(multiple-value-bind (btree found)
@@ -110,31 +122,26 @@
(synchronize-class-to-store class :sc sc :method method)
btree))
-(define-condition persistent-class-not-indexed (error)
- ((class-obj :initarg :class :initarg nil :reader unindexed-class-obj)))
-
(defun cache-new-class-index (class sc)
"If not cached or persistent then this is a new class, make the new index"
(if (indexed class)
(enable-class-indexing class (indexing-record-slots (indexed-record class)) :sc sc)
- (signal 'persistent-class-not-indexed
- :class class
- :format-control "Class ~A is not enabled for indexing"
- :format-arguments (list (class-name class)))))
+ (signal-class-not-indexed class)))
(defmethod find-inverted-index ((class symbol) slot &key (null-on-fail nil))
(find-inverted-index (find-class class) slot :null-on-fail null-on-fail))
(defmethod find-inverted-index ((class persistent-metaclass) slot &key (null-on-fail nil))
- (let* ((cidx (find-class-index class))
+ (let* ((cidx (find-class-index class :errorp (not null-on-fail)))
(idx (or (get-index cidx slot)
(get-index cidx (make-derived-name slot)))))
(if idx
idx
(if null-on-fail
nil
- (error "Inverted index ~A not found for class ~A with
- persistent slots: ~A" slot (class-name class) (car (%persistent-slots class)))))))
+ (cerror "Ignore and continue?"
+ "Inverted index ~A not found for class ~A with persistent slots: ~A"
+ slot (class-name class) (car (%persistent-slots class)))))))
(defmethod find-inverted-index-names ((class persistent-metaclass))
(let ((names nil))
--- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/04/27 13:32:17 1.27
+++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/04/28 02:31:15 1.28
@@ -312,6 +312,7 @@
primary key greater or equal to the pkey argument. Returns
has-tuple / secondary key / value / primary key."))
+
(defgeneric cursor-next-dup (cursor)
(:documentation
"Move to the next duplicate element (with the same key.)
@@ -322,11 +323,6 @@
"Move to the next non-duplicate element (with different
key.) Returns has-pair key value."))
-(defgeneric cursor-prev-nodup (cursor)
- (:documentation
- "Move to the previous non-duplicate element (with
-different key.) Returns has-pair key value."))
-
(defgeneric cursor-pnext-dup (cursor)
(:documentation
"Move to the next duplicate element (with the same key.)
@@ -338,12 +334,53 @@
key.) Returns has-tuple / secondary key / value / primary
key."))
+
+(defgeneric cursor-prev-dup (cursor)
+ (:documentation
+ "Move to the previous duplicate element (with the same key.)
+Returns has-pair key value."))
+
+(defmethod cursor-prev-dup ((cur cursor))
+ "Default implementation. Plan is to update both backends when BDB 4.6 comes out"
+ (when (cursor-initialized-p cur)
+ (multiple-value-bind (exists? skey-cur)
+ (cursor-current cur)
+ (declare (ignore exists?))
+ (multiple-value-bind (exists? skey value)
+ (cursor-prev cur)
+ (if (lisp-compare-equal skey-cur skey)
+ (values exists? skey value)
+ (setf (cursor-initialized-p cur) nil))))))
+
+(defgeneric cursor-prev-nodup (cursor)
+ (:documentation
+ "Move to the previous non-duplicate element (with
+different key.) Returns has-pair key value."))
+
+(defgeneric cursor-pprev-dup (cursor)
+ (:documentation
+ "Move to the previous duplicate element (with the same key.)
+Returns has-tuple / secondary key / value / primary key."))
+
+(defmethod cursor-pprev-dup ((cur cursor))
+ "Default implementation. Plan is to update both backends when BDB 4.6 comes out"
+ (when (cursor-initialized-p cur)
+ (multiple-value-bind (exists? skey-cur)
+ (cursor-current cur)
+ (declare (ignore exists?))
+ (multiple-value-bind (exists? skey value pkey)
+ (cursor-pprev cur)
+ (if (lisp-compare-equal skey-cur skey)
+ (values exists? skey value pkey)
+ (setf (cursor-initialized-p cur) nil))))))
+
(defgeneric cursor-pprev-nodup (cursor)
(:documentation
"Move to the previous non-duplicate element (with
different key.) Returns has-tuple / secondary key / value /
primary key."))
+
(defmacro with-btree-cursor ((var bt) &body body)
"Macro which opens a named cursor on a BTree (primary or
not), evaluates the forms, then closes the cursor."
@@ -439,6 +476,7 @@
start end))
(let ((sc (get-con index))
(end (or value end))
+ (from-end (and from-end (not value-set-p)))
(results nil))
(flet ((collector (k v pk)
(push (funcall fn k v pk) results)))
@@ -454,11 +492,12 @@
(lisp-compare-equal key start))
(lisp-compare<= key end))))
(value-increment ()
- ;; Step to the next key value
+ ;; Step to the next key value;
+ ;; from-end duplicate cursor is already there
(if from-end
- (pprev-hack cur)
+ (cursor-current cur)
(cursor-pnext-nodup cur)))
- (next-value ()
+ (map-values ()
;; Handle the next key value
(multiple-value-bind (exists? skey val pkey)
(value-increment)
@@ -468,18 +507,23 @@
(map-duplicates skey))
(return-from map-index
(nreverse results)))))
+ (next-duplicate (key)
+ (if from-end
+ (pprev-dup-hack cur key)
+ (cursor-pnext-dup cur)))
(map-duplicates (key)
;; Map all duplicates for key value
(multiple-value-bind (exists? skey val pkey)
- (cursor-pnext-dup cur)
+ (next-duplicate key)
(if exists?
(progn
(funcall fn skey val pkey)
(map-duplicates key))
(progn
- (cursor-pset-range cur key)
- (next-value))))))
- (declare (dynamic-extent (function next-value) (function next-value-increment)
+ (unless from-end
+ (cursor-pset cur key))
+ (map-values))))))
+ (declare (dynamic-extent (function map-values) (function next-duplicate)
(function continue-p) (function map-duplicates)))
(multiple-value-bind (exists? skey val pkey)
(cond (value-set-p
@@ -487,9 +531,9 @@
((and (not from-end) (null start))
(cursor-pfirst cur))
((and from-end (null end))
- (cursor-last-range-hack cur))
+ (cursor-plast cur))
(t (if from-end
- (cursor-pset-range cur end)
+ (pset-range-for-descending cur end)
(cursor-pset-range cur start))))
(if (and exists? (continue-p skey))
(progn
@@ -497,23 +541,24 @@
(map-duplicates skey))
nil)))))))))
-(defun pprev-hack (cur)
- "Get the first duplicate instance of the prior value off the current cursor"
- (let ((e? (cursor-pprev-nodup cur)))
- (when e?
- (let ((e? (cursor-pprev-nodup cur)))
- (if e?
- (cursor-pnext cur)
- (cursor-pfirst cur))))))
-
-(defun cursor-last-range-hack (cur)
- "Get the first duplicate instance of the last value of the cursor's index"
- (let ((e? (cursor-plast cur)))
- (when e?
- (let ((e? (cursor-pprev-nodup cur)))
- (if e?
- (cursor-pnext cur)
- (cursor-pfirst cur))))))
+(defun pset-range-for-descending (cur end)
+ (if (cursor-pset cur end)
+ (progn
+ (cursor-next-nodup cur)
+ (cursor-pprev cur))
+ (progn
+ (cursor-pset-range cur end)
+ (cursor-pprev cur))))
+
+(defun pprev-dup-hack (cur key)
+ "Go back one step in a duplicate set, returns nil
+ if previous element is a different key. More efficient than
+ the current default implementation of cursor-pprev-dup"
+ (multiple-value-bind (exists? skey value pkey)
+ (cursor-pprev cur)
+ (when (lisp-compare-equal key skey)
+ (values exists? key value pkey))))
+
;; ===============================
;; Some generic utility functions
--- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/04/25 02:28:01 1.50
+++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/04/28 02:31:15 1.51
@@ -136,7 +136,7 @@
(defun initialize-user-parameters ()
(loop for (keyword variable) in *user-configurable-parameters* do
(awhen (get-user-configuration-parameter keyword)
- (setf variable it))))
+ (setq variable it))))
;;
;; COMMON STORE CONTROLLER FUNCTIONALITY
@@ -165,7 +165,7 @@
"This is an instance cache and part of the
metaclass protocol. Data stores should not
override the default behavior.")
- (instance-cache-lock :accessor instance-cache-lock :initform (ele-make-lock)
+ (instance-cache-lock :accessor instance-cache-lock :initform (ele-make-fast-lock)
:documentation "Protection for updates to
the cache from multiple threads. Do not
override.")
@@ -202,14 +202,16 @@
(defun cache-instance (sc obj)
"Cache a persistent object with the controller."
(declare (type store-controller sc))
- (ele-with-lock ((instance-cache-lock sc))
+ (ele-with-fast-lock ((instance-cache-lock sc))
(setf (get-cache (oid obj) (instance-cache sc)) obj)))
(defun get-cached-instance (sc oid class-name)
"Get a cached instance, or instantiate!"
(declare (type store-controller sc)
(type fixnum oid))
- (let ((obj (get-cache oid (instance-cache sc))))
+ (let ((obj
+ (ele-with-fast-lock ((instance-cache-lock sc))
+ (get-cache oid (instance-cache sc)))))
(if obj obj
;; Should get cached since make-instance calls cache-instance
(make-instance class-name :from-oid oid :sc sc))))
--- /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2007/04/27 13:32:17 1.34
+++ /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2007/04/28 02:31:16 1.35
@@ -222,12 +222,12 @@
#:cursor #:secondary-cursor #:make-cursor #:make-simple-cursor
#:cursor-close #:cursor-duplicate #:cursor-current #:cursor-first
#:cursor-last #:cursor-next #:cursor-next-dup
- #:cursor-next-nodup #:cursor-prev #:cursor-prev-nodup
+ #:cursor-next-nodup #:cursor-prev #:cursor-prev-nodup #:cursor-prev-dup
#:cursor-set #:cursor-set-range #:cursor-get-both
#:cursor-get-both-range #:cursor-delete #:cursor-put
#:cursor-pcurrent #:cursor-pfirst #:cursor-plast
#:cursor-pnext #:cursor-pnext-dup #:cursor-pnext-nodup
- #:cursor-pprev #:cursor-pprev-nodup #:cursor-pset
+ #:cursor-pprev #:cursor-pprev-dup #:cursor-pprev-nodup #:cursor-pset
#:cursor-pset-range #:cursor-pget-both #:cursor-pget-both-range
#:cursor-initialized-p
@@ -267,6 +267,7 @@
;; Various error conditions
#:cross-reference-error
#:controller-lost-error
+ #:persistent-class-not-indexed
#:map-class-query
#:get-query-instances
--- /project/elephant/cvsroot/elephant/src/elephant/transactions.lisp 2007/04/27 13:32:17 1.12
+++ /project/elephant/cvsroot/elephant/src/elephant/transactions.lisp 2007/04/28 02:31:16 1.13
@@ -120,7 +120,7 @@
If nested, the backend must support nested transactions."
(let ((sc (gensym)))
`(let ((,sc ,store-controller))
- (funcall #'execute-transaction ,store-controller
+ (funcall #'execute-transaction ,sc
(lambda () , at body)
:parent (if (owned-txn-p ,sc ,parent)
(transaction-object ,parent)
@@ -146,10 +146,9 @@
(,sc ,store-controller))
(if (owned-txn-p ,sc ,parent)
(funcall ,txn-fn)
- (funcall #'execute-transaction ,store-controller
+ (funcall #'execute-transaction ,sc
,txn-fn
:parent nil
- :transaction nil
:retries ,retries
,@(remove-keywords '(:store-controller :parent :transaction :retries)
keyargs))))))
More information about the Elephant-cvs
mailing list