'From Squeak6.0alpha of 30 January 2021 [latest update: #20183] on 8 March 2021 at 8:10 pm'!

!Context methodsFor: 'private-exceptions' stamp: 'ct 3/8/2021 20:09'!
findNextRunUntilErrorOrReturnFromCalleeContextUpTo: aContext

	| ctx callee |
	"Don't shoot in your own foot when reaching here straight from #jump in #runUntilErrorReturnFrom:"
	self sender selector
		caseOf: {
			[#runUntilErrorOrReturnFrom:] -> [^ nil].
			[#contextOn:do:] -> [(self sender sender tempAt: 2) outerContext ifNotNil: [:blockCtx | blockCtx selector = #runUntilErrorOrReturnFrom: ifTrue: [^ nil]]].
			[#contextEnsure:] -> [(self sender sender tempAt: 1) outerContext ifNotNil: [:blockCtx | blockCtx selector = #runUntilErrorOrReturnFrom: ifTrue: [^ nil]]] }
		otherwise: [].
	
	ctx := self.
	[callee := ctx. (ctx := ctx nextHandlerContext) == nil or: [ctx == aContext]] whileFalse:
		[(((ctx tempAt: 1) == UnhandledError) and:
			[(ctx tempAt: 2) outerContext selector = #runUntilErrorOrReturnFrom:]) ifTrue: [^callee]].
	^nil! !

!Context methodsFor: 'private-exceptions' stamp: 'ct 3/8/2021 14:36'!
nextHandlerContext

	^ self sender ifNotNil: [:ctx | ctx findNextHandlerContextStarting]! !

!Context methodsFor: 'private-exceptions' stamp: 'ct 2/1/2021 19:39'!
nextRunUntilErrorOrReturnFromCalleeContext

	^ self findNextRunUntilErrorOrReturnFromCalleeContextUpTo: self! !

!Context methodsFor: 'controlling' stamp: 'ct 3/8/2021 14:53'!
jump
	"Abandon thisContext and resume self instead (using the same current process).  You may want to save thisContext's sender before calling this so you can jump back to it.
	Self MUST BE a top context (ie. a suspended context or a abandoned context that was jumped out of).  A top context already has its return value on its stack (see Interpreter>>primitiveSuspend and other suspending primitives).
	thisContext's sender is converted to a top context (by pushing a nil return value on its stack) so it can be jump back to."

	| top |
	"Make abandoned context a top context (has return value (nil)) so it can be jumped back to"
	thisContext sender push: nil.

	"Pop self return value then return it to self (since we jump to self by returning to it)"
	stackp = 0 ifTrue: [self stepToSendOrReturn].
	stackp = 0 ifTrue: [self push: nil].  "must be quick return self/constant"
	top := self pop.
	
	thisContext informDebuggerAboutContextSwitchTo: self.
	thisContext privSender: self.
	
	^ top! !

!Context methodsFor: 'controlling' stamp: 'ct 3/8/2021 18:31'!
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.
				ex resumeUnchecked: here jump]
			ifNotNil: [ex pass]
		]).
	ctxt := ctxt insertSender: (Context
		contextEnsure: [error ifNil: [
				topContext := thisContext.
				here push: nil.
				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}
	]! !

!Context methodsFor: 'debugger access' stamp: 'ct 3/8/2021 18:36'!
informDebuggerAboutContextSwitchTo: newContext

	| importantContext |
	importantContext := self nextRunUntilErrorOrReturnFromCalleeContext ifNil: [^ self].
	(newContext hasSender: importantContext nextHandlerContext) ifTrue: [
		"Important context is preeerved, no need to interrupt"
		^ self].
	
	UnhandledError signalForException: (Exception new "dummy exception"
		searchFrom: thisContext sender;
		messageText: thisContext sender selector).! !

!Context methodsFor: 'debugger access' stamp: 'ct 2/1/2021 21:10'!
swapSender: coroutine 
	"Replace the receiver's sender with coroutine and answer the receiver's 
	previous sender. For use in coroutining."

	| oldSender |
	self informDebuggerAboutContextSwitchTo: coroutine.
	
	oldSender := sender.
	sender := coroutine.
	^oldSender! !