File : s-intman-susv3.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
4 -- --
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 --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
10 -- --
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 3, or (at your option) any later ver- --
14 -- sion. GNAT 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. --
17 -- --
18 -- --
19 -- --
20 -- --
21 -- --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
26 -- --
27 -- GNARL was developed by the GNARL team at Florida State University. --
28 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
29 -- --
30 ------------------------------------------------------------------------------
31
32 -- This is the SuSV3 threads version of this package
33
34 -- Make a careful study of all signals available under the OS, to see which
35 -- need to be reserved, kept always unmasked, or kept always unmasked. Be on
36 -- the lookout for special signals that may be used by the thread library.
37
38 -- Since this is a multi target file, the signal <-> exception mapping
39 -- is simple minded. If you need a more precise and target specific
40 -- signal handling, create a new s-intman.adb that will fit your needs.
41
42 -- This file assumes that:
43
44 -- SIGINT exists and will be kept unmasked unless the pragma
45 -- Unreserve_All_Interrupts is specified anywhere in the application.
46
47 -- System.OS_Interface contains the following:
48 -- SIGADAABORT: the signal that will be used to abort tasks.
49 -- Unmasked: the OS specific set of signals that should be unmasked in
50 -- all the threads. SIGADAABORT is unmasked by
51 -- default
52 -- Reserved: the OS specific set of signals that are reserved.
53
54 package body System.Interrupt_Management is
55
56 use Interfaces.C;
57 use System.OS_Interface;
58
59 Unreserve_All_Interrupts : Interfaces.C.int;
60 pragma Import
61 (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
62
63 -----------------------
64 -- Local Subprograms --
65 -----------------------
66
67 function State (Int : Interrupt_ID) return Character;
68 pragma Import (C, State, "__gnat_get_interrupt_state");
69 -- Get interrupt state. Defined in init.c The input argument is the
70 -- interrupt number, and the result is one of the following:
71
72 User : constant Character := 'u';
73 Runtime : constant Character := 'r';
74 Default : constant Character := 's';
75 -- 'n' this interrupt not set by any Interrupt_State pragma
76 -- 'u' Interrupt_State pragma set state to User
77 -- 'r' Interrupt_State pragma set state to Runtime
78 -- 's' Interrupt_State pragma set state to System (use "default"
79 -- system handler)
80
81 ----------------
82 -- Initialize --
83 ----------------
84
85 Initialized : Boolean := False;
86
87 procedure Initialize is
88 begin
89 if Initialized then
90 return;
91 end if;
92
93 Initialized := True;
94
95 -- Need to call pthread_init very early because it is doing signal
96 -- initializations.
97
98 pthread_init;
99
100 Abort_Task_Interrupt := SIGADAABORT;
101
102 pragma Assert (Keep_Unmasked = (Interrupt_ID'Range => False));
103 pragma Assert (Reserve = (Interrupt_ID'Range => False));
104
105 -- Process state of exception signals
106
107 for J in Exception_Signals'Range loop
108 declare
109 Sig : constant Signal := Exception_Signals (J);
110 Id : constant Interrupt_ID := Interrupt_ID (Sig);
111 begin
112 if State (Id) /= User then
113 Keep_Unmasked (Id) := True;
114 Reserve (Id) := True;
115 end if;
116 end;
117 end loop;
118
119 if State (Abort_Task_Interrupt) /= User then
120 Keep_Unmasked (Abort_Task_Interrupt) := True;
121 Reserve (Abort_Task_Interrupt) := True;
122 end if;
123
124 -- Set SIGINT to unmasked state as long as it is not in "User" state.
125 -- Check for Unreserve_All_Interrupts last.
126
127 if State (SIGINT) /= User then
128 Keep_Unmasked (SIGINT) := True;
129 Reserve (SIGINT) := True;
130 end if;
131
132 -- Check all signals for state that requires keeping them unmasked and
133 -- reserved.
134
135 for J in Interrupt_ID'Range loop
136 if State (J) = Default or else State (J) = Runtime then
137 Keep_Unmasked (J) := True;
138 Reserve (J) := True;
139 end if;
140 end loop;
141
142 -- Add the set of signals that must always be unmasked for this target
143
144 for J in Unmasked'Range loop
145 Keep_Unmasked (Interrupt_ID (Unmasked (J))) := True;
146 Reserve (Interrupt_ID (Unmasked (J))) := True;
147 end loop;
148
149 -- Add target-specific reserved signals
150
151 for J in Reserved'Range loop
152 Reserve (Interrupt_ID (Reserved (J))) := True;
153 end loop;
154
155 -- Process pragma Unreserve_All_Interrupts. This overrides any settings
156 -- due to pragma Interrupt_State:
157
158 if Unreserve_All_Interrupts /= 0 then
159 Keep_Unmasked (SIGINT) := False;
160 Reserve (SIGINT) := False;
161 end if;
162
163 -- We do not really have Signal 0. We just use this value to identify
164 -- non-existent signals (see s-intnam.ads). Therefore, Signal should not
165 -- be used in all signal related operations hence mark it as reserved.
166
167 Reserve (0) := True;
168 end Initialize;
169
170 end System.Interrupt_Management;