Squeak-dev February 2023

squeak-dev@lists.squeakfoundation.org

28 participants
108 discussions

How do I create a "synthetic" keyboard event?
by Eduardo Ochs 19 Feb '23

19 Feb '23

Hi list, this is a follow-up to these two messages: http://lists.squeakfoundation.org/pipermail/squeak-dev/2023-February/223407… http://lists.squeakfoundation.org/pipermail/squeak-dev/2023-February/223408… The first one was a question that I asked, and the second was an answer by Marcel Taeumel. I was able to decypher almost all his pointers - but not yet this one: HandMorph >> #generateKeyboardEvent: I am using this code: a := Array with: 50@100 with: 200@300 with: 100@400. b := (PolygonMorph vertices: a color: Color red borderWidth: 1 borderColor: Color black). World addMorph: b. b beSmoothCurve. b beStraightSegments. b vertices. b vertices at: 1. b vertices at: 1 put: 40@100. b vertices at: 1 put: 50@100. b vertices at: 1 put: 40@100. b computeBounds. b vertices at: 1 put: 50@100. b computeBounds. b color. b color: Color banana. b color: Color red. e := EventHandler new. b eventHandler. b eventHandler: nil. b eventHandler: e. bl := [ :a :b | { a . b }]. bl := [ :a :b | Transcript show: { a . b }; cr. ]. bl numArgs. bl value: 2 value: 3. bl perform: #value:value: with: 2 with: 3. bl := [ :evt :sm | Transcript show: { evt . sm }; cr. ]. bl := [ :evt :sm | Transcript show: { evt keyValue . sm }; cr. ]. bl := [ :evt :sm | self halt. ]. e on: #keyStroke send: #value:value: to: bl. b currentHand newKeyboardFocus: b. It is meant to be used in a workspace. By selecting the right parts of it and running them with "do it"s or "print it"s in the right order I can create a PolygonMorph, some EventHandlers, and some blocks, and then I can make the PolygonMorph react to keyboard events in different ways. The last line switches the keyboardFocus to my PolygonMorph, and then I can send several keystroke events to my PolygonMorph, and inspect their events either on the transcript or on the debugger. Question: suppose that evt is an event whose printed representation is this one: [79@273 keystroke ' ' (32) 956759] I know that this means that: evt position -> 79@273 evt type -> #keystroke evt keyValue -> 32 evt keyCode -> 32 evt source -> self currentHand evt timeStamp -> 956759 How do I write code that creates an event like that? I would like to create, ahem, "synthetic keystrokes", and experiment with sending them to certain morphs... Thanks in advance! Eduardo Ochs http://anggtwu.net/eev-squeak.html

2 6

The Inbox: EToys-kfr.494.mcz
by commits＠source.squeak.org 19 Feb '23

19 Feb '23

A new version of EToys was added to project The Inbox: http://source.squeak.org/inbox/EToys-kfr.494.mcz ==================== Summary ==================== Name: EToys-kfr.494 Author: kfr Time: 19 February 2023, 10:06:55.164135 am UUID: 6c582812-887d-3647-bd6b-8c072e2d7e65 Ancestors: EToys-kfr.493 Fix typo =============== Diff against EToys-kfr.493 =============== Item was changed: ----- Method: EventRollMorph>>makeControlsPanel (in category 'processing') ----- makeControlsPanel "One-time initialization. Upon entry, the receiver has no submorphs; upon exit, it has one, namely its controlsPanel, which contains the scale slider, the track headings, and the control buttons." | topWrapper labelWrapper aMorph aPanel | aPanel := AlignmentMorph newColumn beTransparent. aPanel hResizing: #shrinkWrap; vResizing: #shrinkWrap. topWrapper := AlignmentMorph newRow beTransparent. + topWrapper hResizing: #spaceFill; vResizing: #shrinkWrap. - topWrapper hResizing: #spaceFill; vResizing: #shirnkWrap. topWrapper rubberBandCells: true. labelWrapper := AlignmentMorph newColumn beTransparent. labelWrapper addTransparentSpacerOfSize: 0@4. #('mouse' 'keyboard' 'media') translatedNoop do: [:aString | aMorph := Morph new extent: 80@ 20. aMorph hResizing: #rigid; vResizing: #rigid. aMorph beTransparent. aMorph addMorphCentered: (StringMorph contents: aString translated font: (StrikeFont familyName: 'Accujen' size: 24)). labelWrapper addMorphBack: aMorph. labelWrapper addTransparentSpacerOfSize: 0@20]. labelWrapper submorphs last delete. "that last spacer" topWrapper addMorphBack: labelWrapper. labelWrapper on: #mouseDown send: #grabMorph: to: self. topWrapper addMorphBack: self scaleSlider. aPanel addMorphBack: topWrapper. aPanel addMorphBack: self makeButtonsPanel. self addMorph: aPanel!

1 0

The Inbox: EToys-kfr.493.mcz
by commits＠source.squeak.org 19 Feb '23

19 Feb '23

A new version of EToys was added to project The Inbox: http://source.squeak.org/inbox/EToys-kfr.493.mcz ==================== Summary ==================== Name: EToys-kfr.493 Author: kfr Time: 19 February 2023, 10:01:46.774135 am UUID: 937ea9cb-4db2-d04c-a283-97614b109562 Ancestors: EToys-mt.492 Change eventType to type =============== Diff against EToys-mt.492 =============== Item was changed: ----- Method: KeyboardEventSequence>>addKeystrokeEventsTo: (in category 'debugging') ----- addKeystrokeEventsTo: aStream "Add any keystroke event to a stream" + events do: [:e | e type = #keystroke ifTrue: - events do: [:e | e eventType = #keystroke ifTrue: [aStream nextPut: e]]! Item was changed: ----- Method: MentoringEventRecorder>>handleEscape (in category 'commands') ----- handleEscape "The user hit esc to stop recording or playback, so stop." | interimTape unmatchedMouseDown upEvent | tapeStream ifNotNil: [(#(recording recordingWithSound) includes: self state ) ifTrue: [interimTape := tapeStream contents. unmatchedMouseDown := nil. interimTape reversed detect: [:evt | + evt type = #mouseDown - evt eventType = #mouseDown ifTrue: [unmatchedMouseDown := evt. true] ifFalse: + [evt type = #mouseUp]] - [evt eventType = #mouseUp]] ifNone: [nil]. unmatchedMouseDown ifNotNil: ["synthesize a matching up-event" upEvent := unmatchedMouseDown veryDeepCopy. upEvent timeStamp: Time millisecondClockValue. upEvent setType: #mouseUp. tapeStream nextPut: upEvent]. tape := tapeStream contents. saved := false]]. self pauseIn: self world. tapeStream := nil. recordMeter ifNotNil: [recordMeter width: 1]. recordingSpace escapeHitInEventRecorder!

1 0

Improve termination behavior when in #critical section
by Jaromir Matas 18 Feb '23

18 Feb '23

Hi Eliot, Nicolas, or anyone interested in context juggling, A few Process/Semaphore/Mutex tests have been left as expected failures in the current image. It's time to fix them. I'd very much appreciate if you could review/merge the improved versions of #terminate and *especially* #suspendAndReleaseCriticalSection that finally make all currently failing tests pass. Sent in Kernel-jar.1498 and KernelTests-jar.443. In addition, I've added a few Mutex and Semaphore tests to further illustrate the behavior when terminating a process stuck in a #critical section, especially when the critical section itself is inside an unwind block (which has previously not been fully addressed). The steps in #suspendAndReleaseCriticalSection should, hopefully, be sufficiently commented. In case you'd like to hear more detailed comments or explanations I'll be happy to elaborate. The changes have been tested also in Cuis which gives me more confidence they're solid. Thanks for any comments. Best, Jaromir -- Jaromír Matas mail(a)jaromir.net

2 5

The Trunk: Tools-jar.1189.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-jar.1189.mcz ==================== Summary ==================== Name: Tools-jar.1189 Author: jar Time: 31 January 2023, 6:13:22.676927 pm UUID: 70af9ca9-39c5-3944-a8dc-84124e321288 Ancestors: Tools-mt.1188 fix a bug when doing stepInto; this fix makes the three methods #stepInto, #stepOver and #stepThrough consistent. Sending an example in a separate message. =============== Diff against Tools-mt.1188 =============== 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-jar.443.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-jar.443.mcz ==================== Summary ==================== Name: KernelTests-jar.443 Author: jar Time: 30 January 2023, 5:33:22.893677 pm UUID: 4f815d5d-a166-d141-8fca-d9d0d57f0b93 Ancestors: KernelTests-tpr.441 Complement Kernel-jar.1498 =============== Diff against KernelTests-tpr.441 =============== 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: KernelTests-jar.442.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-jar.442.mcz ==================== Summary ==================== Name: KernelTests-jar.442 Author: jar Time: 26 January 2023, 10:37:59.494205 pm UUID: d69aa3b9-4497-6840-935d-1be1ea5f6b80 Ancestors: KernelTests-tpr.441 add setUp and tearDown methods to MonitorTest class to prevent tests from leaving unterminated (blocked on a semaphore) processes behind =============== 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])!

1 0

The Trunk: Kernel-jar.1503.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.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 Trunk: Kernel-jar.1502.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.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 Trunk: Kernel-jar.1501.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.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
...
4
5
6
7
8
9
10
11
Older →