blob: 2097ba84f9d897f04558bdd026e8d73134fe7441 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
-- This is an example of how to attach and handle interrupts in Ada 95.
-- Interrupt handling is done as follows:
--
-- 1. A protected procedure is attached to the interrupt
-- 2. When activated, the procedure enables a conditional entry
-- 3. A task waiting on the entry will carry out the work.
--
-- In this way, we spend minimum amount of time in the protected
-- procedure. Many other schemes are of course possible...
--
-- Written by Tullio Vardanega and Jiri Gaisler
-- European Space Agency, 1999.
--
with Ada.Interrupts;
with System;
with Ada.Text_IO;
package body Interrupt_pkg is
type T_SEM is (HIGH, LOW);
Protected_Priority : constant System.Interrupt_Priority :=
System.Interrupt_Priority'First;
-- Protected object, including interrupt handler (Signal) and conditional entry.
protected Handler is
procedure Signal;
entry Wait;
pragma Attach_Handler (Signal, 17); -- Signal 17 equals irq 1 on ERC32
pragma Priority (Protected_Priority);
private
BARRIER : T_SEM := HIGH;
end Handler;
protected body Handler is
procedure Signal is
begin
BARRIER := LOW;
end Signal;
entry Wait when (BARRIER = LOW) is
begin
BARRIER := HIGH;
end Wait;
end Handler;
-- Sporadic task, waiting on entry (Wait) for the interrupt.
task sporadic is
pragma Priority (8);
end sporadic;
task body sporadic is
Message : constant STRING :=
"sporadic activated";
begin
loop
Handler.Wait;
Ada.Text_IO.Put_line (Message);
end loop;
end sporadic;
-- Test program, generating interrupt 1 on ERC32
procedure itest is
procedure irqforce(irq : integer);
pragma Import (C, irqforce, "irqforce");
begin
for i in 1..10 loop
irqforce(1);
delay(0.05);
end loop;
-- Have to kill sporadic to exit since it is has an infinite loop
abort sporadic;
end;
begin
itest;
end Interrupt_pkg;
|
