'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! !