1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- S Y S T E M . I N T E R R U P T S --
9 -- Copyright (C) 1991-1994, Florida State University --
10 -- Copyright (C) 1995-2005, AdaCore --
12 -- GNARL 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 2, or (at your option) any later ver- --
15 -- sion. GNARL 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. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNARL; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
21 -- Boston, MA 02110-1301, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNARL was developed by the GNARL team at Florida State University. --
31 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
33 ------------------------------------------------------------------------------
35 -- This version is for systems that do not support interrupts (or signals)
39 package body System.Interrupts is
41 pragma Warnings (Off); -- kill warnings on unreferenced formals
45 -----------------------
46 -- Local Subprograms --
47 -----------------------
49 procedure Unimplemented;
50 -- This procedure raises a Program_Error with an appropriate message
51 -- indicating that an unimplemented feature has been used.
57 procedure Attach_Handler
58 (New_Handler : Parameterless_Handler;
59 Interrupt : Interrupt_ID;
60 Static : Boolean := False)
66 -----------------------------
67 -- Bind_Interrupt_To_Entry --
68 -----------------------------
70 procedure Bind_Interrupt_To_Entry
73 Int_Ref : System.Address)
77 end Bind_Interrupt_To_Entry;
83 procedure Block_Interrupt (Interrupt : Interrupt_ID) is
92 function Current_Handler
93 (Interrupt : Interrupt_ID) return Parameterless_Handler
104 procedure Detach_Handler
105 (Interrupt : Interrupt_ID;
106 Static : Boolean := False)
112 ------------------------------
113 -- Detach_Interrupt_Entries --
114 ------------------------------
116 procedure Detach_Interrupt_Entries (T : Task_Id) is
119 end Detach_Interrupt_Entries;
121 ----------------------
122 -- Exchange_Handler --
123 ----------------------
125 procedure Exchange_Handler
126 (Old_Handler : out Parameterless_Handler;
127 New_Handler : Parameterless_Handler;
128 Interrupt : Interrupt_ID;
129 Static : Boolean := False)
134 end Exchange_Handler;
140 procedure Finalize (Object : in out Static_Interrupt_Protection) is
145 -------------------------------------
146 -- Has_Interrupt_Or_Attach_Handler --
147 -------------------------------------
149 function Has_Interrupt_Or_Attach_Handler
150 (Object : access Dynamic_Interrupt_Protection)
153 pragma Warnings (Off, Object);
157 end Has_Interrupt_Or_Attach_Handler;
159 function Has_Interrupt_Or_Attach_Handler
160 (Object : access Static_Interrupt_Protection)
163 pragma Warnings (Off, Object);
167 end Has_Interrupt_Or_Attach_Handler;
169 ----------------------
170 -- Ignore_Interrupt --
171 ----------------------
173 procedure Ignore_Interrupt (Interrupt : Interrupt_ID) is
176 end Ignore_Interrupt;
178 ----------------------
179 -- Install_Handlers --
180 ----------------------
182 procedure Install_Handlers
183 (Object : access Static_Interrupt_Protection;
184 New_Handlers : New_Handler_Array)
188 end Install_Handlers;
194 function Is_Blocked (Interrupt : Interrupt_ID) return Boolean is
200 -----------------------
201 -- Is_Entry_Attached --
202 -----------------------
204 function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is
208 end Is_Entry_Attached;
210 -------------------------
211 -- Is_Handler_Attached --
212 -------------------------
214 function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is
218 end Is_Handler_Attached;
224 function Is_Ignored (Interrupt : Interrupt_ID) return Boolean is
234 function Is_Reserved (Interrupt : Interrupt_ID) return Boolean is
244 function Reference (Interrupt : Interrupt_ID) return System.Address is
247 return Interrupt'Address;
250 --------------------------------
251 -- Register_Interrupt_Handler --
252 --------------------------------
254 procedure Register_Interrupt_Handler
255 (Handler_Addr : System.Address)
259 end Register_Interrupt_Handler;
261 -----------------------
262 -- Unblock_Interrupt --
263 -----------------------
265 procedure Unblock_Interrupt (Interrupt : Interrupt_ID) is
268 end Unblock_Interrupt;
274 function Unblocked_By (Interrupt : Interrupt_ID)
275 return System.Tasking.Task_Id is
281 ------------------------
282 -- Unignore_Interrupt --
283 ------------------------
285 procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is
288 end Unignore_Interrupt;
294 procedure Unimplemented is
296 Ada.Exceptions.Raise_Exception
297 (Program_Error'Identity, "interrupts/signals not implemented");
301 end System.Interrupts;