prev back next

Working with time, delays and interrupts

Contents

Introduction

This document will teach you how to use the timing facilities of Smalltalk/X. Typically, time handling is done by delaying a process (a smalltalk-lightweight process) for some time delta. There are also other (more tricky) possibilities.

Please read the document Working with processes if you do not yet know about processes, priorities, suspension etc.

The current Time vs. the millisecondClock

The internals of smalltalk use different facilities for time representation. Instances of Time, which represent time-of-day values, instances of AbsoluteTime and millisecondClock values, which are the values of a free running clock, incremented every millisecond.

Currently, delaying is only possible using millisecond times. Therefore, it is not directly possible to delay until a specific time-of-day or date has been reached (which may change). To do this, you have to write a program doing so yourself (i.e. delaying in smaller steps until the desired day and/or time-of-day is reached).

The millisecondClock mirrors the underlying operatingSystems clock, which (due to being represented in a limited precision Integer) overruns in regular intervals. On Unix, a flip through 0 occurs about every 74 hours.

Since Smalltalk/X's smallIntegers are represented in 31 bits, it is (currently) not possible to represent time intervals longer than HALF of the range (i.e. about 37 hours) using the millisecondClock value.
(see OperatingSystem>>maximumMillisecondTimeDelta)

The operatingSystems millisecondClock offers a limited precision. Typical internal resolutions are 1/100, 1/60, 1/50 or even 1/20 of a second. Thus, when asking for the millisecondClocks value after a short time interval may return you the same value as before, even when some milliseconds actually have passed in between.

Since millisecondClock values wrap, you cannot perform arithmetic directly upon them. Class OperatingSystem provides methods which know about the wrap and handle it correctly. See:

	OperatingSystem>>millisecondTimeDeltaBetween:and:
	OperatingSystem>>millisecondTimeAdd:and:
	OperatingSystem>>millisecondTime:isAfter:

Using Delay

Delay can be used to suspend the currently running process for some time.
A delay object to suspend execution for some time interval is created with:
	d := Delay forSeconds:numberOfSeconds
or:
	d := Delay forMilliseconds:numberOfMillis
The actual delaying is done by sending wait to this delay.
Try evaluating:
	|d|

	d := Delay forSeconds:3.
	d wait
you will notice, that only the current process gets suspended for the delay time. Other processes continue their execution (open some animated demo - for example, the CubeDemo - to see this).

For short delays, use forMilliseconds, as in:

	(Delay forMilliseconds:100) wait

Delay-time errors and how to avoid them

The delay will last for at least the specified time, it usually waits a bit longer due to internal overhead (the scheduler switching processes) or if a higher priority process becomes runnable in the meantime. Also, except for realtime systems (like the realIX/88k), the OS does not guarantee exact times: another unix process may be executing at a higher priority and thus lead to a slightly longer delay.

This means, that if you call for a delay in a loop, the individual errors will accumulate. It is therefore not possible, to maintain a heart-beat kind of time handling by simply performing delays in a loop.
The example:

	|d t1 t2 delta|

	t1 := Time millisecondClockValue.
	d := Delay forMilliseconds:50.
	100 timesRepeat:[
	    d wait.
	    "do something"
	].
	t2 := Time millisecondClockValue.
	delta := OperatingSystem millisecondTimeDeltaBetween:t2 and:t1.
	Transcript show:'delta time is '; show:(delta); showCr:' milliseconds'.
will NOT finish after 5 seconds, but some time later. On an unloaded system, the error is typically around 2-3%, but, depending on other processes running on your machine, the error may become substantial.

To fix this problem, Delay allows waiting for a specific time to be reached, (in addition to the deltatime based wait described above).
Try:

	|t1 t2 now then delta|

	t1 := Time millisecondClockValue.
	now := Time millisecondClockValue.
	100 timesRepeat:[
	    then := OperatingSystem millisecondTimeAdd:now and:50.
	    (Delay untilMilliseconds:then) wait.
	    now := then
	].
	t2 := Time millisecondClockValue.
	delta := OperatingSystem millisecondTimeDeltaBetween:t2 and:t1.
	Transcript show:'delta time is '; show:(delta); showCr:' milliseconds'.
of course, there is also a nonzero error in each individual wait, but this error will not accumulate. Therefore, the relative error will approach zero over time. Use the above algorithm, if you need some action to be performed in constant intervals.

Premature wakeup

A process waiting on a delay can be resumed before its actual delay-time has expired. To do so, send #resume to the delay. Of course, this must be done by some other process (the delayed process itself obviously cant do it).
Example:
	|process d|

	process := 
	    [
		Transcript show:Time now;
			   showCr:' subprocess: going to wait for half an hour ...'.
		d := Delay forSeconds:1800.
		d wait.
		Transcript show:Time now;
			   showCr:' subprocess: here I am again ...'.
		Transcript show:Time now;
			   showCr:' subprocess: done.'
	    ] fork.

	"after some short time, stop the wait"

	Transcript show:Time now; showCr:' main process: wait a bit'.
	(Delay forSeconds:2) wait.
	Transcript show:Time now; showCr:' main process: early wakeup'.
	d resume.
	Transcript show:Time now; showCr:' main process: done.'.
Process priorities also have an influence; in the following example, the subprocess will start right-away and resume immediately (before the parent process outputs the 'done' message):
	|process d|

	process := 
	    [
		Transcript show:Time now;
			   showCr:' subprocess: going to wait for half an hour ...'.
		d := Delay forSeconds:1800.
		d wait.
		Transcript show:Time now;
			   showCr:' subprocess: here I am again ...'.
		Transcript show:Time now;
			   showCr:' subprocess: done.'
	    ] forkAt:(Processor activePriority + 1).

	"after some short time, stop the wait"

	Transcript show:Time now; showCr:' main process: wait a bit'.
	(Delay forSeconds:2) wait.
	Transcript show:Time now; showCr:' main process: early wakeup'.
	d resume.
	Transcript show:Time now; showCr:' main process: done.'.

Installing a timed wakeup on any other semaphore

If you look at the implementation of semaphores, you will notice that the actual work is done in the ProcessorScheduler class. Through the global variable Processor (which is the one-and-only instance of ProcessorScheduler) you can arrange for semaphores to be signalled whenever some time has been reached, or input arrives on an external stream. (there may be other external events too). This allows installation of a timeout, while waiting for some input to arrive. The following example will wait until either some input arrives on a pipe-stream, or 5 seconds have expired (actually, there is already a method which does exactly this; see ExternalStream readWaitWithTimeout:).
	|sema pipe|

	pipe := PipeStream readingFrom:'(sleep 1; echo hello)'.
	Transcript show:Time now; showCr:' pipe created'; endEntry.
	sema := Semaphore new.
	Processor signal:sema onInput:(pipe fileDescriptor).
	Processor signal:sema afterMilliseconds:5000.
	sema wait.
	Transcript show:Time now; showCr:' after wait'; endEntry.
	pipe canReadWithoutBlocking ifTrue:[
	    Transcript show:Time now; showCr:' data available'; endEntry
	] ifFalse:[
	    Transcript show:Time now; showCr:' no data available'; endEntry
	].
	Transcript show:Time now; showCr:' closing pipe'; endEntry.
	pipe close.
	Transcript show:Time now; showCr:' done'; endEntry.
in contrast to:
	|sema pipe|

	pipe := PipeStream readingFrom:'(sleep 15; echo hello)'.
	Transcript show:Time now; showCr:' pipe created'; endEntry.
	sema := Semaphore new.
	Processor signal:sema onInput:(pipe fileDescriptor).
	Processor signal:sema afterMilliseconds:5000.
	sema wait.
	Transcript show:Time now; showCr:' after wait'; endEntry.
	pipe canReadWithoutBlocking ifTrue:[
	    Transcript show:Time now; showCr:' data available'; endEntry
	] ifFalse:[
	    Transcript show:Time now; showCr:' no data available'; endEntry
	].
	Transcript show:Time now; showCr:' closing pipe'; endEntry.
	pipe close.
	Transcript show:Time now; showCr:' done'; endEntry.
the above is of course the same as:
	|pipe|

	pipe := PipeStream readingFrom:'(sleep 15; echo hello)'.
	Transcript show:Time now; showCr:' pipe created'; endEntry.
	(pipe readWaitWithTimeout:5) ifTrue:[
	    Transcript show:Time now; showCr:' data available'; endEntry
	] ifFalse:[
	    Transcript show:Time now; showCr:' no data available'; endEntry
	].
	Transcript show:Time now; showCr:' closing pipe'; endEntry.
	pipe close.
	Transcript show:Time now; showCr:' done'; endEntry.
Notice, that in the above examples, the "pipe close" may block. This is a consequence of the unix's pclose() implementation (which waits until the subprocess has finished). The following example fixes this, and avoids blocking the process:
	|pipe|

	pipe := PipeStream readingFrom:'(sleep 15; echo hello)'.
	Transcript show:Time now; showCr:' pipe created'; endEntry.
	(pipe readWaitWithTimeout:5) ifTrue:[
	    Transcript show:Time now; showCr:' data available'; endEntry
	] ifFalse:[
	    Transcript show:Time now; showCr:' no data available'; endEntry
	].
	Transcript show:Time now; showCr:' closing pipe'; endEntry.
	pipe shutDown.
	Transcript show:Time now; showCr:' done'; endEntry.

Timed interrupts

Using delays, timing is done by suspending a process for some interval. It is also possible, to continue execution and arrange for an interrupt to occur after some time. To do this, you have to define a block (which will be evaluated by the process after the time has passed) and install it with:
	Processor addTimedBlock:aBlock afterSeconds:seconds
or:
	Processor addTimedBlock:aBlock afterMilliseconds:millis
or:
	Processor addTimedBlock:aBlock atMilliseconds:aMillisecondsClockValue
The currently running process will be interrupted in whatever it is doing when the time has come; if suspended, it will be resumed. Since the behavior is as if the process did "aBlock value", you can perform all kind of actions in the block: raise a signal, do a block-return, terminate the process etc.

You can also force an immediate interrupt and have another process evaluate a block:

	aProcess interruptWith:aBlock
to arrange for this to occur after some time, use:
	Processor addTimedBlock:[
	    aProcess interruptWith:aBlock
	] afterSeconds:timeTillInterrupt
example:
	Processor addTimedBlock:[Transcript showCr:'interrupt occured'; endEntry]
			  afterSeconds:1.
	Transcript showCr:'start processing ...'; endEntry.
	1 to:10 do:[:i |
	    Transcript showCr:i; endEntry.
	    1000 factorial
	].
	Transcript showCr:'done.'; endEntry
example:
	|p|

	p := [
		Transcript showCr:'subprocess start.'; endEntry.
		1 to:20 do:[:i |
		    Transcript showCr:i; endEntry.
		    1000 factorial.
		].
		Transcript showCr:'subprocess end.'; endEntry.
	] forkAt:4.

	Transcript showCr:'waiting for a while ...'; endEntry.
	(Delay forSeconds:3) wait.
	Transcript showCr:'now killing subprocess ...'; endEntry.
	p interruptWith:[p terminate].
	Transcript showCr:'done.'; endEntry

Lowlevel interrupts

All of the above examples involved a process to react somehow on an incoming interrupt (either directly by interrupting the process to perform some action, or indirectly by signalling a semaphore).

On the lowest level, the runtime system does interrupt processing by sending messages to so called interrupt handler objects at the time the interrupt occurs.
These objects are responsible for signaling semaphores, rescheduling processes etc. to implement the above described highlevel interrupt behavior. At system startup time, Smalltalk/X installs appropriate handler objects as interrupt handler.
(see Smalltalk initInterrupts, or ProcessorScheduler initialize for some examples.)

You can (*) install your own interrupt handler objects; situations in which this makes sense are:

You get a faster response, since all of the above mechanisms involve a process switch from the currently running process to some other process (via the semaphore wakeup). Although being pretty fast, this process switch may take too long for special applications.

Interrupt handler objects and messages

All interrupt handler objects are accessed by the runtime system via class variables in the ObjectMemory class. These class variables are known to the runtime system - you may not remove them.
The handler variables and messages sent to them are:

Changing interrupt handler objects

The above listed messages are implemented in the Object class. Therefore, every object (including nil) will understand and respond to those messages.
For each handler, ObjectMemory provides a messages to get and set the corresponding handler objects. Like signal access methods, these are named after the corresponding handlers variable name. For example,
	ObjectMemory userInterruptHandler
returns, and
	ObjectMemory userInterruptHandler:someObject
sets the UserInterruptHandler.

Notes:

(*) WARNING:

You may easily make the system inoperatable when playing around with these handlers. So be prepared for malfunctions or deadlocks when changing things in this area (think twice and save your work before doing so).
(**) Switched with processes - each process has its own private handler.


Copyright © Claus Gittinger Development & Consulting, all rights reserved

(cg@ssw.de)