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
;