home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / SYST55C.ZIP / RATE55.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-08-03  |  3.7 KB  |  116 lines
  1. { =========================================================================== }
  2. { Rate55.pas - Rate timer using only low memory clock.      ver 5.5, 12-01-89 }
  3. {                                                                             }
  4. { This rate timer is a highly accurate timer based on the low memory clock.   }
  5. { It is device independent by not accessing any special timer hardware and    }
  6. { does not use any interrupts.  Accuracy is +-1 repetition.                   }
  7. {                                                                             }
  8. { This timer is great for timing short events (1 microsecond to .1 second) to }
  9. { get a Reps-per-second result.  The secret to such great accuracy is keying  }
  10. { in on the fact that the low memory clock is very accurate and on schedule   }
  11. { every time it ticks.  So, just make the event work by the clock rather than }
  12. { vice-versa.                                                                 }
  13. {                                                                             }
  14. { The timer is set for a 1 second test.  If you can't get enough repetitions  }
  15. { (>100) to get any resolution, you are free to change TestTime up to 3600    }
  16. { seconds.                                                                    }
  17. {                                                                             }
  18. { The timer even accounts for the overhead of the timer itself and any other  }
  19. { overhead that is a part of your event.  Just insert your code and go.  You  }
  20. { may experience a litter jitter while running in the integrated environment, }
  21. { but is solid when run as an executable file.                                }
  22. {   Public Domain by James H. LeMay, Eagle Performance Software               }
  23. { =========================================================================== }
  24. {$A+,B-,D+,E+,F-,I-,L+,N+,O-,R-,S-,V-}
  25.  
  26. program RateTimer;
  27.  
  28. uses
  29.   Crt;
  30.  
  31. const
  32.   TestTime = 1;  { seconds }
  33.   TicksPerDay = 1573040.0;            { DOS timer ticks/day. }
  34.   TicksPerSec = TicksPerDay/86400.0;
  35.  
  36. var
  37.   LowClock: word absolute $0000:$046C;
  38.   Tick1,Ticks:           word;
  39.   Reps,OverheadReps:     longint;
  40.   RepsPerSec,TickFactor: real;
  41.   R: real absolute RepsPerSec; { Variable name is easier to Watch }
  42.   { -- Place your variables here: -- }
  43.   S1,S2: string;
  44.   b:     byte;
  45.   L1,L2,L3: longint;
  46.  
  47. procedure WaitForTick;
  48. begin
  49.   Tick1 := LowClock;
  50.   repeat
  51.   until LowClock<>Tick1;
  52.   Tick1 := LowClock;
  53. end;
  54.  
  55. procedure RunTime (Seconds: word);
  56. begin
  57.   if Seconds>3600
  58.     then Seconds:=3600;
  59.   Ticks := trunc(Seconds*TicksPerSec);
  60.   TickFactor := Seconds*TicksPerSec/Ticks; { Accounts for trunc of seconds }
  61.   WaitForTick;
  62. end;
  63.  
  64. procedure Init;
  65. begin
  66.   { ** Initialize any of your variables here: ** }
  67.   S1 := 'Now is the time to check out Eagle Performance Software Products'+
  68.         'for speed tests';
  69.   S2 := S1;
  70.   L1 := 12345678;
  71.   L2 := 100;
  72. end;
  73.  
  74. procedure ResetVariables;
  75. begin
  76.   { ** Place any variables that need to be reset after each test here: ** }
  77.   { StrMove (S2,S1); }
  78. end;
  79.  
  80. procedure Test;
  81. begin
  82.   Reps := 0;
  83.   RunTime (TestTime);
  84.   repeat
  85.     { ** INSERT CODE ** }
  86.     { ** Insert your test routine here ** }
  87.     L3 := L1 div L2;
  88.     { ** End of test routine ** }
  89.     ResetVariables;
  90.     inc (Reps);
  91.   until LowClock-Tick1>=Ticks;
  92. end;
  93.  
  94. procedure OverHead;
  95. begin
  96.   OverHeadReps := 0;
  97.   RunTime (TestTime);
  98.   repeat
  99.     ResetVariables;
  100.     inc (OverHeadReps);
  101.   until LowClock-Tick1>=Ticks;
  102. end;
  103.  
  104. procedure CalcRate;
  105. begin
  106.   RepsPerSec := TickFactor/((TestTime)*(1.0/Reps-1.0/OverHeadReps));
  107.   WriteLn ('Reps/second = ',RepsPerSec:8:0);
  108. end;
  109.  
  110. begin
  111.   Init;
  112.   Test;
  113.   OverHead;
  114.   CalcRate;
  115. end.
  116.