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

commits at source.squeak.org commits at source.squeak.org
Sun Mar 7 10:38:47 UTC 2021


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

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

Name: Kernel-jar.1380
Author: jar
Time: 7 March 2021, 11:38:42.526625 am
UUID: a8d15458-c0fa-924f-ae0b-32e1354dbd77
Ancestors: Kernel-eem.1379

Refactoring #terminate to get rid of 'cannot return' errors etc.

This is a follow up on the following threads:
[1] http://forum.world.st/The-Inbox-Kernel-jar-1376-mcz-td5127335.html#a5127336
[2] http://forum.world.st/The-Inbox-Kernel-jar-1377-mcz-td5127438.html#a5127439

The enclosed Kernel file is intended for your consideration and testing only; it has not been thoroughly tested against any tools or the VM.

=============== Diff against Kernel-eem.1379 ===============

Item was changed:
  ----- Method: BlockClosure>>newProcess (in category 'scheduling') -----
  newProcess
+ 	"Answer a Process running the code in the receiver. The process is not scheduled.
+ 	Create a new bottom context for Process>>#terminated and make it the sender 
+ 	of the new process for the benefit of Process>>#isTerminated."
+ 	
+ 	| newProcess bottomContext |
+ 	"<primitive: 19>" "Simulation guard"
+ 	newProcess := Process new.
+ 	bottomContext := Context 
+ 		sender: nil 
+ 		receiver: newProcess 
+ 		method: (Process>>#terminated) 
+ 		arguments: {}.
+ 	newProcess suspendedContext: (self asContextWithSender: bottomContext).
+ 	newProcess priority: Processor activePriority.
+ 	^newProcess!
- 	"Answer a Process running the code in the receiver. The process is not 
- 	scheduled."
- 	<primitive: 19> "Simulation guard"
- 	^Process
- 		forContext: 
- 			[self value.
- 			"Since control is now at the bottom there is no need to terminate (which
- 			 runs unwinds) since all unwnds have been run.  Simply suspend.
- 			 Note that we must use this form rather than e.g. Processor suspendActive
- 			 so that isTerminated answers true.  isTerminated requires that if there is a
- 			 suspended context it is the bottom-most, but using a send would result in
- 			 the process's suspendedContext /not/ being the bottom-most."
- 			Processor activeProcess suspend] asContext
- 		priority: Processor activePriority!

Item was changed:
  ----- Method: Process>>isSuspended (in category 'testing') -----
  isSuspended
+ 	"A process is suspended if it has non-nil suspendedContext (e.g. new or 
+ 	previously suspended with the suspend primitive) and is not terminated or
+ 	waiting in a scheduler or a semaphore queue (i.e. is not runnable or blocked)."
+ 	
+ 	^myList isNil
+ 		and: [suspendedContext notNil
+ 		and: [self isTerminated not]]!
- 	"A process is suspended if it has been suspended with the suspend primitive.
- 	 It is distinguishable from the active process and a terminated process by
- 	 having a non-nil suspendedContext that is either not the bottom context
- 	 or has not reached its endPC."
- 	^nil == myList
- 	  and: [nil ~~ suspendedContext
- 	  and: [suspendedContext isBottomContext
- 			ifTrue: [suspendedContext closure
- 						ifNil: [suspendedContext methodClass ~~ Process
- 							or: [suspendedContext selector ~~ #terminate]]
- 						ifNotNil: [suspendedContext pc < suspendedContext closure endPC]]
- 			ifFalse: [true]]]!

Item was changed:
  ----- Method: Process>>isTerminated (in category 'testing') -----
  isTerminated
+ 	"Answer if the receiver is terminated, or at least terminating, i.e. if one 
+ 	of the following conditions is met:
+ 	(1) the receiver is a defunct process (suspendedContext = nil or pc = nil)
+ 	(2) the receiver is suspended within Process>>terminated, i.e. terminated
+ 	(3) the suspendedContext is the bottomContext and the pc is at the endPC"
+ 
+ 	self isActiveProcess ifTrue: [^false].
+ 	^suspendedContext isNil or: [suspendedContext isDead]
+ 	or: [suspendedContext methodClass == Process 
+ 		and: [suspendedContext selector == #terminated]]	
+ 	or: [suspendedContext isBottomContext 
+ 		and: [suspendedContext atEnd]]
+ !
- 	"Answer if the receiver is terminated, or at least terminating."
- 	self isActiveProcess ifTrue: [^ false].
- 	^suspendedContext isNil
- 	  or: ["If the suspendedContext is the bottomContext it is the block in Process>>newProcess.
- 		   If so, and the pc is at the endPC, the block has already sent and returned
- 		   from value and there is nothing more to do."
- 		suspendedContext isBottomContext
- 		and: [suspendedContext closure
- 						ifNil: [suspendedContext methodClass == Process
- 							and: [suspendedContext selector == #terminate]]
- 						ifNotNil: [suspendedContext pc >= suspendedContext closure endPC]]]!

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.
  	 If the process is in the middle of a critical: critical section, release it properly."
  
  	| ctxt unwindBlock oldList |
  	self isActiveProcess ifTrue:
  		[ctxt := thisContext.
  		 [ctxt := ctxt findNextUnwindContextUpTo: nil.
  		  ctxt ~~ nil] whileTrue:
  			[(ctxt tempAt: 2) ifNil:
  				["N.B. Unlike Context>>unwindTo: we do not set complete (tempAt: 2) to true."
  				 unwindBlock := ctxt tempAt: 1.
  				 thisContext terminateTo: ctxt.
  				 unwindBlock value]].
+ 		"Now all work is done and the process can terminate"
+ 		^self terminated].
- 		thisContext terminateTo: nil.
- 		self suspend.
- 		"If the process is resumed this will provoke a cannotReturn: error.
- 		 Would self debug: thisContext title: 'Resuming a terminated process' be better?"
- 		^self].
  
  	"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."
  		(suspendedContext findNextUnwindContextUpTo: nil) ifNotNil:
  			[:outer|
  			 (suspendedContext findContextSuchThat:[:c| c closure == (outer tempAt: 1)]) ifNotNil:
  				[:inner| "This is an unwind block currently under evaluation"
  				 suspendedContext runUntilErrorOrReturnFrom: inner]].
- 
  		ctxt := self popTo: suspendedContext bottomContext.
  		ctxt == suspendedContext bottomContext ifFalse:
  			[self debug: ctxt title: 'Unwind error during termination'].
+ 		"Set the receiver's context to Process>>#terminated for the benefit of isTerminated."
+ 		ctxt setSender: nil receiver: self method: (Process>>#terminated) arguments: {}
+ 	]!
- 		"Set the context to its endPC for the benefit of isTerminated."
- 		ctxt pc: ctxt endPC]!

Item was added:
+ ----- Method: Process>>terminated (in category 'changing process state') -----
+ terminated
+ 	"When I reach this method, I'm terminated.
+ 	Suspending or terminating me is harmless."
+ 	
+ 	thisContext terminateTo: nil.   "sets thisContext sender to nil"
+ 	self suspend.
+ 	^thisContext restart!



More information about the Squeak-dev mailing list