[Vm-dev] Case 5959 - Broken process resume interaction with waiting semaphore

[Ben Coman]

I went looking at the oldest cases, and found issue 5959 interesting and 
perhaps within my scope for my first foray into the VM.

On build 40360 with the following test script...
     | sema proc |
         Transcript clear.
     sema := Semaphore new.
     proc := [ sema wait. Transcript crShow: 'signalled' ]
     proc priority: Processor highestPriority .
     proc resume.
     proc suspend.
         Transcript crShow: 1.
     proc resume.
         Transcript crShow: 2.
     sema signal.
         Transcript crShow: 'excessSignals=' ; show: sema excessSignals

Prior loading attached changeset gives...
   1
   signalled
   2
   excessSignals=1

After loading attached changeset gives...
   1
   2
   signalled
   excessSignals=0


btw, for the test script you need to add
    Semaphore>>excessSignals
        ^excessSignals


The changeset loads on top of VMMaker updating:
* CoInterpreterPrimitives>>primitiveSuspend
* CoInterpreterPrimitives>>primitiveResume
Now I probably have abused myList to keep the semaphore for 
primitiveResume to reactive, but I did poke around references to 
MyListIndex and it seemed myList was written to more than read from.


-----------
In the issue there was mention that some libraries may rely on the 
broken semantics.  Anyone know which those might be?

cheers -ben

https://pharo.fogbugz.com/default.asp?5959
-------------- next part --------------
'From Pharo3.0 of 18 March 2013 [Latest update: #30860] on 19 November 2014 at 12:59:04.381324 am'!

!CoInterpreterPrimitives methodsFor: 'process primitives' stamp: 'BenComan 11/19/2014 00:34'!
primitiveResume
	"Put this process on the scheduler's lists thus allowing it to proceed next time there is
	 a chance for processes of it's priority level.  It must go to the back of its run queue so
	 as not to preempt any already running processes at this level.  If the process's priority
	 is higher than the current process, preempt the current process."
	| proc inInterpreter myList |
	proc := self stackTop.  "rcvr"
	(objectMemory isContext: (objectMemory fetchPointer: SuspendedContextIndex ofObject: proc)) ifFalse:
		[^self primitiveFail].
	
	"Check if process we are resuming is waiting on a semaphore"
	myList := objectMemory fetchPointer: MyListIndex ofObject: proc.
	(objectMemory fetchClassOf: myList) = (objectMemory splObj: ClassSemaphore) ifTrue: [
		| excessSignals |
		excessSignals := self fetchInteger: ExcessSignalsIndex ofObject: myList.
		excessSignals > 0
			ifTrue: [
				"Consume signal and continue with resume"
				self storeInteger: ExcessSignalsIndex
				ofObject: myList
				withValue: excessSignals - 1
				]
			ifFalse: [
				"Revert #suspend action to re-wait on semaphore, and bypass resume"
				self addLastLink: proc toList: myList.
				^self.
				].
		].
		
	"We're about to switch process, either to an interpreted frame or a
	 machine code frame. To know whether to return or enter machine code
	 we have to know from whence we came.  We could have come from the
	 interpreter, either directly or via a machine code primitive.  We could have
	 come from machine code.  The instructionPointer tells us where from:"
	inInterpreter := instructionPointer >= objectMemory startOfMemory.
	(self resume: proc preemptedYieldingIf: preemptionYields from: CSResume) ifTrue:
		[self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter]

	"Personally I would like to check MyList, which should not be one of the elements of the scheduler lists.
	 But there are awful race conditions in things like should:notTakeMoreThan: that mean we can't.
	 eem 9/27/2010 23:08. e.g.

	| proc myList classLinkedList |
	proc := self stackTop.
	myList := objectMemory fetchPointer: MyListIndex ofObject: proc.
	classLinkedList := self superclassOf: (objectMemory splObj: ClassSemaphore).
	((self fetchClassOfNonInt: myList) ~= classLinkedList
	and: [objectMemory isContext: (objectMemory fetchPointer: SuspendedContextIndex ofObject: proc)]) ifFalse:
		[^self primitiveFail].
	''We're about to switch process, either to an interpreted frame or a
	 machine code frame. To know whether to return or enter machine code
	 we have to know from whence we came.  We could have come from the
	 interpreter, either directly or via a machine code primitive.  We could have
	 come from machine code.  The instructionPointer tells us where from:''
	inInterpreter := instructionPointer >= objectMemory startOfMemory.
	(self resume: proc  preemptedYieldingIf: preemptionYields from: CSResume) ifTrue:
		[self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter]"! !

!CoInterpreterPrimitives methodsFor: 'process primitives' stamp: 'BenComan 11/19/2014 00:32'!
primitiveSuspend
	"Primitive. Suspend the receiver, aProcess such that it can be executed again
	by sending #resume. If the given process is not currently running, take it off
	its corresponding list. The primitive returns the list the receiver was previously on."
	| process myList |
	process := self stackTop.
	process = self activeProcess ifTrue:
		[| inInterpreter |
		"We're going to switch process, either to an interpreted frame or a machine
		 code frame. To know whether to return or enter machine code we have to
		 know from whence we came.  We could have come from the interpreter,
		 either directly or via a machine code primitive.  We could have come from
		 machine code.  The instructionPointer tells us where from:"
		self pop: 1 thenPush: objectMemory nilObject.
		inInterpreter := instructionPointer >= objectMemory startOfMemory.
		self transferTo: self wakeHighestPriority from: CSSuspend.
		^self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter].
	myList := objectMemory fetchPointer: MyListIndex ofObject: process.
	"XXXX Fixme. We should really check whether myList is a kind of LinkedList or not
	but we can't easily so just do a quick check for nil which is the most common case."
	myList = objectMemory nilObject ifTrue:[^self primitiveFail].
	self removeProcess: process fromList: myList.
	self successful ifTrue:
		[     "Leave waiting-semaphores in myList, since we need #primitiveResume to re-wait on it"	
			(objectMemory fetchClassOf: myList) = (objectMemory splObj: ClassSemaphore) ifFalse: [
				objectMemory storePointer: MyListIndex ofObject: process withValue: objectMemory nilObject].
		 self pop: 1 thenPush: myList]! !