Fixes #8992 Unwind mechanism during termination is broken - skips mul…

…tiple unwind blocks and corrupts the image

src/Kernel/Process.class.st

@@ -213,13 +213,17 @@ Process >> debugWithTitle: title [
 
 { #category : #private }
 Process >> doTerminationFromAnotherProcess [ 
-	"Stop this process forever from another process.  
+
+  "Stop this process forever from another process.  
 	Unwind to execute pending ensure:/ifCurtailed: blocks before terminating.
 	It assumes that self is not the active process
 	and the termination is requested from another process"
-	| ctxt oldList |
+
+	| ctxt oldList outerMost unwindBlock |
+
 	self isTerminating ifTrue: [ ProcessAlreadyTerminating signal. ^self ].
 	terminating := true.
+
 	"Always suspend the process first so it doesn't accidentally get woken up"
 	oldList := self suspend.
 	suspendedContext ifNil: [^self].
@@ -228,24 +232,42 @@ Process >> doTerminationFromAnotherProcess [
 	in Semaphore>>critical:. So if waiting object is interesting on this situation we will ask it to handle it. In case of Semaphore>>critical, Semaphore will pop the suspendedContext so that we leave the ensure: block inside	Semaphore>>critical: without signaling the semaphore.
 	This methods allow to not be restricted only on Semaphore case."
 	suspendedContext := oldList handleProcessTerminationOfWaitingContext: suspendedContext.
-	"If we are 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 unwindBlock ]) ifNotNil: [ :inner |
-			"This is an unwind block currently under evaluation"
-			suspendedContext runUntilErrorOrReturnFrom: inner ] ].		
-	ctxt := self popTo: suspendedContext bottomContext.
-	[ ctxt == suspendedContext bottomContext ] whileFalse: [
-		"There was a problem during termination. Make the user aware of the problem
-		but ensure that the current process will be properly terminated."
-		| stackCopy |
-		stackCopy := ctxt copyStack.
-		[ UnwindError signalIn: stackCopy ] forkNamed: 'Unwind error during termination'.
-		ctxt terminateTo: ctxt sender.
-		ctxt := self popTo: suspendedContext bottomContext ].
-
-	(suspendedContext notNil and: [ suspendedContext isBottomContext ]) ifTrue: [
-		suspendedContext setSender: nil receiver: self method: (Process>>#endProcess) arguments: {}]
 
+	"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 (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 | 
+				"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)"
+				suspendedContext := outerMost]]. 
+
+	"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."
+	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."
+			suspendedContext := unwindBlock asContextWithSender: ctxt.
+			suspendedContext runUntilErrorOrReturnFrom: suspendedContext].
+		ctxt := ctxt findNextUnwindContextUpTo: nil].
+
+	"Mark the context as terminated"
+	suspendedContext terminateTo: nil.
 ]
 
 { #category : #private }