From: Nikodemus S. <de...@us...> - 2007-11-14 15:57:32
|
Update of /cvsroot/sbcl/sbcl/src/pcl In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv23680/src/pcl Modified Files: dfun.lisp Log Message: 1.0.11.23: internal hash-table usage thread-safety, part 1 * Use :SYNCHRONIZED hash-tables for the most part, and a light dash of WITH-LOCKED-HASH-TABLE as approriapte: *FORWARD-REFERENCED-LAYOUTS*, CLASSOID-SUBCLASSES, *COMPILED-DEBUG-FUNS*, *FUN-END-COOKIES*, *COMPONENT-BREAKPOINT-OFFSETS*, *EFFECTIVE-METHOD-CACHE*. * Replace *FOREIGN-LOCK* with *SHARED-OBJECT-LOCK* and hash-table based locking for *LINKAGE-INFO* for efficiency. Index: dfun.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/dfun.lisp,v retrieving revision 1.62 retrieving revision 1.63 diff -u -d -r1.62 -r1.63 --- dfun.lisp 8 Jun 2007 12:15:46 -0000 1.62 +++ dfun.lisp 14 Nov 2007 15:57:28 -0000 1.63 @@ -1643,12 +1643,21 @@ root))) nil)) -;;; FIXME: Needs a lock. +;;; Not synchronized, as all the uses we have for it are multiple ones +;;; and need WITH-LOCKED-HASH-TABLE in any case. +;;; +;;; FIXME: Is it really more efficient to store this stuff in a global +;;; table instead of having a slot in each method? +;;; +;;; FIXME: This table also seems to contain early methods, which should +;;; presumably be dropped during the bootstrap. (defvar *effective-method-cache* (make-hash-table :test 'eq)) (defun flush-effective-method-cache (generic-function) - (dolist (method (generic-function-methods generic-function)) - (remhash method *effective-method-cache*))) + (let ((cache *effective-method-cache*)) + (with-locked-hash-table (cache) + (dolist (method (generic-function-methods generic-function)) + (remhash method cache))))) (defun get-secondary-dispatch-function (gf methods types &optional method-alist wrappers) @@ -1675,9 +1684,10 @@ (lambda (&rest args) (apply #'no-applicable-method gf args)))) (let* ((key (car methods)) - (ht-value (or (gethash key *effective-method-cache*) - (setf (gethash key *effective-method-cache*) - (cons nil nil))))) + (ht *effective-method-cache*) + (ht-value (with-locked-hash-table (ht) + (or (gethash key ht) + (setf (gethash key ht) (cons nil nil)))))) (if (and (null (cdr methods)) all-applicable-p ; the most common case (null method-alist-p) wrappers-p (not function-p)) (or (car ht-value) |