X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdfun.lisp;h=37002f97e223139d2eb92c7bd5c31413860fcf14;hb=d25e3478acccec70402ff32554669a982be8e281;hp=96a0ffce947e8b057eaa52649ffa41f4227ed866;hpb=30c93105a8bce7b701a5043fb11254f6f1bdd6da;p=sbcl.git

diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp
index 96a0ffc..37002f9 100644
--- a/src/pcl/dfun.lisp
+++ b/src/pcl/dfun.lisp
@@ -187,17 +187,15 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
 (defvar *standard-slot-locations* (make-hash-table :test 'equal))
 
 (defun compute-standard-slot-locations ()
-  (clrhash *standard-slot-locations*)
-  (dolist (class-name *standard-classes*)
-    (let ((class (find-class class-name)))
-      (dolist (slot (class-slots class))
-        (setf (gethash (cons class (slot-definition-name slot))
-                       *standard-slot-locations*)
-              (slot-definition-location slot))))))
-
-;;; FIXME: harmonize the names between COMPUTE-STANDARD-SLOT-LOCATIONS
-;;; and MAYBE-UPDATE-STANDARD-CLASS-LOCATIONS.
-(defun maybe-update-standard-class-locations (class)
+  (let ((new (make-hash-table :test 'equal)))
+    (dolist (class-name *standard-classes*)
+      (let ((class (find-class class-name)))
+        (dolist (slot (class-slots class))
+          (setf (gethash (cons class (slot-definition-name slot)) new)
+                (slot-definition-location slot)))))
+    (setf *standard-slot-locations* new)))
+
+(defun maybe-update-standard-slot-locations (class)
   (when (and (eq *boot-state* 'complete)
              (memq (class-name class) *standard-classes*))
     (compute-standard-slot-locations)))
@@ -1237,13 +1235,8 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
                                            (class-precedence-list
                                             accessor-class))
                                        :test #'eq)
-                               (if early-p
-                                   (not (eq *the-class-standard-method*
-                                            (early-method-class meth)))
-                                   (accessor-method-p meth))
-                               (if early-p
-                                   (early-accessor-method-slot-name meth)
-                                   (accessor-method-slot-name meth))))))
+                               (accessor-method-p meth)
+                               (accessor-method-slot-name meth)))))
          (slotd (and accessor-class
                      (if early-p
                          (dolist (slot (early-class-slotds accessor-class) nil)