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-2017, Florida State University            --
10--                     Copyright (C) 1995-2021, 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-- 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.               --
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 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
36--  these targets.
37
38with Ada.Exceptions;
39
40with Interfaces.C;
41
42with System.OS_Interface;
43
44package body System.Interrupt_Management.Operations is
45
46   use Ada.Exceptions;
47   use Interfaces.C;
48   use System.OS_Interface;
49
50   ----------------------------
51   -- Thread_Block_Interrupt --
52   ----------------------------
53
54   procedure Thread_Block_Interrupt
55     (Interrupt : Interrupt_ID)
56   is
57      pragma Unreferenced (Interrupt);
58   begin
59      Raise_Exception
60        (Program_Error'Identity,
61         "Thread_Block_Interrupt unimplemented");
62   end Thread_Block_Interrupt;
63
64   ------------------------------
65   -- Thread_Unblock_Interrupt --
66   ------------------------------
67
68   procedure Thread_Unblock_Interrupt
69     (Interrupt : Interrupt_ID)
70   is
71      pragma Unreferenced (Interrupt);
72   begin
73      Raise_Exception
74        (Program_Error'Identity,
75         "Thread_Unblock_Interrupt unimplemented");
76   end Thread_Unblock_Interrupt;
77
78   ------------------------
79   -- Set_Interrupt_Mask --
80   ------------------------
81
82   procedure Set_Interrupt_Mask (Mask : access Interrupt_Mask) is
83      pragma Unreferenced (Mask);
84   begin
85      null;
86   end Set_Interrupt_Mask;
87
88   procedure Set_Interrupt_Mask
89     (Mask  : access Interrupt_Mask;
90      OMask : access Interrupt_Mask)
91   is
92      pragma Unreferenced (Mask, OMask);
93   begin
94      Raise_Exception
95        (Program_Error'Identity,
96         "Set_Interrupt_Mask unimplemented");
97   end Set_Interrupt_Mask;
98
99   ------------------------
100   -- Get_Interrupt_Mask --
101   ------------------------
102
103   procedure Get_Interrupt_Mask (Mask : access Interrupt_Mask) is
104      pragma Unreferenced (Mask);
105   begin
106      Raise_Exception
107        (Program_Error'Identity,
108         "Get_Interrupt_Mask unimplemented");
109   end Get_Interrupt_Mask;
110
111   --------------------
112   -- Interrupt_Wait --
113   --------------------
114
115   function Interrupt_Wait
116     (Mask : access Interrupt_Mask) return Interrupt_ID
117   is
118      pragma Unreferenced (Mask);
119   begin
120      Raise_Exception
121        (Program_Error'Identity,
122         "Interrupt_Wait unimplemented");
123      return 0;
124   end Interrupt_Wait;
125
126   ----------------------------
127   -- Install_Default_Action --
128   ----------------------------
129
130   procedure Install_Default_Action (Interrupt : Interrupt_ID) is
131      pragma Unreferenced (Interrupt);
132   begin
133      Raise_Exception
134        (Program_Error'Identity,
135         "Install_Default_Action unimplemented");
136   end Install_Default_Action;
137
138   ---------------------------
139   -- Install_Ignore_Action --
140   ---------------------------
141
142   procedure Install_Ignore_Action (Interrupt : Interrupt_ID) is
143      pragma Unreferenced (Interrupt);
144   begin
145      Raise_Exception
146        (Program_Error'Identity,
147         "Install_Ignore_Action unimplemented");
148   end Install_Ignore_Action;
149
150   -------------------------
151   -- Fill_Interrupt_Mask --
152   -------------------------
153
154   procedure Fill_Interrupt_Mask (Mask : access Interrupt_Mask) is
155      pragma Unreferenced (Mask);
156   begin
157      Raise_Exception
158        (Program_Error'Identity,
159         "Fill_Interrupt_Mask unimplemented");
160   end Fill_Interrupt_Mask;
161
162   --------------------------
163   -- Empty_Interrupt_Mask --
164   --------------------------
165
166   procedure Empty_Interrupt_Mask (Mask : access Interrupt_Mask) is
167      pragma Unreferenced (Mask);
168   begin
169      Raise_Exception
170        (Program_Error'Identity,
171         "Empty_Interrupt_Mask unimplemented");
172   end Empty_Interrupt_Mask;
173
174   ---------------------------
175   -- Add_To_Interrupt_Mask --
176   ---------------------------
177
178   procedure Add_To_Interrupt_Mask
179     (Mask      : access Interrupt_Mask;
180      Interrupt : Interrupt_ID)
181   is
182      pragma Unreferenced (Mask, Interrupt);
183   begin
184      Raise_Exception
185        (Program_Error'Identity,
186         "Add_To_Interrupt_Mask unimplemented");
187   end Add_To_Interrupt_Mask;
188
189   --------------------------------
190   -- Delete_From_Interrupt_Mask --
191   --------------------------------
192
193   procedure Delete_From_Interrupt_Mask
194     (Mask      : access Interrupt_Mask;
195      Interrupt : Interrupt_ID)
196   is
197      pragma Unreferenced (Mask, Interrupt);
198   begin
199      Raise_Exception
200        (Program_Error'Identity,
201         "Delete_From_Interrupt_Mask unimplemented");
202   end Delete_From_Interrupt_Mask;
203
204   ---------------
205   -- Is_Member --
206   ---------------
207
208   function Is_Member
209     (Mask      : access Interrupt_Mask;
210      Interrupt : Interrupt_ID) return Boolean
211   is
212      pragma Unreferenced (Mask, Interrupt);
213   begin
214      Raise_Exception
215        (Program_Error'Identity,
216         "Is_Member unimplemented");
217      return False;
218   end Is_Member;
219
220   -------------------------
221   -- Copy_Interrupt_Mask --
222   -------------------------
223
224   procedure Copy_Interrupt_Mask
225     (X : out Interrupt_Mask;
226      Y : Interrupt_Mask) is
227      pragma Unreferenced (X, Y);
228   begin
229      Raise_Exception
230        (Program_Error'Identity,
231         "Copy_Interrupt_Mask unimplemented");
232   end Copy_Interrupt_Mask;
233
234   ----------------------------
235   -- Interrupt_Self_Process --
236   ----------------------------
237
238   procedure Interrupt_Self_Process (Interrupt : Interrupt_ID) is
239      Result : Interfaces.C.int;
240   begin
241      Result := kill (getpid, Signal (Interrupt));
242      pragma Assert (Result = 0);
243   end Interrupt_Self_Process;
244
245   --------------------------
246   -- Setup_Interrupt_Mask --
247   --------------------------
248
249   procedure Setup_Interrupt_Mask is
250   begin
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.
258
259      null;
260   end Setup_Interrupt_Mask;
261
262end System.Interrupt_Management.Operations;
263