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 --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
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, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, 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. It is --
31 -- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
32 -- State University (http://www.gnat.com). --
34 ------------------------------------------------------------------------------
36 -- Note: the compiler generates direct calls to this interface, via Rtsfind.
37 -- Any changes to this interface may require corresponding compiler changes.
39 -- This package encapsulates the implementation of interrupt or signal
40 -- handlers. It is logically an extension of the body of Ada.Interrupts.
41 -- It is made a child of System to allow visibility of various
42 -- runtime system internal data and operations.
44 -- See System.Interrupt_Management for core interrupt/signal interfaces.
46 -- These two packages are separated in order to allow
47 -- System.Interrupt_Management to be used without requiring the whole
48 -- tasking implementation to be linked and elaborated.
53 with System
.Tasking
.Protected_Objects
.Entries
;
54 -- used for Protection_Entries
56 with System
.OS_Interface
;
57 -- used for Max_Interrupt
59 package System
.Interrupts
is
61 pragma Elaborate_Body
;
62 -- Comment needed on why this is here ???
64 -------------------------
65 -- Constants and types --
66 -------------------------
68 Default_Interrupt_Priority
: constant System
.Interrupt_Priority
:=
69 System
.Interrupt_Priority
'Last;
70 -- Default value used when a pragma Interrupt_Handler or Attach_Handler is
71 -- specified without an Interrupt_Priority pragma, see D.3(10).
73 type Ada_Interrupt_ID
is range 0 .. System
.OS_Interface
.Max_Interrupt
;
74 -- Avoid inheritance by Ada.Interrupts.Interrupt_ID of unwanted operations
76 type Interrupt_ID
is range 0 .. System
.OS_Interface
.Max_Interrupt
;
78 type Parameterless_Handler
is access protected procedure;
80 ----------------------
81 -- General services --
82 ----------------------
84 -- Attempt to attach a Handler to an Interrupt to which an Entry is
85 -- already bound will raise a Program_Error.
87 function Is_Reserved
(Interrupt
: Interrupt_ID
) return Boolean;
89 function Is_Entry_Attached
(Interrupt
: Interrupt_ID
) return Boolean;
91 function Is_Handler_Attached
(Interrupt
: Interrupt_ID
) return Boolean;
93 function Current_Handler
94 (Interrupt
: Interrupt_ID
)
95 return Parameterless_Handler
;
97 -- Calling the following procedures with New_Handler = null
98 -- and Static = true means that we want to modify the current handler
99 -- regardless of the previous handler's binding status.
100 -- (i.e. we do not care whether it is a dynamic or static handler)
102 procedure Attach_Handler
103 (New_Handler
: Parameterless_Handler
;
104 Interrupt
: Interrupt_ID
;
105 Static
: Boolean := False);
107 procedure Exchange_Handler
108 (Old_Handler
: out Parameterless_Handler
;
109 New_Handler
: Parameterless_Handler
;
110 Interrupt
: Interrupt_ID
;
111 Static
: Boolean := False);
113 procedure Detach_Handler
114 (Interrupt
: Interrupt_ID
;
115 Static
: Boolean := False);
118 (Interrupt
: Interrupt_ID
)
119 return System
.Address
;
121 ---------------------------------
122 -- Interrupt entries services --
123 ---------------------------------
125 -- Routines needed for Interrupt Entries
126 -- Attempt to bind an Entry to an Interrupt to which a Handler is
127 -- already attached will raise a Program_Error.
129 procedure Bind_Interrupt_To_Entry
130 (T
: System
.Tasking
.Task_ID
;
131 E
: System
.Tasking
.Task_Entry_Index
;
132 Int_Ref
: System
.Address
);
134 procedure Detach_Interrupt_Entries
(T
: System
.Tasking
.Task_ID
);
135 -- This procedure detaches all the Interrupt Entries bound to a task.
137 -------------------------------
138 -- POSIX.5 signals services --
139 -------------------------------
141 -- Routines needed for POSIX dot5 POSIX_Signals
143 procedure Block_Interrupt
(Interrupt
: Interrupt_ID
);
144 -- Block the Interrupt on the process level
146 procedure Unblock_Interrupt
(Interrupt
: Interrupt_ID
);
148 function Unblocked_By
149 (Interrupt
: Interrupt_ID
)
150 return System
.Tasking
.Task_ID
;
151 -- It returns the ID of the last Task which Unblocked this Interrupt.
152 -- It returns Null_Task if no tasks have ever requested the
153 -- Unblocking operation or the Interrupt is currently Blocked.
155 function Is_Blocked
(Interrupt
: Interrupt_ID
) return Boolean;
156 -- Comment needed ???
158 procedure Ignore_Interrupt
(Interrupt
: Interrupt_ID
);
159 -- Set the sigacion for the interrupt to SIG_IGN.
161 procedure Unignore_Interrupt
(Interrupt
: Interrupt_ID
);
162 -- Comment needed ???
164 function Is_Ignored
(Interrupt
: Interrupt_ID
) return Boolean;
165 -- Comment needed ???
167 -- Note : Direct calls to sigaction, sigprocmask, thr_sigsetmask or any
168 -- other low-level interface that changes the signal action or signal mask
169 -- needs a careful thought.
171 -- One may acheive the effect of system calls first making RTS blocked
172 -- (by calling Block_Interrupt) for the signal under consideration.
173 -- This will make all the tasks in RTS blocked for the Interrupt.
175 ----------------------
176 -- Protection types --
177 ----------------------
179 -- Routines and types needed to implement Interrupt_Handler and
182 -- There are two kinds of protected objects that deal with interrupts:
184 -- (1) Only Interrupt_Handler pragmas are used. We need to be able to
185 -- tell if an Interrupt_Handler applies to a given procedure, so
186 -- Register_Interrupt_Handler has to be called for all the potential
187 -- handlers, it should be done by calling Register_Interrupt_Handler
188 -- with the handler code address. On finalization, which can happen only
189 -- has part of library level finalization since PO with
190 -- Interrupt_Handler pragmas can only be declared at library level,
191 -- nothing special needs to be done since the default handlers have been
192 -- restored as part of task completion which is done just before global
193 -- finalization. Dynamic_Interrupt_Protection should be used in this
196 -- (2) Attach_Handler pragmas are used, and possibly Interrupt_Handler
197 -- pragma. We need to attach the handlers to the given interrupts when
198 -- the objet is elaborated. This should be done by constructing an array
199 -- of pairs (interrupt, handler) from the pragmas and calling
200 -- Install_Handlers with it (types to be used are New_Handler_Item and
201 -- New_Handler_Array). On finalization, we need to restore the handlers
202 -- that were installed before the elaboration of the PO, so we need to
203 -- store these previous handlers. This is also done by Install_Handlers,
204 -- the room for these informations is provided by adding a discriminant
205 -- which is the number of Attach_Handler pragmas and an array of this
206 -- size in the protection type, Static_Interrupt_Protection.
208 procedure Register_Interrupt_Handler
209 (Handler_Addr
: System
.Address
);
210 -- This routine should be called by the compiler to allow the
211 -- handler be used as an Interrupt Handler. That means call this
212 -- procedure for each pragma Interrup_Handler providing the
213 -- address of the handler (not including the pointer to the
214 -- actual PO, this way this routine is called only once for
215 -- each type definition of PO).
217 type Static_Handler_Index
is range 0 .. Integer'Last;
218 subtype Positive_Static_Handler_Index
is
219 Static_Handler_Index
range 1 .. Static_Handler_Index
'Last;
220 -- Comment needed ???
222 type Previous_Handler_Item
is record
223 Interrupt
: Interrupt_ID
;
224 Handler
: Parameterless_Handler
;
227 -- Contains all the information needed to restore a previous handler.
229 type Previous_Handler_Array
is array
230 (Positive_Static_Handler_Index
range <>) of Previous_Handler_Item
;
232 type New_Handler_Item
is record
233 Interrupt
: Interrupt_ID
;
234 Handler
: Parameterless_Handler
;
236 -- Contains all the information from an Attach_Handler pragma.
238 type New_Handler_Array
is
239 array (Positive_Static_Handler_Index
range <>) of New_Handler_Item
;
240 -- Comment needed ???
244 type Dynamic_Interrupt_Protection
is new
245 Tasking
.Protected_Objects
.Entries
.Protection_Entries
with null record;
247 -- ??? Finalize is not overloaded since we currently have no
248 -- way to detach the handlers during library level finalization.
250 function Has_Interrupt_Or_Attach_Handler
251 (Object
: access Dynamic_Interrupt_Protection
) return Boolean;
256 type Static_Interrupt_Protection
257 (Num_Entries
: Tasking
.Protected_Objects
.Protected_Entry_Index
;
258 Num_Attach_Handler
: Static_Handler_Index
)
260 Tasking
.Protected_Objects
.Entries
.Protection_Entries
(Num_Entries
) with
262 Previous_Handlers
: Previous_Handler_Array
(1 .. Num_Attach_Handler
);
265 function Has_Interrupt_Or_Attach_Handler
266 (Object
: access Static_Interrupt_Protection
)
270 procedure Finalize
(Object
: in out Static_Interrupt_Protection
);
271 -- Restore previous handlers as required by C.3.1(12) then call
272 -- Finalize (Protection).
274 procedure Install_Handlers
275 (Object
: access Static_Interrupt_Protection
;
276 New_Handlers
: in New_Handler_Array
);
277 -- Store the old handlers in Object.Previous_Handlers and install
278 -- the new static handlers.
280 end System
.Interrupts
;