X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fclass.lisp;h=86827210e3d6e118041d52df04e8cc9a7492dca0;hb=434d132bed6f23a9bdc4e35c355cc26b9f454f20;hp=a1099ec878331ee166c5044b429c82ff7810b823;hpb=31f072311935e32751508ecf824905c6b58a1d95;p=sbcl.git

diff --git a/src/code/class.lisp b/src/code/class.lisp
index a1099ec..8682721 100644
--- a/src/code/class.lisp
+++ b/src/code/class.lisp
@@ -145,6 +145,10 @@
   ;; LAYOUT-CLOS-HASH-MAX by the doc string of that constant,
   ;; generated as strictly positive in RANDOM-LAYOUT-CLOS-HASH..)
   ;;
+  ;; [ CSR notes, several years later (2005-11-30) that the value 0 is
+  ;;   special for these hash slots, indicating that the wrapper is
+  ;;   obsolete. ]
+  ;;
   ;; KLUDGE: The fact that the slots here start at offset 1 is known
   ;; to the LAYOUT-CLOS-HASH function and to the LAYOUT-dumping code
   ;; in GENESIS.
@@ -247,6 +251,9 @@
   ;; They're declared as INDEX.. Or is this a hack to try to avoid
   ;; having to use bignum arithmetic? Or what? An explanation would be
   ;; nice.
+  ;;
+  ;; an explanation is provided in Kiczales and Rodriguez, "Efficient
+  ;; Method Dispatch in PCL", 1990.  -- CSR, 2005-11-30
   (1+ (random layout-clos-hash-max
               (if (boundp '*layout-clos-hash-random-state*)
                   *layout-clos-hash-random-state*
@@ -670,29 +677,13 @@
   ;; during cold-load.
   (translation nil :type (or ctype (member nil :initializing))))
 
-;;; FIXME: In CMU CL, this was a class with a print function, but not
-;;; necessarily a structure class (e.g. CONDITIONs). In SBCL,
-;;; we let CLOS handle our print functions, so that is no longer needed.
-;;; Is there any need for this class any more?
-(def!struct (slot-classoid (:include classoid)
-                           (:constructor nil)))
-
 ;;; STRUCTURE-CLASS represents what we need to know about structure
 ;;; classes. Non-structure "typed" defstructs are a special case, and
 ;;; don't have a corresponding class.
-(def!struct (basic-structure-classoid (:include slot-classoid)
-                                      (:constructor nil)))
-
-(def!struct (structure-classoid (:include basic-structure-classoid)
+(def!struct (structure-classoid (:include classoid)
                                 (:constructor make-structure-classoid))
   ;; If true, a default keyword constructor for this structure.
   (constructor nil :type (or function null)))
-
-;;; FUNCALLABLE-STRUCTURE-CLASS is used to represent funcallable
-;;; structures, which are used to implement generic functions.
-(def!struct (funcallable-structure-classoid
-             (:include basic-structure-classoid)
-             (:constructor make-funcallable-structure-classoid)))
 
 ;;;; classoid namespace
 
@@ -863,8 +854,8 @@ NIL is returned when no such class exists."
         ;; Otherwise, we can't in general be sure that the
         ;; intersection is empty, since a subclass of both might be
         ;; defined. But we can eliminate it for some special cases.
-        ((or (basic-structure-classoid-p class1)
-             (basic-structure-classoid-p class2))
+        ((or (structure-classoid-p class1)
+             (structure-classoid-p class2))
          ;; No subclass of both can be defined.
          *empty-type*)
         ((eq (classoid-state class1) :sealed)
@@ -1425,11 +1416,15 @@ NIL is returned when no such class exists."
 ;;; Mark LAYOUT as invalid. Setting DEPTHOID -1 helps cause unsafe
 ;;; structure type tests to fail. Remove class from all superclasses
 ;;; too (might not be registered, so might not be in subclasses of the
-;;; nominal superclasses.)
+;;; nominal superclasses.)  We set the layout-clos-hash slots to 0 to
+;;; invalidate the wrappers for specialized dispatch functions, which
+;;; use those slots as indexes into tables.
 (defun invalidate-layout (layout)
   (declare (type layout layout))
   (setf (layout-invalid layout) t
         (layout-depthoid layout) -1)
+  (dotimes (i layout-clos-hash-length)
+    (setf (layout-clos-hash layout i) 0))
   (let ((inherits (layout-inherits layout))
         (classoid (layout-classoid layout)))
     (modify-classoid classoid)