'From Croquet1.0beta of 11 April 2006 [latest update: #1] on 27 July 2007 at 6:21:12 pm'!
"Change Set:		SemaphoreCritical-ar
Date:			27 July 2007
Author:			Andreas Raab

Fixes improper handling of Semaphore>>critical:"!


!Semaphore methodsFor: 'mutual exclusion' stamp: 'ar 7/27/2007 18:19'!
critical: mutuallyExcludedBlock			
	"Evaluate mutuallyExcludedBlock only if the receiver is not currently in
	the process of running the critical: message. If the receiver is, evaluate
	mutuallyExcludedBlock after the other critical: message is finished."
	| blockValue caught |
	"We need to catch eventual interruptions very carefully. 
	The naive approach of just doing, e.g.,:
		self wait.
		aBlock ensure:[self signal].
	will fail if the active process gets terminated while in the wait.
	However, the equally naive:
		[self wait.
		aBlock value] ensure:[self signal].
	will fail too, since the active process may get interrupted while
	entering the ensured block and leave the semaphore signaled twice.
	To avoid both problems we make use of the fact that interrupts only
	occur on sends (or backward jumps) and use an assignment (bytecode)
	right before we go into the wait primitive (which is not a real send and
	therefore not interruptable either)."

	caught := false.
	[
		caught := true. 
		self wait.
		blockValue := mutuallyExcludedBlock value
	] ensure: [
		caught ifTrue: [self signal].
	].
	^blockValue
! !

!Semaphore methodsFor: 'mutual exclusion' stamp: 'ar 7/27/2007 18:19'!
critical: mutuallyExcludedBlock ifCurtailed: terminationBlock
	"Evaluate mutuallyExcludedBlock only if the receiver is not currently in 
	the process of running the critical: message. If the receiver is, evaluate 
	mutuallyExcludedBlock after the other critical: message is finished."
	| blockValue caught |
	caught := false. "See comment in Semaphore>>critical:"
	[
		caught := true.
		self wait.
		[blockValue := mutuallyExcludedBlock value] ifCurtailed: terminationBlock 
	] ensure: [
		caught ifTrue:[self signal].
	].
	^blockValue! !

!Semaphore methodsFor: 'mutual exclusion' stamp: 'ar 7/27/2007 18:20'!
critical: mutuallyExcludedBlock ifError: errorBlock
	"Evaluate mutuallyExcludedBlock only if the receiver is not currently in 
	the process of running the critical: message. If the receiver is, evaluate 
	mutuallyExcludedBlock after the other critical: message is finished."

	| blockValue hasError errMsg errRcvr caught |
	caught := false. "See comment in Semaphore>>critical:"
	[
		caught := true.
		self wait.
		hasError := false.
		blockValue := [mutuallyExcludedBlock value] ifError:[:msg :rcvr|
			hasError := true.
			errMsg := msg.
			errRcvr := rcvr
		].
	] ensure: [
		caught ifTrue:[self signal].
	].

	hasError ifTrue:[ ^errorBlock value: errMsg value: errRcvr].
	^blockValue! !

!Semaphore methodsFor: 'mutual exclusion' stamp: 'ar 7/27/2007 18:20'!
critical: mutuallyExcludedBlock ifLocked: alternativeBlock
	"Evaluate mutuallyExcludedBlock only if the receiver is not currently in 
	the process of running the critical: message. If the receiver is, evaluate 
	alternativeBlock."
	| blockValue caught |

	"Note: The following is tricky and depends on the fact that the VM will not switch between processes while executing byte codes (process switches happen only in real sends). The following test is written carefully so that it will result in bytecodes only."
	excessSignals == 0 ifTrue:[
		"If we come here, then the semaphore was locked when the test executed. 
		Evaluate the alternative block and answer its result."
		^alternativeBlock value 
	].

	caught := false. "See comment in Semaphore>>critical:"
	[
		caught := true.
		self wait.
		blockValue := mutuallyExcludedBlock value.
	] ensure: [
		caught ifTrue:[self signal].
	].
	^blockValue! !


!Semaphore reorganize!
('initialize-release' initSignals terminateProcess)
('communication' signal waitTimeoutMSecs: waitTimeoutSeconds:)
('mutual exclusion' critical: critical:ifCurtailed: critical:ifError: critical:ifLocked:)
('comparing' = hash)
('testing' isSignaled)
('*Scripting-Preload' primitiveWait)
('*Scripting-override' wait)
!