From: Juho Snellman <jsnell@iki.fi>
Date: Thu, 16 Mar 2006 18:57:17 +0000 (+0000)
Subject: 0.9.10.41:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=5a31671c1093aa155a7832277ebd46766eb7c6e4;p=sbcl.git

0.9.10.41:
	Kill the silly *NAME->CLASS->SLOTD-TABLE* PCL cache.

        * Remove the code that updated the table
        * Rewrite the only user of the data stored in the table
          (MAKE-ACCESSOR-TABLE) to recompute it from scratch each time
        * Which actually ends up being faster than using the table,
          speeding the loading of CLOS-using FASLs a bit
        * Reduce core size by a 900 kB on x86-64
---

diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp
index 2c761aa..4b587fc 100644
--- a/src/pcl/braid.lisp
+++ b/src/pcl/braid.lisp
@@ -370,11 +370,7 @@
                                      fsc-p nil slot-name index))
           (set-val 'boundp-function (make-optimized-std-boundp-method-function
                                      fsc-p nil slot-name index)))
-        (set-val 'accessor-flags 7)
-        (let ((table (or (gethash slot-name *name->class->slotd-table*)
-                         (setf (gethash slot-name *name->class->slotd-table*)
-                               (make-hash-table :test 'eq :size 5)))))
-          (setf (gethash class table) slotd)))
+        (set-val 'accessor-flags 7))
       (when (and (eq name 'standard-class)
                  (eq slot-name 'slots) effective-p)
         (setq *the-eslotd-standard-class-slots* slotd))
diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp
index b866b62..dbed28c 100644
--- a/src/pcl/defs.lisp
+++ b/src/pcl/defs.lisp
@@ -200,8 +200,6 @@
 (defun variable-class (var env)
   (caddr (var-declaration 'class var env)))
 
-(defvar *name->class->slotd-table* (make-hash-table))
-
 (defvar *standard-method-combination*)
 
 (defun plist-value (object name)
diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp
index 7c3ed05..ab34a56 100644
--- a/src/pcl/dfun.lisp
+++ b/src/pcl/dfun.lisp
@@ -1326,21 +1326,26 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
                                   method))
                             (accessor-method-slot-name method))))
         (when (or (null specl-cpl)
+                  (null so-p)
                   (member *the-class-structure-object* specl-cpl))
           (return-from make-accessor-table nil))
-        (maphash (lambda (class slotd)
-                   (let ((cpl (if early-p
-                                  (early-class-precedence-list class)
-                                  (class-precedence-list class))))
-                     (when (memq specl cpl)
-                       (unless (and (or so-p
-                                        (member *the-class-standard-object*
-                                                cpl))
-                                    (or early-p
-                                        (slot-accessor-std-p slotd type)))
+        ;; Collect all the slot-definitions for SLOT-NAME from SPECL and
+        ;; 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))))
+                     (when slotd
+                       (unless (or early-p
+                                   (slot-accessor-std-p slotd type))
                          (return-from make-accessor-table nil))
-                       (push (cons specl slotd) (gethash class table)))))
-                 (gethash slot-name *name->class->slotd-table*))))
+                       (push (cons specl slotd) (gethash class table))))
+                   (dolist (subclass (sb-pcl::class-direct-subclasses class))
+                     (aux subclass))))
+          (aux specl))))
     (maphash (lambda (class specl+slotd-list)
                (dolist (sclass (if early-p
                                    (early-class-precedence-list class)
diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index 0af7d48..d40e7cf 100644
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -73,10 +73,6 @@
                                                 effective-slot-definition))
   (let* ((name (slot-value slotd 'name))
          (class (slot-value slotd '%class)))
-    (let ((table (or (gethash name *name->class->slotd-table*)
-                     (setf (gethash name *name->class->slotd-table*)
-                           (make-hash-table :test 'eq :size 5)))))
-      (setf (gethash class table) slotd))
     (dolist (type '(reader writer boundp))
       (let* ((gf-name (ecase type
                               (reader 'slot-value-using-class)
diff --git a/version.lisp-expr b/version.lisp-expr
index 533a593..f4bf7b6 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.10.40"
+"0.9.10.41"