[squeak-dev] The Trunk: Collections-ar.145.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Sep 30 05:18:16 UTC 2009


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

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

Name: Collections-ar.145
Author: ar
Time: 29 September 2009, 10:17:43 am
UUID: 4a842b3f-6ec2-c44d-b5d9-082535b2b576
Ancestors: Collections-ar.144

Pseudo-merging Collections-ul.144:

- replaced all uses of #findElementOrNil: with #scanFor:
- #scanFor: raises an error if it can't find a slot
- new #scanFor:, #scanForEmptySlotFor: and #fixCollisionsFrom: implementations
- removed unnecessary WeakKeyDictionary >> #scanFor:
- added Set >> #errorNoFreeSpace as a common error message for #scanFor: and #scanForEmptySlotFor:

=============== Diff against Collections-ar.144 ===============

Item was changed:
  ----- Method: WeakSet>>scanFor: (in category 'private') -----
  scanFor: anObject
+ 	"Scan the key array for the first slot containing either a nil or a flag (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
- 	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements"
- 
- 	| element start finish |
  
+ 	| index start |
+ 	index := start := anObject hash \\ array size + 1.
+ 	[ 
+ 		| element |
+ 		((element := array at: index) == flag or: [ element = anObject ])
+ 			ifTrue: [ ^index ].
+ 		(index := index \\ array size + 1) = start ] whileFalse: [ ].
+ 	self errorNoFreeSpace!
- 	finish := array size.
- 	start := (anObject hash \\ finish) + 1.
- 	
- 	"Search from (hash mod size) to the end."
- 	start to: finish do:
- 		[:index | ((element := array at: index) == flag or: [element = anObject])
- 			ifTrue: [^ index ]].
- 
- 	"Search from 1 to where we started."
- 	1 to: start-1 do:
- 		[:index | ((element := array at: index) == flag or: [element = anObject])
- 			ifTrue: [^ index ]].
- 
- 	^ 0  "No match AND no empty slot"!

Item was changed:
  ----- Method: Set>>scanFor: (in category 'private') -----
  scanFor: anObject
+ 	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
- 	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
- 
- 	| element start |
- 	start := (anObject hash \\ array size) + 1.
- 	
- 	"Search from (hash mod size) to the end."
- 	start to: array size do: [ :index |
- 		((element := array at: index) == nil or: [ element = anObject ])
- 			ifTrue: [ ^index ] ].
  
+ 	| index start |
+ 	index := start := anObject hash \\ array size + 1.
+ 	[ 
+ 		| element |
- 	"Search from 1 to where we started."
- 	1 to: start - 1 do: [ :index |
  		((element := array at: index) == nil or: [ element = anObject ])
+ 			ifTrue: [ ^index ].
+ 		(index := index \\ array size + 1) = start ] whileFalse: [ ].
+ 	self errorNoFreeSpace!
- 			ifTrue: [ ^index ] ].
- 
- 	^0  "No match AND no empty slot"!

Item was changed:
  ----- Method: WeakKeyDictionary>>at:put: (in category 'accessing') -----
  at: key put: anObject 
  	"Set the value at key to be anObject.  If key is not found, create a new
  	entry for key and set is value to anObject. Answer anObject."
  	| index element |
  	key isNil ifTrue:[^anObject].
+ 	index := self scanFor: key.
- 	index := self findElementOrNil: key.
  	element := array at: index.
  	element == nil
  		ifTrue: [self atNewIndex: index put: (WeakKeyAssociation key: key value: anObject)]
  		ifFalse: [element value: anObject].
  	^ anObject!

Item was changed:
  ----- Method: WeakSet>>add: (in category 'public') -----
  add: newObject
  	"Include newObject as one of the receiver's elements, but only if
  	not already present. Answer newObject"
  
  	| index |
  	newObject ifNil: [self error: 'Sets cannot meaningfully contain nil as an element'].
+ 	index := self scanFor: newObject.
- 	index := self findElementOrNil: newObject.
  	((array at: index) == flag or: [(array at: index) isNil])
  		ifTrue: [self atNewIndex: index put: newObject].
  	^newObject!

Item was changed:
  ----- Method: Set>>add: (in category 'adding') -----
  add: newObject
  	"Include newObject as one of the receiver's elements, but only if
  	not already present. Answer newObject."
  
  	| index |
  	newObject ifNil: [self error: 'Sets cannot meaningfully contain nil as an element'].
+ 	index := self scanFor: newObject.
- 	index := self findElementOrNil: newObject.
  	(array at: index) ifNil: [self atNewIndex: index put: newObject].
  	^ newObject!

Item was changed:
  ----- Method: IdentitySet>>scanForEmptySlotFor: (in category 'private') -----
  scanForEmptySlotFor: anObject
  	"Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
  	
+ 	| index start hash |
+ 	array size > 4096
+ 		ifTrue: [ hash := anObject identityHash * (array size // 4096) ]
- 	| finish hash start |
- 	(finish := array size) > 4096
- 		ifTrue: [ hash := anObject identityHash * (finish // 4096) ]
  		ifFalse: [ hash := anObject identityHash ].
+ 	index := start := hash \\ array size + 1.
+ 	[ 
+ 		(array at: index) ifNil: [ ^index ].
+ 		(index := index \\ array size + 1) = start ] whileFalse: [ ].
+ 	self errorNoFreeSpace!
- 	start := hash \\ finish + 1.
- 	"Search from (hash mod size) to the end."
- 	start to: finish do: [ :index |
- 		(array at: index) ifNil: [ ^index ] ].
- 	"Search from 1 to where we started."
- 	1 to: start - 1 do: [ :index |
- 		(array at: index) ifNil: [ ^index ] ].
- 	self error: 'There is no free space in this collection!!'!

Item was changed:
  ----- Method: Dictionary>>scanFor: (in category 'private') -----
  scanFor: anObject
+ 	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
- 	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
- 	| element start finish |
- 	finish := array size.
- 	start := (anObject hash \\ finish) + 1.
- 
- 	"Search from (hash mod size) to the end."
- 	start to: finish do:
- 		[:index | ((element := array at: index) == nil or: [element key = anObject])
- 			ifTrue: [^ index ]].
  
+ 	| index start |
+ 	index := start := anObject hash \\ array size + 1.
+ 	[ 
+ 		| element |
+ 		((element := array at: index) == nil or: [ element key = anObject ])
+ 			ifTrue: [ ^index ].
+ 		(index := index \\ array size + 1) = start ] whileFalse: [ ].
+ 	self errorNoFreeSpace!
- 	"Search from 1 to where we started."
- 	1 to: start-1 do:
- 		[:index | ((element := array at: index) == nil or: [element key = anObject])
- 			ifTrue: [^ index ]].
- 
- 	^ 0  "No match AND no empty slot"!

Item was changed:
  ----- Method: KeyedIdentitySet>>scanForEmptySlotFor: (in category 'private') -----
  scanForEmptySlotFor: anObject
  	"Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
  	
+ 	| index start hash |
+ 	array size > 4096
+ 		ifTrue: [ hash := anObject identityHash * (array size // 4096) ]
- 	| finish hash start |
- 	(finish := array size) > 4096
- 		ifTrue: [ hash := anObject identityHash * (finish // 4096) ]
  		ifFalse: [ hash := anObject identityHash ].
+ 	index := start := hash \\ array size + 1.
+ 	[ 
+ 		(array at: index) ifNil: [ ^index ].
+ 		(index := index \\ array size + 1) = start ] whileFalse: [ ].
+ 	self errorNoFreeSpace!
- 	start := hash \\ finish + 1.
- 	"Search from (hash mod size) to the end."
- 	start to: finish do: [ :index |
- 		(array at: index) ifNil: [ ^index ] ].
- 	"Search from 1 to where we started."
- 	1 to: start - 1 do: [ :index |
- 		(array at: index) ifNil: [ ^index ] ].
- 	self error: 'There is no free space in this collection!!'!

Item was changed:
  ----- Method: IdentityDictionary>>scanFor: (in category 'private') -----
  scanFor: anObject
+ 	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
- 	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
- 	| finish hash start element |
- 	finish := array size.
- 	finish > 4096
- 		ifTrue: [hash := anObject identityHash * (finish // 4096)]
- 		ifFalse: [hash := anObject identityHash].
- 	start := (hash \\ finish) + 1.
- 
- 	"Search from (hash mod size) to the end."
- 	start to: finish do:
- 		[:index | ((element := array at: index) == nil or: [element key == anObject])
- 			ifTrue: [^ index ]].
- 
- 	"Search from 1 to where we started."
- 	1 to: start-1 do:
- 		[:index | ((element := array at: index) == nil or: [element key == anObject])
- 			ifTrue: [^ index ]].
  
+ 	| index start hash |
+ 	array size > 4096
+ 		ifTrue: [ hash := anObject identityHash * (array size // 4096) ]
+ 		ifFalse: [ hash := anObject identityHash ].
+ 	index := start := hash \\ array size + 1.
+ 	[ 
+ 		| element |
+ 		((element := array at: index) == nil or: [ element key == anObject ])
+ 			ifTrue: [ ^index ].
+ 		(index := index \\ array size + 1) = start ] whileFalse: [ ].
+ 	self errorNoFreeSpace!
- 	^ 0  "No match AND no empty slot"!

Item was changed:
  ----- Method: KeyedSet>>noCheckAdd: (in category 'private') -----
  noCheckAdd: anObject
+ 	array at: (self scanFor: (keyBlock value: anObject)) put: anObject.
- 	array at: (self findElementOrNil: (keyBlock value: anObject)) put: anObject.
  	tally := tally + 1!

Item was changed:
  ----- Method: Dictionary>>add: (in category 'adding') -----
  add: anAssociation
  	| index element |
+ 	index := self scanFor: anAssociation key.
- 	index := self findElementOrNil: anAssociation key.
  	element := array at: index.
  	element == nil
  		ifTrue: [self atNewIndex: index put: anAssociation]
  		ifFalse: [element value: anAssociation value].
  	^ anAssociation!

Item was changed:
  ----- Method: WeakIdentityKeyDictionary>>scanFor: (in category 'private') -----
  scanFor: anObject
+ 	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
- 	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
- 	| element start finish hash |
- 	finish := array size.
- 	finish > 4096
- 		ifTrue: [hash := anObject identityHash * (finish // 4096)]
- 		ifFalse: [hash := anObject identityHash].
- 	start := (hash \\ finish) + 1.
- 
- 	"Search from (hash mod size) to the end."
- 	start to: finish do:
- 		[:index | ((element := array at: index) == nil or: [element key == anObject])
- 			ifTrue: [^ index ]].
- 
- 	"Search from 1 to where we started."
- 	1 to: start-1 do:
- 		[:index | ((element := array at: index) == nil or: [element key == anObject])
- 			ifTrue: [^ index ]].
  
+ 	| index start hash |
+ 	array size > 4096
+ 		ifTrue: [ hash := anObject identityHash * (array size // 4096) ]
+ 		ifFalse: [ hash := anObject identityHash ].
+ 	index := start := hash \\ array size + 1.
+ 	[ 
+ 		| element |
+ 		((element := array at: index) == nil or: [ element key == anObject ])
+ 			ifTrue: [ ^index ].
+ 		(index := index \\ array size + 1) = start ] whileFalse: [ ].
+ 	self errorNoFreeSpace!
- 	^ 0  "No match AND no empty slot"!

Item was changed:
  ----- Method: WeakSet>>scanForEmptySlotFor: (in category 'private') -----
  scanForEmptySlotFor: anObject
  	"Scan the key array for the first slot containing an empty slot (indicated by flag or a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
  	
+ 	| index start |
+ 	index := start := anObject hash \\ array size + 1.
+ 	[ 
+ 		| element |
+ 		((element := array at: index) == flag or: [ element == nil ]) ifTrue: [ ^index ].
+ 		(index := index \\ array size + 1) = start ] whileFalse: [ ].
+ 	self errorNoFreeSpace!
- 	| start element |
- 	start := anObject hash \\ array size + 1.
- 	"Search from (hash mod size) to the end."
- 	start to: array size do: [ :index |
- 		((element := array at: index) == flag or: [ element == nil ]) ifTrue: [ ^index ] ].
- 	"Search from 1 to where we started."
- 	1 to: start - 1 do: [ :index |
- 		((element := array at: index) == flag or: [ element == nil ]) ifTrue: [ ^index ] ].
- 	self error: 'There is no free space in this collection!!'!

Item was changed:
  ----- Method: Dictionary>>associationAt:ifAbsent: (in category 'accessing') -----
  associationAt: key ifAbsent: aBlock 
  	"Answer the association with the given key.
  	If key is not found, return the result of evaluating aBlock."
  
  	| index assoc |
+ 	index := self scanFor: key.
- 	index := self findElementOrNil: key.
  	assoc := array at: index.
  	nil == assoc ifTrue: [ ^ aBlock value ].
  	^ assoc!

Item was changed:
  ----- Method: KeyedSet>>includesKey: (in category 'testing') -----
  includesKey: key
  
+ 	^ (array at: (self scanFor: key)) ~~ nil!
- 	^ (array at: (self findElementOrNil: key)) ~~ nil!

Item was changed:
  ----- Method: KeyedSet>>remove:ifAbsent: (in category 'removing') -----
  remove: oldObject ifAbsent: aBlock
  
  	| index |
+ 	index := self scanFor: (keyBlock value: oldObject).
- 	index := self findElementOrNil: (keyBlock value: oldObject).
  	(array at: index) == nil ifTrue: [ ^ aBlock value ].
  	array at: index put: nil.
  	tally := tally - 1.
  	self fixCollisionsFrom: index.
  	^ oldObject!

Item was changed:
  ----- Method: Set>>noCheckAdd: (in category 'private') -----
  noCheckAdd: anObject
+ 	array at: (self scanFor: anObject) put: anObject.
- 	array at: (self findElementOrNil: anObject) put: anObject.
  	tally := tally + 1!

Item was changed:
  ----- Method: KeyedSet>>removeKey:ifAbsent: (in category 'removing') -----
  removeKey: key ifAbsent: aBlock
  
  	| index obj |
+ 	index := self scanFor: key.
- 	index := self findElementOrNil: key.
  	(obj := array at: index) == nil ifTrue: [ ^ aBlock value ].
  	array at: index put: nil.
  	tally := tally - 1.
  	self fixCollisionsFrom: index.
  	^ obj!

Item was changed:
  ----- Method: KeyedSet>>includes: (in category 'testing') -----
  includes: anObject 
+ 	^ (array at: (self scanFor: (keyBlock value: anObject))) ~~ nil!
- 	^ (array at: (self findElementOrNil: (keyBlock value: anObject))) ~~ nil!

Item was changed:
  ----- Method: IdentityDictionary>>scanForEmptySlotFor: (in category 'private') -----
  scanForEmptySlotFor: anObject
  	"Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
  	
+ 	| index start hash |
+ 	array size > 4096
+ 		ifTrue: [ hash := anObject identityHash * (array size // 4096) ]
- 	| finish hash start |
- 	(finish := array size) > 4096
- 		ifTrue: [ hash := anObject identityHash * (finish // 4096) ]
  		ifFalse: [ hash := anObject identityHash ].
+ 	index := start := hash \\ array size + 1.
+ 	[ 
+ 		(array at: index) ifNil: [ ^index ].
+ 		(index := index \\ array size + 1) = start ] whileFalse: [ ].
+ 	self errorNoFreeSpace!
- 	start := hash \\ finish + 1.
- 	"Search from (hash mod size) to the end."
- 	start to: finish do: [ :index |
- 		(array at: index) ifNil: [ ^index ] ].
- 	"Search from 1 to where we started."
- 	1 to: start - 1 do: [ :index |
- 		(array at: index) ifNil: [ ^index ] ].
- 	self error: 'There is no free space in this collection!!'!

Item was changed:
  ----- Method: Dictionary>>noCheckAdd: (in category 'private') -----
  noCheckAdd: anObject
+ 	"Must be defined separately for Dictionary because (self scanFor:) expects a key,
+ 	not an association.  9/7/96 tk"
- 	"Must be defined separately for Dictionary because (self findElementOrNil:) expects a key, not an association.  9/7/96 tk"
  
+ 	array at: (self scanFor: anObject key) put: anObject.
- 	array at: (self findElementOrNil: anObject key) put: anObject.
  	tally := tally + 1!

Item was changed:
  ----- Method: WeakValueDictionary>>at:put: (in category 'accessing') -----
  at: key put: anObject 
  	"Set the value at key to be anObject.  If key is not found, create a new
  	entry for key and set is value to anObject. Answer anObject."
  	| index element |
+ 	index := self scanFor: key.
- 	index := self findElementOrNil: key.
  	element := array at: index.
  	element == nil
  		ifTrue: [self atNewIndex: index put: (WeakValueAssociation key: key value: anObject)]
  		ifFalse: [element value: anObject].
  	^ anObject!

Item was changed:
  ----- Method: KeyedSet>>member: (in category 'adding') -----
  member: newObject
  	"Include newObject as one of the receiver's elements, if already exists just return it"
  
  	| index |
  	newObject ifNil: [self error: 'Sets cannot meaningfully contain nil as an element'].
+ 	index := self scanFor: (keyBlock value: newObject).
- 	index := self findElementOrNil: (keyBlock value: newObject).
  	(array at: index) ifNotNil: [^ array at: index].
  	self atNewIndex: index put: newObject.
  	^ newObject!

Item was added:
+ ----- Method: Set>>errorNoFreeSpace (in category 'private') -----
+ errorNoFreeSpace
+ 
+ 	self error: 'There is no free space in this collection!!'!

Item was changed:
  ----- Method: PluggableDictionary>>scanFor: (in category 'private') -----
  scanFor: anObject 
+ 	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
- 	"Scan the key array for the first slot containing either a nil (indicating an empty slot)
- 	or an element that matches anObject. Answer the index of that slot or zero if no slot
- 	is found. This  method will be overridden in various subclasses that have different
- 	interpretations for matching elements."
  	
+ 	| index start |
+ 	index := start := (hashBlock
+ 		ifNil: [ anObject hash ]
+ 		ifNotNil: [ hashBlock value: anObject ]) \\ array size + 1.
+ 	[ 
+ 		| element |
+ 		((element := array at: index) == nil or: [
+ 			equalBlock
+ 				ifNil: [ element key = anObject ]
+ 				ifNotNil: [ equalBlock value: element key value: anObject ] ])
+ 			ifTrue: [ ^index ].
+ 		(index := index \\ array size + 1) = start ] whileFalse: [ ].
+ 	self errorNoFreeSpace!
- 	| element start |
- 	start := (hashBlock ifNil: [anObject hash]
- 				ifNotNil: [hashBlock value: anObject])
- 				\\ array size + 1.
- 	"Search from (hash mod size) to the end."
- 	start to: array size do: [:index | ((element := array at: index) == nil or:
- [equalBlock ifNil: [element key = anObject]
- 				ifNotNil: [equalBlock value: element key value: anObject]])
- 			ifTrue: [^ index]].
- 	"Search from 1 to where we started."
- 	1 to: start - 1 do: [:index | ((element := array at: index) == nil or:
- [equalBlock ifNil: [element key = anObject]
- 				ifNotNil: [equalBlock value: element key value: anObject]])
- 			ifTrue: [^ index]].
- 	^ 0"No match AND no empty slot"!

Item was changed:
  ----- Method: Set>>scanForEmptySlotFor: (in category 'private') -----
  scanForEmptySlotFor: anObject
  	"Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
  	
+ 	| index start |
+ 	index := start := anObject hash \\ array size + 1.
+ 	[ 
+ 		(array at: index) ifNil: [ ^index ].
+ 		(index := index \\ array size + 1) = start ] whileFalse: [ ].
+ 	self errorNoFreeSpace!
- 	| start |
- 	start := anObject hash \\ array size + 1.
- 	"Search from (hash mod size) to the end."
- 	start to: array size do: [ :index |
- 		(array at: index) ifNil: [ ^index ] ].
- 	"Search from 1 to where we started."
- 	1 to: start - 1 do: [ :index |
- 		(array at: index) ifNil: [ ^index ] ].
- 	self error: 'There is no free space in this collection!!'!

Item was changed:
  ----- Method: Set>>like: (in category 'accessing') -----
  like: anObject
  	"Answer an object in the receiver that is equal to anObject,
  	nil if no such object is found. Relies heavily on hash properties"
  
  	| index |
+ 	index := self scanFor: anObject.
+ 	^array at: index!
- 
- 	^(index := self scanFor: anObject) = 0
- 		ifFalse: [array at: index]!

Item was changed:
  ----- Method: KeyedSet>>at:ifAbsent: (in category 'accessing') -----
  at: key ifAbsent: aBlock 
  	"Answer the value associated with the key or, if key isn't found,
  	answer the result of evaluating aBlock."
  
  	| obj |
+ 	obj := array at: (self scanFor: key).
- 	obj := array at: (self findElementOrNil: key).
  	obj ifNil: [^ aBlock value].
  	^ obj!

Item was changed:
  ----- Method: WeakSet>>do:after: (in category 'public') -----
  do: aBlock after: anElement
  	| each startIndex |
  
  	tally = 0 ifTrue: [^self].
  	startIndex := anElement ifNil: [1] ifNotNil:
+ 		[self scanFor: anElement].
- 		[self findElementOrNil: anElement].
  	startIndex + 1 to: array size do:
  		[:index |
  			((each := array at: index) == nil or: [each == flag])
  				ifFalse: [aBlock value: each]
  		]!

Item was changed:
  ----- Method: PluggableSet>>scanFor: (in category 'private') -----
  scanFor: anObject 
+ 	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
+ 	
+ 	| index start |
+ 	index := start := (hashBlock
- 	"Scan the key array for the first slot containing either a nil (indicating an empty slot)
- 	or an element that matches anObject. Answer the index of that slot or zero if no slot
- 	is found. This  method will be overridden in various subclasses that have different 	interpretations for matching elements."
- 	| element start |
- 	start := (hashBlock 
  		ifNil: [ anObject hash ]
  		ifNotNil: [ hashBlock value: anObject ]) \\ array size + 1.
+ 	[ 
+ 		| element |
+ 		((element := array at: index) == nil or: [
+ 			equalBlock
+ 				ifNil: [ element = anObject ]
+ 				ifNotNil: [ equalBlock value: element value: anObject ] ])
+ 			ifTrue: [ ^index ].
+ 		(index := index \\ array size + 1) = start ] whileFalse: [ ].
+ 	self errorNoFreeSpace!
- 	"Search from (hash mod size) to the end."
- 	start to: array size do: [:index | ((element := array at: index) == nil or:
- [equalBlock ifNil: [element = anObject]
- 				ifNotNil: [equalBlock value: element value: anObject]])
- 			ifTrue: [^ index]].
- 	"Search from 1 to where we started."
- 	1 to: start - 1 do: [:index | ((element := array at: index) == nil or:
- [equalBlock ifNil: [element = anObject]
- 				ifNotNil: [equalBlock value: element value: anObject]])
- 			ifTrue: [^ index]].
- 	^ 0"No match AND no empty slot"!

Item was changed:
  ----- Method: WeakSet>>remove:ifAbsent: (in category 'public') -----
  remove: oldObject ifAbsent: aBlock
  
  	| index |
+ 	index := self scanFor: oldObject.
- 	index := self findElementOrNil: oldObject.
  	(array at: index) == flag ifTrue: [ ^ aBlock value ].
  	array at: index put: flag.
  	tally := tally - 1.
  	self fixCollisionsFrom: index.
  	^oldObject!

Item was changed:
  ----- Method: Set>>remove:ifAbsent: (in category 'removing') -----
  remove: oldObject ifAbsent: aBlock
  
  	| index |
+ 	index := self scanFor: oldObject.
+ 	(array at: index) ifNil: [ ^ aBlock value ].
- 	index := self findElementOrNil: oldObject.
- 	(array at: index) == nil ifTrue: [ ^ aBlock value ].
  	array at: index put: nil.
  	tally := tally - 1.
  	self fixCollisionsFrom: index.
  	^ oldObject!

Item was changed:
  ----- Method: WeakSet>>includes: (in category 'public') -----
  includes: anObject 
+ 	^(array at: (self scanFor: anObject)) ~~ flag!
- 	^(array at: (self findElementOrNil: anObject)) ~~ flag!

Item was changed:
  ----- Method: Set>>includes: (in category 'testing') -----
  includes: anObject 
+ 	^ (array at: (self scanFor: anObject)) ~~ nil!
- 	^ (array at: (self findElementOrNil: anObject)) ~~ nil!

Item was changed:
  ----- Method: WeakIdentityKeyDictionary>>scanForEmptySlotFor: (in category 'private') -----
  scanForEmptySlotFor: anObject
  	"Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
  	
+ 	| index start hash |
+ 	array size > 4096
+ 		ifTrue: [ hash := anObject identityHash * (array size // 4096) ]
- 	| finish hash start |
- 	(finish := array size) > 4096
- 		ifTrue: [ hash := anObject identityHash * (finish // 4096) ]
  		ifFalse: [ hash := anObject identityHash ].
+ 	index := start := hash \\ array size + 1.
+ 	[ 
+ 		(array at: index) ifNil: [ ^index ].
+ 		(index := index \\ array size + 1) = start ] whileFalse: [ ].
+ 	self errorNoFreeSpace!
- 	start := hash \\ finish + 1.
- 	"Search from (hash mod size) to the end."
- 	start to: finish do: [ :index |
- 		(array at: index) ifNil: [ ^index ] ].
- 	"Search from 1 to where we started."
- 	1 to: start - 1 do: [ :index |
- 		(array at: index) ifNil: [ ^index ] ].
- 	self error: 'There is no free space in this collection!!'!

Item was changed:
  ----- Method: PluggableDictionary>>scanForEmptySlotFor: (in category 'private') -----
  scanForEmptySlotFor: anObject
  	"Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
  	
+ 	| index start |
+ 	index := start := (hashBlock
- 	| start |
- 	start := (hashBlock
  		ifNil: [ anObject hash ]
  		ifNotNil: [ hashBlock value: anObject ]) \\ array size + 1.
+ 	[ 
+ 		(array at: index) ifNil: [ ^index ].
+ 		(index := index \\ array size + 1) = start ] whileFalse: [ ].
+ 	self errorNoFreeSpace!
- 	"Search from (hash mod size) to the end."
- 	start to: array size do: [ :index |
- 		(array at: index) ifNil: [ ^index ] ].
- 	"Search from 1 to where we started."
- 	1 to: start - 1 do: [ :index |
- 		(array at: index) ifNil: [ ^index ] ].
- 	self error: 'There is no free space in this collection!!'!

Item was changed:
  ----- Method: WeakSet>>fixCollisionsFrom: (in category 'private') -----
  fixCollisionsFrom: start
+ 
  	"The element at start has been removed and replaced by flag.
  	This method moves forward from there, relocating any entries
+ 	that had been placed below due to collisions with this one."
- 	that had been placed below due to collisions with this one.
- 	We can be sure that there is an empty slot in this collection
- 	so it's safe to use #scanFor: instead of #findElementOrNil:."
  
+ 	| element index |
+ 	index := start.
+ 	[ (element := self keyAt: (index := index \\ array size + 1)) == flag ] whileFalse: [
+ 		| newIndex |
- 	| element newIndex |
- 	start + 1 to: array size do: [ :index |
- 		(element := self keyAt: index) == flag ifTrue: [ ^self ].
- 		(newIndex := self scanFor: element) = index ifFalse: [
- 			self swap: index with: newIndex ] ].
- 	1 to: start do: [ :index |
- 		(element := self keyAt: index) == flag ifTrue: [ ^self ].
  		(newIndex := self scanFor: element) = index ifFalse: [
  			self swap: index with: newIndex ] ]
  !

Item was changed:
  ----- Method: Set>>fixCollisionsFrom: (in category 'private') -----
  fixCollisionsFrom: start
  	"The element at start has been removed and replaced by nil.
  	This method moves forward from there, relocating any entries
+ 	that had been placed below due to collisions with this one."
- 	that had been placed below due to collisions with this one.
- 	We can be sure that there is an empty slot in this collection
- 	so it's safe to use #scanFor: instead of #findElementOrNil:."
  
+ 	| element index |
+ 	index := start.
+ 	[ (element := self keyAt: (index := index \\ array size + 1)) == nil ] whileFalse: [
+ 		| newIndex |
- 	| element newIndex |
- 	start + 1 to: array size do: [ :index |
- 		(element := self keyAt: index) ifNil: [ ^self ].
- 		(newIndex := self scanFor: element) = index ifFalse: [
- 			self swap: index with: newIndex ] ].
- 	1 to: start do: [ :index |
- 		(element := self keyAt: index) ifNil: [ ^self ].
  		(newIndex := self scanFor: element) = index ifFalse: [
  			self swap: index with: newIndex ] ]!

Item was changed:
  ----- Method: IdentitySet>>scanFor: (in category 'private') -----
  scanFor: anObject
+ 	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
- 	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
- 	| finish hash start element |
- 	finish := array size.
- 	finish > 4096
- 		ifTrue: [hash := anObject identityHash * (finish // 4096)]
- 		ifFalse: [hash := anObject identityHash].
- 	start := (hash \\ finish) + 1.
- 
- 	"Search from (hash mod size) to the end."
- 	start to: finish do:
- 		[:index | ((element := array at: index) == nil or: [element == anObject])
- 			ifTrue: [^ index ]].
- 
- 	"Search from 1 to where we started."
- 	1 to: start-1 do:
- 		[:index | ((element := array at: index) == nil or: [element == anObject])
- 			ifTrue: [^ index ]].
  
+ 	| index start hash |
+ 	array size > 4096
+ 		ifTrue: [ hash := anObject identityHash * (array size // 4096) ]
+ 		ifFalse: [ hash := anObject identityHash ].
+ 	index := start := hash \\ array size + 1.
+ 	[ 
+ 		| element |
+ 		((element := array at: index) == nil or: [ element == anObject ])
+ 			ifTrue: [ ^index ].
+ 		(index := index \\ array size + 1) = start ] whileFalse: [ ].
+ 	self errorNoFreeSpace!
- 	^ 0  "No match AND no empty slot"!

Item was changed:
  ----- Method: KeyedIdentitySet>>scanFor: (in category 'private') -----
  scanFor: anObject
+ 	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
- 	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
- 
- 	| element hash start finish |
- 	finish := array size.
- 	finish > 4096
- 		ifTrue: [ hash := anObject identityHash * (finish // 4096) ]
- 		ifFalse: [ hash := anObject identityHash ].
- 	start := hash \\ finish + 1.
- 	
- 	"Search from (hash mod size) to the end."
- 	start to: finish do:
- 		[:index | ((element := array at: index) == nil or: [(keyBlock value: element) == anObject])
- 			ifTrue: [^ index ]].
- 
- 	"Search from 1 to where we started."
- 	1 to: start-1 do:
- 		[:index | ((element := array at: index) == nil or: [(keyBlock value: element) == anObject])
- 			ifTrue: [^ index ]].
  
+ 	| index start hash |
+ 	array size > 4096
+ 		ifTrue: [ hash := anObject identityHash * (array size // 4096) ]
+ 		ifFalse: [ hash := anObject identityHash ].
+ 	index := start := hash \\ array size + 1.
+ 	[ 
+ 		| element |
+ 		((element := array at: index) == nil or: [ (keyBlock value: element) == anObject ])
+ 			ifTrue: [ ^index ].
+ 		(index := index \\ array size + 1) = start ] whileFalse: [ ].
+ 	self errorNoFreeSpace!
- 	^ 0  "No match AND no empty slot"!

Item was changed:
  ----- Method: Dictionary>>removeKey:ifAbsent: (in category 'removing') -----
  removeKey: key ifAbsent: aBlock 
  	"Remove key (and its associated value) from the receiver. If key is not in 
  	the receiver, answer the result of evaluating aBlock. Otherwise, answer 
  	the value externally named by key."
  
+ 	| index association |
+ 	index := self scanFor: key.
+ 	(association := array at: index) ifNil: [ ^ aBlock value ].
- 	| index assoc |
- 	index := self findElementOrNil: key.
- 	assoc := array at: index.
- 	assoc == nil ifTrue: [ ^ aBlock value ].
  	array at: index put: nil.
  	tally := tally - 1.
  	self fixCollisionsFrom: index.
+ 	^association value!
- 	^ assoc value!

Item was changed:
  ----- Method: KeyedSet>>scanFor: (in category 'private') -----
  scanFor: anObject
+ 	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
- 	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
- 	| element start finish |
- 	finish := array size.
- 	start := (anObject hash \\ finish) + 1.
- 
- 	"Search from (hash mod size) to the end."
- 	start to: finish do:
- 		[:index | ((element := array at: index) == nil or: [(keyBlock value: element) = anObject])
- 			ifTrue: [^ index ]].
  
+ 	| index start |
+ 	index := start := anObject hash \\ array size + 1.
+ 	[ 
+ 		| element |
+ 		((element := array at: index) == nil or: [ (keyBlock value: element) = anObject ])
+ 			ifTrue: [ ^index ].
+ 		(index := index \\ array size + 1) = start ] whileFalse: [ ].
+ 	self errorNoFreeSpace!
- 	"Search from 1 to where we started."
- 	1 to: start-1 do:
- 		[:index | ((element := array at: index) == nil or: [(keyBlock value: element) = anObject])
- 			ifTrue: [^ index ]].
- 
- 	^ 0  "No match AND no empty slot"!

Item was changed:
  ----- Method: Dictionary>>at:ifAbsent: (in category 'accessing') -----
  at: key ifAbsent: aBlock 
  	"Answer the value associated with the key or, if key isn't found,
  	answer the result of evaluating aBlock."
  
  	| assoc |
+ 	assoc := array at: (self scanFor: key).
- 	assoc := array at: (self findElementOrNil: key).
  	assoc ifNil: [^ aBlock value].
  	^ assoc value!

Item was changed:
  ----- Method: PluggableSet>>scanForEmptySlotFor: (in category 'private') -----
  scanForEmptySlotFor: anObject
  	"Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
  	
+ 	| index start |
+ 	index := start := (hashBlock
- 	| start |
- 	start := (hashBlock
  		ifNil: [ anObject hash ]
  		ifNotNil: [ hashBlock value: anObject ]) \\ array size + 1.
+ 	[ 
+ 		(array at: index) ifNil: [ ^index ].
+ 		(index := index \\ array size + 1) = start ] whileFalse: [ ].
+ 	self errorNoFreeSpace!
- 	"Search from (hash mod size) to the end."
- 	start to: array size do: [ :index |
- 		(array at: index) ifNil: [ ^index ] ].
- 	"Search from 1 to where we started."
- 	1 to: start - 1 do: [ :index |
- 		(array at: index) ifNil: [ ^index ] ].
- 	self error: 'There is no free space in this collection!!'!

Item was changed:
  ----- Method: Dictionary>>at:put: (in category 'accessing') -----
  at: key put: anObject 
  	"Set the value at key to be anObject.  If key is not found, create a
  	new entry for key and set is value to anObject. Answer anObject."
  
  	| index assoc |
+ 	index := self scanFor: key.
- 	index := self findElementOrNil: key.
  	assoc := array at: index.
  	assoc
  		ifNil: [self atNewIndex: index put: (Association key: key value: anObject)]
  		ifNotNil: [assoc value: anObject].
  	^ anObject!

Item was changed:
  ----- Method: KeyedSet>>add: (in category 'adding') -----
  add: newObject
  	"Include newObject as one of the receiver's elements, but only if
  	not already present. Answer newObject."
  
  	| index |
  	newObject ifNil: [self error: 'Sets cannot meaningfully contain nil as an element'].
+ 	index := self scanFor: (keyBlock value: newObject).
- 	index := self findElementOrNil: (keyBlock value: newObject).
  	(array at: index) ifNil: [self atNewIndex: index put: newObject].
  	^ newObject!

Item was removed:
- ----- Method: WeakKeyDictionary>>scanFor: (in category 'private') -----
- scanFor: anObject
- 	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
- 	| element start finish |
- 	finish := array size.
- 	start := (anObject hash \\ finish) + 1.
- 	
- 	"Search from (hash mod size) to the end."
- 	start to: finish do:
- 		[:index | ((element := array at: index) == nil or: [element key = anObject])
- 			ifTrue: [^ index ]].
- 
- 	"Search from 1 to where we started."
- 	1 to: start-1 do:
- 		[:index | ((element := array at: index) == nil or: [element key = anObject])
- 			ifTrue: [^ index ]].
- 
- 	^ 0  "No match AND no empty slot"!




More information about the Squeak-dev mailing list