[strongtalk] r185 committed - Add Smalltalk finalization support

[codesite...@google.com]

Revision: 185
Author: StephenLRees
Date: Sun Dec 13 16:47:01 2009
Log: Add Smalltalk finalization support
http://code.google.com/p/strongtalk/source/detail?r=185

Added:
/branches/gcc-linux/StrongtalkSource/BlockDependent.dlt
/branches/gcc-linux/StrongtalkSource/FinalizationDependent.dlt
/branches/gcc-linux/StrongtalkSource/FinalizationNotifier.dlt
/branches/gcc-linux/StrongtalkSource/WeakArrayTest.dlt
Modified:
/branches/gcc-linux/StrongtalkSource/AlienWeakTable.dlt
/branches/gcc-linux/StrongtalkSource/Object.dlt
/branches/gcc-linux/StrongtalkSource/Process.dlt
/branches/gcc-linux/StrongtalkSource/VM.dlt
/branches/gcc-linux/StrongtalkSource/WeakArray.dlt
/branches/gcc-linux/vm/runtime/os_nt.cpp

=======================================
--- /dev/null
+++ /branches/gcc-linux/StrongtalkSource/BlockDependent.dlt Sun Dec 13
16:47:01 2009
@@ -0,0 +1,55 @@
+Delta define: #BlockDependent as: (
+(Class subclassOf: 'Object' instanceVariables: 'updateBlock <[X]>')) !
+
+(Delta mirrorFor: #BlockDependent) revision: '$Revision:$'!
+
+(Delta mirrorFor: #BlockDependent) group: 'Unclassified'!
+
+(Delta mirrorFor: #BlockDependent)
+comment:
+''!
+
+! (Delta mirrorFor: #BlockDependent) classSide methodsFor: 'instance
creation' !
+
+
+asTwoArg: block
+
+ | arity |
+ arity := block arity.
+ arity == 2 ifTrue: [^block].
+ arity == 1 ifTrue: [^[:aspect :value | block value: aspect]].
+ arity == 0 ifTrue: [^[:aspect :value | block value]].
+ ^[:aspect :value| |args|
+ args := Array new: arity.
+ args at: 1 put: aspect.
+ args at: 2 put: value.
+ block valueWithArguments: args] !
+
+updateBlock: block <[]>
+
+ ^self new
+ initialize: (self asTwoArg: block);
+ yourself! !
+
+! (Delta mirrorFor: #BlockDependent) methodsFor: 'dependencies' !
+
+
+update: aspect
+
+ updateBlock
+ value: aspect
+ with: nil!
+
+update: aspect with: value
+
+ updateBlock
+ value: aspect
+ value: value! !
+
+! (Delta mirrorFor: #BlockDependent)
methodsFor: 'priviate-initialization' !
+
+
+initialize: block
+
+ updateBlock := block! !
+
=======================================
--- /dev/null
+++ /branches/gcc-linux/StrongtalkSource/FinalizationDependent.dlt Sun Dec
13 16:47:01 2009
@@ -0,0 +1,21 @@
+Delta define: #FinalizationDependent as: (
+(Class subclassOf: 'Object' instanceVariables: '')) !
+
+(Delta mirrorFor: #FinalizationDependent) revision: '$Revision:$'!
+
+(Delta mirrorFor: #FinalizationDependent) group: 'Unclassified'!
+
+(Delta mirrorFor: #FinalizationDependent)
+comment:
+'A dependent that can be registered with a WeakArray
+instance to receive notification about terminal objects.
+'!
+
+! (Delta mirrorFor: #FinalizationDependent) methodsFor: 'dependencies' !
+
+
+update: aspect with: victim
+
+ #finalize == aspect ifFalse: [^self].
+ victim finalize! !
+
=======================================
--- /dev/null
+++ /branches/gcc-linux/StrongtalkSource/FinalizationNotifier.dlt Sun Dec
13 16:47:01 2009
@@ -0,0 +1,18 @@
+Delta define: #FinalizationNotifier as: (
+(Class subclassOf: 'Object' instanceVariables: '')) !
+
+(Delta mirrorFor: #FinalizationNotifier) revision: '$Revision:$'!
+
+(Delta mirrorFor: #FinalizationNotifier) group: 'Unclassified'!
+
+(Delta mirrorFor: #FinalizationNotifier)
+comment:
+''!
+
+! (Delta mirrorFor: #FinalizationNotifier)
methodsFor: 'restricted-finalization' !
+
+
+finalize
+
+ Transcript cr; print: self! !
+
=======================================
--- /dev/null
+++ /branches/gcc-linux/StrongtalkSource/WeakArrayTest.dlt Sun Dec 13
16:47:01 2009
@@ -0,0 +1,29 @@
+Delta define: #WeakArrayTest as: (
+(Class subclassOf: 'TestCase' instanceVariables: '')) !
+
+(Delta mirrorFor: #WeakArrayTest) revision: '$Revision:$'!
+
+(Delta mirrorFor: #WeakArrayTest) group: 'Unclassified'!
+
+(Delta mirrorFor: #WeakArrayTest)
+comment:
+''!
+
+! (Delta mirrorFor: #WeakArrayTest) methodsFor: 'testing' !
+
+
+testNotifiesWeakDependentOnObjectDeath
+
+| array object dependent victim |
+object := Object new.
+dependent := BlockDependent updateBlock: [:aspect :object | victim :=
object].
+array := WeakArray new: 1.
+array at: 1 put: object.
+array addWeakDependent: dependent.
+VM collectGarbage.
+self assert: victim isNil description: 'victim should still have
references'.
+object := nil.
+VM collectGarbage.
+Processor yield.
+self deny: victim isNil description: 'victim not dying'! !
+
=======================================
--- /branches/gcc-linux/StrongtalkSource/AlienWeakTable.dlt Sun Sep 13
14:52:44 2009
+++ /branches/gcc-linux/StrongtalkSource/AlienWeakTable.dlt Sun Dec 13
16:47:01 2009
@@ -63,5 +63,6 @@
weakArray := WeakArray new: 1024.
strongArray := Array new: 1024.
owner := anOwner.
- ! !
-
+ weakArray addWeakDependent: (BlockDependent
+ updateBlock: [:aspect| self finalizeValues])! !
+
=======================================
--- /branches/gcc-linux/StrongtalkSource/Object.dlt Sun Sep 13 14:52:44 2009
+++ /branches/gcc-linux/StrongtalkSource/Object.dlt Sun Dec 13 16:47:01 2009
@@ -663,6 +663,14 @@
ifTrue: [ false ] "for speed"
ifFalse: [ true ]! !

+! (Delta mirrorFor: #Object) methodsFor: 'restricted-finalization' !
+
+
+finalize
+" no live references to the receiver exist. Clean up any external
+ resources owned by the receiver. The receiver may be resurrected.
+ Default is to do nothing"! !
+
! (Delta mirrorFor: #Object) methodsFor: 'testing' !


=======================================
--- /branches/gcc-linux/StrongtalkSource/Process.dlt Sat Nov 1 12:10:49
2008
+++ /branches/gcc-linux/StrongtalkSource/Process.dlt Sun Dec 13 16:47:01
2009
@@ -219,6 +219,10 @@
! (Delta mirrorFor: #Process) methodsFor: 'testing' !


+dead
+
+ ^self status == #Killed!
+
running ^<Boolean>
"Not suspended, dying, or dead. (This includes processes blocked in async
dll calls)"

=======================================
--- /branches/gcc-linux/StrongtalkSource/VM.dlt Sat Oct 17 07:54:56 2009
+++ /branches/gcc-linux/StrongtalkSource/VM.dlt Sun Dec 13 16:47:01 2009
@@ -162,7 +162,8 @@

collectGarbage

- {{self primitiveGarbageCollect}}!
+ {{self primitiveGarbageCollect}}.
+ WeakArray signalFinalization!

deferredGC

@@ -196,7 +197,8 @@
"Collect very recent garbage. This is fast, but does not collect all
garbage.
(i.e. it scavenges the object nursery) "

- {{self primitiveScavenge}}!
+ {{self primitiveScavenge}}.
+ WeakArray signalFinalization!

startGCProcess

=======================================
--- /branches/gcc-linux/StrongtalkSource/WeakArray.dlt Mon Sep 25 12:14:30
2006
+++ /branches/gcc-linux/StrongtalkSource/WeakArray.dlt Sun Dec 13 16:47:01
2009
@@ -1,5 +1,6 @@
Delta define: #WeakArray as: (
-Generic forAll: 'E ' body: ((Class
subclassOf: 'IndexedNextOfKinInstanceVariables[E] |> Array[E]'
instanceVariables: ''))) !
+Generic forAll: 'E ' body: ((Class
subclassOf: 'IndexedNextOfKinInstanceVariables[E] |> Array[E]'
instanceVariables: 'dependents <NotifyingObject>')
classVariables: 'FinalizationProcess <Process>
+FinalizationSemaphore <Semaphore>')) !

(Delta mirrorFor: #WeakArray) revision: '$Revision: 1.5 $'!

@@ -33,6 +34,90 @@
Use and distribution of this software is subject to the terms of the
attached source license
'!

+! (Delta mirrorFor: #WeakArray) classSide methodsFor: 'initialization' !
+
+
+initialize
+
+ self startFinalizationProcess! !
+
+! (Delta mirrorFor: #WeakArray) classSide methodsFor: 'instance creation' !
+
+
+new: size <Int>
+
+ self startFinalizationProcess.
+ ^(super new: size)
+ initialize;
+ yourself! !
+
+! (Delta mirrorFor: #WeakArray) classSide
methodsFor: 'private-finalization' !
+
+
+checkNotification
+ [
+ {{primitiveNotificationQueueGetIfFail: [ :err |^self]}} notify.
+ ] repeat.!
+
+finalizationBlock
+
+ ^[[[self checkNotification]
+ on: Error
+ do: [:error| self handleFinalizationError: error] .
+ self finalizationSemaphore wait] repeat]!
+
+finalizationPriority
+
+ "%TODO revisit once Process prioritization implemented"
+ ^Processor activePriority!
+
+finalizationProcess
+
+ ^FinalizationProcess!
+
+finalizationSemaphore
+
+ self initFinalizationSemaphore.
+ ^FinalizationSemaphore!
+
+handleFinalizationError: error
+
+ FinalizationProcess := nil.
+ error pass!
+
+hasFinalizationProcess
+
+ ^self finalizationProcess notNil
+ and: [self finalizationProcess running]!
+
+initFinalizationSemaphore
+
+ FinalizationSemaphore isNil
+ ifTrue: [FinalizationSemaphore := Semaphore new]!
+
+startFinalizationProcess
+
+ self hasFinalizationProcess ifTrue: [^self].
+ self terminateFinalizationProcess.
+ self initFinalizationSemaphore.
+ FinalizationProcess := self finalizationBlock forkAt: self
finalizationPriority!
+
+terminateFinalizationProcess
+
+ true ifTrue: [^self]. "%TODO remove when stack overflow issue fixed"
+ self finalizationProcess notNil
+ ifTrue: [[self finalizationProcess terminate]
+ on: Error
+ do: [:ignore|]]! !
+
+! (Delta mirrorFor: #WeakArray) classSide methodsFor: 'restricted to
VM-finalization' !
+
+
+signalFinalization
+
+ self finalizationSemaphore waitWouldBlock
+ ifTrue: [self finalizationSemaphore signal]! !
+
! (Delta mirrorFor: #WeakArray) methodsFor: 'notification' !


@@ -41,9 +126,28 @@

notify
1 to: self size do: [ :index |
- (self hadNearDeathExperience: (self at: index)) ifTrue: [
- Transcript show: 'Cleaing ', index printString; cr.
- self at: index put: nil
+ | victim |
+ (self hadNearDeathExperience: (victim := self at: index)) ifTrue: [
+ self at: index put: nil.
+ dependents changed: #finalize with: victim
]
]! !

+! (Delta mirrorFor: #WeakArray) methodsFor: 'private-initialization' !
+
+
+initialize
+
+ dependents := NotifyingObject new! !
+
+! (Delta mirrorFor: #WeakArray) methodsFor: 'weak dependents' !
+
+
+addWeakDependent: dependent
+
+ dependents addDependent: dependent!
+
+removeWeakDependent: dependent
+
+ dependents removeDependent: dependent! !
+
=======================================
--- /branches/gcc-linux/vm/runtime/os_nt.cpp Sat Oct 17 07:54:56 2009
+++ /branches/gcc-linux/vm/runtime/os_nt.cpp Sun Dec 13 16:47:01 2009
@@ -475,7 +475,7 @@
bool handling_exception;

LONG WINAPI testVectoredHandler(struct _EXCEPTION_POINTERS* exceptionInfo)
{
- lprintf("Caught exception.\n");
+ //lprintf("Caught exception.\n");
if (false && handler && !handling_exception) {
handling_exception = true;
handler((void*)exceptionInfo->ContextRecord->Ebp,