freepascal.compiler/packages/numlib/tests/timer.pas

unit timer;

{$r-,s-}

INTERFACE

var
  timeractive: boolean;
  exacttime, mstime: longint;

function timervalue: longint;          {Return time in 10 usec units}
function mstimer: longint;             {Return time in ms}

IMPLEMENTATION

uses dos, crt;

var
  lowbyte, highbyte, ref: word;
  timerid: integer;
  saveint, exitsave: pointer;

function inport(x: integer): byte;     {Read i/o port}
  inline($5a/$eb/$00/$ec);

{$F+}
procedure clock(p: pointer); interrupt;
{$F-}
  {Interrupt service routine to update timer reference values}

  const
    incr = 5493;                       {Timer increment per interrupt}

  begin
    port[$43] := $00;                  {Latch timer 0}
    lowbyte := inport($40);
    highbyte := inport($40);
    ref := (highbyte shl 8) + lowbyte; {Base for subsequent readings
                                          within current clock interval}
    exacttime := exacttime + incr;     {New 10 usec timer value}
    mstime := mstime + 55;             {New ms timer value}
    inline($9c/$ff/$1e/saveint);       {Chain to old interrupt}
  end;

function timervalue: longint;

  {Get value of 10-usec timer}

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

  begin
    inline($fa);                         {Disable interrupts}
    port[$43] := $00;                    {Latch timer}
    low := inport($40);                  {Timer LSB}
    high := inport($40);                 {MSB}
    dif := ref - ((high shl 8) + low);   {Delta from last sync}
    timervalue := exacttime + (longint(dif)*100 div 1193);
    inline($fb);                         {Re-enable interrupts}
  end;

function mstimer: longint;

  {Get value of millisecond timer}

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

  begin
    inline($fa);
    port[$43] := $00;
    low := inport($40);
    high := inport($40);
    inline($fb);
    dif := ref - ((high shl 8) + low);
    mstimer := mstime + (dif div 1193);
  end;

procedure inittimer;

  begin
    exacttime := 0;
    mstime := 0;
    if not timeractive then
      begin
        port[$43] := $34;   {Mode 2 - countdown
                             (approx .84 microsecond ticks)}
        port[$40] := $ff;   {Initialize timer value}
        port[$40] := $ff;
        getintvec(8, saveint);         {Save old interrupt address}
        setintvec(8, @clock);          {Install new service routine}
        timeractive := true;
        delay(60);                     {Allow for first tick}
      end;
  end;

{$f+} procedure myexit; {$f-}

  {Assure timer interrupt restored before exit}

  begin
    if timeractive then
      setintvec(8, saveint);
    exitproc := exitsave;             {Restore TP exit chain}
  end;

begin  {unit initialization}
  timeractive := false;
  exitsave := exitproc;               {Insert exit routine}
  exitproc := @myexit;
  InitTimer
end.
unit timer;

{$r-,s-}

INTERFACE

var
  timeractive: boolean;
  exacttime, mstime: longint;

function timervalue: longint;          {Return time in 10 usec units}
function mstimer: longint;             {Return time in ms}

IMPLEMENTATION

uses dos, crt;

var
  lowbyte, highbyte, ref: word;
  timerid: integer;
  saveint, exitsave: pointer;

function inport(x: integer): byte;     {Read i/o port}
  inline($5a/$eb/$00/$ec);

{$F+}
procedure clock(p: pointer); interrupt;
{$F-}
  {Interrupt service routine to update timer reference values}

  const
    incr = 5493;                       {Timer increment per interrupt}

  begin
    port[$43] := $00;                  {Latch timer 0}
    lowbyte := inport($40);
    highbyte := inport($40);
    ref := (highbyte shl 8) + lowbyte; {Base for subsequent readings
                                          within current clock interval}
    exacttime := exacttime + incr;     {New 10 usec timer value}
    mstime := mstime + 55;             {New ms timer value}
    inline($9c/$ff/$1e/saveint);       {Chain to old interrupt}
  end;

function timervalue: longint;

  {Get value of 10-usec timer}

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

  begin
    inline($fa);                         {Disable interrupts}
    port[$43] := $00;                    {Latch timer}
    low := inport($40);                  {Timer LSB}
    high := inport($40);                 {MSB}
    dif := ref - ((high shl 8) + low);   {Delta from last sync}
    timervalue := exacttime + (longint(dif)*100 div 1193);
    inline($fb);                         {Re-enable interrupts}
  end;

function mstimer: longint;

  {Get value of millisecond timer}

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

  begin
    inline($fa);
    port[$43] := $00;
    low := inport($40);
    high := inport($40);
    inline($fb);
    dif := ref - ((high shl 8) + low);
    mstimer := mstime + (dif div 1193);
  end;

procedure inittimer;

  begin
    exacttime := 0;
    mstime := 0;
    if not timeractive then
      begin
        port[$43] := $34;   {Mode 2 - countdown
                             (approx .84 microsecond ticks)}
        port[$40] := $ff;   {Initialize timer value}
        port[$40] := $ff;
        getintvec(8, saveint);         {Save old interrupt address}
        setintvec(8, @clock);          {Install new service routine}
        timeractive := true;
        delay(60);                     {Allow for first tick}
      end;
  end;

{$f+} procedure myexit; {$f-}

  {Assure timer interrupt restored before exit}

  begin
    if timeractive then
      setintvec(8, saveint);
    exitproc := exitsave;             {Restore TP exit chain}
  end;

begin  {unit initialization}
  timeractive := false;
  exitsave := exitproc;               {Insert exit routine}
  exitproc := @myexit;
  InitTimer
end.