[squeak-dev] The Trunk: Kernel-ar.284.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Oct 31 06:22:53 UTC 2009


Andreas Raab uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-ar.284.mcz

==================== Summary ====================

Name: Kernel-ar.284
Author: ar
Time: 30 October 2009, 11:22:18 am
UUID: f00d24a4-e752-9c4a-b7cc-6a5052f49b9b
Ancestors: Kernel-nice.283, Kernel-ul.283

Merging Kernel-ul.283:

Updated MethodDictionary
- added MethodDictionary class >> #rehashAllInstances which rehashes all instances and changes the identities in one shot. Much faster than single #become: sends.
- removed
	- #add: - same implementation in superclass
	- #at:putNoBecome:, #fullCheckNoBecome, #growNoBecome, #removeKeyNoBecome: - old methods with no senders (not even in 3.8 full), no comment stating their usefulness
- modified several methods which have cleaner code and/or better performance assuming the following invariant: (self basicAt: index) isNil = (array at: index) isNil
- added a line about the invariant to the class comment

=============== Diff against Kernel-nice.283 ===============

Item was changed:
  ----- Method: MethodDictionary class>>new (in category 'instance creation') -----
  new
  	"change the default size to be a bit bigger to help reduce the number of #grows while filing in"
+ 	
  	^self new: 16!

Item was changed:
  ----- Method: MethodDictionary>>keyAtIdentityValue:ifAbsent: (in category 'accessing') -----
  keyAtIdentityValue: value ifAbsent: exceptionBlock
  	"Answer the key whose value equals the argument, value. If there is
  	none, answer the result of evaluating exceptionBlock."
+ 
+ 	value ifNotNil: [
+ 		1 to: self basicSize do: [ :index |
+ 			(array at: index) == value ifTrue: [
+ 				^self basicAt: index ] ] ].
+ 	^exceptionBlock value!
- 	| theKey |
- 	1 to: self basicSize do:
- 		[:index |
- 		value == (array at: index)
- 			ifTrue:
- 				[(theKey := self basicAt: index) == nil
- 					ifFalse: [^ theKey]]].
- 	^ exceptionBlock value!

Item was changed:
  ----- Method: MethodDictionary>>removeKey:ifAbsent: (in category 'removing') -----
  removeKey: key ifAbsent: errorBlock 
  	"The interpreter might be using this MethodDict while
  	this method is running!!  Therefore we perform the removal
  	in a copy, and then atomically become that copy"
+ 
  	| copy |
  	copy := self copy.
  	copy removeDangerouslyKey: key ifAbsent: [^ errorBlock value].
  	self become: copy!

Item was changed:
  ----- Method: MethodDictionary>>methodArray (in category 'private') -----
  methodArray
+ 
+ 	^array!
- 	^ array!

Item was changed:
  ----- Method: MethodDictionary>>at:put: (in category 'accessing') -----
  at: key put: value
  	"Set the value at key to be value."
+ 	
  	| index |
  	index := self scanFor: key.
+ 	(self basicAt: index)
+ 		ifNil: [
+ 			tally := tally + 1.
+ 			self basicAt: index put: key ]
+ 		ifNotNil: [ (array at: index) flushCache ].
- 	(self basicAt: index) == nil
- 		ifTrue: 
- 			[tally := tally + 1.
- 			self basicAt: index put: key]
- 		ifFalse:
- 			[(array at: index) flushCache].
  	array at: index put: value.
  	self fullCheck.
+ 	^value!
- 	^ value!

Item was changed:
  ----- Method: MethodDictionary>>removeDangerouslyKey:ifAbsent: (in category 'private') -----
  removeDangerouslyKey: key ifAbsent: aBlock
  	"This is not really dangerous.  But if normal removal
  	were done WHILE a MethodDict were being used, the
  	system might crash.  So instead we make a copy, then do
  	this operation (which is NOT dangerous in a copy that is
  	not being used), and then use the copy after the removal."
  
  	| index element |
  	index := self scanFor: key.
+ 	(element := array at: index) ifNil: [ ^aBlock value ].
- 	(self basicAt: index) == nil ifTrue: [ ^ aBlock value ].
- 	element := array at: index.
  	array at: index put: nil.
  	self basicAt: index put: nil.
  	tally := tally - 1.
  	self fixCollisionsFrom: index.
+ 	^element!
- 	^ element!

Item was changed:
  Dictionary variableSubclass: #MethodDictionary
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Kernel-Methods'!
  
+ !MethodDictionary commentStamp: 'ul 10/30/2009 04:43' prior: 0!
- !MethodDictionary commentStamp: '<historical>' prior: 0!
  I am just like a normal Dictionary, except that I am implemented differently.  Each Class has an instances of MethodDictionary to hold the correspondence between selectors (names of methods) and methods themselves.
+ 
- 
  In a normal Dictionary, the instance variable 'array' holds an array of Associations.  Since there are thousands of methods in the system, these Associations waste space.  
  
+ Each MethodDictionary is a variable object, with the list of keys (selector Symbols) in the variable part of the instance.  The variable 'array' holds the values, which are CompiledMethods.
+ 
+ I also maintain the following invariant: (self basicAt: index) isNil = (array at: index) isNil.!
- Each MethodDictionary is a variable object, with the list of keys (selector Symbols) in the variable part of the instance.  The variable 'array' holds the values, which are CompiledMethods.!

Item was changed:
  ----- Method: MethodDictionary>>keysDo: (in category 'enumeration') -----
+ keysDo: aBlock
+ 
+ 	tally = 0 ifTrue: [ ^self ].
+ 	1 to: self basicSize do: [ :i |
+ 		| key |
+ 		(key := self basicAt: i) ifNotNil: [
+ 			aBlock value: key ] ]!
- keysDo: aBlock 
- 	| key |
- 	tally = 0 ifTrue: [^ self].
- 	1 to: self basicSize do:
- 		[:i | (key := self basicAt: i) == nil
- 			ifFalse: [aBlock value: key]]!

Item was changed:
  ----- Method: MethodDictionary>>swap:with: (in category 'private') -----
  swap: oneIndex with: otherIndex
+ 
  	| element |
  	element := self basicAt: oneIndex.
  	self basicAt: oneIndex put: (self basicAt: otherIndex).
  	self basicAt: otherIndex put: element.
+ 	super swap: oneIndex with: otherIndex
- 	super swap: oneIndex with: otherIndex.
  !

Item was changed:
  ----- Method: MethodDictionary>>rehashWithoutBecome (in category 'private') -----
  rehashWithoutBecome
+ 
+ 	| newSelf |
- 	| newSelf key |
  	newSelf := self species new: self size.
+ 	1 to: self basicSize do: [ :i | 
+ 		| key |
+ 		(key := self basicAt: i) ifNotNil: [
+ 			newSelf at: key put: (array at: i) ] ].
- 	1 to: self basicSize do:
- 		[:i | key := self basicAt: i.
- 		key == nil ifFalse: [newSelf at: key put: (array at: i)]].
  	^newSelf!

Item was changed:
  ----- Method: MethodDictionary>>keyAtValue:ifAbsent: (in category 'accessing') -----
  keyAtValue: value ifAbsent: exceptionBlock
  	"Answer the key whose value equals the argument, value. If there is
  	none, answer the result of evaluating exceptionBlock."
+ 	
+ 	value ifNotNil: [
+ 		1 to: self basicSize do: [ :index |
+ 			(array at: index) = value ifTrue: [
+ 				^self basicAt: index ] ] ].
+ 	^exceptionBlock value!
- 	| theKey |
- 	1 to: self basicSize do:
- 		[:index |
- 		value = (array at: index)
- 			ifTrue:
- 				[(theKey := self basicAt: index) == nil
- 					ifFalse: [^ theKey]]].
- 	^ exceptionBlock value!

Item was changed:
  ----- Method: MethodDictionary>>keysAndValuesDo: (in category 'enumeration') -----
  keysAndValuesDo: aBlock 
  	"Enumerate the receiver with all the keys and values passed to the block"
+ 	
- 	| key |
  	tally = 0 ifTrue: [^ self].
+ 	1 to: self basicSize do: [ :i |
+ 		| key |
+ 		(key := self basicAt: i) ifNotNil: [
+ 			aBlock value: key value: (array at: i) ] ]!
- 	1 to: self basicSize do:
- 		[:i | (key := self basicAt: i) == nil ifFalse:
- 			[aBlock value: key value: (array at: i)]
- 		]!

Item was changed:
  ----- Method: MethodDictionary>>grow (in category 'private') -----
+ grow
+ 
+ 	| newSelf |
- grow 
- 	| newSelf key |
  	newSelf := self species new: self basicSize.  "This will double the size"
+ 	1 to: self basicSize do: [ :i | 
+ 		| key |
+ 		(key := self basicAt: i) ifNotNil: [
+ 			newSelf at: key put: (array at: i) ] ].
- 	1 to: self basicSize do:
- 		[:i | key := self basicAt: i.
- 		key == nil ifFalse: [newSelf at: key put: (array at: i)]].
  	self become: newSelf!

Item was added:
+ ----- Method: MethodDictionary class>>rehashAllInstances (in category 'initialization') -----
+ rehashAllInstances
+ 
+ 	| instances newInstances |
+ 	instances := self allInstances asArray.
+ 	newInstances := self allInstances collect: [ :each | each rehashWithoutBecome ].
+ 	instances elementsExchangeIdentityWith: newInstances!

Item was changed:
  ----- Method: MethodDictionary>>valuesDo: (in category 'enumeration') -----
  valuesDo: aBlock 
+ 	
+ 	tally = 0 ifTrue: [ ^self ].
+ 	1 to: self basicSize do: [ :i | 
+ 		| value |
+ 		(value := array at: i) ifNotNil: [
+ 			aBlock value: value ] ]!
- 	| value |
- 	tally = 0 ifTrue: [^ self].
- 	1 to: self basicSize do:
- 		[:i | (value := array at: i) == nil
- 			ifFalse: [aBlock value: value]]!

Item was changed:
  ----- Method: MethodDictionary>>keyAt: (in category 'private') -----
  keyAt: index
  
+ 	^self basicAt: index!
- 	^ self basicAt: index!

Item was changed:
  ----- Method: MethodDictionary>>do: (in category 'enumeration') -----
+ do: aBlock
+ 
+ 	tally = 0 ifTrue: [ ^self ].
+ 	1 to: self basicSize do: [ :i | 
+ 		| value |
+ 		(value := array at: i) ifNotNil: [
+ 			aBlock value: value ] ]
- do: aBlock 
- 	tally = 0 ifTrue: [^ self].
- 	1 to: self basicSize do:
- 		[:i | (self basicAt: i) == nil ifFalse:
- 			[aBlock value: (array at: i)]]
  !

Item was changed:
  ----- Method: MethodDictionary>>associationsDo: (in category 'enumeration') -----
  associationsDo: aBlock 
+ 	
+ 	tally = 0 ifTrue: [ ^self ].
+ 	1 to: self basicSize do: [ :i |
+ 		| key |
+ 		(key := self basicAt: i) ifNotNil: [
+ 			aBlock value: (Association key: key value: (array at: i)) ] ]!
- 	| key |
- 	tally = 0 ifTrue: [^ self].
- 	1 to: self basicSize do:
- 		[:i | (key := self basicAt: i) == nil ifFalse:
- 			[aBlock value: (Association key: key
- 									value: (array at: i))]]!

Item was changed:
  ----- Method: MethodDictionary>>at:ifAbsent: (in category 'accessing') -----
  at: key ifAbsent: aBlock
  
+ 	^(array at: (self scanFor: key)) ifNil: [ aBlock value ]!
- 	| index |
- 	index := self scanFor: key.
- 	(self basicAt: index) == nil ifTrue: [ ^ aBlock value ].
- 	^ array at: index!

Item was changed:
  ----- Method: MethodDictionary class>>new: (in category 'instance creation') -----
  new: nElements
  	"Create a Dictionary large enough to hold nElements without growing.
  	Note that the basic size must be a power of 2.
  	It is VITAL (see grow) that size gets doubled if nElements is a power of 2"
+ 	
  	| size |
  	size := 1 bitShift: nElements highBit.
+ 	^(self basicNew: size) initialize: size!
- 	^ (self basicNew: size) initialize: size!

Item was changed:
  ----- Method: MethodDictionary>>rehash (in category 'private') -----
  rehash 
+ 	
+ 	self become: self rehashWithoutBecome!
- 	| newSelf key |
- 	newSelf := self species new: self size.
- 	1 to: self basicSize do:
- 		[:i | key := self basicAt: i.
- 		key == nil ifFalse: [newSelf at: key put: (array at: i)]].
- 	self become: newSelf!

Item was removed:
- ----- Method: MethodDictionary>>add: (in category 'accessing') -----
- add: anAssociation
- 	^ self at: anAssociation key put: anAssociation value!

Item was removed:
- ----- Method: MethodDictionary>>removeKeyNoBecome: (in category 'removing') -----
- removeKeyNoBecome: key
- 
- 	"The interpreter might be using this MethodDict while
- 	this method is running!!  Therefore we perform the removal
- 	in a copy, and then return the copy for subsequent installation"
- 
- 	| copy |
- 	copy := self copy.
- 	copy removeDangerouslyKey: key ifAbsent: [^ self].
- 	^copy!

Item was removed:
- ----- Method: MethodDictionary>>fullCheckNoBecome (in category 'private') -----
- fullCheckNoBecome
- 
- 	"Keep array at least 1/4 free for decent hash behavior"
- 	array size - tally < (array size // 4 max: 1)
- 		ifTrue: [^self growNoBecome].
- 	^self
- !

Item was removed:
- ----- Method: MethodDictionary>>at:putNoBecome: (in category 'accessing') -----
- at: key putNoBecome: value
- 
- 	"Set the value at key to be value. Answer the resulting MethodDictionary"
- 	| index |
- 	index := self scanFor: key.
- 	(self basicAt: index) == nil
- 		ifTrue: 
- 			[tally := tally + 1.
- 			self basicAt: index put: key]
- 		ifFalse:
- 			[(array at: index) flushCache].
- 	array at: index put: value.
- 	^self fullCheckNoBecome!

Item was removed:
- ----- Method: MethodDictionary>>growNoBecome (in category 'private') -----
- growNoBecome
-  
- 	| newSelf key |
- 
- 	newSelf := self species new: self basicSize.  "This will double the size"
- 	1 to: self basicSize do:
- 		[:i | key := self basicAt: i.
- 		key == nil ifFalse: [newSelf at: key put: (array at: i)]].
- 	^newSelf!




More information about the Squeak-dev mailing list