Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-jar.1501.mcz
==================== Summary ====================
Name: Kernel-jar.1501 Author: jar Time: 15 February 2023, 4:46:08.266577 pm UUID: df3048fe-826b-cd40-a21b-de4b7d285390 Ancestors: Kernel-eem.1498
fix and improve: #terminate - fix multiple termination issue - use a helper method to improve readability; #suspendAndReleaseCriticalSection - improve algorithm to fix failing Sema/Mutex tests - replace conditionals with class based methods; #unwindAndStop: - fix a bug (missing fake return value before jump) #unwindTo: safely: - fix a bug (missing nil check)
Complemented by KernelTests-jar.443 (set of Sema/Mutex/Proc tests)
This changeset replaces Kernel-jar.1498 (#terminate etc) - please remove from Inbox
=============== Diff against Kernel-eem.1498 ===============
Item was added: + ----- Method: BlockClosure>>valueAndWaitWhileUnwinding: (in category 'private') ----- + valueAndWaitWhileUnwinding: contextToUnwind + "A helper method for Process terminate. Evaluate the receiver and suspend + current process until argument's sender chain is unwound." + + | semaphore newBottom | + contextToUnwind ifNil: [^self]. + semaphore := Semaphore new. + newBottom := contextToUnwind class contextEnsure: [semaphore signal]. + contextToUnwind bottomContext insertSender: newBottom. + self value: contextToUnwind. + semaphore wait!
Item was added: + ----- Method: Context>>unwindAndStop: (in category 'private') ----- + unwindAndStop: aProcess + "A helper method to Process #terminate. Create and answer + a helper stack for a terminating process to unwind itself from. + Note: push a fake return value to create a proper top context." + + ^(self class contextEnsure: [self unwindTo: nil]) + privSender: [aProcess suspend] asContext; + push: nil + !
Item was changed: ----- 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 the top context of a stack already halfways through an unwind block, 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]]. "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 ifNil: [^self]. "#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. + (ctx tempAt: 1) ifNotNil: [:unwindBlock | + top := unwindBlock asContextWithSender: ctx. + top runUntilReturnFrom: top]]. - top := (ctx tempAt: 1) asContextWithSender: ctx. - 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 added: + ----- Method: Mutex>>releaseCriticalSection: (in category 'private') ----- + releaseCriticalSection: aContext + "A helper method for Process suspendAndReleaseCriticalSection. + If the terminating process is still blocked at the condition variable + of a critical section, skip the rest of the current context." + + ^aContext pc: aContext endPC!
Item was added: + ----- Method: Mutex>>stepIntoCriticalSection: (in category 'private') ----- + stepIntoCriticalSection: aContext + "A helper method for Process suspendAndReleaseCriticalSection. + If the terminating process still haven't made progress beyond the lock primitive + and the lock primitive just acquired ownership (indicated by it answering false) + then the ensure block has not been activated, so step into it." + + ^(aContext stackPtr > 0 and: [aContext top == false]) + ifTrue: [aContext stepToCallee] + ifFalse: [aContext]!
Item was changed: ----- Method: Process>>suspendAndReleaseCriticalSection (in category 'private') ----- suspendAndReleaseCriticalSection "Figure out if we are terminating a process that is in the ensure: block of a critical section. 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), then the ensure: + block needs to be run. Answer a context chain that needs to be unwound." - one of the runnable lists, i.e. a LinkedList, not a Semaphore or Mutex, et al), then the ensure: - block needs to be run."
+ "Note 1: suspend and unblock the receiver from a condition variable using the old suspend + primitive #88; it answers the list the receiver was on before the suspension. + Note 2: condition variables' classes implement the actual releasing depending on their + implementation of #critical:; see Semaphore or Mutex (or any future extension's) + #releaseCriticalSection: and #stepIntoCriticalSection: and the discussion here: + http://forum.world.st/Solving-termination-of-critical-sections-in-the-contex..." - | oldList selectorJustSent | - "Suspend and unblock the receiver from a condition variable using suspend primitive #88. - It answers the list the receiver was on before the suspension." - oldList := self suspendAndUnblock. - (oldList isNil or: [oldList class == LinkedList]) ifFalse: [^self].
+ | oldList | + oldList := self suspendAndUnblock ifNil: [LinkedList new]. + ^suspendedContext ifNotNil: [:context | + suspendedContext := nil. + (context method pragmaAt: #criticalSection) + ifNil: [context] + ifNotNil: [oldList releaseCriticalSection: context]]! - ((suspendedContext ifNil: [^self]) method pragmaAt: #criticalSection) ifNil: [^self]. - selectorJustSent := suspendedContext selectorJustSentOrSelf. - - "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. Allow all pending unwind + blocks to run before terminating; if they are currently in progress, let them finish." - 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." + "Note: This is the kind of behavior we expect when terminating a healthy process. - "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 new stack and run unwinds from there. If terminating a suspended process (including runnable and blocked), always + suspend the terminating process first so it doesn't accidentally get woken up, + and nil the suspended context to prevent accidental resumption or termination + while manipulating the suspended context. + - 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 previous #suspend simply removed the process from the conditional variable's list it was previously waiting on; see #suspend and #suspendAndUnblock comments. + + If the process is blocked, waiting to access the #critical: section, release it properly. - - If the process is in the middle of a #critical: critical section, release it properly. To allow a suspended process to unwind itself, create a new stack for the process being terminated and resume the suspended process to complete its termination + from the new, parallel stack. Use a semaphore to make the process that invoked - from the new parallel stack. Use a semaphore to make the process that invoked the termination wait for self's completion. Execute the termination in the ensure argument block to ensure it completes even if the terminator process itself gets terminated before it's finished; see testTerminateInTerminate and others." - | context | self isActiveProcess ifTrue: [ + ^(thisContext unwindAndStop: self) jump]. - context := thisContext. - ^[[] ensure: [context unwindTo: nil]. self suspend] asContext jump].
+ [] ensure: [ + [:contextToUnwind | + self - [] ensure: [ | terminator | - self suspendAndReleaseCriticalSection. - context := suspendedContext ifNil: [^self]. - terminator := Semaphore new. - context bottomContext insertSender: (Context contextEnsure: [terminator signal]). - self suspendedContext: [[] ensure: [context unwindTo: nil]. self suspend] asContext; priority: Processor activePriority; + suspendedContext: (contextToUnwind unwindAndStop: self); + resume + ] valueAndWaitWhileUnwinding: self suspendAndReleaseCriticalSection + ]! - resume. - terminator wait]!
Item was added: + ----- Method: Semaphore>>releaseCriticalSection: (in category 'private') ----- + releaseCriticalSection: aContext + "A helper method for Process suspendAndReleaseCriticalSection. + If the terminating process is still blocked at the condition variable + of a critical section, skip the rest of the current context." + + ^aContext pc: aContext endPC!
Item was added: + ----- Method: Semaphore>>stepIntoCriticalSection: (in category 'private') ----- + stepIntoCriticalSection: aContext + "A helper method for Process suspendAndReleaseCriticalSection. + If the terminating process still haven't made progress beyond the wait + then the ensure block has not been activated, so step into it." + + ^aContext stepToCallee!