On Fri, Jan 8, 2016 at 1:20 AM, Eliot Miranda eliot.miranda@gmail.com wrote:
On Thu, Jan 7, 2016 at 5:34 AM, Clément Bera bera.clement@gmail.com wrote:
Eliot, please, you told me you had the code and Denis is interested. It uses 3 primitives for performance.
Here are the two business methods: CriticalSection methods for mutual exclusion critical: aBlock "Evaluate aBlock protected by the receiver." ^self primitiveEnterCriticalSection ifTrue: [aBlock value] ifFalse: [aBlock ensure: [self primitiveExitCriticalSection]]
critical: aBlock ifLocked: lockedBlock "Answer the evaluation of aBlock protected by the receiver. If it is already in a critical section on behalf of some other process answer the evaluation of lockedBlock." ^self primitiveTestAndSetOwnershipOfCriticalSection ifNil: [lockedBlock value] ifNotNil:[:alreadyOwner| alreadyOwner ifTrue: [aBlock value] ifFalse: [aBlock ensure: [self primitiveExitCriticalSection]]]
and the primitives: primitiveEnterCriticalSection primitiveExitCriticalSection primitiveTestAndSetOwnershipOfCriticalSection
Reading this vm code...
primitiveExitCriticalSection | criticalSection owningProcessIndex owningProcess | criticalSection := self stackTop. "rcvr" owningProcessIndex := ExcessSignalsIndex. (self isEmptyList: criticalSection) ifTrue: [objectMemory storePointerUnchecked: owningProcessIndex ofObject: criticalSection withValue: objectMemory nilObject] ifFalse: [owningProcess := self removeFirstLinkOfList: criticalSection. objectMemory storePointerUnchecked: owningProcessIndex ofObject: criticalSection withValue: owningProcess. self resume: owningProcess preemptedYieldingIf: preemptionYields]
I suspect a problem since it does not check it is the owningProcess before setting owningProcess to nil. AFAIK, only the owning process should be able to release the mutex. To demonstrate, evaluating the following...
Transcript clear. cs := CriticalSection new. sync := Semaphore new. b1 := [ Transcript crShow: '1A'. cs primitiveEnterCriticalSection. sync wait. Transcript crShow: '1B'. cs primitiveExitCriticalSection. ]. b2 := [ Transcript crShow: '2A'. cs primitiveEnterCriticalSection. Transcript crShow: '2B'. cs primitiveExitCriticalSection. ]. b3 := [ Transcript crShow: '3A'. cs primitiveExitCriticalSection. cs primitiveEnterCriticalSection. Transcript crShow: '3B'. ]. [ b1 newProcess resume. b2 newProcess resume. 2 second wait. sync signal. ] fork
correctly produces... 1A 2A "pauses here" 1B 2B
but if the last forked block replaces b2 with b3... [ b1 newProcess resume. b3 newProcess resume. 2 second wait. sync signal. ] fork
it produces incorrectly result...
1A 3A 3B "pauses here" 1B
I believe the "cs primitiveExitCriticalSection" in b3 should raise an error. Thus primitiveExitCriticalSection might be...
primitiveExitCriticalSection argumentCount > 0 ifTrue: [ criticalSection := self stackValue: 1. "rcvr" activeProc := self stackTop ] ifFalse: [ criticalSection := self stackTop. "rcvr" activeProc := self activeProcess ]. owningProcessIndex := ExcessSignalsIndex. owningProcess := objectMemory fetchPointer: owningProcessIndex ofObject: criticalSection. owningProcess = activeProc ifFalse: self primitiveFail. "<==!!!" (self isEmptyList: criticalSection) ifTrue: [ objectMemory storePointerUnchecked: owningProcessIndex ofObject: criticalSection withValue: objectMemory nilObject] ifFalse: [ owningProcess := self removeFirstLinkOfList: criticalSection. objectMemory storePointerUnchecked: owningProcessIndex ofObject: criticalSection withValue: owningProcess. self resume: owningProcess preemptedYieldingIf: preemptionYields ]
Now I've inserted the additional check without completely understanding the code around it. I've been contemplating (self isEmptyList: criticalSection) off and on for a couple of days and I'm stumped. I only guess it has something to do with a process being suspended while inside the critical section.
Also I guess the ( argumentCount > 0) is so it can be used from the debugger ??
cheers -ben