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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
|
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- SYSTEM.INTERRUPT_MANAGEMENT.OPERATIONS --
-- --
-- B o d y --
-- --
-- Copyright (C) 1991-2017, Florida State University --
-- Copyright (C) 1995-2024, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
------------------------------------------------------------------------------
-- This is a hardware interrupt version of this package. Many operations are
-- null as this package supports the use of Ada interrupt handling facilities
-- for signals, while those facilities are used for hardware interrupts on
-- these targets.
with Ada.Exceptions;
with Interfaces.C;
with System.OS_Interface;
package body System.Interrupt_Management.Operations is
use Ada.Exceptions;
use Interfaces.C;
use System.OS_Interface;
----------------------------
-- Thread_Block_Interrupt --
----------------------------
procedure Thread_Block_Interrupt
(Interrupt : Interrupt_ID)
is
pragma Unreferenced (Interrupt);
begin
Raise_Exception
(Program_Error'Identity,
"Thread_Block_Interrupt unimplemented");
end Thread_Block_Interrupt;
------------------------------
-- Thread_Unblock_Interrupt --
------------------------------
procedure Thread_Unblock_Interrupt
(Interrupt : Interrupt_ID)
is
pragma Unreferenced (Interrupt);
begin
Raise_Exception
(Program_Error'Identity,
"Thread_Unblock_Interrupt unimplemented");
end Thread_Unblock_Interrupt;
------------------------
-- Set_Interrupt_Mask --
------------------------
procedure Set_Interrupt_Mask (Mask : access Interrupt_Mask) is
pragma Unreferenced (Mask);
begin
null;
end Set_Interrupt_Mask;
procedure Set_Interrupt_Mask
(Mask : access Interrupt_Mask;
OMask : access Interrupt_Mask)
is
pragma Unreferenced (Mask, OMask);
begin
Raise_Exception
(Program_Error'Identity,
"Set_Interrupt_Mask unimplemented");
end Set_Interrupt_Mask;
------------------------
-- Get_Interrupt_Mask --
------------------------
procedure Get_Interrupt_Mask (Mask : access Interrupt_Mask) is
pragma Unreferenced (Mask);
begin
Raise_Exception
(Program_Error'Identity,
"Get_Interrupt_Mask unimplemented");
end Get_Interrupt_Mask;
--------------------
-- Interrupt_Wait --
--------------------
function Interrupt_Wait
(Mask : access Interrupt_Mask) return Interrupt_ID
is
pragma Unreferenced (Mask);
begin
Raise_Exception
(Program_Error'Identity,
"Interrupt_Wait unimplemented");
return 0;
end Interrupt_Wait;
----------------------------
-- Install_Default_Action --
----------------------------
procedure Install_Default_Action (Interrupt : Interrupt_ID) is
pragma Unreferenced (Interrupt);
begin
Raise_Exception
(Program_Error'Identity,
"Install_Default_Action unimplemented");
end Install_Default_Action;
---------------------------
-- Install_Ignore_Action --
---------------------------
procedure Install_Ignore_Action (Interrupt : Interrupt_ID) is
pragma Unreferenced (Interrupt);
begin
Raise_Exception
(Program_Error'Identity,
"Install_Ignore_Action unimplemented");
end Install_Ignore_Action;
-------------------------
-- Fill_Interrupt_Mask --
-------------------------
procedure Fill_Interrupt_Mask (Mask : access Interrupt_Mask) is
pragma Unreferenced (Mask);
begin
Raise_Exception
(Program_Error'Identity,
"Fill_Interrupt_Mask unimplemented");
end Fill_Interrupt_Mask;
--------------------------
-- Empty_Interrupt_Mask --
--------------------------
procedure Empty_Interrupt_Mask (Mask : access Interrupt_Mask) is
pragma Unreferenced (Mask);
begin
Raise_Exception
(Program_Error'Identity,
"Empty_Interrupt_Mask unimplemented");
end Empty_Interrupt_Mask;
---------------------------
-- Add_To_Interrupt_Mask --
---------------------------
procedure Add_To_Interrupt_Mask
(Mask : access Interrupt_Mask;
Interrupt : Interrupt_ID)
is
pragma Unreferenced (Mask, Interrupt);
begin
Raise_Exception
(Program_Error'Identity,
"Add_To_Interrupt_Mask unimplemented");
end Add_To_Interrupt_Mask;
--------------------------------
-- Delete_From_Interrupt_Mask --
--------------------------------
procedure Delete_From_Interrupt_Mask
(Mask : access Interrupt_Mask;
Interrupt : Interrupt_ID)
is
pragma Unreferenced (Mask, Interrupt);
begin
Raise_Exception
(Program_Error'Identity,
"Delete_From_Interrupt_Mask unimplemented");
end Delete_From_Interrupt_Mask;
---------------
-- Is_Member --
---------------
function Is_Member
(Mask : access Interrupt_Mask;
Interrupt : Interrupt_ID) return Boolean
is
pragma Unreferenced (Mask, Interrupt);
begin
Raise_Exception
(Program_Error'Identity,
"Is_Member unimplemented");
return False;
end Is_Member;
-------------------------
-- Copy_Interrupt_Mask --
-------------------------
procedure Copy_Interrupt_Mask
(X : out Interrupt_Mask;
Y : Interrupt_Mask) is
pragma Unreferenced (X, Y);
begin
Raise_Exception
(Program_Error'Identity,
"Copy_Interrupt_Mask unimplemented");
end Copy_Interrupt_Mask;
----------------------------
-- Interrupt_Self_Process --
----------------------------
procedure Interrupt_Self_Process (Interrupt : Interrupt_ID) is
Result : Interfaces.C.int;
begin
Result := kill (getpid, Signal (Interrupt));
pragma Assert (Result = 0);
end Interrupt_Self_Process;
--------------------------
-- Setup_Interrupt_Mask --
--------------------------
procedure Setup_Interrupt_Mask is
begin
-- Nothing to be done. Ada interrupt facilities on VxWorks do not use
-- signals but hardware interrupts. Therefore, interrupt management does
-- not need anything related to signal masking. Note that this procedure
-- cannot raise an exception (as some others in this package) because
-- the generic implementation of the Timer_Server and timing events make
-- explicit calls to this routine to make ensure proper signal masking
-- on targets needed that.
null;
end Setup_Interrupt_Mask;
end System.Interrupt_Management.Operations;
|
