Scribit Pierre THIERRY dies 06/11/2006 hora 14:40: > FWIW, since this patch [...]
And since I'm not that much proud of the patch, I forgot to attach it! Quickly, Nowhere man -- [EMAIL PROTECTED] OpenPGP 0xD9D50D8A
Index: elephant/elephant.asd
===================================================================
--- elephant.orig/elephant.asd 2006-11-05 23:29:59.244904250 +0100
+++ elephant/elephant.asd 2006-11-05 23:32:24.469980250 +0100
@@ -112,7 +112,7 @@
(:file "backend"))
:serial t
:depends-on (memutil)))))
- :depends-on (:uffi))
+ :depends-on (:uffi :bordeaux-threads))
Index: elephant/src/elephant/classes.lisp
===================================================================
--- elephant.orig/src/elephant/classes.lisp 2006-11-05 23:30:09.045516750
+0100
+++ elephant/src/elephant/classes.lisp 2006-11-06 00:14:03.970189250 +0100
@@ -233,44 +233,51 @@
;; 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 (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 (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 (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 (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 (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
Index: elephant/src/elephant/package.lisp
===================================================================
--- elephant.orig/src/elephant/package.lisp 2006-11-05 23:29:59.400914000
+0100
+++ elephant/src/elephant/package.lisp 2006-11-05 23:30:24.186463000 +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
