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