home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
tpdoskermit.tar.gz
/
tpdoskermit.tar
/
timers.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-04-18
|
2KB
|
110 lines
$R-,S-,F+} {No local proc's!
Unit Timers;
Interface
TYPE
TimerTablePtr = ^TimerTableRec;
TimerTableRec = RECORD
next : TimerTablePtr;
count : LongInt;
UserInt, active : BOOLEAN;
END;
CONST
TimerPtr : TimerTablePtr = NIL;
VAR SaveExit, OldTimer : Pointer;
PROCEDURE StartTimer(VAR t : TimerTableRec);
PROCEDURE StopTimer(VAR t : TimerTableRec);
FUNCTION GetTimer(VAR t : TimerTableRec): LongInt;
FUNCTION RunningTimer(VAR t : TimerTableRec): BOOLEAN;
PROCEDURE GetVector(IntNr : WORD; VAR vector: Pointer);
PROCEDURE SetVector(IntNr : WORD; vector: Pointer);
Implementation
VAR IntVectorTable : ARRAY [0..255] OF Pointer ABSOLUTE 0:0;
PROCEDURE GetVector(IntNr : WORD; VAR vector: Pointer);
BEGIN
vector := IntVectorTable[IntNr];
END;
PROCEDURE SetVector(IntNr : WORD; vector: Pointer);
BEGIN
Inline($FA);
IntVectorTable[IntNr] := vector;
InLine($FB);
END;
PROCEDURE StopTimer(VAR t : TimerTableRec);
VAR tp, ne : TimerTablePtr;
BEGIN
t.active := FALSE;
{
IF TimerPtr = NIL THEN Exit;
IF TimerPtr = @t THEN BEGIN
Inline($FA);
TimerPtr := t.next;
Inline($FB);
Exit;
END;
}
tp := @TimerPtr;
ne := TimerPtr;
WHILE ne <> NIL DO BEGIN
IF ne = @t THEN BEGIN
Inline($FA);
tp^.next := t.next;
Inline($FB);
Exit;
END;
tp := ne;
ne := ne^.next;
END;
END;
PROCEDURE StartTimer(VAR t : TimerTableRec);
BEGIN
StopTimer(t);
t.next := TimerPtr;
t.active := TRUE;
Inline($FA);
TimerPtr := @t;
Inline($FB);
END;
FUNCTION GetTimer(VAR t : TimerTableRec): LongInt;
BEGIN
Inline($FA);
GetTimer := t.count;
Inline($FB);
END;
FUNCTION RunningTimer(VAR t : TimerTableRec): BOOLEAN;
BEGIN
RunningTimer := t.active;
END;
PROCEDURE Timer_Int; EXTERNAL; {$L timers.obj}
PROCEDURE Exit_Timers;
BEGIN
SetVector(8,OldTimer);
ExitProc := SaveExit;
END;
BEGIN
GetVector(8,OldTimer);
SetVector(8,@Timer_Int);
SaveExit := ExitProc;
ExitProc := @Exit_Timers;
END.