[squeak-dev] The Inbox: Kernel-jar.1447.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Feb 22 19:18:09 UTC 2022
A new version of Kernel was added to project The Inbox:
http://source.squeak.org/inbox/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]!
More information about the Squeak-dev
mailing list
|