1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- 4-- -- 5-- SYSTEM.INTERRUPT_MANAGEMENT.OPERATIONS -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1991-2017, Florida State University -- 10-- Copyright (C) 1995-2021, AdaCore -- 11-- -- 12-- GNAT is free software; you can redistribute it and/or modify it under -- 13-- terms of the GNU General Public License as published by the Free Soft- -- 14-- ware Foundation; either version 3, or (at your option) any later ver- -- 15-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 16-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 17-- or FITNESS FOR A PARTICULAR PURPOSE. -- 18-- -- 19-- As a special exception under Section 7 of GPL version 3, you are granted -- 20-- additional permissions described in the GCC Runtime Library Exception, -- 21-- version 3.1, as published by the Free Software Foundation. -- 22-- -- 23-- You should have received a copy of the GNU General Public License and -- 24-- a copy of the GCC Runtime Library Exception along with this program; -- 25-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 26-- <http://www.gnu.org/licenses/>. -- 27-- -- 28-- GNARL was developed by the GNARL team at Florida State University. -- 29-- Extensive contributions were provided by Ada Core Technologies, Inc. -- 30-- -- 31------------------------------------------------------------------------------ 32 33-- This is a hardware interrupt version of this package. Many operations are 34-- null as this package supports the use of Ada interrupt handling facilities 35-- for signals, while those facilities are used for hardware interrupts on 36-- these targets. 37 38with Ada.Exceptions; 39 40with Interfaces.C; 41 42with System.OS_Interface; 43 44package body System.Interrupt_Management.Operations is 45 46 use Ada.Exceptions; 47 use Interfaces.C; 48 use System.OS_Interface; 49 50 ---------------------------- 51 -- Thread_Block_Interrupt -- 52 ---------------------------- 53 54 procedure Thread_Block_Interrupt 55 (Interrupt : Interrupt_ID) 56 is 57 pragma Unreferenced (Interrupt); 58 begin 59 Raise_Exception 60 (Program_Error'Identity, 61 "Thread_Block_Interrupt unimplemented"); 62 end Thread_Block_Interrupt; 63 64 ------------------------------ 65 -- Thread_Unblock_Interrupt -- 66 ------------------------------ 67 68 procedure Thread_Unblock_Interrupt 69 (Interrupt : Interrupt_ID) 70 is 71 pragma Unreferenced (Interrupt); 72 begin 73 Raise_Exception 74 (Program_Error'Identity, 75 "Thread_Unblock_Interrupt unimplemented"); 76 end Thread_Unblock_Interrupt; 77 78 ------------------------ 79 -- Set_Interrupt_Mask -- 80 ------------------------ 81 82 procedure Set_Interrupt_Mask (Mask : access Interrupt_Mask) is 83 pragma Unreferenced (Mask); 84 begin 85 null; 86 end Set_Interrupt_Mask; 87 88 procedure Set_Interrupt_Mask 89 (Mask : access Interrupt_Mask; 90 OMask : access Interrupt_Mask) 91 is 92 pragma Unreferenced (Mask, OMask); 93 begin 94 Raise_Exception 95 (Program_Error'Identity, 96 "Set_Interrupt_Mask unimplemented"); 97 end Set_Interrupt_Mask; 98 99 ------------------------ 100 -- Get_Interrupt_Mask -- 101 ------------------------ 102 103 procedure Get_Interrupt_Mask (Mask : access Interrupt_Mask) is 104 pragma Unreferenced (Mask); 105 begin 106 Raise_Exception 107 (Program_Error'Identity, 108 "Get_Interrupt_Mask unimplemented"); 109 end Get_Interrupt_Mask; 110 111 -------------------- 112 -- Interrupt_Wait -- 113 -------------------- 114 115 function Interrupt_Wait 116 (Mask : access Interrupt_Mask) return Interrupt_ID 117 is 118 pragma Unreferenced (Mask); 119 begin 120 Raise_Exception 121 (Program_Error'Identity, 122 "Interrupt_Wait unimplemented"); 123 return 0; 124 end Interrupt_Wait; 125 126 ---------------------------- 127 -- Install_Default_Action -- 128 ---------------------------- 129 130 procedure Install_Default_Action (Interrupt : Interrupt_ID) is 131 pragma Unreferenced (Interrupt); 132 begin 133 Raise_Exception 134 (Program_Error'Identity, 135 "Install_Default_Action unimplemented"); 136 end Install_Default_Action; 137 138 --------------------------- 139 -- Install_Ignore_Action -- 140 --------------------------- 141 142 procedure Install_Ignore_Action (Interrupt : Interrupt_ID) is 143 pragma Unreferenced (Interrupt); 144 begin 145 Raise_Exception 146 (Program_Error'Identity, 147 "Install_Ignore_Action unimplemented"); 148 end Install_Ignore_Action; 149 150 ------------------------- 151 -- Fill_Interrupt_Mask -- 152 ------------------------- 153 154 procedure Fill_Interrupt_Mask (Mask : access Interrupt_Mask) is 155 pragma Unreferenced (Mask); 156 begin 157 Raise_Exception 158 (Program_Error'Identity, 159 "Fill_Interrupt_Mask unimplemented"); 160 end Fill_Interrupt_Mask; 161 162 -------------------------- 163 -- Empty_Interrupt_Mask -- 164 -------------------------- 165 166 procedure Empty_Interrupt_Mask (Mask : access Interrupt_Mask) is 167 pragma Unreferenced (Mask); 168 begin 169 Raise_Exception 170 (Program_Error'Identity, 171 "Empty_Interrupt_Mask unimplemented"); 172 end Empty_Interrupt_Mask; 173 174 --------------------------- 175 -- Add_To_Interrupt_Mask -- 176 --------------------------- 177 178 procedure Add_To_Interrupt_Mask 179 (Mask : access Interrupt_Mask; 180 Interrupt : Interrupt_ID) 181 is 182 pragma Unreferenced (Mask, Interrupt); 183 begin 184 Raise_Exception 185 (Program_Error'Identity, 186 "Add_To_Interrupt_Mask unimplemented"); 187 end Add_To_Interrupt_Mask; 188 189 -------------------------------- 190 -- Delete_From_Interrupt_Mask -- 191 -------------------------------- 192 193 procedure Delete_From_Interrupt_Mask 194 (Mask : access Interrupt_Mask; 195 Interrupt : Interrupt_ID) 196 is 197 pragma Unreferenced (Mask, Interrupt); 198 begin 199 Raise_Exception 200 (Program_Error'Identity, 201 "Delete_From_Interrupt_Mask unimplemented"); 202 end Delete_From_Interrupt_Mask; 203 204 --------------- 205 -- Is_Member -- 206 --------------- 207 208 function Is_Member 209 (Mask : access Interrupt_Mask; 210 Interrupt : Interrupt_ID) return Boolean 211 is 212 pragma Unreferenced (Mask, Interrupt); 213 begin 214 Raise_Exception 215 (Program_Error'Identity, 216 "Is_Member unimplemented"); 217 return False; 218 end Is_Member; 219 220 ------------------------- 221 -- Copy_Interrupt_Mask -- 222 ------------------------- 223 224 procedure Copy_Interrupt_Mask 225 (X : out Interrupt_Mask; 226 Y : Interrupt_Mask) is 227 pragma Unreferenced (X, Y); 228 begin 229 Raise_Exception 230 (Program_Error'Identity, 231 "Copy_Interrupt_Mask unimplemented"); 232 end Copy_Interrupt_Mask; 233 234 ---------------------------- 235 -- Interrupt_Self_Process -- 236 ---------------------------- 237 238 procedure Interrupt_Self_Process (Interrupt : Interrupt_ID) is 239 Result : Interfaces.C.int; 240 begin 241 Result := kill (getpid, Signal (Interrupt)); 242 pragma Assert (Result = 0); 243 end Interrupt_Self_Process; 244 245 -------------------------- 246 -- Setup_Interrupt_Mask -- 247 -------------------------- 248 249 procedure Setup_Interrupt_Mask is 250 begin 251 -- Nothing to be done. Ada interrupt facilities on VxWorks do not use 252 -- signals but hardware interrupts. Therefore, interrupt management does 253 -- not need anything related to signal masking. Note that this procedure 254 -- cannot raise an exception (as some others in this package) because 255 -- the generic implementation of the Timer_Server and timing events make 256 -- explicit calls to this routine to make ensure proper signal masking 257 -- on targets needed that. 258 259 null; 260 end Setup_Interrupt_Mask; 261 262end System.Interrupt_Management.Operations; 263