Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

To the person (ElusiveYak?) who asked about timing events in Pascal

Status
Not open for further replies.

Glenn9999

Programmer
Jun 19, 2004
2,311
US
I don't know what happened to the message, but as I said in there, I was going to go through my pile of stuff and see if I can find something to help you. Well here you are:

There are two different ways to approach it - it depends on what kind of timing you're looking for.

Main proc timing - this is what crt.delay does
Code:
program timer; uses crt;
  const
    one_second = 18;
    one_minute = 1080;
  var
    TSMN: longint absolute $0040:$006c;
    { location for timer ticks to read them yourself.
      There are 18.20648 ticks in one second and
      1573040 ticks in one day - useful for when crt.delay
      isn't really what you want or you don't want the CRT
      unit involved. Value is reset at midnight. }

    start_time: longint;
    elapsed_time: longint;
    second_time: longint;
    time: integer;
    homex, homey: byte;
  begin
    { not entirely accurate, but a demonstration nonetheless }
    start_time := TSMN;
    elapsed_time := TSMN - start_time;
    time := 0;
    homex := wherex; homey := wherey;
    while elapsed_time < one_minute do
      begin
        if (TSMN - second_time) > one_second then
          begin
            inc(time);
            write(time);
            gotoxy(homex, homey);
            second_time := TSMN;
          end;
        elapsed_time := TSMN - start_time;
      end;
  end.

Now ISR timing (this is probably closer to what you want):
Code:
program Timer2; uses Dos, crt;
const
  five_seconds = 18.2 * 1;
var
   Int1CSave   : pointer;  {dword to hold original Int $1C vector}
   ExitSave    : pointer;  {Save the address of next unit exit proc in chain}
   counter: longint;
   time_count: integer;

procedure write_update(var counter: longint);
  var
    homex, homey: byte;
  begin
    homex := wherex; homey := wherey;
    gotoxy(1,1);
    inc(time_count);
    write(time_count, '                                              ');
    gotoxy(homex, homey);
    counter := 0;
  end;

{$F+}
procedure Clock_ISR; interrupt;
  begin
    inline($FA); {cli}
    inc(counter);
    if counter > five_seconds then
      begin
        inline($FB);          {sti}
        write_update(counter);
        inline($FA);          {cli}
      end;
    inline($FB); {sti}
  end;
{$F-}

{$F+}
Procedure myExitProc;
begin
  ExitProc := ExitSave;  {Restore the chain so other units get a turn}
  SetIntVec($1C, Int1CSave);     {restore the original Int $1C vector}
end;
{$F-}

Begin
  ExitSave := ExitProc;
  ExitProc := @myExitProc;
  GetIntVec($1C, Int1CSave);     {Save original Int $1C vector}
  SetIntVec($1C, @Clock_ISR);    {install the the clock ISR}

  time_count := 0;
  writeln;
  writeln;
  writeln;
  writeln('Wait, type, and enter some values.');
  readln;
end.

Use this code at your own peril, only guarantees are that it will take up space in this message and on your drive if you save it there. It didn't hose my computer while I was testing it, but that doesn't mean it might not still have bugs, etc, etc.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top