The Inbox: Kernel-jar.1408.mcz

A new version of Kernel was added to project The Inbox:
http://source.squeak.org/inbox/Kernel-jar.1408.mcz

==================== Summary ====================

Name: Kernel-jar.1408
Author: jar
Time: 14 May 2021, 4:26:31.500152 pm
UUID: 0e0ea158-ad50-464c-847c-76413db42968
Ancestors: Kernel-nice.1407

Improve (and supersede) #terminate from Kernel-jar.1406.

The point is the Debugger actually resumes after finding an error and only updates its title ( which I never fully noticed :o ) but during termination each nested error opens a new debugger - this means I can't override #runUntilErrorOrReturnFrom: as I suggested previously so I created its copy named #runUnwindUntilErrorOrReturnFrom: with the modified functionality required by #terminate. (It's a code duplication, I know, but I'd like to get it working now)

On top of that I extracted a repeating part of #terminate's code to a new method #complete:to: to improve readability and avoid further code duplication.

So you can now debug safely (and correctly) even examples like:

[self error] ensure: [^2]

=============== Diff against Kernel-nice.1407 ===============

Item was added:
+ ----- Method: Context>>runUnwindUntilErrorOrReturnFrom: (in category 'controlling') -----
+ runUnwindUntilErrorOrReturnFrom: 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.
+ here jump.
+ ex signalerContext restart "re-signal the error when jumped back"]
+ 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] 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: Process>>complete:to: (in category 'private') -----
+ complete: topContext to: aContext
+ "Run topContext on behalf of self on topContext's stack until aContext is popped or an unhandled
+ error is raised. Return self's new top context. Note: topContext must be a stack top context.
+ This method is meant to be called primarily by Process>>#terminate."
+
+ | pair top error doNotDebug |
+ pair := Processor activeProcess
+ evaluate: [topContext runUnwindUntilErrorOrReturnFrom: aContext]
+ onBehalfOf: self.
+ top := pair first.
+ error := pair second.
+ "Define an exclusion list of exceptions requiring special care to prevent e.g. an infinite recursion
+ of BlockCannotReturn or MessageNotUnderstood errors; blocks containing these exceptions are
+ skipped silently and the unwind procedure continues."
+ doNotDebug := {BlockCannotReturn. MessageNotUnderstood}.
+ "If an error was detected jump back to #runUntilErrorOrReturnFrom: to open a debugger unless
+ the error is in the doNotDebug list."
+ error ifNotNil: [(doNotDebug includes: error class) ifFalse: [top jump]].
+ ^top
+ !

Item was changed:
  ----- Method: Process>>terminate (in category 'changing process state') -----
  terminate
  "Stop the process that the receiver represents forever.
  Unwind to execute pending ensure:/ifCurtailed: blocks before terminating.
  If the process is in the middle of a critical: critical section, release it properly."
 
+ | ctxt unwindBlock oldList outerMost top newTop |
- | ctxt unwindBlock oldList outerMost top pair doNotDebug |
  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, and if it is nil then the process is already suspended."
  oldList := self suspend.
  suspendedContext ifNotNil: [
  "Release any method marked with the <criticalSection> pragma.
   The argument is whether the process is runnable."
  self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]).
 
+ top := suspendedContext.
+ suspendedContext := nil. "disable this process while running its stack in active process below"
- ctxt := top := suspendedContext.
- "Disable this process while running its stack in active process below"
- suspendedContext := nil.
- "Define an exclusion list of exceptions requiring special care to prevent e.g. an infinite
- recursion of MNU errors or a VM crash in case of a non-local return to a dead home context;
- blocks containing these exceptions are silently skipped and the unwind procedure continues;
- UndefinedObject represents #runUntilErrorOrReturnFrom: found no error and answered nil."
- doNotDebug := {UndefinedObject. BlockCannotReturn. MessageNotUnderstood}.
  "If terminating a process halfways through an unwind, try to complete that unwind block first;
  if there are multiple such nested unwind blocks, try to complete the outer-most one; the inner
  blocks will be completed in the process. Halfway through blocks have already set the complete
  variable (tempAt: 2) in their defining #ensure:/#ifCurtailed contexts from nil to true."
+ ctxt := top.
  [(ctxt := ctxt findNextUnwindContextUpTo: nil) isNil] whileFalse: [
  (ctxt tempAt:2) ifNotNil: [outerMost := ctxt]].
+ "Now outerMost is the outer-most unwind context currently under evaluation (or nil). Let's finish it.
+ Note: outerMost may in theory be the top context e.g. in case #ensure was interrupted right after
+ assigning its complete := true."
+ outerMost ifNotNil: [newTop := self complete: top to: outerMost].
- outerMost ifNotNil: ["This is the outer-most unwind context currently under evaluation"
- "Let's finish the unfinished unwind context only and return here. Note: top may be equal
- to outerMost e.g. in case #ensure was interrupted right after assigning complete := true."
- pair := Processor activeProcess
- evaluate: [top runUntilErrorOrReturnFrom: outerMost]
- onBehalfOf: self.
- "If an error was detected jump back to open a debugger; do not jump back if the error is
- in the doNotDebug list. Note: for more information on the return value pair see comments
- in #runUntilErrorOrReturnFrom."
- (doNotDebug includes: pair second class) ifFalse: [pair first jump]].
 
+ "Now all halfway-through unwind blocks have been completed; let's execute the ones still pending.
+ Note: newTop sender points to the former outerMost sender i.e. the next unexplored context.
+ Note: #findNextUnwindContextUpTo: starts searching from the receiver's sender but the receiver
+ itself may be an unwind context."
+ ctxt := newTop ifNil: [top] ifNotNil: [newTop sender].
- "Now all unwind blocks caught halfway through have been completed;
- let's execute the ones still pending. Note: #findNextUnwindContextUpTo: starts
- searching from the receiver's sender but the receiver itself may be an unwind context;
- set ctxt as a new starting point in a search for the remaining unwind blocks.
- Note: pair first sender points to outerMost sender i.e. the next unexplored context."
- ctxt := pair ifNil: [top] ifNotNil: [pair first sender].
  ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil].
  [ctxt isNil] whileFalse: [
  (ctxt tempAt: 2) ifNil: [
  ctxt tempAt: 2 put: true.
  unwindBlock := ctxt tempAt: 1.
  "Create a context for the unwind block and execute it on the unwind block's stack.
+ Note: using #value instead of #complete:to: would lead to executing the unwind
+ on the wrong stack preventing the correct execution of non-local returns."
- Note: using #value instead of #runUntilErrorOrReturnFrom: would lead to executing
- the unwind on the wrong stack preventing the correct execution of non-local returns."
  top := unwindBlock asContextWithSender: ctxt.
+ self complete: top to: top].
- pair := Processor activeProcess
- evaluate: [top runUntilErrorOrReturnFrom: top]
- onBehalfOf: self.
- "If an error was detected jump back to open a debugger; do not jump back if the error is
- in the doNotDebug list. Note: for more information on the return value pair see comments
- in #runUntilErrorOrReturnFrom."
- (doNotDebug includes: pair second class) ifFalse: [pair first jump]].
  ctxt := ctxt findNextUnwindContextUpTo: nil]]
  !