The Inbox: Kernel-jar.1403.mcz

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

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

Name: Kernel-jar.1403
Author: jar
Time: 10 May 2021, 8:45:01.136524 pm
UUID: eccfd7f5-ad2b-0b4f-abb2-c76d21c4599a
Ancestors: Kernel-nice.1402

Further improve #terminate: add comments, remove unnecessary code, fix minor issue, address Christoph's objection in [1] regarding nested errors inside unwind blocks: the following example will currently NOT execute any assignment to x:

x := ''.
[self error: 'x1'] ensure: [
    [self error: 'x2'] ensure: [
        [self error: 'x3'] ensure: [
            x:=x,'3'].
        x:=x,'2'].
    x:=x,'1']

With the fix all three errors will be dealt with by opening a debugger even after abandoning the one opened on the previous error, and as a result all three assignments will be executed and the value of x will be '321'.

More info in:
[1] http://forum.world.st/Solving-multiple-termination-bugs-summary-proposal-tp5128285p5129113.html

=============== Diff against Kernel-nice.1402 ===============

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.
+ here jump.
+ "re-signal the error if jumped back instead of resuming;
+ required by Process>>#terminate"
+ ex signalerContext restart]
- 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] 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>>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 pair |
- | ctxt unwindBlock oldList outerMost |
  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.
- 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]).
 
+ ctxt := top := suspendedContext.
+ suspendedContext := nil. "Disable this process while running its stack in active process below"
  "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."
- ctxt := suspendedContext.
  [(ctxt := ctxt findNextUnwindContextUpTo: nil) isNil] whileFalse:
+ "Contexts under evaluation have already set their complete variable (tempAt: 2) to true."
- "Contexts under evaluation have already set their complete (tempAt: 2) to true."
  [(ctxt tempAt:2) ifNotNil: [outerMost := ctxt]].
+ 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 := top runUntilErrorOrReturnFrom: outerMost.
+ "If an error was detected jump back to open a debugger; do not jump back in case
+ of a MessageNotUnderstood error to prevent an infinite recursion of MNU errors. Note: for
+ more information on the return value pair see comments in #runUntilErrorOrReturnFrom"
+ pair second ifNotNil: [:error |
+ error class = MessageNotUnderstood ifFalse: [pair first jump]]].
- outerMost ifNotNil: [
- "This is the outer-most unwind context currently under evaluation;
- let's find an inner context executing outerMost's argument block (tempAt: 1)"
- (suspendedContext findContextSuchThat: [:ctx |
- ctx closure == (outerMost tempAt: 1)]) ifNotNil: [:inner |
- "Let's finish the unfinished unwind context only (i.e. up to inner) and return here"
- suspendedContext runUntilErrorOrReturnFrom: inner.
- "Update the receiver's suspendedContext (the previous step reset its sender to nil);
- return, if the execution stack reached its bottom (e.g. in case of non-local returns)."
- (suspendedContext := outerMost sender) ifNil: [^self]]].
 
  "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:"
+ ctxt := pair ifNil: [top] ifNotNil: [pair first sender].
- 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."
- ctxt := suspendedContext.
  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 #runUntilErrorOrReturnFrom: would lead to executing
  the unwind on the wrong stack preventing the correct execution of non-local returns."
+ top := unwindBlock asContextWithSender: ctxt.
+ pair := top runUntilErrorOrReturnFrom: top.
+ "If an error was detected jump back to open a debugger."
+ pair second ifNotNil: [pair first jump]].
+ ctxt := ctxt findNextUnwindContextUpTo: nil]]
+ !
- suspendedContext := unwindBlock asContextWithSender: ctxt.
- suspendedContext runUntilErrorOrReturnFrom: suspendedContext].
- ctxt := ctxt findNextUnwindContextUpTo: nil].
-
- "Reset the context's pc and sender to nil for the benefit of isTerminated."
- suspendedContext terminate]!