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

Modified Files: classes.lisp classindex.lisp collections.lisp controller.lisp metaclasses.lisp transactions.lisp Log Message: Documentation, optimizations, deadlock process, etc

--- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/02/12 20:36:45 1.12 +++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/02/14 04:36:10 1.13 @@ -20,6 +20,8 @@

(defvar *debug-si* nil)

+(declaim #-elephant-without-optimize (optimize (speed 3))) + (defmethod initialize-instance :before ((instance persistent) &rest initargs &key from-oid @@ -235,13 +237,11 @@

(defmethod slot-value-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition)) "Get the slot value from the database." - (declare (optimize (speed 3))) (let ((name (slot-definition-name slot-def))) (persistent-slot-reader (get-con instance) instance name)))

(defmethod (setf slot-value-using-class) :around (new-value (class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition)) "Set the slot value in the database." - (declare (optimize (speed 3))) (if (indexed class) (indexed-slot-writer class instance slot-def new-value) (let ((name (slot-definition-name slot-def))) @@ -249,13 +249,11 @@

(defmethod slot-boundp-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition)) "Checks if the slot exists in the database." - (declare (optimize (speed 3))) (let ((name (slot-definition-name slot-def))) (persistent-slot-boundp (get-con instance) instance name)))

(defmethod slot-boundp-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-name symbol)) "Checks if the slot exists in the database." - (declare (optimize (speed 3))) (loop for slot in (class-slots class) for matches-p = (eq (slot-definition-name slot) slot-name) until matches-p @@ -266,7 +264,6 @@

(defmethod slot-makunbound-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition)) "Deletes the slot from the database." - (declare (optimize (speed 3))) ;; NOTE: call remove-indexed-slot here instead? ;; (when (indexed slot-def) ;; (unregister-indexed-slot class (slot-definition-name slot-def))) @@ -322,8 +319,7 @@ #+(or cmu sbcl) (defun make-persistent-reader (name) (lambda (instance) - (declare (optimize (speed 3)) - (type persistent-object instance)) + (declare (type persistent-object instance)) (persistent-slot-reader (get-con instance) instance name)))

#+(or cmu sbcl) @@ -336,8 +332,7 @@ #+(or cmu sbcl) (defun make-persistent-slot-boundp (name) (lambda (instance) - (declare (optimize (speed 3)) - (type persistent-object instance)) + (declare (type persistent-object instance)) (persistent-slot-boundp (get-con instance) instance name)))

#+sbcl ;; CMU also? Old code follows... --- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/02/12 20:36:46 1.16 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/02/14 04:36:10 1.17 @@ -12,6 +12,8 @@

(in-package "ELEPHANT")

+(declaim #-elephant-without-optimize (optimize (speed 3) (safety 1))) + ;; ;; User level class indexing control protocol ;; @@ -72,8 +74,7 @@ (con (get-con instance))) (declare (type fixnum oid)) (if (no-indexing-needed? class instance slot-def oid) - (ensure-transaction (:store-controller con) - (persistent-slot-writer con new-value instance slot-name)) + (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) (ensure-transaction (:store-controller con) @@ -375,9 +376,7 @@ (get-instances-by-value (find-class class) slot-name value))

(defmethod get-instances-by-value ((class persistent-metaclass) slot-name value) -;; (declare -;; (optimize (speed 3) (safety 1) (space 1)) -;; (type (or string symbol) slot-name)) + (declare (type (or string symbol) slot-name)) (let ((instances nil)) (with-btree-cursor (cur (find-inverted-index class slot-name)) (multiple-value-bind (exists? skey val pkey) (cursor-pset cur value) @@ -405,9 +404,8 @@ (get-instances-by-range (find-class class) slot-name start end))

(defmethod get-instances-by-range ((class persistent-metaclass) idx-name start end) -;; (declare (optimize speed (safety 1) (space 1)) -;; (type fixnum start end) -;; (type string idx-name)) + (declare (type fixnum start end) + (type string idx-name)) (with-inverted-cursor (cur class idx-name) (labels ((next-range (instances) (multiple-value-bind (exists? skey val pkey) (cursor-pnext-nodup cur) @@ -429,23 +427,6 @@ (next-in-range skey (cons val nil)) 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) - `(loop for ,subset in (subsets ,subset-size ,list) do - ,@body)) - (defun drop-instances (instances &key (sc *store-controller*)) (when instances (assert (consp instances)) --- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/02/02 23:51:58 1.7 +++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/02/14 04:36:10 1.8 @@ -325,7 +325,7 @@

(defmethod map-btree (fn (btree btree)) "Like maphash. Default implementation - overridable" - (ensure-transaction (:store-controller (get-con btree)) + (with-transaction (:store-controller (get-con btree)) (with-btree-cursor (curs btree) (loop (multiple-value-bind (more k v) (cursor-next curs) @@ -338,15 +338,25 @@ (multiple-value-bind (valid k) (cursor-next cur) (cond ((not valid) ;; truly empty t) - ((eq k *elephant-properties-label*) ;; has properties + ((and (eq btree (controller-root (get-con btree))) + (eq k *elephant-properties-label*)) ;; has properties (not (cursor-next cur))) (t nil))))))

-(defun dump-btree (bt) +(defun print-btree-node (k v) + (format t "k ~A / v ~A~%" k v)) + +(defun dump-btree (bt &key (print-fn #'print-btree-node) (count nil)) + "Print the contents of a btree for easy inspection & debugging" (format t "DUMP ~A~%" bt) - (map-btree #'(lambda (k v) (format t "k ~A / v ~A~%" k v)) bt) - ) + (let ((i 0)) + (map-btree + (lambda (k v) + (when (and count (>= (incf i) count)) + (return-from dump-btree)) + (funcall print-fn k v)) + bt)))

(defun btree-keys (bt) (format t "BTREE keys for ~A~%" bt) --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/02/12 20:36:46 1.31 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/02/14 04:36:10 1.32 @@ -193,7 +193,6 @@ (migrate target source) (close-store target)))

- ;; ;; Modular serializer support and default serializers for a version ;; --- /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp 2006/04/26 17:53:44 1.7 +++ /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp 2007/02/14 04:36:10 1.8 @@ -20,6 +20,8 @@

(in-package "ELEPHANT")

+(declaim #-elephant-without-optimize (optimize (speed 3) (safety 1))) + (defclass persistent () ((%oid :accessor oid :initarg :from-oid) (dbonnection-spec-pst :type (or list string) :accessor :dbcn-spc-pst :initarg :dbconnection-spec-pst)) --- /project/elephant/cvsroot/elephant/src/elephant/transactions.lisp 2007/02/02 23:51:58 1.5 +++ /project/elephant/cvsroot/elephant/src/elephant/transactions.lisp 2007/02/14 04:36:10 1.6 @@ -26,6 +26,39 @@ non-local exist, provides ACID properties for DB operations within the body and properly binds any relevant parameters."))

+;; Transaction architecture: +;; +;; User and designer considerations: +;; - *current-transaction* is reserved for use by dynamic transaction context. The default global +;; value must always be null (no transaction). Each backend can set it to a different parameter +;; within the dynamic context of an execute-transaction. +;; - Any closures returned from within a transaction cannot bind *current-transaction* +;; - Only a normal return value will result in the transaction being committed, any non-local exit +;; results in a transaction abort. If you want to do something more sophisticated, roll your own +;; using controller-start-transaction, etc. +;; - The body of a with or ensure transaction can take any action (throw, signal, error, etc) +;; knowing that the transaction will be aborted +;; +;; Designer considerations: +;; - with-transaction passes *current-transaction* or the user parameter to execute-transaction +;; in the parent keyword argument. Backends allowing nested transactions can treat the transaction +;; as a parent, otherwise they can reuse the current transaction by ignoring it (inheriting the dynamic +;; value of *current-transaction*) or rebinding the dynamic context (whatever makes coding easier). +;; - ensure-transaction uses *current-transaction* to determine if there is a current transaction +;; in progress. If so, it jumps to the body directly. Otherwise it executes the body in a +;; new transaction. +;; - execute-transaction contract: +;; - Backends must dynamically bind *current-transaction* to a meaningful identifier for the +;; transaction in progress and execute the provided closure in that context +;; - All non-local exists result in an abort; only regular return values result in a commit +;; - If a transaction is aborted due to a deadlock or read conflict, execute-transaction should +;; automatically retry with an appropriate default amount +;; - execute-transaction can take any number of backend-defined keywords, although designers should +;; make sure there are no semantic conflicts if there is a name overlap with existing backends +;; - A typical design approach is to make sure that the most primitive interfaces to the backend +;; database look at *current-transaction* to determine whether a transaction is active. Users code can also +;; access this parameter to check whether a transaction is active. + (defmacro with-transaction ((&rest keyargs &key (store-controller '*store-controller*) (parent '*current-transaction*) @@ -66,7 +99,13 @@ :retries ,retries ,@(remove-keywords '(:store-controller :parent :transaction :retries) keyargs)))))) - + +(defmacro with-batched-transaction ((batch size list &rest txn-options) &body body) + "Perform a set of DB operations over a list of elements in batches of size 'size'. + Pass specific transaction options after the list reference." + `(loop for ,batch in (subsets ,subset-size ,list) do + (with-transaction ,txn-options + ,@body)))

;; ;; An interface to manage transactions explicitly @@ -82,12 +121,3 @@

(defgeneric controller-abort-transaction (store-controller transaction &key &allow-other-keys) (:documentation "Abort an elephant transaction")) - -;; -;; Utility -; - -(defun remove-keywords (key-names args) - (loop for ( name val ) on args by #'cddr - unless (member name key-names) - append (list name val)))