Marcel Taeumel uploaded a new version of Kernel to project The Treated Inbox:
http://source.squeak.org/treated/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 Treated Inbox:
http://source.squeak.org/treated/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 Treated Inbox:
http://source.squeak.org/treated/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 Treated Inbox:
http://source.squeak.org/treated/Kernel-jar.1471.mcz
==================== Summary ====================
Name: Kernel-jar.1471
Author: jar
Time: 30 May 2022, 5:49:42.34119 pm
UUID: 506f7d06-a1a5-8b41-a85b-2fc8b6ae1aef
Ancestors: Kernel-jar.1470
cleanup and add a check for nil value for borderline situations (ensure as a bottom context or two ensure context above each other)
=============== Diff against Kernel-jar.1470 ===============
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
- "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: [
- (ctx tempAt:2) ifNotNil: [
outerMost := ctx].
ctx := ctx findNextUnwindContextUpTo: aContext].
+ outerMost ifNotNil: [top := top runUntilReturnFrom: outerMost]].
- 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 ifNil: [^self].
- 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."!
Marcel Taeumel uploaded a new version of Kernel to project The Treated Inbox:
http://source.squeak.org/treated/Kernel-jar.1447.mcz
==================== Summary ====================
Name: Kernel-jar.1447
Author: jar
Time: 22 February 2022, 8:18:05.479858 pm
UUID: 3772b6a0-c6ab-634c-97bb-a82bda2ecb6a
Ancestors: Kernel-eem.1444
#terminate - latest version working independently of the revised suspend semantics in the latest VMs; structured similarly as original versions of #terminate in Squeak 1.x thru 3.5
supersede Kernel-jar.1443; please remove Kernel-jar.1443, Kernel-jar.1442, Kernel-jar.1437, Kernel-jar.1436, Kernel-jar.1435, Kernel-jar.1426
=============== Diff against Kernel-eem.1444 ===============
Item was added:
+ ----- Method: Context>>releaseCriticalSection: (in category 'private') -----
+ releaseCriticalSection: oldList
+ "Figure out if we are terminating a process that is in the ensure: block of a critical section.
+ In this case, 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."
+
+ | selectorJustSent |
+ (self method pragmaAt: #criticalSection) ifNil: [^self].
+ (oldList isNil or: [oldList class == LinkedList]) ifFalse: [^self].
+ selectorJustSent := self selectorJustSentOrSelf.
+
+ "If still at the wait the ensure: block has not been activated, so signal to restore."
+ selectorJustSent == #wait ifTrue:
+ [self 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 run primitiveExitCriticalSection to unlock."
+ (selectorJustSent == #primitiveEnterCriticalSection
+ or: [selectorJustSent == #primitiveTestAndSetOwnershipOfCriticalSection]) ifTrue:
+ [(self stackPtr > 0
+ and: [self top == false]) ifTrue:
+ [self receiver primitiveExitCriticalSection]]!
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. "see the note below"
+ 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: 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.
+ Release any method marked with the <criticalSection> pragma via #releaseCriticalSection[:].
+ Execute 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: [ | oldList |
+ oldList := myList.
+ self suspend.
+ context := suspendedContext ifNil: [^self].
+ suspendedContext := [
+ context releaseCriticalSection: oldList; 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 Treated Inbox:
http://source.squeak.org/treated/Kernel-jar.1421.mcz
==================== Summary ====================
Name: Kernel-jar.1421
Author: jar
Time: 15 November 2021, 2:01:40.493442 am
UUID: a0158f6a-ffeb-4946-bd0a-25ac6b1947d5
Ancestors: Kernel-eem.1420
Fix a bug: when debugging things like this:
[^2] ensure: [Transcript cr; show: 'done']
if we step into the protected block [^2] and then step over ^2, we incorrectly get a lockCannotReturn. The bug is described in detail in Kernel-nice.1407 and discussed in http://forum.world.st/stepping-over-non-local-return-in-a-protected-block-t…
Add a flag and an explanatory comment.
Supersedes Kernel-jar.1413; please kindly remove from the Inbox
=============== Diff against Kernel-eem.1420 ===============
Item was changed:
----- Method: Context>>resume:through: (in category 'controlling') -----
resume: value through: firstUnwindCtxt
"Unwind thisContext to self and resume with value as result of last send.
Execute any unwind blocks while unwinding.
ASSUMES self is a sender of thisContext."
| ctxt unwindBlock |
+ self flag: #simulator. "jar: see Note below"
self isDead ifTrue: [self cannotReturn: value to: self].
+ ctxt := firstUnwindCtxt ifNil: [thisContext findNextUnwindContextUpTo: self].
- ctxt := firstUnwindCtxt.
[ctxt isNil] whileFalse:
[(ctxt tempAt: 2) ifNil:
[ctxt tempAt: 2 put: true.
unwindBlock := ctxt tempAt: 1.
thisContext terminateTo: ctxt.
unwindBlock value].
ctxt := ctxt findNextUnwindContextUpTo: self].
thisContext terminateTo: self.
^value
+
+ "Note (11/2021): when debugging things like this:
+ [^2] ensure: [Transcript cr; show: 'done']
+ if we step into the protected block [^2] and then step over ^2, we incorrectly get a BlockCannotReturn.
+ To avoid this bug, a close interplay between #return:from: and #resume:through: has been established:
+ During simulation, #return:from: passes firstUnwindCtxt = nil to #aboutToReturn:through: which then
+ propagates to resume:through: and causes a fresh search for the first unwind context. The matter has
+ been discussed in http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-August/216214.h…"!
- !
Item was changed:
----- Method: Context>>return:from: (in category 'instruction decoding') -----
return: value from: aSender
"For simulation. Roll back self to aSender and return value from it. Execute any unwind blocks on the way. ASSUMES aSender is a sender of self"
| newTop |
+ self flag: #simulator. "jar: see Note below"
aSender isDead ifTrue:
[^self send: #cannotReturn: to: self with: {value}].
newTop := aSender sender.
(self findNextUnwindContextUpTo: newTop) ifNotNil:
+ [^self send: #aboutToReturn:through: to: self with: {value. nil}].
- [:unwindProtectCtxt|
- ^self send: #aboutToReturn:through: to: self with: {value. unwindProtectCtxt}].
self releaseTo: newTop.
newTop ifNotNil: [newTop push: value].
+ ^newTop
+
+ "Note (11/2021): when debugging things like this:
+ [^2] ensure: [Transcript cr; show: 'done']
+ if we step into the protected block [^2] and then step over ^2, we incorrectly get a BlockCannotReturn.
+ To avoid this bug, a close interplay between #return:from: and #resume:through: has been established:
+ During simulation, #return:from: passes firstUnwindCtxt = nil to #aboutToReturn:through: which then
+ propagates to resume:through: and causes a fresh search for the first unwind context. The matter has
+ been discussed in http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-August/216214.h…"!
- ^newTop!
Marcel Taeumel uploaded a new version of Kernel to project The Treated Inbox:
http://source.squeak.org/treated/Kernel-jar.1415.mcz
==================== Summary ====================
Name: Kernel-jar.1415
Author: jar
Time: 20 November 2021, 12:22:39.046144 pm
UUID: 2058b1fd-425a-fa46-a2e0-297d1bfab952
Ancestors: Kernel-jar.1414
Fix a bug: when debugging things like this:
[^2] ensure: [Transcript cr; show: 'done']
if we step into the protected block [^2] and then step over ^2, we incorrectly get a BlockCannotReturn error.
This is an alternative proposal to Kernel-jar.1421 (and Kernel-jar.1413); the solution remains the same but it attempts to present a cleaner code (trying to address Christoph's objection in [2] and [3]).
The bug is described in detail in Kernel-nice.1407 and discussed in [1] and most recently in [2] and [3]:
[1] http://forum.world.st/stepping-over-non-local-return-in-a-protected-block-t…
[2] http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-August/216214.h…
[3] http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-November/216971…
=============== Diff against Kernel-jar.1414 ===============
Item was changed:
----- Method: Context>>resume:through: (in category 'controlling') -----
resume: value through: firstUnwindCtxt
"Unwind thisContext to self and resume with value as result of last send.
Execute any unwind blocks while unwinding.
ASSUMES self is a sender of thisContext."
| ctxt unwindBlock |
self isDead ifTrue: [self cannotReturn: value to: self].
+ ctxt := firstUnwindCtxt value. "evaluate in case firstUnwindCtxt is a block (used in simulation)"
- ctxt := firstUnwindCtxt ifNil: [thisContext findNextUnwindContextUpTo: self].
[ctxt isNil] whileFalse:
[(ctxt tempAt: 2) ifNil:
[ctxt tempAt: 2 put: true.
unwindBlock := ctxt tempAt: 1.
thisContext terminateTo: ctxt.
unwindBlock value].
ctxt := ctxt findNextUnwindContextUpTo: self].
thisContext terminateTo: self.
^value
!
Item was changed:
----- Method: Context>>return:from: (in category 'instruction decoding') -----
return: value from: aSender
"For simulation. Roll back self to aSender and return value from it. Execute any unwind blocks on the way. ASSUMES aSender is a sender of self"
| newTop |
aSender isDead ifTrue:
[^self send: #cannotReturn: to: self with: {value}].
newTop := aSender sender.
(self findNextUnwindContextUpTo: newTop) ifNotNil:
+ [^self send: #aboutToReturn:through: to: self with: {value. [thisContext findNextUnwindContextUpTo: newTop]}].
- [^self send: #aboutToReturn:through: to: self with: {value. nil}].
self releaseTo: newTop.
newTop ifNotNil: [newTop push: value].
^newTop!
Marcel Taeumel uploaded a new version of Kernel to project The Treated Inbox:
http://source.squeak.org/treated/Kernel-jar.1399.mcz
==================== Summary ====================
Name: Kernel-jar.1399
Author: jar
Time: 2 May 2021, 3:12:37.830089 pm
UUID: d288b516-c6f1-ce43-9061-2220422b8ab4
Ancestors: Kernel-jar.1398
Fix inconsistent implementation of an explicit and an implicit exception return.
I'd like to return to my original proposal in http://forum.world.st/The-Inbox-Kernel-nice-1391-mcz-tp5129040p5129084.html. The problem then was a bug in #outer that confused me. The bug has been fixed and the original proposal in my opinion makes sense again - to unify how the two kinds of exception return are implemented. Theoretically it's possible to change the #return definition in the future and then the two returns would diverge.
=============== Diff against Kernel-jar.1398 ===============
Item was changed:
----- Method: Context>>handleSignal: (in category 'private-exceptions') -----
handleSignal: exception
"Sent to handler (on:do:) contexts only.
Execute the handler action block"
| val |
<primitive: 199> "just a marker, fail and execute the following"
exception privHandlerContext: self contextTag.
self deactivateHandler. "Prevent re-entering the action block, unless it is explicitely rearmed"
val := [self fireHandlerActionForSignal: exception] ensure: [self reactivateHandler].
+ exception return: val "return from exception handlerContext if not otherwise directed in handle block"!
- self return: val "return from self if not otherwise directed in handle block"!
Marcel Taeumel uploaded a new version of Kernel to project The Treated Inbox:
http://source.squeak.org/treated/Kernel-jar.1487.mcz
==================== Summary ====================
Name: Kernel-jar.1487
Author: jar
Time: 11 July 2022, 3:00:32.776972 pm
UUID: 729cdb60-4feb-0a42-b966-3cb2f9b5c338
Ancestors: Kernel-eem.1486
Add a stronger guard to deal with concurrent terminations.
The current weakness showed in this Workspace example:
p1 := [Smalltalk installLowSpaceWatcher] fork.
p2 := [Smalltalk installLowSpaceWatcher] fork
Instead of terminating both LowSpaceProcesses and unblocking p1 and p2, one of them gets stuck on a semaphore.
Complemented with KernelTests-jar.437 with a modified test (testTerminateTerminatingProcessInUnwindTo) to cover this situation.
=============== Diff against Kernel-eem.1486 ===============
Item was added:
+ ----- Method: Context>>unwindAndStop: (in category 'private') -----
+ unwindAndStop: aProcess
+ "I'm a helper method to #terminate; I create and answer
+ a helper stack for a terminating process to unwind itself from."
+
+ ^(Context contextEnsure: [self unwindTo: nil])
+ privSender: [aProcess suspend] asContext
+ !
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."
- | context |
self isActiveProcess ifTrue: [
+ ^(thisContext unwindAndStop: self) jump].
- context := thisContext.
- ^[[] ensure: [context unwindTo: nil]. self suspend] asContext jump].
[] ensure: [ | terminator |
self suspendAndReleaseCriticalSection.
+ suspendedContext ifNil: [^self].
- context := suspendedContext ifNil: [^self].
terminator := Semaphore new.
+ suspendedContext bottomContext insertSender: (Context contextEnsure: [terminator signal]).
+ self suspendedContext: (suspendedContext unwindAndStop: self);
- context bottomContext insertSender: (Context contextEnsure: [terminator signal]).
- self suspendedContext: [[] ensure: [context unwindTo: nil]. self suspend] asContext;
priority: Processor activePriority;
resume.
terminator wait]!