From b9915e9a838059473beb4fa03a6410eb8d6b68e3 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Fri, 2 Dec 2005 14:30:13 +0000 Subject: [PATCH] 0.9.7.9: Fix bug #392: yet another hole in MAKE-INSTANCES-OBSOLETE ... make the classoid-based invalidation of layouts clear (set to 0) the clos-hash slots of the layout, as well as setting depthoid to -1 and layout-invalid to t. ... this intertwingling is kind of odd, and also kind of unnecessary. Maybe step 1 of an integrated PCL would merge layouts and wrappers and centralize their handling? ... fix genesis never to dump layouts with hash-slots of 0. ... one or two explanatory comments. --- BUGS | 25 +------------------------ NEWS | 1 + src/code/class.lisp | 13 ++++++++++++- src/compiler/generic/genesis.lisp | 27 +++++++++++---------------- src/pcl/cache.lisp | 7 +++++++ tests/clos.impure.lisp | 22 ++++++++++++++++++++++ version.lisp-expr | 2 +- 7 files changed, 55 insertions(+), 42 deletions(-) diff --git a/BUGS b/BUGS index ab0e74b..c546bc4 100644 --- a/BUGS +++ b/BUGS @@ -2092,27 +2092,4 @@ WORKAROUND: compiler's type deriver. 392: slot-accessor for subclass misses obsoleted superclass - - (defclass super () - ((x :initform 0 :accessor x-of))) - (defclass sub (super) ()) - - (defmethod shared-initialize :after ((i super) slots &rest init) - (incf (x-of i))) - - (defvar *super* (make-instance 'super)) - (defvar *sub* (make-instance 'sub)) - - (x-of *super*) ; => 1 ...ok - (x-of *sub*) ; => 1 ...ok - - (make-instances-obsolete 'super) - - (x-of *sub*) ; => 1 ...ooops! - (x-of *super*) ; => 2 ...ok - (x-of *sub*) ; => 2 ...got it now - - (make-instances-obsolete 'super) - - (x-of *sub*) ; => 2 ...ooops, i did it again... - (slot-value *sub* 'x) ; => 3 ...ok but a bit late + (fixed in sbcl-0.9.7.9) \ No newline at end of file diff --git a/NEWS b/NEWS index e82ef7f..74e9562 100644 --- a/NEWS +++ b/NEWS @@ -4,6 +4,7 @@ changes in sbcl-0.9.8 relative to sbcl-0.9.7: expected. (reported by Tim Daly Jr) * fixed bug #391: complicated :TYPE intersections in slot definitions no longer cause an error in PCL internals. + * fixed bug #392: plugged a hole in the obsolete-instance protocol. * bug fix: FILE-STRING-LENGTH is now external-format sensitive, returning the number of octets which would be written to the file-stream. (thanks to Robert J. Macomber) diff --git a/src/code/class.lisp b/src/code/class.lisp index a1099ec..c19e3fb 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* @@ -1425,11 +1432,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) diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index 8d6a047..01b7e71 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -924,22 +924,17 @@ core and return a descriptor to it." ;; the target Lisp's (RANDOM-LAYOUT-CLOS-HASH) sequence ;; and show up as the CLOS-HASH value of some other ;; LAYOUT. - ;; - ;; FIXME: This expression here can generate a zero value, - ;; and the CMU CL code goes out of its way to generate - ;; strictly positive values (even though the field is - ;; declared as an INDEX). Check that it's really OK to - ;; have zero values in the CLOS-HASH slots. - (hash-value (mod (logxor (logand (random-layout-clos-hash) 15253) - (logandc2 (random-layout-clos-hash) 15253) - 1) - ;; (The MOD here is defensive programming - ;; to make sure we never write an - ;; out-of-range value even if some joker - ;; sets LAYOUT-CLOS-HASH-MAX to other - ;; than 2^n-1 at some time in the - ;; future.) - (1+ sb!kernel:layout-clos-hash-max)))) + (hash-value + (1+ (mod (logxor (logand (random-layout-clos-hash) 15253) + (logandc2 (random-layout-clos-hash) 15253) + 1) + ;; (The MOD here is defensive programming + ;; to make sure we never write an + ;; out-of-range value even if some joker + ;; sets LAYOUT-CLOS-HASH-MAX to other + ;; than 2^n-1 at some time in the + ;; future.) + sb!kernel:layout-clos-hash-max)))) (write-wordindexed result (+ i sb!vm:instance-slots-offset 1) (make-fixnum-descriptor hash-value)))) diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp index 9a65def..34c148f 100644 --- a/src/pcl/cache.lisp +++ b/src/pcl/cache.lisp @@ -25,6 +25,13 @@ (in-package "SB-PCL") +;;; Ye olde CMUCL comment follows, but it seems likely that the paper +;;; that would be inserted would resemble Kiczales and Rodruigez, +;;; Efficient Method Dispatch in PCL, ACM 1990. Some of the details +;;; changed between that paper and "May Day PCL" of 1992; some other +;;; details have changed since, but reading that paper gives the broad +;;; idea. +;;; ;;; The caching algorithm implemented: ;;; ;;; << put a paper here >> diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp index a037be3..54931c9 100644 --- a/tests/clos.impure.lisp +++ b/tests/clos.impure.lisp @@ -892,6 +892,28 @@ (slot-boundp *obsoleted* 'a) (assert (= *obsoleted-counter* 1)) +;;; yet another MAKE-INSTANCES-OBSOLETE test, this time from Nikodemus +;;; Siivola. Not all methods for accessing slots are created equal... +(defclass yet-another-obsoletion-super () ((obs :accessor obs-of :initform 0))) +(defclass yet-another-obsoletion-sub (yet-another-obsoletion-super) ()) +(defmethod shared-initialize :after ((i yet-another-obsoletion-super) + slots &rest init) + (incf (obs-of i))) + +(defvar *yao-super* (make-instance 'yet-another-obsoletion-super)) +(defvar *yao-sub* (make-instance 'yet-another-obsoletion-sub)) + +(assert (= (obs-of *yao-super*) 1)) +(assert (= (obs-of *yao-sub*) 1)) +(make-instances-obsolete 'yet-another-obsoletion-super) +(assert (= (obs-of *yao-sub*) 2)) +(assert (= (obs-of *yao-super*) 2)) +(make-instances-obsolete 'yet-another-obsoletion-super) +(assert (= (obs-of *yao-super*) 3)) +(assert (= (obs-of *yao-sub*) 3)) +(assert (= (slot-value *yao-super* 'obs) 3)) +(assert (= (slot-value *yao-sub* 'obs) 3)) + ;;; shared -> local slot transfers of inherited slots, reported by ;;; Bruno Haible (let (i) diff --git a/version.lisp-expr b/version.lisp-expr index 6de96c8..6d9232f 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.7.8" +"0.9.7.9" -- 1.7.10.4