home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / turbopas / async4.arc / TIMERS.PAS < prev    next >
Pascal/Delphi Source File  |  1987-11-11  |  6KB  |  215 lines
  1. { Timers: Timers unit for Turbo Pascal Version 4            1.0a - 09 Nov 87 }
  2. {=============================================================================
  3.  
  4.                                   Timers.T4U
  5.  
  6.                          Timers unit for Turbo Pascal
  7.                           Written by N. Arley Dealey
  8.  
  9.  
  10. Description: Provides tick (1/18.2 second) and second elapsed timers.
  11.  
  12. NOTES:
  13.   1. Seconds resolution is only approximate.
  14.  
  15. --- Revision History ---------------------------------------------------------
  16. 09 Nov 87  1.0a  ---  *** Uploaded to CompuServe BorPro forum DL 2 **********
  17. 09 Nov 87  1.0a  nad  Even cruder extension for three timers (two public).
  18. 08 Nov 87  0.0a  nad  First version.  Extremely primitive.  Only one timer.
  19. {============================================================================}
  20.  
  21. {---  Conditionals ---------------------------------------------------------}
  22. { The following conditionals may be set to control compilation as specified }
  23. { DEFINE Test           }{ Enables various trace reports                    }
  24. {$DEFINE ExitProc       }{ Installs/Removes exitproc                        }
  25. {---------------------------------------------------------------------------}
  26.  
  27. {$B-} { Short circuit boolean evaluation }
  28. {$I-} { I/O checking    OFF   }
  29. {$R-} { Range checking  OFF   }
  30. {$S-} { Stack checking  OFF   }
  31. {$V-} { Var-str check   OFF   }
  32. UNIT Timers ;
  33.  
  34. INTERFACE
  35.  
  36. USES
  37.   Dos ;
  38.  
  39. CONST
  40.   UnitVersion   = '1.0a' ;
  41.   UnitVerDate   = '09 Nov 87' ;
  42.  
  43.  
  44. PROCEDURE ResetTimer
  45.   (     WhichTimer : byte ) ;
  46.  
  47. FUNCTION ElapsedTicks
  48.   (     WhichTimer : byte )
  49.   : word ;
  50.  
  51. FUNCTION ElapsedSeconds
  52.   (     WhichTimer : byte )
  53.   : word ;
  54.  
  55. PROCEDURE DelayTicks
  56.   (     HowMany : word ) ;
  57.  
  58. PROCEDURE DelaySeconds
  59.   (     HowMany : word ) ;
  60.  
  61. IMPLEMENTATION {============================================================}
  62.  
  63. VAR
  64.   OrigTimerVec : pointer ;
  65.   TickCounter  : ARRAY [0..2] OF word ;
  66.   {$IFDEF ExitProc}
  67.     ExitSave     : pointer ;
  68.     {$ENDIF}
  69.  
  70.  
  71. {---------------------------------------------------------------------------}
  72. {                    M A C R O     D E F I N I T I O N S                    }
  73. {---------------------------------------------------------------------------}
  74.  
  75. PROCEDURE DisableInterrupts ;   inline( $FA {cli} ) ;
  76. PROCEDURE EnableInterrupts ;    inline( $FB {sti} ) ;
  77.  
  78.  
  79. {---------------------------------------------------------------------------}
  80. {                     L O C A L     P R O C E D U R E S                     }
  81. {---------------------------------------------------------------------------}
  82.  
  83.  
  84. {---------------------------------------------------------} 
  85. {  Timer_ISR: Increments a counter 18.2 times per second  } 
  86. {---------------------------------------------------------}
  87.  
  88. PROCEDURE Timer_ISR ; INTERRUPT ;
  89.  
  90. BEGIN { Timer_ISR
  91.   { The compiler generates the following prologue }
  92.   { push ax     }
  93.   { push bx     }
  94.   { push cx     }
  95.   { push dx     }
  96.   { push si     }
  97.   { push di     }
  98.   { push ds     }
  99.   { push es     }
  100.   { push bp     }
  101.   { sub  sp,sizeof(local_variables) }
  102.   { mov  ax,dseg}
  103.   { mov  ds,ax  }
  104.   DisableInterrupts ;
  105.   inc( TickCounter[0] ) ;
  106.   inc( TickCounter[1] ) ;
  107.   inc( TickCounter[2] ) ;
  108.   { Since we are going to dispatch to any previously installed tick handler }
  109.   { and since it might expect interrupts to be disabled, we'll leave 'em    }
  110.   { that way.                                                               }
  111.   inline( { now invoke any previously installed timer routine }
  112.   { mov  ax,OrigTimerVec+2  ;vector seg  }  $A1/>OrigTimerVec+2/
  113.   { mov  bx,OrigTimerVec    ;vector ofs  }  $8B/$1E/>OrigTimerVec/
  114.   { xchg bx,[bp+14]         ;swap ofs/bx }  $87/$5E/$0E/
  115.   { xchg ax,[bp+16]         ;swap seg/ax }  $87/$46/$10/
  116.   { mov  sp,bp                           }  $8B/$E5/
  117.   { pop  bp                              }  $5D/
  118.   { pop  es                              }  $07/
  119.   { pop  ds                              }  $1F/
  120.   { pop  di                              }  $5F/
  121.   { pop  si                              }  $5E/
  122.   { pop  dx                              }  $5A/
  123.   { pop  cx                              }  $59/
  124.   { retf                                 }  $CB
  125.   ) ; { end inline }
  126.   END ; { Timer_ISR }
  127.  
  128.  
  129. {$F+}
  130. PROCEDURE TerminateUnit ; {$F-}
  131.  
  132. BEGIN { TerminateUnit }
  133.   SetIntVec( $1C, OrigTimerVec ) ;
  134.   {$IFDEF ExitProc}
  135.     ExitProc := ExitSave
  136.     {$ENDIF}
  137.   END { TerminateUnit } ;
  138.  
  139.  
  140. PROCEDURE InitializeUnit ;
  141.  
  142. BEGIN { InitializeUnit }
  143.   {$IFDEF ExitProc}
  144.     ExitSave := ExitProc ;
  145.     ExitProc := @TerminateUnit ;
  146.     {$ENDIF}
  147.   GetIntVec( $1C, OrigTimerVec ) ;
  148.   SetIntVec( $1C, @Timer_ISR ) ;
  149.   ResetTimer( 0 ) ;
  150.   ResetTimer( 1 ) ;
  151.   ResetTimer( 2 )
  152.   END { InitializeUnit } ;
  153.  
  154.  
  155. {---------------------------------------------------------------------------}
  156. {                  E X P O R T E D     P R O C E D U R E S                  }
  157. {---------------------------------------------------------------------------}
  158.  
  159. PROCEDURE ResetTimer
  160.   {     WhichTimer : byte } ;
  161.  
  162. BEGIN { ResetTimer }
  163.   DisableInterrupts ;
  164.   TickCounter[WhichTimer] := 0 ;
  165.   EnableInterrupts
  166.   END { ResetTimer } ;
  167.  
  168.  
  169. FUNCTION ElapsedTicks
  170.   {     WhichTimer : byte )
  171.   : word } ;
  172.  
  173. BEGIN { ElapsedTicks }
  174.   DisableInterrupts ;
  175.   ElapsedTicks := TickCounter[WhichTimer] ;
  176.   EnableInterrupts
  177.   END { ElapsedTicks } ;
  178.  
  179.  
  180. FUNCTION ElapsedSeconds
  181.   {     WhichTimer : byte )
  182.   : word } ;
  183.  
  184. BEGIN { ElapsedSeconds }
  185.   ElapsedSeconds := (ElapsedTicks(WhichTimer) DIV 18)
  186.   END { ElapsedSeconds } ;
  187.  
  188.  
  189. PROCEDURE DelayTicks
  190.   {     HowMany : word } ;
  191.  
  192. BEGIN { DelayTicks }
  193.   ResetTimer( 0 ) ;
  194.   WHILE ElapsedTicks( 0 ) < HowMany DO { nothing }
  195.   END { DelayTicks } ;
  196.  
  197.  
  198. PROCEDURE DelaySeconds
  199.   {     HowMany : word } ;
  200.  
  201. BEGIN { DelaySeconds }
  202.   ResetTimer( 0 ) ;
  203.   WHILE ElapsedSeconds( 0 ) < HowMany DO { nothing }
  204.   END { DelaySeconds } ;
  205.  
  206.  
  207. {---------------------------------------------------------------------------}
  208. {                            U N I T     B O D Y                            }
  209. {---------------------------------------------------------------------------}
  210.                                                 
  211. BEGIN { Timers unit body }
  212.   InitializeUnit
  213.   END { Timers unit body }.
  214.  
  215.