[squeak-dev] The Trunk: Collections-fbs.528.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Aug 6 21:14:53 UTC 2013


Frank Shearar uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-fbs.528.mcz

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

Name: Collections-fbs.528
Author: fbs
Time: 6 August 2013, 10:14:16.491 pm
UUID: b987940e-565a-9941-b026-85a6ba5b5d43
Ancestors: Collections-nice.527

Consolidate all finalization stuff in System-Finalization.

=============== Diff against Collections-nice.527 ===============

Item was changed:
  SystemOrganization addCategory: #'Collections-Abstract'!
  SystemOrganization addCategory: #'Collections-Arrayed'!
+ SystemOrganization addCategory: #'Collections-Exceptions'!
  SystemOrganization addCategory: #'Collections-Sequenceable'!
  SystemOrganization addCategory: #'Collections-Stack'!
  SystemOrganization addCategory: #'Collections-Streams'!
  SystemOrganization addCategory: #'Collections-Strings'!
  SystemOrganization addCategory: #'Collections-Support'!
  SystemOrganization addCategory: #'Collections-Text'!
  SystemOrganization addCategory: #'Collections-Unordered'!
  SystemOrganization addCategory: #'Collections-Weak'!
- SystemOrganization addCategory: #'Collections-Exceptions'!

Item was removed:
- ----- Method: WeakArray class>>finalizationProcess (in category 'private') -----
- finalizationProcess
- 
- 	| initialized |
- 	initialized := false.
- 	[FinalizationSemaphore wait.
- 	initialized ifFalse: ["check VM capability once at image startup time"
- 		WeakFinalizationList initTestPair.
- 		Smalltalk garbageCollect.
- 		WeakFinalizationList checkTestPair.
- 		initialized := true].
- 	FinalizationLock critical:
- 		[FinalizationDependents do:
- 			[ :weakDependent |
- 			weakDependent ifNotNil:
- 				[weakDependent finalizeValues]]]
- 		ifError:
- 		[:msg :rcvr | rcvr error: msg]] repeat!

Item was removed:
- Object subclass: #WeakFinalizationList
- 	instanceVariableNames: 'first'
- 	classVariableNames: 'HasNewFinalization TestItem TestList'
- 	poolDictionaries: ''
- 	category: 'Collections-Weak'!
- 
- !WeakFinalizationList commentStamp: 'Igor.Stasenko 9/22/2010 21:09' prior: 0!
- IMPORTANT!!!!!!
- 
- This class is a special object, recognized by VM.
- Its only purpose is to 
- a) identify a special kind of objects who usually having a weak references but
-   also having an instance of me held by first non-weak fixed slot (instance variable).
- 
- b) a 'first' instance variable points to the head of a list of items, reported by VM which has weak references which became garbage during last garbage collection
- 
- At my class side, there are some public behavior, which is used by finalization process to detect if VM supports new finalization scheme or should use the old one.
- Weak registry using #hasNewFinalization for switching to correct finalization logic,
- depending on VM it currently runs on.
- !

Item was removed:
- ----- Method: WeakFinalizationList class>>checkTestPair (in category 'vm capability test') -----
- checkTestPair
- 	HasNewFinalization := TestList swapWithNil notNil.!

Item was removed:
- ----- Method: WeakFinalizationList class>>hasNewFinalization (in category 'vm capability test') -----
- hasNewFinalization
- 	^ HasNewFinalization == true!

Item was removed:
- ----- Method: WeakFinalizationList class>>initTestPair (in category 'vm capability test') -----
- initTestPair
- 	TestItem := WeakFinalizerItem new list: TestList object: Object new.
- !

Item was removed:
- ----- Method: WeakFinalizationList class>>initialize (in category 'class initialization') -----
- initialize
- 	TestList := self new.!

Item was removed:
- ----- Method: WeakFinalizationList>>first (in category 'accessing') -----
- first
- 	^ first!

Item was removed:
- ----- Method: WeakFinalizationList>>swapWithNil (in category 'accessing') -----
- swapWithNil
- 
- 	| head |
- 	head := first.
- 	first := nil.
- 	^ head!

Item was removed:
- Object weakSubclass: #WeakFinalizerItem
- 	instanceVariableNames: 'list next executor'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Collections-Weak'!
- 
- !WeakFinalizerItem commentStamp: 'Igor.Stasenko 9/22/2010 20:59' prior: 0!
- My instances is used by weak registry to hold a single weak reference
- and executor(s).
- 
- Once object, referenced weakly by my instance become garbage, a weak registry triggers its execution
- by sending #finalizeValues to my instance.
- 
- Note, that a new VM finalization scheme does not implies to use this particular class
- in order to implement finalization scheme. VM refers only to WeakFinalizationList class. 
- 
- In this way, my class and its implementation can serve as an example for implementing various finalization actions, which may differ from this one, provided by default for use by weak registry.
- 
- Once initialized, my instance should:
-  - point to particular list (an instance of WeakFinalizationList),
-  - next should be nil
-  - executor or multiple executors initialized
-  - weak reference slot should point to some object of interest
- 
- At the moment, when object, referenced weakly, become garbage, VM checks if its fist instance variable is an instance of WeakFinalizationList.
- If it so, then it adds a given object to this list, and also links the tail of list through 'next' instance variable. 
- 
- So, as a result of garbage collection, a list will contain all objects, which had weak references to garbage collected objects. 
- It is a responsibility of application to manage the instances of WeakFinalizationList's , as well as clear this list before the next garbage collection.
- As a consequence of that you can:
-  - use multiple different lists and manage them differently in order to react differently when some objects became garbage
-  - you are not obliged to handle/clear the list(s) immediately after GC. You can clean up them periodically.
-  - you can implement own kind of weak referencing object(s), which could use same finalization, provided by newer VMs.
- 
- VM requires only that an object with weak reference having at least two instance variables,
- and its first instance variable points to instance of WeakFinalizationList. Everything else is optional.
- !

Item was removed:
- ----- Method: WeakFinalizerItem class>>new (in category 'as yet unclassified') -----
- new
- 	^ self basicNew: 1!

Item was removed:
- ----- Method: WeakFinalizerItem>>add: (in category 'accessing') -----
- add: newExecutor
- 
- 	executor 
- 		ifNil: [ executor := newExecutor ]
- 		ifNotNil: [
- 			executor hasMultipleExecutors
- 				ifTrue: [ executor add: newExecutor]
- 				ifFalse: [ executor := ObjectFinalizerCollection with: executor with: newExecutor ]
- 		]!

Item was removed:
- ----- Method: WeakFinalizerItem>>clear (in category 'accessing') -----
- clear
- 	list := next := nil.!

Item was removed:
- ----- Method: WeakFinalizerItem>>copyWithList: (in category 'copying') -----
- copyWithList: aList
- 
- 	^ self copy list: aList!

Item was removed:
- ----- Method: WeakFinalizerItem>>executor (in category 'accessing') -----
- executor
- 	^ executor!

Item was removed:
- ----- Method: WeakFinalizerItem>>finalizeValues (in category 'finalizing') -----
- finalizeValues
- 	" cleanup the receiver, so it could be reused "
- 	| ex |
- 	ex := executor.
- 	executor := nil.
- 	next := nil.
- 	ex finalize.!

Item was removed:
- ----- Method: WeakFinalizerItem>>list (in category 'accessing') -----
- list
- 	^ list!

Item was removed:
- ----- Method: WeakFinalizerItem>>list: (in category 'accessing') -----
- list: aList
- 	list := aList!

Item was removed:
- ----- Method: WeakFinalizerItem>>list:object: (in category 'initialize-release') -----
- list: weakFinalizationList object: anObject
- 	self assert: (weakFinalizationList class == WeakFinalizationList).
- 	list := weakFinalizationList.
- 	self at: 1 put: anObject.
- !

Item was removed:
- ----- Method: WeakFinalizerItem>>list:object:executor: (in category 'initialize-release') -----
- list: weakFinalizationList object: anObject executor: anExecutor
- 	self assert: (weakFinalizationList class == WeakFinalizationList).
- 	list := weakFinalizationList.
- 	self at: 1 put: anObject.
- 	executor := anExecutor!

Item was removed:
- ----- Method: WeakFinalizerItem>>next (in category 'accessing') -----
- next
- 	^ next!

Item was removed:
- ----- Method: WeakFinalizerItem>>object (in category 'accessing') -----
- object
- 	^ self at: 1!

Item was removed:
- ----- Method: WeakFinalizerItem>>postCopy (in category 'copying') -----
- postCopy
- 	executor hasMultipleExecutors ifTrue: [ executor := executor copy ].!

Item was removed:
- Collection subclass: #WeakRegistry
- 	instanceVariableNames: 'list valueDictionary sema executors'
- 	classVariableNames: 'Default'
- 	poolDictionaries: ''
- 	category: 'Collections-Weak'!
- 
- !WeakRegistry commentStamp: 'ul 9/26/2010 02:51' prior: 0!
- I am a registry for objects needing finalization. When an object is added the object as well as its executor is stored. When the object is garbage collected, the executor can take the appropriate action for any resources associated with the object.
- 
- This kind of WeakRegistry is using a new VM feature, which allows a more robust finalization support. In contrast to the old implementation, it doesn't spend linear time checking which elements became garbage.
- 
- See also:
- 	Object executor
- 	Object actAsExecutor
- 	Object finalize!

Item was removed:
- ----- Method: WeakRegistry class>>default (in category 'accessing') -----
- default
- 	^Default ifNil:[Default := self new]!

Item was removed:
- ----- Method: WeakRegistry class>>new (in category 'instance creation') -----
- new
- 	| registry |
- 	registry := super new.
- 	WeakArray addWeakDependent: registry.
- 	^registry
- !

Item was removed:
- ----- Method: WeakRegistry class>>new: (in category 'instance creation') -----
- new: n
- 	^ self new!

Item was removed:
- ----- Method: WeakRegistry>>add: (in category 'adding') -----
- add: anObject
- 	"Add anObject to the receiver. Store the object as well as the associated executor."
- 	
- 	^self add: anObject executor: anObject executor!

Item was removed:
- ----- Method: WeakRegistry>>add:executor: (in category 'adding') -----
- add: anObject executor: anExecutor
- 
- 	self protected: [ | finItem |
- 		finItem := valueDictionary at: anObject ifAbsentPut: [
- 			WeakFinalizerItem new list: list object: anObject ].
- 		finItem add: anExecutor ].
- 	^ anObject
- !

Item was removed:
- ----- Method: WeakRegistry>>do: (in category 'enumerating') -----
- do: aBlock
- 	^self protected: [
- 		valueDictionary keysDo: aBlock.
- 	].
- !

Item was removed:
- ----- Method: WeakRegistry>>finalizeValues (in category 'finalization') -----
- 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.
- 			finalizer := executors.
- 			executors := nil ].
- 		finalizer ifNotNil: [
- 			finalizer do: [ :each | each finalizeValues ] ].
- 		^ self ].
- 
- 	finalizer :=  self protected: [ 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 ].
- !

Item was removed:
- ----- Method: WeakRegistry>>initialize (in category 'initialize-release') -----
- initialize
- 	valueDictionary := WeakIdentityKeyDictionary new.
- 	list := WeakFinalizationList new.
- 	sema := Semaphore forMutualExclusion.
- 	self installFinalizer.!

Item was removed:
- ----- Method: WeakRegistry>>installFinalizer (in category 'initialize-release') -----
- installFinalizer
- 
- 	valueDictionary finalizer: [ :executor |
- 		WeakFinalizationList hasNewFinalization 
- 			ifTrue: [ executor finalizeValues ]
- 			ifFalse: [ 
- 				(executors ifNil: [ executors := OrderedCollection new ]) add: executor ] ]!

Item was removed:
- ----- Method: WeakRegistry>>keys (in category 'accessing') -----
- keys
- 
- 	^self protected: [ valueDictionary keys ]
- !

Item was removed:
- ----- Method: WeakRegistry>>postCopy (in category 'copying') -----
- 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)
- 		].
- 	]!

Item was removed:
- ----- Method: WeakRegistry>>printElementsOn: (in category 'printing') -----
- printElementsOn: aStream
- 	sema ifNil: [^super printElementsOn: aStream].
- 	aStream nextPutAll: '(<this WeakRegistry is locked>)'!

Item was removed:
- ----- Method: WeakRegistry>>protected: (in category 'private') -----
- protected: aBlock
- 	"Execute aBlock protected by the accessLock"
- 
- 	^ sema
- 		critical: aBlock
- 		ifError: [ :msg :rcvr |
- 		rcvr error: msg ] !

Item was removed:
- ----- Method: WeakRegistry>>remove:ifAbsent: (in category 'printing') -----
- 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 ]!

Item was removed:
- ----- Method: WeakRegistry>>removeAll (in category 'printing') -----
- removeAll
- 	"See super"
- 	
- 	self protected:[
- 		valueDictionary removeAll.
- 	].!

Item was removed:
- ----- Method: WeakRegistry>>size (in category 'accessing') -----
- size
- 	^ self protected: [valueDictionary slowSize]!

Item was removed:
- ----- Method: WeakRegistry>>species (in category 'private') -----
- species
- 	^Set!



More information about the Squeak-dev mailing list