From: William Harold Newman Date: Sat, 18 May 2002 22:13:07 +0000 (+0000) Subject: 0.7.3.17 X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=50462f68bf70faf0bd96de7517643afb740543e6;p=sbcl.git 0.7.3.17 merged NJF PCL INVALID-WRAPPER-P cleanups sbcl-devel 2002-05-16 --- diff --git a/src/code/debug.lisp b/src/code/debug.lisp index 4943a51..66be011 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -806,7 +806,7 @@ reset to ~S." '*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))) diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp index 62fccf5..da80465 100644 --- a/src/pcl/cache.lisp +++ b/src/pcl/cache.lisp @@ -268,18 +268,18 @@ ;;; 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))) @@ -297,7 +297,7 @@ (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)) @@ -443,16 +443,16 @@ (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 diff --git a/src/pcl/slots.lisp b/src/pcl/slots.lisp index 11ffc16..e726ba4 100644 --- a/src/pcl/slots.lisp +++ b/src/pcl/slots.lisp @@ -191,16 +191,14 @@ (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)) @@ -224,12 +222,12 @@ (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)) @@ -249,14 +247,14 @@ (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)) @@ -278,12 +276,12 @@ (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+)) diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp index a52b2b3..f5a0172 100644 --- a/src/pcl/std-class.lisp +++ b/src/pcl/std-class.lisp @@ -1006,14 +1006,13 @@ (eq (class-of class) new-super-meta-class)))) (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) @@ -1029,9 +1028,9 @@ (declare (ignore owrapper)) (set-wrapper instance nwrapper)) -;;; 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) @@ -1049,8 +1048,8 @@ (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 ;;; @@ -1068,12 +1067,13 @@ ;;; 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* diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp index 12a4640..5154482 100644 --- a/src/pcl/vector.lisp +++ b/src/pcl/vector.lisp @@ -1156,7 +1156,7 @@ (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)) diff --git a/version.lisp-expr b/version.lisp-expr index 24a0cb8..a53c45e 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; 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"