File : s-interr-pikeos4.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
4 -- --
5 -- S Y S T E M . I N T E R R U P T S --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2016, AdaCore --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
17 -- --
18 -- --
19 -- --
20 -- --
21 -- --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
26 -- --
27 -- GNARL was developed by the GNARL team at Florida State University. --
28 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
29 -- --
30 ------------------------------------------------------------------------------
31
32 -- This is a version of this package for PikeOS
33
34 pragma Restrictions (No_Elaboration_Code);
35
36 with System.Tasking;
37 with System.Task_Primitives.Operations;
38 with System.Task_Info;
39 with System.Storage_Elements; use System.Storage_Elements;
40 with System.Tasking.Restricted.Stages;
41 with System.OS_Interface; use System.OS_Interface;
42 with System.Multiprocessors;
43
44 package body System.Interrupts is
45
46 ----------------
47 -- Local Data --
48 ----------------
49
50 Nbr_Interrupts : constant Natural;
51 pragma Import (C, Nbr_Interrupts, "__gnat_nbr_interrupts");
52 -- Number of interrupts attached. Set before elaboration in
53 -- pikeos-cert-app.c
54
55 Interrupt_Stack_Size : constant := 8 * 1024;
56 -- Stack size for an interrupt thread
57
58 type Handler_Entry is record
59 User_Handler : Parameterless_Handler;
60 -- The user protected subprogram to be called when an interrupt is
61 -- triggered.
62
63 Priority : Interrupt_Priority;
64 -- Priority of the protected object
65
66 Id : P4_intid_t;
67 -- This handler is for interrupt ID
68
69 ATCB : aliased System.Tasking.Ada_Task_Control_Block (0);
70 -- As one task is created per interrupt handler, an ATCB is needed for
71 -- the task.
72
73 Stack : Storage_Array (1 .. Interrupt_Stack_Size);
74 -- As well as a stack
75 end record;
76 pragma Suppress_Initialization (Handler_Entry);
77
78 type Handlers_Table is array (Interrupt_ID) of Handler_Entry;
79 pragma Suppress_Initialization (Handlers_Table);
80 -- Type used to represent the procedures used as interrupt handlers. No
81 -- need to create an initializer, as the only object declared with this
82 -- type is just below and has an expression to initialize it.
83
84 Interrupt_Handlers : Handlers_Table;
85 -- Table containing user handlers.
86
87 Initialized_Interrupts : array (Interrupt_ID) of Boolean :=
88 (others => False);
89 -- Set to true when an entry of Interrupt_Handlers has been set. Avoid to
90 -- Initialize Interrupt_Handlers array, which is pretty large due to the
91 -- stacks.
92
93 Interrupts_Map : array (Interrupt_ID) of P4_intid_t;
94 pragma Import (C, Interrupts_Map, "__gnat_interrupts_map");
95
96 -----------------------
97 -- Local Subprograms --
98 -----------------------
99
100 procedure Install_Handler (Interrupt : Interrupt_ID);
101 -- Install the runtime umbrella handler for a hardware interrupt
102
103 procedure Interrupt_Task (Arg : Address);
104
105 procedure Interrupt_Task (Arg : Address)
106 is
107 Handler : Handler_Entry;
108 pragma Import (Ada, Handler);
109 for Handler'Address use Arg;
110
111 Res : P4_e_t;
112 begin
113
114 -- Attach interrupt
115
116 Res := p4_int_attach (Handler.Id);
117 if Res /= P4_E_OK then
118 raise Program_Error;
119 end if;
120
121 OS_Interface.Set_Interrupt (Handler.Id);
122
123 loop
124 -- Wait for interrupt
125
126 Res := p4_int_wait (P4_TIMEOUT_INFINITE, 0);
127 pragma Assert (Res = P4_E_OK);
128
129 pragma Assert (Handler.User_Handler /= null);
130
131 -- Call handler
132
133 -- As exception propagated from a handler that is invoked by an
134 -- interrupt must have no effect (ARM C.3 par. 7), interrupt handlers
135 -- are wrapped by a null exception handler to avoid exceptions to be
136 -- propagated further.
137
138 -- The ravenscar-sfp profile has a No_Exception_Propagation
139 -- restriction. Discard compiler warning on the handler.
140
141 pragma Warnings (Off);
142
143 begin
144 Handler.User_Handler.all;
145
146 exception
147
148 -- Avoid any further exception propagation
149
150 when others =>
151 null;
152 end;
153
154 pragma Warnings (On);
155 end loop;
156 end Interrupt_Task;
157
158 -- Depending on whether exception propagation is supported or not, the
159 -- implementation will differ; exceptions can never be propagated through
160 -- this procedure (see ARM C.3 par. 7).
161
162 ---------------------
163 -- Install_Handler --
164 ---------------------
165
166 procedure Install_Handler (Interrupt : Interrupt_ID)
167 is
168 Handler : Handler_Entry renames Interrupt_Handlers (Interrupt);
169 Id : Tasking.Task_Id;
170 Chain : Tasking.Activation_Chain;
171 begin
172 -- Attach the default handler to the specified interrupt. This handler
173 -- will in turn call the user handler.
174
175 -- Create a task for the interrupt handler
176
177 Id := Handler.ATCB'Access;
178 System.Tasking.Restricted.Stages.Create_Restricted_Task
179 (Priority => Handler.Priority,
180 Stack_Address => Handler.Stack'Address,
181 Size => Interrupt_Stack_Size,
182 Task_Info => System.Task_Info.Unspecified_Task_Info,
183 CPU => Integer (System.Multiprocessors.Not_A_Specific_CPU),
184 State => Interrupt_Task'Access,
185 Discriminants => Handler'Address,
186 Elaborated => null,
187 Chain => Chain,
188 Task_Image => "",
189 Created_Task => Id);
190
191 -- And activate it.
192
193 System.Tasking.Restricted.Stages.Activate_Restricted_Tasks
194 (Chain'Unrestricted_Access);
195 end Install_Handler;
196
197 ---------------------------------
198 -- Install_Restricted_Handlers --
199 ---------------------------------
200
201 procedure Install_Restricted_Handlers
202 (Prio : Any_Priority;
203 Handlers : Handler_Array)
204 is
205 use System.Tasking.Restricted.Stages;
206
207 begin
208 for H of Handlers loop
209
210 if Natural (H.Interrupt) > Nbr_Interrupts
211 or else Initialized_Interrupts (H.Interrupt)
212 then
213 -- Interrupt already attached. This is not supported.
214
215 raise Program_Error;
216 else
217 -- Mark the interrupt as attached
218
219 Initialized_Interrupts (H.Interrupt) := True;
220
221 -- Copy the handler in the table that contains the user handlers
222
223 Interrupt_Handlers (H.Interrupt).User_Handler := H.Handler;
224 Interrupt_Handlers (H.Interrupt).Priority := Prio;
225 Interrupt_Handlers (H.Interrupt).Id :=
226 Interrupts_Map (H.Interrupt);
227
228 -- Install the handler now, unless attachment is deferred because
229 -- of sequential partition elaboration policy.
230
231 if Partition_Elaboration_Policy /= 'S' then
232 Install_Handler (H.Interrupt);
233 end if;
234 end if;
235 end loop;
236 end Install_Restricted_Handlers;
237
238 --------------------------------------------
239 -- Install_Restricted_Handlers_Sequential --
240 --------------------------------------------
241
242 procedure Install_Restricted_Handlers_Sequential is
243 begin
244 for J in Interrupt_ID loop
245 if Initialized_Interrupts (J) then
246 Install_Handler (J);
247 end if;
248 end loop;
249 end Install_Restricted_Handlers_Sequential;
250
251 end System.Interrupts;