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

commits at source.squeak.org commits at source.squeak.org
Wed Jan 5 14:19:38 UTC 2022


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

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

Name: Kernel-jar.1443
Author: jar
Time: 5 January 2022, 3:19:34.612959 pm
UUID: d483056e-2509-0c40-ae7b-82632ea95f82
Ancestors: Kernel-mt.1441

revised new #terminate
- new active process termination (now direct)
- updated for revised suspend semantics
- simplified #releaseCriticalSection

Complemented by a battery of tests: KernelTests-jar.421

Supersede Kernel-jar.1442 (can be removed)

=============== Diff against Kernel-mt.1441 ===============

Item was added:
+ ----- Method: Context>>releaseCriticalSection (in category 'private') -----
+ 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 then the ensure: block needs to be run.
+ 	 Cf. Process >> releaseCriticalSection: for pre-2022 VMs."
+ 
+ 	| 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 primitiveExitCriticalSection to unlock."
+ 	(selectorJustSent == #primitiveEnterCriticalSection
+ 	 or: [selectorJustSent == #primitiveTestAndSetOwnershipOfCriticalSection]) ifTrue:
+ 		[(self stackPtr > 0
+ 		  and: [self top == false]) ifTrue:
+ 			[self receiver primitiveExitCriticalSection]]
+ !

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;
+ 	 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 behavior we expect when terminating a healthy process.
+ 	 See further comments in #terminateAggressively and #destroy methods dealing 
+ 	 with process termination when closing a debugger or after a catastrophic failure."
- 	"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."
  
+ 	| top |
+ 	"If terminating the active process, create a parallel stack and run unwinds from there."
- 	| ctxt unwindBlock oldList outerMost |
  	self isActiveProcess ifTrue: [
+ 		top := thisContext.
+ 		^[self unwind: top; suspend] asContext jump].
- 		"If terminating the active process, suspend it first and terminate it as a suspended process."
- 		[self terminate] fork.
- 		^self suspend].
  
+ 	"Always suspend the terminating process first so it doesn't accidentally get woken up.
+ 	 Disable the terminating process while running its stack in active process so it doesn't 
+ 	 accidentally get resumed or terminated again; see Process>>#resume and tests
+ 	 testResumeTerminatingProcess and testTerminateTerminatingProcess.
+ 	 Release any method marked with the <criticalSection> pragma.
+ 	 Execute termination in the ensure argument block to ensure it completes even if the 
+ 	 terminator process itself is terminated in the middle; see testTerminateInTerminate."
- 	"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]).
  
+ 	[] ensure: [
+ 		suspendedContext ifNil: [^self error: 'Process already terminated or terminating'].
+ 		Smalltalk processSuspensionUnblocks 
+ 			ifFalse: [  "this part is for revised resume semantics introduced in 2022 VMs"
+ 				self suspend.
+ 				top := suspendedContext.
+ 				suspendedContext := nil.			
+ 				top releaseCriticalSection.
+ 				self unwind: top]
+ 			ifTrue: [  "this part is for backward compatibilty with pre-2022 VMs"
+ 				| oldList |
+ 				oldList := self suspend.
+ 				self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]).
+ 				top := suspendedContext.
+ 				suspendedContext := nil.
+ 				self unwind: top]]!
- 		"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]!

Item was added:
+ ----- Method: Process>>unwind: (in category 'private') -----
+ unwind: aContext
+ 
+ 	| top ctxt outerMost |
+ 	"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; nested unwind 
+ 	blocks will be completed in the process; see tests in UnwindTest, and testTerminationDuringUnwind. 
+ 	Note: Halfway-through blocks have already set the complete variable (tempAt: 2) in their defining
+ 	#ensure:/#ifCurtailed contexts from nil to true; we'll search for the bottom-most one.
+ 	Note: #findNextUnwindContextUpTo: starts searching from the receiver's sender but the receiver 
+ 	itself may be an unwind context; see testTerminateEnsureAsStackTop."
+ 	ctxt := top := aContext.
+ 	ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil].
+ 	[ctxt isNil] whileFalse: [
+ 		(ctxt tempAt:2) ifNotNil: [
+ 			outerMost := ctxt].
+ 		ctxt := ctxt findNextUnwindContextUpTo: nil].
+ 	outerMost ifNotNil: [top := (self unwind: top to: outerMost) sender].
+ 
+ 	"By now no halfway-through unwind blocks are on the stack. Create a new top context for each 
+ 	pending unwind block (tempAt: 1) and execute it on the unwind block's stack on behalf of self, i.e.
+ 	the process being terminated, to preserve process identity; see testProcessFaithfulTermination.
+ 	Cf. the unwind pattern in #resume:through: : using #value instead of #runUnwindTo:onBehalfOf: 
+ 	would lead to an incorrect evaluation of non-local returns on the wrong stack (active process's).
+ 	Note: new top points to the former outerMost sender, i.e. the next unexplored context."
+ 	ctxt := top.
+ 	ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil].
+ 	[ctxt isNil] whileFalse: [
+ 		(ctxt tempAt: 2) ifNil: [
+ 			ctxt tempAt: 2 put: true.
+ 			top := (ctxt tempAt: 1) asContextWithSender: ctxt.
+ 			self unwind: top to: top].
+ 		ctxt := ctxt findNextUnwindContextUpTo: nil]
+ !

Item was added:
+ ----- Method: Process>>unwind:to: (in category 'private') -----
+ unwind: top to: aContext
+ 	"Run top on behalf of self on self's stack until aContext returns. Avoid a context that cannot return. 
+ 	Note: top must be a stack top context. Note: to avoid infinite recursion of MNU error: e.g. a wrapper 
+ 	around the message sentTo: receiver in #doesNotUnderstand: must be implemented. 
+ 	Note: This method is meant to be used exclusively by Process>>#terminate."
+ 
+ 	Processor activeProcess
+ 		evaluate: [ 
+ 			| here unwindBottom newTop |
+ 			here := thisContext.
+ 			"Avoid a context that cannot return (see Note 1 below)"
+ 			unwindBottom := (top 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]).
+ 			top jump.  "Control jumps to top (see Note 2 below)"
+ 			"Control resumes here once the above inserted ensure block is executed"
+ 			^newTop ]  "Return the new top context (see Note 3 below)"
+ 		onBehalfOf: self
+ 
+ "Note 1: returning from #cannotReturn's sender would crash the VM so we install a guard ensure context right 
+ above it and after returning to #terminate the unwind will continue safely. Try running and debugging this example 
+ (avoid Proceeding the BCR error though; it would indeed crash the image):
+ [[[] ensure: [^2]] ensure: [^42]] fork"
+ 
+ "Note 2: top is run by jumping directly to it (the active process abandons thisContext and executes top on aProcess's 
+ stack; top is its top context). However, before jumping to top we insert an ensure block under unwindBottom context 
+ that jumps 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 #terminate will use it only as a starting 
+ point in the search for the next unwind context and the computation will never return here. Cf. the pattern in 
+ #runUntilErrorOrReturnFrom:: removing the inserted ensure context by stepping until popped when executing 
+ non-local returns is not applicable here and would fail tests testTerminateInNestedEnsureWithReturn1 through 4."
+ 
+ !



More information about the Squeak-dev mailing list