Christoph Thiede uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ct.1545.mcz
==================== Summary ====================
Name: Kernel-ct.1545 Author: ct Time: 30 December 2023, 6:07:29.181543 pm UUID: 4089c9dd-3a41-1240-8e53-b7a8a6fe1cae Ancestors: Kernel-mt.1544, Kernel-jar.1539
Merges Kernel-jar.1537, Kernel-jar.1538, and Kernel-jar.1539, which make 'Computation has been terminated' a regular error, fix the simulation of non-local returns for dead senders, and store the final context in BlockCannotReturn exceptions.
=============== Diff against Kernel-mt.1544 ===============
Item was changed: Error subclass: #BlockCannotReturn + instanceVariableNames: 'pc result deadHome finalContext' - instanceVariableNames: 'pc result deadHome' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Exceptions'!
!BlockCannotReturn commentStamp: '<historical>' prior: 0! This class is private to the EHS implementation. Its use allows for ensured execution to survive code such as:
[self doThis. ^nil] ensure: [self doThat]
Signaling or handling this exception is not recommended.!
Item was added: + ----- Method: BlockCannotReturn>>finalContext (in category 'accessing') ----- + finalContext + + ^ finalContext!
Item was added: + ----- Method: BlockCannotReturn>>finalContext: (in category 'accessing') ----- + finalContext: context + + finalContext := context!
Item was changed: ----- Method: Context>>cannotReturn: (in category 'private-exceptions') ----- cannotReturn: result
closureOrNil ifNotNil: [^ self cannotReturn: result to: self home sender]. + self error: 'Computation has been terminated!!'! - Processor debugWithTitle: 'Computation has been terminated!!' translated full: false.!
Item was changed: ----- Method: Context>>cannotReturn:to: (in category 'private') ----- cannotReturn: result to: homeContext "The receiver tried to return result to homeContext that cannot be returned from. + Capture the return context/pc in a BlockCannotReturn. Nil the pc to prevent repeat - Capture the return pc in a BlockCannotReturn. Nil the pc to prevent repeat attempts and/or invalid continuation. Answer the result of raising the exception."
+ | exception previousPc | - | exception | exception := BlockCannotReturn new. + previousPc := pc ifNotNil: [self previousPc]. exception result: result; deadHome: homeContext; + finalContext: self; + pc: previousPc. - pc: self previousPc. pc := nil. ^exception signal!
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. + (aSender isDead or: [newTop isNil or: [newTop isDead]]) ifTrue: + [^self pc: nil; send: #cannotReturn: to: self with: {value}]. (self findNextUnwindContextUpTo: newTop) ifNotNil: "Send #aboutToReturn:through: with nil as the second argument to avoid this bug: 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 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 stepToCalleeOrNil]. - [ctxt isDead or: [topContext isNil]] 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>>stepToCalleeOrNil (in category 'private') ----- + stepToCalleeOrNil + "Step to callee or sender; step to return and answer nil in case sender cannot be returned to." + + | ctxt | + ctxt := self. + [(ctxt willReturn and: [ctxt sender isNil or: [ctxt sender isDead]]) not and: [(ctxt := ctxt step) == self]] whileTrue. + ctxt == self ifTrue: [^nil]. + ^ctxt!