Avoid rehashing of sets in #allClasses..
--- 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 $'
! !