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-- 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 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
37with Ada.Exceptions;
38
39with Interfaces.C;
40
41with System.OS_Interface;
42
43package 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
261end System.Interrupt_Management.Operations;
262