+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- S Y S T E M . S O F T _ L I N K S --
--- --
--- B o d y --
--- --
--- $Revision: 1.1.16.1 $
--- --
--- 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- --
--- 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 --
--- 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 --
--- 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. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
-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.
-
-with System.Machine_State_Operations; use System.Machine_State_Operations;
--- Used for Create_TSD, Destroy_TSD
-
-with System.Parameters;
--- Used for Sec_Stack_Ratio
-
-with System.Secondary_Stack;
-
-package body System.Soft_Links is
-
- 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.
-
- NT_Exc_Stack : array (0 .. 8192) of aliased Character;
- for NT_Exc_Stack'Alignment use Standard'Maximum_Alignment;
-
- NT_TSD : TSD;
-
- --------------------
- -- Abort_Defer_NT --
- --------------------
-
- procedure Abort_Defer_NT is
- begin
- null;
- end Abort_Defer_NT;
-
- ----------------------
- -- Abort_Handler_NT --
- ----------------------
-
- procedure Abort_Handler_NT is
- begin
- null;
- end Abort_Handler_NT;
-
- ----------------------
- -- Abort_Undefer_NT --
- ----------------------
-
- procedure Abort_Undefer_NT is
- begin
- null;
- end Abort_Undefer_NT;
-
- ---------------------------
- -- Check_Abort_Status_NT --
- ---------------------------
-
- function Check_Abort_Status_NT return Integer is
- begin
- return Boolean'Pos (False);
- end Check_Abort_Status_NT;
-
- ------------------------
- -- Complete_Master_NT --
- ------------------------
-
- procedure Complete_Master_NT is
- begin
- null;
- end Complete_Master_NT;
-
- ----------------
- -- Create_TSD --
- ----------------
-
- 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;
- begin
-
- if SS_Ratio_Dynamic then
- SST.SS_Init
- (New_TSD.Sec_Stack_Addr, SST.Default_Secondary_Stack_Size);
- end if;
-
- New_TSD.Machine_State_Addr :=
- System.Address
- (System.Machine_State_Operations.Allocate_Machine_State);
- end Create_TSD;
-
- -----------------------
- -- Current_Master_NT --
- -----------------------
-
- function Current_Master_NT return Integer is
- begin
- return 0;
- end Current_Master_NT;
-
- -----------------
- -- Destroy_TSD --
- -----------------
-
- 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));
- end Destroy_TSD;
-
- ---------------------
- -- Enter_Master_NT --
- ---------------------
-
- procedure Enter_Master_NT is
- begin
- null;
- end Enter_Master_NT;
-
- --------------------------
- -- Get_Current_Excep_NT --
- --------------------------
-
- function Get_Current_Excep_NT return EOA is
- begin
- return NT_TSD.Current_Excep'Access;
- end Get_Current_Excep_NT;
-
- ---------------------------
- -- Get_Exc_Stack_Addr_NT --
- ---------------------------
-
- function Get_Exc_Stack_Addr_NT return Address is
- begin
- return NT_TSD.Exc_Stack_Addr;
- end Get_Exc_Stack_Addr_NT;
-
- -----------------------------
- -- Get_Exc_Stack_Addr_Soft --
- -----------------------------
-
- function Get_Exc_Stack_Addr_Soft return Address is
- begin
- return Get_Exc_Stack_Addr.all;
- end Get_Exc_Stack_Addr_Soft;
-
- ------------------------
- -- Get_GNAT_Exception --
- ------------------------
-
- function Get_GNAT_Exception return Ada.Exceptions.Exception_Id is
- begin
- return Ada.Exceptions.Exception_Identity (Get_Current_Excep.all.all);
- end Get_GNAT_Exception;
-
- ---------------------------
- -- Get_Jmpbuf_Address_NT --
- ---------------------------
-
- function Get_Jmpbuf_Address_NT return Address is
- begin
- return NT_TSD.Jmpbuf_Address;
- end Get_Jmpbuf_Address_NT;
-
- -----------------------------
- -- Get_Jmpbuf_Address_Soft --
- -----------------------------
-
- function Get_Jmpbuf_Address_Soft return Address is
- begin
- return Get_Jmpbuf_Address.all;
- end Get_Jmpbuf_Address_Soft;
-
- -------------------------------
- -- Get_Machine_State_Addr_NT --
- -------------------------------
-
- function Get_Machine_State_Addr_NT return Address is
- begin
- return NT_TSD.Machine_State_Addr;
- end Get_Machine_State_Addr_NT;
-
- ---------------------------------
- -- Get_Machine_State_Addr_Soft --
- ---------------------------------
-
- function Get_Machine_State_Addr_Soft return Address is
- begin
- return Get_Machine_State_Addr.all;
- end Get_Machine_State_Addr_Soft;
-
- ---------------------------
- -- Get_Sec_Stack_Addr_NT --
- ---------------------------
-
- function Get_Sec_Stack_Addr_NT return Address is
- begin
- return NT_TSD.Sec_Stack_Addr;
- end Get_Sec_Stack_Addr_NT;
-
- -----------------------------
- -- Get_Sec_Stack_Addr_Soft --
- -----------------------------
-
- function Get_Sec_Stack_Addr_Soft return Address is
- begin
- return Get_Sec_Stack_Addr.all;
- end Get_Sec_Stack_Addr_Soft;
-
- -----------------------
- -- Get_Stack_Info_NT --
- -----------------------
-
- function Get_Stack_Info_NT return Stack_Checking.Stack_Access is
- begin
- return NT_TSD.Pri_Stack_Info'Access;
- end Get_Stack_Info_NT;
-
- -------------------
- -- Null_Adafinal --
- -------------------
-
- procedure Null_Adafinal is
- begin
- null;
- end Null_Adafinal;
-
- ---------------------------
- -- Set_Exc_Stack_Addr_NT --
- ---------------------------
-
- procedure Set_Exc_Stack_Addr_NT (Self_ID : Address; Addr : Address) is
- begin
- NT_TSD.Exc_Stack_Addr := Addr;
- end Set_Exc_Stack_Addr_NT;
-
- -----------------------------
- -- Set_Exc_Stack_Addr_Soft --
- -----------------------------
-
- procedure Set_Exc_Stack_Addr_Soft (Self_ID : Address; Addr : Address) is
- begin
- Set_Exc_Stack_Addr (Self_ID, Addr);
- end Set_Exc_Stack_Addr_Soft;
-
- ---------------------------
- -- Set_Jmpbuf_Address_NT --
- ---------------------------
-
- procedure Set_Jmpbuf_Address_NT (Addr : Address) is
- begin
- NT_TSD.Jmpbuf_Address := Addr;
- end Set_Jmpbuf_Address_NT;
-
- procedure Set_Jmpbuf_Address_Soft (Addr : Address) is
- begin
- Set_Jmpbuf_Address (Addr);
- end Set_Jmpbuf_Address_Soft;
-
- -------------------------------
- -- Set_Machine_State_Addr_NT --
- -------------------------------
-
- procedure Set_Machine_State_Addr_NT (Addr : Address) is
- begin
- NT_TSD.Machine_State_Addr := Addr;
- end Set_Machine_State_Addr_NT;
-
- ---------------------------------
- -- Set_Machine_State_Addr_Soft --
- ---------------------------------
-
- procedure Set_Machine_State_Addr_Soft (Addr : Address) is
- begin
- Set_Machine_State_Addr (Addr);
- end Set_Machine_State_Addr_Soft;
-
- ---------------------------
- -- Set_Sec_Stack_Addr_NT --
- ---------------------------
-
- procedure Set_Sec_Stack_Addr_NT (Addr : Address) is
- begin
- NT_TSD.Sec_Stack_Addr := Addr;
- end Set_Sec_Stack_Addr_NT;
-
- -----------------------------
- -- Set_Sec_Stack_Addr_Soft --
- -----------------------------
-
- procedure Set_Sec_Stack_Addr_Soft (Addr : Address) is
- begin
- Set_Sec_Stack_Addr (Addr);
- end Set_Sec_Stack_Addr_Soft;
-
- ------------------
- -- Task_Lock_NT --
- ------------------
-
- procedure Task_Lock_NT is
- begin
- null;
- end Task_Lock_NT;
-
- --------------------
- -- Task_Unlock_NT --
- --------------------
-
- procedure Task_Unlock_NT is
- begin
- null;
- end Task_Unlock_NT;
-
- -------------------------
- -- Update_Exception_NT --
- -------------------------
-
- procedure Update_Exception_NT (X : EO := Current_Target_Exception) is
- begin
- Ada.Exceptions.Save_Occurrence (NT_TSD.Current_Excep, X);
- end Update_Exception_NT;
-
- -------------------------
- -- Package Elaboration --
- -------------------------
-
-begin
- 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;
projects / msp430-gcc.git / blobdiff