Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/libgnarl/s-intman__solaris.adb @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
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-2017, 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 -- As a special exception under Section 7 of GPL version 3, you are granted -- | |
19 -- additional permissions described in the GCC Runtime Library Exception, -- | |
20 -- version 3.1, as published by the Free Software Foundation. -- | |
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 a Solaris 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. | |
36 | |
37 -- Be on the lookout for special signals that may be used by the thread | |
38 -- library. | |
39 | |
40 package body System.Interrupt_Management is | |
41 | |
42 use Interfaces.C; | |
43 use System.OS_Interface; | |
44 | |
45 type Interrupt_List is array (Interrupt_ID range <>) of Interrupt_ID; | |
46 | |
47 Exception_Interrupts : constant Interrupt_List := | |
48 (SIGFPE, SIGILL, SIGSEGV, SIGBUS); | |
49 | |
50 Unreserve_All_Interrupts : Interfaces.C.int; | |
51 pragma Import | |
52 (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts"); | |
53 | |
54 function State (Int : Interrupt_ID) return Character; | |
55 pragma Import (C, State, "__gnat_get_interrupt_state"); | |
56 -- Get interrupt state. Defined in init.c | |
57 -- The input argument is the interrupt number, | |
58 -- and the result is one of the following: | |
59 | |
60 User : constant Character := 'u'; | |
61 Runtime : constant Character := 'r'; | |
62 Default : constant Character := 's'; | |
63 -- 'n' this interrupt not set by any Interrupt_State pragma | |
64 -- 'u' Interrupt_State pragma set state to User | |
65 -- 'r' Interrupt_State pragma set state to Runtime | |
66 -- 's' Interrupt_State pragma set state to System (use "default" | |
67 -- system handler) | |
68 | |
69 ---------------------- | |
70 -- Notify_Exception -- | |
71 ---------------------- | |
72 | |
73 -- This function identifies the Ada exception to be raised using the | |
74 -- information when the system received a synchronous signal. Since this | |
75 -- function is machine and OS dependent, different code has to be provided | |
76 -- for different target. | |
77 | |
78 procedure Notify_Exception | |
79 (signo : Signal; | |
80 info : access siginfo_t; | |
81 context : access ucontext_t); | |
82 | |
83 ---------------------- | |
84 -- Notify_Exception -- | |
85 ---------------------- | |
86 | |
87 procedure Notify_Exception | |
88 (signo : Signal; | |
89 info : access siginfo_t; | |
90 context : access ucontext_t) | |
91 is | |
92 pragma Unreferenced (info); | |
93 | |
94 begin | |
95 -- Perform the necessary context adjustments prior to a raise from a | |
96 -- signal handler. | |
97 | |
98 Adjust_Context_For_Raise (signo, context.all'Address); | |
99 | |
100 -- Check that treatment of exception propagation here is consistent with | |
101 -- treatment of the abort signal in System.Task_Primitives.Operations. | |
102 | |
103 case signo is | |
104 when SIGFPE => raise Constraint_Error; | |
105 when SIGILL => raise Program_Error; | |
106 when SIGSEGV => raise Storage_Error; | |
107 when SIGBUS => raise Storage_Error; | |
108 when others => null; | |
109 end case; | |
110 end Notify_Exception; | |
111 | |
112 ---------------- | |
113 -- Initialize -- | |
114 ---------------- | |
115 | |
116 Initialized : Boolean := False; | |
117 | |
118 procedure Initialize is | |
119 act : aliased struct_sigaction; | |
120 old_act : aliased struct_sigaction; | |
121 mask : aliased sigset_t; | |
122 Result : Interfaces.C.int; | |
123 | |
124 begin | |
125 if Initialized then | |
126 return; | |
127 end if; | |
128 | |
129 Initialized := True; | |
130 | |
131 -- Need to call pthread_init very early because it is doing signal | |
132 -- initializations. | |
133 | |
134 pthread_init; | |
135 | |
136 -- Change this if you want to use another signal for task abort. | |
137 -- SIGTERM might be a good one. | |
138 | |
139 Abort_Task_Interrupt := SIGABRT; | |
140 | |
141 act.sa_handler := Notify_Exception'Address; | |
142 | |
143 -- Set sa_flags to SA_NODEFER so that during the handler execution | |
144 -- we do not change the Signal_Mask to be masked for the Signal. | |
145 -- This is a temporary fix to the problem that the Signal_Mask is | |
146 -- not restored after the exception (longjmp) from the handler. | |
147 -- The right fix should be made in sigsetjmp so that we save | |
148 -- the Signal_Set and restore it after a longjmp. | |
149 | |
150 -- In that case, this field should be changed back to 0. ??? (Dong-Ik) | |
151 | |
152 act.sa_flags := 16; | |
153 | |
154 Result := sigemptyset (mask'Access); | |
155 pragma Assert (Result = 0); | |
156 | |
157 -- ??? For the same reason explained above, we can't mask these signals | |
158 -- because otherwise we won't be able to catch more than one signal. | |
159 | |
160 act.sa_mask := mask; | |
161 | |
162 pragma Assert (Keep_Unmasked = (Interrupt_ID'Range => False)); | |
163 pragma Assert (Reserve = (Interrupt_ID'Range => False)); | |
164 | |
165 for J in Exception_Interrupts'Range loop | |
166 if State (Exception_Interrupts (J)) /= User then | |
167 Keep_Unmasked (Exception_Interrupts (J)) := True; | |
168 Reserve (Exception_Interrupts (J)) := True; | |
169 | |
170 if State (Exception_Interrupts (J)) /= Default then | |
171 Result := | |
172 sigaction | |
173 (Signal (Exception_Interrupts (J)), act'Unchecked_Access, | |
174 old_act'Unchecked_Access); | |
175 pragma Assert (Result = 0); | |
176 end if; | |
177 end if; | |
178 end loop; | |
179 | |
180 if State (Abort_Task_Interrupt) /= User then | |
181 Keep_Unmasked (Abort_Task_Interrupt) := True; | |
182 Reserve (Abort_Task_Interrupt) := True; | |
183 end if; | |
184 | |
185 -- Set SIGINT to unmasked state as long as it's | |
186 -- not in "User" state. Check for Unreserve_All_Interrupts last | |
187 | |
188 if State (SIGINT) /= User then | |
189 Keep_Unmasked (SIGINT) := True; | |
190 Reserve (SIGINT) := True; | |
191 end if; | |
192 | |
193 -- Check all signals for state that requires keeping them | |
194 -- unmasked and reserved | |
195 | |
196 for J in Interrupt_ID'Range loop | |
197 if State (J) = Default or else State (J) = Runtime then | |
198 Keep_Unmasked (J) := True; | |
199 Reserve (J) := True; | |
200 end if; | |
201 end loop; | |
202 | |
203 -- Add the set of signals that must always be unmasked for this target | |
204 | |
205 for J in Unmasked'Range loop | |
206 Keep_Unmasked (Interrupt_ID (Unmasked (J))) := True; | |
207 Reserve (Interrupt_ID (Unmasked (J))) := True; | |
208 end loop; | |
209 | |
210 -- Add target-specific reserved signals | |
211 | |
212 for J in Reserved'Range loop | |
213 Reserve (Interrupt_ID (Reserved (J))) := True; | |
214 end loop; | |
215 | |
216 -- Process pragma Unreserve_All_Interrupts. This overrides any | |
217 -- settings due to pragma Interrupt_State: | |
218 | |
219 if Unreserve_All_Interrupts /= 0 then | |
220 Keep_Unmasked (SIGINT) := False; | |
221 Reserve (SIGINT) := False; | |
222 end if; | |
223 | |
224 -- We do not have Signal 0 in reality. We just use this value to | |
225 -- identify not existing signals (see s-intnam.ads). Therefore, Signal 0 | |
226 -- should not be used in all signal related operations hence mark it as | |
227 -- reserved. | |
228 | |
229 Reserve (0) := True; | |
230 end Initialize; | |
231 | |
232 end System.Interrupt_Management; |