Avoid rehashing of sets in #allClasses..
authorStefan Vogel <sv@exept.de>
Wed, 19 Oct 2005 14:35:44 +0200
changeset 8964 91b012315d91
parent 8963 e81373595ecf
child 8965 b3cebce55744
Avoid rehashing of sets in #allClasses..
Smalltalk.st
--- a/Smalltalk.st	Wed Oct 19 14:34:05 2005 +0200
+++ b/Smalltalk.st	Wed Oct 19 14:35:44 2005 +0200
@@ -14,17 +14,17 @@
 
 Object subclass:#Smalltalk
 	instanceVariableNames:''
-	classVariableNames:'StartBlocks ImageStartBlocks ExitBlocks CachedClasses SystemPath
-		StartupClass StartupSelector StartupArguments CommandLine
-		CommandName CommandLineArguments CachedAbbreviations
-		SilentLoading Initializing StandAlone HeadlessOperation
-		DebuggingStandAlone LogDoits LoadBinaries RealSystemPath
-		ResourcePath SourcePath BitmapPath BinaryPath FileInPath
-		PackagePath BinaryDirName ResourceDirName SourceDirName
-		BitmapDirName PackageDirName FileInDirName ChangeFileName
-		ImageStartTime ImageRestartTime DemoMode SaveEmergencyImage
-		SpecialObjectArray CallbackSignal KnownPackages
-		ClassesFailedToInitialize'
+	classVariableNames:'StartBlocks ImageStartBlocks ExitBlocks CachedClasses
+		NumberOfClassesHint SystemPath StartupClass StartupSelector
+		StartupArguments CommandLine CommandName CommandLineArguments
+		CachedAbbreviations SilentLoading Initializing StandAlone
+		HeadlessOperation DebuggingStandAlone LogDoits LoadBinaries
+		RealSystemPath ResourcePath SourcePath BitmapPath BinaryPath
+		FileInPath PackagePath BinaryDirName ResourceDirName
+		SourceDirName BitmapDirName PackageDirName FileInDirName
+		ChangeFileName ImageStartTime ImageRestartTime DemoMode
+		SaveEmergencyImage SpecialObjectArray CallbackSignal
+		KnownPackages ClassesFailedToInitialize'
 	poolDictionaries:''
 	category:'System-Support'
 !
@@ -469,6 +469,8 @@
 
     |idx|
 
+    NumberOfClassesHint := 4500.
+
     Initializing := true.
 
     AbstractOperatingSystem initializeConcreteClass.
@@ -1597,18 +1599,18 @@
 
     |already|
 
-    already := IdentitySet new.
+    already := IdentitySet new:NumberOfClassesHint*2.
     self allClassesDo:[:eachClass | |cls|
-	cls := eachClass theNonMetaclass.
-	(already includes:cls) ifFalse:[
-	    aBlock value:cls.
-	    already add:cls.    
-	].
-	cls := cls class.
-	(already includes:cls) ifFalse:[
-	    aBlock value:cls.
-	    already add:cls.    
-	].
+        cls := eachClass theNonMetaclass.
+        (already includes:cls) ifFalse:[
+            aBlock value:cls.
+            already add:cls.    
+        ].
+        cls := cls class.
+        (already includes:cls) ifFalse:[
+            aBlock value:cls.
+            already add:cls.    
+        ].
     ].
 !
 
@@ -1688,22 +1690,22 @@
 
     |already|
 
-    already := IdentitySet new.
-    self allClassesDo:[:aClass |
-	(already includes:aClass) ifFalse:[
-	    aClass allSuperclasses reverseDo:[:cls |
-		(already includes:aClass) ifFalse:[
-		    already add:cls.
-		    aBlock value:cls.
-		].
-	    ].
-	    already add:aClass.
-	    aBlock value:aClass.
-	]
-    ].
-
-    "
-     Smalltalk allClassesInOrderDo:[:aClass | aClass name printCR]
+    already := IdentitySet new:NumberOfClassesHint.
+    self allClassesDo:[:eachClass |
+        (already includes:eachClass) ifFalse:[
+            eachClass allSuperclasses reverseDo:[:eachSuperClass |
+                (already includes:eachSuperClass) ifFalse:[
+                    already add:eachSuperClass.
+                    aBlock value:eachSuperClass.
+                ].
+            ].
+            already add:eachClass.
+            aBlock value:eachClass.
+        ]
+    ].
+
+    "
+     Smalltalk allClassesInOrderDo:[:aClass | Transcript showCR:aClass name]
     "
 !
 
@@ -1936,32 +1938,32 @@
     "/ If that happens, we restart the set-building here
     "/
     [(classes := CachedClasses) isNil] whileTrue:[
-	CachedClasses := classes := IdentitySet new:800. 
-	self keysAndValuesDo:[:sym :anObject |
-	    anObject notNil ifTrue:[
-		anObject isBehavior ifTrue:[
-		    "/ sigh - would like to skip over aliases
-		    "/ but this cannot be done simply by comparing
-		    "/ the classes name against the store-key
-		    "/ i.e. cannot do:
-		    "/      anObject name == sym ifTrue:[
-		    "/          classes add:anObject
-		    "/      ]
-		    "/ because that would lead to ignore all java
-		    "/ classes, which are stored under a different
-		    "/ key.
-
-		    (anObject name == sym
-		    or:[anObject isJavaClass]) ifTrue:[
-			classes add:anObject
-		    ].
-		]
-	    ]
-	]
+        CachedClasses := classes := IdentitySet new:NumberOfClassesHint. 
+        self keysAndValuesDo:[:eachName :eachGlobal |
+            (eachGlobal notNil and:[eachGlobal isBehavior]) ifTrue:[
+                "/ sigh - would like to skip over aliases
+                "/ but this cannot be done simply by comparing
+                "/ the classes name against the store-key
+                "/ i.e. cannot do:
+                "/      anObject name == sym ifTrue:[
+                "/          classes add:anObject
+                "/      ]
+                "/ because that would lead to ignore all java
+                "/ classes, which are stored under a different
+                "/ key.
+
+                (eachGlobal name == eachName
+                 or:[eachGlobal isJavaClass]) ifTrue:[
+                    classes add:eachGlobal
+                ].
+            ]
+        ].
+        NumberOfClassesHint := classes size.
     ].
     ^ classes
 
-    "CachedClasses := nil.
+    "
+     CachedClasses := nil.
      Smalltalk allClasses
 
     to get the list sorted by name:
@@ -1977,10 +1979,10 @@
 
     |classes|
 
-    classes := IdentitySet new.
+    classes := IdentitySet new:NumberOfClassesHint*2.
     self allClassesDo:[:eachClass |
-	classes add:(eachClass theNonMetaclass).
-	classes add:(eachClass theMetaclass).
+        classes add:(eachClass theNonMetaclass).
+        classes add:(eachClass theMetaclass).
     ].
     ^ classes
 !
@@ -6458,5 +6460,5 @@
 !Smalltalk class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.684 2005-10-13 14:07:45 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.685 2005-10-19 12:35:44 stefan Exp $'
 ! !