File : s-interr-xi.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-2013, 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 generic bare board version of this package
33
34 pragma Restrictions (No_Elaboration_Code);
35
36 with System.Tasking.Restricted.Stages;
37
38 package body System.Interrupts is
39
40 ----------------
41 -- Local Data --
42 ----------------
43
44 type Handler_Entry is record
45 Handler : Parameterless_Handler;
46 -- The protected subprogram
47
48 PO_Priority : Interrupt_Priority;
49 -- The priority of the protected object in which the handler is declared
50 --
51 -- As the handler is a fat pointer to both the subprogram and the
52 -- protected object, it could be possible to extract the priority
53 -- from the access. But there is currently no mechanism for that ???
54 end record;
55 pragma Suppress_Initialization (Handler_Entry);
56
57 type Handlers_Table is array (Interrupt_ID) of Handler_Entry;
58 pragma Suppress_Initialization (Handlers_Table);
59 -- Type used to represent the procedures used as interrupt handlers. No
60 -- need to create an initializer, as the only object declared with this
61 -- type is just below and has an expression to initialize it.
62
63 User_Handlers : Handlers_Table :=
64 (others => (null, Interrupt_Priority'First));
65 -- Table containing user handlers. Must be explicitly initialized to detect
66 -- interrupts without attached handlers.
67
68 -----------------------
69 -- Local Subprograms --
70 -----------------------
71
72 procedure Install_Handler (Interrupt : Interrupt_ID);
73 -- Install the runtime umbrella handler for a hardware interrupt
74
75 procedure Default_Handler (Interrupt : System.OS_Interface.Interrupt_ID);
76 -- Default interrupt handler
77
78 ---------------------
79 -- Default_Handler --
80 ---------------------
81
82 procedure Default_Handler (Interrupt : System.OS_Interface.Interrupt_ID) is
83 Handler : constant Parameterless_Handler :=
84 User_Handlers (Interrupt_ID (Interrupt)).Handler;
85 begin
86 if Handler = null then
87
88 -- Be sure to properly report spurious interrupts even if the run
89 -- time is compiled with checks suppressed.
90
91 -- The ravenscar-sfp profile has a No_Exception_Propagation
92 -- restriction. Discard compiler warning on the raise statement.
93
94 pragma Warnings (Off);
95 raise Program_Error;
96 pragma Warnings (On);
97 end if;
98
99 -- As exception propagated from a handler that is invoked by an
100 -- interrupt must have no effect (ARM C.3 par. 7), interrupt handlers
101 -- are wrapped by a null exception handler to avoid exceptions to be
102 -- propagated further.
103
104 -- The ravenscar-sfp profile has a No_Exception_Propagation
105 -- restriction. Discard compiler warning on the handler.
106
107 pragma Warnings (Off);
108
109 begin
110 Handler.all;
111
112 exception
113
114 -- Avoid any further exception propagation
115
116 when others =>
117 null;
118 end;
119
120 pragma Warnings (On);
121 end Default_Handler;
122
123 -- Depending on whether exception propagation is supported or not, the
124 -- implementation will differ; exceptions can never be propagated through
125 -- this procedure (see ARM C.3 par. 7).
126
127 ---------------------
128 -- Install_Handler --
129 ---------------------
130
131 procedure Install_Handler (Interrupt : Interrupt_ID) is
132 begin
133 -- Attach the default handler to the specified interrupt. This handler
134 -- will in turn call the user handler.
135
136 System.OS_Interface.Attach_Handler
137 (Default_Handler'Access,
138 System.OS_Interface.Interrupt_ID (Interrupt),
139 User_Handlers (Interrupt).PO_Priority);
140 end Install_Handler;
141
142 ---------------------------------
143 -- Install_Restricted_Handlers --
144 ---------------------------------
145
146 procedure Install_Restricted_Handlers
147 (Prio : Any_Priority;
148 Handlers : Handler_Array)
149 is
150 use System.Tasking.Restricted.Stages;
151
152 begin
153 for J in Handlers'Range loop
154
155 -- Copy the handler in the table that contains the user handlers
156
157 User_Handlers (Handlers (J).Interrupt) :=
158 (Handlers (J).Handler, Prio);
159
160 -- Install the handler now, unless attachment is deferred because of
161 -- sequential partition elaboration policy.
162
163 if Partition_Elaboration_Policy /= 'S' then
164 Install_Handler (Handlers (J).Interrupt);
165 end if;
166 end loop;
167 end Install_Restricted_Handlers;
168
169 --------------------------------------------
170 -- Install_Restricted_Handlers_Sequential --
171 --------------------------------------------
172
173 procedure Install_Restricted_Handlers_Sequential is
174 begin
175 for J in User_Handlers'Range loop
176 if User_Handlers (J).Handler /= null then
177 Install_Handler (J);
178 end if;
179 end loop;
180 end Install_Restricted_Handlers_Sequential;
181
182 end System.Interrupts;