The Inbox: Kernel-jar.1384.mcz

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

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

Name: Kernel-jar.1384
Author: jar
Time: 31 March 2021, 11:11:51.005212 pm
UUID: 7fa9b545-e341-054f-835a-c1bd059fd414
Ancestors: Kernel-mt.1383

Fixes current implementation ignoring some nested  unwind blocks in common situations. Explained and documented in http://forum.world.st/Another-bug-in-Process-terminate-in-unwinding-contexts-tp5128171p5128178.html

A test follows.

=============== Diff against Kernel-mt.1383 ===============

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 |
- | ctxt unwindBlock oldList |
  self isActiveProcess ifTrue:
  [ctxt := thisContext.
  [ctxt := ctxt findNextUnwindContextUpTo: nil.
   ctxt ~~ nil] whileTrue:
  [(ctxt tempAt: 2) ifNil:
  ["N.B. Unlike Context>>unwindTo: we do not set complete (tempAt: 2) to true."
  unwindBlock := ctxt tempAt: 1.
  thisContext terminateTo: ctxt.
  unwindBlock value]].
  thisContext terminateTo: nil.
  self suspend.
  "If the process is resumed this will provoke a cannotReturn: error.
  Would self debug: thisContext title: 'Resuming a terminated process' be better?"
  ^self].
 
  "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]).
 
+ "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 block
+ (i.e. the one closest to the bottom of the stack)"
+ ctxt := suspendedContext.
+ [(ctxt := ctxt findNextUnwindContextUpTo: nil) isNil] whileFalse:
+ "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 find an inner context executing outerMost's argument block (tempAt: 1)"
+ (suspendedContext findContextSuchThat: [:ctx |
+ ctx closure == (outerMost tempAt: 1)]) ifNotNil: [:inner |
+ suspendedContext runUntilErrorOrReturnFrom: inner.
+ "update receiver's suspendedContext reset in the previous step"
+ suspendedContext := outerMost]].
- "If terminating a process halfways through an unwind, try to complete that unwind block first."
- (suspendedContext findNextUnwindContextUpTo: nil) ifNotNil:
- [:outer|
- (suspendedContext findContextSuchThat:[:c| c closure == (outer tempAt: 1)]) ifNotNil:
- [:inner| "This is an unwind block currently under evaluation"
- suspendedContext runUntilErrorOrReturnFrom: inner]].
 
  ctxt := self popTo: suspendedContext bottomContext.
  ctxt == suspendedContext bottomContext ifFalse:
  [self debugWithTitle: 'Unwind error during termination' translated full: false].
  "Set the context to its endPC for the benefit of isTerminated."
  ctxt pc: ctxt endPC]!