Revision: 3945 Author: hans URL: http://bknr.net/trac/changeset/3945
make hash tables thread safe for sbcl
U trunk/bknr/datastore/src/indices/indices.lisp
Modified: trunk/bknr/datastore/src/indices/indices.lisp =================================================================== --- trunk/bknr/datastore/src/indices/indices.lisp 2008-09-22 18:53:45 UTC (rev 3944) +++ trunk/bknr/datastore/src/indices/indices.lisp 2008-09-22 19:18:24 UTC (rev 3945) @@ -27,7 +27,7 @@ (unless (= (length slots) 1) (error "Exactly one slot name in :SLOTS initarg required to create a SLOT-INDEX")) (with-slots (hash-table slot-name) index - (setf hash-table (make-hash-table :test test) + (setf hash-table (make-hash-table :test test #+sbcl #+sbcl :synchronized t) slot-name (first slots) (slot-value index 'index-nil) index-nil)))
@@ -65,7 +65,7 @@
(defmethod index-clear ((index slot-index)) (with-slots (hash-table) index - (setf hash-table (make-hash-table :test (hash-table-test hash-table))))) + (setf hash-table (make-hash-table :test (hash-table-test hash-table) #+sbcl #+sbcl :synchronized t))))
(defmethod index-reinitialize ((new-index slot-index) (old-index slot-index)) @@ -110,7 +110,7 @@
(defmethod initialize-instance :after ((index string-unique-index) &key (test #'equal)) (with-slots (hash-table) index - (setf hash-table (make-hash-table :test test)))) + (setf hash-table (make-hash-table :test test #+sbcl #+sbcl :synchronized t))))
(defmethod index-add :around ((index string-unique-index) object) (unless (slot-boundp object (slot-index-slot-name index)) @@ -421,7 +421,7 @@ (unless (<= (length slots) 1) (error "Can not create slot-index with more than one slot.")) (with-slots (hash-table slot-name) index - (setf hash-table (make-hash-table :test test) + (setf hash-table (make-hash-table :test test #+sbcl #+sbcl :synchronized t) slot-name (first slots) (slot-value index 'index-superclasses) index-superclasses)))
@@ -490,7 +490,7 @@
(defmethod index-clear ((index class-skip-index)) (with-slots (hash-table) index - (setf hash-table (make-hash-table :test (hash-table-test hash-table))))) + (setf hash-table (make-hash-table :test (hash-table-test hash-table) #+sbcl #+sbcl :synchronized t))))
(defmethod index-keys ((index class-skip-index)) (loop for key being the hash-keys of (class-skip-index-hash-table index)