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