File : s-inmaop-vxworks.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
4 -- --
5 -- SYSTEM.INTERRUPT_MANAGEMENT.OPERATIONS --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1991-1994, Florida State University --
10 -- Copyright (C) 1995-2011, AdaCore --
11 -- --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 3, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- --
19 -- --
20 -- --
21 -- --
22 -- --
23 -- You should have received a copy of the GNU General Public License and --
24 -- a copy of the GCC Runtime Library Exception along with this program; --
25 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
26 -- <http://www.gnu.org/licenses/>. --
27 -- --
28 -- GNARL was developed by the GNARL team at Florida State University. --
29 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
30 -- --
31 ------------------------------------------------------------------------------
32
33 -- This is a VxWorks version of this package. Many operations are null as this
34 -- package supports the use of Ada interrupt handling facilities for signals,
35 -- while those facilities are used for hardware interrupts on these targets.
36
37 with Ada.Exceptions;
38
39 with Interfaces.C;
40
41 with System.OS_Interface;
42
43 package body System.Interrupt_Management.Operations is
44
45 use Ada.Exceptions;
46 use Interfaces.C;
47 use System.OS_Interface;
48
49 ----------------------------
50 -- Thread_Block_Interrupt --
51 ----------------------------
52
53 procedure Thread_Block_Interrupt
54 (Interrupt : Interrupt_ID)
55 is
56 pragma Unreferenced (Interrupt);
57 begin
58 Raise_Exception
59 (Program_Error'Identity,
60 "Thread_Block_Interrupt unimplemented");
61 end Thread_Block_Interrupt;
62
63 ------------------------------
64 -- Thread_Unblock_Interrupt --
65 ------------------------------
66
67 procedure Thread_Unblock_Interrupt
68 (Interrupt : Interrupt_ID)
69 is
70 pragma Unreferenced (Interrupt);
71 begin
72 Raise_Exception
73 (Program_Error'Identity,
74 "Thread_Unblock_Interrupt unimplemented");
75 end Thread_Unblock_Interrupt;
76
77 ------------------------
78 -- Set_Interrupt_Mask --
79 ------------------------
80
81 procedure Set_Interrupt_Mask (Mask : access Interrupt_Mask) is
82 pragma Unreferenced (Mask);
83 begin
84 null;
85 end Set_Interrupt_Mask;
86
87 procedure Set_Interrupt_Mask
88 (Mask : access Interrupt_Mask;
89 OMask : access Interrupt_Mask)
90 is
91 pragma Unreferenced (Mask, OMask);
92 begin
93 Raise_Exception
94 (Program_Error'Identity,
95 "Set_Interrupt_Mask unimplemented");
96 end Set_Interrupt_Mask;
97
98 ------------------------
99 -- Get_Interrupt_Mask --
100 ------------------------
101
102 procedure Get_Interrupt_Mask (Mask : access Interrupt_Mask) is
103 pragma Unreferenced (Mask);
104 begin
105 Raise_Exception
106 (Program_Error'Identity,
107 "Get_Interrupt_Mask unimplemented");
108 end Get_Interrupt_Mask;
109
110 --------------------
111 -- Interrupt_Wait --
112 --------------------
113
114 function Interrupt_Wait
115 (Mask : access Interrupt_Mask) return Interrupt_ID
116 is
117 pragma Unreferenced (Mask);
118 begin
119 Raise_Exception
120 (Program_Error'Identity,
121 "Interrupt_Wait unimplemented");
122 return 0;
123 end Interrupt_Wait;
124
125 ----------------------------
126 -- Install_Default_Action --
127 ----------------------------
128
129 procedure Install_Default_Action (Interrupt : Interrupt_ID) is
130 pragma Unreferenced (Interrupt);
131 begin
132 Raise_Exception
133 (Program_Error'Identity,
134 "Install_Default_Action unimplemented");
135 end Install_Default_Action;
136
137 ---------------------------
138 -- Install_Ignore_Action --
139 ---------------------------
140
141 procedure Install_Ignore_Action (Interrupt : Interrupt_ID) is
142 pragma Unreferenced (Interrupt);
143 begin
144 Raise_Exception
145 (Program_Error'Identity,
146 "Install_Ignore_Action unimplemented");
147 end Install_Ignore_Action;
148
149 -------------------------
150 -- Fill_Interrupt_Mask --
151 -------------------------
152
153 procedure Fill_Interrupt_Mask (Mask : access Interrupt_Mask) is
154 pragma Unreferenced (Mask);
155 begin
156 Raise_Exception
157 (Program_Error'Identity,
158 "Fill_Interrupt_Mask unimplemented");
159 end Fill_Interrupt_Mask;
160
161 --------------------------
162 -- Empty_Interrupt_Mask --
163 --------------------------
164
165 procedure Empty_Interrupt_Mask (Mask : access Interrupt_Mask) is
166 pragma Unreferenced (Mask);
167 begin
168 Raise_Exception
169 (Program_Error'Identity,
170 "Empty_Interrupt_Mask unimplemented");
171 end Empty_Interrupt_Mask;
172
173 ---------------------------
174 -- Add_To_Interrupt_Mask --
175 ---------------------------
176
177 procedure Add_To_Interrupt_Mask
178 (Mask : access Interrupt_Mask;
179 Interrupt : Interrupt_ID)
180 is
181 pragma Unreferenced (Mask, Interrupt);
182 begin
183 Raise_Exception
184 (Program_Error'Identity,
185 "Add_To_Interrupt_Mask unimplemented");
186 end Add_To_Interrupt_Mask;
187
188 --------------------------------
189 -- Delete_From_Interrupt_Mask --
190 --------------------------------
191
192 procedure Delete_From_Interrupt_Mask
193 (Mask : access Interrupt_Mask;
194 Interrupt : Interrupt_ID)
195 is
196 pragma Unreferenced (Mask, Interrupt);
197 begin
198 Raise_Exception
199 (Program_Error'Identity,
200 "Delete_From_Interrupt_Mask unimplemented");
201 end Delete_From_Interrupt_Mask;
202
203 ---------------
204 -- Is_Member --
205 ---------------
206
207 function Is_Member
208 (Mask : access Interrupt_Mask;
209 Interrupt : Interrupt_ID) return Boolean
210 is
211 pragma Unreferenced (Mask, Interrupt);
212 begin
213 Raise_Exception
214 (Program_Error'Identity,
215 "Is_Member unimplemented");
216 return False;
217 end Is_Member;
218
219 -------------------------
220 -- Copy_Interrupt_Mask --
221 -------------------------
222
223 procedure Copy_Interrupt_Mask
224 (X : out Interrupt_Mask;
225 Y : Interrupt_Mask) is
226 pragma Unreferenced (X, Y);
227 begin
228 Raise_Exception
229 (Program_Error'Identity,
230 "Copy_Interrupt_Mask unimplemented");
231 end Copy_Interrupt_Mask;
232
233 ----------------------------
234 -- Interrupt_Self_Process --
235 ----------------------------
236
237 procedure Interrupt_Self_Process (Interrupt : Interrupt_ID) is
238 Result : Interfaces.C.int;
239 begin
240 Result := kill (getpid, Signal (Interrupt));
241 pragma Assert (Result = 0);
242 end Interrupt_Self_Process;
243
244 --------------------------
245 -- Setup_Interrupt_Mask --
246 --------------------------
247
248 procedure Setup_Interrupt_Mask is
249 begin
250 -- Nothing to be done. Ada interrupt facilities on VxWorks do not use
251 -- signals but hardware interrupts. Therefore, interrupt management does
252 -- not need anything related to signal masking. Note that this procedure
253 -- cannot raise an exception (as some others in this package) because
254 -- the generic implementation of the Timer_Server and timing events make
255 -- explicit calls to this routine to make ensure proper signal masking
256 -- on targets needed that.
257
258 null;
259 end Setup_Interrupt_Mask;
260
261 end System.Interrupt_Management.Operations;