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 _ M A N A G E M E N T --
10 -- Copyright (C) 1991-2002 Florida State University --
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 -- This is the GNU/Linux version of this package
38 -- This file performs the system-dependent translation between machine
39 -- exceptions and the Ada exceptions, if any, that should be raised when they
40 -- occur. This version works for the x86 running linux.
42 -- This is a Sun OS (FSU THREADS) version of this package
44 -- PLEASE DO NOT add any dependences on other packages. ??? why not ???
45 -- This package is designed to work with or without tasking support.
47 -- Make a careful study of all signals available under the OS, to see which
48 -- need to be reserved, kept always unmasked, or kept always unmasked. Be on
49 -- the lookout for special signals that may be used by the thread library.
51 -- The definitions of "reserved" differ slightly between the ARM and POSIX.
52 -- Here is the ARM definition of reserved interrupt:
54 -- The set of reserved interrupts is implementation defined. A reserved
55 -- interrupt is either an interrupt for which user-defined handlers are not
56 -- supported, or one which already has an attached handler by some other
57 -- implementation-defined means. Program units can be connected to
58 -- non-reserved interrupts.
60 -- POSIX.5b/.5c specifies further:
62 -- Signals which the application cannot accept, and for which the application
63 -- cannot modify the signal action or masking, because the signals are
64 -- reserved for use by the Ada language implementation. The reserved signals
65 -- defined by this standard are Signal_Abort, Signal_Alarm,
66 -- Signal_Floating_Point_Error, Signal_Illegal_Instruction,
67 -- Signal_Segmentation_Violation, Signal_Bus_Error. If the implementation
68 -- supports any signals besides those defined by this standard, the
69 -- implementation may also reserve some of those.
71 -- The signals defined by POSIX.5b/.5c that are not specified as being
72 -- reserved are SIGHUP, SIGINT, SIGPIPE, SIGQUIT, SIGTERM, SIGUSR1, SIGUSR2,
73 -- SIGCHLD, SIGCONT, SIGSTOP, SIGTSTP, SIGTTIN, SIGTTOU, SIGIO SIGURG, and all
74 -- the real-time signals.
76 -- Beware of reserving signals that POSIX.5b/.5c require to be available for
77 -- users. POSIX.5b/.5c say:
79 -- An implementation shall not impose restrictions on the ability of an
80 -- application to send, accept, block, or ignore the signals defined by this
81 -- standard, except as specified in this standard.
83 -- Here are some other relevant requirements from POSIX.5b/.5c:
85 -- For the environment task, the initial signal mask is that specified for
88 -- It is anticipated that the paragraph above may be modified by a future
89 -- revision of this standard, to require that the realtime signals always be
90 -- initially masked for a process that is an Ada active partition.
92 -- For all other tasks, the initial signal mask shall include all the signals
93 -- that are not reserved signals and are not bound to entries of the task.
96 -- used for int and other types
98 with System
.Error_Reporting
;
101 with System
.OS_Interface
;
102 -- used for various Constants, Signal and types
105 -- used for Exception_Id
106 -- Raise_From_Signal_Handler
108 with System
.Soft_Links
;
109 -- used for Get_Machine_State_Addr
111 with Unchecked_Conversion
;
113 package body System
.Interrupt_Management
is
116 use System
.Error_Reporting
;
117 use System
.OS_Interface
;
119 package TSL
renames System
.Soft_Links
;
121 type Interrupt_List
is array (Interrupt_ID
range <>) of Interrupt_ID
;
122 Exception_Interrupts
: constant Interrupt_List
:=
123 (SIGFPE
, SIGILL
, SIGSEGV
);
125 Unreserve_All_Interrupts
: Interfaces
.C
.int
;
127 (C
, Unreserve_All_Interrupts
, "__gl_unreserve_all_interrupts");
129 subtype int
is Interfaces
.C
.int
;
130 subtype unsigned_short
is Interfaces
.C
.unsigned_short
;
131 subtype unsigned_long
is Interfaces
.C
.unsigned_long
;
133 ----------------------
134 -- Notify_Exception --
135 ----------------------
137 Signal_Mask
: aliased sigset_t
;
138 -- The set of signals handled by Notify_Exception
140 -- This function identifies the Ada exception to be raised using
141 -- the information when the system received a synchronous signal.
142 -- Since this function is machine and OS dependent, different code
143 -- has to be provided for different target.
145 procedure Notify_Exception
159 trapno
: unsigned_long
;
163 eflags
: unsigned_long
;
164 esp_at_signal
: unsigned_long
;
166 fpstate
: System
.Address
;
167 oldmask
: unsigned_long
;
168 cr2
: unsigned_long
);
170 procedure Notify_Exception
184 trapno
: unsigned_long
;
188 eflags
: unsigned_long
;
189 esp_at_signal
: unsigned_long
;
191 fpstate
: System
.Address
;
192 oldmask
: unsigned_long
;
196 function To_Machine_State_Ptr
is new
197 Unchecked_Conversion
(Address
, Machine_State_Ptr
);
199 -- These are not directly visible
201 procedure Raise_From_Signal_Handler
202 (E
: Ada
.Exceptions
.Exception_Id
;
205 (Ada
, Raise_From_Signal_Handler
,
206 "ada__exceptions__raise_from_signal_handler");
207 pragma No_Return
(Raise_From_Signal_Handler
);
209 mstate
: Machine_State_Ptr
;
210 message
: aliased constant String := "" & ASCII
.Nul
;
211 -- a null terminated String.
217 -- Raise_From_Signal_Handler makes sure that the exception is raised
218 -- safely from this signal handler.
220 -- ??? The original signal mask (the one we had before coming into this
221 -- signal catching function) should be restored by
222 -- Raise_From_Signal_Handler. For now, restore it explicitly
224 Result
:= pthread_sigmask
(SIG_UNBLOCK
, Signal_Mask
'Access, null);
225 pragma Assert
(Result
= 0);
227 -- Check that treatment of exception propagation here
228 -- is consistent with treatment of the abort signal in
229 -- System.Task_Primitives.Operations.
231 mstate
:= To_Machine_State_Ptr
(TSL
.Get_Machine_State_Addr
.all);
234 mstate
.esp
:= esp_at_signal
;
241 Raise_From_Signal_Handler
242 (Constraint_Error
'Identity, message
'Address);
244 Raise_From_Signal_Handler
245 (Constraint_Error
'Identity, message
'Address);
247 Raise_From_Signal_Handler
248 (Storage_Error
'Identity, message
'Address);
250 if Shutdown
("Unexpected signal") then
254 end Notify_Exception
;
256 ---------------------------
257 -- Initialize_Interrupts --
258 ---------------------------
260 -- Nothing needs to be done on this platform.
262 procedure Initialize_Interrupts
is
265 end Initialize_Interrupts
;
269 act
: aliased struct_sigaction
;
270 old_act
: aliased struct_sigaction
;
275 -- Need to call pthread_init very early because it is doing signal
280 Abort_Task_Interrupt
:= SIGADAABORT
;
282 act
.sa_handler
:= Notify_Exception
'Address;
285 -- On some targets, we set sa_flags to SA_NODEFER so that during the
286 -- handler execution we do not change the Signal_Mask to be masked for
288 -- This is a temporary fix to the problem that the Signal_Mask is
289 -- not restored after the exception (longjmp) from the handler.
290 -- The right fix should be made in sigsetjmp so that we save
291 -- the Signal_Set and restore it after a longjmp.
292 -- Since SA_NODEFER is obsolete, instead we reset explicitly
293 -- the mask in the exception handler.
295 Result
:= sigemptyset
(Signal_Mask
'Access);
296 pragma Assert
(Result
= 0);
298 for J
in Exception_Interrupts
'Range loop
300 sigaddset
(Signal_Mask
'Access, Signal
(Exception_Interrupts
(J
)));
301 pragma Assert
(Result
= 0);
304 act
.sa_mask
:= Signal_Mask
;
306 for J
in Exception_Interrupts
'Range loop
307 Keep_Unmasked
(Exception_Interrupts
(J
)) := True;
310 (Signal
(Exception_Interrupts
(J
)),
311 act
'Unchecked_Access,
312 old_act
'Unchecked_Access);
313 pragma Assert
(Result
= 0);
316 Keep_Unmasked
(Abort_Task_Interrupt
) := True;
318 -- By keeping SIGINT unmasked, allow the user to do a Ctrl-C, but in the
319 -- same time, disable the ability of handling this signal
320 -- via Ada.Interrupts.
321 -- The pragma Unreserve_All_Interrupts allows the user to
322 -- change this behavior.
324 if Unreserve_All_Interrupts
= 0 then
325 Keep_Unmasked
(SIGINT
) := True;
328 for J
in Unmasked
'Range loop
329 Keep_Unmasked
(Interrupt_ID
(Unmasked
(J
))) := True;
332 Reserve
:= Keep_Unmasked
or Keep_Masked
;
334 for J
in Reserved
'Range loop
335 Reserve
(Interrupt_ID
(Reserved
(J
))) := True;
339 -- We do not have Signal 0 in reality. We just use this value
340 -- to identify non-existent signals (see s-intnam.ads). Therefore,
341 -- Signal 0 should not be used in all signal related operations hence
342 -- mark it as reserved.
345 end System
.Interrupt_Management
;