1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- SYSTEM.INTERRUPT_MANAGEMENT.OPERATIONS --
9 -- Copyright (C) 1991-2017, Florida State University --
10 -- Copyright (C) 1995-2024, AdaCore --
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. --
19 -- As a special exception under Section 7 of GPL version 3, you are granted --
20 -- additional permissions described in the GCC Runtime Library Exception, --
21 -- version 3.1, as published by the Free Software Foundation. --
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/>. --
28 -- GNARL was developed by the GNARL team at Florida State University. --
29 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
31 ------------------------------------------------------------------------------
33 -- This is a hardware interrupt version of this package. Many operations are
34 -- null as this package supports the use of Ada interrupt handling facilities
35 -- for signals, while those facilities are used for hardware interrupts on
42 with System
.OS_Interface
;
44 package body System
.Interrupt_Management
.Operations
is
48 use System
.OS_Interface
;
50 ----------------------------
51 -- Thread_Block_Interrupt --
52 ----------------------------
54 procedure Thread_Block_Interrupt
55 (Interrupt
: Interrupt_ID
)
57 pragma Unreferenced
(Interrupt
);
60 (Program_Error
'Identity,
61 "Thread_Block_Interrupt unimplemented");
62 end Thread_Block_Interrupt
;
64 ------------------------------
65 -- Thread_Unblock_Interrupt --
66 ------------------------------
68 procedure Thread_Unblock_Interrupt
69 (Interrupt
: Interrupt_ID
)
71 pragma Unreferenced
(Interrupt
);
74 (Program_Error
'Identity,
75 "Thread_Unblock_Interrupt unimplemented");
76 end Thread_Unblock_Interrupt
;
78 ------------------------
79 -- Set_Interrupt_Mask --
80 ------------------------
82 procedure Set_Interrupt_Mask
(Mask
: access Interrupt_Mask
) is
83 pragma Unreferenced
(Mask
);
86 end Set_Interrupt_Mask
;
88 procedure Set_Interrupt_Mask
89 (Mask
: access Interrupt_Mask
;
90 OMask
: access Interrupt_Mask
)
92 pragma Unreferenced
(Mask
, OMask
);
95 (Program_Error
'Identity,
96 "Set_Interrupt_Mask unimplemented");
97 end Set_Interrupt_Mask
;
99 ------------------------
100 -- Get_Interrupt_Mask --
101 ------------------------
103 procedure Get_Interrupt_Mask
(Mask
: access Interrupt_Mask
) is
104 pragma Unreferenced
(Mask
);
107 (Program_Error
'Identity,
108 "Get_Interrupt_Mask unimplemented");
109 end Get_Interrupt_Mask
;
115 function Interrupt_Wait
116 (Mask
: access Interrupt_Mask
) return Interrupt_ID
118 pragma Unreferenced
(Mask
);
121 (Program_Error
'Identity,
122 "Interrupt_Wait unimplemented");
126 ----------------------------
127 -- Install_Default_Action --
128 ----------------------------
130 procedure Install_Default_Action
(Interrupt
: Interrupt_ID
) is
131 pragma Unreferenced
(Interrupt
);
134 (Program_Error
'Identity,
135 "Install_Default_Action unimplemented");
136 end Install_Default_Action
;
138 ---------------------------
139 -- Install_Ignore_Action --
140 ---------------------------
142 procedure Install_Ignore_Action
(Interrupt
: Interrupt_ID
) is
143 pragma Unreferenced
(Interrupt
);
146 (Program_Error
'Identity,
147 "Install_Ignore_Action unimplemented");
148 end Install_Ignore_Action
;
150 -------------------------
151 -- Fill_Interrupt_Mask --
152 -------------------------
154 procedure Fill_Interrupt_Mask
(Mask
: access Interrupt_Mask
) is
155 pragma Unreferenced
(Mask
);
158 (Program_Error
'Identity,
159 "Fill_Interrupt_Mask unimplemented");
160 end Fill_Interrupt_Mask
;
162 --------------------------
163 -- Empty_Interrupt_Mask --
164 --------------------------
166 procedure Empty_Interrupt_Mask
(Mask
: access Interrupt_Mask
) is
167 pragma Unreferenced
(Mask
);
170 (Program_Error
'Identity,
171 "Empty_Interrupt_Mask unimplemented");
172 end Empty_Interrupt_Mask
;
174 ---------------------------
175 -- Add_To_Interrupt_Mask --
176 ---------------------------
178 procedure Add_To_Interrupt_Mask
179 (Mask
: access Interrupt_Mask
;
180 Interrupt
: Interrupt_ID
)
182 pragma Unreferenced
(Mask
, Interrupt
);
185 (Program_Error
'Identity,
186 "Add_To_Interrupt_Mask unimplemented");
187 end Add_To_Interrupt_Mask
;
189 --------------------------------
190 -- Delete_From_Interrupt_Mask --
191 --------------------------------
193 procedure Delete_From_Interrupt_Mask
194 (Mask
: access Interrupt_Mask
;
195 Interrupt
: Interrupt_ID
)
197 pragma Unreferenced
(Mask
, Interrupt
);
200 (Program_Error
'Identity,
201 "Delete_From_Interrupt_Mask unimplemented");
202 end Delete_From_Interrupt_Mask
;
209 (Mask
: access Interrupt_Mask
;
210 Interrupt
: Interrupt_ID
) return Boolean
212 pragma Unreferenced
(Mask
, Interrupt
);
215 (Program_Error
'Identity,
216 "Is_Member unimplemented");
220 -------------------------
221 -- Copy_Interrupt_Mask --
222 -------------------------
224 procedure Copy_Interrupt_Mask
225 (X
: out Interrupt_Mask
;
226 Y
: Interrupt_Mask
) is
227 pragma Unreferenced
(X
, Y
);
230 (Program_Error
'Identity,
231 "Copy_Interrupt_Mask unimplemented");
232 end Copy_Interrupt_Mask
;
234 ----------------------------
235 -- Interrupt_Self_Process --
236 ----------------------------
238 procedure Interrupt_Self_Process
(Interrupt
: Interrupt_ID
) is
239 Result
: Interfaces
.C
.int
;
241 Result
:= kill
(getpid
, Signal
(Interrupt
));
242 pragma Assert
(Result
= 0);
243 end Interrupt_Self_Process
;
245 --------------------------
246 -- Setup_Interrupt_Mask --
247 --------------------------
249 procedure Setup_Interrupt_Mask
is
251 -- Nothing to be done. Ada interrupt facilities on VxWorks do not use
252 -- signals but hardware interrupts. Therefore, interrupt management does
253 -- not need anything related to signal masking. Note that this procedure
254 -- cannot raise an exception (as some others in this package) because
255 -- the generic implementation of the Timer_Server and timing events make
256 -- explicit calls to this routine to make ensure proper signal masking
257 -- on targets needed that.
260 end Setup_Interrupt_Mask
;
262 end System
.Interrupt_Management
.Operations
;