home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #30 / NN_1992_30.iso / spool / comp / lang / pascal / 7504 < prev    next >
Encoding:
Text File  |  1992-12-16  |  2.6 KB  |  114 lines
  1. Newsgroups: comp.lang.pascal
  2. Path: sparky!uunet!munnari.oz.au!newsroom.utas.edu.au!pc_100.psychol.utas.edu.au!peter
  3. From: peter@psychnet.psychol.utas.edu.au (Peter R. Tattam)
  4. Subject: Re: High speed clock
  5. Message-ID: <peter.433.724490084@psychnet.psychol.utas.edu.au>
  6. Keywords: clock
  7. Sender: news@newsroom.utas.edu.au
  8. Organization: Psychology Department, University of Tasmania
  9. References: <1992Nov20.091212.24871@lth.se> <peter.422.723796479@psychnet.psychol.utas.edu.au> <Bz47zL.5sH@news.cso.uiuc.edu> <peter.430.724488284@psychnet.psychol.utas.edu.au>
  10. Date: Wed, 16 Dec 1992 07:14:44 GMT
  11. Lines: 101
  12.  
  13. Well.  Here 'tis.
  14. have fun.
  15. ------------------- cut here ----------------------
  16. { millisecond timer unit }
  17.  
  18. unit msecs;
  19.  
  20. interface
  21.  
  22. var
  23.    timer:word;                     { msec timer }
  24.    idle:procedure; {  you can change this to do something useful when delaying}
  25.  
  26. procedure delay_ticks(t:word);     { resume until t clock ticks have elapsed }
  27. procedure start_clock;             { starts the 1 msec timer }
  28. procedure stop_clock;              { stops the 1 msec timer }
  29.  
  30. implementation
  31.  
  32. uses dos;
  33.  
  34. procedure delay_ticks(t:word);
  35. begin
  36.   inc(t,timer);
  37.   repeat idle until integer(timer - t) >= 0;
  38. end;
  39.  
  40. const clock_active:boolean = false;
  41.       one_msec = 1193;
  42. var   save_clock:pointer;
  43.       clocks:word;
  44.  
  45. procedure tick_int; far; assembler;
  46. asm
  47.   push ax
  48.   push ds
  49.   mov ax,seg @data
  50.   mov ds,ax
  51.   mov al,$20
  52.   out $20,al
  53.   inc [timer]
  54.   add [clocks],one_msec
  55.   jnc @1
  56.   pushf
  57.   call [save_clock]
  58. @1:
  59.   pop ds
  60.   pop ax
  61.   iret
  62. end;
  63.  
  64.  
  65. procedure start_clock;
  66. begin
  67.   if clock_active then exit;
  68.   inc(clock_active);
  69.   timer := 0;
  70.   clocks := 0;
  71.   getintvec($08,save_clock);
  72.   setintvec($08,@tick_int);
  73.   port[$43] := $36;
  74.   port[$40] := lo(one_msec);
  75.   port[$40] := hi(one_msec);
  76. end;
  77.  
  78. procedure stop_clock;
  79. begin
  80.   if not clock_active then exit;
  81.   dec(clock_active);
  82.   port[$43] := $36;
  83.   port[$40] := 0;
  84.   port[$40] := 0;
  85.   setintvec($08,save_clock);
  86. end;
  87.  
  88. procedure nothing; far;
  89. begin
  90. end;
  91.  
  92. var saveexit:pointer;
  93.  
  94. procedure uninstall; far;
  95. begin
  96.   exitproc := saveexit;
  97.   if clock_active then stop_clock;
  98. end;
  99.  
  100. begin
  101.   timer := 0;
  102.   idle := nothing;
  103.   saveexit := exitproc;
  104.   exitproc := @uninstall;
  105. end.
  106.  
  107.  
  108. -------------------- cut here --------------------
  109. ----------------------------------------------------------------------------
  110. P.Tattam                                    International Phone 61-02-202346
  111. Programmer, Psychology Department           Australia     Phone   002-202346
  112. University of Tasmania, Hobart, Tasmania, Australia
  113. ----------------------------------------------------------------------------
  114.