0.7.9.42:

[sbcl.git] / src / pcl / std-class.lisp

diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index 7b4c293..5e5f933 100644 (file)
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -320,7 +320,7 @@
                    :direct-superclasses supers
                    :direct-slots slots
                    :definition-source `((defclass ,name)
-                                        ,*load-truename*)
+                                        ,*load-pathname*)
                    other)))
     ;; Defclass of a class with a forward-referenced superclass does not
     ;; have a wrapper. RES is the incomplete PCL class. The Lisp class
@@ -1048,14 +1048,38 @@
     (or (eq new-super-meta-class *the-class-std-class*)
        (eq (class-of class) new-super-meta-class))))
 \f
+;;; What this does depends on which of the four possible values of
+;;; LAYOUT-INVALID the PCL wrapper has; the simplest case is when it
+;;; is (:FLUSH <wrapper>) or (:OBSOLETE <wrapper>), when there is
+;;; nothing to do, as the new wrapper has already been created.  If
+;;; LAYOUT-INVALID returns NIL, then we invalidate it (setting it to
+;;; (:FLUSH <wrapper>); UPDATE-SLOTS later gets to choose whether or
+;;; not to "upgrade" this to (:OBSOLETE <wrapper>).
+;;;
+;;; This leaves the case where LAYOUT-INVALID returns T, which happens
+;;; when REGISTER-LAYOUT has invalidated a superclass of CLASS (which
+;;; invalidated all the subclasses in SB-KERNEL land).  Again, here we
+;;; must flush the caches and allow UPDATE-SLOTS to decide whether to
+;;; obsolete the wrapper.
+;;;
+;;; FIXME: either here or in INVALID-WRAPPER-P looks like a good place
+;;; for (AVER (NOT (EQ (SB-KERNEL:LAYOUT-INVALID OWRAPPER)
+;;;                    :UNINITIALIZED)))
+;;;
+;;; Thanks to Gerd Moellmann for the explanation.  -- CSR, 2002-10-29
 (defun force-cache-flushes (class)
   (let* ((owrapper (class-wrapper class)))
-    ;; We only need to do something if the state is still T. If the
-    ;; state isn't T, it will be FLUSH or OBSOLETE, and both of those
-    ;; will already be doing what we want. In particular, we must be
-    ;; sure we never change an OBSOLETE into a FLUSH since OBSOLETE
-    ;; means do what FLUSH does and then some.
-    (unless (invalid-wrapper-p owrapper)
+    ;; We only need to do something if the wrapper is still valid. If
+    ;; the wrapper isn't valid, state will be FLUSH or OBSOLETE, and
+    ;; both of those will already be doing what we want. In
+    ;; particular, we must be sure we never change an OBSOLETE into a
+    ;; FLUSH since OBSOLETE means do what FLUSH does and then some.
+    (when (or (not (invalid-wrapper-p owrapper))
+             ;; KLUDGE: despite the observations above, this remains
+             ;; a violation of locality or what might be considered
+             ;; good style.  There has to be a better way!  -- CSR,
+             ;; 2002-10-29
+             (eq (sb-kernel:layout-invalid owrapper) t))
       (let ((nwrapper (make-wrapper (wrapper-no-of-instance-slots owrapper)
                                    class)))
        (setf (wrapper-instance-slots-layout nwrapper)
@@ -1282,6 +1306,17 @@
   (or (eq s *the-class-t*)
       (eq s *the-class-stream*)))
 \f
+;;; Some necessary methods for FORWARD-REFERENCED-CLASS
+(defmethod class-direct-slots ((class forward-referenced-class)) ())
+(defmethod class-direct-default-initargs ((class forward-referenced-class)) ())
+(macrolet ((def (method)
+             `(defmethod ,method ((class forward-referenced-class))
+                (error "~@<~I~S was called on a forward referenced class:~2I~_~S~:>"
+                       ',method class))))
+  (def class-default-initargs)
+  (def class-precedence-list)
+  (def class-slots))
+
 (defmethod validate-superclass ((c slot-class)
                                (f forward-referenced-class))
   t)