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) 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 OpenVMS/Alpha version of this package 33 34with System.OS_Interface; 35with System.Aux_DEC; 36with System.Parameters; 37with System.Tasking; 38with System.Tasking.Initialization; 39with System.Task_Primitives; 40with System.Task_Primitives.Operations; 41with System.Task_Primitives.Operations.DEC; 42 43with Ada.Unchecked_Conversion; 44 45package body System.Interrupt_Management.Operations is 46 47 use System.OS_Interface; 48 use System.Parameters; 49 use System.Tasking; 50 use type unsigned_short; 51 52 function To_Address is 53 new Ada.Unchecked_Conversion 54 (Task_Id, System.Task_Primitives.Task_Address); 55 56 package POP renames System.Task_Primitives.Operations; 57 58 ---------------------------- 59 -- Thread_Block_Interrupt -- 60 ---------------------------- 61 62 procedure Thread_Block_Interrupt (Interrupt : Interrupt_ID) is 63 pragma Warnings (Off, Interrupt); 64 begin 65 null; 66 end Thread_Block_Interrupt; 67 68 ------------------------------ 69 -- Thread_Unblock_Interrupt -- 70 ------------------------------ 71 72 procedure Thread_Unblock_Interrupt (Interrupt : Interrupt_ID) is 73 pragma Warnings (Off, Interrupt); 74 begin 75 null; 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 Warnings (Off, 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 Warnings (Off, Mask); 93 pragma Warnings (Off, OMask); 94 begin 95 null; 96 end Set_Interrupt_Mask; 97 98 ------------------------ 99 -- Get_Interrupt_Mask -- 100 ------------------------ 101 102 procedure Get_Interrupt_Mask (Mask : access Interrupt_Mask) is 103 pragma Warnings (Off, Mask); 104 begin 105 null; 106 end Get_Interrupt_Mask; 107 108 -------------------- 109 -- Interrupt_Wait -- 110 -------------------- 111 112 function To_unsigned_long is new 113 Ada.Unchecked_Conversion (System.Aux_DEC.Short_Address, unsigned_long); 114 115 function Interrupt_Wait (Mask : access Interrupt_Mask) 116 return Interrupt_ID 117 is 118 Self_ID : constant Task_Id := Self; 119 Iosb : IO_Status_Block_Type := (0, 0, 0); 120 Status : Cond_Value_Type; 121 122 begin 123 124 -- A QIO read is registered. The system call returns immediately 125 -- after scheduling an AST to be fired when the operation 126 -- completes. 127 128 Sys_QIO 129 (Status => Status, 130 Chan => Rcv_Interrupt_Chan, 131 Func => IO_READVBLK, 132 Iosb => Iosb, 133 Astadr => 134 POP.DEC.Interrupt_AST_Handler'Access, 135 Astprm => To_Address (Self_ID), 136 P1 => To_unsigned_long (Interrupt_Mailbox'Address), 137 P2 => Interrupt_ID'Size / 8); 138 139 pragma Assert ((Status and 1) = 1); 140 141 loop 142 143 -- Wait to be woken up. Could be that the AST has fired, 144 -- in which case the Iosb.Status variable will be non-zero, 145 -- or maybe the wait is being aborted. 146 147 POP.Sleep 148 (Self_ID, 149 System.Tasking.Interrupt_Server_Blocked_On_Event_Flag); 150 151 if Iosb.Status /= 0 then 152 if (Iosb.Status and 1) = 1 153 and then Mask (Signal (Interrupt_Mailbox)) 154 then 155 return Interrupt_Mailbox; 156 else 157 return 0; 158 end if; 159 else 160 POP.Unlock (Self_ID); 161 162 if Single_Lock then 163 POP.Unlock_RTS; 164 end if; 165 166 System.Tasking.Initialization.Undefer_Abort (Self_ID); 167 System.Tasking.Initialization.Defer_Abort (Self_ID); 168 169 if Single_Lock then 170 POP.Lock_RTS; 171 end if; 172 173 POP.Write_Lock (Self_ID); 174 end if; 175 end loop; 176 end Interrupt_Wait; 177 178 ---------------------------- 179 -- Install_Default_Action -- 180 ---------------------------- 181 182 procedure Install_Default_Action (Interrupt : Interrupt_ID) is 183 pragma Warnings (Off, Interrupt); 184 begin 185 null; 186 end Install_Default_Action; 187 188 --------------------------- 189 -- Install_Ignore_Action -- 190 --------------------------- 191 192 procedure Install_Ignore_Action (Interrupt : Interrupt_ID) is 193 pragma Warnings (Off, Interrupt); 194 begin 195 null; 196 end Install_Ignore_Action; 197 198 ------------------------- 199 -- Fill_Interrupt_Mask -- 200 ------------------------- 201 202 procedure Fill_Interrupt_Mask (Mask : access Interrupt_Mask) is 203 begin 204 Mask.all := (others => True); 205 end Fill_Interrupt_Mask; 206 207 -------------------------- 208 -- Empty_Interrupt_Mask -- 209 -------------------------- 210 211 procedure Empty_Interrupt_Mask (Mask : access Interrupt_Mask) is 212 begin 213 Mask.all := (others => False); 214 end Empty_Interrupt_Mask; 215 216 --------------------------- 217 -- Add_To_Interrupt_Mask -- 218 --------------------------- 219 220 procedure Add_To_Interrupt_Mask 221 (Mask : access Interrupt_Mask; 222 Interrupt : Interrupt_ID) 223 is 224 begin 225 Mask (Signal (Interrupt)) := True; 226 end Add_To_Interrupt_Mask; 227 228 -------------------------------- 229 -- Delete_From_Interrupt_Mask -- 230 -------------------------------- 231 232 procedure Delete_From_Interrupt_Mask 233 (Mask : access Interrupt_Mask; 234 Interrupt : Interrupt_ID) 235 is 236 begin 237 Mask (Signal (Interrupt)) := False; 238 end Delete_From_Interrupt_Mask; 239 240 --------------- 241 -- Is_Member -- 242 --------------- 243 244 function Is_Member 245 (Mask : access Interrupt_Mask; 246 Interrupt : Interrupt_ID) return Boolean 247 is 248 begin 249 return Mask (Signal (Interrupt)); 250 end Is_Member; 251 252 ------------------------- 253 -- Copy_Interrupt_Mask -- 254 ------------------------- 255 256 procedure Copy_Interrupt_Mask 257 (X : out Interrupt_Mask; 258 Y : Interrupt_Mask) 259 is 260 begin 261 X := Y; 262 end Copy_Interrupt_Mask; 263 264 ---------------------------- 265 -- Interrupt_Self_Process -- 266 ---------------------------- 267 268 procedure Interrupt_Self_Process (Interrupt : Interrupt_ID) is 269 Status : Cond_Value_Type; 270 begin 271 Sys_QIO 272 (Status => Status, 273 Chan => Snd_Interrupt_Chan, 274 Func => IO_WRITEVBLK, 275 P1 => To_unsigned_long (Interrupt'Address), 276 P2 => Interrupt_ID'Size / 8); 277 278 -- The following could use a comment ??? 279 280 pragma Assert ((Status and 1) = 1); 281 end Interrupt_Self_Process; 282 283 -------------------------- 284 -- Setup_Interrupt_Mask -- 285 -------------------------- 286 287 procedure Setup_Interrupt_Mask is 288 begin 289 null; 290 end Setup_Interrupt_Mask; 291 292begin 293 Interrupt_Management.Initialize; 294 Environment_Mask := (others => False); 295 All_Tasks_Mask := (others => True); 296 297 for J in Interrupt_ID loop 298 if Keep_Unmasked (J) then 299 Environment_Mask (Signal (J)) := True; 300 All_Tasks_Mask (Signal (J)) := False; 301 end if; 302 end loop; 303end System.Interrupt_Management.Operations; 304