High Voltage Shareware/high1.zip/high1/DIR9/QWIK71A.ZIP/TIMER24.PAS

Pascal/Delphi Source File | 1993-09-23 | 6KB | 196 lines

{ ========================================================================== }
{ Timer24.pas - High-resolution timer                     ver 7.1a, 09-23-93 }
{                                                                            }
{ A precise 24 hour timer with resolution of 1 micro-second to measure       }
{ elapsed time in seconds.                                                   }
{                                                                            }
{ Can be used in DOS or Windows.  It will only perform adequately in Windows }
{ standard mode.                                                             }
{                                                                            }
{  Copyright (C) 1992,1993 James H. LeMay for Eagle Performance Software     }
{ ========================================================================== }

{$A+,F-,R-,S- }

UNIT Timer24;


INTERFACE

type
  StartStop = (Start, Stop, Sync);

var
  ElapsedTime: real;  { Time between last start and last stop. (seconds) }

procedure Timer (SS: StartStop);
procedure WaitForTick;


IMPLEMENTATION

{$ifdef Windows }
uses
  WinProcs, WinTypes;
{$endif }

type
  TicksArray = array [1..5] of byte;

var
  PrevExitProc:    pointer;
  T1array,T2array: TicksArray;
  t0,              { Timer overhead     (ticks) }
  t1,              { Time at last Start (ticks) }
  t2: real;        { Time at last Stop  (ticks) }
  LowClock: word absolute $0040:$006C;

const
  TicksPerDay = 103090749440.0;        { 2^16 * 1573040 DOS timer ticks/day. }
  TicksPerSec = TicksPerDay/86400.0;

procedure SetTimerMode; assembler;
  asm
    mov   al,$34    { For counter 0, mode 2 }
    out   $43,al    { Set timer for input   }
    jmp   @1        { Null jump             }
@1: xor   ax,ax     { Set ax=0 (Max count)  }
    out   $40,al    { LSB first             }
    jmp   @2        { Null jump             }
@2: out   $40,al    { MSB second            }
end;

procedure GetTicks (VAR Ticks: TicksArray);
begin
  asm
    mov   dx,$40         { Data port for timer }
    mov   es,dx          { Segment for DOS timer }
    mov   al,dh          { 0 to latch counter 0 }

    cli                  { Prevent interrupts }
    seges mov bl,[$006C] { Low byte of system timer }
    seges mov si,[$006D] { Mid word of system timer }

    out   $43,al         { Latch timer }
    jmp   @0             { Null jump }
@0: in    al,dx          { Timer chip LSB }
    jmp   @1             { Null jump }
@1: mov   cl,al          { Save in CL }
    in    al,dx          { Timer chip MSB }
    sti                  { Enable interrupts AFTER MOV }
                         {   Interrupts not enabled yet in DOS }
                         {   Interrupts enabled in Windows }
    mov   ax,ax          { Fast NOP }
                         {   Now interrupts enabled in DOS }
                         { Let system clock be updated now }
    seges mov bh,[$006C] { Again copy of the Low byte }
    mov   ch,al          { Move in CH }
    not   cx             { Convert count-down to up }

    cmp   ch,10          { Time since system tick <2560 ticks? }
    adc   dh,dh          { Save copy of CF }
    sub   bh,bl          { BH=1 if before<>after }
    and   dh,bh          { DH=1 if pending tick INT }
    add   bl,dh          { Inc if INT was pending }
    adc   si,$0000       { Just propogate carry bit }

    les   di,Ticks       { Load address of ticks }
    mov   es:[di],cx     { Store chip timer word }
    mov   es:[di+2],bl   { Store system low byte }
    mov   es:[di+3],si   { Store system mid word }
  end;
end;

function ArrayToReal (Ticks: TicksArray): real;
var
  T: record
      B: byte;
      L: longint;
     end absolute Ticks;
begin
  ArrayToReal := (T.L)*256.0 + T.B;
end;

procedure Timer;
begin
  case SS of
    Stop:  begin
             GetTicks (T2array);
             t1 := ArrayToReal (T1array);        { Convert AFTER the event! }
             t2 := ArrayToReal (T2array);
             if t2<t1 then
               t2 := t2+TicksPerDay;
             ElapsedTime := (t2-t1-t0)/TicksPerSec   { units of seconds }
           end;
    Start: begin
             ElapsedTime := 0;
             GetTicks (T1array)
           end;
    Sync:  begin
             ElapsedTime := 0;
             SetTimerMode;
             GetTicks (T1array)
           end;
  end;
end;

procedure WaitForTick;
var Tick: real;
begin
  Tick := LowClock;
  repeat
  until LowClock<>Tick;
end;

procedure TimerInit;
var
  least: real;
  b:     byte;
begin
  t0    := 0.0;                        { Initial value to prevent overflow }
  least := 1000000.0;                  { Initial value that's too high }
  WaitForTick;
  for b:=1 to 5 do
    begin                              { Check timer overhead by timing }
      Timer (Start);                   { itself.  Do it 5 times to get the }
      Timer (Stop);                    { least value.  }
      t0 := ArrayToReal(T2array) - ArrayToReal(T1array);
      if t0<least then
        least:=t0;
    end;
  t0 := least;                         { Minimum overhead for timer }
end;

{$F+}
procedure ExitTimer24;
begin
  ExitProc := PrevExitProc;
  { -- Restore default timer mode -- }
  asm
    mov   al,$36     { For counter 0, mode 3 }
    out   $43,al     { Set timer for input   }
    jmp   @1         { Null jump             }
@1: xor   ax,ax      { Set ax=0 (Max count)  }
    out   $40,al     { LSB first             }
    jmp   @2         { Null jump             }
@2: out   $40,al     { MSB second            }
  end;
end;
{$F-}

BEGIN
   {$ifdef Windows }
  if (GetWinFlags and wf_Standard)=0 then
    begin
      MessageBox (0,'Must run Timer24 unit in standard mode',nil,
                  mb_OK+mb_TaskModal);
      Halt(1);
    end;
   {$endif }

  PrevExitProc := ExitProc;
  ExitProc     := @ExitTimer24;
  SetTimerMode;
  TimerInit;
END.