'*flush-debug-errors*)
(/show0 "throwing DEBUG-LOOP-CATCHER")
(throw 'debug-loop-catcher nil)))))
- ;; We have to bind level for the restart function created by
+ ;; We have to bind LEVEL for the restart function created by
;; WITH-SIMPLE-RESTART.
(let ((level *debug-command-level*)
(restart-commands (make-restart-commands)))
;;; 19991204) haven't been motivated to reverse engineer them from the
;;; code and document them here.
;;;
-;;; FIXME: This is awkward and unmnemonic. There is a function
-;;; (INVALID-WRAPPER-P) to test this return result abstractly for
-;;; invalidness but it's not called consistently; the functions that
-;;; need to know whether a wrapper is invalid often test (EQ
-;;; (WRAPPER-STATE X) T), ick. It would be good to use the abstract
-;;; test instead. It would probably be even better to switch the sense
-;;; of the WRAPPER-STATE function, renaming it to WRAPPER-INVALID and
-;;; making it synonymous with LAYOUT-INVALID. Then the
-;;; INVALID-WRAPPER-P function would become trivial and would go away
-;;; (replaced with WRAPPER-INVALID), since all the various invalid
-;;; wrapper states would become generalized boolean "true" values. --
-;;; WHN 19991204
+;;; FIXME: We have removed the persistent use of this function throughout
+;;; the PCL codebase, instead opting to use INVALID-WRAPPER-P, which
+;;; abstractly tests the return result of this function for invalidness.
+;;; However, part of the original comment that is still applicable follows.
+;;; --njf, 2002-05-02
+;;;
+;;; FIXME: It would probably be even better to switch the sense of the
+;;; WRAPPER-STATE function, renaming it to WRAPPER-INVALID and making it
+;;; synonymous with LAYOUT-INVALID. Then the INVALID-WRAPPER-P function
+;;; would become trivial and would go away (replaced with
+;;; WRAPPER-INVALID), since all the various invalid wrapper states would
+;;; become generalized boolean "true" values. -- WHN 19991204
#-sb-fluid (declaim (inline wrapper-state (setf wrapper-state)))
(defun wrapper-state (wrapper)
(let ((invalid (sb-kernel:layout-invalid wrapper)))
(setf (sb-kernel:layout-invalid wrapper)
(if (eq new-value t)
nil
- new-value)))
+ new-value)))
(defmacro wrapper-instance-slots-layout (wrapper)
`(%wrapper-instance-slots-layout ,wrapper))
(gethash nwrapper *previous-nwrappers*) new-previous)))))
(defun check-wrapper-validity (instance)
- (let* ((owrapper (wrapper-of instance))
- (state (wrapper-state owrapper)))
- (if (eq state t)
+ (let* ((owrapper (wrapper-of instance)))
+ (if (not (invalid-wrapper-p owrapper))
owrapper
- (let ((nwrapper
+ (let* ((state (wrapper-state wrapper))
+ (nwrapper
(ecase (car state)
(:flush
- (flush-cache-trap owrapper (cadr state) instance))
+ (flush-cache-trap owrapper (cadr state) instance))
(:obsolete
- (obsolete-instance-trap owrapper (cadr state) instance)))))
+ (obsolete-instance-trap owrapper (cadr state) instance)))))
;; This little bit of error checking is superfluous. It only
;; checks to see whether the person who implemented the trap
;; handling screwed up. Since that person is hacking
(value (typecase location
(fixnum
(cond ((std-instance-p object)
- ;; FIXME: EQ T (WRAPPER-STATE ..) is better done
- ;; through INVALID-WRAPPER-P (here and below).
- (unless (eq t (wrapper-state (std-instance-wrapper
- object)))
+ (when (invalid-wrapper-p (std-instance-wrapper
+ object))
(check-wrapper-validity object))
(clos-slots-ref (std-instance-slots object)
location))
((fsc-instance-p object)
- (unless (eq t (wrapper-state (fsc-instance-wrapper
- object)))
+ (when (invalid-wrapper-p (fsc-instance-wrapper
+ object))
(check-wrapper-validity object))
(clos-slots-ref (fsc-instance-slots object)
location))
(typecase location
(fixnum
(cond ((std-instance-p object)
- (unless (eq t (wrapper-state (std-instance-wrapper object)))
+ (when (invalid-wrapper-p (std-instance-wrapper object))
(check-wrapper-validity object))
(setf (clos-slots-ref (std-instance-slots object) location)
new-value))
((fsc-instance-p object)
- (unless (eq t (wrapper-state (fsc-instance-wrapper object)))
+ (when (invalid-wrapper-p (fsc-instance-wrapper object))
(check-wrapper-validity object))
(setf (clos-slots-ref (fsc-instance-slots object) location)
new-value))
(value (typecase location
(fixnum
(cond ((std-instance-p object)
- (unless (eq t (wrapper-state (std-instance-wrapper
- object)))
+ (when (invalid-wrapper-p (std-instance-wrapper
+ object))
(check-wrapper-validity object))
(clos-slots-ref (std-instance-slots object)
location))
((fsc-instance-p object)
- (unless (eq t (wrapper-state (fsc-instance-wrapper
- object)))
+ (when (invalid-wrapper-p (fsc-instance-wrapper
+ object))
(check-wrapper-validity object))
(clos-slots-ref (fsc-instance-slots object)
location))
(typecase location
(fixnum
(cond ((std-instance-p object)
- (unless (eq t (wrapper-state (std-instance-wrapper object)))
+ (when (invalid-wrapper-p (std-instance-wrapper object))
(check-wrapper-validity object))
(setf (clos-slots-ref (std-instance-slots object) location)
+slot-unbound+))
((fsc-instance-p object)
- (unless (eq t (wrapper-state (fsc-instance-wrapper object)))
+ (when (invalid-wrapper-p (fsc-instance-wrapper object))
(check-wrapper-validity object))
(setf (clos-slots-ref (fsc-instance-slots object) location)
+slot-unbound+))
(eq (class-of class) new-super-meta-class))))
\f
(defun force-cache-flushes (class)
- (let* ((owrapper (class-wrapper class))
- (state (wrapper-state owrapper)))
+ (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.
- (when (eq state t) ; FIXME: should be done through INVALID-WRAPPER-P
+ (unless (invalid-wrapper-p owrapper)
(let ((nwrapper (make-wrapper (wrapper-no-of-instance-slots owrapper)
class)))
(setf (wrapper-instance-slots-layout nwrapper)
(declare (ignore owrapper))
(set-wrapper instance nwrapper))
\f
-;;; make-instances-obsolete can be called by user code. It will cause the
-;;; next access to the instance (as defined in 88-002R) to trap through the
-;;; update-instance-for-redefined-class mechanism.
+;;; MAKE-INSTANCES-OBSOLETE can be called by user code. It will cause
+;;; the next access to the instance (as defined in 88-002R) to trap
+;;; through the UPDATE-INSTANCE-FOR-REDEFINED-CLASS mechanism.
(defmethod make-instances-obsolete ((class std-class))
(let* ((owrapper (class-wrapper class))
(nwrapper (make-wrapper (wrapper-no-of-instance-slots owrapper)
(defmethod make-instances-obsolete ((class symbol))
(make-instances-obsolete (find-class class)))
-;;; obsolete-instance-trap is the internal trap that is called when we see
-;;; an obsolete instance. The times when it is called are:
+;;; OBSOLETE-INSTANCE-TRAP is the internal trap that is called when we
+;;; see an obsolete instance. The times when it is called are:
;;; - when the instance is involved in method lookup
;;; - when attempting to access a slot of an instance
;;;
;;; sure that the traps are only happening when they should, and that
;;; the trap methods are computing appropriate new wrappers.
-;;; obsolete-instance-trap might be called on structure instances
-;;; after a structure is redefined. In most cases, obsolete-instance-trap
-;;; will not be able to fix the old instance, so it must signal an
-;;; error. The hard part of this is that the error system and debugger
-;;; might cause obsolete-instance-trap to be called again, so in that
-;;; case, we have to return some reasonable wrapper, instead.
+;;; OBSOLETE-INSTANCE-TRAP might be called on structure instances
+;;; after a structure is redefined. In most cases,
+;;; OBSOLETE-INSTANCE-TRAP will not be able to fix the old instance,
+;;; so it must signal an error. The hard part of this is that the
+;;; error system and debugger might cause OBSOLETE-INSTANCE-TRAP to be
+;;; called again, so in that case, we have to return some reasonable
+;;; wrapper, instead.
(defvar *in-obsolete-instance-trap* nil)
(defvar *the-wrapper-of-structure-object*
(w-t pv-wrappers))
(dolist (arg args)
(setq w (wrapper-of arg))
- (unless (eq t (wrapper-state w)) ; FIXME: should be INVALID-WRAPPER-P
+ (when (invalid-wrapper-p w)
(setq w (check-wrapper-validity arg)))
(setf (car w-t) w))
(setq w-t (cdr w-t))
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.7.3.16"
+"0.7.3.17"
projects / sbcl.git / commitdiff