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 --
9 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
11 -- GNARL is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNARL; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNARL was developed by the GNARL team at Florida State University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 -- Note: the compiler generates direct calls to this interface, via Rtsfind.
35 -- Any changes to this interface may require corresponding compiler changes.
37 -- This package encapsulates the implementation of interrupt or signal
38 -- handlers. It is logically an extension of the body of Ada.Interrupts.
39 -- It is made a child of System to allow visibility of various
40 -- runtime system internal data and operations.
42 -- See System.Interrupt_Management for core interrupt/signal interfaces.
44 -- These two packages are separated in order to allow
45 -- System.Interrupt_Management to be used without requiring the whole
46 -- tasking implementation to be linked and elaborated.
51 with System
.Tasking
.Protected_Objects
.Entries
;
52 -- used for Protection_Entries
54 with System
.OS_Interface
;
55 -- used for Max_Interrupt
57 package System
.Interrupts
is
59 pragma Elaborate_Body
;
60 -- Comment needed on why this is here ???
62 -------------------------
63 -- Constants and types --
64 -------------------------
66 Default_Interrupt_Priority
: constant System
.Interrupt_Priority
:=
67 System
.Interrupt_Priority
'Last;
68 -- Default value used when a pragma Interrupt_Handler or Attach_Handler is
69 -- specified without an Interrupt_Priority pragma, see D.3(10).
71 type Ada_Interrupt_ID
is range 0 .. System
.OS_Interface
.Max_Interrupt
;
72 -- Avoid inheritance by Ada.Interrupts.Interrupt_ID of unwanted operations
74 type Interrupt_ID
is range 0 .. System
.OS_Interface
.Max_Interrupt
;
76 type Parameterless_Handler
is access protected procedure;
78 ----------------------
79 -- General services --
80 ----------------------
82 -- Attempt to attach a Handler to an Interrupt to which an Entry is
83 -- already bound will raise a Program_Error.
85 function Is_Reserved
(Interrupt
: Interrupt_ID
) return Boolean;
87 function Is_Entry_Attached
(Interrupt
: Interrupt_ID
) return Boolean;
89 function Is_Handler_Attached
(Interrupt
: Interrupt_ID
) return Boolean;
91 function Current_Handler
92 (Interrupt
: Interrupt_ID
)
93 return Parameterless_Handler
;
95 -- Calling the following procedures with New_Handler = null
96 -- and Static = true means that we want to modify the current handler
97 -- regardless of the previous handler's binding status.
98 -- (i.e. we do not care whether it is a dynamic or static handler)
100 procedure Attach_Handler
101 (New_Handler
: Parameterless_Handler
;
102 Interrupt
: Interrupt_ID
;
103 Static
: Boolean := False);
105 procedure Exchange_Handler
106 (Old_Handler
: out Parameterless_Handler
;
107 New_Handler
: Parameterless_Handler
;
108 Interrupt
: Interrupt_ID
;
109 Static
: Boolean := False);
111 procedure Detach_Handler
112 (Interrupt
: Interrupt_ID
;
113 Static
: Boolean := False);
116 (Interrupt
: Interrupt_ID
)
117 return System
.Address
;
119 ---------------------------------
120 -- Interrupt entries services --
121 ---------------------------------
123 -- Routines needed for Interrupt Entries
124 -- Attempt to bind an Entry to an Interrupt to which a Handler is
125 -- already attached will raise a Program_Error.
127 procedure Bind_Interrupt_To_Entry
128 (T
: System
.Tasking
.Task_ID
;
129 E
: System
.Tasking
.Task_Entry_Index
;
130 Int_Ref
: System
.Address
);
132 procedure Detach_Interrupt_Entries
(T
: System
.Tasking
.Task_ID
);
133 -- This procedure detaches all the Interrupt Entries bound to a task.
135 -------------------------------
136 -- POSIX.5 signals services --
137 -------------------------------
139 -- Routines needed for POSIX dot5 POSIX_Signals
141 procedure Block_Interrupt
(Interrupt
: Interrupt_ID
);
142 -- Block the Interrupt on the process level
144 procedure Unblock_Interrupt
(Interrupt
: Interrupt_ID
);
146 function Unblocked_By
147 (Interrupt
: Interrupt_ID
)
148 return System
.Tasking
.Task_ID
;
149 -- It returns the ID of the last Task which Unblocked this Interrupt.
150 -- It returns Null_Task if no tasks have ever requested the
151 -- Unblocking operation or the Interrupt is currently Blocked.
153 function Is_Blocked
(Interrupt
: Interrupt_ID
) return Boolean;
154 -- Comment needed ???
156 procedure Ignore_Interrupt
(Interrupt
: Interrupt_ID
);
157 -- Set the sigacion for the interrupt to SIG_IGN.
159 procedure Unignore_Interrupt
(Interrupt
: Interrupt_ID
);
160 -- Comment needed ???
162 function Is_Ignored
(Interrupt
: Interrupt_ID
) return Boolean;
163 -- Comment needed ???
165 -- Note : Direct calls to sigaction, sigprocmask, thr_sigsetmask or any
166 -- other low-level interface that changes the signal action or signal mask
167 -- needs a careful thought.
169 -- One may acheive the effect of system calls first making RTS blocked
170 -- (by calling Block_Interrupt) for the signal under consideration.
171 -- This will make all the tasks in RTS blocked for the Interrupt.
173 ----------------------
174 -- Protection types --
175 ----------------------
177 -- Routines and types needed to implement Interrupt_Handler and
180 -- There are two kinds of protected objects that deal with interrupts:
182 -- (1) Only Interrupt_Handler pragmas are used. We need to be able to
183 -- tell if an Interrupt_Handler applies to a given procedure, so
184 -- Register_Interrupt_Handler has to be called for all the potential
185 -- handlers, it should be done by calling Register_Interrupt_Handler
186 -- with the handler code address. On finalization, which can happen only
187 -- has part of library level finalization since PO with
188 -- Interrupt_Handler pragmas can only be declared at library level,
189 -- nothing special needs to be done since the default handlers have been
190 -- restored as part of task completion which is done just before global
191 -- finalization. Dynamic_Interrupt_Protection should be used in this
194 -- (2) Attach_Handler pragmas are used, and possibly Interrupt_Handler
195 -- pragma. We need to attach the handlers to the given interrupts when
196 -- the objet is elaborated. This should be done by constructing an array
197 -- of pairs (interrupt, handler) from the pragmas and calling
198 -- Install_Handlers with it (types to be used are New_Handler_Item and
199 -- New_Handler_Array). On finalization, we need to restore the handlers
200 -- that were installed before the elaboration of the PO, so we need to
201 -- store these previous handlers. This is also done by Install_Handlers,
202 -- the room for these informations is provided by adding a discriminant
203 -- which is the number of Attach_Handler pragmas and an array of this
204 -- size in the protection type, Static_Interrupt_Protection.
206 procedure Register_Interrupt_Handler
207 (Handler_Addr
: System
.Address
);
208 -- This routine should be called by the compiler to allow the
209 -- handler be used as an Interrupt Handler. That means call this
210 -- procedure for each pragma Interrup_Handler providing the
211 -- address of the handler (not including the pointer to the
212 -- actual PO, this way this routine is called only once for
213 -- each type definition of PO).
215 type Static_Handler_Index
is range 0 .. Integer'Last;
216 subtype Positive_Static_Handler_Index
is
217 Static_Handler_Index
range 1 .. Static_Handler_Index
'Last;
218 -- Comment needed ???
220 type Previous_Handler_Item
is record
221 Interrupt
: Interrupt_ID
;
222 Handler
: Parameterless_Handler
;
225 -- Contains all the information needed to restore a previous handler.
227 type Previous_Handler_Array
is array
228 (Positive_Static_Handler_Index
range <>) of Previous_Handler_Item
;
230 type New_Handler_Item
is record
231 Interrupt
: Interrupt_ID
;
232 Handler
: Parameterless_Handler
;
234 -- Contains all the information from an Attach_Handler pragma.
236 type New_Handler_Array
is
237 array (Positive_Static_Handler_Index
range <>) of New_Handler_Item
;
238 -- Comment needed ???
242 type Dynamic_Interrupt_Protection
is new
243 Tasking
.Protected_Objects
.Entries
.Protection_Entries
with null record;
245 -- ??? Finalize is not overloaded since we currently have no
246 -- way to detach the handlers during library level finalization.
248 function Has_Interrupt_Or_Attach_Handler
249 (Object
: access Dynamic_Interrupt_Protection
) return Boolean;
254 type Static_Interrupt_Protection
255 (Num_Entries
: Tasking
.Protected_Objects
.Protected_Entry_Index
;
256 Num_Attach_Handler
: Static_Handler_Index
)
258 Tasking
.Protected_Objects
.Entries
.Protection_Entries
(Num_Entries
) with
260 Previous_Handlers
: Previous_Handler_Array
(1 .. Num_Attach_Handler
);
263 function Has_Interrupt_Or_Attach_Handler
264 (Object
: access Static_Interrupt_Protection
)
268 procedure Finalize
(Object
: in out Static_Interrupt_Protection
);
269 -- Restore previous handlers as required by C.3.1(12) then call
270 -- Finalize (Protection).
272 procedure Install_Handlers
273 (Object
: access Static_Interrupt_Protection
;
274 New_Handlers
: in New_Handler_Array
);
275 -- Store the old handlers in Object.Previous_Handlers and install
276 -- the new static handlers.
278 end System
.Interrupts
;