[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]