Re: Ada83 and Ada95 interrupt handling

[Robert A Duff <bobduff@world.std.com>]

Armin <ArminSchmidle@swol.de> writes:

> I am porting an Ada83 application to Ada95. In Ada83 there was a
> construction
> known as interrupt entry.
...
> How can I do the same thing in Ada95 ?

I just happened to be working on some examples of interrupt handling for
our (Averstar's) AdaMagic for SHARC implementation, which we validated
last month.

When using a protected procedure as an interrupt handler, there are (at
least) two ways to make the handler notify a task that the interrupt has
occurred.  You can have the task wait on an entry of the same protected
object as the interrupt handler.  Or, you can use suspension objects.

Here's an extract from the documentation I wrote:

...
Example 2.

The second example prints the following:

 Hello from Interrupt_Test_With_Entries main procedure.
 Generating interrupt.
 Waiting_Task: Got interrupt.
 Generating interrupt.
 Waiting_Task: Got interrupt.
 Generating interrupt.
 Waiting_Task: Got interrupt.
 Generating interrupt.
 Waiting_Task: Got interrupt.
 Generating interrupt.
 Waiting_Task: Got interrupt.
 Generating interrupt.
 Waiting_Task: Got interrupt.
 Generating interrupt.
 Waiting_Task: Got interrupt.
 Generating interrupt.
 Waiting_Task: Got interrupt.
 Generating interrupt.
 Waiting_Task: Got interrupt.
 Generating interrupt.
 Goodbye from Interrupt_Test_With_Entries main procedure.
 Waiting_Task: Got interrupt.
 Goodbye from Waiting_Task.

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

-- This example illustrates how an interrupt handler (a protected
-- procedure) may communicate with a task using an entry.  The interrupt
-- handler is called when the interrupt occurs, and it causes the
-- entry's barrier to become True.  The task waits by calling the entry;
-- it is blocked until the barrier becomes True.

-- In this example, we simulate 10 interrupts, and we have a task
-- (Waiting_Task) that waits for 10 interrupts by calling the entry.
-- Each interrupt triggers one call to the entry to proceed.  In this
-- example, the only information being transmitted back to the waiting
-- task is the fact that the interrupt has occurred.

-- In a real program, the protected object might have additional
-- operations to do something to some external device (e.g. initiate
-- some I/O).  This might cause the device to generate an interrupt.
-- The interrupt would not be noticed until after this operation
-- returns, even if the device generates the interrupt right away;
-- that's because of the priority rules.  Also, the interrupt handler
-- might get some information from the device, save it locally in the
-- protected object, and then the entry body might pass this information
-- back to the task via an 'out' parameter.

-- In other words, a protected object used in this way acts as a "device
-- driver", containing operations to initiate I/O operations, to wait
-- for operations to complete, and to handle interrupts.  Anything that
-- needs to be done while masking the interrupt of the device should be
-- part of the protected object.

-- Note that if multiple device drivers are needed for similar devices,
-- it is convenient to declare a protected type, and declare multiple
-- objects of that type.  Discriminants can be used to pass in
-- information specific to individual devices.

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

with Ada.Interrupts.Names; use Ada.Interrupts.Names;
with System.RTS.Temp_IO; use System.RTS.Temp_IO;

package Interrupt_Test_With_Entries is

    -- Empty.

end Interrupt_Test_With_Entries;

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

package Interrupt_Test_With_Entries.Handlers is

    pragma Elaborate_Body;

    protected Handler_PO is

        procedure Handler; -- The interrupt handler.
        pragma Attach_Handler(Handler, SFT0I);
            -- SFT0I is declared in Ada.Interrupts.Names.

        entry Await_Interrupt;
            -- Each time Handler is called,
            -- this entry is triggered.

    private

        Interrupt_Occurred: Boolean := False;

    end Handler_PO;

end Interrupt_Test_With_Entries.Handlers;

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

package body Interrupt_Test_With_Entries.Handlers is

    protected body Handler_PO is

        procedure Handler is
        begin
            Interrupt_Occurred := True;
        end Handler;

        entry Await_Interrupt when Interrupt_Occurred is
        begin
            Interrupt_Occurred := False;
        end Await_Interrupt;

    end Handler_PO;

end Interrupt_Test_With_Entries.Handlers;

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

package Interrupt_Test_With_Entries.Waiting_Tasks is

    pragma Elaborate_Body; -- So the body is allowed.

end Interrupt_Test_With_Entries.Waiting_Tasks;

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

with Interrupt_Test_With_Entries.Handlers; use Interrupt_Test_With_Entries.Handlers;
package body Interrupt_Test_With_Entries.Waiting_Tasks is

    task Waiting_Task;

    task body Waiting_Task is
    begin
        for I in 1..10 loop
            Handler_PO.Await_Interrupt;
            Put_Line("Waiting_Task: Got interrupt.");
        end loop;
        Put_Line("Goodbye from Waiting_Task.");
    end Waiting_Task;

end Interrupt_Test_With_Entries.Waiting_Tasks;

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

with System.Machine_Intrinsics;

with Interrupt_Test_With_Entries.Waiting_Tasks;
    -- There are no references to this package; this with_clause is here
    -- so that task Waiting_Task will be included in the program.

procedure Interrupt_Test_With_Entries.Main is

    procedure Generate_Interrupt(Interrupt : Ada.Interrupts.Interrupt_ID) is
        -- This uses machine code intrinsics to simulate a hardware
        -- interrupt, by generating an interrupt in software.

        use System.Machine_Intrinsics;

        -- This sets the N'th bit in IRPTL, where N is the interrupt number,
        -- which causes the interrupt to happen; see page 3-26 of the
        -- ADSP-2106x SHARC Users' Manual, Second Edition.
        -- We want to use the BIT SET instruction, so it's atomic,
        -- but that instruction requires an immediate value;
        -- we can't calculate 2**N and use that as the mask;
        -- hence the rather repetitive code below.

        procedure Gen_0 is
            pragma Inline(Gen_0);
        begin
            Asm("BIT SET IRPTL 0x00000001;");
        end Gen_0;

        procedure Gen_1 is
            pragma Inline(Gen_1);
        begin
            Asm("BIT SET IRPTL 0x00000002;");
        end Gen_1;

        procedure Gen_2 is
            pragma Inline(Gen_2);
        begin
            Asm("BIT SET IRPTL 0x00000004;");
        end Gen_2;

        procedure Gen_3 is
            pragma Inline(Gen_3);
        begin
            Asm("BIT SET IRPTL 0x00000008;");
        end Gen_3;

        procedure Gen_4 is
            pragma Inline(Gen_4);
        begin
            Asm("BIT SET IRPTL 0x00000010;");
        end Gen_4;

        procedure Gen_5 is
            pragma Inline(Gen_5);
        begin
            Asm("BIT SET IRPTL 0x00000020;");
        end Gen_5;

        procedure Gen_6 is
            pragma Inline(Gen_6);
        begin
            Asm("BIT SET IRPTL 0x00000040;");
        end Gen_6;

        procedure Gen_7 is
            pragma Inline(Gen_7);
        begin
            Asm("BIT SET IRPTL 0x00000080;");
        end Gen_7;

        procedure Gen_8 is
            pragma Inline(Gen_8);
        begin
            Asm("BIT SET IRPTL 0x00000100;");
        end Gen_8;

        procedure Gen_9 is
            pragma Inline(Gen_9);
        begin
            Asm("BIT SET IRPTL 0x00000200;");
        end Gen_9;

        procedure Gen_10 is
            pragma Inline(Gen_10);
        begin
            Asm("BIT SET IRPTL 0x00000400;");
        end Gen_10;

        procedure Gen_11 is
            pragma Inline(Gen_11);
        begin
            Asm("BIT SET IRPTL 0x00000800;");
        end Gen_11;

        procedure Gen_12 is
            pragma Inline(Gen_12);
        begin
            Asm("BIT SET IRPTL 0x00001000;");
        end Gen_12;

        procedure Gen_13 is
            pragma Inline(Gen_13);
        begin
            Asm("BIT SET IRPTL 0x00002000;");
        end Gen_13;

        procedure Gen_14 is
            pragma Inline(Gen_14);
        begin
            Asm("BIT SET IRPTL 0x00004000;");
        end Gen_14;

        procedure Gen_15 is
            pragma Inline(Gen_15);
        begin
            Asm("BIT SET IRPTL 0x00008000;");
        end Gen_15;

        procedure Gen_16 is
            pragma Inline(Gen_16);
        begin
            Asm("BIT SET IRPTL 0x00010000;");
        end Gen_16;

        procedure Gen_17 is
            pragma Inline(Gen_17);
        begin
            Asm("BIT SET IRPTL 0x00020000;");
        end Gen_17;

        procedure Gen_18 is
            pragma Inline(Gen_18);
        begin
            Asm("BIT SET IRPTL 0x00040000;");
        end Gen_18;

        procedure Gen_19 is
            pragma Inline(Gen_19);
        begin
            Asm("BIT SET IRPTL 0x00080000;");
        end Gen_19;

        procedure Gen_20 is
            pragma Inline(Gen_20);
        begin
            Asm("BIT SET IRPTL 0x00100000;");
        end Gen_20;

        procedure Gen_21 is
            pragma Inline(Gen_21);
        begin
            Asm("BIT SET IRPTL 0x00200000;");
        end Gen_21;

        procedure Gen_22 is
            pragma Inline(Gen_22);
        begin
            Asm("BIT SET IRPTL 0x00400000;");
        end Gen_22;

        procedure Gen_23 is
            pragma Inline(Gen_23);
        begin
            Asm("BIT SET IRPTL 0x00800000;");
        end Gen_23;

        procedure Gen_24 is
            pragma Inline(Gen_24);
        begin
            Asm("BIT SET IRPTL 0x01000000;");
        end Gen_24;

        procedure Gen_25 is
            pragma Inline(Gen_25);
        begin
            Asm("BIT SET IRPTL 0x02000000;");
        end Gen_25;

        procedure Gen_26 is
            pragma Inline(Gen_26);
        begin
            Asm("BIT SET IRPTL 0x04000000;");
        end Gen_26;

        procedure Gen_27 is
            pragma Inline(Gen_27);
        begin
            Asm("BIT SET IRPTL 0x08000000;");
        end Gen_27;

        procedure Gen_28 is
            pragma Inline(Gen_28);
        begin
            Asm("BIT SET IRPTL 0x10000000;");
        end Gen_28;

        procedure Gen_29 is
            pragma Inline(Gen_29);
        begin
            Asm("BIT SET IRPTL 0x20000000;");
        end Gen_29;

        procedure Gen_30 is
            pragma Inline(Gen_30);
        begin
            Asm("BIT SET IRPTL 0x40000000;");
        end Gen_30;

        procedure Gen_31 is
            pragma Inline(Gen_31);
        begin
            Asm("BIT SET IRPTL 0x80000000;");
        end Gen_31;

        subtype Handleable_Range is Ada.Interrupts.Interrupt_ID
          range 0..31; -- These are the only interrupts that
                       -- actually exist in the hardware.
    begin
        case Handleable_Range'(Interrupt) is
            when 0 => Gen_0;
            when 1 => Gen_1;
            when 2 => Gen_2;
            when 3 => Gen_3;
            when 4 => Gen_4;
            when 5 => Gen_5;
            when 6 => Gen_6;
            when 7 => Gen_7;
            when 8 => Gen_8;
            when 9 => Gen_9;
            when 10 => Gen_10;
            when 11 => Gen_11;
            when 12 => Gen_12;
            when 13 => Gen_13;
            when 14 => Gen_14;
            when 15 => Gen_15;
            when 16 => Gen_16;
            when 17 => Gen_17;
            when 18 => Gen_18;
            when 19 => Gen_19;
            when 20 => Gen_20;
            when 21 => Gen_21;
            when 22 => Gen_22;
            when 23 => Gen_23;
            when 24 => Gen_24;
            when 25 => Gen_25;
            when 26 => Gen_26;
            when 27 => Gen_27;
            when 28 => Gen_28;
            when 29 => Gen_29;
            when 30 => Gen_30;
            when 31 => Gen_31;
        end case;
    end Generate_Interrupt;

begin

    -- Generate 10 simulated interrupts, with delays in between.

    Put_Line("Hello from Interrupt_Test_With_Entries main procedure.");
    for I in 1..10 loop
        delay 0.01;
        Put_Line("Generating interrupt.");
        Generate_Interrupt(SFT0I);
    end loop;
    Put_Line("Goodbye from Interrupt_Test_With_Entries main procedure.");

end Interrupt_Test_With_Entries.Main;

================================================================
================================================================

Example 3.

The third example prints the following:

 Hello from Suspension_Objects_Test main procedure. 
 Generating interrupt. 
 Waiting_Task: Got interrupt. 
 Generating interrupt. 
 Waiting_Task: Got interrupt. 
 Generating interrupt. 
 Waiting_Task: Got interrupt. 
 Generating interrupt. 
 Waiting_Task: Got interrupt. 
 Goodbye from Waiting_Task. 
 Generating interrupt. 
 Generating interrupt. 
 Generating interrupt. 
 Generating interrupt. 
 Generating interrupt. 
 Generating interrupt. 
 Goodbye from Suspension_Objects_Test main procedure. 

-- This example illustrates how an interrupt handler
-- (a protected procedure) may communicate with a task
-- using a suspension object.  A suspension object allows a
-- task or interrupt handler to notify another task that some
-- event (in our case, an interrupt) has occurred.
-- Each time the interrupt occurs, the suspension object is set to True.
-- The task waits for this event by calling Suspend_Until_True.

-- In this example, we simulate some interrupts,
-- and we have a task (Waiting_Task) that waits for them
-- using a suspension object called Interrupt_Occurred.

-- Note that if the task is already waiting (the usual case) when the
-- interrupt occurs, Interrupt_Occurred is only set to True momentarily;
-- Suspend_Until_True automatically resets it to False.  If the task is
-- not waiting, then the True state will be remembered, and when the
-- task gets around to waiting, it will reset it to False and proceed
-- immediately.

-- Note that only one task can wait on a given suspension object; it's
-- sort of like a protected object with an entry queue of length one,
-- which allows it to be implemented more efficiently.  This means that
-- the programmer using suspension objects has to know which task will
-- do the waiting; it's as if that task has a kind of ownership of that
-- particular suspension object.

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

with Ada.Interrupts.Names; use Ada.Interrupts.Names;
with System.RTS.Temp_IO; use System.RTS.Temp_IO;

package Suspension_Objects_Test is

    -- Empty.

end Suspension_Objects_Test;

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

with Ada.Synchronous_Task_Control; use Ada.Synchronous_Task_Control;
package Suspension_Objects_Test.Handlers is

    pragma Elaborate_Body;

    protected Handler_PO is

        procedure Handler; -- The interrupt handler.
        pragma Attach_Handler(Handler, SFT0I);

    end Handler_PO;

    Interrupt_Occurred: Suspension_Object;
        -- Default-initialized to False.
        -- Set to True for each interrupt.

end Suspension_Objects_Test.Handlers;

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

package body Suspension_Objects_Test.Handlers is

    protected body Handler_PO is

        procedure Handler is
        begin
            Set_True(Interrupt_Occurred);
        end Handler;

    end Handler_PO;

end Suspension_Objects_Test.Handlers;

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

package Suspension_Objects_Test.Waiting_Tasks is

    pragma Elaborate_Body; -- So the body is allowed.

end Suspension_Objects_Test.Waiting_Tasks;

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

with Suspension_Objects_Test.Handlers; use Suspension_Objects_Test.Handlers;
with Ada.Synchronous_Task_Control; use Ada.Synchronous_Task_Control;
package body Suspension_Objects_Test.Waiting_Tasks is

    task Waiting_Task;

    task body Waiting_Task is
    begin
        for I in 1..4 loop
            Suspend_Until_True(Interrupt_Occurred);
            Put_Line("Waiting_Task: Got interrupt.");
        end loop;
        Put_Line("Goodbye from Waiting_Task.");
    end Waiting_Task;

end Suspension_Objects_Test.Waiting_Tasks;

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

with System.Machine_Intrinsics;

with Suspension_Objects_Test.Waiting_Tasks;
    -- There are no references to this package; this with_clause is here
    -- so that task Waiting_Task will be included in the program.

procedure Suspension_Objects_Test.Main is

    procedure Generate_Interrupt(Interrupt : Ada.Interrupts.Interrupt_ID) is
        ... -- as in previous example
    end Generate_Interrupt;

begin

    -- Generate some simulated interrupts, with delays in between.

    Put_Line("Hello from Suspension_Objects_Test main procedure.");
    for I in 1..10 loop
        delay 0.01;
        Put_Line("Generating interrupt.");
        Generate_Interrupt(SFT0I);
    end loop;
    Put_Line("Goodbye from Suspension_Objects_Test main procedure.");

end Suspension_Objects_Test.Main;
-- 
Change robert to bob to get my real email address.  Sorry.