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-- 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
40package 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
96      --  from a 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 =>
105            raise Constraint_Error;
106         when SIGILL =>
107            raise Program_Error;
108         when SIGSEGV =>
109            raise Storage_Error;
110         when SIGBUS =>
111            raise Storage_Error;
112         when others =>
113            null;
114      end case;
115   end Notify_Exception;
116
117   ----------------
118   -- Initialize --
119   ----------------
120
121   Initialized : Boolean := False;
122
123   procedure Initialize is
124      act     : aliased struct_sigaction;
125      old_act : aliased struct_sigaction;
126      mask    : aliased sigset_t;
127      Result  : Interfaces.C.int;
128
129   begin
130      if Initialized then
131         return;
132      end if;
133
134      Initialized := True;
135
136      --  Need to call pthread_init very early because it is doing signal
137      --  initializations.
138
139      pthread_init;
140
141      --  Change this if you want to use another signal for task abort.
142      --  SIGTERM might be a good one.
143
144      Abort_Task_Interrupt := SIGABRT;
145
146      act.sa_handler := Notify_Exception'Address;
147
148      --  Set sa_flags to SA_NODEFER so that during the handler execution
149      --  we do not change the Signal_Mask to be masked for the Signal.
150      --  This is a temporary fix to the problem that the Signal_Mask is
151      --  not restored after the exception (longjmp) from the handler.
152      --  The right fix should be made in sigsetjmp so that we save
153      --  the Signal_Set and restore it after a longjmp.
154
155      --  In that case, this field should be changed back to 0. ??? (Dong-Ik)
156
157      act.sa_flags := 16;
158
159      Result := sigemptyset (mask'Access);
160      pragma Assert (Result = 0);
161
162      --  ??? For the same reason explained above, we can't mask these signals
163      --  because otherwise we won't be able to catch more than one signal.
164
165      act.sa_mask := mask;
166
167      pragma Assert (Keep_Unmasked = (Interrupt_ID'Range => False));
168      pragma Assert (Reserve = (Interrupt_ID'Range => False));
169
170      for J in Exception_Interrupts'Range loop
171         if State (Exception_Interrupts (J)) /= User then
172            Keep_Unmasked (Exception_Interrupts (J)) := True;
173            Reserve (Exception_Interrupts (J)) := True;
174
175            if State (Exception_Interrupts (J)) /= Default then
176               Result :=
177                 sigaction
178                 (Signal (Exception_Interrupts (J)), act'Unchecked_Access,
179                  old_act'Unchecked_Access);
180               pragma Assert (Result = 0);
181            end if;
182         end if;
183      end loop;
184
185      if State (Abort_Task_Interrupt) /= User then
186         Keep_Unmasked (Abort_Task_Interrupt) := True;
187         Reserve (Abort_Task_Interrupt) := True;
188      end if;
189
190      --  Set SIGINT to unmasked state as long as it's
191      --  not in "User" state.  Check for Unreserve_All_Interrupts last
192
193      if State (SIGINT) /= User then
194         Keep_Unmasked (SIGINT) := True;
195         Reserve (SIGINT) := True;
196      end if;
197
198      --  Check all signals for state that requires keeping them
199      --  unmasked and reserved
200
201      for J in Interrupt_ID'Range loop
202         if State (J) = Default or else State (J) = Runtime then
203            Keep_Unmasked (J) := True;
204            Reserve (J) := True;
205         end if;
206      end loop;
207
208      --  Add the set of signals that must always be unmasked for this target
209
210      for J in Unmasked'Range loop
211         Keep_Unmasked (Interrupt_ID (Unmasked (J))) := True;
212         Reserve (Interrupt_ID (Unmasked (J))) := True;
213      end loop;
214
215      --  Add target-specific reserved signals
216
217      for J in Reserved'Range loop
218         Reserve (Interrupt_ID (Reserved (J))) := True;
219      end loop;
220
221      --  Process pragma Unreserve_All_Interrupts. This overrides any
222      --  settings due to pragma Interrupt_State:
223
224      if Unreserve_All_Interrupts /= 0 then
225         Keep_Unmasked (SIGINT) := False;
226         Reserve (SIGINT) := False;
227      end if;
228
229      --  We do not have Signal 0 in reality. We just use this value to
230      --  identify not existing signals (see s-intnam.ads). Therefore, Signal 0
231      --  should not be used in all signal related operations hence mark it as
232      --  reserved.
233
234      Reserve (0) := True;
235   end Initialize;
236
237end System.Interrupt_Management;
238