[squeak-dev] The Inbox: Kernel-jar.1434.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Dec 10 12:44:06 UTC 2021
A new version of Kernel was added to project The Inbox:
==================== Summary ====================
Time: 10 December 2021, 1:44:02.255039 pm
substantially simplified #terminate's helper method #runUnwind:onBehalfOf: (former #complete:to:) and updated comments. The functionality remains unchanged and all tests pass.
Previous version Kernel-jar.1426 can be moved to Treated if this version accepted. All tests complementing Kernel-jar.1426 remain valid.
=============== Diff against Kernel-mt.1433 ===============
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 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: [
+ | ctxt here |
+ here := thisContext.
+ "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"
+ ^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: 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') -----
"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."
- 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.
+  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]).
- "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 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.
+ 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].
- 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.
+ 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.
+ top runUnwindTo: top 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]!
More information about the Squeak-dev