[Back to TIMING SWAG index] [Back to Main SWAG index] [Original]

    {

    The two Units below give you a millisecond timer. Use the global variable
    TimerTick for the timing e.g.
    }

    program Test;

    uses timer;  {or timer2}

    procedure TestIt;
    begin
      ...
      {put code here}
      ...
    end;

    var Time: LongInt;
    begin
      TimerTick := 0;
      TestIt;
      Time := TimerTick;    :Te amount of ms. used by the procedure TestIt;
    end.

    Use Timer if your max. time < $FFFF (65535) Ms, else use Timer2.

    ======================================================================

    {CUT HERE}

    Unit Timer;

    { 1 Ms timer Unit }

    InterFace

    var TimerTick: Word;               { Global Ms counter }

    procedure TDelay(Ms: Integer);     { Ms dealy procedure }
                                       { Resets the global TimerTick variable
    !! }

    Implementation

    const SaveInt = $67;               { Private constants and variables }
          Base = 55;

    var OldExitProc: Pointer;
        Counter: Word;

    procedure TDelay(Ms: Integer);
    begin
      if Ms <= 0 then Exit;
      TimerTick := 0;
      repeat until TimerTick >= Ms;
    end;

    procedure NewTimer; INTERRUPT; Assembler;
    asm
      Dec Counter                      { Decrement counter }
      CMP Counter, $00                 { Call old INT ? }
      JNZ @@2
      Int SaveInt                      { Yes }
      MOV Counter, Base;               { Restore counter }
      JMP @@3
    @@2:
      MOV AL, $20
      OUT $20, AL
    @@3:
      Inc TimerTick                    { Increment Ticker }
    end;

    procedure InitTimer;
    const Freq = 1000;
    var InitialCount: Word;
        OldVector: Pointer;
    begin
      TimerTick := 0;
      Inline($FA);                             { Disable Interrrupts }
      InitialCount := 1193180 div Freq;        { Calculate base for counter }
      Port[$43] := $36;                        { Setl mode for timerchip }
      Port[$40] := Lo(InitialCount);           { Write LSB }
      Port[$40] := Hi(InitialCount);           { Write MSB }
      GetIntVec(8, OldVector);                 { Get Old IntVec }
      SetIntVec(SaveInt,OldVector);            { Int 8 now saved in OldVector }
      SetIntVec(8, @NewTimer);                 { New Int Handler }
      Inline($FB);                             { Enable Interrupts }
    end;

    procedure SaveExitProc; Far;
    var OldVector: Pointer;
    begin
      Inline($FA);
      Port[$43] := $36;                        { Restore old interrupts and }
      Port[$40] := $FF;
      Port[$40] := $FF;
      GetIntVec(SaveInt, OldVector);
      SetIntVec(8, OldVector);
      Inline($FA);
      ExitProc := OldExitProc;                 { Restore old ExitProc }
    end;

    begin
      OldExitProc :=ExitProc;                  { Save ExitProcedure }
      ExitProc := @SaveExitProc;               { Install our ExitProcedure }
      InitTimer;                               { Install new Int Handler }
    end.

    ======================================================================

    Unit Timer2;

    { 1 Ms timer Unit }

    InterFace

    var TimerTick: LongInt;

    procedure TDelay(Ms: LongInt);

    Implementation

    Uses Dos;                 { For the Registers type used in NewTimer }

    const SaveInt = $67;
          Base = 55;

    var OldExitProc: Pointer;
        Counter: Word;
        DTick: LongInt;

    procedure TDelay(Ms: LongInt);
    begin
      if Ms <= 0 then Exit;
      DTick := 0;
      repeat until DTick >= Ms;
    end;

    procedure NewTimer; INTERRUPT;
    var R: Registers;
    begin
      Dec(Counter);
      if (Counter = 0) then
      begin
        Intr(SaveInt,R);
        Counter := Base;
      end
      Else Port[$20] := $20;
      Inc(TimerTick);
      Inc(DTick);
    end;

    procedure InitTimer;
    const Freq = 1000;
    var InitialCount: Word;
        OldVector: Pointer;
    begin
      TimerTick := 0;
      DTick := 0;
      Inline($FA);
      InitialCount := 1193180 div Freq;
      Port[$43] := $36;
      Port[$40] := Lo(InitialCount);
      Port[$40] := Hi(InitialCount);
      GetIntVec(8, OldVector);
      SetIntVec(SaveInt,OldVector);
      SetIntVec(8, @NewTimer);
      Inline($FB);
    end;

    procedure SaveExitProc; Far;
    var OldVector: Pointer;
    begin
      Inline($FA);
      Port[$43] := $36;
      Port[$40] := $FF;
      Port[$40] := $FF;
      GetIntVec(SaveInt, OldVector);
      SetIntVec(8, OldVector);
      Inline($FA);
      ExitProc := OldExitProc;
    ExitProc }
    end;

    begin
      OldExitProc :=ExitProc;
      ExitProc := @SaveExitProc;
      InitTimer;
    end.

[Back to TIMING SWAG index] [Back to Main SWAG index] [Original]