Path: utzoo!utgpu!jarvis.csri.toronto.edu!mailrus!tut.cis.ohio-state.edu!pacific.mps.ohio-state.edu!zaphod.mps.ohio-state.edu!brutus.cs.uiuc.edu!jarthur!polyslo!vlsi3b15!vax1.cc.lehigh.edu!lehigh.bitnet!KRW1
From: KRW1%LEHIGH.BITNET@IBM1.CC.Lehigh.EDU
Newsgroups: comp.lang.pascal
Subject: Re: millisecond timer
Message-ID: <09029012:46:23KRW1@lehigh.bitnet>
Date: 9 Feb 90 17:46:23 GMT
Lines: 184
Return-path: KRW1 <@IBM1.CC.Lehigh.EDU:KRW1@Lehigh.Bitnet>
To: lusysnz@VAX1.CC.LEHIGH.EDU

Okay - here's a simple-minded Turbo Pascal unit that uses the speaker
timer to return a reference time in units of 10 microseconds.  Works as
long as you don't need the speaker.  Accuracy is on the order of 30 to
300 microseconds, depending on your system.  Use inittimer to begin
counting, and function timervalue to get current reading.  Be careful of
the 32-bit counter overflowing for long time periods.
-------------------------------------------------------------------

unit timer;

INTERFACE

type
  userproc = procedure;

var
  timeractive, hirestimer: boolean;
  procpointer: userproc;

function systime: longint;
function timervalue: longint;
procedure inittimer;
procedure resettimer;
procedure suspendtimer;
procedure defproc(proc: userproc);


IMPLEMENTATION

uses dos, crt;

var
  oldtimer, exitsave: pointer;
  exacttime, restart, starttime: longint;
  lowbyte, highbyte, ref: word;

{$f+}
procedure dummy;
  begin
  end;
{$f-}

procedure defproc(proc: userproc);

  { Define optional user procedure to call at clock interrupt }

  begin
    procpointer := proc;
  end;

function systime: longint;

  { Return system time in milliseconds }

  var
    h, m, s, hs: word;

  begin
    gettime(h,m,s,hs);
    systime := (((longint(h)*60+m)*60+s)*100+hs)*10;
  end;

procedure clock; interrupt;

  {Update 10-microsecond timer}

  const
    incr = 5493;                       {Timer increment per interrupt}

  begin
    inline($fa);                       {Disable interrupts}
    port[$43] := $80;                  {Latch timer 2}
    lowbyte := port[$42];
    highbyte := port[$42];
    ref := (highbyte shl 8) + lowbyte; {Base for subsequent readings
                                          within current clock interval}
    exacttime := exacttime + incr;     {New 10-mic timer value}
    inline($fb);                       {Enable interrupts}

(* ---- disabled
    procpointer;                       {Execute user procedure}
*)
  end;

function timervalue: longint;

  {Get value of 10-microsecond timer}

  var
    dif, low, high: word;
    t: longint;

  begin
    if hirestimer then
      begin
        inline($fa);
        port[$43] := $80;
        low := port[$42];
        high := port[$42];
        dif := ref - ((high shl 8) + low);
        timervalue := exacttime + (longint(dif)*100 div 1193);
        inline($fb);
      end
    else
      begin
        t := systime;
        if t < starttime then t := t + 8640000;
        timervalue := (t - starttime) * 100;
      end;
  end;

procedure resettimer;

  begin
    if timeractive and hirestimer then
      begin
        setintvec($1c, oldtimer);
        timeractive := false;
      end;
  end;

procedure inittimer;

  begin
    if not timeractive then
      begin
        exacttime := restart;
        if hirestimer then
          begin
            getintvec($1c, oldtimer);
            setintvec($1c, @clock);
            {Start high-precision timer}
            port[$43] := $b2;   {Mode 1 - countdown
                                 (approx .84 microsecond ticks)}
            port[$42] := $ff;   {Initialize timer value}
            port[$42] := $ff;
            timeractive := true;
            delay(25);                     {Allow for first tick}
            if timervalue = timervalue then
              begin                        {Not incrementing - use low res}
                resettimer;
                hirestimer := false;
              end;
          end;
      end;
  end;

procedure suspendtimer;

  begin
    restart := exacttime - 2500;
    resettimer;
    timeractive := false;
  end;

procedure cleartimer;

  begin
    suspendtimer;
    starttime := systime;
    restart := 0;
    inittimer;
  end;

{$f+}
procedure timerexit;

  {Exit procedure}

  begin
    exitproc := exitsave;
    resettimer;
  end;
{$f-}

begin
  timeractive := false;
  hirestimer := true;
  restart := 0;
  starttime := systime;
  exitsave := exitproc;              {Save exit address}
  exitproc := @timerexit;
  procpointer := dummy;
end.