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