Andreas Raab uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-ar.240.mcz

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

Name: Kernel-ar.240
Author: ar
Time: 4 September 2009, 12:01:07 pm
UUID: 099cbd0d-a7eb-0d49-952d-85f7b8391795
Ancestors: Kernel-ar.239

http://bugs.squeak.org/view.php?id=7321

(three more change sets at once since I can't wait three hours for the commits to complete)

Change Set:		SignalExceptionFix
Date:			23 March 2009
Author:			Andreas Raab

A fix for Process>>signalException: which would not work properly for Process subclasses and should use atomic suspend if at all available.

Change Set:		ProcessTerminateFix
Date:			23 March 2009
Author:			Andreas Raab

Fixes a problem in Process>>isTerminated which can cause severe problems if the process which is being asked runs at a higher priority than the process asking. In this situation the answer may be incorrect if an external signal occurs while the code is trying to find the bottom context of an executing process.

Change Set:		DelayWaitTimeout
Date:			23 March 2009
Author:			Andreas Raab

Provides a light-weight, correct implementation of waitTimeoutMSecs:

=============== Diff against Kernel-ar.239 ===============

Item was added:
+ ----- Method: DelayWaitTimeout>>setDelay:forSemaphore: (in category 'private') -----
+ setDelay: anInteger forSemaphore: aSemaphore
+ 	super setDelay: anInteger forSemaphore: aSemaphore.
+ 	process := Processor activeProcess.
+ 	expired := false.!

Item was added:
+ ----- Method: DelayWaitTimeout>>signalWaitingProcess (in category 'signaling') -----
+ signalWaitingProcess
+ 	"Release the given process from the semaphore it is waiting on.
+ 	This method relies on running at highest priority so that it cannot be preempted
+ 	by the process being released."
+ 	beingWaitedOn := false.
+ 	"Release the process but only if it is still waiting on its original list"
+ 	process suspendingList == delaySemaphore ifTrue:[
+ 		expired := true.
+ 		process suspend; resume.
+ 	].
+ !

Item was changed:
  ----- Method: Process>>signalException: (in category 'signaling') -----
  signalException: anException
  	"Signal an exception in the receiver process...if the receiver is currently
  	suspended, the exception will get signaled when the receiver is resumed.  If 
  	the receiver is blocked on a Semaphore, it will be immediately re-awakened
  	and the exception will be signaled; if the exception is resumed, then the receiver
  	will return to a blocked state unless the blocking Semaphore has excess signals"
+ 	| oldList |
- 
  	"If we are the active process, go ahead and signal the exception"
  	self isActiveProcess ifTrue: [^anException signal].
+ 
+ 	"Suspend myself first to ensure that I won't run away in the
+ 	midst of the following modifications."
+ 	myList ifNotNil:[oldList := self suspend].
  
  	"Add a new method context to the stack that will signal the exception"
  	suspendedContext := MethodContext
  		sender: suspendedContext
  		receiver: self
+ 		method: (self class lookupSelector: #pvtSignal:list:)
+ 		arguments: (Array with: anException with: oldList).
- 		method: (self class methodDict at: #pvtSignal:list:)
- 		arguments: (Array with: anException with: myList).
  
  	"If we are on a list to run, then suspend and restart the receiver 
  	(this lets the receiver run if it is currently blocked on a semaphore).  If
  	we are not on a list to be run (i.e. this process is suspended), then when the
  	process is resumed, it will signal the exception"
  
+ 	oldList ifNotNil: [self resume].
+ !
- 	myList ifNotNil: [self suspend; resume].!

Item was added:
+ ----- Method: ContextPart>>isBottomContext (in category 'query') -----
+ isBottomContext
+ 	"Answer if this is the last context (the first context invoked) in my sender chain"
+ 
+ 	^sender isNil!

Item was changed:
  ----- Method: Process>>isTerminated (in category 'accessing') -----
  isTerminated
  
  	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 greater than the startpc, the bock has alrteady sent and returned
+ 		   from value and there is nothing more to do."
+ 		suspendedContext isBottomContext
+ 		and: [suspendedContext pc > suspendedContext startpc]]!
- 	^ suspendedContext isNil or: [
- 		suspendedContext == suspendedContext bottomContext and: [
- 			suspendedContext pc > suspendedContext startpc]]!

Item was added:
+ ----- Method: DelayWaitTimeout>>wait (in category 'waiting') -----
+ wait
+ 	"Wait until either the semaphore is signaled or the delay times out"
+ 	[self schedule.
+ 	"It is critical that the following has no suspension point so that
+ 	the test and the wait primitive are atomic. In addition, if the delay
+ 	is no longer being waited on while entering the way we know that it 
+ 	is expired because the delay has already fired."
+ 	beingWaitedOn 
+ 		ifTrue:[delaySemaphore wait]
+ 		ifFalse:[expired := true]] ensure:[self unschedule].
+ 	^self isExpired
+ !

Item was changed:
  ----- Method: Semaphore>>waitTimeoutMSecs: (in category 'communication') -----
  waitTimeoutMSecs: anInteger
+ 	"Wait on this semaphore for up to the given number of milliseconds, then timeout. 
+ 	Return true if the deadline expired, false otherwise."
- 	"Wait on this semaphore for up to the given number of milliseconds, then timeout. It is up to the sender to determine the difference between the expected event and a timeout."
- 
  	| d |
+ 	d := DelayWaitTimeout new setDelay: (anInteger max: 0) forSemaphore: self.
+ 	^d wait!
- 	d := Delay timeoutSemaphore: self afterMSecs: (anInteger max: 0).
- 	[self wait] ensure:[d unschedule].
- !

Item was added:
+ Delay subclass: #DelayWaitTimeout
+ 	instanceVariableNames: 'process expired'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Kernel-Processes'!
+ 
+ !DelayWaitTimeout commentStamp: '<historical>' prior: 0!
+ DelayWaitTimeout is a special kind of Delay used in waitTimeoutMSecs: to avoid signaling the underlying semaphore when the wait times out.!

Item was changed:
  ----- Method: Semaphore>>waitTimeoutSeconds: (in category 'communication') -----
  waitTimeoutSeconds: anInteger
+ 	"Wait on this semaphore for up to the given number of seconds, then timeout.
+ 	Return true if the deadline expired, false otherwise."
+ 	^self waitTimeoutMSecs: anInteger * 1000.
- 	"Wait on this semaphore for up to the given number of seconds, then timeout. It is up to the sender to determine the difference between the expected event and a timeout."
- 
- 	self waitTimeoutMSecs: anInteger * 1000.
  !

Item was added:
+ ----- Method: DelayWaitTimeout>>isExpired (in category 'testing') -----
+ isExpired
+ 	"Did this timeout fire before the associated semaphore was signaled?"
+ 	^expired!