[Pkg] The Trunk: Kernel-ul.709.mcz

[commits at source.squeak.org]

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!