[squeak-dev] The Inbox: Kernel-jar.1447.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Feb 22 19:18:09 UTC 2022

A new version of Kernel was added to project The Inbox:

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

Name: Kernel-jar.1447
Author: jar
Time: 22 February 2022, 8:18:05.479858 pm
UUID: 3772b6a0-c6ab-634c-97bb-a82bda2ecb6a
Ancestors: Kernel-eem.1444

#terminate - latest version working independently of the revised suspend semantics in the latest VMs; structured similarly as original versions of #terminate in Squeak 1.x thru 3.5

supersede Kernel-jar.1443; please remove Kernel-jar.1443, Kernel-jar.1442, Kernel-jar.1437, Kernel-jar.1436, Kernel-jar.1435, Kernel-jar.1426

=============== Diff against Kernel-eem.1444 ===============

Item was added:
+ ----- Method: Context>>releaseCriticalSection: (in category 'private') -----
+ releaseCriticalSection: oldList
+ 	"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 the oldList
+ 	 being one of the runnable lists, i.e. a LinkedList, not a Semaphore or Mutex, et al), then the ensure:
+ 	 block needs to be run."
+ 	| selectorJustSent |
+ 	(self method pragmaAt: #criticalSection) ifNil: [^self].
+ 	(oldList isNil or: [oldList class == LinkedList]) ifFalse: [^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]]!

Item was added:
+ ----- Method: Context>>runUntilReturnFrom: (in category 'private-exceptions') -----
+ 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."!

Item was changed:
  ----- Method: Context>>unwindTo: (in category 'private-exceptions') -----
  unwindTo: aContext
+ 	"Unwind the receiver to aContext to execute all pending unwind blocks."
+ 	self unwindTo: aContext safely: true!
- 	| ctx unwindBlock |
- 	ctx := self.
- 	[(ctx := ctx findNextUnwindContextUpTo: aContext) isNil] whileFalse: [
- 		(ctx tempAt: 2) ifNil:[
- 			ctx tempAt: 2 put: true.
- 			unwindBlock := ctx tempAt: 1.
- 			unwindBlock value]
- 	].
- !

Item was added:
+ ----- Method: Context>>unwindTo:safely: (in category 'private-exceptions') -----
+ 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."!

Item was changed:
  ----- Method: Process>>terminate (in category 'changing process state') -----
+ 	"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."
- 	"Stop the receiver forever.
- 	Run all unwind contexts (#ensure:/#ifCurtailed: blocks) on the stack, even if they are currently in progress. If already active unwind contexts should not be continued, send #terminateAggressively instead.
- 	Note that ill unwind contexts are theoretically able to stall the termination (for instance, by placing a non-local return in an unwind block); however, this is a disrecommended practice.
- 	If the process is in the middle of a critical section, release it properly."
+ 	"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 |
- 	| ctxt unwindBlock oldList outerMost |
  	self isActiveProcess ifTrue: [
+ 		context := thisContext.
+ 		^[context unwindTo: nil. self suspend] asContext jump].
- 		"If terminating the active process, suspend it first and terminate it as a suspended process."
- 		[self terminate] fork.
- 		^self suspend].
+ 	[] ensure: [ | oldList |
+ 		oldList := myList.
+ 		self suspend.
+ 		context := suspendedContext ifNil: [^self].
+ 		suspendedContext := [
+ 			context releaseCriticalSection: oldList; unwindTo: nil. 
+ 			self suspend] asContext.
+ 		self priority: Processor activePriority + 1; resume]!
- 	"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 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);
- 					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."
- 		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].
- 		"Reset the context's pc and sender to nil for the benefit of isTerminated."
- 		suspendedContext terminate]!

More information about the Squeak-dev mailing list