[Vm-dev] Where to get Monitor implementation based on primitives?

[Ben Coman]

On Fri, Jan 8, 2016 at 1:20 AM, Eliot Miranda <eliot.miranda at gmail.com> wrote:
>>
>> On Thu, Jan 7, 2016 at 5:34 AM, Clément Bera <bera.clement at 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