File : s-interr-pikeos.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-2015, 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.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 end Install_Handler;
140
141 ---------------------------------
142 -- Install_Restricted_Handlers --
143 ---------------------------------
144
145 procedure Install_Restricted_Handlers
146 (Prio : Any_Priority;
147 Handlers : Handler_Array)
148 is
149 use System.Tasking.Restricted.Stages;
150
151 begin
152 for J in Handlers'Range loop
153
154 -- Copy the handler in the table that contains the user handlers
155
156 User_Handlers (Handlers (J).Interrupt) :=
157 (Handlers (J).Handler, Prio);
158
159 -- Install the handler now, unless attachment is deferred because of
160 -- sequential partition elaboration policy.
161
162 if Partition_Elaboration_Policy /= 'S' then
163 Install_Handler (Handlers (J).Interrupt);
164 end if;
165 end loop;
166 end Install_Restricted_Handlers;
167
168 --------------------------------------------
169 -- Install_Restricted_Handlers_Sequential --
170 --------------------------------------------
171
172 procedure Install_Restricted_Handlers_Sequential is
173 begin
174 for J in User_Handlers'Range loop
175 if User_Handlers (J).Handler /= null then
176 Install_Handler (J);
177 end if;
178 end loop;
179 end Install_Restricted_Handlers_Sequential;
180
181 end System.Interrupts;