[Back to TIMING SWAG index] [Back to Main SWAG index] [Original]
{
From: JAKE CHAPPLE
Subj: Events on IRQ/TIMERS
---------------------------------------------------------------------------
}
{----------------------- Beginning of TIMER.PAS -----------------------}
Unit Timer;
{========================================================================}
{ INTERFACE SECTION }
{========================================================================}
{ }
{ This unit implements a set of general purpose, low resolution timers }
{ for use in any application that requires them. The design of the }
{ timer system is adapted from the following magazine article: }
{ }
{ Jones S., A High-Performance Lightweight Timer Package, Tech }
{ Specialist, Vol. 2, No. 1, Jan 1991, pp 17-27. }
{ }
{ Most of Jones' design has been copied, although this implementation is }
{ in Turbo Pascal rather than MASM. By default, this unit provides 10 }
{ timers, although this can be increased by increasing the value of }
{ MAX_TIMER and re-compiling. }
{ }
{ Timers are referenced by "handles" i.e. small integers. These are }
{ actually indexes into the timer array. To obtain a handle one must }
{ ALLOCATE a timer. The Allocate function also requires the address of }
{ a routine to execute when the timer expires as well as a user context }
{ variable. The timer function must be compiled as a FAR routine. The }
{ user context variable is a 16 bit word of data that can be used for any}
{ application specific purpose. It is passed to the timer routine when }
{ the timer expires. This is useful if a common timer routine is used }
{ for multiple timers. It allows the common timer routine to determine }
{ which timer expired and take appropriate action. }
{ }
{ Once a timer is allocated, it must be STARTED. The StartTimer }
{ procedure requires the timer handle and a timer running time. The }
{ timer running timer is passed as a RELATIVE number of MILLISECONDS i.e.}
{ the number of milliseconds from now when the timer should expire. }
{ }
{ A timer can be stopped before it expires with StopTimer which just }
{ requires the timer handle. There is the possibility that the StopTimer}
{ routine could be interrupted by a clock tick and the expiration routine}
{ could run before the StopTimer procedure actually stops the timer. }
{ It's up to you to guard against this. }
{ }
{ Finally, an allocated timer can be deallocated with DeallocateTimer }
{========================================================================}
INTERFACE
uses
Dos;
type
UserProc = procedure(context : word);
function AllocateTimer(UserContext : word; UserRtn : UserProc) : integer;
procedure StartTimer(handle : integer; rel_timeout : longint);
procedure StopTimer(handle : integer);
procedure DeallocateTimer(handle : integer);
{========================================================================}
{ IMPLEMENTATION SECTION }
{========================================================================}
IMPLEMENTATION
const
MAX_TIMER = 10; {Total number of timers}
MILLISECS_PER_TICK = 55; {clock tick interval}
TIMER_ALLOCATED = 1; {bits in the timer flags word}
TIMER_RUNNING = 2;
type
timer_rec = record {Timer descriptor record}
timeout : longint; {Timeout. Absolute number of millisecs}
{From beginning of program execution}
routine : UserProc; {User procedure to run on expiration}
flags : word; {Timer status flags}
context : word; {User parameter to pass to User Proc}
end;
var
timers : array[1..MAX_TIMER] of timer_rec; {timer database}
Int1CSave : pointer; {dword to hold original Int $1C vector}
TimeCounter : longint; {incremented by 55 millisecs on every entry to ISR}
ExitSave : pointer; {Save the address of next unit exit proc in chain}
i : integer; {loop counter}
{$F+}
{------------------------------------------------------------------------}
procedure Clock_ISR; interrupt;
{------------------------------------------------------------------------}
{ Description: }
{ This is an interrupt service routine which is hooked into the PC's }
{ $1C vector. An Int $1C is generated at each clock tick. Int $1C is }
{ executed by the hardware interrupt service routine after it has up- }
{ dated the system time-of-day clock. }
{ Parameters: }
{ None. }
{------------------------------------------------------------------------}
var
i : integer; {local loop counter}
begin
{Update the current time, relative to the start of the program}
inline($FA); {cli}
TimeCounter := TimeCounter + MILLISECS_PER_TICK; {update millisecond counter}
{Scan the array of timers looking for ones which have expired}
for i := 1 to MAX_TIMER do
with timers[i] do
if (flags and TIMER_ALLOCATED) > 0 then {Is this timer allocated? if no}
if (flags and TIMER_RUNNING) > 0 then {Is this timer running? if not}
if timeout <= TimeCounter then begin {Has this timer expired yet?}
flags := flags and (not TIMER_RUNNING); {turn off running flag}
inline($FB); {sti}
routine(context); {call user expiration routine}
inline($FA); {cli}
end;
inline($FB); {sti}
end;
{$F-}
{------------------------------------------------------------------------}
function AllocateTimer(UserContext : word; UserRtn : UserProc) : integer;
{------------------------------------------------------------------------}
{ Description: }
{ Allocate the next available timer in the timer database for use by }
{ application. }
{ Parameters: }
{ UserContext - application specific word of data to be passed to the }
{ expiration routine when it is called. }
{ UserProc - address of a procedure to be called when the timer expires}
{ Returns: }
{ Handle - integer from 1 to MAX_TIMER }
{ OR -1 if no timers available. }
{------------------------------------------------------------------------}
var
i : integer;
begin
inline($FA); {cli}
for i := 1 to MAX_TIMER do begin {scan timer database looking for 1st free}
with timers[i] do begin
if flags = 0 then begin
flags := TIMER_ALLOCATED; {Mark timer as allocated}
context := UserContext; {Save users context variable}
routine := UserRtn; {Store user routine}
AllocateTimer := i; {Return handle to timer}
inline($FB); {Enable interrupts}
exit;
end;
end;
end;
{ No timers available, return error}
AllocateTimer := -1;
inline($FB);
end;
{------------------------------------------------------------------------}
procedure DeallocateTimer(handle : integer);
{------------------------------------------------------------------------}
{ Description: }
{ Return a previously allocated timer to the pool of available timers }
{------------------------------------------------------------------------}
begin
timers[handle].flags := 0;
end;
{------------------------------------------------------------------------}
procedure StartTimer(handle : integer; rel_timeout : longint);
{------------------------------------------------------------------------}
{ Description: }
{ Start an allocated timer ticking. }
{ Parameters: }
{ Handle - the handle of a previously allocated timer. }
{ rel_timeout - number of milliseconds before the timer is to expire. }
{------------------------------------------------------------------------}
begin
inline($FA); {cli}
with timers[handle] do begin
flags := flags or TIMER_RUNNING; {set timmer running flag}
timeout := TimeCounter + rel_timeout; {Convert relative timeout to absolute}
end;
inline($FB); {sti}
end;
{------------------------------------------------------------------------}
procedure StopTimer(handle : integer);
{------------------------------------------------------------------------}
{ Description: }
{ Stop a ticking timer from running. This routine does not deallocate }
{ the timer, just stops it. Remember, it is possible for the clock }
{ interrupt to interrupt this routine before it actually stops the }
{ timer. Therefore, it is possible for the expiration routine to run }
{ before the timer is stopped i.e. unexpectedly. }
{ Parameters: }
{ Handle - handle of timer to stop. }
{------------------------------------------------------------------------}
begin
with timers[handle] do
flags := flags and (not TIMER_RUNNING);
end;
{$F+}
{------------------------------------------------------------------------}
Procedure myExitProc;
{------------------------------------------------------------------------}
{ Description: }
{ This is the unit exit procedure which is called as part of a chain of }
{ exit procedures at program termination. }
{------------------------------------------------------------------------}
begin
ExitProc := ExitSave; {Restore the chain so other units get a turn}
SetIntVec($1C, Int1CSave); {restore the original Int $1C vector}
end;
{$F-}
{=========================================================================}
{ INITIALIZATION SECTION }
{=========================================================================}
Begin {unit initialization code}
(* Establish the unit exit procedure *)
ExitSave := ExitProc;
ExitProc := @myExitProc;
{Initialize the timers database and install the custom Clock ISR}
for i := 1 to MAX_TIMER do {clear flag word for all timers}
timers[i].flags := 0;
TimeCounter := 0; {clear current time counter}
GetIntVec($1C, Int1CSave); {Save original Int $1C vector}
SetIntVec($1C, @Clock_ISR); {install the the clock ISR}
end.
{------------------------- End of TIMER.PAS -----------------------------}
{---------------------- Beginning of TIMERTST.PAS -----------------------}
program timer_test;
uses
Crt, timer;
var
t1, t2 : integer; {timer handles}
done : boolean;
{---- Procedure to be run when timer 1 expires ----}
procedure t1_proc(context1 : word); far;
begin
writeln('Timer ',context1);
StartTimer(t1, 1000); {Keep timer 1 running}
end;
{---- Procedure to be run when timer 2 expires ----}
procedure t2_proc(context2 : word); far;
begin
done := true;
writeln('Timer ',context2,' expired');
end;
begin
ClrScr;
done := false;
t1 := AllocateTimer(1, t1_proc); {Create timer 1}
t2 := AllocateTimer(2, t2_proc); {Create timer 2}
StartTimer(t2, 5000); {Start timer 2 for 5 second delay}
StartTimer(t1, 1000); {Start timer 1 for 1 second delay}
while not done do begin {Do nothing until timer 2 expires}
end;
StopTimer(t1);
end.
[Back to TIMING SWAG index] [Back to Main SWAG index] [Original]