1 ------------------------------------------------------------------------------
3 -- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- S Y S T E M . I N T E R R U P T S --
11 -- Copyright (C) 1991-2000 Florida State University --
13 -- GNARL is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNARL; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- As a special exception, if other files instantiate generics from this --
25 -- unit, or you link this unit with other files to produce an executable, --
26 -- this unit does not by itself cause the resulting executable to be --
27 -- covered by the GNU General Public License. This exception does not --
28 -- however invalidate any other reasons why the executable file might be --
29 -- covered by the GNU Public License. --
31 -- GNARL was developed by the GNARL team at Florida State University. It is --
32 -- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
33 -- State University (http://www.gnat.com). --
35 ------------------------------------------------------------------------------
37 -- This is an OS/2 version of this package.
39 -- This version is a stub, for systems that
40 -- do not support interrupts (or signals).
44 package body System
.Interrupts
is
48 -----------------------
49 -- Local Subprograms --
50 -----------------------
52 procedure Unimplemented
;
53 -- This procedure raises a Program_Error with an appropriate message
54 -- indicating that an unimplemented feature has been used.
60 procedure Attach_Handler
61 (New_Handler
: in Parameterless_Handler
;
62 Interrupt
: in Interrupt_ID
;
63 Static
: in Boolean := False)
69 -----------------------------
70 -- Bind_Interrupt_To_Entry --
71 -----------------------------
73 procedure Bind_Interrupt_To_Entry
76 Int_Ref
: System
.Address
)
80 end Bind_Interrupt_To_Entry
;
86 procedure Block_Interrupt
(Interrupt
: Interrupt_ID
) is
95 function Current_Handler
96 (Interrupt
: Interrupt_ID
)
97 return Parameterless_Handler
108 procedure Detach_Handler
109 (Interrupt
: in Interrupt_ID
;
110 Static
: in Boolean := False)
116 ------------------------------
117 -- Detach_Interrupt_Entries --
118 ------------------------------
120 procedure Detach_Interrupt_Entries
(T
: Task_ID
) is
123 end Detach_Interrupt_Entries
;
125 ----------------------
126 -- Exchange_Handler --
127 ----------------------
129 procedure Exchange_Handler
130 (Old_Handler
: out Parameterless_Handler
;
131 New_Handler
: in Parameterless_Handler
;
132 Interrupt
: in Interrupt_ID
;
133 Static
: in Boolean := False)
138 end Exchange_Handler
;
144 procedure Finalize
(Object
: in out Static_Interrupt_Protection
) is
149 -------------------------------------
150 -- Has_Interrupt_Or_Attach_Handler --
151 -------------------------------------
153 function Has_Interrupt_Or_Attach_Handler
154 (Object
: access Dynamic_Interrupt_Protection
)
160 end Has_Interrupt_Or_Attach_Handler
;
162 function Has_Interrupt_Or_Attach_Handler
163 (Object
: access Static_Interrupt_Protection
)
169 end Has_Interrupt_Or_Attach_Handler
;
171 ----------------------
172 -- Ignore_Interrupt --
173 ----------------------
175 procedure Ignore_Interrupt
(Interrupt
: Interrupt_ID
) is
178 end Ignore_Interrupt
;
180 ----------------------
181 -- Install_Handlers --
182 ----------------------
184 procedure Install_Handlers
185 (Object
: access Static_Interrupt_Protection
;
186 New_Handlers
: in New_Handler_Array
)
190 end Install_Handlers
;
196 function Is_Blocked
(Interrupt
: Interrupt_ID
) return Boolean is
202 -----------------------
203 -- Is_Entry_Attached --
204 -----------------------
206 function Is_Entry_Attached
(Interrupt
: Interrupt_ID
) return Boolean is
210 end Is_Entry_Attached
;
212 -------------------------
213 -- Is_Handler_Attached --
214 -------------------------
216 function Is_Handler_Attached
(Interrupt
: Interrupt_ID
) return Boolean is
220 end Is_Handler_Attached
;
226 function Is_Ignored
(Interrupt
: Interrupt_ID
) return Boolean is
236 function Is_Reserved
(Interrupt
: Interrupt_ID
) return Boolean is
246 function Reference
(Interrupt
: Interrupt_ID
) return System
.Address
is
249 return Interrupt
'Address;
252 --------------------------------
253 -- Register_Interrupt_Handler --
254 --------------------------------
256 procedure Register_Interrupt_Handler
257 (Handler_Addr
: System
.Address
)
261 end Register_Interrupt_Handler
;
263 -----------------------
264 -- Unblock_Interrupt --
265 -----------------------
267 procedure Unblock_Interrupt
(Interrupt
: Interrupt_ID
) is
270 end Unblock_Interrupt
;
276 function Unblocked_By
(Interrupt
: Interrupt_ID
)
277 return System
.Tasking
.Task_ID
is
283 ------------------------
284 -- Unignore_Interrupt --
285 ------------------------
287 procedure Unignore_Interrupt
(Interrupt
: Interrupt_ID
) is
290 end Unignore_Interrupt
;
296 procedure Unimplemented
is
298 Ada
.Exceptions
.Raise_Exception
299 (Program_Error
'Identity, "interrupts/signals not implemented");
303 end System
.Interrupts
;