home *** CD-ROM | disk | FTP | other *** search
- { Timers: Timers unit for Turbo Pascal Version 4 1.0a - 09 Nov 87 }
- {=============================================================================
-
- Timers.T4U
-
- Timers unit for Turbo Pascal
- Written by N. Arley Dealey
-
-
- Description: Provides tick (1/18.2 second) and second elapsed timers.
-
- NOTES:
- 1. Seconds resolution is only approximate.
-
- --- Revision History ---------------------------------------------------------
- 09 Nov 87 1.0a --- *** Uploaded to CompuServe BorPro forum DL 2 **********
- 09 Nov 87 1.0a nad Even cruder extension for three timers (two public).
- 08 Nov 87 0.0a nad First version. Extremely primitive. Only one timer.
- {============================================================================}
-
- {--- Conditionals ---------------------------------------------------------}
- { The following conditionals may be set to control compilation as specified }
- { DEFINE Test }{ Enables various trace reports }
- {$DEFINE ExitProc }{ Installs/Removes exitproc }
- {---------------------------------------------------------------------------}
-
- {$B-} { Short circuit boolean evaluation }
- {$I-} { I/O checking OFF }
- {$R-} { Range checking OFF }
- {$S-} { Stack checking OFF }
- {$V-} { Var-str check OFF }
- UNIT Timers ;
-
- INTERFACE
-
- USES
- Dos ;
-
- CONST
- UnitVersion = '1.0a' ;
- UnitVerDate = '09 Nov 87' ;
-
-
- PROCEDURE ResetTimer
- ( WhichTimer : byte ) ;
-
- FUNCTION ElapsedTicks
- ( WhichTimer : byte )
- : word ;
-
- FUNCTION ElapsedSeconds
- ( WhichTimer : byte )
- : word ;
-
- PROCEDURE DelayTicks
- ( HowMany : word ) ;
-
- PROCEDURE DelaySeconds
- ( HowMany : word ) ;
-
- IMPLEMENTATION {============================================================}
-
- VAR
- OrigTimerVec : pointer ;
- TickCounter : ARRAY [0..2] OF word ;
- {$IFDEF ExitProc}
- ExitSave : pointer ;
- {$ENDIF}
-
-
- {---------------------------------------------------------------------------}
- { M A C R O D E F I N I T I O N S }
- {---------------------------------------------------------------------------}
-
- PROCEDURE DisableInterrupts ; inline( $FA {cli} ) ;
- PROCEDURE EnableInterrupts ; inline( $FB {sti} ) ;
-
-
- {---------------------------------------------------------------------------}
- { L O C A L P R O C E D U R E S }
- {---------------------------------------------------------------------------}
-
-
- {---------------------------------------------------------}
- { Timer_ISR: Increments a counter 18.2 times per second }
- {---------------------------------------------------------}
-
- PROCEDURE Timer_ISR ; INTERRUPT ;
-
- BEGIN { Timer_ISR
- { The compiler generates the following prologue }
- { push ax }
- { push bx }
- { push cx }
- { push dx }
- { push si }
- { push di }
- { push ds }
- { push es }
- { push bp }
- { sub sp,sizeof(local_variables) }
- { mov ax,dseg}
- { mov ds,ax }
- DisableInterrupts ;
- inc( TickCounter[0] ) ;
- inc( TickCounter[1] ) ;
- inc( TickCounter[2] ) ;
- { Since we are going to dispatch to any previously installed tick handler }
- { and since it might expect interrupts to be disabled, we'll leave 'em }
- { that way. }
- inline( { now invoke any previously installed timer routine }
- { mov ax,OrigTimerVec+2 ;vector seg } $A1/>OrigTimerVec+2/
- { mov bx,OrigTimerVec ;vector ofs } $8B/$1E/>OrigTimerVec/
- { xchg bx,[bp+14] ;swap ofs/bx } $87/$5E/$0E/
- { xchg ax,[bp+16] ;swap seg/ax } $87/$46/$10/
- { mov sp,bp } $8B/$E5/
- { pop bp } $5D/
- { pop es } $07/
- { pop ds } $1F/
- { pop di } $5F/
- { pop si } $5E/
- { pop dx } $5A/
- { pop cx } $59/
- { retf } $CB
- ) ; { end inline }
- END ; { Timer_ISR }
-
-
- {$F+}
- PROCEDURE TerminateUnit ; {$F-}
-
- BEGIN { TerminateUnit }
- SetIntVec( $1C, OrigTimerVec ) ;
- {$IFDEF ExitProc}
- ExitProc := ExitSave
- {$ENDIF}
- END { TerminateUnit } ;
-
-
- PROCEDURE InitializeUnit ;
-
- BEGIN { InitializeUnit }
- {$IFDEF ExitProc}
- ExitSave := ExitProc ;
- ExitProc := @TerminateUnit ;
- {$ENDIF}
- GetIntVec( $1C, OrigTimerVec ) ;
- SetIntVec( $1C, @Timer_ISR ) ;
- ResetTimer( 0 ) ;
- ResetTimer( 1 ) ;
- ResetTimer( 2 )
- END { InitializeUnit } ;
-
-
- {---------------------------------------------------------------------------}
- { E X P O R T E D P R O C E D U R E S }
- {---------------------------------------------------------------------------}
-
- PROCEDURE ResetTimer
- { WhichTimer : byte } ;
-
- BEGIN { ResetTimer }
- DisableInterrupts ;
- TickCounter[WhichTimer] := 0 ;
- EnableInterrupts
- END { ResetTimer } ;
-
-
- FUNCTION ElapsedTicks
- { WhichTimer : byte )
- : word } ;
-
- BEGIN { ElapsedTicks }
- DisableInterrupts ;
- ElapsedTicks := TickCounter[WhichTimer] ;
- EnableInterrupts
- END { ElapsedTicks } ;
-
-
- FUNCTION ElapsedSeconds
- { WhichTimer : byte )
- : word } ;
-
- BEGIN { ElapsedSeconds }
- ElapsedSeconds := (ElapsedTicks(WhichTimer) DIV 18)
- END { ElapsedSeconds } ;
-
-
- PROCEDURE DelayTicks
- { HowMany : word } ;
-
- BEGIN { DelayTicks }
- ResetTimer( 0 ) ;
- WHILE ElapsedTicks( 0 ) < HowMany DO { nothing }
- END { DelayTicks } ;
-
-
- PROCEDURE DelaySeconds
- { HowMany : word } ;
-
- BEGIN { DelaySeconds }
- ResetTimer( 0 ) ;
- WHILE ElapsedSeconds( 0 ) < HowMany DO { nothing }
- END { DelaySeconds } ;
-
-
- {---------------------------------------------------------------------------}
- { U N I T B O D Y }
- {---------------------------------------------------------------------------}
-
- BEGIN { Timers unit body }
- InitializeUnit
- END { Timers unit body }.
-
-