Scribit Robert L. Read dies 20/01/2007 hora 14:06: > I personally solve problem by using SBCL mutexes around the > serialize/deserialize code, but I have not committed that code, since > it is highly SBCL-specific, and in fact I don't know of a good way to > do locking portably.
I used the bordeux-threads to do that, I attach the patch I personnaly used. It works like a charm as far as I can see, but as I'm not that familiar with Elephant's internals, I can't tell if everything is indeed correctly protected. My applications using it were only put under moderate workload. Avoid globals is a Good Thing anyway, and hopefully 0.6.1 will be both thead-safe and efficient (the lock solution adds a major bottleneck...). Portably, Pierre -- [EMAIL PROTECTED] OpenPGP 0xD9D50D8A
diff -r 2052823e9c15 elephant.asd
--- a/elephant.asd Fri Jan 05 03:45:07 2007 +0100
+++ b/elephant.asd Fri Jan 05 03:50:19 2007 +0100
@@ -166,5 +166,5 @@
(:file "backend"))
:serial t
:depends-on (memutil)))))
- :depends-on (:uffi :cl-base64))
+ :depends-on (:uffi :cl-base64 :bordeaux-threads))
diff -r 2052823e9c15 src/elephant/classes.lisp
--- a/src/elephant/classes.lisp Fri Jan 05 03:45:07 2007 +0100
+++ b/src/elephant/classes.lisp Fri Jan 05 03:53:05 2007 +0100
@@ -233,44 +233,51 @@ slots."
;; SLOT ACCESS PROTOCOLS
;;
+(defvar *slot-lock* (make-lock "Slot access lock"))
+
(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 #-elephant-without-optimize(optimize (speed 3)))
- (let ((name (slot-definition-name slot-def)))
- (persistent-slot-reader (get-con instance) instance name)))
+ (with-lock-held (*slot-lock*)
+ (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 #-elephant-without-optimize(optimize (speed 3)))
- (if (indexed class)
- (indexed-slot-writer class instance slot-def new-value)
- (let ((name (slot-definition-name slot-def)))
- (persistent-slot-writer (get-con instance) new-value instance name))))
+ (with-recursive-lock-held (*slot-lock*)
+ (if (indexed class)
+ (indexed-slot-writer class instance slot-def new-value)
+ (let ((name (slot-definition-name slot-def)))
+ (persistent-slot-writer (get-con instance) new-value instance name)))))
(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 #-elephant-without-optimize(optimize (speed 3)))
- (let ((name (slot-definition-name slot-def)))
- (persistent-slot-boundp (get-con instance) instance name)))
+ (with-recursive-lock-held (*slot-lock*)
+ (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 #-elephant-without-optimize(optimize (speed 3)))
- (loop for slot in (class-slots class)
- for matches-p = (eq (slot-definition-name slot) slot-name)
- until matches-p
- finally (return (if (and matches-p
- (subtypep (type-of slot) 'persistent-slot-definition))
- (persistent-slot-boundp (get-con instance) instance slot-name)
- (call-next-method)))))
+ (with-recursive-lock-held (*slot-lock*)
+ (loop for slot in (class-slots class)
+ for matches-p = (eq (slot-definition-name slot) slot-name)
+ until matches-p
+ finally (return (if (and matches-p
+ (subtypep (type-of slot) 'persistent-slot-definition))
+ (persistent-slot-boundp (get-con instance) instance slot-name)
+ (call-next-method))))))
(defmethod slot-makunbound-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
"Deletes the slot from the database."
(declare #-elephant-without-optimize(optimize (speed 3)))
;; NOTE: call remove-indexed-slot here instead?
- (when (indexed slot-def)
- (unregister-indexed-slot class (slot-definition-name slot-def)))
- (persistent-slot-makunbound (get-con instance) instance (slot-definition-name slot-def)))
+ (with-recursive-lock-held (*slot-lock*)
+ (when (indexed slot-def)
+ (unregister-indexed-slot class (slot-definition-name slot-def)))
+ (persistent-slot-makunbound (get-con instance) instance (slot-definition-name slot-def))))
;; ======================================================
;; Handling metaclass overrides of normal slot operation
diff -r 2052823e9c15 src/elephant/package.lisp
--- a/src/elephant/package.lisp Fri Jan 05 03:45:07 2007 +0100
+++ b/src/elephant/package.lisp Fri Jan 05 03:50:19 2007 +0100
@@ -20,7 +20,7 @@
(in-package :cl-user)
(defpackage elephant
- (:use common-lisp elephant-memutil)
+ (:use common-lisp elephant-memutil bordeaux-threads)
(:nicknames ele :ele)
(:documentation
"Elephant: an object-oriented database for Common Lisp with
signature.asc
Description: Digital signature
_______________________________________________ elephant-devel site list elephant-devel@common-lisp.net http://common-lisp.net/mailman/listinfo/elephant-devel
