'From Squeak4.2alpha of 19 August 2010 [latest update: #10382] on 23 September 2010 at 1:03:35 am'!
Collection subclass: #WeakFinalizationRegistry
	instanceVariableNames: 'list valueDictionary sema'
	classVariableNames: 'Default'
	poolDictionaries: ''
	category: 'Collections-Weak'!
!WeakFinalizationRegistry commentStamp: 'Igor.Stasenko 3/8/2010 23:04' prior: 0!
This kind of WeakRegistry using a new VM feature,
which allows a more robust finalization support.

In contrast to old implementation, it doesn't spending linear time , checking what elements became garbage.!


!WeakFinalizationRegistry methodsFor: 'printing' stamp: 'Igor.Stasenko 5/25/2010 05:13'!
printElementsOn: aStream
	sema ifNil: [^super printElementsOn: aStream].
	aStream nextPutAll: '(<this WeakRegistry is locked>)'! !

!WeakFinalizationRegistry methodsFor: 'printing' stamp: 'Igor.Stasenko 5/25/2010 05:21'!
remove: oldObject ifAbsent: exceptionBlock
	"Remove oldObject as one of the receiver's elements."
	
	oldObject ifNil: [ ^nil ].
	^(self protected: [ valueDictionary removeKey: oldObject ifAbsent: nil ])
		ifNil: [ exceptionBlock value ]! !

!WeakFinalizationRegistry methodsFor: 'printing' stamp: 'Igor.Stasenko 5/25/2010 05:16'!
removeAll
	"See super"
	
	self protected:[
		valueDictionary removeAll.
	].! !


!WeakFinalizationRegistry methodsFor: 'enumerating' stamp: 'Igor.Stasenko 5/25/2010 05:11'!
do: aBlock
	^self protected: [
		valueDictionary keysDo: aBlock.
	].
! !


!WeakFinalizationRegistry methodsFor: 'adding' stamp: 'Igor.Stasenko 3/8/2010 21:03'!
add: anObject
	"Add anObject to the receiver. Store the object as well as the associated executor."
	
	^self add: anObject executor: anObject executor! !

!WeakFinalizationRegistry methodsFor: 'adding' stamp: 'Igor.Stasenko 5/25/2010 05:30'!
add: anObject executor: anExecutor

	self protected: [ | finItem |
		finItem := valueDictionary at: anObject ifAbsentPut: [
			WeakFinalizerItem new list: list object: anObject ].
		finItem add: anExecutor ].
	^ anObject
! !


!WeakFinalizationRegistry methodsFor: 'copying' stamp: 'Igor.Stasenko 5/28/2010 05:16'!
postCopy
	"should we prohibit any attempts to copy receiver?"
	self protected: [ | oldDict |
		sema := Semaphore forMutualExclusion.
		oldDict := valueDictionary.
		list := WeakFinalizationList new.
		valueDictionary := WeakIdentityKeyDictionary new.
		self installFinalizer.
	
		oldDict keysAndValuesDo: [:key :value |
			valueDictionary at: key put: (value copyWithList: list)
		].
	]! !


!WeakFinalizationRegistry methodsFor: 'finalization' stamp: 'Igor.Stasenko 9/22/2010 21:21'!
finalizeValues
	"Finalize any values, which happen to stocked in our list, due to some weak references become garbage"
	
	| finalizer |

	WeakFinalizationList hasNewFinalization ifFalse: [
		self protected: [ valueDictionary finalizeValues ].
		^ self ].

	self protected: [ finalizer := list swapWithNil ].

	"We don't need to protect a following loop from concurrent access,
	because at the moment we're finalizing values, 
	only we can access this list of finalizers, because valueDictionary already see them
	as an unused slots, because they're associated with key == nil"
	
	[ finalizer notNil ] whileTrue: [
		| next |
		next := finalizer next.
		finalizer finalizeValues.
		finalizer := next
	].
! !


!WeakFinalizationRegistry methodsFor: 'initialize-release' stamp: 'Igor.Stasenko 5/28/2010 05:12'!
initialize
	valueDictionary := WeakIdentityKeyDictionary new.
	list := WeakFinalizationList new.
	sema := Semaphore forMutualExclusion.
	self installFinalizer.! !

!WeakFinalizationRegistry methodsFor: 'initialize-release' stamp: 'Igor.Stasenko 5/28/2010 05:11'!
installFinalizer

	valueDictionary finalizer: #finalizeValues! !


!WeakFinalizationRegistry methodsFor: 'accessing' stamp: 'Igor.Stasenko 3/8/2010 22:49'!
keys

	^ valueDictionary keys! !

!WeakFinalizationRegistry methodsFor: 'accessing' stamp: 'Igor.Stasenko 5/25/2010 05:48'!
size
	^ self protected: [valueDictionary slowSize]! !


!WeakFinalizationRegistry methodsFor: 'private' stamp: 'Igor.Stasenko 5/25/2010 05:34'!
protected: aBlock
	"Execute aBlock protected by the accessLock"

	^ sema
		critical: aBlock
		ifError: [ :msg :rcvr |
		rcvr error: msg ] ! !

!WeakFinalizationRegistry methodsFor: 'private' stamp: 'Igor.Stasenko 5/25/2010 05:35'!
species
	^Set! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

WeakFinalizationRegistry class
	instanceVariableNames: ''!

!WeakFinalizationRegistry class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 3/8/2010 21:47'!
new
	| registry |
	registry := super new.
	WeakArray addWeakDependent: registry.
	^registry
! !

!WeakFinalizationRegistry class methodsFor: 'instance creation' stamp: 'Igor.Stasenko 5/25/2010 05:31'!
new: n
	^ self new! !


!WeakFinalizationRegistry class methodsFor: 'migrating registry' stamp: 'Igor.Stasenko 9/23/2010 00:59'!
migrateOldRegistries
	Smalltalk at: #WeakFinalizationRegistry ifAbsent: [ ^ self "already done" ].
	
	Smalltalk recreateSpecialObjectsArray.
	WeakArray restartFinalizationProcess.
	
	Smalltalk garbageCollect; garbageCollect.
	
	"leave no chance to interrupt migration"	
	Compiler evaluate: '
	[ | old new oldClass newClass |
		old := OrderedCollection new.
		new := OrderedCollection new.
		WeakRegistry allInstancesDo: [:registry | | newr |
			old add: registry.
			newr := WeakFinalizationRegistry basicNew initialize.
			registry migrateTo: newr.
			new add: newr ].
		old asArray elementsForwardIdentityTo: new asArray.
		
		oldClass := WeakRegistry.
		newClass := WeakFinalizationRegistry.
		
		Smalltalk forgetClass: #WeakFinalizationRegistry logged: false.
		newClass superclass removeSubclass: newClass.
		newClass setName: #WeakRegistry.
		oldClass becomeForward: newClass.
	] forkAt: Processor highestPriority.
	'.
! !


!WeakFinalizationRegistry class methodsFor: 'accessing' stamp: 'Igor.Stasenko 9/22/2010 21:22'!
default
	^Default ifNil:[Default := self new]! !