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 Ada.Task_Identification;           use Ada.Task_Identification;
with Ada.Exceptions;                    use Ada.Exceptions;

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;

   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");

   exception
      when E: others =>
         Put_Line (Current_Error,
                   "Task "
                   & Image (Current_Task)
                   & " reports: "
                   & Exception_Name (E)
                   & " in: "
                   & Exception_Message (E));

   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");

   exception
      when E: others =>
         Put_Line (Current_Error,
                   "Task "
                   & Image (Current_Task)
                   & " reports: "
                   & Exception_Name (E)
                   & " in: "
                   & Exception_Message (E));

   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;