home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / LA / LA018.ZIP / STRG55.ARC / RATE55.PAS < prev    next >
Pascal/Delphi Source File  |  1990-01-02  |  4KB  |  112 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,Strg;
  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.  
  46. procedure WaitForTick;
  47. begin
  48.   Tick1 := LowClock;
  49.   repeat
  50.   until LowClock<>Tick1;
  51.   Tick1 := LowClock;
  52. end;
  53.  
  54. procedure RunTime (Seconds: word);
  55. begin
  56.   if Seconds>3600
  57.     then Seconds:=3600;
  58.   Ticks := trunc(Seconds*TicksPerSec);
  59.   TickFactor := Seconds*TicksPerSec/Ticks; { Accounts for trunc of seconds }
  60.   WaitForTick;
  61. end;
  62.  
  63. procedure Init;
  64. begin
  65.   { ** Initialize any of your variables here: ** }
  66.   S1 := 'Now is the time to check out Eagle Performance Software Products'+
  67.         'for speed tests';
  68.   S2 := S1;
  69. end;
  70.  
  71. procedure ResetVariables;
  72. begin
  73.   { ** Place any variables that need to be reset after each test here: ** }
  74.   { StrMove (S2,S1); }
  75. end;
  76.  
  77. procedure Test;
  78. begin
  79.   Reps := 0;
  80.   RunTime (TestTime);
  81.   repeat
  82.     { ** Insert your test routine here ** }
  83.     b := StrPosL (S1,'speed',1);
  84.     { ** End of test routine ** }
  85.     ResetVariables;
  86.     inc (Reps);
  87.   until LowClock-Tick1>=Ticks;
  88. end;
  89.  
  90. procedure OverHead;
  91. begin
  92.   OverHeadReps := 0;
  93.   RunTime (TestTime);
  94.   repeat
  95.     ResetVariables;
  96.     inc (OverHeadReps);
  97.   until LowClock-Tick1>=Ticks;
  98. end;
  99.  
  100. procedure CalcRate;
  101. begin
  102.   RepsPerSec := TickFactor/((TestTime)*(1.0/Reps-1.0/OverHeadReps));
  103.   WriteLn ('Strings/sec = ',RepsPerSec:8:0);
  104. end;
  105.  
  106. begin
  107.   Init;
  108.   Test;
  109.   OverHead;
  110.   CalcRate;
  111. end.
  112.