--- a/Class.st	Thu Apr 08 18:25:02 2010 +0100
+++ b/Class.st	Fri Apr 09 19:02:18 2010 +0100
@@ -377,6 +377,9 @@
      This is private protocol"
 
     SubclassInfo := nil.
+    self allSubInstancesDo:[:cls |
+        cls flushSubclasses
+    ].
 
     "
      Class flushSubclassInfo
@@ -393,7 +396,8 @@
     aClass notNil ifTrue:[
         SubclassInfo notNil ifTrue:[
             SubclassInfo removeKey:aClass ifAbsent:[]
-        ]
+        ].
+        aClass flushSubclasses
     ].
 
     "
@@ -414,22 +418,22 @@
 
     |d|
 
-    SubclassInfo notNil ifTrue:[^ SubclassInfo].
-
-    d := IdentityDictionary new.
-    Smalltalk allClassesDo:[:aClass |
-        |superCls setToAddSubclass|
-
-        superCls := aClass superclass.
-        superCls notNil ifTrue:[
-            setToAddSubclass := d at:superCls ifAbsent:nil.
-            setToAddSubclass isNil ifTrue:[
-                d at:superCls put:(Set with:aClass).
-            ] ifFalse:[
-                setToAddSubclass add:aClass
-            ]
-        ]
-    ].
+"/    SubclassInfo notNil ifTrue:[^ SubclassInfo].
+"/
+"/    d := IdentityDictionary new.
+"/    Smalltalk allClassesDo:[:aClass |
+"/        |superCls setToAddSubclass|
+"/
+"/        superCls := aClass superclass.
+"/        superCls notNil ifTrue:[
+"/            setToAddSubclass := d at:superCls ifAbsent:nil.
+"/            setToAddSubclass isNil ifTrue:[
+"/                d at:superCls put:(Set with:aClass).
+"/            ] ifFalse:[
+"/                setToAddSubclass add:aClass
+"/            ]
+"/        ]
+"/    ].
     SubclassInfo := d.
     ^ d
 
@@ -1591,6 +1595,46 @@
 
     "Created: / 07-12-1995 / 13:16:46 / cg"
     "Modified: / 05-12-2006 / 22:04:26 / cg"
+!
+
+superclass:aClass
+    "set the superclass - this actually creates a new class,
+     recompiling all methods for the new one. The receiving class stays
+     around anonymously to allow existing instances some life.
+     This may change in the future (adjusting existing instances)"
+
+    |owner ns name|
+
+    "must flush caches since lookup chain changes"
+    ObjectMemory flushCaches.
+
+    "/ for correct recompilation, just create a new class ...
+    "/ but care to avoid a nameSpace change, by giving my
+    "/ full name and answering with Smalltalk to a nameSpace query.
+
+    (owner := self owningClass) notNil ifTrue:[
+        ns := owner.
+        name := self nameWithoutPrefix asSymbol
+    ] ifFalse:[
+        ns := Smalltalk.
+        name := self name
+    ].
+
+    Class classRedefinitionNotification answer:#keep do:[
+        Class nameSpaceQuerySignal 
+            answer:ns
+            do:[
+                aClass
+                    perform:(self definitionSelector)
+                    withArguments:(Array with:name
+                                   with:(self instanceVariableString)
+                                   with:(self classVariableString)
+                                   with:'' "/ pool
+                                   with:(self category)).
+            ]
+    ]
+
+    "Modified: / 20.6.1998 / 18:17:37 / cg"
 ! !
 
 !Class methodsFor:'adding & removing'!
@@ -1991,34 +2035,13 @@
      This will only enumerate globally known classes - for anonymous
      behaviors, you have to walk over all instances of Behavior."
 
-    |coll|
-
-    "/ use cached information (avoid class hierarchy search)
-    "/ if possible
-    SubclassInfo isNil ifTrue:[
-        Class subclassInfo   "/ creates SubclassInfo as side effect
-    ].
-    SubclassInfo notNil ifTrue:[
-        coll := SubclassInfo at:self ifAbsent:nil.
-        coll notNil ifTrue:[
-            coll do:aBlock.
-            ^ self
-        ].
+    "/ use cached information (avoid class hierarchy search), if possible
+    subclasses notNil ifTrue:[
+        subclasses do:aBlock
+    ] ifFalse:[
+        super subclassesDo:aBlock
     ].
 
-    coll := OrderedCollection new.
-    Smalltalk allClassesDo:[:aClass |
-        (aClass superclass == self) ifTrue:[
-            coll add:aClass
-        ]
-    ].
-
-    SubclassInfo notNil ifTrue:[
-        SubclassInfo at:self put:coll.
-    ].
-
-    coll do:aBlock.
-
     "
      Collection subclassesDo:[:c | Transcript showCR:(c name)]
     "
@@ -3504,6 +3527,10 @@
     "Modified: / 06-03-2007 / 11:54:53 / cg"
 !
 
+flushSubclasses
+    subclasses := nil
+!
+
 hasExtensions
     "return true, if there are methods in the receiver, which belong to
      a different package (i.e. package of class ~= package of method).
@@ -3655,24 +3682,11 @@
 subclasses
     "return a collection of the direct subclasses of the receiver"
 
-    |newColl|
-
-    "/ use cached information (avoid class hierarchy search)
-    "/ if possible
-
-    SubclassInfo notNil ifTrue:[
-        newColl := SubclassInfo at:self ifAbsent:nil.
-        newColl notNil ifTrue:[^ newColl asOrderedCollection]
+    "/ use cached information (avoid class hierarchy search), if possible
+    subclasses isNil ifTrue:[
+        subclasses := super subclasses asArray.
     ].
-
-    newColl := OrderedCollection new.
-    self subclassesDo:[:aClass |
-        newColl add:aClass
-    ].
-    SubclassInfo notNil ifTrue:[
-        SubclassInfo at:self put:newColl.
-    ].
-    ^ newColl
+    ^ subclasses
 
     "
      Class flushSubclassInfo.
@@ -5033,11 +5047,11 @@
 !Class class methodsFor:'documentation'!
 
 version
-    ^ '$Id: Class.st 10510 2010-04-08 17:25:02Z vranyj1 $'
+    ^ '$Id: Class.st 10512 2010-04-09 18:02:18Z vranyj1 $'
 !
 
 version_CVS
-    ^ '§Header: /cvs/stx/stx/libbasic/Class.st,v 1.568 2010/04/06 15:33:20 cg Exp §'
+    ^ '§Header: /cvs/stx/stx/libbasic/Class.st,v 1.570 2010/04/07 18:21:18 cg Exp §'
 ! !
 
 
@@ -5045,3 +5059,4 @@
 
 
 
+