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." + + !
packages@lists.squeakfoundation.org