|
111
|
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 -- --
|
|
145
|
9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
11 -- GNARL 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 -- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
|
19 -- additional permissions described in the GCC Runtime Library Exception, --
|
|
|
20 -- version 3.1, as published by the Free Software Foundation. --
|
|
|
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 -- Invariants:
|
|
|
33
|
|
|
34 -- All user-handlable signals are masked at all times in all tasks/threads
|
|
|
35 -- except possibly for the Interrupt_Manager task.
|
|
|
36
|
|
|
37 -- When a user task wants to have the effect of masking/unmasking an signal,
|
|
|
38 -- it must call Block_Interrupt/Unblock_Interrupt, which will have the effect
|
|
|
39 -- of unmasking/masking the signal in the Interrupt_Manager task. These
|
|
|
40 -- comments do not apply to vectored hardware interrupts, which may be masked
|
|
|
41 -- or unmasked using routined interfaced to the relevant embedded RTOS system
|
|
|
42 -- calls.
|
|
|
43
|
|
|
44 -- Once we associate a Signal_Server_Task with an signal, the task never goes
|
|
|
45 -- away, and we never remove the association. On the other hand, it is more
|
|
|
46 -- convenient to terminate an associated Interrupt_Server_Task for a vectored
|
|
|
47 -- hardware interrupt (since we use a binary semaphore for synchronization
|
|
|
48 -- with the umbrella handler).
|
|
|
49
|
|
|
50 -- There is no more than one signal per Signal_Server_Task and no more than
|
|
|
51 -- one Signal_Server_Task per signal. The same relation holds for hardware
|
|
|
52 -- interrupts and Interrupt_Server_Task's at any given time. That is, only
|
|
|
53 -- one non-terminated Interrupt_Server_Task exists for a give interrupt at
|
|
|
54 -- any time.
|
|
|
55
|
|
|
56 -- Within this package, the lock L is used to protect the various status
|
|
|
57 -- tables. If there is a Server_Task associated with a signal or interrupt,
|
|
|
58 -- we use the per-task lock of the Server_Task instead so that we protect the
|
|
|
59 -- status between Interrupt_Manager and Server_Task. Protection among service
|
|
|
60 -- requests are ensured via user calls to the Interrupt_Manager entries.
|
|
|
61
|
|
|
62 -- This is reasonably generic version of this package, supporting vectored
|
|
|
63 -- hardware interrupts using non-RTOS specific adapter routines which should
|
|
|
64 -- easily implemented on any RTOS capable of supporting GNAT.
|
|
|
65
|
|
|
66 with Ada.Unchecked_Conversion;
|
|
|
67 with Ada.Task_Identification;
|
|
|
68
|
|
|
69 with Interfaces.C; use Interfaces.C;
|
|
|
70 with System.OS_Interface; use System.OS_Interface;
|
|
|
71 with System.Interrupt_Management;
|
|
|
72 with System.Task_Primitives.Operations;
|
|
|
73 with System.Storage_Elements;
|
|
|
74 with System.Tasking.Utilities;
|
|
|
75
|
|
|
76 with System.Tasking.Rendezvous;
|
|
|
77 pragma Elaborate_All (System.Tasking.Rendezvous);
|
|
|
78
|
|
|
79 package body System.Interrupts is
|
|
|
80
|
|
|
81 use Tasking;
|
|
|
82
|
|
|
83 package POP renames System.Task_Primitives.Operations;
|
|
|
84
|
|
|
85 function To_Ada is new Ada.Unchecked_Conversion
|
|
|
86 (System.Tasking.Task_Id, Ada.Task_Identification.Task_Id);
|
|
|
87
|
|
|
88 function To_System is new Ada.Unchecked_Conversion
|
|
|
89 (Ada.Task_Identification.Task_Id, Task_Id);
|
|
|
90
|
|
|
91 -----------------
|
|
|
92 -- Local Tasks --
|
|
|
93 -----------------
|
|
|
94
|
|
|
95 -- WARNING: System.Tasking.Stages performs calls to this task with low-
|
|
|
96 -- level constructs. Do not change this spec without synchronizing it.
|
|
|
97
|
|
|
98 task Interrupt_Manager is
|
|
|
99 entry Detach_Interrupt_Entries (T : Task_Id);
|
|
|
100
|
|
|
101 entry Attach_Handler
|
|
|
102 (New_Handler : Parameterless_Handler;
|
|
|
103 Interrupt : Interrupt_ID;
|
|
|
104 Static : Boolean;
|
|
|
105 Restoration : Boolean := False);
|
|
|
106
|
|
|
107 entry Exchange_Handler
|
|
|
108 (Old_Handler : out Parameterless_Handler;
|
|
|
109 New_Handler : Parameterless_Handler;
|
|
|
110 Interrupt : Interrupt_ID;
|
|
|
111 Static : Boolean);
|
|
|
112
|
|
|
113 entry Detach_Handler
|
|
|
114 (Interrupt : Interrupt_ID;
|
|
|
115 Static : Boolean);
|
|
|
116
|
|
|
117 entry Bind_Interrupt_To_Entry
|
|
|
118 (T : Task_Id;
|
|
|
119 E : Task_Entry_Index;
|
|
|
120 Interrupt : Interrupt_ID);
|
|
|
121
|
|
|
122 pragma Interrupt_Priority (System.Interrupt_Priority'First);
|
|
|
123 end Interrupt_Manager;
|
|
|
124
|
|
|
125 task type Interrupt_Server_Task
|
|
|
126 (Interrupt : Interrupt_ID;
|
|
|
127 Int_Sema : Binary_Semaphore_Id)
|
|
|
128 is
|
|
|
129 -- Server task for vectored hardware interrupt handling
|
|
|
130
|
|
|
131 pragma Interrupt_Priority (System.Interrupt_Priority'First + 2);
|
|
|
132 end Interrupt_Server_Task;
|
|
|
133
|
|
|
134 type Interrupt_Task_Access is access Interrupt_Server_Task;
|
|
|
135
|
|
|
136 -------------------------------
|
|
|
137 -- Local Types and Variables --
|
|
|
138 -------------------------------
|
|
|
139
|
|
|
140 type Entry_Assoc is record
|
|
|
141 T : Task_Id;
|
|
|
142 E : Task_Entry_Index;
|
|
|
143 end record;
|
|
|
144
|
|
|
145 type Handler_Assoc is record
|
|
|
146 H : Parameterless_Handler;
|
|
|
147 Static : Boolean; -- Indicates static binding;
|
|
|
148 end record;
|
|
|
149
|
|
|
150 User_Handler : array (Interrupt_ID) of Handler_Assoc :=
|
|
|
151 (others => (null, Static => False));
|
|
|
152 pragma Volatile_Components (User_Handler);
|
|
|
153 -- Holds the protected procedure handler (if any) and its Static
|
|
|
154 -- information for each interrupt or signal. A handler is static iff it
|
|
|
155 -- is specified through the pragma Attach_Handler.
|
|
|
156
|
|
|
157 User_Entry : array (Interrupt_ID) of Entry_Assoc :=
|
|
|
158 (others => (T => Null_Task, E => Null_Task_Entry));
|
|
|
159 pragma Volatile_Components (User_Entry);
|
|
|
160 -- Holds the task and entry index (if any) for each interrupt / signal
|
|
|
161
|
|
|
162 -- Type and Head, Tail of the list containing Registered Interrupt
|
|
|
163 -- Handlers. These definitions are used to register the handlers
|
|
|
164 -- specified by the pragma Interrupt_Handler.
|
|
|
165
|
|
|
166 type Registered_Handler;
|
|
|
167 type R_Link is access all Registered_Handler;
|
|
|
168
|
|
|
169 type Registered_Handler is record
|
|
|
170 H : System.Address := System.Null_Address;
|
|
|
171 Next : R_Link := null;
|
|
|
172 end record;
|
|
|
173
|
|
|
174 Registered_Handler_Head : R_Link := null;
|
|
|
175 Registered_Handler_Tail : R_Link := null;
|
|
|
176
|
|
|
177 Server_ID : array (Interrupt_ID) of System.Tasking.Task_Id :=
|
|
|
178 (others => System.Tasking.Null_Task);
|
|
|
179 pragma Atomic_Components (Server_ID);
|
|
|
180 -- Holds the Task_Id of the Server_Task for each interrupt / signal.
|
|
|
181 -- Task_Id is needed to accomplish locking per interrupt base. Also
|
|
|
182 -- is needed to determine whether to create a new Server_Task.
|
|
|
183
|
|
|
184 Semaphore_ID_Map : array
|
|
|
185 (Interrupt_ID range 0 .. System.OS_Interface.Max_HW_Interrupt) of
|
|
|
186 Binary_Semaphore_Id := (others => 0);
|
|
|
187 -- Array of binary semaphores associated with vectored interrupts. Note
|
|
|
188 -- that the last bound should be Max_HW_Interrupt, but this will raise
|
|
|
189 -- Storage_Error if Num_HW_Interrupts is null so use extra 4 bytes instead.
|
|
|
190
|
|
|
191 Interrupt_Access_Hold : Interrupt_Task_Access;
|
|
|
192 -- Variable for allocating an Interrupt_Server_Task
|
|
|
193
|
|
|
194 Handler_Installed : array (HW_Interrupt) of Boolean := (others => False);
|
|
|
195 -- True if Notify_Interrupt was connected to the interrupt. Handlers can
|
|
|
196 -- be connected but disconnection is not possible on VxWorks. Therefore
|
|
|
197 -- we ensure Notify_Installed is connected at most once.
|
|
|
198
|
|
|
199 type Interrupt_Connector is access function
|
|
|
200 (Vector : Interrupt_Vector;
|
|
|
201 Handler : Interrupt_Handler;
|
|
|
202 Parameter : System.Address := System.Null_Address) return int;
|
|
|
203 -- Profile must match VxWorks intConnect()
|
|
|
204
|
|
|
205 Interrupt_Connect : Interrupt_Connector :=
|
|
|
206 System.OS_Interface.Interrupt_Connect'Access;
|
|
|
207 pragma Export (C, Interrupt_Connect, "__gnat_user_int_connect");
|
|
|
208 -- Allow user alternatives to the OS implementation of
|
|
|
209 -- System.OS_Interface.Interrupt_Connect. This allows the user to
|
|
|
210 -- associate a handler with an interrupt source when an alternate routine
|
|
|
211 -- is needed to do so. The association is performed in
|
|
|
212 -- Interfaces.VxWorks.Interrupt_Connections. Defaults to the standard OS
|
|
|
213 -- connection routine.
|
|
|
214
|
|
|
215 -----------------------
|
|
|
216 -- Local Subprograms --
|
|
|
217 -----------------------
|
|
|
218
|
|
|
219 procedure Check_Reserved_Interrupt (Interrupt : Interrupt_ID);
|
|
|
220 -- Check if Id is a reserved interrupt, and if so raise Program_Error
|
|
|
221 -- with an appropriate message, otherwise return.
|
|
|
222
|
|
|
223 procedure Finalize_Interrupt_Servers;
|
|
|
224 -- Unbind the handlers for hardware interrupt server tasks at program
|
|
|
225 -- termination.
|
|
|
226
|
|
|
227 function Is_Registered (Handler : Parameterless_Handler) return Boolean;
|
|
|
228 -- See if Handler has been "pragma"ed using Interrupt_Handler.
|
|
|
229 -- Always consider a null handler as registered.
|
|
|
230
|
|
|
231 procedure Notify_Interrupt (Param : System.Address);
|
|
|
232 pragma Convention (C, Notify_Interrupt);
|
|
|
233 -- Umbrella handler for vectored interrupts (not signals)
|
|
|
234
|
|
|
235 procedure Install_Umbrella_Handler
|
|
|
236 (Interrupt : HW_Interrupt;
|
|
|
237 Handler : System.OS_Interface.Interrupt_Handler);
|
|
|
238 -- Install the runtime umbrella handler for a vectored hardware
|
|
|
239 -- interrupt
|
|
|
240
|
|
|
241 procedure Unimplemented (Feature : String);
|
|
|
242 pragma No_Return (Unimplemented);
|
|
|
243 -- Used to mark a call to an unimplemented function. Raises Program_Error
|
|
|
244 -- with an appropriate message noting that Feature is unimplemented.
|
|
|
245
|
|
|
246 --------------------
|
|
|
247 -- Attach_Handler --
|
|
|
248 --------------------
|
|
|
249
|
|
|
250 -- Calling this procedure with New_Handler = null and Static = True
|
|
|
251 -- means we want to detach the current handler regardless of the previous
|
|
|
252 -- handler's binding status (i.e. do not care if it is a dynamic or static
|
|
|
253 -- handler).
|
|
|
254
|
|
|
255 -- This option is needed so that during the finalization of a PO, we can
|
|
|
256 -- detach handlers attached through pragma Attach_Handler.
|
|
|
257
|
|
|
258 procedure Attach_Handler
|
|
|
259 (New_Handler : Parameterless_Handler;
|
|
|
260 Interrupt : Interrupt_ID;
|
|
|
261 Static : Boolean := False) is
|
|
|
262 begin
|
|
|
263 Check_Reserved_Interrupt (Interrupt);
|
|
|
264 Interrupt_Manager.Attach_Handler (New_Handler, Interrupt, Static);
|
|
|
265 end Attach_Handler;
|
|
|
266
|
|
|
267 -----------------------------
|
|
|
268 -- Bind_Interrupt_To_Entry --
|
|
|
269 -----------------------------
|
|
|
270
|
|
|
271 -- This procedure raises a Program_Error if it tries to
|
|
|
272 -- bind an interrupt to which an Entry or a Procedure is
|
|
|
273 -- already bound.
|
|
|
274
|
|
|
275 procedure Bind_Interrupt_To_Entry
|
|
|
276 (T : Task_Id;
|
|
|
277 E : Task_Entry_Index;
|
|
|
278 Int_Ref : System.Address)
|
|
|
279 is
|
|
|
280 Interrupt : constant Interrupt_ID :=
|
|
|
281 Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
|
|
|
282 begin
|
|
|
283 Check_Reserved_Interrupt (Interrupt);
|
|
|
284 Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt);
|
|
|
285 end Bind_Interrupt_To_Entry;
|
|
|
286
|
|
|
287 ---------------------
|
|
|
288 -- Block_Interrupt --
|
|
|
289 ---------------------
|
|
|
290
|
|
|
291 procedure Block_Interrupt (Interrupt : Interrupt_ID) is
|
|
|
292 begin
|
|
|
293 Unimplemented ("Block_Interrupt");
|
|
|
294 end Block_Interrupt;
|
|
|
295
|
|
|
296 ------------------------------
|
|
|
297 -- Check_Reserved_Interrupt --
|
|
|
298 ------------------------------
|
|
|
299
|
|
|
300 procedure Check_Reserved_Interrupt (Interrupt : Interrupt_ID) is
|
|
|
301 begin
|
|
|
302 if Is_Reserved (Interrupt) then
|
|
|
303 raise Program_Error with
|
|
|
304 "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
|
|
|
305 else
|
|
|
306 return;
|
|
|
307 end if;
|
|
|
308 end Check_Reserved_Interrupt;
|
|
|
309
|
|
|
310 ---------------------
|
|
|
311 -- Current_Handler --
|
|
|
312 ---------------------
|
|
|
313
|
|
|
314 function Current_Handler
|
|
|
315 (Interrupt : Interrupt_ID) return Parameterless_Handler
|
|
|
316 is
|
|
|
317 begin
|
|
|
318 Check_Reserved_Interrupt (Interrupt);
|
|
|
319
|
|
|
320 -- ??? Since Parameterless_Handler is not Atomic, the current
|
|
|
321 -- implementation is wrong. We need a new service in Interrupt_Manager
|
|
|
322 -- to ensure atomicity.
|
|
|
323
|
|
|
324 return User_Handler (Interrupt).H;
|
|
|
325 end Current_Handler;
|
|
|
326
|
|
|
327 --------------------
|
|
|
328 -- Detach_Handler --
|
|
|
329 --------------------
|
|
|
330
|
|
|
331 -- Calling this procedure with Static = True means we want to Detach the
|
|
|
332 -- current handler regardless of the previous handler's binding status
|
|
|
333 -- (i.e. do not care if it is a dynamic or static handler).
|
|
|
334
|
|
|
335 -- This option is needed so that during the finalization of a PO, we can
|
|
|
336 -- detach handlers attached through pragma Attach_Handler.
|
|
|
337
|
|
|
338 procedure Detach_Handler
|
|
|
339 (Interrupt : Interrupt_ID;
|
|
|
340 Static : Boolean := False)
|
|
|
341 is
|
|
|
342 begin
|
|
|
343 Check_Reserved_Interrupt (Interrupt);
|
|
|
344 Interrupt_Manager.Detach_Handler (Interrupt, Static);
|
|
|
345 end Detach_Handler;
|
|
|
346
|
|
|
347 ------------------------------
|
|
|
348 -- Detach_Interrupt_Entries --
|
|
|
349 ------------------------------
|
|
|
350
|
|
|
351 procedure Detach_Interrupt_Entries (T : Task_Id) is
|
|
|
352 begin
|
|
|
353 Interrupt_Manager.Detach_Interrupt_Entries (T);
|
|
|
354 end Detach_Interrupt_Entries;
|
|
|
355
|
|
|
356 ----------------------
|
|
|
357 -- Exchange_Handler --
|
|
|
358 ----------------------
|
|
|
359
|
|
|
360 -- Calling this procedure with New_Handler = null and Static = True
|
|
|
361 -- means we want to detach the current handler regardless of the previous
|
|
|
362 -- handler's binding status (i.e. we do not care if it is a dynamic or
|
|
|
363 -- static handler).
|
|
|
364
|
|
|
365 -- This option is needed so that during the finalization of a PO, we can
|
|
|
366 -- detach handlers attached through pragma Attach_Handler.
|
|
|
367
|
|
|
368 procedure Exchange_Handler
|
|
|
369 (Old_Handler : out Parameterless_Handler;
|
|
|
370 New_Handler : Parameterless_Handler;
|
|
|
371 Interrupt : Interrupt_ID;
|
|
|
372 Static : Boolean := False)
|
|
|
373 is
|
|
|
374 begin
|
|
|
375 Check_Reserved_Interrupt (Interrupt);
|
|
|
376 Interrupt_Manager.Exchange_Handler
|
|
|
377 (Old_Handler, New_Handler, Interrupt, Static);
|
|
|
378 end Exchange_Handler;
|
|
|
379
|
|
|
380 --------------
|
|
|
381 -- Finalize --
|
|
|
382 --------------
|
|
|
383
|
|
|
384 procedure Finalize (Object : in out Static_Interrupt_Protection) is
|
|
|
385 begin
|
|
|
386 -- ??? loop to be executed only when we're not doing library level
|
|
|
387 -- finalization, since in this case all interrupt / signal tasks are
|
|
|
388 -- gone.
|
|
|
389
|
|
|
390 if not Interrupt_Manager'Terminated then
|
|
|
391 for N in reverse Object.Previous_Handlers'Range loop
|
|
|
392 Interrupt_Manager.Attach_Handler
|
|
|
393 (New_Handler => Object.Previous_Handlers (N).Handler,
|
|
|
394 Interrupt => Object.Previous_Handlers (N).Interrupt,
|
|
|
395 Static => Object.Previous_Handlers (N).Static,
|
|
|
396 Restoration => True);
|
|
|
397 end loop;
|
|
|
398 end if;
|
|
|
399
|
|
|
400 Tasking.Protected_Objects.Entries.Finalize
|
|
|
401 (Tasking.Protected_Objects.Entries.Protection_Entries (Object));
|
|
|
402 end Finalize;
|
|
|
403
|
|
|
404 --------------------------------
|
|
|
405 -- Finalize_Interrupt_Servers --
|
|
|
406 --------------------------------
|
|
|
407
|
|
|
408 -- Restore default handlers for interrupt servers
|
|
|
409
|
|
|
410 -- This is called by the Interrupt_Manager task when it receives the abort
|
|
|
411 -- signal during program finalization.
|
|
|
412
|
|
|
413 procedure Finalize_Interrupt_Servers is
|
|
|
414 HW_Interrupts : constant Boolean := HW_Interrupt'Last >= 0;
|
|
|
415 begin
|
|
|
416 if HW_Interrupts then
|
|
|
417 for Int in HW_Interrupt loop
|
|
|
418 if Server_ID (Interrupt_ID (Int)) /= null
|
|
|
419 and then
|
|
|
420 not Ada.Task_Identification.Is_Terminated
|
|
|
421 (To_Ada (Server_ID (Interrupt_ID (Int))))
|
|
|
422 then
|
|
|
423 Interrupt_Manager.Attach_Handler
|
|
|
424 (New_Handler => null,
|
|
|
425 Interrupt => Interrupt_ID (Int),
|
|
|
426 Static => True,
|
|
|
427 Restoration => True);
|
|
|
428 end if;
|
|
|
429 end loop;
|
|
|
430 end if;
|
|
|
431 end Finalize_Interrupt_Servers;
|
|
|
432
|
|
|
433 -------------------------------------
|
|
|
434 -- Has_Interrupt_Or_Attach_Handler --
|
|
|
435 -------------------------------------
|
|
|
436
|
|
|
437 function Has_Interrupt_Or_Attach_Handler
|
|
|
438 (Object : access Dynamic_Interrupt_Protection)
|
|
|
439 return Boolean
|
|
|
440 is
|
|
|
441 pragma Unreferenced (Object);
|
|
|
442 begin
|
|
|
443 return True;
|
|
|
444 end Has_Interrupt_Or_Attach_Handler;
|
|
|
445
|
|
|
446 function Has_Interrupt_Or_Attach_Handler
|
|
|
447 (Object : access Static_Interrupt_Protection)
|
|
|
448 return Boolean
|
|
|
449 is
|
|
|
450 pragma Unreferenced (Object);
|
|
|
451 begin
|
|
|
452 return True;
|
|
|
453 end Has_Interrupt_Or_Attach_Handler;
|
|
|
454
|
|
|
455 ----------------------
|
|
|
456 -- Ignore_Interrupt --
|
|
|
457 ----------------------
|
|
|
458
|
|
|
459 procedure Ignore_Interrupt (Interrupt : Interrupt_ID) is
|
|
|
460 begin
|
|
|
461 Unimplemented ("Ignore_Interrupt");
|
|
|
462 end Ignore_Interrupt;
|
|
|
463
|
|
|
464 ----------------------
|
|
|
465 -- Install_Handlers --
|
|
|
466 ----------------------
|
|
|
467
|
|
|
468 procedure Install_Handlers
|
|
|
469 (Object : access Static_Interrupt_Protection;
|
|
|
470 New_Handlers : New_Handler_Array)
|
|
|
471 is
|
|
|
472 begin
|
|
|
473 for N in New_Handlers'Range loop
|
|
|
474
|
|
|
475 -- We need a lock around this ???
|
|
|
476
|
|
|
477 Object.Previous_Handlers (N).Interrupt := New_Handlers (N).Interrupt;
|
|
|
478 Object.Previous_Handlers (N).Static := User_Handler
|
|
|
479 (New_Handlers (N).Interrupt).Static;
|
|
|
480
|
|
|
481 -- We call Exchange_Handler and not directly Interrupt_Manager.
|
|
|
482 -- Exchange_Handler so we get the Is_Reserved check.
|
|
|
483
|
|
|
484 Exchange_Handler
|
|
|
485 (Old_Handler => Object.Previous_Handlers (N).Handler,
|
|
|
486 New_Handler => New_Handlers (N).Handler,
|
|
|
487 Interrupt => New_Handlers (N).Interrupt,
|
|
|
488 Static => True);
|
|
|
489 end loop;
|
|
|
490 end Install_Handlers;
|
|
|
491
|
|
|
492 ---------------------------------
|
|
|
493 -- Install_Restricted_Handlers --
|
|
|
494 ---------------------------------
|
|
|
495
|
|
|
496 procedure Install_Restricted_Handlers
|
|
|
497 (Prio : Any_Priority;
|
|
|
498 Handlers : New_Handler_Array)
|
|
|
499 is
|
|
|
500 pragma Unreferenced (Prio);
|
|
|
501 begin
|
|
|
502 for N in Handlers'Range loop
|
|
|
503 Attach_Handler (Handlers (N).Handler, Handlers (N).Interrupt, True);
|
|
|
504 end loop;
|
|
|
505 end Install_Restricted_Handlers;
|
|
|
506
|
|
|
507 ------------------------------
|
|
|
508 -- Install_Umbrella_Handler --
|
|
|
509 ------------------------------
|
|
|
510
|
|
|
511 procedure Install_Umbrella_Handler
|
|
|
512 (Interrupt : HW_Interrupt;
|
|
|
513 Handler : System.OS_Interface.Interrupt_Handler)
|
|
|
514 is
|
|
|
515 Vec : constant Interrupt_Vector :=
|
|
|
516 Interrupt_Number_To_Vector (int (Interrupt));
|
|
|
517
|
|
|
518 Status : int;
|
|
|
519
|
|
|
520 begin
|
|
|
521 -- Only install umbrella handler when no Ada handler has already been
|
|
|
522 -- installed. Note that the interrupt number is passed as a parameter
|
|
|
523 -- when an interrupt occurs, so the umbrella handler has a different
|
|
|
524 -- wrapper generated by the connector routine for each interrupt
|
|
|
525 -- number.
|
|
|
526
|
|
|
527 if not Handler_Installed (Interrupt) then
|
|
|
528 Status :=
|
|
|
529 Interrupt_Connect.all (Vec, Handler, System.Address (Interrupt));
|
|
|
530 pragma Assert (Status = 0);
|
|
|
531
|
|
|
532 Handler_Installed (Interrupt) := True;
|
|
|
533 end if;
|
|
|
534 end Install_Umbrella_Handler;
|
|
|
535
|
|
|
536 ----------------
|
|
|
537 -- Is_Blocked --
|
|
|
538 ----------------
|
|
|
539
|
|
|
540 function Is_Blocked (Interrupt : Interrupt_ID) return Boolean is
|
|
|
541 begin
|
|
|
542 Unimplemented ("Is_Blocked");
|
|
|
543 return False;
|
|
|
544 end Is_Blocked;
|
|
|
545
|
|
|
546 -----------------------
|
|
|
547 -- Is_Entry_Attached --
|
|
|
548 -----------------------
|
|
|
549
|
|
|
550 function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is
|
|
|
551 begin
|
|
|
552 Check_Reserved_Interrupt (Interrupt);
|
|
|
553 return User_Entry (Interrupt).T /= Null_Task;
|
|
|
554 end Is_Entry_Attached;
|
|
|
555
|
|
|
556 -------------------------
|
|
|
557 -- Is_Handler_Attached --
|
|
|
558 -------------------------
|
|
|
559
|
|
|
560 function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is
|
|
|
561 begin
|
|
|
562 Check_Reserved_Interrupt (Interrupt);
|
|
|
563 return User_Handler (Interrupt).H /= null;
|
|
|
564 end Is_Handler_Attached;
|
|
|
565
|
|
|
566 ----------------
|
|
|
567 -- Is_Ignored --
|
|
|
568 ----------------
|
|
|
569
|
|
|
570 function Is_Ignored (Interrupt : Interrupt_ID) return Boolean is
|
|
|
571 begin
|
|
|
572 Unimplemented ("Is_Ignored");
|
|
|
573 return False;
|
|
|
574 end Is_Ignored;
|
|
|
575
|
|
|
576 -------------------
|
|
|
577 -- Is_Registered --
|
|
|
578 -------------------
|
|
|
579
|
|
|
580 function Is_Registered (Handler : Parameterless_Handler) return Boolean is
|
|
145
|
581
|
|
|
582 type Acc_Proc is access procedure;
|
|
|
583
|
|
111
|
584 type Fat_Ptr is record
|
|
|
585 Object_Addr : System.Address;
|
|
145
|
586 Handler_Addr : Acc_Proc;
|
|
111
|
587 end record;
|
|
|
588
|
|
|
589 function To_Fat_Ptr is new Ada.Unchecked_Conversion
|
|
|
590 (Parameterless_Handler, Fat_Ptr);
|
|
|
591
|
|
|
592 Ptr : R_Link;
|
|
|
593 Fat : Fat_Ptr;
|
|
|
594
|
|
|
595 begin
|
|
|
596 if Handler = null then
|
|
|
597 return True;
|
|
|
598 end if;
|
|
|
599
|
|
|
600 Fat := To_Fat_Ptr (Handler);
|
|
|
601
|
|
|
602 Ptr := Registered_Handler_Head;
|
|
|
603 while Ptr /= null loop
|
|
145
|
604 if Ptr.H = Fat.Handler_Addr.all'Address then
|
|
111
|
605 return True;
|
|
|
606 end if;
|
|
|
607
|
|
|
608 Ptr := Ptr.Next;
|
|
|
609 end loop;
|
|
|
610
|
|
|
611 return False;
|
|
|
612 end Is_Registered;
|
|
|
613
|
|
|
614 -----------------
|
|
|
615 -- Is_Reserved --
|
|
|
616 -----------------
|
|
|
617
|
|
|
618 function Is_Reserved (Interrupt : Interrupt_ID) return Boolean is
|
|
|
619 use System.Interrupt_Management;
|
|
|
620 begin
|
|
|
621 return Reserve (System.Interrupt_Management.Interrupt_ID (Interrupt));
|
|
|
622 end Is_Reserved;
|
|
|
623
|
|
|
624 ----------------------
|
|
|
625 -- Notify_Interrupt --
|
|
|
626 ----------------------
|
|
|
627
|
|
|
628 -- Umbrella handler for vectored hardware interrupts (as opposed to signals
|
|
|
629 -- and exceptions). As opposed to the signal implementation, this handler
|
|
|
630 -- is installed in the vector table when the first Ada handler is attached
|
|
|
631 -- to the interrupt. However because VxWorks don't support disconnecting
|
|
|
632 -- handlers, this subprogram always test whether or not an Ada handler is
|
|
|
633 -- effectively attached.
|
|
|
634
|
|
|
635 -- Otherwise, the handler that existed prior to program startup is in the
|
|
|
636 -- vector table. This ensures that handlers installed by the BSP are active
|
|
|
637 -- unless explicitly replaced in the program text.
|
|
|
638
|
|
|
639 -- Each Interrupt_Server_Task has an associated binary semaphore on which
|
|
|
640 -- it pends once it's been started. This routine determines The appropriate
|
|
|
641 -- semaphore and issues a semGive call, waking the server task. When
|
|
|
642 -- a handler is unbound, System.Interrupts.Unbind_Handler issues a
|
|
|
643 -- Binary_Semaphore_Flush, and the server task deletes its semaphore
|
|
|
644 -- and terminates.
|
|
|
645
|
|
|
646 procedure Notify_Interrupt (Param : System.Address) is
|
|
|
647 Interrupt : constant Interrupt_ID := Interrupt_ID (Param);
|
|
|
648 Id : constant Binary_Semaphore_Id := Semaphore_ID_Map (Interrupt);
|
|
|
649 Status : int;
|
|
|
650 begin
|
|
|
651 if Id /= 0 then
|
|
|
652 Status := Binary_Semaphore_Release (Id);
|
|
|
653 pragma Assert (Status = 0);
|
|
|
654 end if;
|
|
|
655 end Notify_Interrupt;
|
|
|
656
|
|
|
657 ---------------
|
|
|
658 -- Reference --
|
|
|
659 ---------------
|
|
|
660
|
|
|
661 function Reference (Interrupt : Interrupt_ID) return System.Address is
|
|
|
662 begin
|
|
|
663 Check_Reserved_Interrupt (Interrupt);
|
|
|
664 return Storage_Elements.To_Address
|
|
|
665 (Storage_Elements.Integer_Address (Interrupt));
|
|
|
666 end Reference;
|
|
|
667
|
|
|
668 --------------------------------
|
|
|
669 -- Register_Interrupt_Handler --
|
|
|
670 --------------------------------
|
|
|
671
|
|
|
672 procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is
|
|
|
673 New_Node_Ptr : R_Link;
|
|
|
674
|
|
|
675 begin
|
|
|
676 -- This routine registers a handler as usable for dynamic interrupt
|
|
|
677 -- handler association. Routines attaching and detaching handlers
|
|
|
678 -- dynamically should determine whether the handler is registered.
|
|
|
679 -- Program_Error should be raised if it is not registered.
|
|
|
680
|
|
|
681 -- Pragma Interrupt_Handler can only appear in a library level PO
|
|
|
682 -- definition and instantiation. Therefore, we do not need to implement
|
|
|
683 -- an unregister operation. Nor do we need to protect the queue
|
|
|
684 -- structure with a lock.
|
|
|
685
|
|
|
686 pragma Assert (Handler_Addr /= System.Null_Address);
|
|
|
687
|
|
|
688 New_Node_Ptr := new Registered_Handler;
|
|
|
689 New_Node_Ptr.H := Handler_Addr;
|
|
|
690
|
|
|
691 if Registered_Handler_Head = null then
|
|
|
692 Registered_Handler_Head := New_Node_Ptr;
|
|
|
693 Registered_Handler_Tail := New_Node_Ptr;
|
|
|
694 else
|
|
|
695 Registered_Handler_Tail.Next := New_Node_Ptr;
|
|
|
696 Registered_Handler_Tail := New_Node_Ptr;
|
|
|
697 end if;
|
|
|
698 end Register_Interrupt_Handler;
|
|
|
699
|
|
|
700 -----------------------
|
|
|
701 -- Unblock_Interrupt --
|
|
|
702 -----------------------
|
|
|
703
|
|
|
704 procedure Unblock_Interrupt (Interrupt : Interrupt_ID) is
|
|
|
705 begin
|
|
|
706 Unimplemented ("Unblock_Interrupt");
|
|
|
707 end Unblock_Interrupt;
|
|
|
708
|
|
|
709 ------------------
|
|
|
710 -- Unblocked_By --
|
|
|
711 ------------------
|
|
|
712
|
|
|
713 function Unblocked_By
|
|
|
714 (Interrupt : Interrupt_ID) return System.Tasking.Task_Id
|
|
|
715 is
|
|
|
716 begin
|
|
|
717 Unimplemented ("Unblocked_By");
|
|
|
718 return Null_Task;
|
|
|
719 end Unblocked_By;
|
|
|
720
|
|
|
721 ------------------------
|
|
|
722 -- Unignore_Interrupt --
|
|
|
723 ------------------------
|
|
|
724
|
|
|
725 procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is
|
|
|
726 begin
|
|
|
727 Unimplemented ("Unignore_Interrupt");
|
|
|
728 end Unignore_Interrupt;
|
|
|
729
|
|
|
730 -------------------
|
|
|
731 -- Unimplemented --
|
|
|
732 -------------------
|
|
|
733
|
|
|
734 procedure Unimplemented (Feature : String) is
|
|
|
735 begin
|
|
|
736 raise Program_Error with Feature & " not implemented on VxWorks";
|
|
|
737 end Unimplemented;
|
|
|
738
|
|
|
739 -----------------------
|
|
|
740 -- Interrupt_Manager --
|
|
|
741 -----------------------
|
|
|
742
|
|
|
743 task body Interrupt_Manager is
|
|
|
744 -- By making this task independent of any master, when the process goes
|
|
|
745 -- away, the Interrupt_Manager will terminate gracefully.
|
|
|
746
|
|
|
747 Ignore : constant Boolean := System.Tasking.Utilities.Make_Independent;
|
|
|
748 pragma Unreferenced (Ignore);
|
|
|
749
|
|
|
750 --------------------
|
|
|
751 -- Local Routines --
|
|
|
752 --------------------
|
|
|
753
|
|
|
754 procedure Bind_Handler (Interrupt : Interrupt_ID);
|
|
|
755 -- This procedure does not do anything if a signal is blocked.
|
|
|
756 -- Otherwise, we have to interrupt Server_Task for status change
|
|
|
757 -- through a wakeup signal.
|
|
|
758
|
|
|
759 procedure Unbind_Handler (Interrupt : Interrupt_ID);
|
|
|
760 -- This procedure does not do anything if a signal is blocked.
|
|
|
761 -- Otherwise, we have to interrupt Server_Task for status change
|
|
|
762 -- through an abort signal.
|
|
|
763
|
|
|
764 procedure Unprotected_Exchange_Handler
|
|
|
765 (Old_Handler : out Parameterless_Handler;
|
|
|
766 New_Handler : Parameterless_Handler;
|
|
|
767 Interrupt : Interrupt_ID;
|
|
|
768 Static : Boolean;
|
|
|
769 Restoration : Boolean := False);
|
|
|
770
|
|
|
771 procedure Unprotected_Detach_Handler
|
|
|
772 (Interrupt : Interrupt_ID;
|
|
|
773 Static : Boolean);
|
|
|
774
|
|
|
775 ------------------
|
|
|
776 -- Bind_Handler --
|
|
|
777 ------------------
|
|
|
778
|
|
|
779 procedure Bind_Handler (Interrupt : Interrupt_ID) is
|
|
|
780 begin
|
|
|
781 Install_Umbrella_Handler
|
|
|
782 (HW_Interrupt (Interrupt), Notify_Interrupt'Access);
|
|
|
783 end Bind_Handler;
|
|
|
784
|
|
|
785 --------------------
|
|
|
786 -- Unbind_Handler --
|
|
|
787 --------------------
|
|
|
788
|
|
|
789 procedure Unbind_Handler (Interrupt : Interrupt_ID) is
|
|
|
790 Status : int;
|
|
|
791
|
|
|
792 begin
|
|
|
793 -- Flush server task off semaphore, allowing it to terminate
|
|
|
794
|
|
|
795 Status := Binary_Semaphore_Flush (Semaphore_ID_Map (Interrupt));
|
|
|
796 pragma Assert (Status = 0);
|
|
|
797 end Unbind_Handler;
|
|
|
798
|
|
|
799 --------------------------------
|
|
|
800 -- Unprotected_Detach_Handler --
|
|
|
801 --------------------------------
|
|
|
802
|
|
|
803 procedure Unprotected_Detach_Handler
|
|
|
804 (Interrupt : Interrupt_ID;
|
|
|
805 Static : Boolean)
|
|
|
806 is
|
|
|
807 Old_Handler : Parameterless_Handler;
|
|
|
808 begin
|
|
|
809 if User_Entry (Interrupt).T /= Null_Task then
|
|
|
810
|
|
|
811 -- If an interrupt entry is installed raise Program_Error
|
|
|
812 -- (propagate it to the caller).
|
|
|
813
|
|
|
814 raise Program_Error with
|
|
|
815 "an interrupt entry is already installed";
|
|
|
816 end if;
|
|
|
817
|
|
|
818 -- Note : Static = True will pass the following check. This is the
|
|
|
819 -- case when we want to detach a handler regardless of the static
|
|
|
820 -- status of the Current_Handler.
|
|
|
821
|
|
|
822 if not Static and then User_Handler (Interrupt).Static then
|
|
|
823
|
|
|
824 -- Trying to detach a static Interrupt Handler, raise
|
|
|
825 -- Program_Error.
|
|
|
826
|
|
|
827 raise Program_Error with
|
|
|
828 "trying to detach a static Interrupt Handler";
|
|
|
829 end if;
|
|
|
830
|
|
|
831 Old_Handler := User_Handler (Interrupt).H;
|
|
|
832
|
|
|
833 -- The new handler
|
|
|
834
|
|
|
835 User_Handler (Interrupt).H := null;
|
|
|
836 User_Handler (Interrupt).Static := False;
|
|
|
837
|
|
|
838 if Old_Handler /= null then
|
|
|
839 Unbind_Handler (Interrupt);
|
|
|
840 end if;
|
|
|
841 end Unprotected_Detach_Handler;
|
|
|
842
|
|
|
843 ----------------------------------
|
|
|
844 -- Unprotected_Exchange_Handler --
|
|
|
845 ----------------------------------
|
|
|
846
|
|
|
847 procedure Unprotected_Exchange_Handler
|
|
|
848 (Old_Handler : out Parameterless_Handler;
|
|
|
849 New_Handler : Parameterless_Handler;
|
|
|
850 Interrupt : Interrupt_ID;
|
|
|
851 Static : Boolean;
|
|
|
852 Restoration : Boolean := False)
|
|
|
853 is
|
|
|
854 begin
|
|
|
855 if User_Entry (Interrupt).T /= Null_Task then
|
|
|
856
|
|
|
857 -- If an interrupt entry is already installed, raise
|
|
|
858 -- Program_Error (propagate it to the caller).
|
|
|
859
|
|
|
860 raise Program_Error with "an interrupt is already installed";
|
|
|
861 end if;
|
|
|
862
|
|
|
863 -- Note : A null handler with Static = True will pass the following
|
|
|
864 -- check. This is the case when we want to detach a handler
|
|
|
865 -- regardless of the Static status of Current_Handler.
|
|
|
866
|
|
|
867 -- We don't check anything if Restoration is True, since we may be
|
|
|
868 -- detaching a static handler to restore a dynamic one.
|
|
|
869
|
|
|
870 if not Restoration and then not Static
|
|
|
871 and then (User_Handler (Interrupt).Static
|
|
|
872
|
|
|
873 -- Trying to overwrite a static Interrupt Handler with a dynamic
|
|
|
874 -- Handler
|
|
|
875
|
|
|
876 -- The new handler is not specified as an Interrupt Handler by a
|
|
|
877 -- pragma.
|
|
|
878
|
|
|
879 or else not Is_Registered (New_Handler))
|
|
|
880 then
|
|
|
881 raise Program_Error with
|
|
|
882 "trying to overwrite a static interrupt handler with a "
|
|
|
883 & "dynamic handler";
|
|
|
884 end if;
|
|
|
885
|
|
|
886 -- Save the old handler
|
|
|
887
|
|
|
888 Old_Handler := User_Handler (Interrupt).H;
|
|
|
889
|
|
|
890 -- The new handler
|
|
|
891
|
|
|
892 User_Handler (Interrupt).H := New_Handler;
|
|
|
893
|
|
|
894 if New_Handler = null then
|
|
|
895
|
|
|
896 -- The null handler means we are detaching the handler
|
|
|
897
|
|
|
898 User_Handler (Interrupt).Static := False;
|
|
|
899
|
|
|
900 else
|
|
|
901 User_Handler (Interrupt).Static := Static;
|
|
|
902 end if;
|
|
|
903
|
|
|
904 -- Invoke a corresponding Server_Task if not yet created. Place
|
|
|
905 -- Task_Id info in Server_ID array.
|
|
|
906
|
|
|
907 if New_Handler /= null
|
|
|
908 and then
|
|
|
909 (Server_ID (Interrupt) = Null_Task
|
|
|
910 or else
|
|
|
911 Ada.Task_Identification.Is_Terminated
|
|
|
912 (To_Ada (Server_ID (Interrupt))))
|
|
|
913 then
|
|
|
914 Interrupt_Access_Hold :=
|
|
|
915 new Interrupt_Server_Task (Interrupt, Binary_Semaphore_Create);
|
|
|
916 Server_ID (Interrupt) :=
|
|
|
917 To_System (Interrupt_Access_Hold.all'Identity);
|
|
|
918 end if;
|
|
|
919
|
|
|
920 if (New_Handler = null) and then Old_Handler /= null then
|
|
|
921
|
|
|
922 -- Restore default handler
|
|
|
923
|
|
|
924 Unbind_Handler (Interrupt);
|
|
|
925
|
|
|
926 elsif Old_Handler = null then
|
|
|
927
|
|
|
928 -- Save default handler
|
|
|
929
|
|
|
930 Bind_Handler (Interrupt);
|
|
|
931 end if;
|
|
|
932 end Unprotected_Exchange_Handler;
|
|
|
933
|
|
|
934 -- Start of processing for Interrupt_Manager
|
|
|
935
|
|
|
936 begin
|
|
|
937 loop
|
|
|
938 -- A block is needed to absorb Program_Error exception
|
|
|
939
|
|
|
940 declare
|
|
|
941 Old_Handler : Parameterless_Handler;
|
|
|
942
|
|
|
943 begin
|
|
|
944 select
|
|
|
945 accept Attach_Handler
|
|
|
946 (New_Handler : Parameterless_Handler;
|
|
|
947 Interrupt : Interrupt_ID;
|
|
|
948 Static : Boolean;
|
|
|
949 Restoration : Boolean := False)
|
|
|
950 do
|
|
|
951 Unprotected_Exchange_Handler
|
|
|
952 (Old_Handler, New_Handler, Interrupt, Static, Restoration);
|
|
|
953 end Attach_Handler;
|
|
|
954
|
|
|
955 or
|
|
|
956 accept Exchange_Handler
|
|
|
957 (Old_Handler : out Parameterless_Handler;
|
|
|
958 New_Handler : Parameterless_Handler;
|
|
|
959 Interrupt : Interrupt_ID;
|
|
|
960 Static : Boolean)
|
|
|
961 do
|
|
|
962 Unprotected_Exchange_Handler
|
|
|
963 (Old_Handler, New_Handler, Interrupt, Static);
|
|
|
964 end Exchange_Handler;
|
|
|
965
|
|
|
966 or
|
|
|
967 accept Detach_Handler
|
|
|
968 (Interrupt : Interrupt_ID;
|
|
|
969 Static : Boolean)
|
|
|
970 do
|
|
|
971 Unprotected_Detach_Handler (Interrupt, Static);
|
|
|
972 end Detach_Handler;
|
|
|
973
|
|
|
974 or
|
|
|
975 accept Bind_Interrupt_To_Entry
|
|
|
976 (T : Task_Id;
|
|
|
977 E : Task_Entry_Index;
|
|
|
978 Interrupt : Interrupt_ID)
|
|
|
979 do
|
|
|
980 -- If there is a binding already (either a procedure or an
|
|
|
981 -- entry), raise Program_Error (propagate it to the caller).
|
|
|
982
|
|
|
983 if User_Handler (Interrupt).H /= null
|
|
|
984 or else User_Entry (Interrupt).T /= Null_Task
|
|
|
985 then
|
|
|
986 raise Program_Error with
|
|
|
987 "a binding for this interrupt is already present";
|
|
|
988 end if;
|
|
|
989
|
|
|
990 User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E);
|
|
|
991
|
|
|
992 -- Indicate the attachment of interrupt entry in the ATCB.
|
|
|
993 -- This is needed so when an interrupt entry task terminates
|
|
|
994 -- the binding can be cleaned. The call to unbinding must be
|
|
|
995 -- make by the task before it terminates.
|
|
|
996
|
|
|
997 T.Interrupt_Entry := True;
|
|
|
998
|
|
|
999 -- Invoke a corresponding Server_Task if not yet created.
|
|
|
1000 -- Place Task_Id info in Server_ID array.
|
|
|
1001
|
|
|
1002 if Server_ID (Interrupt) = Null_Task
|
|
|
1003 or else
|
|
|
1004 Ada.Task_Identification.Is_Terminated
|
|
|
1005 (To_Ada (Server_ID (Interrupt)))
|
|
|
1006 then
|
|
|
1007 Interrupt_Access_Hold := new Interrupt_Server_Task
|
|
|
1008 (Interrupt, Binary_Semaphore_Create);
|
|
|
1009 Server_ID (Interrupt) :=
|
|
|
1010 To_System (Interrupt_Access_Hold.all'Identity);
|
|
|
1011 end if;
|
|
|
1012
|
|
|
1013 Bind_Handler (Interrupt);
|
|
|
1014 end Bind_Interrupt_To_Entry;
|
|
|
1015
|
|
|
1016 or
|
|
|
1017 accept Detach_Interrupt_Entries (T : Task_Id) do
|
|
|
1018 for Int in Interrupt_ID'Range loop
|
|
|
1019 if not Is_Reserved (Int) then
|
|
|
1020 if User_Entry (Int).T = T then
|
|
|
1021 User_Entry (Int) :=
|
|
|
1022 Entry_Assoc'
|
|
|
1023 (T => Null_Task, E => Null_Task_Entry);
|
|
|
1024 Unbind_Handler (Int);
|
|
|
1025 end if;
|
|
|
1026 end if;
|
|
|
1027 end loop;
|
|
|
1028
|
|
|
1029 -- Indicate in ATCB that no interrupt entries are attached
|
|
|
1030
|
|
|
1031 T.Interrupt_Entry := False;
|
|
|
1032 end Detach_Interrupt_Entries;
|
|
|
1033 end select;
|
|
|
1034
|
|
|
1035 exception
|
|
|
1036 -- If there is a Program_Error we just want to propagate it to
|
|
|
1037 -- the caller and do not want to stop this task.
|
|
|
1038
|
|
|
1039 when Program_Error =>
|
|
|
1040 null;
|
|
|
1041
|
|
|
1042 when others =>
|
|
|
1043 pragma Assert (False);
|
|
|
1044 null;
|
|
|
1045 end;
|
|
|
1046 end loop;
|
|
|
1047
|
|
|
1048 exception
|
|
|
1049 when Standard'Abort_Signal =>
|
|
|
1050
|
|
|
1051 -- Flush interrupt server semaphores, so they can terminate
|
|
|
1052
|
|
|
1053 Finalize_Interrupt_Servers;
|
|
|
1054 raise;
|
|
|
1055 end Interrupt_Manager;
|
|
|
1056
|
|
|
1057 ---------------------------
|
|
|
1058 -- Interrupt_Server_Task --
|
|
|
1059 ---------------------------
|
|
|
1060
|
|
|
1061 -- Server task for vectored hardware interrupt handling
|
|
|
1062
|
|
|
1063 task body Interrupt_Server_Task is
|
|
|
1064 Ignore : constant Boolean := System.Tasking.Utilities.Make_Independent;
|
|
|
1065
|
|
|
1066 Self_Id : constant Task_Id := Self;
|
|
|
1067 Tmp_Handler : Parameterless_Handler;
|
|
|
1068 Tmp_ID : Task_Id;
|
|
|
1069 Tmp_Entry_Index : Task_Entry_Index;
|
|
|
1070 Status : int;
|
|
|
1071
|
|
|
1072 begin
|
|
|
1073 Semaphore_ID_Map (Interrupt) := Int_Sema;
|
|
|
1074
|
|
|
1075 loop
|
|
|
1076 -- Pend on semaphore that will be triggered by the umbrella handler
|
|
|
1077 -- when the associated interrupt comes in.
|
|
|
1078
|
|
|
1079 Status := Binary_Semaphore_Obtain (Int_Sema);
|
|
|
1080 pragma Assert (Status = 0);
|
|
|
1081
|
|
|
1082 if User_Handler (Interrupt).H /= null then
|
|
|
1083
|
|
|
1084 -- Protected procedure handler
|
|
|
1085
|
|
|
1086 Tmp_Handler := User_Handler (Interrupt).H;
|
|
|
1087 Tmp_Handler.all;
|
|
|
1088
|
|
|
1089 elsif User_Entry (Interrupt).T /= Null_Task then
|
|
|
1090
|
|
|
1091 -- Interrupt entry handler
|
|
|
1092
|
|
|
1093 Tmp_ID := User_Entry (Interrupt).T;
|
|
|
1094 Tmp_Entry_Index := User_Entry (Interrupt).E;
|
|
|
1095 System.Tasking.Rendezvous.Call_Simple
|
|
|
1096 (Tmp_ID, Tmp_Entry_Index, System.Null_Address);
|
|
|
1097
|
|
|
1098 else
|
|
|
1099 -- Semaphore has been flushed by an unbind operation in the
|
|
|
1100 -- Interrupt_Manager. Terminate the server task.
|
|
|
1101
|
|
|
1102 -- Wait for the Interrupt_Manager to complete its work
|
|
|
1103
|
|
|
1104 POP.Write_Lock (Self_Id);
|
|
|
1105
|
|
|
1106 -- Unassociate the interrupt handler
|
|
|
1107
|
|
|
1108 Semaphore_ID_Map (Interrupt) := 0;
|
|
|
1109
|
|
|
1110 -- Delete the associated semaphore
|
|
|
1111
|
|
|
1112 Status := Binary_Semaphore_Delete (Int_Sema);
|
|
|
1113
|
|
|
1114 pragma Assert (Status = 0);
|
|
|
1115
|
|
|
1116 -- Set status for the Interrupt_Manager
|
|
|
1117
|
|
|
1118 Server_ID (Interrupt) := Null_Task;
|
|
|
1119 POP.Unlock (Self_Id);
|
|
|
1120
|
|
|
1121 exit;
|
|
|
1122 end if;
|
|
|
1123 end loop;
|
|
|
1124 end Interrupt_Server_Task;
|
|
|
1125
|
|
|
1126 begin
|
|
|
1127 -- Get Interrupt_Manager's ID so that Abort_Interrupt can be sent
|
|
|
1128
|
|
|
1129 Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
|
|
|
1130 end System.Interrupts;
|
