Levente Uzonyi uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ul.709.mcz
==================== Summary ====================
Name: Kernel-ul.709 Author: ul Time: 4 September 2012, 12:42:11.196 am UUID: 359e6dd2-5981-ae43-a5bd-c687dd1d5614 Ancestors: Kernel-eem.708
Various changes: - improved Object >> #inboundPointersExcluding:. Better results (less noise) and performance. Uses a marker object instead of 0. - introduced ProtoObject >> #pointsOnlyWeaklyTo: which returns true if the receiver only has a weak reference to the argument, otherwise false. The reason why it's in ProtoObject is that #pointsTo: is there too. Implementation from Pharo by Igor Stasenko. - added Process >> #environmentAt:ifAbsentPut: which is useful for direct manipulation of the environment of Processes - introduced Behavior >> #isCompact and changed two methods which can use this method directly
=============== Diff against Kernel-eem.708 ===============
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. + (self isCompact or: [cct includes: self]) - (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>>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. + (self isCompact or: [cct includes: self]) - (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" !
Item was added: + ----- Method: Behavior>>isCompact (in category 'testing') ----- + isCompact + + ^self indexIfCompact ~= 0!
Item was changed: ----- Method: Object>>inboundPointersExcluding: (in category 'tracing') ----- inboundPointersExcluding: objectsToExclude + "Answer a list of all objects in the system that hold a reference to me, excluding those in the collection of objectsToExclude." - "Answer a list of all objects in the system that point to me, excluding those in the collection of objectsToExclude. I do my best to avoid creating any temporary objects that point to myself, especially method and block contexts. Adapted from PointerFinder class >> #pointersTo:except:"
+ | pointers object objectsToAlwaysExclude | - | anObj pointers objectsToAlwaysExclude | Smalltalk garbageCollect. + pointers := OrderedCollection new. + "SystemNavigation >> #allObjectsDo: is inlined here with a slight modification: the marker object is pointers. This gives better results, because the value of pointers, it's inner objects and transient method contexts will not be iterated over." + object := self someObject. + [ object == pointers ] whileFalse: [ + (object isInMemory and: [ object pointsTo: self ]) ifTrue: [ + pointers add: object ]. + object := object nextObject ]. - "big collection shouldn't grow, so it's contents array is always the same" - pointers := OrderedCollection new: 1000. - - "#allObjectsDo: and #pointsTo: are expanded inline to keep spurious - method and block contexts out of the results" - anObj := self someObject. - [0 == anObj] whileFalse: [ "We must use #== here, to avoid leaving the loop when anObj is another number that's equal to 0 (e.g. 0.0)." - anObj isInMemory - ifTrue: [((anObj instVarsInclude: self) - or: [anObj class == self]) - ifTrue: [pointers add: anObj]]. - anObj := anObj nextObject]. - objectsToAlwaysExclude := { - pointers collector. thisContext. thisContext sender. thisContext sender sender. objectsToExclude. }. + ^pointers removeAllSuchThat: [ :ea | - - ^ pointers removeAllSuchThat: [:ea | (objectsToAlwaysExclude identityIncludes: ea) + or: [ objectsToExclude identityIncludes: ea ] ]! - or: [objectsToExclude identityIncludes: ea]]!
Item was added: + ----- Method: Process>>environmentAt:ifAbsentPut: (in category 'process specific') ----- + environmentAt: key ifAbsentPut: aBlock + + ^(env ifNil: [ env := Dictionary new ]) at: key ifAbsentPut: aBlock.!
Item was added: + ----- Method: ProtoObject>>pointsOnlyWeaklyTo: (in category 'tracing') ----- + pointsOnlyWeaklyTo: anObject + "Assume, we already know that receiver points to an object, answer true if receiver points only weakly to it." + + self class isWeak ifFalse: [ ^false ]. + 1 to: self class instSize do: [ :i | + (self instVarAt: i) == anObject ifTrue: [ ^false ] ]. + ^true!