"======================================================================
|
|   Delay Method Definitions
|
|   $Revision: 1.7.5$
|   $Date: 2000/05/28 16:56:52$
|   $Author: pb$
|
 ======================================================================"


"======================================================================
|
| Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc.
| Written by Steve Byrne.
|
| This file is part of the GNU Smalltalk class library.
|
| The GNU Smalltalk class library is free software; you can redistribute it
| and/or modify it under the terms of the GNU Lesser General Public License
| as published by the Free Software Foundation; either version 2.1, or (at
| your option) any later version.
| 
| The GNU Smalltalk class library is distributed in the hope that it will be
| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
| General Public License for more details.
| 
| You should have received a copy of the GNU Lesser General Public License
| along with the GNU Smalltalk class library; see the file COPYING.LESSER.
| If not, write to the Free Software Foundation, 59 Temple Place - Suite
| 330, Boston, MA 02111-1307, USA.  
|
 ======================================================================"


Object subclass: #Delay
       instanceVariableNames: 'resumptionTime isRelative'
       classVariableNames: 'Queue TimeoutSem MutexSem DelayProcess IdleProcess'
       poolDictionaries: ''
       category: 'Language-Processes'
!

Delay comment: 
'I am the ultimate agent for frustration in the world.  I cause things to wait 
(typically much more than is appropriate, but it is those losing operating
systems'' fault).  When a process sends one of my instances a wait message,
that process goes to sleep for the interval specified when the instance was
created.'
!
	   


!Delay class methodsFor: 'instance creation'!

forMilliseconds: millisecondCount
    "Answer a Delay waiting for millisecondCount milliseconds"
    ^self new init: millisecondCount isRelative: true
!

forSeconds: secondCount
    "Answer a Delay waiting for secondCount seconds"
    ^self forMilliseconds: secondCount * 1000
!

untilMilliseconds: millisecondCount
    "Answer a Delay waiting for millisecondCount milliseconds after midnight"
    ^self new init: millisecondCount isRelative: false
! !



!Delay class methodsFor: 'general inquiries'!

millisecondClockValue
    "Private - Answer the number of milliseconds since midnight"
    ^Time primMillisecondClock
! !



!Delay class methodsFor: 'initialization'!

initialize
    "Private - Initialize the receiver and the associated process"
    "'initalizing Delays' printNl."
    Queue := SortedCollection sortBlock:
	[ :a :b | (a key) <= (b key) ].

    MutexSem := Semaphore forMutualExclusion.
    TimeoutSem := Semaphore new.

    IdleProcess := [
	[ Processor idle; yield ] repeat
    ] newProcess.

    IdleProcess
	name: 'idle';
	priority: Processor systemBackgroundPriority.
! !


!Delay class methodsFor: 'private'!

startDelayLoop
    "Private - Start the processes for Delays"

    DelayProcess := [
        | empty |
	[ 
	    IdleProcess resume.
	    TimeoutSem wait.
	    IdleProcess suspend.
	    MutexSem critical: [
		Queue removeFirst value signal.
		empty := Queue isEmpty.
		empty ifFalse: [ self timeout: Queue first key ]
	    ].
	    empty
	] whileFalse
    ]   forkAt: Processor timingPriority.

    DelayProcess name: 'timeout'.
!

timeout: milliseconds
    "Private - Signal the TimeoutSem after the given number of milliseconds.
    Delays across midnight are gracefully handled."
    | resumeMillis |
    resumeMillis := milliseconds - Delay millisecondClockValue.
    resumeMillis <= 0 ifTrue: [ TimeoutSem signal. ^self ].

    resumeMillis := (resumeMillis \\ Time millisecondsPerDay) asInteger.
    Processor
	signal: TimeoutSem
	atMilliseconds: resumeMillis
! !



!Delay methodsFor: 'accessing'!

resumptionTime
    "Answer the time when a process waiting on a Delay will resume"
    isRelative
	ifTrue: [ ^Delay millisecondClockValue + resumptionTime ] 
	ifFalse: [ ^resumptionTime ] 
! !



!Delay methodsFor: 'process delay'!

wait
    "Wait until the amount of time represented by the instance of Delay
     elapses"
    | elt sem |
    IdleProcess isNil ifTrue: [ Delay initialize ].
    MutexSem critical: [
	Processor isTimeoutProgrammed
	    ifFalse: [
		DelayProcess isNil ifFalse: [ DelayProcess terminate ].
		Delay startDelayLoop ].

	sem := Semaphore new.
	elt := Association key: self resumptionTime value: sem.
	Queue add: elt.
	"If we've become the head of the list, we need to
	 alter the interrupt time"
	Queue first == elt ifTrue: [ Delay timeout: elt key ]
    ].
    sem wait
! !



!Delay methodsFor: 'comparing'!

= aDelay
    "Answer whether the receiver and aDelay denote the same delay"
    self class == aDelay class ifFalse: [ ^false ].

    ^(isRelative = aDelay isRelative)
	and: [ resumptionTime = aDelay basicResumptionTime ]
!

hash
    "Answer an hash value for the receiver"
    ^resumptionTime
! !



!Delay methodsFor: 'private'!

basicResumptionTime
    ^resumptionTime
!

init: milliseconds isRelative: aBoolean
    isRelative := aBoolean.
    resumptionTime := milliseconds
!

isRelative
    ^isRelative
! !