1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- S Y S T E M . S O F T _ L I N K S --
9 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
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 2, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
35 -- We must turn polling off for this unit, because otherwise we get
36 -- an infinite loop from the code within the Poll routine itself.
38 with System.Machine_State_Operations; use System.Machine_State_Operations;
39 -- Used for Create_TSD, Destroy_TSD
41 with System.Parameters;
42 -- Used for Sec_Stack_Ratio
44 with System.Secondary_Stack;
46 package body System.Soft_Links is
48 package SST renames System.Secondary_Stack;
50 -- Allocate an exception stack for the main program to use.
51 -- We make sure that the stack has maximum alignment. Some systems require
52 -- this (e.g. Sun), and in any case it is a good idea for efficiency.
54 NT_Exc_Stack : array (0 .. 8192) of aliased Character;
55 for NT_Exc_Stack'Alignment use Standard'Maximum_Alignment;
63 procedure Abort_Defer_NT is
68 ----------------------
69 -- Abort_Handler_NT --
70 ----------------------
72 procedure Abort_Handler_NT is
77 ----------------------
78 -- Abort_Undefer_NT --
79 ----------------------
81 procedure Abort_Undefer_NT is
86 ---------------------------
87 -- Check_Abort_Status_NT --
88 ---------------------------
90 function Check_Abort_Status_NT return Integer is
92 return Boolean'Pos (False);
93 end Check_Abort_Status_NT;
95 ------------------------
96 -- Complete_Master_NT --
97 ------------------------
99 procedure Complete_Master_NT is
102 end Complete_Master_NT;
108 procedure Create_TSD (New_TSD : in out TSD) is
109 use type Parameters.Size_Type;
111 SS_Ratio_Dynamic : constant Boolean :=
112 Parameters.Sec_Stack_Ratio = Parameters.Dynamic;
115 if SS_Ratio_Dynamic then
117 (New_TSD.Sec_Stack_Addr, SST.Default_Secondary_Stack_Size);
120 New_TSD.Machine_State_Addr :=
122 (System.Machine_State_Operations.Allocate_Machine_State);
125 -----------------------
126 -- Current_Master_NT --
127 -----------------------
129 function Current_Master_NT return Integer is
132 end Current_Master_NT;
138 procedure Destroy_TSD (Old_TSD : in out TSD) is
140 SST.SS_Free (Old_TSD.Sec_Stack_Addr);
141 System.Machine_State_Operations.Free_Machine_State
142 (Machine_State (Old_TSD.Machine_State_Addr));
145 ---------------------
146 -- Enter_Master_NT --
147 ---------------------
149 procedure Enter_Master_NT is
154 --------------------------
155 -- Get_Current_Excep_NT --
156 --------------------------
158 function Get_Current_Excep_NT return EOA is
160 return NT_TSD.Current_Excep'Access;
161 end Get_Current_Excep_NT;
163 ---------------------------
164 -- Get_Exc_Stack_Addr_NT --
165 ---------------------------
167 function Get_Exc_Stack_Addr_NT return Address is
169 return NT_TSD.Exc_Stack_Addr;
170 end Get_Exc_Stack_Addr_NT;
172 -----------------------------
173 -- Get_Exc_Stack_Addr_Soft --
174 -----------------------------
176 function Get_Exc_Stack_Addr_Soft return Address is
178 return Get_Exc_Stack_Addr.all;
179 end Get_Exc_Stack_Addr_Soft;
181 ------------------------
182 -- Get_GNAT_Exception --
183 ------------------------
185 function Get_GNAT_Exception return Ada.Exceptions.Exception_Id is
187 return Ada.Exceptions.Exception_Identity (Get_Current_Excep.all.all);
188 end Get_GNAT_Exception;
190 ---------------------------
191 -- Get_Jmpbuf_Address_NT --
192 ---------------------------
194 function Get_Jmpbuf_Address_NT return Address is
196 return NT_TSD.Jmpbuf_Address;
197 end Get_Jmpbuf_Address_NT;
199 -----------------------------
200 -- Get_Jmpbuf_Address_Soft --
201 -----------------------------
203 function Get_Jmpbuf_Address_Soft return Address is
205 return Get_Jmpbuf_Address.all;
206 end Get_Jmpbuf_Address_Soft;
208 -------------------------------
209 -- Get_Machine_State_Addr_NT --
210 -------------------------------
212 function Get_Machine_State_Addr_NT return Address is
214 return NT_TSD.Machine_State_Addr;
215 end Get_Machine_State_Addr_NT;
217 ---------------------------------
218 -- Get_Machine_State_Addr_Soft --
219 ---------------------------------
221 function Get_Machine_State_Addr_Soft return Address is
223 return Get_Machine_State_Addr.all;
224 end Get_Machine_State_Addr_Soft;
226 ---------------------------
227 -- Get_Sec_Stack_Addr_NT --
228 ---------------------------
230 function Get_Sec_Stack_Addr_NT return Address is
232 return NT_TSD.Sec_Stack_Addr;
233 end Get_Sec_Stack_Addr_NT;
235 -----------------------------
236 -- Get_Sec_Stack_Addr_Soft --
237 -----------------------------
239 function Get_Sec_Stack_Addr_Soft return Address is
241 return Get_Sec_Stack_Addr.all;
242 end Get_Sec_Stack_Addr_Soft;
244 -----------------------
245 -- Get_Stack_Info_NT --
246 -----------------------
248 function Get_Stack_Info_NT return Stack_Checking.Stack_Access is
250 return NT_TSD.Pri_Stack_Info'Access;
251 end Get_Stack_Info_NT;
257 procedure Null_Adafinal is
262 ---------------------------
263 -- Set_Exc_Stack_Addr_NT --
264 ---------------------------
266 procedure Set_Exc_Stack_Addr_NT (Self_ID : Address; Addr : Address) is
267 pragma Warnings (Off, Self_ID);
270 NT_TSD.Exc_Stack_Addr := Addr;
271 end Set_Exc_Stack_Addr_NT;
273 -----------------------------
274 -- Set_Exc_Stack_Addr_Soft --
275 -----------------------------
277 procedure Set_Exc_Stack_Addr_Soft (Self_ID : Address; Addr : Address) is
279 Set_Exc_Stack_Addr (Self_ID, Addr);
280 end Set_Exc_Stack_Addr_Soft;
282 ---------------------------
283 -- Set_Jmpbuf_Address_NT --
284 ---------------------------
286 procedure Set_Jmpbuf_Address_NT (Addr : Address) is
288 NT_TSD.Jmpbuf_Address := Addr;
289 end Set_Jmpbuf_Address_NT;
291 procedure Set_Jmpbuf_Address_Soft (Addr : Address) is
293 Set_Jmpbuf_Address (Addr);
294 end Set_Jmpbuf_Address_Soft;
296 -------------------------------
297 -- Set_Machine_State_Addr_NT --
298 -------------------------------
300 procedure Set_Machine_State_Addr_NT (Addr : Address) is
302 NT_TSD.Machine_State_Addr := Addr;
303 end Set_Machine_State_Addr_NT;
305 ---------------------------------
306 -- Set_Machine_State_Addr_Soft --
307 ---------------------------------
309 procedure Set_Machine_State_Addr_Soft (Addr : Address) is
311 Set_Machine_State_Addr (Addr);
312 end Set_Machine_State_Addr_Soft;
314 ---------------------------
315 -- Set_Sec_Stack_Addr_NT --
316 ---------------------------
318 procedure Set_Sec_Stack_Addr_NT (Addr : Address) is
320 NT_TSD.Sec_Stack_Addr := Addr;
321 end Set_Sec_Stack_Addr_NT;
323 -----------------------------
324 -- Set_Sec_Stack_Addr_Soft --
325 -----------------------------
327 procedure Set_Sec_Stack_Addr_Soft (Addr : Address) is
329 Set_Sec_Stack_Addr (Addr);
330 end Set_Sec_Stack_Addr_Soft;
336 procedure Task_Lock_NT is
345 procedure Task_Unlock_NT is
350 -------------------------
351 -- Update_Exception_NT --
352 -------------------------
354 procedure Update_Exception_NT (X : EO := Current_Target_Exception) is
356 Ada.Exceptions.Save_Occurrence (NT_TSD.Current_Excep, X);
357 end Update_Exception_NT;
363 function Task_Name_NT return String is
368 -------------------------
369 -- Package Elaboration --
370 -------------------------
373 NT_TSD.Exc_Stack_Addr := NT_Exc_Stack (8192)'Address;
374 Ada.Exceptions.Save_Occurrence
375 (NT_TSD.Current_Excep, Ada.Exceptions.Null_Occurrence);
377 end System.Soft_Links;