Squeak-dev February 2023

squeak-dev@lists.squeakfoundation.org

28 participants
108 discussions

The Trunk: Kernel-jar.1500.mcz
by commits＠source.squeak.org 16 Feb '23

16 Feb '23

Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-jar.1500.mcz ==================== Summary ==================== Name: Kernel-jar.1500 Author: jar Time: 2 February 2023, 10:04:57.541211 pm UUID: 8add6e35-4849-624a-94f8-0722d7ef8c07 Ancestors: Kernel-tpr.1497 Fix #terminateAggressively and #runUntilErrorOrReturnFrom: bugs. Both bugs combined cause the Debugger MNU in this situation: Run this in the Workspace: p := [ [Semaphore new wait] ensure: [1/0] ] fork Then terminate it like this: [p terminate] fork And then just press Abandon and get the MNU error. =============== Diff against Kernel-tpr.1497 =============== Item was changed: ----- Method: Context>>runUntilErrorOrReturnFrom: (in category 'controlling') ----- runUntilErrorOrReturnFrom: aSender "ASSUMES aSender is a sender of self. Execute self's stack until aSender returns or an unhandled exception is raised. Return a pair containing the new top context and a possibly nil exception. The exception is not nil if it was raised before aSender returned and it was not handled. The exception is returned rather than openning the debugger, giving the caller the choice of how to handle it." "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 aSender that jumps back to thisContext when evaluated. We also insert an exception handler under aSender that jumps back to thisContext when an unhandled exception is raised. In either case, the inserted ensure and exception handler are removed once control jumps back to thisContext." | error ctxt here topContext | here := thisContext. "Insert ensure and exception handler contexts under aSender" error := nil. ctxt := aSender insertSender: (Context contextOn: UnhandledError do: [:ex | error ifNil: [ error := ex exception. topContext := thisContext. ex resumeUnchecked: here jump] ifNotNil: [ex pass] ]). ctxt := ctxt insertSender: (Context contextEnsure: [error ifNil: [ topContext := thisContext. here jump] ]). self jump. "Control jumps to self" "Control resumes here once above ensure block or exception handler is executed" ^ error ifNil: [ "No error was raised, remove ensure context by stepping until popped" + [ctxt isDead or: [topContext isNil]] whileFalse: [topContext := topContext stepToCallee]. - [ctxt isDead] whileFalse: [topContext := topContext stepToCallee]. {topContext. nil} ] ifNotNil: [ "Error was raised, remove inserted above contexts then return signaler context" aSender terminateTo: ctxt sender. "remove above ensure and handler contexts" {topContext. error} ]! Item was changed: ----- Method: Process>>terminateAggressively (in category 'changing process state') ----- terminateAggressively "Stop the receiver forever. Run all unwind contexts (#ensure:/#ifCurtailed: blocks) on the stack that have not yet been started. If the process is in the middle of an unwind block, then that unwind block will not be completed, but subsequent unwind blocks will be run. If even those unwind contexts should be continued, send #terminate 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: critical section, release it properly." | oldList bottom tombstone | self isActiveProcess ifTrue: [ "If terminating the active process, suspend it first and terminate it as a suspended process." [self terminate] fork. ^self suspend]. "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." oldList := self suspend. suspendedContext ifNil: [^ self "Process 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]). bottom := suspendedContext bottomContext. tombstone := bottom insertSender: [self suspend "terminated"] asContext. suspendedContext := self activateReturn: bottom value: nil. self complete: tombstone ifError: [:ex | + (suspendedContext ifNil: [^self]) privRefresh. "Restart the handler context of UnhandledError so that when the receiver is resumed, its #defaultAction will be reached. See implementation details in #runUntilErrorOrReturnFrom:." - suspendedContext privRefresh. "Restart the handler context of UnhandledError so that when the receiver is resumed, its #defaultAction will be reached. See implementation details in #runUntilErrorOrReturnFrom:." "We're not yet done, resume the receiver to spawn a new debugger on the error." self resume].!

1 0

The Trunk: Collections-jar.1028.mcz
by commits＠source.squeak.org 16 Feb '23

16 Feb '23

Marcel Taeumel uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-jar.1028.mcz ==================== Summary ==================== Name: Collections-jar.1028 Author: jar Time: 16 February 2023, 8:00:13.16881 am UUID: 60a0cd75-df99-1942-8d6a-3fbe0615b1aa Ancestors: Collections-mt.1027 complement Kernel-jar.1501 (#terminate etc) =============== Diff against Collections-mt.1027 =============== Item was added: + ----- Method: LinkedList>>releaseCriticalSection: (in category 'private') ----- + releaseCriticalSection: aContext + "A helper method for Process suspendAndReleaseCriticalSection; + aContext receiver represents a condition variable, i.e. a Semaphore + or a Mutex (or any other in case of future new condition variables), + which will take care of releasing the critical section properly." + + ^aContext receiver stepIntoCriticalSection: aContext!

1 0

The Trunk: Tools-mt.1190.mcz
by commits＠source.squeak.org 16 Feb '23

16 Feb '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1190.mcz ==================== Summary ==================== Name: Tools-mt.1190 Author: mt Time: 16 February 2023, 9:38:41.897287 am UUID: 91daa1d9-9457-f646-a5d2-32fbd45dd79b Ancestors: Tools-mt.1189, Tools-jar.1189 Complement Kernel-mt.1504 =============== Diff against Tools-mt.1189 =============== Item was changed: ----- Method: Debugger>>send (in category 'context stack menu') ----- send "Send the selected message in the accessed method, and take control in the method invoked to allow further step or send." + | newContext currentContext | self okToChange ifFalse: [^ self]. self interruptedProcessIsReady ifFalse: [^ self shouldNotStep]. self checkContextSelection. + currentContext := self selectedContext. + self handleLabelUpdatesIn: + [interruptedProcess step: currentContext] + whenExecuting: currentContext. - interruptedProcess step: self selectedContext. interruptedProcess ifNil: [^ self shouldNotStep]. + newContext := interruptedProcess stepToSendOrReturn. + self updateProcess. + self contextStackIndex > 1 + ifTrue: [self resetContext: newContext] + ifFalse: + [newContext == currentContext + ifTrue: [self changed: #contentsSelection. + self updateInspectors] + ifFalse: [self resetContext: newContext]]! - self resetContext: interruptedProcess stepToSendOrReturn.!

1 0

The Trunk: KernelTests-mt.444.mcz
by commits＠source.squeak.org 16 Feb '23

16 Feb '23

Marcel Taeumel uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-mt.444.mcz ==================== Summary ==================== Name: KernelTests-mt.444 Author: mt Time: 16 February 2023, 9:38:13.146287 am UUID: e53ab079-320a-0443-978a-24f1e5d386d6 Ancestors: KernelTests-jar.443, KernelTests-jar.442 Complement Kernel-mt.1504 =============== Diff against KernelTests-tpr.441 =============== Item was changed: TestCase subclass: #MonitorTest + instanceVariableNames: 'semaphore' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'KernelTests-Processes'! Item was added: + ----- Method: MonitorTest>>setUp (in category 'as yet unclassified') ----- + setUp + + super setUp. + semaphore := Semaphore new.! Item was added: + ----- Method: MonitorTest>>tearDown (in category 'as yet unclassified') ----- + tearDown + "Release all processes still waiting at the semaphore or in the active priority queue." + + Processor yield. + [semaphore isEmpty] whileFalse: [semaphore signal]. + + super tearDown.! Item was changed: ----- Method: MonitorTest>>testCheckOwnerProcess (in category 'tests') ----- testCheckOwnerProcess self should: [Monitor new checkOwnerProcess] raise: Error. self shouldnt: [| m | m := Monitor new. m critical: [m checkOwnerProcess]] raise: Error. self should: [| s m | m := Monitor new. + [m critical: [s := #in. semaphore wait]] fork. - [m critical: [s := #in. Semaphore new wait]] fork. Processor yield. self assert: #in equals: s. m checkOwnerProcess] raise: Error! Item was changed: ----- Method: MonitorTest>>testCriticalIfLocked (in category 'tests') ----- testCriticalIfLocked | m s | m := Monitor new. self assert: #unlocked == (m critical: [#unlocked] ifLocked: [#locked]). + [m critical: [s := #in. semaphore wait]] fork. - [m critical: [s := #in. Semaphore new wait]] fork. Processor yield. self assert: #in equals: s. self assert: #locked equals: (m critical: [#unlocked] ifLocked: [#locked])! Item was removed: - ----- Method: MutexTest>>expectedFailures (in category 'failures') ----- - expectedFailures - - ^ #(testUnwindMutexBlockedInCritical)! Item was added: + ----- Method: MutexTest>>testMutexAfterCriticalWait2 (in category 'tests') ----- + testMutexAfterCriticalWait2 + "This tests whether a process that has just left the primitiveEnterCriticalSection in Mutex>>critical: + leaves it with the mutex correctly released." + | lock p beenHere | + lock := Mutex new. beenHere := false. + p := [lock critical: [beenHere := true]] newProcess. + p priority: Processor activePriority - 1. + lock critical: "We now own it; p can't enter properly" + [p resume. + "wait until p enters the critical section; it doesn't own the Mutex so is blocked..." + [p suspendingList == lock] whileFalse: [(Delay forMilliseconds: 10) wait]. + self deny: lock isEmpty]. + "p is waiting on lock; on our exiting critical: p is now the notional owner. Terminate before it has a chance to run". + p terminate. + self deny: lock isOwned. + self assert: lock isEmpty. + self deny: beenHere! Item was added: + ----- Method: MutexTest>>testMutexAfterCriticalWaitCf (in category 'tests') ----- + testMutexAfterCriticalWaitCf + "This tests whether a process that has just left the primitiveEnterCriticalSection in Mutex>>critical: + leaves it with the mutex correctly released." + | lock p beenHere | + lock := Mutex new. beenHere := false. + p := [lock critical: [beenHere := true]] newProcess. + p priority: Processor activePriority - 1. + lock critical: "We now own it; p can't enter properly" + [p resume. + "wait until p enters the critical section; it doesn't own the Mutex so is blocked..." + [p suspendingList == lock] whileFalse: [(Delay forMilliseconds: 10) wait]. + self deny: lock isEmpty. + "p is waiting on lock; on our exiting critical: p is now the notional owner. Terminate before it has a chance to run". + p terminate]. + self deny: lock isOwned. + self assert: lock isEmpty. + self deny: beenHere! Item was added: + ----- Method: MutexTest>>testMutexAfterCriticalWaitInEnsure (in category 'tests') ----- + testMutexAfterCriticalWaitInEnsure + "This tests whether a process that has just left the primitiveEnterCriticalSection in Mutex>>critical: + leaves it with the mutex correctly released." + | lock p | + lock := Mutex new. + p := [[] ensure: [lock critical: []]] newProcess. + p priority: Processor activePriority - 1. + lock critical: "We now own it; p can't enter properly" + [p resume. + "wait until p enters the critical section; it doesn't own the Mutex so is blocked..." + [p suspendingList == lock] whileFalse: [(Delay forMilliseconds: 10) wait]. + self deny: lock isEmpty]. + "p is waiting on lock; on our exiting critical: p is now the notional owner. Terminate before it has a chance to run". + p terminate. + self deny: lock isOwned. + self assert: lock isEmpty! Item was added: + ----- Method: MutexTest>>testMutexAfterCriticalWaitInEnsure2 (in category 'tests') ----- + testMutexAfterCriticalWaitInEnsure2 + "This tests whether a process that has just left the primitiveEnterCriticalSection in Mutex>>critical: + leaves it with the mutex correctly released." + | lock p beenHere | + lock := Mutex new. beenHere := false. + p := [[] ensure: [lock critical: [beenHere := true]]] newProcess. + p priority: Processor activePriority - 1. + lock critical: "We now own it; p can't enter properly" + [p resume. + "wait until p enters the critical section; it doesn't own the Mutex so is blocked..." + [p suspendingList == lock] whileFalse: [(Delay forMilliseconds: 10) wait]. + self deny: lock isEmpty]. + "p is waiting on lock; on our exiting critical: p is now the notional owner. Terminate before it has a chance to run". + p terminate. + self deny: lock isOwned. + self assert: lock isEmpty. + self assert: beenHere! Item was added: + ----- Method: MutexTest>>testMutexAfterCriticalWaitInEnsureCf (in category 'tests') ----- + testMutexAfterCriticalWaitInEnsureCf + "This tests whether a process that has just left the primitiveEnterCriticalSection in Mutex>>critical: + leaves it with the mutex correctly released." + | lock p beenHere | + lock := Mutex new. beenHere := false. + p := [[] ensure: [lock critical: [beenHere := true]]] newProcess. + p priority: Processor activePriority - 1. + lock critical: "We now own it; p can't enter properly" + [p resume. + "wait until p enters the critical section; it doesn't own the Mutex so is blocked..." + [p suspendingList == lock] whileFalse: [(Delay forMilliseconds: 10) wait]. + self deny: lock isEmpty. + "p is waiting on lock; on our exiting critical: p is now the notional owner. Terminate before it has a chance to run". + p terminate]. + self deny: lock isOwned. + self assert: lock isEmpty. + self deny: beenHere! Item was added: + ----- Method: MutexTest>>testMutexBlockedInCritical (in category 'tests') ----- + testMutexBlockedInCritical + "This tests whether a process that is inside the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unchanged." + | lock sock proc wait | + lock := Mutex new. + sock := Semaphore new. + proc := [lock critical: [sock wait]] fork. + wait := [lock critical: []] fork. + Processor yield. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == lock. + self deny: lock isEmpty. + self assert: lock isOwned. + wait terminate. + Processor yield. + self assert: wait isTerminated. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == nil. + self assert: lock isEmpty. + self assert: lock isOwned. + proc terminate! Item was added: + ----- Method: MutexTest>>testMutexBlockedInCritical2 (in category 'tests') ----- + testMutexBlockedInCritical2 + "This tests whether a process that is inside the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unchanged." + | lock sock proc wait beenHere beenHereToo | + lock := Mutex new. + sock := Semaphore new. + beenHere := beenHereToo := false. + proc := [lock critical: [sock wait]] fork. + wait := [lock critical: [beenHere := true]. beenHereToo := true] fork. + Processor yield. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == lock. + self deny: lock isEmpty. + self assert: lock isOwned. + wait terminate. + Processor yield. + self assert: wait isTerminated. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == nil. + self assert: lock isEmpty. + self assert: lock isOwned. + self deny: beenHere. + self deny: beenHereToo. + proc terminate! Item was added: + ----- Method: MutexTest>>testMutexBlockedInCriticalInEnsure (in category 'tests') ----- + testMutexBlockedInCriticalInEnsure + "This tests whether a process that is inside the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unchanged." + | lock sock proc wait | + lock := Mutex new. + sock := Semaphore new. + proc := [lock critical: [sock wait]] fork. + wait := [[] ensure: [lock critical: []]] fork. + Processor yield. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == lock. + self deny: lock isEmpty. + self assert: lock isOwned. + wait terminate. + Processor yield. + self assert: wait isTerminated. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == nil. + self assert: lock isEmpty. + self assert: lock isOwned. + proc terminate! Item was added: + ----- Method: MutexTest>>testMutexBlockedInCriticalInEnsure2 (in category 'tests') ----- + testMutexBlockedInCriticalInEnsure2 + "This tests whether a process that is inside the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unchanged." + | lock sock proc wait beenHere beenHereToo | + lock := Mutex new. + sock := Semaphore new. + beenHere := beenHereToo := false. + proc := [lock critical: [sock wait]] fork. + wait := [[] ensure: [lock critical: [beenHere := true]. beenHereToo := true]] fork. + Processor yield. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == lock. + self deny: lock isEmpty. + self assert: lock isOwned. + wait terminate. + Processor yield. + self assert: wait isTerminated. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == nil. + self assert: lock isEmpty. + self assert: lock isOwned. + self deny: beenHere. + self assert: beenHereToo. + proc terminate! Item was added: + ----- Method: MutexTest>>testMutexInCriticalWait2 (in category 'tests') ----- + testMutexInCriticalWait2 + "This tests whether a process that has got past the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unowned." + | lock sock proc beenHere beenHereToo | + lock := Mutex new. + sock := Semaphore new. + beenHere := beenHereToo := false. + proc := [lock critical: [sock wait. beenHere := true]. beenHereToo := true] fork. + Processor yield. + self assert: proc suspendingList == sock. + proc terminate. + self deny: lock isOwned. + self assert: lock isEmpty. + self deny: beenHere. + self deny: beenHereToo! Item was added: + ----- Method: MutexTest>>testMutexInCriticalWaitInEnsure (in category 'tests') ----- + testMutexInCriticalWaitInEnsure + "This tests whether a process that has got past the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unowned." + | lock sock proc | + lock := Mutex new. + sock := Semaphore new. + proc := [[] ensure: [lock critical: [sock wait]]] fork. + Processor yield. + self assert: proc suspendingList == sock. + proc terminate. + self deny: lock isOwned. + self assert: lock isEmpty! Item was added: + ----- Method: MutexTest>>testMutexInCriticalWaitInEnsure2 (in category 'tests') ----- + testMutexInCriticalWaitInEnsure2 + "This tests whether a process that has got past the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unowned." + | lock sock proc beenHere beenHereToo | + lock := Mutex new. + sock := Semaphore new. + beenHere := beenHereToo := false. + proc := [[] ensure: [lock critical: [sock wait. beenHere := true]. beenHereToo := true]] fork. + Processor yield. + self assert: proc suspendingList == sock. + proc terminate. + self deny: lock isOwned. + self assert: lock isEmpty. + self assert: beenHere. + self assert: beenHereToo! Item was removed: - ----- Method: MutexTest>>testUnwindMutexBlockedInCritical (in category 'tests') ----- - testUnwindMutexBlockedInCritical "self run: #testMutexBlockedInCritical" - "This tests whether a mutex that is inside the primitiveEnterCriticalSection in Mutex>>critical: - leaves it unchanged." - | lock sock proc wait | - lock := Mutex new. - sock := Semaphore new. - proc := [lock critical: [sock wait]] fork. - wait := [[] ensure: [lock critical: []]] fork. - Processor yield. - self assert: proc suspendingList == sock. - self assert: wait suspendingList == lock. - self deny: lock isEmpty. - self assert: lock isOwned. - wait terminate. - Processor yield. - self assert: wait isTerminated. - self assert: proc suspendingList == sock. - self assert: wait suspendingList == nil. - self assert: lock isEmpty. - self assert: lock isOwned - ! Item was removed: - ----- Method: ProcessTest>>expectedFailures (in category 'failures') ----- - expectedFailures - - ^ #(testTerminateTerminatingProcess testResumeTerminatingProcess)! Item was changed: ----- Method: ProcessTest>>testResumeTerminatingProcess (in category 'tests') ----- testResumeTerminatingProcess + "An attempt to resume a terminating process in the middle of preparing its suspended context should raise an error; + one possible solution is to nil the suspended context of the terminating process while executing the vulnerable code" + + "Note: another solution could be to run the vulnerable part of the code in #terminate using #valueUnpreemptively; + currently, however, #valueUnpreemptively is affected by the #priority: bug described here: + http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217473…" - "An attempt to resume a terminating process should probably raise an error; - leave this test as an expected failure for the moment." + | terminatee terminator unwound | + unwound := false. + terminatee := [[Processor activeProcess suspend] ensure: [unwound := unwound not]] newProcess. + terminatee priority: Processor activePriority + 1. + terminatee resume. - | terminatee terminator resumed | - terminatee := [semaphore critical:[]. resumed := true] fork. - Processor yield. terminator := [terminatee terminate] newProcess. + terminator priority: Processor activePriority + 1. + self assert: terminatee isSuspended. - self assert: terminatee suspendingList == semaphore. self assert: terminator isSuspended. "run terminator and stop inside #terminate" + [terminator suspendedContext selectorToSendOrSelf == #bottomContext] whileFalse: [terminator step]. + self assert: terminatee suspendedContext isNil. + self deny: unwound. - terminator runUntil: [:ctx | ctx selectorToSendOrSelf = #priority:]. self assert: terminator isSuspended. + "resuming the terminatee process should causes the VM to raise an error while its suspended context is nil" - "resume the terminatee process and and check if the VM raises an error; - an error is expected because terminatee's suspendedContext equals nil" self should: [terminatee resume] raise: Error. + self assert: terminatee suspendedContext isNil. + self deny: unwound. + self assert: terminator isSuspended. + "now let the terminator finish its interrupted termination of the terminatee process" - "now let the terminator finish terminating the terminatee process" terminator resume. - Processor yield. - self assert: resumed isNil. self assert: terminatee isTerminated. + self assert: unwound. self assert: terminator isTerminated! Item was changed: ----- Method: ProcessTest>>testTerminateTerminatingProcess (in category 'tests') ----- testTerminateTerminatingProcess + "An attempt to terminate a terminating process in the middle of preparing its suspended context should do nothing; + one possible solution is to nil the suspended context of the terminating process while executing the vulnerable code." + + "Note: another solution could be to run the vulnerable part of the code in #terminate using #valueUnpreemptively; + currently, however, #valueUnpreemptively is affected by the #priority: bug described here: + http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217473…" - "An attempt to terminate a terminating process should probably raise an error; - leave this test as an expected failure for the moment." + | terminatee terminator unwound | + unwound := false. + terminatee := [[Processor activeProcess suspend] ensure: [unwound := unwound not]] newProcess. + terminatee priority: Processor activePriority + 1. + terminatee resume. - | terminatee terminator resumed | - terminatee := [semaphore critical:[]. resumed := true] fork. - Processor yield. terminator := [terminatee terminate] newProcess. + terminator priority: Processor activePriority + 1. + self assert: terminatee isSuspended. - self assert: terminatee suspendingList == semaphore. self assert: terminator isSuspended. "run terminator and stop inside #terminate" + [terminator suspendedContext selectorToSendOrSelf == #bottomContext] whileFalse: [terminator step]. + self assert: terminatee suspendedContext isNil. + self deny: unwound. - terminator runUntil: [:ctx | ctx selectorToSendOrSelf = #priority:]. self assert: terminator isSuspended. + "terminating the terminatee process again should make no difference while its suspended context is nil" + terminatee terminate. + self assert: terminatee suspendedContext isNil. + self deny: unwound. + self assert: terminator isSuspended. + "now let the terminator finish its interrupted termination of the terminatee process" - "terminate the terminatee process again and let the termination finish; - an error is expected because #terminate detected multiple termination" - self should: [terminatee terminate] raise: Error. - "now let the terminator finish terminating the terminatee process" terminator resume. - Processor yield. - self assert: resumed isNil. self assert: terminatee isTerminated. + self assert: unwound. self assert: terminator isTerminated! Item was added: + ----- Method: ProcessTest>>testTerminateTerminatingProcessBeforeUnwindTo (in category 'tests') ----- + testTerminateTerminatingProcessBeforeUnwindTo + "Terminating a terminatee process after the terminator process restarted the terminatee + process should unwind the terminatee process and let the terminator process terminate." + + | terminator terminatee unwound | + unwound := false. + terminatee := [[Semaphore new wait] ensure: [unwound := true]] fork. + Processor yield. + terminator := [terminatee terminate] newProcess. + self assert: terminatee isBlocked. + self assert: terminator isSuspended. + terminator runUntil: [:ctx | ctx selectorToSendOrSelf = #resume]. + "terminator steps until terminatee's unwind context is set" + terminator suspendedContext nextInstruction. "skip terminatee resume instruction" + terminator resume. "and run until parked at wait" + "terminatee is inside its helper stack, about to call #unwindTo:" + self assert: terminatee isSuspended. + terminatee terminate. + self assert: terminatee isTerminated. + self assert: unwound. + Processor yield. + self assert: terminator isTerminated! Item was removed: - ----- Method: SemaphoreTest>>expectedFailures (in category 'failures') ----- - expectedFailures - - ^ #(testUnwindSemaInCriticalWait)! Item was added: + ----- Method: SemaphoreTest>>testSemaAfterCriticalWait2 (in category 'tests') ----- + testSemaAfterCriticalWait2 + "This tests whether a process that has just left the wait in Semaphore>>critical: + leaves it with signaling the associated semaphore." + | s p beenHere | + s := Semaphore new. beenHere := false. + p := [s critical: [beenHere := true]] forkAt: Processor activePriority-1. + "wait until p entered the critical section" + [p suspendingList == s] whileFalse: [(Delay forMilliseconds: 10) wait]. + "Now that p entered it, signal the semaphore. p now 'owns' the semaphore + but since we are running at higher priority than p it will not get to do + anything." + s signal. + p terminate. + self assert: 1 equals: s excessSignals. + self deny: beenHere! Item was added: + ----- Method: SemaphoreTest>>testSemaAfterCriticalWaitInEnsure (in category 'tests') ----- + testSemaAfterCriticalWaitInEnsure + "This tests whether a process that has just left the wait in Semaphore>>critical: + leaves it with signaling the associated semaphore." + | s p | + s := Semaphore new. + p := [[] ensure: [s critical:[]]] forkAt: Processor activePriority-1. + "wait until p entered the critical section" + [p suspendingList == s] whileFalse: [(Delay forMilliseconds: 10) wait]. + "Now that p entered it, signal the semaphore. p now 'owns' the semaphore + but since we are running at higher priority than p it will not get to do + anything." + s signal. + p terminate. + self assert: 1 equals: s excessSignals! Item was added: + ----- Method: SemaphoreTest>>testSemaAfterCriticalWaitInEnsure2 (in category 'tests') ----- + testSemaAfterCriticalWaitInEnsure2 + "This tests whether a process that has just left the wait in Semaphore>>critical: + leaves it with signaling the associated semaphore." + | s p beenHere | + s := Semaphore new. beenHere := false. + p := [[] ensure: [s critical: [beenHere := true]]] forkAt: Processor activePriority-1. + "wait until p entered the critical section" + [p suspendingList == s] whileFalse: [(Delay forMilliseconds: 10) wait]. + "Now that p entered it, signal the semaphore. p now 'owns' the semaphore + but since we are running at higher priority than p it will not get to do + anything." + s signal. + p terminate. + self assert: 1 equals: s excessSignals. + self assert: beenHere! Item was added: + ----- Method: SemaphoreTest>>testSemaInCriticalWait2 (in category 'tests') ----- + testSemaInCriticalWait2 + "This tests whether a process that has entered the wait in Semaphore>>critical: + leaves it without signaling the associated semaphore." + | s p beenHere | + s := Semaphore new. beenHere := false. + p := [s critical: [beenHere := true]] fork. + Processor yield. + self assert: s equals: p suspendingList. + p terminate. + self assert: 0 equals: s excessSignals. + self deny: beenHere! Item was added: + ----- Method: SemaphoreTest>>testSemaInCriticalWaitInEnsure (in category 'tests') ----- + testSemaInCriticalWaitInEnsure + "This tests whether a process that has entered the wait in Semaphore>>critical: + leaves it without signaling the associated semaphore." + | s p | + s := Semaphore new. + p := [[] ensure: [s critical: []]] fork. + Processor yield. + self assert: s equals: p suspendingList. + p terminate. + self assert: 0 equals: s excessSignals! Item was added: + ----- Method: SemaphoreTest>>testSemaInCriticalWaitInEnsure2 (in category 'tests') ----- + testSemaInCriticalWaitInEnsure2 + "This tests whether a process that has entered the wait in Semaphore>>critical: + leaves it without signaling the associated semaphore." + | s p beenHere | + s := Semaphore new. beenHere := false. + p := [[] ensure: [s critical: [beenHere := true]]] fork. + Processor yield. + self assert: s equals: p suspendingList. + p terminate. + self assert: 0 equals: s excessSignals. + self deny: beenHere! Item was removed: - ----- Method: SemaphoreTest>>testUnwindSemaInCriticalWait (in category 'tests') ----- - testUnwindSemaInCriticalWait "self run: #testSemaInCriticalWait" - "This tests whether a semaphore that has entered the wait in Semaphore>>critical: - leaves it without signaling the associated semaphore." - | s p | - s := Semaphore new. - p := [[] ensure: [s critical:[]]] fork. - Processor yield. - self assert:(p suspendingList == s). - p terminate. - self assert: 0 equals: s excessSignals!

1 0

The Trunk: Kernel-mt.1504.mcz
by commits＠source.squeak.org 16 Feb '23

16 Feb '23

Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-mt.1504.mcz ==================== Summary ==================== Name: Kernel-mt.1504 Author: mt Time: 16 February 2023, 9:37:50.549287 am UUID: 213eecba-61aa-fc4d-bae3-52aaf4eaa8c0 Ancestors: Kernel-jar.1500, Kernel-jar.1501, Kernel-jar.1502, Kernel-jar.1503 Merge, merge, merge. :-) Big thanks to Jaromir (jar)!! Kernel-jar.1500: Fix #terminateAggressively and #runUntilErrorOrReturnFrom: bugs. Both bugs combined cause the Debugger MNU in this situation: [...] Kernel-jar.1501: fix and improve: #terminate [...] #suspendAndReleaseCriticalSection [...] #unwindAndStop: [...] #unwindTo: safely: [...] Kernel-jar.1502: make Context #methodReturnContexts a synonym of #home; make BlockClosure and FullBlockClosure #homeMethod synonyms of #method [...] Kernel-jar.1503: remove unwind code duplication and fix the "stepOver bug" (Cannot #stepOver '^2' in example '[^2] ensure: []') [...] =============== Diff against Kernel-tpr.1497 =============== Item was changed: ----- Method: BlockClosure>>hasMethodReturn (in category 'testing') ----- hasMethodReturn "Answer whether the receiver has a method-return ('^') in its code." | scanner endpc | + scanner := InstructionStream new method: self method pc: startpcOrMethod. - scanner := InstructionStream new method: outerContext method pc: startpcOrMethod. endpc := self endPC. + scanner scanFor: + [:byte | + scanner willReturn ifTrue: + [scanner willBlockReturn ifFalse: + [^true]]. + scanner pc >= endpc]. + ^false! - scanner scanFor: [:byte | (byte between: 120 and: 124) or: [scanner pc > endpc]]. - ^scanner pc <= endpc! Item was changed: ----- Method: BlockClosure>>homeMethod (in category 'accessing') ----- homeMethod + "Answer the home method associated with the receiver. + This is polymorphic with BlockClosure, CompiledCode, Context etc." + + ^self method! - ^outerContext method! 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 removed: - ----- Method: CompiledBlock>>homeMethod (in category 'accessing') ----- - homeMethod - "answer the compiled method that I am installed in, or nil if none." - ^self outerCode homeMethod! Item was changed: ----- Method: CompiledCode>>homeMethod (in category 'accessing') ----- homeMethod + "Answer the home method associated with the receiver. + This is polymorphic with BlockClosure, CompiledCode, Context etc." - "Answer the home method associated with the receiver." + ^self method! - ^self subclassResponsibility! Item was removed: - ----- Method: CompiledMethod>>homeMethod (in category 'accessing') ----- - homeMethod - "Answer the home method associated with the receiver. - This is polymorphic with closure, CompiledBlock, Context etc" - - ^self! Item was changed: ----- Method: Context>>home (in category 'accessing') ----- home + "Answer the outermost context (along the static chain) for the receiver. + This is the outermost lexical scope in which the receiver's method is defined." - "Answer the context in which the receiver was defined." + ^closureOrNil + ifNil: [self] "normal method activation" + ifNotNil: "block activation" + [:closure| + closure outerContext + ifNil: [self] "clean block" + ifNotNil: [:outerContext| outerContext home]] "normal block"! - closureOrNil == nil ifTrue: - [^self]. - ^closureOrNil outerContext home! Item was changed: ----- Method: Context>>homeMethod (in category 'accessing') ----- homeMethod "Answer the home method associated with the receiver. + This is polymorphic with BlockClosure, CompiledCode, Context etc." + + ^self method! - This is polymorphic with BlockClosure, CompiledCode, etc" - ^method homeMethod! Item was changed: ----- Method: Context>>methodReturnContext (in category 'accessing') ----- methodReturnContext "Answer the context from which an ^-return should return from." + ^self home! - closureOrNil == nil ifTrue: - [^self]. - ^closureOrNil outerContext methodReturnContext! Item was changed: ----- Method: Context>>restart (in category 'controlling') ----- restart "Unwind thisContext to self and resume from beginning. Execute unwind blocks when unwinding. ASSUMES self is a sender of thisContext" + ^self resumeEvaluating: [self privRefresh]! - | ctxt unwindBlock | - self isDead ifTrue: [self cannotReturn: nil to: self]. - self privRefresh. - ctxt := thisContext. - [ ctxt := ctxt findNextUnwindContextUpTo: self. - ctxt isNil - ] whileFalse: [ - (ctxt tempAt: 2) ifNil:[ - ctxt tempAt: 2 put: true. - unwindBlock := ctxt tempAt: 1. - thisContext terminateTo: ctxt. - unwindBlock value]. - ]. - thisContext terminateTo: self. - self jump. - ! Item was changed: ----- Method: Context>>resume:through: (in category 'controlling') ----- resume: value through: firstUnwindCtxt "Unwind thisContext to self and resume with value as result of last send. Execute any unwind blocks while unwinding. ASSUMES self is a sender of thisContext." + ^self resumeEvaluating: [value] through: firstUnwindCtxt! - | ctxt unwindBlock | - self isDead ifTrue: [self cannotReturn: value to: self]. - ctxt := firstUnwindCtxt. - [ctxt isNil] whileFalse: - [(ctxt tempAt: 2) ifNil: - [ctxt tempAt: 2 put: true. - unwindBlock := ctxt tempAt: 1. - thisContext terminateTo: ctxt. - unwindBlock value]. - ctxt := ctxt findNextUnwindContextUpTo: self]. - thisContext terminateTo: self. - ^value - ! Item was changed: ----- Method: Context>>resumeEvaluating: (in category 'controlling') ----- resumeEvaluating: aBlock "Unwind thisContext to self and resume with value as result of last send. Execute unwind blocks when unwinding. ASSUMES self is a sender of thisContext" + ^self resumeEvaluating: aBlock through: nil! - | ctxt unwindBlock | - self isDead ifTrue: [self cannotReturn: aBlock value to: self]. - ctxt := thisContext. - [ ctxt := ctxt findNextUnwindContextUpTo: self. - ctxt isNil - ] whileFalse: [ - (ctxt tempAt: 2) ifNil:[ - "(tempAt: 2) refers to complete temporary in ensure: and ifCurtailed: - or any other method marked with <primitive: 198>" - ctxt tempAt: 2 put: true. - unwindBlock := ctxt tempAt: 1. - thisContext terminateTo: ctxt. - unwindBlock value]. - ]. - thisContext terminateTo: self. - ^ aBlock value - ! Item was added: + ----- Method: Context>>resumeEvaluating:through: (in category 'controlling') ----- + resumeEvaluating: aBlock through: firstUnwindCtxtOrNil + "Unwind thisContext to self and resume with value as result of last send. + Execute unwind blocks when unwinding. + ASSUMES self is a sender of thisContext." + + self isDead ifTrue: [self cannotReturn: aBlock value to: self]. + (firstUnwindCtxtOrNil ifNil: thisContext) unwindTo: self safely: false. + thisContext terminateTo: self. + ^aBlock value! Item was changed: ----- Method: Context>>return:from: (in category 'instruction decoding') ----- return: value from: aSender "For simulation. Roll back self to aSender and return value from it. Execute any unwind blocks on the way. ASSUMES aSender is a sender of self" | newTop | aSender isDead ifTrue: [^self send: #cannotReturn: to: self with: {value}]. newTop := aSender sender. (self findNextUnwindContextUpTo: newTop) ifNotNil: + "Send #aboutToReturn:through: with nil as the second argument to avoid this bug: + Cannot #stepOver '^2' in example '[^2] ensure: []'. - [:unwindProtectCtxt| - self flag: #knownBug. "Cannot #stepOver '^2' in example '[^2] ensure: []'. See http://lists.squeakfoundation.org/pipermail/squeak-dev/2022-June/220975.html" + [^self send: #aboutToReturn:through: to: self with: {value. nil}]. - ^self send: #aboutToReturn:through: to: self with: {value. unwindProtectCtxt}]. self releaseTo: newTop. newTop ifNotNil: [newTop push: value]. ^newTop! Item was changed: ----- Method: Context>>runUntilErrorOrReturnFrom: (in category 'controlling') ----- runUntilErrorOrReturnFrom: aSender "ASSUMES aSender is a sender of self. Execute self's stack until aSender returns or an unhandled exception is raised. Return a pair containing the new top context and a possibly nil exception. The exception is not nil if it was raised before aSender returned and it was not handled. The exception is returned rather than openning the debugger, giving the caller the choice of how to handle it." "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 aSender that jumps back to thisContext when evaluated. We also insert an exception handler under aSender that jumps back to thisContext when an unhandled exception is raised. In either case, the inserted ensure and exception handler are removed once control jumps back to thisContext." | error ctxt here topContext | here := thisContext. "Insert ensure and exception handler contexts under aSender" error := nil. ctxt := aSender insertSender: (Context contextOn: UnhandledError do: [:ex | error ifNil: [ error := ex exception. topContext := thisContext. ex resumeUnchecked: here jump] ifNotNil: [ex pass] ]). ctxt := ctxt insertSender: (Context contextEnsure: [error ifNil: [ topContext := thisContext. here jump] ]). self jump. "Control jumps to self" "Control resumes here once above ensure block or exception handler is executed" ^ error ifNil: [ "No error was raised, remove ensure context by stepping until popped" + [ctxt isDead or: [topContext isNil]] whileFalse: [topContext := topContext stepToCallee]. - [ctxt isDead] whileFalse: [topContext := topContext stepToCallee]. {topContext. nil} ] ifNotNil: [ "Error was raised, remove inserted above contexts then return signaler context" aSender terminateTo: ctxt sender. "remove above ensure and handler contexts" {topContext. error} ]! 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 removed: - ----- Method: FullBlockClosure>>homeMethod (in category 'accessing') ----- - homeMethod - ^startpcOrMethod homeMethod! 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-conte…" - | 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 changed: ----- Method: Process>>terminateAggressively (in category 'changing process state') ----- terminateAggressively "Stop the receiver forever. Run all unwind contexts (#ensure:/#ifCurtailed: blocks) on the stack that have not yet been started. If the process is in the middle of an unwind block, then that unwind block will not be completed, but subsequent unwind blocks will be run. If even those unwind contexts should be continued, send #terminate 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: critical section, release it properly." | oldList bottom tombstone | self isActiveProcess ifTrue: [ "If terminating the active process, suspend it first and terminate it as a suspended process." [self terminate] fork. ^self suspend]. "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." oldList := self suspend. suspendedContext ifNil: [^ self "Process 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]). bottom := suspendedContext bottomContext. tombstone := bottom insertSender: [self suspend "terminated"] asContext. suspendedContext := self activateReturn: bottom value: nil. self complete: tombstone ifError: [:ex | + (suspendedContext ifNil: [^self]) privRefresh. "Restart the handler context of UnhandledError so that when the receiver is resumed, its #defaultAction will be reached. See implementation details in #runUntilErrorOrReturnFrom:." - suspendedContext privRefresh. "Restart the handler context of UnhandledError so that when the receiver is resumed, its #defaultAction will be reached. See implementation details in #runUntilErrorOrReturnFrom:." "We're not yet done, resume the receiver to spawn a new debugger on the error." self resume].! 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!

1 0

Inbox cleanup before sending more
by Jaromir Matas 16 Feb '23

16 Feb '23

Hi all, I'd like to ask you for your help: I'd like to finalize my work on process termination; I have a few bugfixes for someone to merge, some more tests and small improvements covering boundary cases that do not change the termination semantics. I don't think these final changes require a thorough review and believe they can be merged right away as they have been thoroughly tested and most of them are already running fine in Cuis and have been tested in Pharo too. Unfortunately I've discovered many of my contributions that had already been merged or moved to the Treated box reappeared in the Inbox, which is wrong, so I'd like to help tidy the Inbox first; I guess it doesn't make much sense for me to just send more changesets to the Inbox before the cleanup. I'm aware you're busy and hate to take up your time; please let me know how I can help. best, Jaromir -- Jaromír Matas mail(a)jaromir.net

2 4

The Inbox: Collections-jar.1028.mcz
by commits＠source.squeak.org 16 Feb '23

16 Feb '23

A new version of Collections was added to project The Inbox: http://source.squeak.org/inbox/Collections-jar.1028.mcz ==================== Summary ==================== Name: Collections-jar.1028 Author: jar Time: 16 February 2023, 8:00:13.16881 am UUID: 60a0cd75-df99-1942-8d6a-3fbe0615b1aa Ancestors: Collections-mt.1027 complement Kernel-jar.1501 (#terminate etc) =============== Diff against Collections-mt.1027 =============== Item was added: + ----- Method: LinkedList>>releaseCriticalSection: (in category 'private') ----- + releaseCriticalSection: aContext + "A helper method for Process suspendAndReleaseCriticalSection; + aContext receiver represents a condition variable, i.e. a Semaphore + or a Mutex (or any other in case of future new condition variables), + which will take care of releasing the critical section properly." + + ^aContext receiver stepIntoCriticalSection: aContext!

1 0

The Inbox: Kernel-jar.1503.mcz
by commits＠source.squeak.org 15 Feb '23

15 Feb '23

A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1503.mcz ==================== Summary ==================== Name: Kernel-jar.1503 Author: jar Time: 15 February 2023, 5:20:15.299287 pm UUID: 63fd8775-0f3d-7f49-93f3-a116e9fbb3d5 Ancestors: Kernel-eem.1498 remove unwind code duplication and fix the "stepOver bug" (Cannot #stepOver '^2' in example '[^2] ensure: []') See http://lists.squeakfoundation.org/pipermail/squeak-dev/2023-February/223443… for detailed explanation =============== Diff against Kernel-eem.1498 =============== Item was changed: ----- Method: Context>>restart (in category 'controlling') ----- restart "Unwind thisContext to self and resume from beginning. Execute unwind blocks when unwinding. ASSUMES self is a sender of thisContext" + ^self resumeEvaluating: [self privRefresh]! - | ctxt unwindBlock | - self isDead ifTrue: [self cannotReturn: nil to: self]. - self privRefresh. - ctxt := thisContext. - [ ctxt := ctxt findNextUnwindContextUpTo: self. - ctxt isNil - ] whileFalse: [ - (ctxt tempAt: 2) ifNil:[ - ctxt tempAt: 2 put: true. - unwindBlock := ctxt tempAt: 1. - thisContext terminateTo: ctxt. - unwindBlock value]. - ]. - thisContext terminateTo: self. - self jump. - ! Item was changed: ----- Method: Context>>resume:through: (in category 'controlling') ----- resume: value through: firstUnwindCtxt "Unwind thisContext to self and resume with value as result of last send. Execute any unwind blocks while unwinding. ASSUMES self is a sender of thisContext." + ^self resumeEvaluating: [value] through: firstUnwindCtxt! - | ctxt unwindBlock | - self isDead ifTrue: [self cannotReturn: value to: self]. - ctxt := firstUnwindCtxt. - [ctxt isNil] whileFalse: - [(ctxt tempAt: 2) ifNil: - [ctxt tempAt: 2 put: true. - unwindBlock := ctxt tempAt: 1. - thisContext terminateTo: ctxt. - unwindBlock value]. - ctxt := ctxt findNextUnwindContextUpTo: self]. - thisContext terminateTo: self. - ^value - ! Item was changed: ----- Method: Context>>resumeEvaluating: (in category 'controlling') ----- resumeEvaluating: aBlock "Unwind thisContext to self and resume with value as result of last send. Execute unwind blocks when unwinding. ASSUMES self is a sender of thisContext" + ^self resumeEvaluating: aBlock through: nil! - | ctxt unwindBlock | - self isDead ifTrue: [self cannotReturn: aBlock value to: self]. - ctxt := thisContext. - [ ctxt := ctxt findNextUnwindContextUpTo: self. - ctxt isNil - ] whileFalse: [ - (ctxt tempAt: 2) ifNil:[ - "(tempAt: 2) refers to complete temporary in ensure: and ifCurtailed: - or any other method marked with <primitive: 198>" - ctxt tempAt: 2 put: true. - unwindBlock := ctxt tempAt: 1. - thisContext terminateTo: ctxt. - unwindBlock value]. - ]. - thisContext terminateTo: self. - ^ aBlock value - ! Item was added: + ----- Method: Context>>resumeEvaluating:through: (in category 'controlling') ----- + resumeEvaluating: aBlock through: firstUnwindCtxtOrNil + "Unwind thisContext to self and resume with value as result of last send. + Execute unwind blocks when unwinding. + ASSUMES self is a sender of thisContext." + + self isDead ifTrue: [self cannotReturn: aBlock value to: self]. + (firstUnwindCtxtOrNil ifNil: thisContext) unwindTo: self safely: false. + thisContext terminateTo: self. + ^aBlock value! Item was changed: ----- Method: Context>>return:from: (in category 'instruction decoding') ----- return: value from: aSender "For simulation. Roll back self to aSender and return value from it. Execute any unwind blocks on the way. ASSUMES aSender is a sender of self" | newTop | aSender isDead ifTrue: [^self send: #cannotReturn: to: self with: {value}]. newTop := aSender sender. (self findNextUnwindContextUpTo: newTop) ifNotNil: + "Send #aboutToReturn:through: with nil as the second argument to avoid this bug: + Cannot #stepOver '^2' in example '[^2] ensure: []'. - [:unwindProtectCtxt| - self flag: #knownBug. "Cannot #stepOver '^2' in example '[^2] ensure: []'. See http://lists.squeakfoundation.org/pipermail/squeak-dev/2022-June/220975.html" + [^self send: #aboutToReturn:through: to: self with: {value. nil}]. - ^self send: #aboutToReturn:through: to: self with: {value. unwindProtectCtxt}]. self releaseTo: newTop. newTop ifNotNil: [newTop push: value]. ^newTop!

1 0

The Inbox: Kernel-jar.1502.mcz
by commits＠source.squeak.org 15 Feb '23

15 Feb '23

A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1502.mcz ==================== Summary ==================== Name: Kernel-jar.1502 Author: jar Time: 15 February 2023, 4:58:07.875244 pm UUID: 14e0c30b-c6a4-7a4f-b869-3cc2e605eef6 Ancestors: Kernel-eem.1498 make Context #methodReturnContexts a synonym of #home; make BlockClosure and FullBlockClosure #homeMethod synonyms of #method (current code makes it rather difficult to realize #homeMethod and #method are actually synonymous) =============== Diff against Kernel-eem.1498 =============== Item was changed: ----- Method: BlockClosure>>homeMethod (in category 'accessing') ----- homeMethod + "Answer the home method associated with the receiver. + This is polymorphic with BlockClosure, CompiledCode, Context etc." + + ^self method! - ^outerContext method! Item was removed: - ----- Method: CompiledBlock>>homeMethod (in category 'accessing') ----- - homeMethod - "answer the compiled method that I am installed in, or nil if none." - ^self outerCode homeMethod! Item was changed: ----- Method: CompiledCode>>homeMethod (in category 'accessing') ----- homeMethod + "Answer the home method associated with the receiver. + This is polymorphic with BlockClosure, CompiledCode, Context etc." - "Answer the home method associated with the receiver." + ^self method! - ^self subclassResponsibility! Item was removed: - ----- Method: CompiledMethod>>homeMethod (in category 'accessing') ----- - homeMethod - "Answer the home method associated with the receiver. - This is polymorphic with closure, CompiledBlock, Context etc" - - ^self! Item was changed: ----- Method: Context>>homeMethod (in category 'accessing') ----- homeMethod "Answer the home method associated with the receiver. + This is polymorphic with BlockClosure, CompiledCode, Context etc." + + ^self method! - This is polymorphic with BlockClosure, CompiledCode, etc" - ^method homeMethod! Item was changed: ----- Method: Context>>methodReturnContext (in category 'accessing') ----- methodReturnContext "Answer the context from which an ^-return should return from." + ^self home! - closureOrNil == nil ifTrue: - [^self]. - ^closureOrNil outerContext methodReturnContext! Item was removed: - ----- Method: FullBlockClosure>>homeMethod (in category 'accessing') ----- - homeMethod - ^startpcOrMethod homeMethod!

1 0

The Inbox: Kernel-jar.1501.mcz
by commits＠source.squeak.org 15 Feb '23

15 Feb '23

A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/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-conte…" - | 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!

1 0

← Newer
1
...
5
6
7
8
9
10
11
Older →