1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- S Y S T E M . S O F T _ L I N K S -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT 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-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32pragma Compiler_Unit_Warning; 33 34pragma Polling (Off); 35-- We must turn polling off for this unit, because otherwise we get an 36-- infinite loop from the code within the Poll routine itself. 37 38with System.Parameters; 39 40pragma Warnings (Off); 41-- Disable warnings since System.Secondary_Stack is currently not Preelaborate 42with System.Secondary_Stack; 43pragma Warnings (On); 44 45package body System.Soft_Links is 46 47 package SST renames System.Secondary_Stack; 48 49 NT_TSD : TSD; 50 -- Note: we rely on the default initialization of NT_TSD 51 52 -------------------- 53 -- Abort_Defer_NT -- 54 -------------------- 55 56 procedure Abort_Defer_NT is 57 begin 58 null; 59 end Abort_Defer_NT; 60 61 ---------------------- 62 -- Abort_Handler_NT -- 63 ---------------------- 64 65 procedure Abort_Handler_NT is 66 begin 67 null; 68 end Abort_Handler_NT; 69 70 ---------------------- 71 -- Abort_Undefer_NT -- 72 ---------------------- 73 74 procedure Abort_Undefer_NT is 75 begin 76 null; 77 end Abort_Undefer_NT; 78 79 ----------------- 80 -- Adafinal_NT -- 81 ----------------- 82 83 procedure Adafinal_NT is 84 begin 85 -- Handle normal task termination by the environment task, but only 86 -- for the normal task termination. In the case of Abnormal and 87 -- Unhandled_Exception they must have been handled before, and the 88 -- task termination soft link must have been changed so the task 89 -- termination routine is not executed twice. 90 91 Task_Termination_Handler.all (Ada.Exceptions.Null_Occurrence); 92 93 -- Finalize all library-level controlled objects if needed 94 95 if Finalize_Library_Objects /= null then 96 Finalize_Library_Objects.all; 97 end if; 98 end Adafinal_NT; 99 100 --------------------------- 101 -- Check_Abort_Status_NT -- 102 --------------------------- 103 104 function Check_Abort_Status_NT return Integer is 105 begin 106 return Boolean'Pos (False); 107 end Check_Abort_Status_NT; 108 109 ------------------------ 110 -- Complete_Master_NT -- 111 ------------------------ 112 113 procedure Complete_Master_NT is 114 begin 115 null; 116 end Complete_Master_NT; 117 118 ---------------- 119 -- Create_TSD -- 120 ---------------- 121 122 procedure Create_TSD (New_TSD : in out TSD) is 123 use Parameters; 124 SS_Ratio_Dynamic : constant Boolean := Sec_Stack_Percentage = Dynamic; 125 begin 126 if SS_Ratio_Dynamic then 127 SST.SS_Init 128 (New_TSD.Sec_Stack_Addr, SST.Default_Secondary_Stack_Size); 129 end if; 130 end Create_TSD; 131 132 ----------------------- 133 -- Current_Master_NT -- 134 ----------------------- 135 136 function Current_Master_NT return Integer is 137 begin 138 return 0; 139 end Current_Master_NT; 140 141 ----------------- 142 -- Destroy_TSD -- 143 ----------------- 144 145 procedure Destroy_TSD (Old_TSD : in out TSD) is 146 begin 147 SST.SS_Free (Old_TSD.Sec_Stack_Addr); 148 end Destroy_TSD; 149 150 --------------------- 151 -- Enter_Master_NT -- 152 --------------------- 153 154 procedure Enter_Master_NT is 155 begin 156 null; 157 end Enter_Master_NT; 158 159 -------------------------- 160 -- Get_Current_Excep_NT -- 161 -------------------------- 162 163 function Get_Current_Excep_NT return EOA is 164 begin 165 return NT_TSD.Current_Excep'Access; 166 end Get_Current_Excep_NT; 167 168 ------------------------ 169 -- Get_GNAT_Exception -- 170 ------------------------ 171 172 function Get_GNAT_Exception return Ada.Exceptions.Exception_Id is 173 begin 174 return Ada.Exceptions.Exception_Identity (Get_Current_Excep.all.all); 175 end Get_GNAT_Exception; 176 177 --------------------------- 178 -- Get_Jmpbuf_Address_NT -- 179 --------------------------- 180 181 function Get_Jmpbuf_Address_NT return Address is 182 begin 183 return NT_TSD.Jmpbuf_Address; 184 end Get_Jmpbuf_Address_NT; 185 186 ----------------------------- 187 -- Get_Jmpbuf_Address_Soft -- 188 ----------------------------- 189 190 function Get_Jmpbuf_Address_Soft return Address is 191 begin 192 return Get_Jmpbuf_Address.all; 193 end Get_Jmpbuf_Address_Soft; 194 195 --------------------------- 196 -- Get_Sec_Stack_Addr_NT -- 197 --------------------------- 198 199 function Get_Sec_Stack_Addr_NT return Address is 200 begin 201 return NT_TSD.Sec_Stack_Addr; 202 end Get_Sec_Stack_Addr_NT; 203 204 ----------------------------- 205 -- Get_Sec_Stack_Addr_Soft -- 206 ----------------------------- 207 208 function Get_Sec_Stack_Addr_Soft return Address is 209 begin 210 return Get_Sec_Stack_Addr.all; 211 end Get_Sec_Stack_Addr_Soft; 212 213 ----------------------- 214 -- Get_Stack_Info_NT -- 215 ----------------------- 216 217 function Get_Stack_Info_NT return Stack_Checking.Stack_Access is 218 begin 219 return NT_TSD.Pri_Stack_Info'Access; 220 end Get_Stack_Info_NT; 221 222 ----------------------------- 223 -- Save_Library_Occurrence -- 224 ----------------------------- 225 226 procedure Save_Library_Occurrence (E : EOA) is 227 use Ada.Exceptions; 228 begin 229 if not Library_Exception_Set then 230 Library_Exception_Set := True; 231 if E /= null then 232 Ada.Exceptions.Save_Occurrence (Library_Exception, E.all); 233 end if; 234 end if; 235 end Save_Library_Occurrence; 236 237 --------------------------- 238 -- Set_Jmpbuf_Address_NT -- 239 --------------------------- 240 241 procedure Set_Jmpbuf_Address_NT (Addr : Address) is 242 begin 243 NT_TSD.Jmpbuf_Address := Addr; 244 end Set_Jmpbuf_Address_NT; 245 246 procedure Set_Jmpbuf_Address_Soft (Addr : Address) is 247 begin 248 Set_Jmpbuf_Address (Addr); 249 end Set_Jmpbuf_Address_Soft; 250 251 --------------------------- 252 -- Set_Sec_Stack_Addr_NT -- 253 --------------------------- 254 255 procedure Set_Sec_Stack_Addr_NT (Addr : Address) is 256 begin 257 NT_TSD.Sec_Stack_Addr := Addr; 258 end Set_Sec_Stack_Addr_NT; 259 260 ----------------------------- 261 -- Set_Sec_Stack_Addr_Soft -- 262 ----------------------------- 263 264 procedure Set_Sec_Stack_Addr_Soft (Addr : Address) is 265 begin 266 Set_Sec_Stack_Addr (Addr); 267 end Set_Sec_Stack_Addr_Soft; 268 269 ------------------ 270 -- Task_Lock_NT -- 271 ------------------ 272 273 procedure Task_Lock_NT is 274 begin 275 null; 276 end Task_Lock_NT; 277 278 ------------------ 279 -- Task_Name_NT -- 280 ------------------- 281 282 function Task_Name_NT return String is 283 begin 284 return "main_task"; 285 end Task_Name_NT; 286 287 ------------------------- 288 -- Task_Termination_NT -- 289 ------------------------- 290 291 procedure Task_Termination_NT (Excep : EO) is 292 pragma Unreferenced (Excep); 293 begin 294 null; 295 end Task_Termination_NT; 296 297 -------------------- 298 -- Task_Unlock_NT -- 299 -------------------- 300 301 procedure Task_Unlock_NT is 302 begin 303 null; 304 end Task_Unlock_NT; 305 306 ------------------------- 307 -- Update_Exception_NT -- 308 ------------------------- 309 310 procedure Update_Exception_NT (X : EO := Current_Target_Exception) is 311 begin 312 Ada.Exceptions.Save_Occurrence (NT_TSD.Current_Excep, X); 313 end Update_Exception_NT; 314 315end System.Soft_Links; 316