GCC v8.2
[gcc.git] / gcc / ada / libgnarl / s-intman__posix.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-2018, 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 the POSIX 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 --    SIGFPE, SIGILL, SIGSEGV and SIGBUS exist. They are mapped as follows:
45 --      SIGPFE  => Constraint_Error
46 --      SIGILL  => Program_Error
47 --      SIGSEGV => Storage_Error
48 --      SIGBUS  => Storage_Error
49
50 --    SIGINT exists and will be kept unmasked unless the pragma
51 --     Unreserve_All_Interrupts is specified anywhere in the application.
52
53 --    System.OS_Interface contains the following:
54 --      SIGADAABORT: the signal that will be used to abort tasks.
55 --      Unmasked: the OS specific set of signals that should be unmasked in
56 --                all the threads. SIGADAABORT is unmasked by
57 --                default
58 --      Reserved: the OS specific set of signals that are reserved.
59
60 with System.Task_Primitives;
61
62 package body System.Interrupt_Management is
63
64    use Interfaces.C;
65    use System.OS_Interface;
66
67    type Interrupt_List is array (Interrupt_ID range <>) of Interrupt_ID;
68    Exception_Interrupts : constant Interrupt_List :=
69      (SIGFPE, SIGILL, SIGSEGV, SIGBUS);
70
71    Unreserve_All_Interrupts : Interfaces.C.int;
72    pragma Import
73      (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
74
75    -----------------------
76    -- Local Subprograms --
77    -----------------------
78
79    function State (Int : Interrupt_ID) return Character;
80    pragma Import (C, State, "__gnat_get_interrupt_state");
81    --  Get interrupt state. Defined in init.c The input argument is the
82    --  interrupt number, and the result is one of the following:
83
84    User    : constant Character := 'u';
85    Runtime : constant Character := 'r';
86    Default : constant Character := 's';
87    --    'n'   this interrupt not set by any Interrupt_State pragma
88    --    'u'   Interrupt_State pragma set state to User
89    --    'r'   Interrupt_State pragma set state to Runtime
90    --    's'   Interrupt_State pragma set state to System (use "default"
91    --           system handler)
92
93    procedure Notify_Exception
94      (signo    : Signal;
95       siginfo  : System.Address;
96       ucontext : System.Address);
97    --  This function identifies the Ada exception to be raised using the
98    --  information when the system received a synchronous signal. Since this
99    --  function is machine and OS dependent, different code has to be provided
100    --  for different target.
101
102    ----------------------
103    -- Notify_Exception --
104    ----------------------
105
106    Signal_Mask : aliased sigset_t;
107    --  The set of signals handled by Notify_Exception
108
109    procedure Notify_Exception
110      (signo    : Signal;
111       siginfo  : System.Address;
112       ucontext : System.Address)
113    is
114       pragma Unreferenced (siginfo);
115
116       Result : Interfaces.C.int;
117
118    begin
119       --  With the __builtin_longjmp, the signal mask is not restored, so we
120       --  need to restore it explicitly.
121
122       Result := pthread_sigmask (SIG_UNBLOCK, Signal_Mask'Access, null);
123       pragma Assert (Result = 0);
124
125       --  Perform the necessary context adjustments prior to a raise
126       --  from a signal handler.
127
128       Adjust_Context_For_Raise (signo, ucontext);
129
130       --  Check that treatment of exception propagation here is consistent with
131       --  treatment of the abort signal in System.Task_Primitives.Operations.
132
133       case signo is
134          when SIGFPE  => raise Constraint_Error;
135          when SIGILL  => raise Program_Error;
136          when SIGSEGV => raise Storage_Error;
137          when SIGBUS  => raise Storage_Error;
138          when others  => null;
139       end case;
140    end Notify_Exception;
141
142    ----------------
143    -- Initialize --
144    ----------------
145
146    Initialized : Boolean := False;
147
148    procedure Initialize is
149       act     : aliased struct_sigaction;
150       old_act : aliased struct_sigaction;
151       Result  : System.OS_Interface.int;
152
153       Use_Alternate_Stack : constant Boolean :=
154                               System.Task_Primitives.Alternate_Stack_Size /= 0;
155       --  Whether to use an alternate signal stack for stack overflows
156
157    begin
158       if Initialized then
159          return;
160       end if;
161
162       Initialized := True;
163
164       --  Need to call pthread_init very early because it is doing signal
165       --  initializations.
166
167       pthread_init;
168
169       Abort_Task_Interrupt := SIGADAABORT;
170
171       act.sa_handler := Notify_Exception'Address;
172
173       --  Setting SA_SIGINFO asks the kernel to pass more than just the signal
174       --  number argument to the handler when it is called. The set of extra
175       --  parameters includes a pointer to the interrupted context, which the
176       --  ZCX propagation scheme needs.
177
178       --  Most man pages for sigaction mention that sa_sigaction should be set
179       --  instead of sa_handler when SA_SIGINFO is on.  In practice, the two
180       --  fields are actually union'ed and located at the same offset.
181
182       --  On some targets, we set sa_flags to SA_NODEFER so that during the
183       --  handler execution we do not change the Signal_Mask to be masked for
184       --  the Signal.
185
186       --  This is a temporary fix to the problem that the Signal_Mask is not
187       --  restored after the exception (longjmp) from the handler. The right
188       --  fix should be made in sigsetjmp so that we save the Signal_Set and
189       --  restore it after a longjmp.
190
191       --  Since SA_NODEFER is obsolete, instead we reset explicitly the mask
192       --  in the exception handler.
193
194       Result := sigemptyset (Signal_Mask'Access);
195       pragma Assert (Result = 0);
196
197       --  Add signals that map to Ada exceptions to the mask
198
199       for J in Exception_Interrupts'Range loop
200          if State (Exception_Interrupts (J)) /= Default then
201             Result :=
202             sigaddset (Signal_Mask'Access, Signal (Exception_Interrupts (J)));
203             pragma Assert (Result = 0);
204          end if;
205       end loop;
206
207       act.sa_mask := Signal_Mask;
208
209       pragma Assert (Keep_Unmasked = (Interrupt_ID'Range => False));
210       pragma Assert (Reserve = (Interrupt_ID'Range => False));
211
212       --  Process state of exception signals
213
214       for J in Exception_Interrupts'Range loop
215          if State (Exception_Interrupts (J)) /= User then
216             Keep_Unmasked (Exception_Interrupts (J)) := True;
217             Reserve (Exception_Interrupts (J)) := True;
218
219             if State (Exception_Interrupts (J)) /= Default then
220                act.sa_flags := SA_SIGINFO;
221
222                if Use_Alternate_Stack
223                  and then Exception_Interrupts (J) = SIGSEGV
224                then
225                   act.sa_flags := act.sa_flags + SA_ONSTACK;
226                end if;
227
228                Result :=
229                  sigaction
230                    (Signal (Exception_Interrupts (J)), act'Unchecked_Access,
231                     old_act'Unchecked_Access);
232                pragma Assert (Result = 0);
233             end if;
234          end if;
235       end loop;
236
237       if State (Abort_Task_Interrupt) /= User then
238          Keep_Unmasked (Abort_Task_Interrupt) := True;
239          Reserve (Abort_Task_Interrupt) := True;
240       end if;
241
242       --  Set SIGINT to unmasked state as long as it is not in "User" state.
243       --  Check for Unreserve_All_Interrupts last.
244
245       if State (SIGINT) /= User then
246          Keep_Unmasked (SIGINT) := True;
247          Reserve (SIGINT) := True;
248       end if;
249
250       --  Check all signals for state that requires keeping them unmasked and
251       --  reserved.
252
253       for J in Interrupt_ID'Range loop
254          if State (J) = Default or else State (J) = Runtime then
255             Keep_Unmasked (J) := True;
256             Reserve (J) := True;
257          end if;
258       end loop;
259
260       --  Add the set of signals that must always be unmasked for this target
261
262       for J in Unmasked'Range loop
263          Keep_Unmasked (Interrupt_ID (Unmasked (J))) := True;
264          Reserve (Interrupt_ID (Unmasked (J))) := True;
265       end loop;
266
267       --  Add target-specific reserved signals
268
269       for J in Reserved'Range loop
270          Reserve (Interrupt_ID (Reserved (J))) := True;
271       end loop;
272
273       --  Process pragma Unreserve_All_Interrupts. This overrides any settings
274       --  due to pragma Interrupt_State:
275
276       if Unreserve_All_Interrupts /= 0 then
277          Keep_Unmasked (SIGINT) := False;
278          Reserve (SIGINT) := False;
279       end if;
280
281       --  We do not really have Signal 0. We just use this value to identify
282       --  non-existent signals (see s-intnam.ads). Therefore, Signal should not
283       --  be used in all signal related operations hence mark it as reserved.
284
285       Reserve (0) := True;
286    end Initialize;
287
288 end System.Interrupt_Management;