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-2021, 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 Warnings (Off); 35-- Disable warnings as System.Soft_Links.Initialize is not Preelaborate. It is 36-- safe to with this unit as its elaboration routine will only be initializing 37-- NT_TSD, which is part of this package spec. 38with System.Soft_Links.Initialize; 39pragma Warnings (On); 40 41package body System.Soft_Links is 42 43 Stack_Limit : aliased System.Address := System.Null_Address; 44 pragma Export (C, Stack_Limit, "__gnat_stack_limit"); 45 -- Needed for Vx6Cert (Vx653mc) GOS cert and ravenscar-cert runtimes, 46 -- VxMILS cert, ravenscar-cert and full runtimes, Vx 5 default runtime 47 48 -------------------- 49 -- Abort_Defer_NT -- 50 -------------------- 51 52 procedure Abort_Defer_NT is 53 begin 54 null; 55 end Abort_Defer_NT; 56 57 ---------------------- 58 -- Abort_Handler_NT -- 59 ---------------------- 60 61 procedure Abort_Handler_NT is 62 begin 63 null; 64 end Abort_Handler_NT; 65 66 ---------------------- 67 -- Abort_Undefer_NT -- 68 ---------------------- 69 70 procedure Abort_Undefer_NT is 71 begin 72 null; 73 end Abort_Undefer_NT; 74 75 ----------------- 76 -- Adafinal_NT -- 77 ----------------- 78 79 procedure Adafinal_NT is 80 begin 81 -- Handle normal task termination by the environment task, but only 82 -- for the normal task termination. In the case of Abnormal and 83 -- Unhandled_Exception they must have been handled before, and the 84 -- task termination soft link must have been changed so the task 85 -- termination routine is not executed twice. 86 87 Task_Termination_Handler.all (Ada.Exceptions.Null_Occurrence); 88 89 -- Finalize all library-level controlled objects if needed 90 91 if Finalize_Library_Objects /= null then 92 Finalize_Library_Objects.all; 93 end if; 94 end Adafinal_NT; 95 96 --------------------------- 97 -- Check_Abort_Status_NT -- 98 --------------------------- 99 100 function Check_Abort_Status_NT return Integer is 101 begin 102 return Boolean'Pos (False); 103 end Check_Abort_Status_NT; 104 105 ------------------------ 106 -- Complete_Master_NT -- 107 ------------------------ 108 109 procedure Complete_Master_NT is 110 begin 111 null; 112 end Complete_Master_NT; 113 114 ---------------- 115 -- Create_TSD -- 116 ---------------- 117 118 procedure Create_TSD 119 (New_TSD : in out TSD; 120 Sec_Stack : SST.SS_Stack_Ptr; 121 Sec_Stack_Size : System.Parameters.Size_Type) 122 is 123 begin 124 New_TSD.Jmpbuf_Address := Null_Address; 125 126 New_TSD.Sec_Stack_Ptr := Sec_Stack; 127 SST.SS_Init (New_TSD.Sec_Stack_Ptr, Sec_Stack_Size); 128 end Create_TSD; 129 130 ----------------------- 131 -- Current_Master_NT -- 132 ----------------------- 133 134 function Current_Master_NT return Integer is 135 begin 136 return 0; 137 end Current_Master_NT; 138 139 ----------------- 140 -- Destroy_TSD -- 141 ----------------- 142 143 procedure Destroy_TSD (Old_TSD : in out TSD) is 144 begin 145 SST.SS_Free (Old_TSD.Sec_Stack_Ptr); 146 end Destroy_TSD; 147 148 --------------------- 149 -- Enter_Master_NT -- 150 --------------------- 151 152 procedure Enter_Master_NT is 153 begin 154 null; 155 end Enter_Master_NT; 156 157 -------------------------- 158 -- Get_Current_Excep_NT -- 159 -------------------------- 160 161 function Get_Current_Excep_NT return EOA is 162 begin 163 return NT_TSD.Current_Excep'Access; 164 end Get_Current_Excep_NT; 165 166 ------------------------ 167 -- Get_GNAT_Exception -- 168 ------------------------ 169 170 function Get_GNAT_Exception return Ada.Exceptions.Exception_Id is 171 begin 172 return Ada.Exceptions.Exception_Identity (Get_Current_Excep.all.all); 173 end Get_GNAT_Exception; 174 175 --------------------------- 176 -- Get_Jmpbuf_Address_NT -- 177 --------------------------- 178 179 function Get_Jmpbuf_Address_NT return Address is 180 begin 181 return NT_TSD.Jmpbuf_Address; 182 end Get_Jmpbuf_Address_NT; 183 184 ----------------------------- 185 -- Get_Jmpbuf_Address_Soft -- 186 ----------------------------- 187 188 function Get_Jmpbuf_Address_Soft return Address is 189 begin 190 return Get_Jmpbuf_Address.all; 191 end Get_Jmpbuf_Address_Soft; 192 193 ---------------------- 194 -- Get_Sec_Stack_NT -- 195 ---------------------- 196 197 function Get_Sec_Stack_NT return SST.SS_Stack_Ptr is 198 begin 199 return NT_TSD.Sec_Stack_Ptr; 200 end Get_Sec_Stack_NT; 201 202 ----------------------------- 203 -- Get_Sec_Stack_Soft -- 204 ----------------------------- 205 206 function Get_Sec_Stack_Soft return SST.SS_Stack_Ptr is 207 begin 208 return Get_Sec_Stack.all; 209 end Get_Sec_Stack_Soft; 210 211 ----------------------- 212 -- Get_Stack_Info_NT -- 213 ----------------------- 214 215 function Get_Stack_Info_NT return Stack_Checking.Stack_Access is 216 begin 217 return NT_TSD.Pri_Stack_Info'Access; 218 end Get_Stack_Info_NT; 219 220 ----------------------------- 221 -- Save_Library_Occurrence -- 222 ----------------------------- 223 224 procedure Save_Library_Occurrence (E : EOA) is 225 use Ada.Exceptions; 226 begin 227 if not Library_Exception_Set then 228 Library_Exception_Set := True; 229 if E /= null then 230 Ada.Exceptions.Save_Occurrence (Library_Exception, E.all); 231 end if; 232 end if; 233 end Save_Library_Occurrence; 234 235 --------------------------- 236 -- Set_Jmpbuf_Address_NT -- 237 --------------------------- 238 239 procedure Set_Jmpbuf_Address_NT (Addr : Address) is 240 begin 241 NT_TSD.Jmpbuf_Address := Addr; 242 end Set_Jmpbuf_Address_NT; 243 244 procedure Set_Jmpbuf_Address_Soft (Addr : Address) is 245 begin 246 Set_Jmpbuf_Address (Addr); 247 end Set_Jmpbuf_Address_Soft; 248 249 ---------------------- 250 -- Set_Sec_Stack_NT -- 251 ---------------------- 252 253 procedure Set_Sec_Stack_NT (Stack : SST.SS_Stack_Ptr) is 254 begin 255 NT_TSD.Sec_Stack_Ptr := Stack; 256 end Set_Sec_Stack_NT; 257 258 ------------------------ 259 -- Set_Sec_Stack_Soft -- 260 ------------------------ 261 262 procedure Set_Sec_Stack_Soft (Stack : SST.SS_Stack_Ptr) is 263 begin 264 Set_Sec_Stack (Stack); 265 end Set_Sec_Stack_Soft; 266 267 ------------------ 268 -- Task_Lock_NT -- 269 ------------------ 270 271 procedure Task_Lock_NT is 272 begin 273 null; 274 end Task_Lock_NT; 275 276 ------------------ 277 -- Task_Name_NT -- 278 ------------------- 279 280 function Task_Name_NT return String is 281 begin 282 return "main_task"; 283 end Task_Name_NT; 284 285 ------------------------- 286 -- Task_Termination_NT -- 287 ------------------------- 288 289 procedure Task_Termination_NT (Excep : EO) is 290 pragma Unreferenced (Excep); 291 begin 292 null; 293 end Task_Termination_NT; 294 295 -------------------- 296 -- Task_Unlock_NT -- 297 -------------------- 298 299 procedure Task_Unlock_NT is 300 begin 301 null; 302 end Task_Unlock_NT; 303end System.Soft_Links; 304