(writer (cadr specializers))))
(specl-cpl (if early-p
(early-class-precedence-list specl)
- (and (class-finalized-p specl)
- (class-precedence-list specl))))
+ (when (class-finalized-p specl)
+ (class-precedence-list specl))))
(so-p (member *the-class-standard-object* specl-cpl))
(slot-name (if (consp method)
(and (early-method-standard-accessor-p method)
;; all of its subclasses. If either SPECL or one of the subclasses
;; is not a standard-class, bail out.
(labels ((aux (class)
- ;; FIND-SLOT-DEFINITION might not be defined yet
- (let ((slotd (find-if (lambda (x)
- (eq (sb-pcl::slot-definition-name x)
- slot-name))
- (sb-pcl::class-slots class))))
+ (let ((slotd (find-slot-definition class slot-name)))
(when slotd
- (unless (or early-p
- (slot-accessor-std-p slotd type))
+ (unless (or early-p (slot-accessor-std-p slotd type))
(return-from make-accessor-table nil))
(push (cons specl slotd) (gethash class table))))
(dolist (subclass (sb-pcl::class-direct-subclasses class))
+ (unless (class-finalized-p subclass)
+ (return-from make-accessor-table nil))
(aux subclass))))
(aux specl))))
(maphash (lambda (class specl+slotd-list)
root)))
nil))
\f
-;;; 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)
(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)