'From Croquet1.0beta of 11 April 2006 [latest update: #1] on 30 August 2007 at 8:35:57 pm'!
"Change Set:		DelayTweaks-ar
Date:			30 August 2007
Author:			Andreas Raab

Some more delay tweaks:
- Ensure proper unscheduling of delays which are terminated in the wait
- Only unschedule delays that are beingWaitedOn
- Bullet-proof handleTimerEvent so that it only polls the clock once (each poll is a potential cause for msecs clock overflow) and cope with an obscure race condition
"!


!Delay methodsFor: 'delaying' stamp: 'ar 8/30/2007 19:32'!
wait
	"Schedule this Delay, then wait on its semaphore. The current process will be suspended for the amount of time specified when this Delay was created."

	self schedule.
	[delaySemaphore wait] ifCurtailed:[self unschedule].
! !


!Delay class methodsFor: 'timer process' stamp: 'ar 8/24/2007 12:36'!
handleTimerEvent
	"Handle a timer event; which can be either:
		- a schedule request (ScheduledDelay notNil)
		- an unschedule request (FinishedDelay notNil)
		- a timer signal (not explicitly specified)
	We check for timer expiry every time we get a signal."
	| nowTick nextTick |
	"Wait until there is work to do."
	TimingSemaphore wait.

	"Process any schedule requests"
	ScheduledDelay ifNotNil:[
		"Schedule the given delay"
		self scheduleDelay: ScheduledDelay.
		ScheduledDelay := nil.
	].

	"Process any unschedule requests"
	FinishedDelay ifNotNil:[
		self unscheduleDelay: FinishedDelay.
		FinishedDelay := nil.
	].

	"Check for clock wrap-around."
	nowTick := Time millisecondClockValue.
	nowTick < ActiveDelayStartTime ifTrue: [
		"clock wrapped"
		self saveResumptionTimes.
		self restoreResumptionTimes.
	].
	ActiveDelayStartTime := nowTick.

	"Signal any expired delays"
	[ActiveDelay notNil and:[nowTick >= ActiveDelay resumptionTime]] whileTrue:[
		ActiveDelay signalWaitingProcess.
		SuspendedDelays isEmpty 
			ifTrue: [ActiveDelay := nil] 
			ifFalse:[ActiveDelay := SuspendedDelays removeFirst].
	].

	"And signal when the next request is due. We sleep at most 1sec here
	as a soft busy-loop so that we don't accidentally miss signals."
	nextTick := nowTick + 1000.
	ActiveDelay ifNotNil:[nextTick := nextTick min: ActiveDelay resumptionTime].
	nextTick := nextTick min: SmallInteger maxVal.

	"Since we have processed all outstanding requests, reset the timing semaphore so
	that only new work will wake us up again. Do this RIGHT BEFORE setting the next
	wakeup call from the VM because it is only signaled once so we mustn't miss it."
	TimingSemaphore initSignals.
	Delay primSignal: TimingSemaphore atMilliseconds: nextTick.

	"This last test is necessary for the obscure case that the msecs clock rolls over
	after nowTick has been computed (unlikely but not impossible). In this case we'd
	wait for MillisecondClockMask msecs (roughly six days) or until another delay gets
	scheduled (which may not be any time soon). In any case, since handling the
	condition is easy, let's just deal with it"
	Time millisecondClockValue < nowTick ifTrue:[TimingSemaphore signal]. "retry"
! !

!Delay class methodsFor: 'timer process' stamp: 'ar 8/30/2007 19:59'!
unscheduleDelay: aDelay
	"Private. Unschedule this Delay."
	aDelay beingWaitedOn ifFalse:[^self].
	ActiveDelay == aDelay ifTrue: [
		SuspendedDelays isEmpty ifTrue:[
			ActiveDelay := nil.
		] ifFalse: [
			ActiveDelay := SuspendedDelays removeFirst.
		]
	] ifFalse:[
		SuspendedDelays remove: aDelay ifAbsent: [].
	].
	aDelay beingWaitedOn: false.! !


!Semaphore methodsFor: 'communication' stamp: 'ar 8/30/2007 16:15'!
waitTimeoutMSecs: anInteger
	"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 := Delay timeoutSemaphore: self afterMSecs: (anInteger max: 0).
	[self wait] ensure:[d unschedule].
! !

