-(defun force-cache-flushes (class)
- (let* ((owrapper (class-wrapper class))
- (state (wrapper-state owrapper)))
- ;; 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.
- (when (eq state t) ; FIXME: should be done through INVALID-WRAPPER-P
- (let ((nwrapper (make-wrapper (wrapper-no-of-instance-slots owrapper)
- class)))
- (setf (wrapper-instance-slots-layout nwrapper)
- (wrapper-instance-slots-layout owrapper))
- (setf (wrapper-class-slots nwrapper)
- (wrapper-class-slots owrapper))
- (sb-sys:without-interrupts
- (update-lisp-class-layout class nwrapper)
- (setf (slot-value class 'wrapper) nwrapper)
- (invalidate-wrapper owrapper ':flush nwrapper))))))
-
-(defun flush-cache-trap (owrapper nwrapper instance)
- (declare (ignore owrapper))
- (set-wrapper instance nwrapper))
+;;; 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 (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 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 (layout-invalid owrapper) t))
+ (let ((nwrapper (make-wrapper (layout-length owrapper)
+ class)))
+ (setf (wrapper-instance-slots-layout nwrapper)
+ (wrapper-instance-slots-layout owrapper))
+ (setf (wrapper-class-slots nwrapper)
+ (wrapper-class-slots owrapper))
+ (setf (wrapper-slot-table nwrapper)
+ (wrapper-slot-table owrapper))
+ (%update-lisp-class-layout class nwrapper)
+ (setf (slot-value class 'wrapper) nwrapper)
+ ;; Use :OBSOLETE instead of :FLUSH if any superclass has
+ ;; been obsoleted.
+ (if (find-if (lambda (x)
+ (and (consp x) (eq :obsolete (car x))))
+ (layout-inherits owrapper)
+ :key #'layout-invalid)
+ (%invalidate-wrapper owrapper :obsolete nwrapper)
+ (%invalidate-wrapper owrapper :flush nwrapper))))))