home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 2 / crawlyvol2.bin / program / pascal / passrc / timer.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-18  |  3.6 KB  |  128 lines
  1. { -----------------------------------------------------------------------------
  2.  
  3.                                  NOTICE:
  4.  
  5.       THESE MATERIALS are UNSUPPORTED by OSS!  If you do not understand how to
  6.       use them do not contact OSS for help!  We will not teach you how to 
  7.       program in Pascal.  If you find an error in these materials, feel free
  8.       to SEND US A LETTER explaining the error, and how to fix it.
  9.  
  10.       THE BOTTOM LINE:
  11.  
  12.          Use it, enjoy it, but you are on your own when using these materials!
  13.  
  14.  
  15.                                DISCLAIMER:
  16.  
  17.       OSS makes no representations or warranties with respect to the contents
  18.       hereof and specifically disclaim all warranties of merchantability or
  19.       fitness for any particular purpose.   This document is subject to change
  20.       without notice.
  21.       
  22.       OSS provides these materials for use with Personal Pascal.  Use them in
  23.       any way you wish.
  24.  
  25.    -------------------------------------------------------------------------- }
  26.  
  27.  
  28. program test_timer;
  29.  
  30. {
  31.  
  32.         Program to demonstrate method of grabbing the 200hz timer in
  33.         system variables area ($4ba)
  34.  
  35.         Sept. 25, 1986 M Curry
  36.  
  37. }
  38.  
  39. VAR
  40.       c : char;
  41.       start, finish : long_integer;
  42.  
  43. {
  44.  
  45.         Declare bios and gemdos routinese we will need
  46.         See Intro.txt, char.txt, ST Internals
  47.  
  48. }
  49.  
  50. Function Super( x: long_integer ) : long_integer;
  51.    Gemdos( $20 );
  52.  
  53. { ***********************************************************************
  54.  
  55.         Set cursor on (true) or off (false)
  56.  
  57.   *********************************************************************** }
  58.  
  59. Procedure Cursor( b : boolean );
  60.  
  61.   Begin
  62.      Write( chr( 27 ) );
  63.      IF b THEN Write( 'e' ) ELSE Write( 'f' );
  64.   End;
  65.  
  66.  
  67. { ************************************************************************
  68.  
  69.         Time Function returns system timer ticks 200/second resolution
  70.  
  71.   ************************************************************************ }
  72.  
  73. Function Time : Long_integer;
  74.  
  75.   Type
  76.  
  77.      Long_pointer = ^long_integer;
  78.  
  79.   Var
  80.  
  81.      SSP : Long_Integer;        { save old supervisor stack pointer }
  82.  
  83.      hz_200 : RECORD
  84.         CASE Boolean OF
  85.             true : ( l: long_integer );
  86.            false : ( p: long_pointer );
  87.         END;
  88.  
  89.   BEGIN
  90.       SSP := Super( 0 );        { save supervisor stack.. enter super mode }
  91.       hz_200.l := $4ba;         { point at 200 hertz timer }
  92.       {$p-}                     { turn pointer checking off }
  93.       Time := hz_200.p^;        { get the longword at that location }
  94.       {$p=}                     { restore old value of pointer checking }
  95.       SSP := Super( SSP );      { restore supervisor stack... enter user mode }
  96.   END;
  97.  
  98. { **************************************************************************
  99.  
  100.         Now test out the time function...
  101.  
  102.   ************************************************************************** }
  103.  
  104. begin
  105.         start := time;          { get start time }
  106.  
  107.         writeln;
  108.         writeln( '200 hz. system timer - Press any key to exit' );
  109.  
  110.         Cursor( FALSE );        { turn off cursor }
  111.  
  112.         while not Keypress do   { main loop - display timer }
  113.            write( (time / 200.0):10:2, chr(13) );
  114.  
  115.         Cursor( TRUE );         { turn on cursor }
  116.         read( c );              { clean up key buffer }
  117.  
  118.         finish := time;         { get finish time }
  119.  
  120.         writeln;
  121.         write( 'Program was active for ', ( finish-start ) / 200.00 :10:3 );
  122.         writeln( ' seconds.' );
  123.         writeln;
  124.  
  125. end.
  126.  
  127.  
  128.