[squeak-dev] The Trunk: Kernel-mt.1504.mczcommits at source.squeak.org commits at source.squeak.orgThu Feb 16 08:37:52 UTC 2023
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-context-of-priority-inversion-was-SemaphoreTest-fail-td5082184.html" - | 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!
More information about the Squeak-dev mailing list |