Andreas Raab uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-ar.418.mcz ==================== Summary ==================== Name: Kernel-ar.418 Author: ar Time: 5 March 2010, 7:34:04.564 pm UUID: 3e6da606-e78d-1b45-adaf-af57902b8b4a Ancestors: Kernel-cmm.417 Fix some questionable messages sent to the environment of classes, including #garbageCollect, #compactClassesArray and more. All of these belong sent to Smalltalk not the local environment. =============== Diff against Kernel-cmm.417 =============== Item was changed: ----- Method: Behavior>>shouldNotBeRedefined (in category 'testing') ----- shouldNotBeRedefined "Return true if the receiver should not be redefined. The assumption is that compact classes, classes in Smalltalk specialObjects and Behaviors should not be redefined" + ^(Smalltalk compactClassesArray includes: self) + or:[(Smalltalk specialObjectsArray includes: self) - ^(self environment compactClassesArray includes: self) - or:[(self environment specialObjectsArray includes: self) or:[self isKindOf: self]]! Item was changed: ----- Method: ClassDescription>>removeUninstantiatedSubclassesSilently (in category 'accessing class hierarchy') ----- removeUninstantiatedSubclassesSilently "Remove the classes of any subclasses that have neither instances nor subclasses. Answer the number of bytes reclaimed" "Player removeUninstantiatedSubclassesSilently" | candidatesForRemoval oldFree | + oldFree := Smalltalk garbageCollect. - oldFree := self environment garbageCollect. candidatesForRemoval := self subclasses select: [:c | (c instanceCount = 0) and: [c subclasses size = 0]]. candidatesForRemoval do: [:c | c removeFromSystem]. + ^Smalltalk garbageCollect - oldFree! - ^ self environment garbageCollect - oldFree! Item was changed: ----- Method: Behavior>>becomeCompact (in category 'private') ----- becomeCompact "Here are the restrictions on compact classes in order for export segments to work: A compact class index may not be reused. If a class was compact in a release of Squeak, no other class may use that index. The class might not be compact later, and there should be nil in its place in the array." | cct index | self isWeak ifTrue:[^ self halt: 'You must not make a weak class compact']. + cct := Smalltalk compactClassesArray. - cct := self environment compactClassesArray. (self indexIfCompact > 0 or: [cct includes: self]) ifTrue: [^ self halt: self name , 'is already compact']. index := cct indexOf: nil ifAbsent: [^ self halt: 'compact class table is full']. "Install this class in the compact class table" cct at: index put: self. "Update instspec so future instances will be compact" format := format + (index bitShift: 11). "Make up new instances and become old ones into them" self updateInstancesFrom: self. "Purge any old instances" Smalltalk garbageCollect.! Item was changed: ----- Method: Behavior>>whichSelectorsReferTo: (in category 'testing method dictionary') ----- whichSelectorsReferTo: literal "Answer a Set of selectors whose methods access the argument as a literal." | special byte | + special := Smalltalk hasSpecialSelector: literal ifTrueSetByte: [:b | byte := b]. - special := self environment hasSpecialSelector: literal ifTrueSetByte: [:b | - byte := b]. ^self whichSelectorsReferTo: literal special: special byte: byte "Rectangle whichSelectorsReferTo: #+."! Item was changed: ----- Method: Behavior>>allLocalCallsOn: (in category 'user interface') ----- allLocalCallsOn: aSymbol "Answer a SortedCollection of all the methods that call on aSymbol, anywhere in my class hierarchy." | aSet special byte cls | aSet := Set new. cls := self theNonMetaClass. + special := Smalltalk hasSpecialSelector: aSymbol - special := self environment hasSpecialSelector: aSymbol ifTrueSetByte: [:b | byte := b ]. cls withAllSuperAndSubclassesDoGently: [ :class | (class whichSelectorsReferTo: aSymbol special: special byte: byte) do: [:sel | sel isDoIt ifFalse: [aSet add: class name , ' ', sel]]]. cls class withAllSuperAndSubclassesDoGently: [ :class | (class whichSelectorsReferTo: aSymbol special: special byte: byte) do: [:sel | sel isDoIt ifFalse: [aSet add: class name , ' ', sel]]]. ^aSet! Item was changed: ----- Method: Behavior>>becomeUncompact (in category 'private') ----- becomeUncompact | cct index | + cct := Smalltalk compactClassesArray. - cct := self environment compactClassesArray. (index := self indexIfCompact) = 0 ifTrue: [^ self]. (cct includes: self) ifFalse: [^ self halt "inconsistent state"]. "Update instspec so future instances will not be compact" format := format - (index bitShift: 11). "Make up new instances and become old ones into them" self updateInstancesFrom: self. "Make sure there are no compact ones left around" Smalltalk garbageCollect. "Remove this class from the compact class table" cct at: index put: nil. ! Item was changed: ----- Method: Behavior>>becomeCompactSimplyAt: (in category 'private') ----- becomeCompactSimplyAt: index "Make me compact, but don't update the instances. For importing segments." "Here are the restrictions on compact classes in order for export segments to work: A compact class index may not be reused. If a class was compact in a release of Squeak, no other class may use that index. The class might not be compact later, and there should be nil in its place in the array." | cct | self isWeak ifTrue:[^ self halt: 'You must not make a weak class compact']. + cct := Smalltalk compactClassesArray. - cct := self environment compactClassesArray. (self indexIfCompact > 0 or: [cct includes: self]) ifTrue: [^ self halt: self name , 'is already compact']. (cct at: index) ifNotNil: [^ self halt: 'compact table slot already in use']. "Install this class in the compact class table" cct at: index put: self. "Update instspec so future instances will be compact" format := format + (index bitShift: 11). "Caller must convert the instances" ! |
Free forum by Nabble | Edit this page |