Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/PCTV3N2.ZIP/TIMEOUTS.PAS

Pascal/Delphi Source File | 1992-03-29 | 6.8 KB | 201 lines

UNIT TimeOuts; { TIMEOUTS.PAS -- Deadman timers for applications }
INTERFACE
USES Dos;
CONST
  TimerIntLvl  = $1C; {------------------ Timer Interrupt level }
  MaxTimeOuts  = 8;   {---------------------- Default "maximum" }

TYPE
  PTimerRec = ^TTimerRec;
  TTimerRec = RECORD  {------------ A TimeOut timer data record }
    TimerAsn : Boolean;                { TRUE if timer assigned }
    TimerAct : Boolean;                  { TRUE if timer active }
    TimedOut : Boolean;               { TRUE if timer timed out }
    TimeBase : LongInt;      { User-specified time-out (counts) }
    TimerCnt : LongInt;               { Current downcount value }
  END;

  PTimerData = ^TTimerData; {---- Default data array for timers }
  TTimerData = ARRAY[1..MaxTimeOuts] OF TTimerRec;

  PTimer = ^TTimer;
  TTimer = OBJECT {-------------------------- The TTimer object }
    Timers    : Integer;         { Number of timers used by app }
    TimerData : PTimerData;       { Pointer to array of records }
    CONSTRUCTOR Init(NTimers : Integer);
    DESTRUCTOR  Done;
    PROCEDURE   GetTimer(VAR TN : Integer);    { TN = Timer no. }
    PROCEDURE   SetTimer(TN : Integer; TSecs : LongInt);
    PROCEDURE   StartTimer(TN : Integer);
    PROCEDURE   StopTimer(TN : Integer);
    PROCEDURE   FreeTimer(TN : Integer);
    FUNCTION    IsTimedOut(TN : Integer): Boolean;
    FUNCTION    TimerActive(TN : Integer): Boolean;
    PROCEDURE   ProcessInt;
  END;

IMPLEMENTATION

VAR
  TimerIntSave : Pointer; {------------ Original INT 1CH vector }
  TheTimer     : PTimer;            { ISR link to TTimer object }

PROCEDURE TimISR(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: Word);
                                                       INTERRUPT;
{----------------------------------------------------------------
 This is the INT 1CH Interrupt Servicing Routine.  Since
 an interrupt processor cannot be an object method, this
 routine does nothing more that invoke the TTImer.ProcessInt
 routine.  It uses the "TheTimer" pointer to address the
 TTimer object.
----------------------------------------------------------------}
VAR I : Integer;
BEGIN
  TheTimer^.ProcessInt;
END;

CONSTRUCTOR TTimer.Init(NTimers : Integer);
{----------------------------------------------------------------
  Instantiates the TTimer object for "NTimers" timers, allocates
  heap space for the data fields, and sets up the interrupt vector.
----------------------------------------------------------------}
VAR I : Integer;

BEGIN
  Timers := NTimers;        { Save the number of timers desired }
  GetMem(TimerData,(Timers * SizeOf(TTimerData)));
  FOR I := 1 TO Timers DO FreeTimer(I); { Initialize the timers }
  TheTimer := @Self;                 { Set up the ISR's pointer }
  GetIntVec(TimerIntLvl, TimerIntSave); { Set up the ISR vector }
  SetIntVec(TimerIntLvl, @TimISR);
END;

DESTRUCTOR TTimer.Done;
{----------------------------------------------------------------
 Disposes of the TTimer instance and resets the timer interrupt.
----------------------------------------------------------------}
BEGIN
  SetIntVec(TimerIntLvl, TimerIntSave); { Restore the ISR vector }
  FreeMem(TimerData,(Timers * SizeOf(TTimerData)));
END;

PROCEDURE TTimer.GetTimer(VAR TN : Integer);
{----------------------------------------------------------------
 Assigns the next free timer (if any) to the caller.  (Returns
 "TN" set to zero if none are available.)
----------------------------------------------------------------}
VAR I : Integer;

BEGIN
  TN := 0;
  FOR I := 1 TO Timers DO BEGIN
    WITH TimerData^[I] DO BEGIN
      IF (NOT TimerAsn) THEN BEGIN
        FreeTimer(I);
        TimerAsn := TRUE;
        TN := I;
        Exit
      END;
    END;
  END;
END;

PROCEDURE TTimer.SetTimer(TN : Integer; TSecs : LongInt);
{----------------------------------------------------------------
 Sets up (but does not start) the assigned timer with the caller-
 specified down-count, in SECONDS.
----------------------------------------------------------------}
BEGIN
  WITH TimerData^[TN] DO BEGIN
    IF (TimerAsn AND (TSecs > 0)) THEN BEGIN
      TimeBase := TSecs * (1193180 DIV 65536);   { TSecs * 18.2 }
      TimerCnt := 0;
    END;
  END;
END;

PROCEDURE TTimer.StartTimer(TN : Integer);
{----------------------------------------------------------------
 Starts the down-count operation for Timer "TN" (if assigned).
----------------------------------------------------------------}
BEGIN
  WITH TimerData^[TN] DO BEGIN
    IF (TimerAsn) THEN BEGIN
      TimedOut := FALSE;
      TimerAct := TRUE;
      TimerCnt := TimeBase;
    END;
  END;
END;

PROCEDURE TTimer.StopTimer(TN : Integer);
{----------------------------------------------------------------
 Stops the down-count operation for Timer "TN" (while running).
----------------------------------------------------------------}
BEGIN
  WITH TimerData^[TN] DO BEGIN
    IF (TimerAsn) THEN BEGIN
      TimerAct := FALSE;
      TimerCnt := 0;
    END;
  END;
END;

PROCEDURE TTimer.FreeTimer(TN : Integer);
{----------------------------------------------------------------
 "Unassigns" Timer "TN" and intializes the data fields.
----------------------------------------------------------------}
BEGIN
  WITH TimerData^[TN] DO BEGIN
    TimerAsn := FALSE;
    TimerAct := FALSE;
    TimedOut := FALSE;
    TimeBase := 0;
    TimerCnt := 0;
  END;
END;

FUNCTION TTimer.IsTimedOut(TN : Integer): Boolean;
{----------------------------------------------------------------
 Returns TRUE if timer "TN" has timed out; then, reset TimedOut.
----------------------------------------------------------------}
BEGIN
  WITH TimerData^[TN] DO BEGIN
    IF (TimerAsn AND TimerAct AND TimedOut) THEN IsTimedOut := TRUE
    ELSE IsTimedOut := FALSE;
    TimedOut := FALSE;
  END;
END;

FUNCTION TTimer.TimerActive(TN : Integer): Boolean;
{----------------------------------------------------------------
 Returns TRUE if timer "TN" is active.
----------------------------------------------------------------}
BEGIN
  WITH TimerData^[TN] DO BEGIN
    IF (TimerAsn AND TimerAct) THEN TimerActive := TRUE
    ELSE TimerActive := FALSE;
  END;
END;

PROCEDURE TTimer.ProcessInt;
{----------------------------------------------------------------
 This logic does the actual processing of the timer interrupt.
 It decrements all active timers that have positive values.
 If the decremented value reaches zero, the timer is set to
 "Timed Out."
----------------------------------------------------------------}
VAR TN : Integer;

BEGIN
  FOR TN := 1 TO Timers DO BEGIN
    WITH TimerData^[TN] DO BEGIN
      IF (TimerAsn AND TimerAct AND (TimerCnt > 0)) THEN BEGIN
        Dec(TimerCnt);
        IF (TimerCnt = 0) THEN TimedOut := TRUE;
      END;
    END;
  END;
END;
END.