class: Smalltalk
authorStefan Vogel <sv@exept.de>
Thu, 03 Sep 2015 22:19:38 +0200
changeset 18732 34212221028c
parent 18731 561e93b88768
child 18733 20fc1bb8fe15
class: Smalltalk added: #basicRemoveClass: #removeClasses: changed: #removeClass:
Smalltalk.st
--- a/Smalltalk.st	Thu Sep 03 14:09:02 2015 +0200
+++ b/Smalltalk.st	Thu Sep 03 22:19:38 2015 +0200
@@ -1274,6 +1274,111 @@
 
 !Smalltalk class methodsFor:'class management'!
 
+basicRemoveClass:aClass
+    "remove the argument, aClass from the smalltalk dictionary;
+     we have to flush the caches since these methods are now void.
+     Also, class variables of aClass are removed."
+
+    |sym cSym names oldName oldNameSym actualName wrongName|
+
+    aClass isNil ifTrue:[^ self].
+
+    oldName := aClass name.
+    sym := oldNameSym := oldName asSymbol.
+    ((self at:oldNameSym) == aClass) ifFalse:[
+        "check other name ..."
+        (self includes:aClass) ifFalse:[
+            'Smalltalk [warning]: no such class: ' errorPrint. oldName errorPrintCR.
+            ^ self
+        ].
+        "
+         the class has changed its name - without telling me ...
+         what should be done in this case ?
+        "
+        'Smalltalk [warning]: class ' errorPrint. oldName errorPrint.
+        ' has changed its name' errorPrintCR.
+
+        "/
+        "/ might be an alias (i.e. removing a compatibility name)
+        "/
+        actualName := self keyAtValue:aClass.
+        ('Smalltalk [info]: ' , oldName , ' is actually stored as ' , actualName , '.') infoPrintCR.
+        sym := actualName asSymbol.
+        oldName := actualName asString.
+        wrongName := true.
+    ].
+
+    self at:sym put:nil.    "nil it out for compiled accesses"
+
+    "/
+    "/ see comment in removeKey: on why we dont remove it here
+    "/
+    "/ self removeKey:sym.     "/ remove key - this actually fails, if there are
+                               "/ still compiled code references."
+
+    "remove private classes"
+
+    aClass privateClassesSorted do:[:somePrivateClass |
+        aClass privateClassesAt:(somePrivateClass nameWithoutPrefix) asSymbol put:nil.
+    ].
+
+    "remove class variables"
+
+    names := aClass classVariableString asCollectionOfWords.
+    names do:[:name |
+        cSym := aClass globalKeyForClassVar:name.
+        self at:cSym asSymbol put:nil.
+
+        "/
+        "/ see comment in removeKey: on why we dont remove it here
+        "/
+        "/ self removeKey:cSym
+    ].
+
+
+"/    actually could get along with less flushing
+"/    (entries for aClass and subclasses only)
+"/    but we have to delay this, until we have the set of subclasses
+"/    at hand - for now, searching for all subclasses is way more
+"/    expensive then cache flushing.
+"/
+"/    aClass allSubclassesDo:[:aSubclass |
+"/        ObjectMemory flushInlineCachesForClass:aSubclass.
+"/        ObjectMemory flushMethodCacheFor:aSubclass
+"/    ].
+"/    ObjectMemory flushInlineCachesForClass:aClass.
+"/    ObjectMemory flushMethodCacheFor:aClass
+
+    ObjectMemory flushInlineCaches.
+    ObjectMemory flushMethodCache.
+
+    aClass addChangeRecordForClassRemove.
+    self changed:#classRemove with:aClass.
+
+    aClass setCategory:#'* removed *'.
+
+"/    self flushCachedClasses.
+"/    Class flushSubclassInfo.
+    self flushCachedClass:aClass.
+    Class flushSubclassInfoFor:aClass superclass.
+    Class flushSubclassInfoFor:aClass.
+
+    wrongName == true ifTrue:[
+        "/
+        "/ an alias (i.e. removing a compatibility name)
+        "/
+        "/ check if there are more refs to it ...
+        [self includes:aClass] whileTrue:[
+            actualName := self keyAtValue:aClass.
+            ('Smalltalk [info]: ' , aClass name , ' is also registered under the name ' , actualName
+                          , ' - remove that binding too.') infoPrintCR.
+            self at:actualName put:nil.
+        ].
+    ].
+
+    "Modified: / 18-11-2006 / 17:16:31 / cg"
+!
+
 changeCategoryOf:aClass to:newCategory
     "change a classes category, add a change record,
      send change notifications"
@@ -1321,126 +1426,79 @@
 removeClass:aClass
     "remove the argument, aClass from the smalltalk dictionary;
      we have to flush the caches since these methods are now void.
-     Also, class variables of aClass are removed."
-
-    |sym cSym names oldName oldNameSym actualName wrongName ns ons|
-
-    aClass isNil ifTrue:[^ self].
-
-    oldName := aClass name.
-    sym := oldNameSym := oldName asSymbol.
-    ((self at:oldNameSym) == aClass) ifFalse:[
-	"check other name ..."
-	(self includes:aClass) ifFalse:[
-	    'Smalltalk [warning]: no such class: ' errorPrint. oldName errorPrintCR.
-	    ^ self
-	].
-	"
-	 the class has changed its name - without telling me ...
-	 what should be done in this case ?
-	"
-	'Smalltalk [warning]: class ' errorPrint. oldName errorPrint.
-	' has changed its name' errorPrintCR.
-
-	"/
-	"/ might be an alias (i.e. removing a compatibility name)
-	"/
-	actualName := self keyAtValue:aClass.
-	('Smalltalk [info]: ' , oldName , ' is actually stored as ' , actualName , '.') infoPrintCR.
-	sym := actualName asSymbol.
-	oldName := actualName asString.
-	wrongName := true.
-    ].
-
+     Also, class variables of aClass are removed.
+     Recompile accessors to aClass."
+
+    |oldNameSym ns ons|
+
+    oldNameSym := aClass name asSymbol.
     ns := aClass nameSpace.
     aClass topOwningClass notNil ifTrue:[
-	ons := aClass topOwningClass nameSpace
-    ].
-
-    self at:sym put:nil.    "nil it out for compiled accesses"
-
-    "/
-    "/ see comment in removeKey: on why we dont remove it here
-    "/
-    "/ self removeKey:sym.     "/ remove key - this actually fails, if there are
-			       "/ still compiled code references."
-
-    "remove private classes"
-
-    aClass privateClassesSorted do:[:somePrivateClass |
-	aClass privateClassesAt:(somePrivateClass nameWithoutPrefix) asSymbol put:nil.
-    ].
-
-    "remove class variables"
-
-    names := aClass classVariableString asCollectionOfWords.
-    names do:[:name |
-	cSym := aClass globalKeyForClassVar:name.
-	self at:cSym asSymbol put:nil.
-
-	"/
-	"/ see comment in removeKey: on why we dont remove it here
-	"/
-	"/ self removeKey:cSym
-    ].
-
-
-"/    actually could get along with less flushing
-"/    (entries for aClass and subclasses only)
-"/    but we have to delay this, until we have the set of subclasses
-"/    at hand - for now, searching for all subclasses is way more
-"/    expensive then cache flushing.
-"/
-"/    aClass allSubclassesDo:[:aSubclass |
-"/        ObjectMemory flushInlineCachesForClass:aSubclass.
-"/        ObjectMemory flushMethodCacheFor:aSubclass
-"/    ].
-"/    ObjectMemory flushInlineCachesForClass:aClass.
-"/    ObjectMemory flushMethodCacheFor:aClass
-
-    ObjectMemory flushInlineCaches.
-    ObjectMemory flushMethodCache.
-
-    aClass addChangeRecordForClassRemove.
-    self changed:#classRemove with:aClass.
-
-    aClass setCategory:#'* removed *'.
-
-"/    self flushCachedClasses.
-"/    Class flushSubclassInfo.
-    self flushCachedClass:aClass.
-    Class flushSubclassInfoFor:aClass superclass.
-    Class flushSubclassInfoFor:aClass.
-
-    wrongName == true ifTrue:[
-	"/
-	"/ an alias (i.e. removing a compatibility name)
-	"/
-	"/ check if there are more refs to it ...
-	[self includes:aClass] whileTrue:[
-	    actualName := self keyAtValue:aClass.
-	    ('Smalltalk [info]: ' , aClass name , ' is also registered under the name ' , actualName
-			  , ' - remove that binding too.') infoPrintCR.
-	    self at:actualName put:nil.
-	].
-    ].
+        ons := aClass topOwningClass nameSpace
+    ].
+
+    self basicRemoveClass:aClass.
 
     ns ~~ Smalltalk ifTrue:[
-	ons notNil ifTrue:[
-	    ClassBuilder
-		recompileGlobalAccessorsTo:oldNameSym
-		in:ons
-		except:nil
-	].
-	(ns notNil and:[ns ~~ ons]) ifTrue:[
-	    ClassBuilder
-		recompileGlobalAccessorsTo:oldNameSym
-		in:ns
-		except:nil
-	].
-    ].
-
-    "Modified: / 18-11-2006 / 17:16:31 / cg"
+        ons notNil ifTrue:[
+            ClassBuilder
+                recompileGlobalAccessorsTo:oldNameSym
+                in:ons
+                except:nil
+        ].
+        (ns notNil and:[ns ~~ ons]) ifTrue:[
+            ClassBuilder
+                recompileGlobalAccessorsTo:oldNameSym
+                in:ns
+                except:nil
+        ].
+    ].
+!
+
+removeClasses:aCollectionOfClasses
+    "remove aCollectionOfClasses from the smalltalk dictionary;
+     we have to flush the caches since these methods are now void.
+     Also, class variables of aClass are removed.
+     Recompile accessors to the classes - after all classes in the collection have been removed."
+
+    |tuples|
+
+    tuples := aCollectionOfClasses collect:[:eachClass|
+                Array 
+                    with:eachClass name asSymbol
+                    with:eachClass nameSpace
+                    with:(
+                            eachClass topOwningClass notNil ifTrue:[
+                                eachClass topOwningClass nameSpace
+                            ] ifFalse:[nil])
+            ].
+
+    aCollectionOfClasses do:[:eachClass|
+        self basicRemoveClass:eachClass.
+    ].
+
+    tuples do:[:eachClssymNsOnsTuple|
+        |oldNameSym ns ons|
+
+        oldNameSym := eachClssymNsOnsTuple at:1.
+        ns := eachClssymNsOnsTuple at:2.
+        ons := eachClssymNsOnsTuple at:3.
+
+        ns ~~ Smalltalk ifTrue:[
+            ons notNil ifTrue:[
+                ClassBuilder
+                    recompileGlobalAccessorsTo:oldNameSym
+                    in:ons
+                    except:nil
+            ].
+            (ns notNil and:[ns ~~ ons]) ifTrue:[
+                ClassBuilder
+                    recompileGlobalAccessorsTo:oldNameSym
+                    in:ns
+                    except:nil
+            ].
+        ]
+    ].
 !
 
 renameClass:aClass to:newName