[squeak-dev] The Trunk: Collections-nice.723.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Dec 14 18:55:41 UTC 2016


Nicolas Cellier uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-nice.723.mcz

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

Name: Collections-nice.723
Author: nice
Time: 27 October 2016, 8:04:09.437881 pm
UUID: 0c01b091-06e9-694d-9415-56c62c06babc
Ancestors: Collections-nice.722

Provide a WeakIdentityDictionary - a good candidate for being used as environments undeclared pool.

=============== Diff against Collections-nice.722 ===============

Item was changed:
  ----- Method: IdentityDictionary>>keyAtValue:ifAbsent: (in category 'accessing') -----
  keyAtValue: value ifAbsent: exceptionBlock
  	"Answer the key that is the external name for the argument, value. If 
  	there is none, answer the result of evaluating exceptionBlock."
   
+ 	^self keyAtIdentityValue: value ifAbsent: exceptionBlock!
- 	^super keyAtIdentityValue: value ifAbsent: exceptionBlock!

Item was added:
+ IdentityDictionary subclass: #WeakIdentityDictionary
+ 	instanceVariableNames: 'vacuum'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Collections-Weak'!
+ 
+ !WeakIdentityDictionary commentStamp: 'nice 10/27/2016 20:00' prior: 0!
+ I am a WeakIdentityDictionary, that is a dictionary pointing weakly to its associations of key->value pairs.
+ I am especially usefull for handling undeclared bindings that will be naturally garbage collected without having to scan all the CompiledMethods.
+ 
+ Instance variables:
+     vacuum    <Object> a unique object used for marking empty slots
+ 
+ Due to usage of WeakArray for my own storage, reclaimed slots will be nilled out.
+ I cannot consider a nil slot as empty because of garbage collection does not fix collisions.
+ Thus I need to differentiate empty slots (vacuum) from garbaged collected slots (nil).
+ 
+ If I did not reclaim the nil slots and make them vacuum again, then my capacity would grow indefinitely.
+ My strategy to avoid such growth is to randomly cleanup the garbage collected slot encountered when scanning for a key.
+ It should mitigate the growth since this method is used when adding a new entry.
+ 
+ Due to those not yet cleaned-up nil slots I might over-estimate my size. Don't take it too literally.!

Item was added:
+ ----- Method: WeakIdentityDictionary class>>arrayType (in category 'private') -----
+ arrayType
+ 	^ WeakArray!

Item was added:
+ ----- Method: WeakIdentityDictionary>>add: (in category 'accessing') -----
+ add: anAssociation
+ 
+ 	| index |
+ 	index := self scanFor: anAssociation key.
+ 	(array at: index)
+ 		ifNil: [ self atNewIndex: index put: anAssociation ]
+ 		ifNotNil: [ :element |
+ 				element == vacuum
+ 					ifTrue: [ self atNewIndex: index put: anAssociation ]
+ 					ifFalse: [ element value: anAssociation value ] ].
+ 	^anAssociation!

Item was added:
+ ----- Method: WeakIdentityDictionary>>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."
+ 
+ 	^((array at: (self scanFor: key))
+ 		ifNil: [ aBlock value ]
+ 		ifNotNil: [:association |
+ 			association == vacuum
+ 				ifTrue: [ aBlock value ]
+ 				ifFalse: [ association ] ])!

Item was added:
+ ----- Method: WeakIdentityDictionary>>associationsDo: (in category 'enumerating') -----
+ associationsDo: aBlock 
+ 	"Evaluate aBlock for each of the receiver's elements (key/value 
+ 	associations)."
+ 
+ 	tally = 0 ifTrue: [ ^self].
+ 	1 to: array size do: [ :index |
+ 		(array at: index) ifNotNil: [ :element |
+ 			element == vacuum ifFalse: [ aBlock value: element ] ] ]!

Item was added:
+ ----- Method: WeakIdentityDictionary>>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."
+ 
+ 	^((array at: (self scanFor: key))
+ 		ifNil: [ aBlock ]
+ 		ifNotNil: [:association |
+ 			association == vacuum
+ 				ifTrue: [ aBlock ]
+ 				ifFalse: [ association ] ]) value "Blocks and Associations expect #value"!

Item was added:
+ ----- Method: WeakIdentityDictionary>>at:ifPresent:ifAbsentPut: (in category 'accessing') -----
+ at: key ifPresent: oneArgBlock ifAbsentPut: absentBlock
+ 	"Lookup the given key in the receiver. If it is present, answer the value of
+ 	 evaluating oneArgBlock with the value associated with the key. Otherwise
+ 	 add the value of absentBlock under the key, and answer that value."
+ 
+ 	| index value |
+ 	index := self scanFor: key.
+ 	(array at: index) ifNotNil:
+ 		[:element|
+ 		 element == vacuum ifFalse: [^oneArgBlock value: element value] ].
+ 	value := absentBlock value.
+ 	self atNewIndex: index put: (self associationClass key: key value: value).
+ 	^value!

Item was added:
+ ----- Method: WeakIdentityDictionary>>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 |
+ 	index := self scanFor: key.
+ 	(array at: index)
+ 		ifNil:
+ 			["it's possible to get here if the association just died"
+ 			self atNewIndex: index put: (self associationClass key: key value: anObject) ]
+ 		ifNotNil: [ :association | 
+ 			association == vacuum
+ 				ifTrue: [ self atNewIndex: index put: (self associationClass key: key value: anObject) ]
+ 				ifFalse: [association value: anObject ] ].
+ 	^anObject!

Item was added:
+ ----- Method: WeakIdentityDictionary>>cleanupIndex: (in category 'private') -----
+ cleanupIndex: anInteger
+ 	array at: anInteger put: vacuum.
+ 	tally := tally - 1.
+ 	self fixCollisionsFrom: anInteger.!

Item was added:
+ ----- Method: WeakIdentityDictionary>>fixCollisionsFrom: (in category 'private') -----
+ fixCollisionsFrom: start
+ 	"The element at start has been removed and replaced by vacuum.
+ 	This method moves forward from there, relocating any entries
+ 	that had been placed below due to collisions with this one."
+ 
+ 	| element index |
+ 	index := start.
+ 	[ (element := array at: (index := index \\ array size + 1)) == vacuum ] whileFalse: [
+ 		element
+ 			ifNil:
+ 				[ "The binding at this slot was reclaimed - finish the cleanup"
+ 				array at: index put: vacuum.
+ 				tally := tally - 1 ]
+ 			ifNotNil:
+ 				[| newIndex |
+ 				(newIndex := self scanWithoutGarbagingFor: element key) = index ifFalse: [
+ 					array 
+ 						at: newIndex put: element;
+ 						at: index put: vacuum ] ] ]!

Item was added:
+ ----- Method: WeakIdentityDictionary>>growTo: (in category 'private') -----
+ growTo: anInteger
+ 	"Grow the elements array and reinsert the old elements"
+ 	
+ 	| oldElements |
+ 	oldElements := array.
+ 	array := self class arrayType new: anInteger withAll: vacuum.
+ 	self noCheckNoGrowFillFrom: oldElements!

Item was added:
+ ----- Method: WeakIdentityDictionary>>includesKey: (in category 'testing') -----
+ includesKey: key 
+ 	"Answer whether the receiver has a key equal to the argument, key."
+ 	
+ 	^(array at: (self scanFor: key))
+ 		ifNil:
+ 			["it just has been reclaimed"
+ 			false]
+ 		ifNotNil: [:element | element ~~ vacuum]!

Item was added:
+ ----- Method: WeakIdentityDictionary>>initialize: (in category 'private') -----
+ initialize: n
+ 	vacuum := Object new.
+ 	array := self class arrayType new: n withAll: vacuum.
+ 	tally := 0!

Item was added:
+ ----- Method: WeakIdentityDictionary>>noCheckNoGrowFillFrom: (in category 'private') -----
+ noCheckNoGrowFillFrom: anArray
+ 	"Add the elements of anArray except nils to me assuming that I don't contain any of them, they are unique and I have more free space than they require."
+ 
+ 	1 to: anArray size do: [ :index |
+ 		(anArray at: index) ifNotNil: [ :association |
+ 			association == vacuum
+ 				ifFalse: [array
+ 					at: (self scanForEmptySlotFor: association key)
+ 					put: association ] ] ]!

Item was added:
+ ----- Method: WeakIdentityDictionary>>postCopy (in category 'copying') -----
+ postCopy
+ 	"Beware: do share the bindings, so changing a binding value in the copy will also change it in the original.
+ 	Copying the bindings would not make sense: we hold weakly on them, so they would die at first garbage collection."
+ 
+ 	| oldVacuum |
+ 	super postCopy.
+ 	oldVacuum := vacuum.
+ 	vacuum := Object new.
+ 	array := array collect: [ :association |
+ 		association ifNotNil: [
+ 			association == oldVacuum
+ 				ifTrue: [ vacuum ]
+ 				ifFalse: [ association ] ] ]!

Item was added:
+ ----- Method: WeakIdentityDictionary>>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)) == vacuum ifTrue: [ ^aBlock value ].
+ 	self cleanupIndex: index.
+ 	^association value!

Item was added:
+ ----- Method: WeakIdentityDictionary>>scanFor: (in category 'private') -----
+ scanFor: anObject
+ 	"Scan the array for the first slot containing either
+ 	- a vacuum object indicating an empty slot
+ 	- or a binding whose key matches anObject.
+ 	Answer the index of that slot or raise an error if no slot is found.
+ 	When garbage collected slots are encountered, perform a clean-up."
+ 
+ 	| index start rescan |	
+ 	[
+ 		rescan := false.
+ 		index := start := anObject scaledIdentityHash \\ array size + 1.
+ 		[ 
+ 			(array at: index) 
+ 				ifNil:
+ 					["Object at this slot has been garbage collected.
+ 					A rescan is necessary because fixing collisions
+ 					might have moved the target before current index."
+ 					self cleanupIndex: index.
+ 					rescan := true]
+ 				ifNotNil:
+ 					[:element | (element == vacuum or: [ element key == anObject ])
+ 						ifTrue: [ ^index ].
+ 					(index := index \\ array size + 1) = start ] ] whileFalse.
+ 		rescan ] whileTrue.
+ 	self errorNoFreeSpace!

Item was added:
+ ----- Method: WeakIdentityDictionary>>scanForEmptySlotFor: (in category 'private') -----
+ scanForEmptySlotFor: anObject
+ 	"Scan the array for the first empty slot marked by vacuum object.
+ 	Answer the index of that slot or raise an error if no slot is found.
+ 	Ignore the slots that have been garbage collected (those containing nil)."
+ 
+ 	| index start |	
+ 	index := start := anObject scaledIdentityHash \\ array size + 1.
+ 	[ 
+ 		(array at: index) 
+ 			ifNotNil:
+ 				[:element | element == vacuum ifTrue: [ ^index ] ].
+ 		(index := index \\ array size + 1) = start ] whileFalse.
+ 	self errorNoFreeSpace!

Item was added:
+ ----- Method: WeakIdentityDictionary>>scanWithoutGarbagingFor: (in category 'private') -----
+ scanWithoutGarbagingFor: anObject
+ 	"Scan the array for the first slot containing either
+ 	- a vacuum object indicating an empty slot
+ 	- or a binding whose key matches anObject.
+ 	Answer the index of that slot or raise an error if no slot is found.
+ 	Ignore the slots that have been garbage collected (those containing nil)"
+ 
+ 	| index start |	
+ 	index := start := anObject scaledIdentityHash \\ array size + 1.
+ 	[ 
+ 		(array at: index) 
+ 			ifNotNil:
+ 				[:element | (element == vacuum or: [ element key == anObject ])
+ 					ifTrue: [ ^index ] ].
+ 		(index := index \\ array size + 1) = start ] whileFalse.
+ 	self errorNoFreeSpace!

Item was changed:
+ ----- Method: WeakSet class>>arrayType (in category 'private') -----
- ----- Method: WeakSet class>>arrayType (in category 'as yet unclassified') -----
  arrayType
  
  	^WeakArray!



More information about the Squeak-dev mailing list