[squeak-dev] The Trunk: System-nice.148.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Sep 16 19:56:22 UTC 2009
Nicolas Cellier uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-nice.148.mcz
==================== Summary ====================
Name: System-nice.148
Author: nice
Time: 16 September 2009, 9:55:30 am
UUID: 65da5445-0683-4adb-b74d-6320c987d5ff
Ancestors: System-ar.147
Multilingual code said "Thu shalt not use Symbol allInstances anymore".
http://bugs.squeak.org/view.php?id=6584
=============== Diff against System-ar.147 ===============
Item was changed:
----- Method: CodeLoader class>>exportCodeSegment:classes:keepSource: (in category 'utilities') -----
exportCodeSegment: exportName classes: aClassList keepSource: keepSources
"Code for writing out a specific category of classes as an external image segment. Perhaps this should be a method."
| is oldMethods newMethods classList symbolHolder fileName |
keepSources
ifTrue: [
self confirm: 'We are going to abandon sources.
Quit without saving after this has run.' orCancel: [^self]].
classList := aClassList asArray.
"Strong pointers to symbols"
+ symbolHolder := Symbol allSymbols.
- symbolHolder := Symbol allInstances.
oldMethods := OrderedCollection new: classList size * 150.
newMethods := OrderedCollection new: classList size * 150.
keepSources
ifTrue: [
classList do: [:cl |
cl selectors do:
[:selector | | m oldCodeString methodNode |
m := cl compiledMethodAt: selector.
m fileIndex > 0 ifTrue:
[oldCodeString := cl sourceCodeAt: selector.
methodNode := cl compilerClass new
parse: oldCodeString in: cl notifying: nil.
oldMethods addLast: m.
newMethods addLast: (m copyWithTempsFromMethodNode: methodNode)]]]].
oldMethods asArray elementsExchangeIdentityWith: newMethods asArray.
oldMethods := newMethods := nil.
Smalltalk garbageCollect.
is := ImageSegment new copyFromRootsForExport: classList. "Classes and MetaClasses"
fileName := FileDirectory fileName: exportName extension: ImageSegment fileExtension.
is writeForExport: fileName.
self compressFileNamed: fileName
!
Item was changed:
----- Method: SystemDictionary>>writeImageSegmentsFrom:withKernel: (in category 'shrinking') -----
writeImageSegmentsFrom: segmentDictionary withKernel: kernel
"segmentDictionary is associates segmentName -> {classNames. methodNames},
and kernel is another set of classNames determined to be essential.
Add a partition, 'Secondary' with everything not in partitions and not in the kernel.
Then write segments based on this partitioning of classes."
| metas secondary dups segDict overlaps classes n symbolHolder |
"First, put all classes that are in no other partition, and not in kernel into a new partition called 'Secondary'. Also remove any classes in kernel from putative partitions."
secondary := Smalltalk classNames asIdentitySet.
segmentDictionary keysDo:
[:segName |
secondary removeAllFoundIn: (segmentDictionary at: segName) first.
(segmentDictionary at: segName) first removeAllFoundIn: kernel].
secondary removeAllFoundIn: kernel.
secondary removeAllFoundIn: #(PseudoContext TranslatedMethod Utilities Preferences OutOfScopeNotification FakeClassPool BlockCannotReturn FormSetFont ExternalSemaphoreTable NetNameResolver ScreenController InterpreterPlugin Command WeakSet).
FileDirectory allSubclassesDo: [:c | secondary remove: c name ifAbsent: []].
segmentDictionary at: 'Secondary' put: {secondary. {}}.
"Now build segDict giving className -> segName, and report any duplicates."
dups := Dictionary new.
segDict := IdentityDictionary new: 3000.
segmentDictionary keysDo:
[:segName | (segmentDictionary at: segName) first do:
[:className |
(segDict includesKey: className) ifTrue:
[(dups includesKey: className) ifFalse: [dups at: className put: Array new].
dups at: className put: (dups at: className) , {segName}].
segDict at: className put: segName]].
dups size > 0 ifTrue: [dups inspect. ^ self error: 'Duplicate entries'].
"Then for every class in every partition, make sure that neither it
nor any of its superclasses are in any other partition. If they are,
enter them in a dictionary of overlaps.
If the dictionary is not empty, then stop and report it."
overlaps := Dictionary new.
segmentDictionary keysDo:
[:segName |
classes := (segmentDictionary at: segName) first asArray collect: [:k | Smalltalk at: k].
classes do:
[:c | (c isKindOf: Class) ifTrue:
[c withAllSuperclasses do:
[:sc | n := segDict at: sc name ifAbsent: [segName].
n ~= segName ifTrue:
[n = 'Secondary'
ifTrue: [(segmentDictionary at: 'Secondary') first
remove: sc name ifAbsent: []]
ifFalse: [overlaps at: c name put:
(c withAllSuperclasses collect: [:cc | segDict associationAt: cc name ifAbsent: [cc name -> 'Kernel']])]]]]]].
overlaps size > 0 ifTrue: [overlaps inspect. ^ self error: 'Superclasses in separate segments'].
"If there are no overlaps, then proceed to write the partitioned classes."
+ symbolHolder := Symbol allSymbols. "Hold onto Symbols with strong pointers,
- symbolHolder := Symbol allInstances. "Hold onto Symbols with strong pointers,
so they will be in outPointers"
segmentDictionary keysDo:
[:segName | Utilities informUser: segName during:
[classes := (segmentDictionary at: segName) first asArray collect: [:k | Smalltalk at: k].
metas := classes select: [:c | c isKindOf: Class] thenCollect: [:c | c class].
(ImageSegment new copyFromRoots: classes , metas sizeHint: 0) extract;
writeToFile: segName]].
symbolHolder. "Keep compiler for getting uppity."!
More information about the Squeak-dev
mailing list
|