﻿'From Squeak6.0alpha of 11 May 2022 [latest update: #21739] on 12 May 2022 at 2:45:41 pm'!

!Context methodsFor: 'private' stamp: 'jar 2/22/2022 22:22'!
releaseCriticalSection
	"Figure out if we are terminating a process that is in the ensure: block of a critical section. In this case,
	 if it hasn't made progress but is beyond the wait (which we can tell by inspecting the selectorJustSent),
	 then the ensure: block needs to be run. 
	 Note: Cf. Process >> #releaseCriticalSection: in pre-2022 images: using the older #suspend semantics."

	| selectorJustSent |
	(self method pragmaAt: #criticalSection) ifNil: [^self].
	selectorJustSent := self selectorJustSentOrSelf.

	"If still at the wait the ensure: block has not been activated, so signal to restore."
	selectorJustSent == #wait ifTrue:
		[self receiver signal].

	"If still at the lock primitive and the lock primitive just acquired ownership (indicated by it answering false)
	 then the ensure block has not been activated, so explicitly run primitiveExitCriticalSection to unlock."
	(selectorJustSent == #primitiveEnterCriticalSection
	 or: [selectorJustSent == #primitiveTestAndSetOwnershipOfCriticalSection]) ifTrue:
		[(self stackPtr > 0
		  and: [self top == false]) ifTrue:
			[self receiver primitiveExitCriticalSection]]! !

!Context methodsFor: 'private-exceptions' stamp: 'jar 2/22/2022 22:22'!
runUntilReturnFrom: aContext
	"Run the receiver (which must be its stack top context) until aContext returns. Avoid a context that cannot return.
	 Note: to avoid infinite recursion of MNU error inside unwind blocks, implement e.g. a wrapper around the message
	 sentTo: receiver in #doesNotUnderstand:. Note: This method is a trivialized version of #runUntilErrorOrReturnFrom:
	 and was intended to be used by #unwindTo as a helper method to unwind non-local returns inside unwind blocks."

	| here unwindBottom newTop |
	here := thisContext.
	"Avoid a context that cannot return (see Note 1 below)"
	unwindBottom := (self findContextSuchThat: [:ctx | ctx selector = #cannotReturn:]) ifNil: [aContext].
	newTop := aContext sender.
	"Insert ensure context under unwindBottom in self's stack (see Note 2 below)"
	unwindBottom insertSender: (Context contextEnsure: [here jump]).
	self jump.  "Control jumps to the receiver's stack (see Note 2 below)"
	"Control resumes here once the above inserted ensure block is executed (see #jump comments)"
	^newTop  "Return the new top context (see Note 3 below)"

	"Note 1: returning from #cannotReturn's sender would crash the VM so we install a guard ensure context right
	 above it; after returning here the unwind will continue safely. Try running and debugging this example
	 (avoid Proceeding the BCR error though; it may indeed crash the image):
	 [[[] ensure: [^2]] ensure: [^42]] fork"

	"Note 2: the receiver (self) is run by jumping directly to it (the active process abandons thisContext and executes
	 self on its own stack; self must be its top context). However, before jumping to self we insert an ensure block under
	 unwindBottom context that will execute a jump back to thisContext when evaluated. The inserted guard ensure
	 context is removed once control jumps back to thisContext."

	"Note 3: it doesn't matter newTop is not a proper stack top context because #unwindTo will only use it as a starting
	 point in the search for the next unwind context and the computation will never return here. We could make newTop
	 a proper top context by pushing nil to its stack (^newTop push: nil) if need be (see #jump comments).
	 Cf. the pattern in #runUntilErrorOrReturnFrom:: removing the inserted ensure context by stepping until popped
	 when executing non-local returns wouldn't work here and would fail tests testTerminateInNestedEnsureWithReturn1
	 through 4."! !

!Context methodsFor: 'private-exceptions' stamp: 'jar 2/22/2022 22:22'!
unwindTo: aContext
	"Unwind the receiver to aContext to execute all pending unwind blocks."

	self unwindTo: aContext safely: true! !

!Context methodsFor: 'private-exceptions' stamp: 'jar 2/22/2022 22:22'!
unwindTo: aContext safely: aBoolean
	"Unwind self to aContext to execute pending #ensure:/#ifCurtailed: argument blocks between self
	 and aContext. If aBoolean is false, unwind only blocks that have not run yet, otherwise complete all
	 pending unwind blocks including those currently in the middle of their execution; these blocks will
	 just finish their execution. Run all unwinds on their original stack using #runUntilReturnFrom:."
	
	| top ctx |
	ctx := top := self.
	aBoolean ifTrue: [
	"If self is a top context of a stack already halfways through an unwind, complete the outer-most
	 unfinished unwind block first; all nested pending unwind blocks will be completed in the process;
	 see testTerminationDuringUnwind and tests in ProcessTest/UnwindTest.
	 Note: Halfway-through blocks have already set the complete variable (ctxt tempAt: 2) in their
	 defining #ensure:/#ifCurtailed contexts from nil to true; we'll search for the bottom-most one."
		| outerMost |
		ctx isUnwindContext ifFalse: [ctx := ctx findNextUnwindContextUpTo: aContext].
		[ctx isNil] whileFalse: [
			(ctx tempAt:2) ifNotNil: [
				outerMost := ctx].
			ctx := ctx findNextUnwindContextUpTo: aContext].
		outerMost ifNotNil: [top := (top runUntilReturnFrom: outerMost) sender]].
		"By now no halfway-through unwind blocks are on the stack. 
		 Note: top points to the former outerMost sender now, i.e. to the next context to be explored."

	ctx := top.
	"#findNextUnwindContextUpTo: starts searching from the receiver's sender so we must check
	 the receiver explicitly whether it is an unwind context; see testTerminateEnsureAsStackTop.
	 Create a new top context (i.e. a new branch off the original stack) for each pending unwind block
	 (ctxt tempAt: 1) and execute it on the unwind block's stack to evaluate non-local returns correctly."
	ctx isUnwindContext ifFalse: [ctx := ctx findNextUnwindContextUpTo: aContext].
	[ctx isNil] whileFalse: [
		(ctx tempAt: 2) ifNil: [
			ctx tempAt: 2 put: true.
			top := (ctx tempAt: 1) asContextWithSender: ctx.  "see the note below"
			top runUntilReturnFrom: top].
		ctx := ctx findNextUnwindContextUpTo: aContext]
	"Note: Cf. the unwind pattern in the previous versions of unwindTo: (1999-2021). Using #value
	 instead of #runUntilReturnFrom: lead to a failure to evaluate some non-local returns correctly;
	 a non-local return must be evaluated in the evaluation context (sender chain) in which it was defined."! !


!Process methodsFor: 'changing process state' stamp: 'jar 2/22/2022 22:22'!
terminate 
	"Stop the process that the receiver represents forever.
	 Unwind to execute pending #ensure:/#ifCurtailed: blocks before terminating;
	 allow all unwind blocks to run; if they are currently in progress, let them finish.
	 If the process is in the middle of a #critical: critical section, release it properly."
	
	"This is the kind of behavior we expect when terminating a healthy process.
	 See further comments in #terminateAggressively and #destroy methods dealing 
	 with process termination when closing the debugger or after a catastrophic failure."
	
	"If terminating the active process, create a parallel stack and run unwinds from there;
	 if terminating a suspended process, again, create a parallel stack for the process being
	 terminated and resume the suspended process to complete its termination from the new
	 parallel stack. Use a priority higher than the active priority to make the process that
	 invoked the termination wait for its completion."

	"If terminating a suspended process (including runnable and blocked), always suspend
	 the terminating process first so it doesn't accidentally get woken up. Equally important is
	 the side effect of the suspension; In 2022 a new suspend semantics has been introduced:
	 the revised #suspend backs up a process waiting on a conditional variable to the send that
	 invoked the wait state, while the pre-2022 #suspend simply removed the process from
	 the conditional variable's list it was previously waiting on; see Process>>suspend comments.
	 Release any method marked with the <criticalSection> pragma via #releaseCriticalSection[:].
	 Execute termination in the ensure argument block to ensure it completes even if the 
	 terminator process itself gets terminated before it's finished; see testTerminateInTerminate."

	| context |
	self isActiveProcess ifTrue: [
		context := thisContext.
		^[context unwindTo: nil. self suspend] asContext jump].

	[] ensure: [
		self suspend.
		context := suspendedContext ifNil: [^self].
		suspendedContext := 
			[context releaseCriticalSection; unwindTo: nil. self suspend] asContext.
		self priority: Processor activePriority + 1; resume]! !

