Обработка аппаратных прерываний - Free Pascal

{$IFNDEF Debug}
{$D-,S-,L-}
{$ENDIF}
{$B-,R-,V-,X+,N+,E-,A-,T-,F-,Q-,P-}
{.$G+}
program SysTimerSample;
 
uses
  CRT;
 
const
  Time1sec = 18;       { 18.2065086 Гц                    }
  Time10sec = 182;     { 1 сутки = 1 573 040 (18 00 B0 h) }
  Time1min = 1092;
  Time1hour = 65543;
  Time24hour = 1573040;
  IntNum = $1C;
var
  TimerDec: word;
 
var
  OldExitProc: Pointer;
  OldIntProc:  Pointer;
 
var
  Sounds: boolean;    {состояние звучания динамика}
 
  VectInt       : Pointer absolute $0000:(IntNum*4  );
  procedure DisableInterrupts; inline($FA); {cli}
  procedure EnableInterrupts;  inline($FB); {sti}
 
  procedure Speaker;
  begin
    Sounds := not Sounds;
    begin
      if Sounds then
      begin
        Sound(440);
        TimerDec := Time1sec * 1;
      end
      else
      begin
        NoSound;
        TimerDec := Time1sec * 4;
      end;
    end;
  end;
{$F+}
  procedure SystemTimer; interrupt;
  assembler;
  asm
    Dec TimerDec
    test TimerDec, 0ffffH
    jnz @@Skip
    call Speaker
  @@Skip:
    pushf
    call  OldIntProc
  end;
 
  procedure DoneSysTimer; far;
  begin
    DisableInterrupts;
    VectInt := OldIntProc;
    EnableInterrupts;
    ExitProc := OldExitProc;
  end;
 
{$F-}
  procedure InitSysTimer;
  begin
    OldIntProc := VectInt;
    DisableInterrupts;
    VectInt := @SystemTimer;
    EnableInterrupts;
    OldExitProc := ExitProc;
    ExitProc := @DoneSysTimer;
  end;
 
begin
  TimerDec:=2;
  Sounds := false;
  InitSysTimer;
  while not KeyPressed do;
  ReadKey;
  NoSound;
end.