File : interrupt_handler.adb


----------------------------------------------------------------------------
--
--                              -*- Mode: Ada -*-
--
-- Filename        : interrup_handler.adb
-- Description     : Allows for multiple protected procedures
--                   receiving the same interrupt.
-- Author          : Uwe R. Zimmer
-- Created On      : 08/99
-- Last Modified By: Uwe R. Zimmer
-- Last Modified On: 11/99
-- Update Count    : Version 0.91
-- Status          : Beta
--
----------------------------------------------------------------------------
--
-- Imports
--
----------------------------------------------------------------------------

with Ada.Interrupts;      use Ada.Interrupts;
with System.OS_Interface; use System.OS_Interface;

with Text_IO; use Text_IO;

----------------------------------------------------------------------------

package body Interrupt_Handler is

   ----------------------------------------------------------------------------
   --
   --
   --
   ----------------------------------------------------------------------------

   package Int_Io is new Integer_IO (Integer);
   use Int_Io;
   package LongInt_Io is new Integer_IO (Long_Integer);
   use LongInt_Io;
   package Flo_Io is new Float_IO (Float);
   use Flo_Io;

   ----------------------------------------------------------------------------
   --
   -- Global constants
   --
   ----------------------------------------------------------------------------

   MaxNoOfIntRoutines : constant Positive := 10;

   ----------------------------------------------------------------------------
   --
   -- Global types
   --
   ----------------------------------------------------------------------------

   type IntRoutineArray is
     array (SysInterrupts,
            Positive range 1 .. MaxNoOfIntRoutines)
            of InterruptRoutine;

   type NoOfIntRoutinesArray is array (SysInterrupts) of Natural;

   ----------------------------------------------------------------------------
   --
   -- Global variables
   --
   ----------------------------------------------------------------------------

   IntHandlerInitialized : Boolean := False;
   NoOfClients           : Natural := 0;

   IntRoutines     : IntRoutineArray;
   NoOfIntRoutines : NoOfIntRoutinesArray;

   ----------------------------------------------------------------------------
   --
   -- InterruptReceiver
   --
   ----------------------------------------------------------------------------

   protected InterruptReceiver is

      procedure SIGIO_Handler;
      pragma Attach_Handler (SIGIO_Handler, SIGIO);

      entry BlockTask;

   private

      Released : Boolean := False;

   end InterruptReceiver;

   protected body InterruptReceiver is

      procedure SIGIO_Handler is

      begin
         Released := True;
      end SIGIO_Handler;

      entry BlockTask when Released is
      begin
         Released := False;
      end BlockTask;

   end InterruptReceiver;

   ----------------------------------------------------------------------------
   --
   -- ForwardInterrupts
   --
   ----------------------------------------------------------------------------

   task ForwardInterrupts is

      entry TerminateTask;

   end ForwardInterrupts;

   task body ForwardInterrupts is

      TaskActive   : Boolean                                := True;
      RoutineIndex : Positive range 1 .. MaxNoOfIntRoutines := 1;

   begin
      while TaskActive loop
         select
            accept TerminateTask do
               TaskActive := False;
            end TerminateTask;
         else
            InterruptReceiver.BlockTask;
            for RoutineIndex in 1 .. NoOfIntRoutines (SignalIO) loop
               IntRoutines (SignalIO, RoutineIndex).all;
            end loop;
         end select;
      end loop;

      Put_Line (" -> Interrupt_Handler: ForwardInterrupts terminated");
   end ForwardInterrupts;

   ----------------------------------------------------------------------------
   --
   -- FreeBlocked ForwardInterrupts tasks
   --
   ----------------------------------------------------------------------------

   task FreeAllPendingTasks is

      entry FreeAll;
      entry TerminateTask;

   end FreeAllPendingTasks;

   task body FreeAllPendingTasks is

      TaskActive : Boolean := True;

   begin
      accept FreeAll;

      while TaskActive loop
         select
            accept TerminateTask do
               TaskActive := False;
            end TerminateTask;
         else
            InterruptReceiver.SIGIO_Handler;
            delay (0.1);
         end select;
      end loop;

      Put_Line (" -> Interrupt_Handler: FreeAllPendingTasks terminated");
   end FreeAllPendingTasks;

   ----------------------------------------------------------------------------
   --
   -- InterruptInterface
   --
   ----------------------------------------------------------------------------

   protected body InterruptInterface is

      procedure InitIntHandler is

         IntIndex : SysInterrupts := SysInterrupts'First;

      begin
         if not IntHandlerInitialized then
            for IntIndex in SysInterrupts'First .. SysInterrupts'Last loop
               NoOfIntRoutines (IntIndex) := 0;
            end loop;
         end if;
         IntHandlerInitialized := True;
         NoOfClients           := NoOfClients + 1;
      end InitIntHandler;

      entry ShutdownIntHandler when IntHandlerInitialized is
      begin
         NoOfClients := NoOfClients - 1;
         if NoOfClients = 0 then

            FreeAllPendingTasks.FreeAll;
            ForwardInterrupts.TerminateTask;
            FreeAllPendingTasks.TerminateTask;
            IntHandlerInitialized := False;
         end if;
      end ShutdownIntHandler;

      entry AddIntRoutine
        (Int        : in SysInterrupts;
         NewRoutine : in InterruptRoutine) when IntHandlerInitialized
      is
      begin
         IntRoutines (Int, NoOfIntRoutines (Int) + 1)  := NewRoutine;
         NoOfIntRoutines (Int)                         :=
           NoOfIntRoutines (Int) + 1;
      end AddIntRoutine;

   end InterruptInterface;

end Interrupt_Handler;