Marcel Taeumel uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-jar.1468.mcz
==================== Summary ====================
Name: Kernel-jar.1468
Author: jar
Time: 29 May 2022, 3:09:04.797182 pm
UUID: ed2a10c6-957b-ef4b-88ed-e3bf53f65520
Ancestors: Kernel-dtl.1467
Update to accommodate the new suspend semantics using primitives 568 and 578.
Use new suspend primitive 579 but 568 could be used as well if preferred. The old primitive 88 has been moved to #suspendAndUnblock for convenience and backward compatibiity.
Update #terminate to be able to unblock and terminate processes being blocked on a condition variable.
This minimum set of changes is partly compatible with older VMs with only suspend primitive 88. For improved compatibility with older VMs #isTerminated would require to be updated as well.
To be complemented with a set of new and updated tests - coming soon.
Supersede Kernel-jar.1447; please remove it from the Inbox.
=============== Diff against Kernel-dtl.1467 ===============
Item was added:
+ ----- Method: Context>>runUntilReturnFrom: (in category 'private-exceptions') -----
+ runUntilReturnFrom: aContext
+ "Run the receiver (which must be its stack top context) until aContext returns. Avoid a context that cannot return.
+ Note: to avoid infinite recursion of MNU error inside unwind blocks, implement e.g. a wrapper around the message
+ sentTo: receiver in #doesNotUnderstand:. Note: This method is a trivialized version of #runUntilErrorOrReturnFrom:
+ and was intended to be used by #unwindTo as a helper method to unwind non-local returns inside unwind blocks."
+
+ | here unwindBottom newTop |
+ here := thisContext.
+ "Avoid a context that cannot return (see Note 1 below)"
+ unwindBottom := (self findContextSuchThat: [:ctx | ctx selector = #cannotReturn:]) ifNil: [aContext].
+ newTop := aContext sender.
+ "Insert ensure context under unwindBottom in self's stack (see Note 2 below)"
+ unwindBottom insertSender: (Context contextEnsure: [here jump]).
+ self jump. "Control jumps to the receiver's stack (see Note 2 below)"
+ "Control resumes here once the above inserted ensure block is executed (see #jump comments)"
+ ^newTop "Return the new top context (see Note 3 below)"
+
+ "Note 1: returning from #cannotReturn's sender would crash the VM so we install a guard ensure context right
+ above it; after returning here the unwind will continue safely. Try running and debugging this example
+ (avoid Proceeding the BCR error though; it may indeed crash the image):
+ [[[] ensure: [^2]] ensure: [^42]] fork"
+
+ "Note 2: the receiver (self) is run by jumping directly to it (the active process abandons thisContext and executes
+ self on its own stack; self must be its top context). However, before jumping to self we insert an ensure block under
+ unwindBottom context that will execute a jump back to thisContext when evaluated. The inserted guard ensure
+ context is removed once control jumps back to thisContext."
+
+ "Note 3: it doesn't matter newTop is not a proper stack top context because #unwindTo will only use it as a starting
+ point in the search for the next unwind context and the computation will never return here. We could make newTop
+ a proper top context by pushing nil to its stack (^newTop push: nil) if need be (see #jump comments).
+ Cf. the pattern in #runUntilErrorOrReturnFrom:: removing the inserted ensure context by stepping until popped
+ when executing non-local returns wouldn't work here and would fail tests testTerminateInNestedEnsureWithReturn1
+ through 4."!
Item was changed:
----- Method: Context>>unwindTo: (in category 'private-exceptions') -----
unwindTo: aContext
+ "Unwind the receiver to aContext to execute all pending unwind blocks."
+ self unwindTo: aContext safely: true!
- | ctx unwindBlock |
- ctx := self.
- [(ctx := ctx findNextUnwindContextUpTo: aContext) isNil] whileFalse: [
- (ctx tempAt: 2) ifNil:[
- ctx tempAt: 2 put: true.
- unwindBlock := ctx tempAt: 1.
- unwindBlock value]
- ].
- !
Item was added:
+ ----- Method: Context>>unwindTo:safely: (in category 'private-exceptions') -----
+ unwindTo: aContext safely: aBoolean
+ "Unwind self to aContext to execute pending #ensure:/#ifCurtailed: argument blocks between self
+ and aContext. If aBoolean is false, unwind only blocks that have not run yet, otherwise complete all
+ pending unwind blocks including those currently in the middle of their execution; these blocks will
+ just finish their execution. Run all unwinds on their original stack using #runUntilReturnFrom:."
+
+ | top ctx |
+ ctx := top := self.
+ aBoolean ifTrue: [
+ "If self is a top context of a stack already halfways through an unwind, complete the outer-most
+ unfinished unwind block first; all nested pending unwind blocks will be completed in the process;
+ see testTerminationDuringUnwind and tests in ProcessTest/UnwindTest.
+ Note: Halfway-through blocks have already set the complete variable (ctxt tempAt: 2) in their
+ defining #ensure:/#ifCurtailed contexts from nil to true; we'll search for the bottom-most one."
+ | outerMost |
+ ctx isUnwindContext ifFalse: [ctx := ctx findNextUnwindContextUpTo: aContext].
+ [ctx isNil] whileFalse: [
+ (ctx tempAt:2) ifNotNil: [
+ outerMost := ctx].
+ ctx := ctx findNextUnwindContextUpTo: aContext].
+ outerMost ifNotNil: [top := (top runUntilReturnFrom: outerMost) sender]].
+ "By now no halfway-through unwind blocks are on the stack.
+ Note: top points to the former outerMost sender now, i.e. to the next context to be explored."
+
+ ctx := top.
+ "#findNextUnwindContextUpTo: starts searching from the receiver's sender so we must check
+ the receiver explicitly whether it is an unwind context; see testTerminateEnsureAsStackTop.
+ Create a new top context (i.e. a new branch off the original stack) for each pending unwind block
+ (ctxt tempAt: 1) and execute it on the unwind block's stack to evaluate non-local returns correctly."
+ ctx isUnwindContext ifFalse: [ctx := ctx findNextUnwindContextUpTo: aContext].
+ [ctx isNil] whileFalse: [
+ (ctx tempAt: 2) ifNil: [
+ ctx tempAt: 2 put: true.
+ top := (ctx tempAt: 1) asContextWithSender: ctx.
+ top runUntilReturnFrom: top].
+ ctx := ctx findNextUnwindContextUpTo: aContext]
+ "Note: Cf. the unwind pattern in the previous versions of unwindTo: (1999-2021). Using #value
+ instead of #runUntilReturnFrom: lead to a failure to evaluate some non-local returns correctly;
+ a non-local return must be evaluated in the evaluation context (sender chain) in which it was defined."!
Item was changed:
----- Method: DelayWaitTimeout>>signalWaitingProcess (in category 'signaling') -----
signalWaitingProcess
"Release the given process from the semaphore it is waiting on.
This method relies on running at highest priority so that it cannot be preempted
by the process being released."
beingWaitedOn := false.
"Release the process but only if it is still waiting on its original list"
process suspendingList == delaySemaphore ifTrue:[
expired := true.
+ process suspendAndUnblock; resume.
- process suspend; resume.
].
!
Item was changed:
----- Method: Process>>signalException: (in category 'signaling') -----
signalException: anException
"Signal an exception in the receiver process...if the receiver is currently
suspended, the exception will get signaled when the receiver is resumed. If
the receiver is blocked on a Semaphore, it will be immediately re-awakened
and the exception will be signaled; if the exception is resumed, then the receiver
will return to a blocked state unless the blocking Semaphore has excess signals"
+
- | oldList |
"If we are the active process, go ahead and signal the exception"
+ self isActiveProcess ifTrue: [^anException signal].
- self isActiveProcess ifTrue: [^anException signal].
+ "Suspend myself first to ensure that I won't run away
+ in the midst of the following modifications."
+ self suspend.
+ suspendedContext := Context
+ sender: suspendedContext
+ receiver: anException
+ method: (anException class lookupSelector: #signal)
+ arguments: #().
+ ^self resume!
- "Suspend myself first to ensure that I won't run away in the
- midst of the following modifications."
- myList ifNotNil:[oldList := self suspend].
-
- "Add a new method context to the stack that will signal the exception"
- suspendedContext := Context
- sender: suspendedContext
- receiver: self
- method: (self class lookupSelector: #pvtSignal:list:)
- arguments: (Array with: anException with: oldList).
-
- "If we are on a list to run, then suspend and restart the receiver
- (this lets the receiver run if it is currently blocked on a semaphore). If
- we are not on a list to be run (i.e. this process is suspended), then when the
- process is resumed, it will signal the exception"
-
- oldList ifNotNil: [self resume]!
Item was changed:
----- Method: Process>>suspend (in category 'changing process state') -----
suspend
+ "eem 1/3/2022 10:38:
+ Primitive. Suspend the receiver, aProcess, such that it can be executed again
+ by sending #resume. If the given process is not the active process, take it off
+ its corresponding list. If the list was not its run queue assume it was on some
+ condition variable (Semaphore, Mutex) and back up its pc to the send that
+ invoked the wait state the process entered. Hence when the process resumes
+ it will reenter the wait state. Answer the list the receiver was previously on iff
+ it was not active and not blocked, otherwise answer nil."
+
+ <primitive: 578 error: ec>
+ "This is fallback code for VMs which only support the old primitiveSuspend 88.
+ Note: in this case some tests may fail and some methods assuming the revised
+ suspend semantics described above may not work entirely as expected (e.g.
+ Context >> #releaseCriticalSection or Process >> #signalException)."
+ ^self suspendAndUnblock!
- "Primitive. Stop the process that the receiver represents in such a way
- that it can be restarted at a later time (by sending the receiver the
- message resume). If the receiver represents the activeProcess, suspend it.
- Otherwise remove the receiver from the list of waiting processes.
- The return value of this method is the list the receiver was previously on (if any)."
- | oldList |
- <primitive: 88>
- "This is fallback code for VMs which only support the old primitiveSuspend which
- would not accept processes that are waiting to be run."
- myList ifNil:[^nil]. "this allows us to use suspend multiple times"
- oldList := myList.
- myList := nil.
- oldList remove: self ifAbsent:[].
- ^oldList!
Item was added:
+ ----- Method: Process>>suspendAndReleaseCriticalSection (in category 'private') -----
+ suspendAndReleaseCriticalSection
+ "Figure out if we are terminating a process that is in the ensure: block of a critical section.
+ If it hasn't made progress but is beyond the wait (which we can tell by 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."
+
+ | oldList selectorJustSent |
+ "Suspend and unblock the receiver from a condition variable using suspend primitive #88.
+ It answers the list the receiver was on before the suspension."
+ oldList := self suspendAndUnblock.
+ (oldList isNil or: [oldList class == LinkedList]) ifFalse: [^self].
+
+ (suspendedContext method pragmaAt: #criticalSection) ifNil: [^self].
+ selectorJustSent := suspendedContext selectorJustSentOrSelf.
+
+ "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 added:
+ ----- Method: Process>>suspendAndUnblock (in category 'changing process state') -----
+ suspendAndUnblock
+ "ar 12/7/2007 17:10:
+ Primitive. Stop the process that the receiver represents in such a way
+ that it can be restarted at a later time (by sending the receiver the
+ message resume). If the receiver represents the activeProcess, suspend it.
+ Otherwise remove the receiver from the list of waiting processes.
+ The return value of this method is the list the receiver was previously on (if any)."
+
+ <primitive: 88 error: ec>
+ "ar 12/7/2007 17:10:
+ This is fallback code for VMs which only support the old primitiveSuspend which
+ would not accept processes that are waiting to be run."
+ ^myList ifNotNil: "this allows us to use suspend multiple times"
+ [:oldList|
+ myList := nil.
+ oldList remove: self ifAbsent: [].
+ oldList]!
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;
+ allow all unwind blocks to run; if they are currently in progress, let them finish.
+ If the process is in the middle of a #critical: critical section, release it properly."
+
+ "This is the kind of behavior we expect when terminating a healthy process.
+ See further comments in #terminateAggressively and #destroy methods dealing
+ with process termination when closing the debugger or after a catastrophic failure."
+
+ "If terminating the active process, create a parallel stack and run unwinds from there;
+ if terminating a suspended process, again, create a parallel stack for the process being
+ terminated and resume the suspended process to complete its termination from the new
+ parallel stack. Use a priority higher than the active priority to make the process that
+ invoked the termination wait for its completion."
- "Stop the receiver forever.
- Run all unwind contexts (#ensure:/#ifCurtailed: blocks) on the stack, even if they are currently in progress. If already active unwind contexts should not be continued, send #terminateAggressively instead.
- Note that ill unwind contexts are theoretically able to stall the termination (for instance, by placing a non-local return in an unwind block); however, this is a disrecommended practice.
- If the process is in the middle of a critical section, release it properly."
+ "If terminating a suspended process (including runnable and blocked), always suspend
+ the terminating process first so it doesn't accidentally get woken up. Equally important is
+ the side effect of the suspension; In 2022 a new suspend semantics has been introduced:
+ the revised #suspend backs up a process waiting on a conditional variable to the send that
+ invoked the wait state, while the pre-2022 #suspend simply removed the process from
+ the conditional variable's list it was previously waiting on; see Process>>suspend comments.
+ Execute the termination in the ensure argument block to ensure it completes even if the
+ terminator process itself gets terminated before it's finished; see testTerminateInTerminate."
+
+ | context |
- | ctxt unwindBlock oldList outerMost |
self isActiveProcess ifTrue: [
+ context := thisContext.
+ ^[context unwindTo: nil. self suspend] asContext jump].
- "If terminating the active process, suspend it first and terminate it as a suspended process."
- [self terminate] fork.
- ^self suspend].
+ [] ensure: [
+ self suspendAndReleaseCriticalSection.
+ context := suspendedContext ifNil: [^self].
+ suspendedContext := [context unwindTo: nil. self suspend] asContext.
+ self priority: Processor activePriority + 1; resume]!
- "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."
- 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]).
-
- "If terminating a process halfways through an unwind, try to complete that unwind block first;
- if there are multiple such nested unwind blocks, try to complete the outer-most one; the inner
- blocks will be completed in the process."
- ctxt := suspendedContext.
- [(ctxt := ctxt findNextUnwindContextUpTo: nil) isNil] whileFalse:
- "Contexts under evaluation have already set their complete (tempAt: 2) to true."
- [(ctxt tempAt:2) ifNotNil: [outerMost := ctxt]].
- outerMost ifNotNil: [
- "This is the outer-most unwind context currently under evaluation;
- let's find an inner context executing outerMost's argument block (tempAt: 1)"
- (suspendedContext findContextSuchThat: [:ctx |
- ctx closure == (outerMost tempAt: 1)]) ifNotNil: [:inner |
- "Let's finish the unfinished unwind context only (i.e. up to inner) and return here"
- suspendedContext runUntilErrorOrReturnFrom: inner.
- "Update the receiver's suspendedContext (the previous step reset its sender to nil);
- return, if the execution stack reached its bottom (e.g. in case of non-local returns)."
- (suspendedContext := outerMost sender) ifNil: [^self]]].
-
- "Now all unwind blocks caught halfway through have been completed;
- let's execute the ones still pending. Note: #findNextUnwindContextUpTo: starts
- searching from the receiver's sender but the receiver itself may be an unwind context."
- ctxt := suspendedContext.
- ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil].
- [ctxt isNil] whileFalse: [
- (ctxt tempAt: 2) ifNil: [
- ctxt tempAt: 2 put: true.
- unwindBlock := ctxt tempAt: 1.
- "Create a context for the unwind block and execute it on the unwind block's stack.
- Note: using #value instead of #runUntilErrorOrReturnFrom: would lead to executing
- the unwind on the wrong stack preventing the correct execution of non-local returns."
- suspendedContext := unwindBlock asContextWithSender: ctxt.
- suspendedContext runUntilErrorOrReturnFrom: suspendedContext].
- ctxt := ctxt findNextUnwindContextUpTo: nil].
-
- "Reset the context's pc and sender to nil for the benefit of isTerminated."
- suspendedContext terminate]!
Marcel Taeumel uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-jar.1469.mcz
==================== Summary ====================
Name: Kernel-jar.1469
Author: jar
Time: 29 May 2022, 3:37:20.04666 pm
UUID: 9b7abd4f-b901-db43-961d-55abbca84437
Ancestors: Kernel-jar.1468
Oops, slight change in #terminate, the rest of Kernel-jar.1468 is unchanged.
=============== Diff against Kernel-jar.1468 ===============
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;
allow all unwind blocks to run; if they are currently in progress, let them finish.
If the process is in the middle of a #critical: critical section, release it properly."
"This is the kind of behavior we expect when terminating a healthy process.
See further comments in #terminateAggressively and #destroy methods dealing
with process termination when closing the debugger or after a catastrophic failure."
"If terminating the active process, create a parallel stack and run unwinds from there;
if terminating a suspended process, again, create a parallel stack for the process being
terminated and resume the suspended process to complete its termination from the new
parallel stack. Use a priority higher than the active priority to make the process that
invoked the termination wait for its completion."
"If terminating a suspended process (including runnable and blocked), always suspend
the terminating process first so it doesn't accidentally get woken up. Equally important is
the side effect of the suspension; In 2022 a new suspend semantics has been introduced:
the revised #suspend backs up a process waiting on a conditional variable to the send that
invoked the wait state, while the pre-2022 #suspend simply removed the process from
the conditional variable's list it was previously waiting on; see Process>>suspend comments.
Execute the termination in the ensure argument block to ensure it completes even if the
terminator process itself gets terminated before it's finished; see testTerminateInTerminate."
| context |
self isActiveProcess ifTrue: [
context := thisContext.
^[context unwindTo: nil. self suspend] asContext jump].
[] ensure: [
self suspendAndReleaseCriticalSection.
context := suspendedContext ifNil: [^self].
suspendedContext := [context unwindTo: nil. self suspend] asContext.
+ self priority: (Processor activePriority + 1 min: Processor highestPriority); resume]!
- self priority: Processor activePriority + 1; resume]!
Marcel Taeumel uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-jar.1470.mcz
==================== Summary ====================
Name: Kernel-jar.1470
Author: jar
Time: 29 May 2022, 10:51:34.061501 pm
UUID: 18469d29-2a9e-074d-b7e3-12d8d981f4b5
Ancestors: Kernel-jar.1469
one more oops; check suspendedContext for nil
=============== Diff against Kernel-jar.1469 ===============
Item was changed:
----- Method: Process>>suspendAndReleaseCriticalSection (in category 'private') -----
suspendAndReleaseCriticalSection
"Figure out if we are terminating a process that is in the ensure: block of a critical section.
If it hasn't made progress but is beyond the wait (which we can tell by 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."
| oldList selectorJustSent |
"Suspend and unblock the receiver from a condition variable using suspend primitive #88.
It answers the list the receiver was on before the suspension."
oldList := self suspendAndUnblock.
(oldList isNil or: [oldList class == LinkedList]) ifFalse: [^self].
+ ((suspendedContext ifNil: [^self]) method pragmaAt: #criticalSection) ifNil: [^self].
- (suspendedContext method pragmaAt: #criticalSection) ifNil: [^self].
selectorJustSent := suspendedContext selectorJustSentOrSelf.
"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]]!
Marcel Taeumel uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-jar.1473.mcz
==================== Summary ====================
Name: Kernel-jar.1473
Author: jar
Time: 31 May 2022, 11:31:14.576719 pm
UUID: 53473e84-779a-8a4c-9bf5-32a53197cd05
Ancestors: Kernel-mt.1472
Fix a bug causing an endless stream of error windows poping up when debugging e.g.
[] newProcess
when Process Browser is open with auto-update on.
Once the suspendedContext is set, the new process is no longer considered terminated and Process Browser will try to place it in its list of processes but encounters a nil error when reading its priority because it has not been set yet.
=============== Diff against Kernel-mt.1472 ===============
Item was changed:
----- Method: Process class>>forContext:priority: (in category 'instance creation') -----
forContext: aContext priority: anInteger
+ "Answer an instance of me that has suspended aContext at priority anInteger.
+ It's important to set the priority before setting the suspendedContext; otherwise
+ an endless stream of error windows will start poping up when debugging e.g.
+ [] newProcess
+ when Process Browser is open with auto-update on."
- "Answer an instance of me that has suspended aContext at priority
- anInteger."
| newProcess |
newProcess := self new.
- newProcess suspendedContext: aContext asContext.
newProcess priority: anInteger.
+ newProcess suspendedContext: aContext asContext.
^newProcess!
Marcel Taeumel uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-jar.1475.mcz
==================== Summary ====================
Name: Kernel-jar.1475
Author: jar
Time: 4 June 2022, 10:31:44.661893 pm
UUID: 923d5402-9a8d-0a48-87d7-44c56400dd0c
Ancestors: Kernel-jar.1474
Fix a scenario when a delay or yield inside unwind blocks may cause control be handed over to the original process which may be assuming the termination has completed. (A higher priority for termination is indeed not a solution)
A process that invokes termination of another process is assumed to wait until the terminating process finishes unwinding itself. This may be useful during cleanup operations requiring e.g. waiting for resources etc.
A complementing test 'testTerminateWithDelayInUnwind' is part of the additional collection of tests in KernelTests-jar.428.
=============== Diff against Kernel-jar.1474 ===============
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;
+ allow all unwind blocks to run; if they are currently in progress, let them finish."
- allow all unwind blocks to run; if they are currently in progress, let them finish.
- If the process is in the middle of a #critical: critical section, release it properly."
+ "This is the kind of behavior we expect when terminating a healthy process.
- "This is the kind of behavior we expect when terminating a healthy process.
See further comments in #terminateAggressively and #destroy methods dealing
+ with process termination when closing the debugger or after a catastrophic failure.
+
+ If terminating the active process, create a new stack and run unwinds from there.
- with process termination when closing the debugger or after a catastrophic failure."
+ If terminating a suspended process (including runnable and blocked), always
+ suspend the terminating process first so it doesn't accidentally get woken up.
+ Equally important is the side effect of the suspension: In 2022 a new suspend
+ semantics has been introduced: the revised #suspend backs up a process waiting
+ on a conditional variable to the send that invoked the wait state, while the previous
+ #suspend simply removed the process from the conditional variable's list it was
+ previously waiting on; see #suspend and #suspendAndUnblock comments.
- "If terminating the active process, create a parallel stack and run unwinds from there;
- if terminating a suspended process, again, create a parallel stack for the process being
- terminated and resume the suspended process to complete its termination from the new
- parallel stack. Use a priority higher than the active priority to make the process that
- invoked the termination wait for its completion."
+ If the process is in the middle of a #critical: critical section, release it properly.
+
+ To allow a suspended process to unwind itself, create a new stack for the process
+ being terminated and resume the suspended process to complete its termination
+ from the new parallel stack. Use a semaphore to make the process that invoked
+ the termination wait for self's completion. Execute the termination in the ensure
+ argument block to ensure it completes even if the terminator process itself gets
+ terminated before it's finished; see testTerminateInTerminate."
+
- "If terminating a suspended process (including runnable and blocked), always suspend
- the terminating process first so it doesn't accidentally get woken up. Equally important is
- the side effect of the suspension; In 2022 a new suspend semantics has been introduced:
- the revised #suspend backs up a process waiting on a conditional variable to the send that
- invoked the wait state, while the pre-2022 #suspend simply removed the process from
- the conditional variable's list it was previously waiting on; see Process>>suspend comments.
- Execute the termination in the ensure argument block to ensure it completes even if the
- terminator process itself gets terminated before it's finished; see testTerminateInTerminate."
-
| context |
self isActiveProcess ifTrue: [
context := thisContext.
^[context unwindTo: nil. self suspend] asContext jump].
+ [] ensure: [ | terminator |
- [] ensure: [
self suspendAndReleaseCriticalSection.
context := suspendedContext ifNil: [^self].
+ terminator := Semaphore new.
+ suspendedContext := [context unwindTo: nil. terminator signal. self suspend] asContext.
+ self priority: Processor activePriority; resume.
+ terminator wait]!
- suspendedContext := [context unwindTo: nil. self suspend] asContext.
- self priority: (Processor activePriority + 1 min: Processor highestPriority); resume]!
Marcel Taeumel uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-jar.1476.mcz
==================== Summary ====================
Name: Kernel-jar.1476
Author: jar
Time: 7 June 2022, 5:26:20.195964 pm
UUID: 485a13c3-c632-aa4b-bc0d-a1a7fb9a3376
Ancestors: Kernel-jar.1475
- fix synchronization between the terminating process and the process that invoked the termination
- add further protection against multiple termination (it makes the code uglier but I can't help it)
- improve the comment (it's still too long and insufficient though ;) )
Complemented by additional tests (I'll bundle all of them in one changeset)
=============== Diff against Kernel-jar.1475 ===============
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;
allow all unwind blocks to run; if they are currently in progress, let them finish."
"This is the kind of behavior we expect when terminating a healthy process.
See further comments in #terminateAggressively and #destroy methods dealing
with process termination when closing the debugger or after a catastrophic failure.
If terminating the active process, create a new stack and run unwinds from there.
If terminating a suspended process (including runnable and blocked), always
suspend the terminating process first so it doesn't accidentally get woken up.
Equally important is the side effect of the suspension: In 2022 a new suspend
semantics has been introduced: the revised #suspend backs up a process waiting
on a conditional variable to the send that invoked the wait state, while the previous
#suspend simply removed the process from the conditional variable's list it was
previously waiting on; see #suspend and #suspendAndUnblock comments.
If the process is in the middle of a #critical: critical section, release it properly.
To allow a suspended process to unwind itself, create a new stack for the process
being terminated and resume the suspended process to complete its termination
from the new parallel stack. Use a semaphore to make the process that invoked
the termination wait for self's completion. Execute the termination in the ensure
argument block to ensure it completes even if the terminator process itself gets
+ terminated before it's finished; see testTerminateInTerminate and others."
- terminated before it's finished; see testTerminateInTerminate."
| context |
self isActiveProcess ifTrue: [
context := thisContext.
+ ^[[] ensure: [context unwindTo: nil]. self suspend] asContext jump].
- ^[context unwindTo: nil. self suspend] asContext jump].
[] ensure: [ | terminator |
self suspendAndReleaseCriticalSection.
context := suspendedContext ifNil: [^self].
terminator := Semaphore new.
+ context bottomContext insertSender: (Context contextEnsure: [terminator signal]).
+ self suspendedContext: [[] ensure: [context unwindTo: nil]. self suspend] asContext;
+ priority: Processor activePriority;
+ resume.
- suspendedContext := [context unwindTo: nil. terminator signal. self suspend] asContext.
- self priority: Processor activePriority; resume.
terminator wait]!
Marcel Taeumel uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-jar.1477.mcz
==================== Summary ====================
Name: Kernel-jar.1477
Author: jar
Time: 8 June 2022, 1:18:13.217988 pm
UUID: cde25b8e-8f6a-4241-8f6e-67a9ae27da68
Ancestors: Kernel-jar.1476
Setting suspendedContext may ruin your image; add checks to prevent such situations. Add examples and coments documenting disastrous situations.
Supersede Kernel-jar.1474.
Updated test will follow later.
=============== Diff against Kernel-jar.1476 ===============
Item was changed:
----- Method: Process>>suspendedContext: (in category 'private') -----
+ suspendedContext: aContextOrNil
+ "Set suspendedContext; proceed with caution when assigning nil or when process priority is undefined."
+
+ "Note: Assigning nil to a runnable but not active process would freeze the image when self is scheduled to run.
+
+ Workspace example:
+ These two lines (executed at once, not line by line)
+ p := [] newProcess resume.
+ p suspendedContext: nil
+ will freeze the image; the first line puts p in the run queue, the second line niles p's suspendedContext and
+ when the UI cycles, p tries to run with niled suspendedContext and the image freezes as a result.
+
+ Assigning 'suspendedContext' before 'priority' is defined may cause a disaster when Process Browser is open
+ with auto-update on; once the 'suspendedContext' is set, the new process is no longer considered terminated
+ and Process Browser will try to place it in its list of processes but encounters a nil error when reading its priority
+ because it has not been set yet.
+
+ Workspace example:
+ If you run the following line with Process Browser open and auto-update on, you'll ruin your image:
+ p := Process new suspendedContext: [self] asContext
+ Every second a new debugger window pops up and the only way out is to kill the image in the OS.
+
+ As a precautionary measure set 'priority' if undefined to the active process priority before setting
+ 'suspendedContext'."
- suspendedContext: aContext
- "Note: assigning nil to a runnable but not active process would freeze the image when self is scheduled to run."
+ priority ifNil: [priority := Processor activePriority].
+ suspendedContext := aContextOrNil ifNil: [self suspend. nil]!
- suspendedContext := aContext ifNil: [self suspend. nil]!
Marcel Taeumel uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-jar.1478.mcz
==================== Summary ====================
Name: Kernel-jar.1478
Author: jar
Time: 8 June 2022, 11:16:07.949882 pm
UUID: f5720d99-9ce2-374c-adb0-811c23b2cfe5
Ancestors: Kernel-jar.1477
Fix a bug in #runUntilReturnFrom:: while searching for a context that cannot return (to avoid the VM crash) I forgot to limit the search to the relevant part of the stack only (i.e. search only *between* the contexts to be executed). As a result the following example currently fails to unwind:
p := [[[^2] on: BlockCannotReturn do: [Semaphore new wait]] ensure: [Transcript show: 'been here ']] fork.
Processor yield.
[p terminate] fork
Plus a minor change to allow unwinding even in this case:
p := [[] ensure: [[[^2] on: BlockCannotReturn do: [Semaphore new wait]] ensure: [Transcript show: 'been here ']]] fork.
Processor yield.
[p terminate] fork
A test will follow later.
=============== Diff against Kernel-jar.1477 ===============
Item was changed:
----- Method: Context>>runUntilReturnFrom: (in category 'private-exceptions') -----
runUntilReturnFrom: aContext
"Run the receiver (which must be its stack top context) until aContext returns. Avoid a context that cannot return.
Note: to avoid infinite recursion of MNU error inside unwind blocks, implement e.g. a wrapper around the message
sentTo: receiver in #doesNotUnderstand:. Note: This method is a trivialized version of #runUntilErrorOrReturnFrom:
and was intended to be used by #unwindTo as a helper method to unwind non-local returns inside unwind blocks."
| here unwindBottom newTop |
here := thisContext.
+ "Avoid a context that cannot return between self and aContext (see Note 1 below)."
+ unwindBottom := self findContextSuchThat: [:ctx | ctx == aContext or: [ctx selector = #cannotReturn:]].
+ newTop := unwindBottom sender.
- "Avoid a context that cannot return (see Note 1 below)"
- unwindBottom := (self findContextSuchThat: [:ctx | ctx selector = #cannotReturn:]) ifNil: [aContext].
- newTop := aContext sender.
"Insert ensure context under unwindBottom in self's stack (see Note 2 below)"
unwindBottom insertSender: (Context contextEnsure: [here jump]).
self jump. "Control jumps to the receiver's stack (see Note 2 below)"
"Control resumes here once the above inserted ensure block is executed (see #jump comments)"
^newTop "Return the new top context (see Note 3 below)"
"Note 1: returning from #cannotReturn's sender would crash the VM so we install a guard ensure context right
above it; after returning here the unwind will continue safely. Try running and debugging this example
(avoid Proceeding the BCR error though; it may indeed crash the image):
[[[] ensure: [^2]] ensure: [^42]] fork"
"Note 2: the receiver (self) is run by jumping directly to it (the active process abandons thisContext and executes
self on its own stack; self must be its top context). However, before jumping to self we insert an ensure block under
unwindBottom context that will execute a jump back to thisContext when evaluated. The inserted guard ensure
context is removed once control jumps back to thisContext."
"Note 3: it doesn't matter newTop is not a proper stack top context because #unwindTo will only use it as a starting
point in the search for the next unwind context and the computation will never return here. We could make newTop
a proper top context by pushing nil to its stack (^newTop push: nil) if need be (see #jump comments).
Cf. the pattern in #runUntilErrorOrReturnFrom:: removing the inserted ensure context by stepping until popped
when executing non-local returns wouldn't work here and would fail tests testTerminateInNestedEnsureWithReturn1
through 4."!
Marcel Taeumel uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-jar.1500.mcz
==================== Summary ====================
Name: Kernel-jar.1500
Author: jar
Time: 2 February 2023, 10:04:57.541211 pm
UUID: 8add6e35-4849-624a-94f8-0722d7ef8c07
Ancestors: Kernel-tpr.1497
Fix #terminateAggressively and #runUntilErrorOrReturnFrom: bugs. Both bugs combined cause the Debugger MNU in this situation:
Run this in the Workspace:
p := [ [Semaphore new wait] ensure: [1/0] ] fork
Then terminate it like this:
[p terminate] fork
And then just press Abandon and get the MNU error.
=============== Diff against Kernel-tpr.1497 ===============
Item was changed:
----- Method: Context>>runUntilErrorOrReturnFrom: (in category 'controlling') -----
runUntilErrorOrReturnFrom: aSender
"ASSUMES aSender is a sender of self. Execute self's stack until aSender returns or an unhandled exception is raised. Return a pair containing the new top context and a possibly nil exception. The exception is not nil if it was raised before aSender returned and it was not handled. The exception is returned rather than openning the debugger, giving the caller the choice of how to handle it."
"Self is run by jumping directly to it (the active process abandons thisContext and executes self). However, before jumping to self we insert an ensure block under aSender that jumps back to thisContext when evaluated. We also insert an exception handler under aSender that jumps back to thisContext when an unhandled exception is raised. In either case, the inserted ensure and exception handler are removed once control jumps back to thisContext."
| error ctxt here topContext |
here := thisContext.
"Insert ensure and exception handler contexts under aSender"
error := nil.
ctxt := aSender insertSender: (Context
contextOn: UnhandledError do: [:ex |
error ifNil: [
error := ex exception.
topContext := thisContext.
ex resumeUnchecked: here jump]
ifNotNil: [ex pass]
]).
ctxt := ctxt insertSender: (Context
contextEnsure: [error ifNil: [
topContext := thisContext.
here jump]
]).
self jump. "Control jumps to self"
"Control resumes here once above ensure block or exception handler is executed"
^ error ifNil: [
"No error was raised, remove ensure context by stepping until popped"
+ [ctxt isDead or: [topContext isNil]] whileFalse: [topContext := topContext stepToCallee].
- [ctxt isDead] whileFalse: [topContext := topContext stepToCallee].
{topContext. nil}
] ifNotNil: [
"Error was raised, remove inserted above contexts then return signaler context"
aSender terminateTo: ctxt sender. "remove above ensure and handler contexts"
{topContext. error}
]!
Item was changed:
----- Method: Process>>terminateAggressively (in category 'changing process state') -----
terminateAggressively
"Stop the receiver forever.
Run all unwind contexts (#ensure:/#ifCurtailed: blocks) on the stack that have not yet been started. If the process is in the middle of an unwind block, then that unwind block will not be completed, but subsequent unwind blocks will be run. If even those unwind contexts should be continued, send #terminate instead.
Note that ill unwind contexts are theoretically able to stall the termination (for instance, by placing a non-local return in an unwind block); however, this is a disrecommended practice.
If the process is in the middle of a critical: critical section, release it properly."
| oldList bottom tombstone |
self isActiveProcess ifTrue: [
"If terminating the active process, suspend it first and terminate it as a suspended process."
[self terminate] fork.
^self suspend].
"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."
oldList := self suspend.
suspendedContext ifNil: [^ self "Process is already terminated"].
"Release any method marked with the <criticalSection> pragma. The argument is whether the process is runnable."
self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]).
bottom := suspendedContext bottomContext.
tombstone := bottom insertSender: [self suspend "terminated"] asContext.
suspendedContext := self
activateReturn: bottom
value: nil.
self complete: tombstone ifError: [:ex |
+ (suspendedContext ifNil: [^self]) privRefresh. "Restart the handler context of UnhandledError so that when the receiver is resumed, its #defaultAction will be reached. See implementation details in #runUntilErrorOrReturnFrom:."
- suspendedContext privRefresh. "Restart the handler context of UnhandledError so that when the receiver is resumed, its #defaultAction will be reached. See implementation details in #runUntilErrorOrReturnFrom:."
"We're not yet done, resume the receiver to spawn a new debugger on the error."
self resume].!
Marcel Taeumel uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-jar.1501.mcz
==================== Summary ====================
Name: Kernel-jar.1501
Author: jar
Time: 15 February 2023, 4:46:08.266577 pm
UUID: df3048fe-826b-cd40-a21b-de4b7d285390
Ancestors: Kernel-eem.1498
fix and improve:
#terminate
- fix multiple termination issue
- use a helper method to improve readability;
#suspendAndReleaseCriticalSection
- improve algorithm to fix failing Sema/Mutex tests
- replace conditionals with class based methods;
#unwindAndStop:
- fix a bug (missing fake return value before jump)
#unwindTo: safely:
- fix a bug (missing nil check)
Complemented by KernelTests-jar.443 (set of Sema/Mutex/Proc tests)
This changeset replaces Kernel-jar.1498 (#terminate etc) - please remove from Inbox
=============== Diff against Kernel-eem.1498 ===============
Item was added:
+ ----- Method: BlockClosure>>valueAndWaitWhileUnwinding: (in category 'private') -----
+ valueAndWaitWhileUnwinding: contextToUnwind
+ "A helper method for Process terminate. Evaluate the receiver and suspend
+ current process until argument's sender chain is unwound."
+
+ | semaphore newBottom |
+ contextToUnwind ifNil: [^self].
+ semaphore := Semaphore new.
+ newBottom := contextToUnwind class contextEnsure: [semaphore signal].
+ contextToUnwind bottomContext insertSender: newBottom.
+ self value: contextToUnwind.
+ semaphore wait!
Item was added:
+ ----- Method: Context>>unwindAndStop: (in category 'private') -----
+ unwindAndStop: aProcess
+ "A helper method to Process #terminate. Create and answer
+ a helper stack for a terminating process to unwind itself from.
+ Note: push a fake return value to create a proper top context."
+
+ ^(self class contextEnsure: [self unwindTo: nil])
+ privSender: [aProcess suspend] asContext;
+ push: nil
+ !
Item was changed:
----- Method: Context>>unwindTo:safely: (in category 'private-exceptions') -----
unwindTo: aContext safely: aBoolean
"Unwind self to aContext to execute pending #ensure:/#ifCurtailed: argument blocks between self
and aContext. If aBoolean is false, unwind only blocks that have not run yet, otherwise complete all
pending unwind blocks including those currently in the middle of their execution; these blocks will
just finish their execution. Run all unwinds on their original stack using #runUntilReturnFrom:."
| top ctx |
ctx := top := self.
aBoolean ifTrue: [
"If self is the top context of a stack already halfways through an unwind block, complete the outer-most
unfinished unwind block first; all nested pending unwind blocks will be completed in the process;
see testTerminationDuringUnwind and tests in ProcessTest/UnwindTest.
Note: Halfway-through blocks have already set the complete variable (ctxt tempAt: 2) in their
defining #ensure:/#ifCurtailed contexts from nil to true; we'll search for the bottom-most one."
| outerMost |
ctx isUnwindContext ifFalse: [ctx := ctx findNextUnwindContextUpTo: aContext].
[ctx isNil] whileFalse: [
(ctx tempAt: 2) ifNotNil: [
outerMost := ctx].
ctx := ctx findNextUnwindContextUpTo: aContext].
outerMost ifNotNil: [top := top runUntilReturnFrom: outerMost]].
"By now no halfway-through unwind blocks are on the stack.
Note: top points to the former outerMost sender now, i.e. to the next context to be explored."
ctx := top ifNil: [^self].
"#findNextUnwindContextUpTo: starts searching from the receiver's sender so we must check
the receiver explicitly whether it is an unwind context; see testTerminateEnsureAsStackTop.
Create a new top context (i.e. a new branch off the original stack) for each pending unwind block
(ctxt tempAt: 1) and execute it on the unwind block's stack to evaluate non-local returns correctly."
ctx isUnwindContext ifFalse: [ctx := ctx findNextUnwindContextUpTo: aContext].
[ctx isNil] whileFalse: [
(ctx tempAt: 2) ifNil: [
ctx tempAt: 2 put: true.
+ (ctx tempAt: 1) ifNotNil: [:unwindBlock |
+ top := unwindBlock asContextWithSender: ctx.
+ top runUntilReturnFrom: top]].
- top := (ctx tempAt: 1) asContextWithSender: ctx.
- top runUntilReturnFrom: top].
ctx := ctx findNextUnwindContextUpTo: aContext]
"Note: Cf. the unwind pattern in the previous versions of unwindTo: (1999-2021). Using #value
instead of #runUntilReturnFrom: lead to a failure to evaluate some non-local returns correctly;
a non-local return must be evaluated in the evaluation context (sender chain) in which it was defined."!
Item was added:
+ ----- Method: Mutex>>releaseCriticalSection: (in category 'private') -----
+ releaseCriticalSection: aContext
+ "A helper method for Process suspendAndReleaseCriticalSection.
+ If the terminating process is still blocked at the condition variable
+ of a critical section, skip the rest of the current context."
+
+ ^aContext pc: aContext endPC!
Item was added:
+ ----- Method: Mutex>>stepIntoCriticalSection: (in category 'private') -----
+ stepIntoCriticalSection: aContext
+ "A helper method for Process suspendAndReleaseCriticalSection.
+ If the terminating process still haven't made progress beyond the lock primitive
+ and the lock primitive just acquired ownership (indicated by it answering false)
+ then the ensure block has not been activated, so step into it."
+
+ ^(aContext stackPtr > 0 and: [aContext top == false])
+ ifTrue: [aContext stepToCallee]
+ ifFalse: [aContext]!
Item was changed:
----- Method: Process>>suspendAndReleaseCriticalSection (in category 'private') -----
suspendAndReleaseCriticalSection
"Figure out if we are terminating a process that is in the ensure: block of a critical section.
If it hasn't made progress but is beyond the wait (which we can tell by the oldList being
+ one of the runnable lists, i.e. a LinkedList, not a Semaphore or Mutex), then the ensure:
+ block needs to be run. Answer a context chain that needs to be unwound."
- one of the runnable lists, i.e. a LinkedList, not a Semaphore or Mutex, et al), then the ensure:
- block needs to be run."
+ "Note 1: suspend and unblock the receiver from a condition variable using the old suspend
+ primitive #88; it answers the list the receiver was on before the suspension.
+ Note 2: condition variables' classes implement the actual releasing depending on their
+ implementation of #critical:; see Semaphore or Mutex (or any future extension's)
+ #releaseCriticalSection: and #stepIntoCriticalSection: and the discussion here:
+ http://forum.world.st/Solving-termination-of-critical-sections-in-the-conte…"
- | oldList selectorJustSent |
- "Suspend and unblock the receiver from a condition variable using suspend primitive #88.
- It answers the list the receiver was on before the suspension."
- oldList := self suspendAndUnblock.
- (oldList isNil or: [oldList class == LinkedList]) ifFalse: [^self].
+ | oldList |
+ oldList := self suspendAndUnblock ifNil: [LinkedList new].
+ ^suspendedContext ifNotNil: [:context |
+ suspendedContext := nil.
+ (context method pragmaAt: #criticalSection)
+ ifNil: [context]
+ ifNotNil: [oldList releaseCriticalSection: context]]!
- ((suspendedContext ifNil: [^self]) method pragmaAt: #criticalSection) ifNil: [^self].
- selectorJustSent := suspendedContext selectorJustSentOrSelf.
-
- "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. Allow all pending unwind
+ blocks to run before terminating; if they are currently in progress, let them finish."
- terminate
- "Stop the process that the receiver represents forever.
- Unwind to execute pending #ensure:/#ifCurtailed: blocks before terminating;
- allow all unwind blocks to run; if they are currently in progress, let them finish."
+ "Note: This is the kind of behavior we expect when terminating a healthy process.
- "This is the kind of behavior we expect when terminating a healthy process.
See further comments in #terminateAggressively and #destroy methods dealing
with process termination when closing the debugger or after a catastrophic failure.
If terminating the active process, create a new stack and run unwinds from there.
If terminating a suspended process (including runnable and blocked), always
+ suspend the terminating process first so it doesn't accidentally get woken up,
+ and nil the suspended context to prevent accidental resumption or termination
+ while manipulating the suspended context.
+
- suspend the terminating process first so it doesn't accidentally get woken up.
Equally important is the side effect of the suspension: In 2022 a new suspend
semantics has been introduced: the revised #suspend backs up a process waiting
on a conditional variable to the send that invoked the wait state, while the previous
#suspend simply removed the process from the conditional variable's list it was
previously waiting on; see #suspend and #suspendAndUnblock comments.
+
+ If the process is blocked, waiting to access the #critical: section, release it properly.
-
- If the process is in the middle of a #critical: critical section, release it properly.
To allow a suspended process to unwind itself, create a new stack for the process
being terminated and resume the suspended process to complete its termination
+ from the new, parallel stack. Use a semaphore to make the process that invoked
- from the new parallel stack. Use a semaphore to make the process that invoked
the termination wait for self's completion. Execute the termination in the ensure
argument block to ensure it completes even if the terminator process itself gets
terminated before it's finished; see testTerminateInTerminate and others."
- | context |
self isActiveProcess ifTrue: [
+ ^(thisContext unwindAndStop: self) jump].
- context := thisContext.
- ^[[] ensure: [context unwindTo: nil]. self suspend] asContext jump].
+ [] ensure: [
+ [:contextToUnwind |
+ self
- [] ensure: [ | terminator |
- self suspendAndReleaseCriticalSection.
- context := suspendedContext ifNil: [^self].
- terminator := Semaphore new.
- context bottomContext insertSender: (Context contextEnsure: [terminator signal]).
- self suspendedContext: [[] ensure: [context unwindTo: nil]. self suspend] asContext;
priority: Processor activePriority;
+ suspendedContext: (contextToUnwind unwindAndStop: self);
+ resume
+ ] valueAndWaitWhileUnwinding: self suspendAndReleaseCriticalSection
+ ]!
- resume.
- terminator wait]!
Item was added:
+ ----- Method: Semaphore>>releaseCriticalSection: (in category 'private') -----
+ releaseCriticalSection: aContext
+ "A helper method for Process suspendAndReleaseCriticalSection.
+ If the terminating process is still blocked at the condition variable
+ of a critical section, skip the rest of the current context."
+
+ ^aContext pc: aContext endPC!
Item was added:
+ ----- Method: Semaphore>>stepIntoCriticalSection: (in category 'private') -----
+ stepIntoCriticalSection: aContext
+ "A helper method for Process suspendAndReleaseCriticalSection.
+ If the terminating process still haven't made progress beyond the wait
+ then the ensure block has not been activated, so step into it."
+
+ ^aContext stepToCallee!