Christoph Thiede uploaded a new version of Kernel to project The Treated Inbox:
http://source.squeak.org/treated/Kernel-jar.1426.mcz
==================== Summary ====================
Name: Kernel-jar.1426
Author: jar
Time: 27 November 2021, 9:15:00.59036 pm
UUID: 25d09f11-f641-a14f-8942-161f54fce41a
Ancestors: Kernel-ct.1425
Final version of #teminate solving all bugs reported in [1] and allowing the 'block cannot return issue' [2] and 'infinite recursion in doesNotUnderstand:' [3] to be dealt with independently.
Most recently discussed at http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-November/217194…
Please remove Kernel-jar.1414 from the Inbox.
Complementing tests:
KernelTests-jar.406 (Terminator test)
KernelTests-jar.407 (McClure test)
Tests-jar.466 (unwind tests)
ToolsTests-jar.105 (debugger tests)
[1] http://forum.world.st/Solving-multiple-termination-bugs-summary-amp-proposa…
[2] http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-May/215526.html
[3] http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-November/217031…
=============== Diff against Kernel-ct.1425 ===============
Item was added:
+ ----- Method: Context>>runUnwindUntilErrorOrReturnFrom: (in category 'private') -----
+ runUnwindUntilErrorOrReturnFrom: 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.
+ here jump.
+ ex signalerContext restart "re-signal the exception when jumped back"]
+ 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, return the sender of the above ensure context (see note below)"
+ {ctxt sender. 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}
+ ]
+
+ "Note: It doesn't matter 'ctxt sender' is not a proper top context because #terminate will use it only as a starting point in the search for the next unwind context and computation will never return here. Removing the inserted ensure context (i.e. ctxt) by stepping until popped (as in #runUntilErrorOrReturnFrom:) when executing non-local returns is not applicable here and would fail testTerminationDuringNestedUnwindWithReturn1 through 4."!
Item was added:
+ ----- Method: Process>>complete:to: (in category 'private') -----
+ complete: topContext to: aContext
+ "Run topContext on behalf of self on topContext's stack until aContext is popped or an unhandled
+ error is raised. Return self's new top context. Note: topContext must be a stack top context.
+ This method is meant to be called primarily by Process>>#terminate."
+
+ | pair top error |
+ "avoid a block that cannot return"
+ (topContext stackPtr >= 2
+ and: [(topContext tempAt: 2) isContext
+ and: [(topContext tempAt: 2) selector = #cannotReturn:to:]]) ifTrue: [^aContext].
+ pair := Processor activeProcess
+ evaluate: [topContext runUnwindUntilErrorOrReturnFrom: aContext]
+ onBehalfOf: self.
+ top := pair first.
+ error := pair second.
+ "if an error was detected jump back to the debugged process to re-signal the error"
+ error ifNotNil: [top jump].
+ ^top
+
+ "Note: to avoid infinite recursion of MNU error: e.g. a wrapper around the message sentTo: receiver in #doesNotUnderstand: should be implemented."!
Item was changed:
----- Method: Process>>terminate (in category 'changing process state') -----
terminate
"Stop the process that the receiver represents forever.
Unwind to execute pending ensure:/ifCurtailed: blocks before terminating.
If the process is in the middle of a critical: critical section, release it properly."
+ | oldList top ctxt outerMost newTop unwindBlock |
+ "If terminating the active process, suspend it first and terminate it as a suspended process."
- | ctxt unwindBlock oldList outerMost |
self isActiveProcess ifTrue: [
- "If terminating the active process, suspend it first and terminate it as a suspended process."
[self terminate] fork.
^self suspend].
+ [] ensure: ["Execute termination as an unwind block to ensure it completes even if terminated;
+ see testTerminateInTerminate."
+ "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 ifNil: [^self]. "self 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]).
- "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]).
+ top := suspendedContext.
+ suspendedContext := nil. "disable this process while running its stack in active process below"
"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; nested
+ unwind blocks will be completed in the process (see testTerminationDuringUnwind, testNestedUnwind).
+ Note: Halfway-through blocks have already set the complete variable (tempAt: 2) in their defining
+ #ensure:/#ifCurtailed contexts from nil to true; we'll search for the bottom-most one.
+ Note: #findNextUnwindContextUpTo: starts searching from the receiver's sender but the receiver
+ itself may be an unwind context (see testTerminateEnsureAsTopContext)."
+ ctxt := top.
+ ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil].
+ [ctxt isNil] whileFalse: [
+ (ctxt tempAt:2) ifNotNil: [
+ outerMost := ctxt].
+ ctxt := ctxt findNextUnwindContextUpTo: nil].
+ outerMost ifNotNil: [newTop := self complete: top to: outerMost].
- 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]]].
+ "By now no halfway-through unwind blocks are on the stack. Create a new top context for each
+ pending unwind block (tempAt: 1) and execute it on the unwind block's stack.
+ Note: using #value instead of #complete:to: would lead to incorrect evaluation of non-local returns.
+ Note: newTop sender points to the former outerMost sender, i.e. the next unexplored context."
+ ctxt := newTop ifNil: [top] ifNotNil: [newTop sender].
- "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.
+ top := unwindBlock asContextWithSender: ctxt.
+ self complete: top to: top].
+ ctxt := ctxt findNextUnwindContextUpTo: nil]
+ ]!
- "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]!
Christoph Thiede uploaded a new version of Kernel to project The Treated Inbox:
http://source.squeak.org/treated/Kernel-jar.1435.mcz
==================== Summary ====================
Name: Kernel-jar.1435
Author: jar
Time: 12 December 2021, 3:46:52.56578 pm
UUID: d1b691a1-130c-174d-801d-245ecc5b7176
Ancestors: Kernel-jar.1434
This is an improved version of Kernel-jar.1434 (new #terminate) fixing some deficiencies when the BCR error is debugged; try the following example:
[[[] ensure: [^2]] ensure: [^42]] fork
now you can debug this example whichever way you like now without crashing the image (of course except pressing Proceed). #terminate will correctly unwind even the ensure block inside Debugger class>>openOn:context:... previously skipped when abandoning the debugger.
Please review. I appreciate your time :)
Thanks,
Jaromir
PS: please remove Kernel-jar.1434 from the Inbox
=============== Diff against Kernel-jar.1434 ===============
Item was changed:
----- Method: Context>>runUnwindTo:onBehalfOf: (in category 'private') -----
runUnwindTo: aContext onBehalfOf: aProcess
+ "Run self on behalf of aProcess on aProcess's (i.e. self's) stack until aContext returns. Avoid a context that cannot return. Note: self must be a stack top context. Note: to avoid infinite recursion of MNU error: e.g. a wrapper around the message sentTo: receiver in #doesNotUnderstand: must be implemented.
+ This method is meant to be used exclusively by Process>>#terminate."
- "Run self on behalf of aProcess on aProcess's (i.e. self's) stack until aContext returns. Avoid a block that cannot return.
- This method is meant to be used primarily by Process>>#terminate.
- Note: self must be a stack top context.
- Note: to avoid infinite recursion of MNU error: e.g. a wrapper around the message sentTo: receiver in #doesNotUnderstand: must be implemented."
- (self stackPtr >= 2 "Avoid a block that cannot return"
- and: [(self tempAt: 2) isContext
- and: [(self tempAt: 2) selector = #cannotReturn:to:]]) ifTrue: [^aContext].
Processor activeProcess
evaluate: [
+ | here unwindBottom newTop |
- | ctxt here |
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 self (see Note 2 below)"
- "Insert ensure context under aContext in aProcess's stack"
- ctxt := aContext insertSender: (Context contextEnsure: [here jump]).
- self jump. "Control jumps to self (see Note below)"
"Control resumes here once the above inserted ensure block is executed"
+ ^newTop ] "Return the new top context (see Note 3 below)"
- ^ctxt sender]
onBehalfOf: aProcess
- "Return the new top context; note that it doesn't matter 'ctxt sender' is not a proper stack top context because #terminate will use it only as a starting point in the search for the next unwind context and the computation will never return here. Note: cf. the pattern in #runUntilErrorOrReturnFrom:: removing the inserted ensure context (i.e. ctxt) by stepping until popped when executing non-local returns is not applicable here and would fail the tests testTerminationDuringNestedUnwindWithReturn1 through 4."
+ "Note 1: returning from #cannotReturn's sender would crash the VM so we install a guard ensure context right above it and after returning to #terminate the unwind will continue safely. Try running and debugging this example (avoid Proceeding the BCR error though; it would indeed crash the image):
+ [[[] ensure: [^2]] ensure: [^42]] fork"
+ "Note 2: self is run by jumping directly to it (the active process abandons thisContext and executes self on aProcess's stack; self is its top context). However, before jumping to self we insert an ensure block under unwindBottom context that jumps 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 #terminate will use it only as a starting point in the search for the next unwind context and the computation will never return here. Cf. the pattern in #runUntilErrorOrReturnFrom:: removing the inserted ensure context by stepping until popped when executing non-local returns is not applicable here and would fail the tests testTerminationDuringNestedUnwindWithReturn1 through 4."
+
+ !
- "Note: 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 aContext that jumps back to thisContext when evaluated. The inserted ensure context is removed once control jumps back to thisContext."!
Item was changed:
----- Method: Process>>terminate (in category 'changing process state') -----
terminate
"Stop the process that the receiver represents forever.
Unwind to execute pending ensure:/ifCurtailed: blocks before terminating.
If the process is in the middle of a #critical: critical section, release it properly."
| oldList top ctxt outerMost newTop unwindBlock |
"If terminating the active process, suspend it first and terminate it as a suspended process."
self isActiveProcess ifTrue: [
[self terminate] fork.
^self suspend].
[] ensure: ["Execute termination as an ensure block to ensure it completes even if terminated
before the termination is finished; see testTerminateInTerminate."
"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 ifNil: [^self]. "self 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]).
top := suspendedContext.
suspendedContext := nil. "Disable terminating process while running its stack in active process below"
"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; nested unwind
+ blocks will be completed in the process; see testTerminationDuringUnwind, testNestedUnwind.
- if there are multiple such nested unwind blocks, try to complete the outer-most one; nested
- unwind blocks will be completed in the process; see testTerminationDuringUnwind, testNestedUnwind.
Note: Halfway-through blocks have already set the complete variable (tempAt: 2) in their defining
#ensure:/#ifCurtailed contexts from nil to true; we'll search for the bottom-most one.
Note: #findNextUnwindContextUpTo: starts searching from the receiver's sender but the receiver
itself may be an unwind context (see testTerminateEnsureAsTopContext)."
ctxt := top.
ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil].
[ctxt isNil] whileFalse: [
(ctxt tempAt:2) ifNotNil: [
outerMost := ctxt].
ctxt := ctxt findNextUnwindContextUpTo: nil].
outerMost ifNotNil: [newTop := top runUnwindTo: outerMost onBehalfOf: self].
"By now no halfway-through unwind blocks are on the stack. Create a new top context for each
pending unwind block (tempAt: 1) and execute it on the unwind block's stack on behalf of self, i.e.
+ the process being terminated, to preserve process identity; see testProcessFaithfulTermination.
- the process being terminated to preserve process identity; see testProcessFaithfulTermination.
Cf. the unwind pattern in #resume:through:: using #value instead of #runUnwindTo:onBehalfOf:
+ would lead to an incorrect evaluation of non-local returns on the wrong stack (active process's).
- would lead to an incorrect evaluation of non-local returns.
Note: newTop sender points to the former outerMost sender, i.e. the next unexplored context."
ctxt := newTop ifNil: [top] ifNotNil: [newTop sender].
ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil].
[ctxt isNil] whileFalse: [
(ctxt tempAt: 2) ifNil: [
ctxt tempAt: 2 put: true.
unwindBlock := ctxt tempAt: 1.
top := unwindBlock asContextWithSender: ctxt.
top runUnwindTo: top onBehalfOf: self].
ctxt := ctxt findNextUnwindContextUpTo: nil]
]!
Christoph Thiede uploaded a new version of Kernel to project The Treated Inbox:
http://source.squeak.org/treated/Kernel-jar.1436.mcz
==================== Summary ====================
Name: Kernel-jar.1436
Author: jar
Time: 17 December 2021, 1:21:58.879151 pm
UUID: 5d25417f-02b8-3343-9243-5001d28893c3
Ancestors: Kernel-jar.1435
This is an improved version of Kernel-jar.1435 (new #terminate) preventing multiple termination and/or resuming of a terminating process described in
http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217695…
and mentioned in
http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217679…
Also improved references to the relevant tests in the comments
Complemented by KernelTests-jar.417
=============== Diff against Kernel-jar.1434 ===============
Item was added:
+ ----- Method: Context>>releaseCriticalSection: (in category 'private') -----
+ releaseCriticalSection: runnable
+ "Figure out if we are terminating a process that is in the ensure: block of a critical section.
+ In this case, if the block has made progress, pop the suspendedContext so that we leave the
+ ensure: block inside the critical: without signaling the semaphore/exiting the primitive section,
+ since presumably this has already happened. But if it hasn't made progress but is beyond the
+ wait (which we can tell 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 suspendedContext |
+ suspendedContext := self.
+ (suspendedContext method pragmaAt: #criticalSection) ifNil: [^self].
+ selectorJustSent := suspendedContext selectorJustSentOrSelf.
+
+ "Receiver and/or argument blocks of ensure: in Semaphore>>critical: or Mutex>>#critical:"
+ suspendedContext isClosureContext ifTrue:
+ [suspendedContext sender isUnwindContext ifTrue:
+ [| notWaitingButMadeNoProgress |
+ "Avoid running the ensure: block twice, popping it if it has already been run. If runnable
+ but at the wait, leave it in place. N.B. No need to check if the block receiver of ensure: has
+ not started to run (via suspendedContext pc = suspendedContext startpc) because ensure:
+ uses valueNoContextSwitch, and so there is no suspension point before the wait."
+ notWaitingButMadeNoProgress :=
+ runnable
+ and: [selectorJustSent == #wait
+ and: [suspendedContext sender selectorJustSentOrSelf == #valueNoContextSwitch]].
+ notWaitingButMadeNoProgress ifFalse:
+ [suspendedContext := suspendedContext home]].
+ ^suspendedContext].
+
+ "Either Semaphore>>critical: or Mutex>>#critical:. Is the process still blocked? If so, nothing further to do."
+ runnable ifFalse: [^self].
+
+ "If still at the wait the ensure: block has not been activated, so signal to restore."
+ selectorJustSent == #wait ifTrue:
+ [suspendedContext receiver signal].
+
+ "If still at the lock primitive and the lock primitive just acquired ownership (indicated by it answering false)
+ then the ensure block has not been activated, so explicitly primitiveExitCriticalSection to unlock."
+ (selectorJustSent == #primitiveEnterCriticalSection
+ or: [selectorJustSent == #primitiveTestAndSetOwnershipOfCriticalSection]) ifTrue:
+ [(suspendedContext stackPtr > 0
+ and: [suspendedContext top == false]) ifTrue:
+ [suspendedContext receiver primitiveExitCriticalSection]]
+ !
Item was changed:
----- Method: Context>>runUnwindTo:onBehalfOf: (in category 'private') -----
runUnwindTo: aContext onBehalfOf: aProcess
+ "Run self on behalf of aProcess on aProcess's (i.e. self's) stack until aContext returns. Avoid a context that cannot return. Note: self must be a stack top context. Note: to avoid infinite recursion of MNU error: e.g. a wrapper around the message sentTo: receiver in #doesNotUnderstand: must be implemented.
+ This method is meant to be used exclusively by Process>>#terminate."
- "Run self on behalf of aProcess on aProcess's (i.e. self's) stack until aContext returns. Avoid a block that cannot return.
- This method is meant to be used primarily by Process>>#terminate.
- Note: self must be a stack top context.
- Note: to avoid infinite recursion of MNU error: e.g. a wrapper around the message sentTo: receiver in #doesNotUnderstand: must be implemented."
- (self stackPtr >= 2 "Avoid a block that cannot return"
- and: [(self tempAt: 2) isContext
- and: [(self tempAt: 2) selector = #cannotReturn:to:]]) ifTrue: [^aContext].
Processor activeProcess
evaluate: [
+ | here unwindBottom newTop |
- | ctxt here |
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 self (see Note 2 below)"
- "Insert ensure context under aContext in aProcess's stack"
- ctxt := aContext insertSender: (Context contextEnsure: [here jump]).
- self jump. "Control jumps to self (see Note below)"
"Control resumes here once the above inserted ensure block is executed"
+ ^newTop ] "Return the new top context (see Note 3 below)"
- ^ctxt sender]
onBehalfOf: aProcess
- "Return the new top context; note that it doesn't matter 'ctxt sender' is not a proper stack top context because #terminate will use it only as a starting point in the search for the next unwind context and the computation will never return here. Note: cf. the pattern in #runUntilErrorOrReturnFrom:: removing the inserted ensure context (i.e. ctxt) by stepping until popped when executing non-local returns is not applicable here and would fail the tests testTerminationDuringNestedUnwindWithReturn1 through 4."
+ "Note 1: returning from #cannotReturn's sender would crash the VM so we install a guard ensure context right above it and after returning to #terminate the unwind will continue safely. Try running and debugging this example (avoid Proceeding the BCR error though; it would indeed crash the image):
+ [[[] ensure: [^2]] ensure: [^42]] fork"
+ "Note 2: self is run by jumping directly to it (the active process abandons thisContext and executes self on aProcess's stack; self is its top context). However, before jumping to self we insert an ensure block under unwindBottom context that jumps 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 #terminate will use it only as a starting point in the search for the next unwind context and the computation will never return here. Cf. the pattern in #runUntilErrorOrReturnFrom:: removing the inserted ensure context by stepping until popped when executing non-local returns is not applicable here and would fail tests testTerminateInNestedEnsureWithReturn1 through 4."
+
+ !
- "Note: 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 aContext that jumps back to thisContext when evaluated. The inserted ensure context is removed once control jumps back to thisContext."!
Item was removed:
- ----- Method: Process>>releaseCriticalSection: (in category 'private') -----
- releaseCriticalSection: runnable
- "Figure out if we are terminating a process that is in the ensure: block of a critical section.
- In this case, if the block has made progress, pop the suspendedContext so that we leave the
- ensure: block inside the critical: without signaling the semaphore/exiting the primitive section,
- since presumably this has already happened. But if it hasn't made progress but is beyond the
- wait (which we can tell 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 |
- (suspendedContext method pragmaAt: #criticalSection) ifNil: [^self].
- selectorJustSent := suspendedContext selectorJustSentOrSelf.
-
- "Receiver and/or argument blocks of ensure: in Semaphore>>critical: or Mutex>>#critical:"
- suspendedContext isClosureContext ifTrue:
- [suspendedContext sender isUnwindContext ifTrue:
- [| notWaitingButMadeNoProgress |
- "Avoid running the ensure: block twice, popping it if it has already been run. If runnable
- but at the wait, leave it in place. N.B. No need to check if the block receiver of ensure: has
- not started to run (via suspendedContext pc = suspendedContext startpc) because ensure:
- uses valueNoContextSwitch, and so there is no suspension point before the wait."
- notWaitingButMadeNoProgress :=
- runnable
- and: [selectorJustSent == #wait
- and: [suspendedContext sender selectorJustSentOrSelf == #valueNoContextSwitch]].
- notWaitingButMadeNoProgress ifFalse:
- [suspendedContext := suspendedContext home]].
- ^self].
-
- "Either Semaphore>>critical: or Mutex>>#critical:. Is the process still blocked? If so, nothing further to do."
- runnable ifFalse: [^self].
-
- "If still at the wait the ensure: block has not been activated, so signal to restore."
- selectorJustSent == #wait ifTrue:
- [suspendedContext receiver signal].
-
- "If still at the lock primitive and the lock primitive just acquired ownership (indicated by it answering false)
- then the ensure block has not been activated, so explicitly primitiveExitCriticalSection to unlock."
- (selectorJustSent == #primitiveEnterCriticalSection
- or: [selectorJustSent == #primitiveTestAndSetOwnershipOfCriticalSection]) ifTrue:
- [(suspendedContext stackPtr > 0
- and: [suspendedContext top == false]) ifTrue:
- [suspendedContext receiver primitiveExitCriticalSection]]!
Item was changed:
----- Method: Process>>terminate (in category 'changing process state') -----
terminate
"Stop the process that the receiver represents forever.
Unwind to execute pending ensure:/ifCurtailed: blocks before terminating.
If the process is in the middle of a #critical: critical section, release it properly."
| oldList top ctxt outerMost newTop unwindBlock |
"If terminating the active process, suspend it first and terminate it as a suspended process."
self isActiveProcess ifTrue: [
[self terminate] fork.
^self suspend].
[] ensure: ["Execute termination as an ensure block to ensure it completes even if terminated
before the termination is finished; see testTerminateInTerminate."
+
"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.
+ top := suspendedContext ifNil: [^self error: 'Process already terminated or terminating'].
+ "Disable terminating process while running its stack in active process below so it doesn't
+ accidentally get resumed or terminated again; see Process>>#resume and tests
+ testResumeTerminatingProcess and testTerminateTerminatingProcess"
+ suspendedContext := nil.
+ "Release any method marked with the <criticalSection> pragma and answer new top context.
- suspendedContext ifNil: [^self]. "self is already terminated"
- "Release any method marked with the <criticalSection> pragma.
The argument is whether the process is runnable."
+ ctxt := top := top releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]).
- self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]).
- top := suspendedContext.
- suspendedContext := nil. "Disable terminating process while running its stack in active process below"
"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; nested unwind
+ blocks will be completed in the process; see tests in UnwindTest, testTerminationDuringUnwind.
- if there are multiple such nested unwind blocks, try to complete the outer-most one; nested
- unwind blocks will be completed in the process; see testTerminationDuringUnwind, testNestedUnwind.
Note: Halfway-through blocks have already set the complete variable (tempAt: 2) in their defining
#ensure:/#ifCurtailed contexts from nil to true; we'll search for the bottom-most one.
Note: #findNextUnwindContextUpTo: starts searching from the receiver's sender but the receiver
+ itself may be an unwind context; see testTerminateEnsureAsStackTop."
- itself may be an unwind context (see testTerminateEnsureAsTopContext)."
- ctxt := top.
ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil].
[ctxt isNil] whileFalse: [
(ctxt tempAt:2) ifNotNil: [
outerMost := ctxt].
ctxt := ctxt findNextUnwindContextUpTo: nil].
outerMost ifNotNil: [newTop := top runUnwindTo: outerMost onBehalfOf: self].
"By now no halfway-through unwind blocks are on the stack. Create a new top context for each
pending unwind block (tempAt: 1) and execute it on the unwind block's stack on behalf of self, i.e.
+ the process being terminated, to preserve process identity; see testProcessFaithfulTermination.
- the process being terminated to preserve process identity; see testProcessFaithfulTermination.
Cf. the unwind pattern in #resume:through:: using #value instead of #runUnwindTo:onBehalfOf:
+ would lead to an incorrect evaluation of non-local returns on the wrong stack (active process's).
- would lead to an incorrect evaluation of non-local returns.
Note: newTop sender points to the former outerMost sender, i.e. the next unexplored context."
ctxt := newTop ifNil: [top] ifNotNil: [newTop sender].
ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil].
[ctxt isNil] whileFalse: [
(ctxt tempAt: 2) ifNil: [
ctxt tempAt: 2 put: true.
unwindBlock := ctxt tempAt: 1.
top := unwindBlock asContextWithSender: ctxt.
top runUnwindTo: top onBehalfOf: self].
ctxt := ctxt findNextUnwindContextUpTo: nil]
+ ]
+ !
- ]!
Christoph Thiede uploaded a new version of Kernel to project The Treated Inbox:
http://source.squeak.org/treated/Kernel-jar.1437.mcz
==================== Summary ====================
Name: Kernel-jar.1437
Author: jar
Time: 22 December 2021, 6:36:20.744925 pm
UUID: 0f4d0c71-d03e-a840-ba8f-c404aa5c999d
Ancestors: Kernel-ct.1436
update #teminate fix with the fixes of two more bugs - see summary in
http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217765…
also update comments to refer to #terminateAggressively and #destroy
Please remove previous version from the Inbox, i.e. Kernel-jar.1436, Kernel-jar.1435 and Kernel-jar.1426
=============== Diff against Kernel-ct.1436 ===============
Item was added:
+ ----- Method: Context>>releaseCriticalSection: (in category 'private') -----
+ releaseCriticalSection: runnable
+ "Figure out if we are terminating a process that is in the ensure: block of a critical section.
+ In this case, if the block has made progress, pop the suspendedContext so that we leave the
+ ensure: block inside the critical: without signaling the semaphore/exiting the primitive section,
+ since presumably this has already happened. But if it hasn't made progress but is beyond the
+ wait (which we can tell 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 suspendedContext |
+ suspendedContext := self.
+ (suspendedContext method pragmaAt: #criticalSection) ifNil: [^self].
+ selectorJustSent := suspendedContext selectorJustSentOrSelf.
+
+ "Receiver and/or argument blocks of ensure: in Semaphore>>critical: or Mutex>>#critical:"
+ suspendedContext isClosureContext ifTrue:
+ [suspendedContext sender isUnwindContext ifTrue:
+ [| notWaitingButMadeNoProgress progressedIntoEnsureArgument |
+ "Avoid running the ensure: block twice, popping it if it has already been run. If runnable
+ but at the wait, leave it in place. N.B. No need to check if the block receiver of ensure: has
+ not started to run (via suspendedContext pc = suspendedContext startpc) because ensure:
+ uses valueNoContextSwitch, and so there is no suspension point before the wait."
+ notWaitingButMadeNoProgress :=
+ runnable
+ and: [selectorJustSent == #wait
+ and: [suspendedContext sender selectorJustSentOrSelf == #valueNoContextSwitch]].
+ progressedIntoEnsureArgument :=
+ runnable
+ and: [suspendedContext sender selectorJustSentOrSelf == #value].
+ (notWaitingButMadeNoProgress or: [progressedIntoEnsureArgument]) ifFalse:
+ [suspendedContext := suspendedContext home]].
+ ^suspendedContext].
+
+ "Either Semaphore>>critical: or Mutex>>#critical:. Is the process still blocked? If so, nothing further to do."
+ runnable ifFalse: [^self].
+
+ "If still at the wait the ensure: block has not been activated, so signal to restore."
+ selectorJustSent == #wait ifTrue:
+ [suspendedContext receiver signal].
+
+ "If still at the lock primitive and the lock primitive just acquired ownership (indicated by it answering false)
+ then the ensure block has not been activated, so explicitly primitiveExitCriticalSection to unlock."
+ (selectorJustSent == #primitiveEnterCriticalSection
+ or: [selectorJustSent == #primitiveTestAndSetOwnershipOfCriticalSection]) ifTrue:
+ [(suspendedContext stackPtr > 0
+ and: [suspendedContext top == false]) ifTrue:
+ [suspendedContext receiver primitiveExitCriticalSection]]
+ !
Item was added:
+ ----- Method: Context>>runUnwindTo:onBehalfOf: (in category 'private') -----
+ runUnwindTo: aContext onBehalfOf: aProcess
+ "Run self on behalf of aProcess on aProcess's (i.e. self's) stack until aContext returns. Avoid a context that cannot return. Note: self must be a stack top context. Note: to avoid infinite recursion of MNU error: e.g. a wrapper around the message sentTo: receiver in #doesNotUnderstand: must be implemented.
+ This method is meant to be used exclusively by Process>>#terminate."
+
+ Processor activeProcess
+ evaluate: [
+ | 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 self (see Note 2 below)"
+ "Control resumes here once the above inserted ensure block is executed"
+ ^newTop ] "Return the new top context (see Note 3 below)"
+ onBehalfOf: aProcess
+
+ "Note 1: returning from #cannotReturn's sender would crash the VM so we install a guard ensure context right above it and after returning to #terminate the unwind will continue safely. Try running and debugging this example (avoid Proceeding the BCR error though; it would indeed crash the image):
+ [[[] ensure: [^2]] ensure: [^42]] fork"
+ "Note 2: self is run by jumping directly to it (the active process abandons thisContext and executes self on aProcess's stack; self is its top context). However, before jumping to self we insert an ensure block under unwindBottom context that jumps 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 #terminate will use it only as a starting point in the search for the next unwind context and the computation will never return here. Cf. the pattern in #runUntilErrorOrReturnFrom:: removing the inserted ensure context by stepping until popped when executing non-local returns is not applicable here and would fail tests testTerminateInNestedEnsureWithReturn1 through 4."
+
+ !
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 behavior we expect when terminating a healthy process.
+ See further comments in #terminateAggressively and #destroy methods dealing
+ with process termination when closing a debugger or after a catastrophic failure."
- "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."
+ | oldList top newTop ctxt outerMost unwindBlock |
+ "If terminating the active process, suspend it first and terminate it as a suspended process."
- | ctxt unwindBlock oldList outerMost |
self isActiveProcess ifTrue: [
- "If terminating the active process, suspend it first and terminate it as a suspended process."
[self terminate] fork.
^self suspend].
+ [] ensure: ["Execute termination as an ensure block to ensure it completes even if terminated
+ before the termination is finished; see testTerminateInTerminate."
- "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]).
+ "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.
+ "Disable terminating process while running its stack in active process below so it doesn't
+ accidentally get resumed or terminated again; see Process>>#resume and tests
+ testResumeTerminatingProcess and testTerminateTerminatingProcess"
+ top := suspendedContext ifNil: [^self error: 'Process already terminated or terminating'].
+ suspendedContext := nil.
+ "Release any method marked with the <criticalSection> pragma and answer the new top context.
+ The argument is whether the process was runnable (or suspended); for detailed description see
+ http://forum.world.st/Solving-termination-of-critical-sections-in-the-conte…."
+ ctxt := top := top 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; nested unwind
+ blocks will be completed in the process; see tests in UnwindTest, and testTerminationDuringUnwind.
+ Note: Halfway-through blocks have already set the complete variable (tempAt: 2) in their defining
+ #ensure:/#ifCurtailed contexts from nil to true; we'll search for the bottom-most one.
+ Note: #findNextUnwindContextUpTo: starts searching from the receiver's sender but the receiver
+ itself may be an unwind context; see testTerminateEnsureAsStackTop."
+ ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil].
+ [ctxt isNil] whileFalse: [
+ (ctxt tempAt:2) ifNotNil: [
+ outerMost := ctxt].
+ ctxt := ctxt findNextUnwindContextUpTo: nil].
+ outerMost ifNotNil: [newTop := top runUnwindTo: outerMost onBehalfOf: self].
- 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]]].
+ "By now no halfway-through unwind blocks are on the stack. Create a new top context for each
+ pending unwind block (tempAt: 1) and execute it on the unwind block's stack on behalf of self, i.e.
+ the process being terminated, to preserve process identity; see testProcessFaithfulTermination.
+ Cf. the unwind pattern in #resume:through: : using #value instead of #runUnwindTo:onBehalfOf:
+ would lead to an incorrect evaluation of non-local returns on the wrong stack (active process's).
+ Note: newTop sender points to the former outerMost sender, i.e. the next unexplored context."
+ ctxt := newTop ifNil: [top] ifNotNil: [newTop sender].
- "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.
+ newTop := unwindBlock asContextWithSender: ctxt.
+ newTop runUnwindTo: newTop onBehalfOf: self].
+ ctxt := ctxt findNextUnwindContextUpTo: nil]
+ ]
+ !
- "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]!
Christoph Thiede uploaded a new version of Kernel to project The Treated Inbox:
http://source.squeak.org/treated/Kernel-jar.1442.mcz
==================== Summary ====================
Name: Kernel-jar.1442
Author: jar
Time: 3 January 2022, 6:13:10.111222 pm
UUID: 94b84422-d9f6-df4e-a55b-8baf646eafc2
Ancestors: Kernel-mt.1441
new terminate integrating revised resume's semantics; including simplified #releaseCriticalSection and updated comments.
please review
supersedes Kernel-jar.1437
=============== Diff against Kernel-mt.1441 ===============
Item was added:
+ ----- Method: Context>>releaseCriticalSection (in category 'private') -----
+ releaseCriticalSection
+ "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 then the ensure: block needs to be run.
+ Cf. Process >> releaseCriticalSection: for pre-2022 VMs."
+
+ | selectorJustSent |
+ (self method pragmaAt: #criticalSection) ifNil: [^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 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>>runUnwindTo:onBehalfOf: (in category 'private') -----
+ runUnwindTo: aContext onBehalfOf: aProcess
+ "Run self on behalf of aProcess on aProcess's (i.e. self's) stack until aContext returns. Avoid a context that cannot return. Note: self must be a stack top context. Note: to avoid infinite recursion of MNU error: e.g. a wrapper around the message sentTo: receiver in #doesNotUnderstand: must be implemented. Note: This method is meant to be used exclusively by Process>>#terminate."
+
+ Processor activeProcess
+ evaluate: [
+ | 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 self (see Note 2 below)"
+ "Control resumes here once the above inserted ensure block is executed"
+ ^newTop ] "Return the new top context (see Note 3 below)"
+ onBehalfOf: aProcess
+
+ "Note 1: returning from #cannotReturn's sender would crash the VM so we install a guard ensure context right above it and after returning to #terminate the unwind will continue safely. Try running and debugging this example (avoid Proceeding the BCR error though; it would indeed crash the image):
+ [[[] ensure: [^2]] ensure: [^42]] fork"
+ "Note 2: self is run by jumping directly to it (the active process abandons thisContext and executes self on aProcess's stack; self is its top context). However, before jumping to self we insert an ensure block under unwindBottom context that jumps 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 #terminate will use it only as a starting point in the search for the next unwind context and the computation will never return here. Cf. the pattern in #runUntilErrorOrReturnFrom:: removing the inserted ensure context by stepping until popped when executing non-local returns is not applicable here and would fail tests testTerminateInNestedEnsureWithReturn1 through 4."
+
+ !
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 behavior we expect when terminating a healthy process.
+ See further comments in #terminateAggressively and #destroy methods dealing
+ with process termination when closing a debugger or after a catastrophic failure."
- "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 the active process, suspend it first and terminate it as a suspended process."
- | ctxt unwindBlock oldList outerMost |
self isActiveProcess ifTrue: [
- "If terminating the active process, suspend it first and terminate it as a suspended process."
[self terminate] fork.
^self suspend].
+ "Execute termination in the ensure argument block to ensure it completes even if it
+ (the termination itself) is terminated in the middle; see testTerminateInTerminate."
+ [] ensure: [ | top ctxt outerMost |
+ suspendedContext ifNil: [^self error: 'Process already terminated or terminating'].
- "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]).
+ "Always suspend the process first so it doesn't accidentally get woken up.
+ Disable the terminating process while running its stack in active process below so it doesn't
+ accidentally get resumed or terminated again; see Process>>#resume and tests
+ testResumeTerminatingProcess and testTerminateTerminatingProcess.
+ Release any method marked with the <criticalSection> pragma."
+ Smalltalk processSuspensionUnblocks
+ ifFalse: [ "this part is for revised resume semantics introduced in 2022 VMs"
+ self suspend.
+ top := suspendedContext.
+ suspendedContext := nil.
+ top releaseCriticalSection]
+ ifTrue: [ "this part is for backward compatibilty with pre-2022 VMs"
+ | oldList |
+ oldList := self suspend.
+ self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]).
+ top := suspendedContext.
+ suspendedContext := nil].
+
"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; nested unwind
+ blocks will be completed in the process; see tests in UnwindTest, and testTerminationDuringUnwind.
+ Note: Halfway-through blocks have already set the complete variable (tempAt: 2) in their defining
+ #ensure:/#ifCurtailed contexts from nil to true; we'll search for the bottom-most one.
+ Note: #findNextUnwindContextUpTo: starts searching from the receiver's sender but the receiver
+ itself may be an unwind context; see testTerminateEnsureAsStackTop."
+ ctxt := top.
+ ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil].
+ [ctxt isNil] whileFalse: [
+ (ctxt tempAt:2) ifNotNil: [
+ outerMost := ctxt].
+ ctxt := ctxt findNextUnwindContextUpTo: nil].
+ outerMost ifNotNil: [top := (top runUnwindTo: outerMost onBehalfOf: self) sender].
- 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]]].
+ "By now no halfway-through unwind blocks are on the stack. Create a new top context for each
+ pending unwind block (tempAt: 1) and execute it on the unwind block's stack on behalf of self, i.e.
+ the process being terminated, to preserve process identity; see testProcessFaithfulTermination.
+ Cf. the unwind pattern in #resume:through: : using #value instead of #runUnwindTo:onBehalfOf:
+ would lead to an incorrect evaluation of non-local returns on the wrong stack (active process's).
+ Note: new top points to the former outerMost sender, i.e. the next unexplored context."
+ ctxt := top.
- "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.
+ top := (ctxt tempAt: 1) asContextWithSender: ctxt.
+ top runUnwindTo: top onBehalfOf: self].
+ ctxt := ctxt findNextUnwindContextUpTo: nil]
+ ]!
- 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]!
Christoph Thiede uploaded a new version of Kernel to project The Treated Inbox:
http://source.squeak.org/treated/Kernel-jar.1443.mcz
==================== Summary ====================
Name: Kernel-jar.1443
Author: jar
Time: 5 January 2022, 3:19:34.612959 pm
UUID: d483056e-2509-0c40-ae7b-82632ea95f82
Ancestors: Kernel-mt.1441
revised new #terminate
- new active process termination (now direct)
- updated for revised suspend semantics
- simplified #releaseCriticalSection
Complemented by a battery of tests: KernelTests-jar.421
Supersede Kernel-jar.1442 (can be removed)
=============== Diff against Kernel-mt.1441 ===============
Item was added:
+ ----- Method: Context>>releaseCriticalSection (in category 'private') -----
+ releaseCriticalSection
+ "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 then the ensure: block needs to be run.
+ Cf. Process >> releaseCriticalSection: for pre-2022 VMs."
+
+ | selectorJustSent |
+ (self method pragmaAt: #criticalSection) ifNil: [^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 primitiveExitCriticalSection to unlock."
+ (selectorJustSent == #primitiveEnterCriticalSection
+ or: [selectorJustSent == #primitiveTestAndSetOwnershipOfCriticalSection]) ifTrue:
+ [(self stackPtr > 0
+ and: [self top == false]) ifTrue:
+ [self receiver primitiveExitCriticalSection]]
+ !
Item was changed:
----- Method: Process>>terminate (in category 'changing process state') -----
terminate
+ "Stop the process that the receiver represents forever.
+ Unwind to execute pending ensure:/ifCurtailed: blocks before terminating;
+ 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 behavior we expect when terminating a healthy process.
+ See further comments in #terminateAggressively and #destroy methods dealing
+ with process termination when closing a debugger or after a catastrophic failure."
- "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."
+ | top |
+ "If terminating the active process, create a parallel stack and run unwinds from there."
- | ctxt unwindBlock oldList outerMost |
self isActiveProcess ifTrue: [
+ top := thisContext.
+ ^[self unwind: top; suspend] asContext jump].
- "If terminating the active process, suspend it first and terminate it as a suspended process."
- [self terminate] fork.
- ^self suspend].
+ "Always suspend the terminating process first so it doesn't accidentally get woken up.
+ Disable the terminating process while running its stack in active process so it doesn't
+ accidentally get resumed or terminated again; see Process>>#resume and tests
+ testResumeTerminatingProcess and testTerminateTerminatingProcess.
+ Release any method marked with the <criticalSection> pragma.
+ Execute termination in the ensure argument block to ensure it completes even if the
+ terminator process itself is terminated in the middle; see testTerminateInTerminate."
- "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]).
+ [] ensure: [
+ suspendedContext ifNil: [^self error: 'Process already terminated or terminating'].
+ Smalltalk processSuspensionUnblocks
+ ifFalse: [ "this part is for revised resume semantics introduced in 2022 VMs"
+ self suspend.
+ top := suspendedContext.
+ suspendedContext := nil.
+ top releaseCriticalSection.
+ self unwind: top]
+ ifTrue: [ "this part is for backward compatibilty with pre-2022 VMs"
+ | oldList |
+ oldList := self suspend.
+ self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]).
+ top := suspendedContext.
+ suspendedContext := nil.
+ self unwind: top]]!
- "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]!
Item was added:
+ ----- Method: Process>>unwind: (in category 'private') -----
+ unwind: aContext
+
+ | top ctxt outerMost |
+ "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; nested unwind
+ blocks will be completed in the process; see tests in UnwindTest, and testTerminationDuringUnwind.
+ Note: Halfway-through blocks have already set the complete variable (tempAt: 2) in their defining
+ #ensure:/#ifCurtailed contexts from nil to true; we'll search for the bottom-most one.
+ Note: #findNextUnwindContextUpTo: starts searching from the receiver's sender but the receiver
+ itself may be an unwind context; see testTerminateEnsureAsStackTop."
+ ctxt := top := aContext.
+ ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil].
+ [ctxt isNil] whileFalse: [
+ (ctxt tempAt:2) ifNotNil: [
+ outerMost := ctxt].
+ ctxt := ctxt findNextUnwindContextUpTo: nil].
+ outerMost ifNotNil: [top := (self unwind: top to: outerMost) sender].
+
+ "By now no halfway-through unwind blocks are on the stack. Create a new top context for each
+ pending unwind block (tempAt: 1) and execute it on the unwind block's stack on behalf of self, i.e.
+ the process being terminated, to preserve process identity; see testProcessFaithfulTermination.
+ Cf. the unwind pattern in #resume:through: : using #value instead of #runUnwindTo:onBehalfOf:
+ would lead to an incorrect evaluation of non-local returns on the wrong stack (active process's).
+ Note: new top points to the former outerMost sender, i.e. the next unexplored context."
+ ctxt := top.
+ ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil].
+ [ctxt isNil] whileFalse: [
+ (ctxt tempAt: 2) ifNil: [
+ ctxt tempAt: 2 put: true.
+ top := (ctxt tempAt: 1) asContextWithSender: ctxt.
+ self unwind: top to: top].
+ ctxt := ctxt findNextUnwindContextUpTo: nil]
+ !
Item was added:
+ ----- Method: Process>>unwind:to: (in category 'private') -----
+ unwind: top to: aContext
+ "Run top on behalf of self on self's stack until aContext returns. Avoid a context that cannot return.
+ Note: top must be a stack top context. Note: to avoid infinite recursion of MNU error: e.g. a wrapper
+ around the message sentTo: receiver in #doesNotUnderstand: must be implemented.
+ Note: This method is meant to be used exclusively by Process>>#terminate."
+
+ Processor activeProcess
+ evaluate: [
+ | here unwindBottom newTop |
+ here := thisContext.
+ "Avoid a context that cannot return (see Note 1 below)"
+ unwindBottom := (top 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]).
+ top jump. "Control jumps to top (see Note 2 below)"
+ "Control resumes here once the above inserted ensure block is executed"
+ ^newTop ] "Return the new top context (see Note 3 below)"
+ onBehalfOf: self
+
+ "Note 1: returning from #cannotReturn's sender would crash the VM so we install a guard ensure context right
+ above it and after returning to #terminate the unwind will continue safely. Try running and debugging this example
+ (avoid Proceeding the BCR error though; it would indeed crash the image):
+ [[[] ensure: [^2]] ensure: [^42]] fork"
+
+ "Note 2: top is run by jumping directly to it (the active process abandons thisContext and executes top on aProcess's
+ stack; top is its top context). However, before jumping to top we insert an ensure block under unwindBottom context
+ that jumps 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 #terminate will use it only as a starting
+ point in the search for the next unwind context and the computation will never return here. Cf. the pattern in
+ #runUntilErrorOrReturnFrom:: removing the inserted ensure context by stepping until popped when executing
+ non-local returns is not applicable here and would fail tests testTerminateInNestedEnsureWithReturn1 through 4."
+
+ !
Christoph Thiede uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-ct.1453.mcz
==================== Summary ====================
Name: Kernel-ct.1453
Author: ct
Time: 25 March 2022, 9:27:45.391762 pm
UUID: 8e8469d0-7b91-004e-b092-29d3d572ac1d
Ancestors: Kernel-ct.1452
Removes obsolete comment from Error. UnhandledError is real!
=============== Diff against Kernel-ct.1452 ===============
Item was changed:
Exception subclass: #Error
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Kernel-Exceptions-Kernel'!
+ !Error commentStamp: 'ct 3/25/2022 21:09' prior: 0!
- !Error commentStamp: '<historical>' prior: 0!
>From the ANSI standard:
This protocol describes the behavior of instances of class Error. These are used to represent error conditions that prevent the normal continuation of processing. Actual error exceptions used by an application may be subclasses of this class.
+ As Error is explicitly specified to be subclassable, conforming implementations must implement its behavior in a non-fragile manner.!
- As Error is explicitly specified to be subclassable, conforming implementations must implement its behavior in a non-fragile manner.
-
- Additional notes:
- Error>defaultAction uses an explicit test for the presence of the Debugger class to decide whether or not it is in development mode. In the future, TFEI hopes to enhance the semantics of #defaultAction to improve support for pluggable default handlers.!
Christoph Thiede uploaded a new version of 60Deprecated to project The Trunk:
http://source.squeak.org/trunk/60Deprecated-ct.108.mcz
==================== Summary ====================
Name: 60Deprecated-ct.108
Author: ct
Time: 25 March 2022, 9:24:32.353762 pm
UUID: 66b82798-b173-684a-b384-48b70c79f60b
Ancestors: 60Deprecated-mt.107
Complements SUnit-ct.139 (deprecation of #shouldFix:). Uses Kernel-ct.1452.
=============== Diff against 60Deprecated-mt.107 ===============
Item was added:
+ ----- Method: SUnitExtensionsTest>>shouldFixTest (in category '*60Deprecated-real tests') -----
+ shouldFixTest
+
+ self shouldFix: [ Error signal: 'any kind of error' ]
+ !
Item was added:
+ ----- Method: SUnitExtensionsTest>>testShouldFix (in category '*60Deprecated-tests') -----
+ testShouldFix
+
+ | testCase testResult |
+
+ testCase := self class selector: #shouldFixTest.
+ testResult := Deprecation suppressDuring: [testCase run].
+
+ self assert: (testResult passed includes: testCase).
+ self assert: testResult passed size=1.
+ self assert: testResult failures isEmpty.
+ self assert: testResult errors isEmpty.
+
+ !
Item was added:
+ ----- Method: TestCase>>shouldFix: (in category '*60Deprecated-asserting - extensions') -----
+ shouldFix: aBlock
+
+ self deprecated: 'Handling exceptions of all kind is disrecommended. To test for errors, send #shouldRaiseError: instead. You can also send #should:raise: to test against specific exception classes such as Warning or NotFound. See also the class comments on Exception and Error.'.
+ ^self should: aBlock raise: Exception!
Christoph Thiede uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-ct.1452.mcz
==================== Summary ====================
Name: Kernel-ct.1452
Author: ct
Time: 25 March 2022, 9:20:32.375762 pm
UUID: 341893ac-9032-1c42-a928-9e2eed3a1fa5
Ancestors: Kernel-nice.1447
Adds execution around method for suppressing warnings.
Differently to an exception handler, this can be used to avoid signaling a warning altogether, which is particularly helpful when there is another inner exception handler that cannot be controlled by the client of this message.
=============== Diff against Kernel-nice.1447 ===============
Item was added:
+ ----- Method: Warning class>>suppressDuring: (in category 'suppress and reset') -----
+ suppressDuring: aBlock
+
+ self suppressed ifTrue: [^ aBlock value].
+
+ self suppressed: true.
+ ^ aBlock ensure: [self suppressed: false]!