Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.1183.mcz
==================== Summary ====================
Name: Kernel-eem.1183 Author: eem Time: 26 July 2018, 8:57:05.046828 pm UUID: a55317a4-d742-41af-b3a3-b3198281c2d9 Ancestors: Kernel-eem.1182
Fix the broken SemaphoreTest and MutexTest tests (test[Mutex|Semaphore][After|In]CriticalWait) by having Process>>terminate correctly release <criticalSection> marked methods. This is done by terminate's helper releaseCriticalSection: distinguishing between a context blocked on a blocking primitive (wait, primitiveEnterCriticalSection & primitiveTestAndSetOwnershipOfCriticalSection) and a runnable process that has been unblocked but has not advanced beyond the blocking send, presumably because it has been shut out by currently running higher priority processes.
Add InstructionStream>>selectorJustSentOrSelf (c.f. selectorToSendOrSelf) to support releaseCriticalSection:.
=============== Diff against Kernel-eem.1182 ===============
Item was added: + ----- Method: InstructionStream>>selectorJustSentOrSelf (in category 'scanning') ----- + selectorJustSentOrSelf + "If this instruction follows a send, answer the send's selector, otherwise answer self." + + | method | + method := self method. + ^method encoderClass selectorToSendOrItselfFor: self in: method at: self previousPc!
Item was added: + ----- Method: Process>>releaseCriticalSection: (in category 'private') ----- + releaseCriticalSection: runnable + "Figure out if we are terminating a process that is in the ensure: block of a critical section. + In this case, if the block has made progress, pop the suspendedContext so that we leave the + ensure: block inside the critical: without signaling the semaphore/exiting the primitive section, + since presumably this has already happened. But if it hasn't made progress but is beyond the + wait (which we can tell my the oldList being one of the runnable lists, i.e. a LinkedList, not a + Semaphore or Mutex, et al), then the ensure: block needs to be run." + | selectorJustSent | + (suspendedContext method pragmaAt: #criticalSection) ifNil: [^self]. + selectorJustSent := suspendedContext selectorJustSentOrSelf. + + "Receiver and/or argument blocks of ensure: in Semaphore>>critical: or Mutex>>#critical:" + suspendedContext isClosureContext ifTrue: + [suspendedContext sender selector == #ensure: ifTrue: + [| notWaitingButMadeNoProgress | + "Avoid running the ensure: block twice, popping it if it has already been run. If runnable + but at the wait, leave it in place. N.B. No need to check if the block receiver of ensure: has + not started to run (via suspendedContext pc = suspendedContext startpc) because ensure: + uses valueNoContextSwitch, and so there is no suspension point before the wait." + notWaitingButMadeNoProgress := + runnable + and: [selectorJustSent == #wait + and: [suspendedContext sender selectorJustSentOrSelf == #valueNoContextSwitch]]. + notWaitingButMadeNoProgress ifFalse: + [suspendedContext := suspendedContext home]]. + ^self]. + + "Either Semaphore>>critical: or Mutex>>#critical:. Is the process still blocked? If so, nothing further to do." + runnable ifFalse: [^self]. + + "If still at the wait the ensure: block has not been activated, so signal to restore." + selectorJustSent == #wait ifTrue: + [suspendedContext receiver signal]. + + "If still at the lock primitive and the lock primitive just acquired ownership (indicated by it answering false) + then the ensure block has not been activated, so explicitly primitiveExitCriticalSection to unlock." + (selectorJustSent == #primitiveEnterCriticalSection + or: [selectorJustSent == #primitiveTestAndSetOwnershipOfCriticalSection]) ifTrue: + [(suspendedContext stackPtr > 0 + and: [suspendedContext top == false]) ifTrue: + [suspendedContext receiver primitiveExitCriticalSection]]!
Item was changed: ----- Method: Process>>terminate (in category 'changing process state') ----- terminate + "Stop the process that the receiver represents forever. + Unwind to execute pending ensure:/ifCurtailed: blocks before terminating. + If the process is in the middle of a critical: critical section, release it properly." - "Stop the process that the receiver represents forever. Unwind to execute pending ensure:/ifCurtailed: blocks before terminating."
| ctxt unwindBlock oldList | self isActiveProcess ifTrue: [ ctxt := thisContext. [ ctxt := ctxt findNextUnwindContextUpTo: nil. ctxt isNil ] whileFalse: [ (ctxt tempAt: 2) ifNil:[ ctxt tempAt: 2 put: nil. unwindBlock := ctxt tempAt: 1. thisContext terminateTo: ctxt. unwindBlock value]. ]. thisContext terminateTo: nil. self suspend. ] ifFalse:[ + "Always suspend the process first so it doesn't accidentally get woken up. + N.B. If oldList is a LinkedList then the process is runnable. If it is a Semaphore/Mutex et al + then the process is blocked, and if it is nil then the process is already suspended." - "Always suspend the process first so it doesn't accidentally get woken up" oldList := self suspend. + suspendedContext ifNotNil: + ["Release any method marked with the <criticalSection> pragma. + The argument is whether the process is runnable." + self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]). - suspendedContext ifNotNil:[ - "Figure out if we are terminating a process that is in the ensure: block of a critical section. - In this case, if the block has made progress, pop the suspendedContext so that we leave the - ensure: block inside the critical: without signaling the semaphore/exiting the primitive section, - since presumably this has already happened." - (suspendedContext isClosureContext - and: [(suspendedContext method pragmaAt: #criticalSection) notNil - and: [suspendedContext startpc > suspendedContext closure startpc]]) ifTrue: - [suspendedContext := suspendedContext home].
+ "If terminating a process halfways through an unwind, try to complete that unwind block first." - "If we are terminating a process halfways through an unwind, try - to complete that unwind block first." (suspendedContext findNextUnwindContextUpTo: nil) ifNotNil: [:outer| (suspendedContext findContextSuchThat:[:c| c closure == (outer tempAt: 1)]) ifNotNil: [:inner| "This is an unwind block currently under evaluation" suspendedContext runUntilErrorOrReturnFrom: inner]].
ctxt := self popTo: suspendedContext bottomContext. ctxt == suspendedContext bottomContext ifFalse: [self debug: ctxt title: 'Unwind error during termination']. "Set the context to its endPC for the benefit of isTerminated." ctxt pc: ctxt endPC]]!