mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 05:29:28 +02:00
115 lines
2.8 KiB
ObjectPascal
115 lines
2.8 KiB
ObjectPascal
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.
|