File : s-soflin.adb
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
5 -- S Y S T E M . S O F T _ L I N K S --
-- --
-- B o d y --
-- --
-- $Revision: 1.18 $
10 -- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
25 -- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
30 -- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
35
pragma Polling (Off);
-- We must turn polling off for this unit, because otherwise we get
-- an infinite loop from the code within the Poll routine itself.
40 with System.Machine_State_Operations; use System.Machine_State_Operations;
-- Used for Create_TSD, Destroy_TSD
with System.Parameters;
-- Used for Sec_Stack_Ratio
45
with System.Secondary_Stack;
package body System.Soft_Links is
50 package SST renames System.Secondary_Stack;
-- Allocate an exception stack for the main program to use.
-- We make sure that the stack has maximum alignment. Some systems require
-- this (e.g. Sun), and in any case it is a good idea for efficiency.
55
NT_Exc_Stack : array (0 .. 8192) of aliased Character;
for NT_Exc_Stack'Alignment use Standard'Maximum_Alignment;
NT_TSD : TSD;
60
--------------------
-- Abort_Defer_NT --
--------------------
65 procedure Abort_Defer_NT is
begin
null;
end Abort_Defer_NT;
70 ----------------------
-- Abort_Handler_NT --
----------------------
procedure Abort_Handler_NT is
75 begin
null;
end Abort_Handler_NT;
----------------------
80 -- Abort_Undefer_NT --
----------------------
procedure Abort_Undefer_NT is
begin
85 null;
end Abort_Undefer_NT;
---------------------------
-- Check_Abort_Status_NT --
90 ---------------------------
function Check_Abort_Status_NT return Integer is
begin
return Boolean'Pos (False);
95 end Check_Abort_Status_NT;
------------------------
-- Complete_Master_NT --
------------------------
100
procedure Complete_Master_NT is
begin
null;
end Complete_Master_NT;
105
----------------
-- Create_TSD --
----------------
110 procedure Create_TSD (New_TSD : in out TSD) is
use type Parameters.Size_Type;
SS_Ratio_Dynamic : constant Boolean :=
Parameters.Sec_Stack_Ratio = Parameters.Dynamic;
115
begin
if SS_Ratio_Dynamic then
SST.SS_Init
(New_TSD.Sec_Stack_Addr, SST.Default_Secondary_Stack_Size);
120 end if;
New_TSD.Machine_State_Addr :=
System.Address
(System.Machine_State_Operations.Allocate_Machine_State);
125 end Create_TSD;
-----------------------
-- Current_Master_NT --
-----------------------
130
function Current_Master_NT return Integer is
begin
return 0;
end Current_Master_NT;
135
-----------------
-- Destroy_TSD --
-----------------
140 procedure Destroy_TSD (Old_TSD : in out TSD) is
begin
SST.SS_Free (Old_TSD.Sec_Stack_Addr);
System.Machine_State_Operations.Free_Machine_State
(Machine_State (Old_TSD.Machine_State_Addr));
145 end Destroy_TSD;
---------------------
-- Enter_Master_NT --
---------------------
150
procedure Enter_Master_NT is
begin
null;
end Enter_Master_NT;
155
--------------------------
-- Get_Current_Excep_NT --
--------------------------
160 function Get_Current_Excep_NT return EOA is
begin
return NT_TSD.Current_Excep'Access;
end Get_Current_Excep_NT;
165 ---------------------------
-- Get_Exc_Stack_Addr_NT --
---------------------------
function Get_Exc_Stack_Addr_NT return Address is
170 begin
return NT_TSD.Exc_Stack_Addr;
end Get_Exc_Stack_Addr_NT;
-----------------------------
175 -- Get_Exc_Stack_Addr_Soft --
-----------------------------
function Get_Exc_Stack_Addr_Soft return Address is
begin
180 return Get_Exc_Stack_Addr.all;
end Get_Exc_Stack_Addr_Soft;
------------------------
-- Get_GNAT_Exception --
185 ------------------------
function Get_GNAT_Exception return Ada.Exceptions.Exception_Id is
begin
return Ada.Exceptions.Exception_Identity (Get_Current_Excep.all.all);
190 end Get_GNAT_Exception;
---------------------------
-- Get_Jmpbuf_Address_NT --
---------------------------
195
function Get_Jmpbuf_Address_NT return Address is
begin
return NT_TSD.Jmpbuf_Address;
end Get_Jmpbuf_Address_NT;
200
-----------------------------
-- Get_Jmpbuf_Address_Soft --
-----------------------------
205 function Get_Jmpbuf_Address_Soft return Address is
begin
return Get_Jmpbuf_Address.all;
end Get_Jmpbuf_Address_Soft;
210 -------------------------------
-- Get_Machine_State_Addr_NT --
-------------------------------
function Get_Machine_State_Addr_NT return Address is
215 begin
return NT_TSD.Machine_State_Addr;
end Get_Machine_State_Addr_NT;
---------------------------------
220 -- Get_Machine_State_Addr_Soft --
---------------------------------
function Get_Machine_State_Addr_Soft return Address is
begin
225 return Get_Machine_State_Addr.all;
end Get_Machine_State_Addr_Soft;
---------------------------
-- Get_Sec_Stack_Addr_NT --
230 ---------------------------
function Get_Sec_Stack_Addr_NT return Address is
begin
return NT_TSD.Sec_Stack_Addr;
235 end Get_Sec_Stack_Addr_NT;
-----------------------------
-- Get_Sec_Stack_Addr_Soft --
-----------------------------
240
function Get_Sec_Stack_Addr_Soft return Address is
begin
return Get_Sec_Stack_Addr.all;
end Get_Sec_Stack_Addr_Soft;
245
-----------------------
-- Get_Stack_Info_NT --
-----------------------
250 function Get_Stack_Info_NT return Stack_Checking.Stack_Access is
begin
return NT_TSD.Pri_Stack_Info'Access;
end Get_Stack_Info_NT;
255 -------------------
-- Null_Adafinal --
-------------------
procedure Null_Adafinal is
260 begin
null;
end Null_Adafinal;
---------------------------
265 -- Set_Exc_Stack_Addr_NT --
---------------------------
procedure Set_Exc_Stack_Addr_NT (Self_ID : Address; Addr : Address) is
pragma Warnings (Off, Self_ID);
270
begin
NT_TSD.Exc_Stack_Addr := Addr;
end Set_Exc_Stack_Addr_NT;
275 -----------------------------
-- Set_Exc_Stack_Addr_Soft --
-----------------------------
procedure Set_Exc_Stack_Addr_Soft (Self_ID : Address; Addr : Address) is
280 begin
Set_Exc_Stack_Addr (Self_ID, Addr);
end Set_Exc_Stack_Addr_Soft;
---------------------------
285 -- Set_Jmpbuf_Address_NT --
---------------------------
procedure Set_Jmpbuf_Address_NT (Addr : Address) is
begin
290 NT_TSD.Jmpbuf_Address := Addr;
end Set_Jmpbuf_Address_NT;
procedure Set_Jmpbuf_Address_Soft (Addr : Address) is
begin
295 Set_Jmpbuf_Address (Addr);
end Set_Jmpbuf_Address_Soft;
-------------------------------
-- Set_Machine_State_Addr_NT --
300 -------------------------------
procedure Set_Machine_State_Addr_NT (Addr : Address) is
begin
NT_TSD.Machine_State_Addr := Addr;
305 end Set_Machine_State_Addr_NT;
---------------------------------
-- Set_Machine_State_Addr_Soft --
---------------------------------
310
procedure Set_Machine_State_Addr_Soft (Addr : Address) is
begin
Set_Machine_State_Addr (Addr);
end Set_Machine_State_Addr_Soft;
315
---------------------------
-- Set_Sec_Stack_Addr_NT --
---------------------------
320 procedure Set_Sec_Stack_Addr_NT (Addr : Address) is
begin
NT_TSD.Sec_Stack_Addr := Addr;
end Set_Sec_Stack_Addr_NT;
325 -----------------------------
-- Set_Sec_Stack_Addr_Soft --
-----------------------------
procedure Set_Sec_Stack_Addr_Soft (Addr : Address) is
330 begin
Set_Sec_Stack_Addr (Addr);
end Set_Sec_Stack_Addr_Soft;
------------------
335 -- Task_Lock_NT --
------------------
procedure Task_Lock_NT is
begin
340 null;
end Task_Lock_NT;
--------------------
-- Task_Unlock_NT --
345 --------------------
procedure Task_Unlock_NT is
begin
null;
350 end Task_Unlock_NT;
-------------------------
-- Update_Exception_NT --
-------------------------
355
procedure Update_Exception_NT (X : EO := Current_Target_Exception) is
begin
Ada.Exceptions.Save_Occurrence (NT_TSD.Current_Excep, X);
end Update_Exception_NT;
360
------------------
-- Task_Name_NT --
-------------------
365 function Task_Name_NT return String is
begin
return "main_task";
end Task_Name_NT;
370 -------------------------
-- Package Elaboration --
-------------------------
begin
375 NT_TSD.Exc_Stack_Addr := NT_Exc_Stack (8192)'Address;
Ada.Exceptions.Save_Occurrence
(NT_TSD.Current_Excep, Ada.Exceptions.Null_Occurrence);
end System.Soft_Links;