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-2019, 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 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 232end System.Interrupt_Management; 233