'From Squeak3.10beta of 22 July 2007 [latest update: #7130] on 5 October 2007 at 6:34:37 pm'!
"Change Set:		SemaCritical
Date:			5 October 2007
Author:			Andreas Raab

An attempt to fix the problems with Semaphore>>critical: by cooperating with Process>terminate."!


!Process methodsFor: 'changing process state' stamp: 'ar 10/5/2007 18:01'!
terminate 
	"Stop the process that the receiver represents forever.  Unwind to execute pending ensure:/ifCurtailed: blocks before terminating."

	| ctxt unwindBlock inSema |
	self isActiveProcess ifTrue: [
		ctxt := thisContext.
		[	ctxt := ctxt findNextUnwindContextUpTo: nil.
			ctxt isNil
		] whileFalse: [
			unwindBlock := ctxt tempAt: 1.
			unwindBlock ifNotNil: [
				ctxt tempAt: 1 put: nil.
				thisContext terminateTo: ctxt.
				unwindBlock value].
		].
		thisContext terminateTo: nil.
		myList := nil.
		self primitiveSuspend.
	] ifFalse: [
		"Since the receiver is not the active process, drop its priority to rock-bottom so that
		it doesn't accidentally preempt the process that is trying to terminate it."
		priority := 10.
		myList ifNotNil: [
			myList remove: self ifAbsent: [].
			"Figure out if the receiver was terminated while waiting on a Semaphore"
			inSema := myList class == Semaphore.
			myList := nil].
		suspendedContext ifNotNil: [
			"Figure out if we are terminating the process while waiting in Semaphore>>critical:
			In this case, pop the suspendedContext so that we leave the ensure: block inside
			Semaphore>>critical: without signaling the semaphore."
			(inSema == true and:[
				suspendedContext method == (Semaphore compiledMethodAt: #critical:)]) ifTrue:[
					suspendedContext := suspendedContext home.
			].
			ctxt := self popTo: suspendedContext bottomContext.
			ctxt == suspendedContext bottomContext ifFalse: [
				self debug: ctxt title: 'Unwind error during termination']].
	].
! !


!Semaphore methodsFor: 'mutual exclusion' stamp: 'ar 10/5/2007 17:59'!
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 |
	caught := false.
	[
		caught := true.
		self wait.
		blockValue := mutuallyExcludedBlock value
	] ensure: [caught ifTrue: [self signal]].
	^blockValue
! !

!Semaphore methodsFor: 'mutual exclusion' stamp: 'ar 10/5/2007 18:33'!
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."
	^self critical:[[mutuallyExcludedBlock value] ifCurtailed: terminationBlock]
! !

!Semaphore methodsFor: 'mutual exclusion' stamp: 'ar 10/5/2007 17:59'!
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 |
	hasError := false.
	self critical:[
		blockValue := [mutuallyExcludedBlock value] ifError:[:msg :rcvr|
			hasError := true.
			errMsg := msg.
			errRcvr := rcvr
		].
	].
	hasError ifTrue:[ ^errorBlock value: errMsg value: errRcvr].
	^blockValue! !

!Semaphore methodsFor: 'mutual exclusion' stamp: 'ar 10/5/2007 18:34'!
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 
	mutuallyExcludedBlock after the other critical: message is finished."
	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 
	].
	^self critical: mutuallyExcludedBlock! !

