aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/ada/s-soflin.ads
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.9/gcc/ada/s-soflin.ads')
-rw-r--r--gcc-4.9/gcc/ada/s-soflin.ads408
1 files changed, 408 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/ada/s-soflin.ads b/gcc-4.9/gcc/ada/s-soflin.ads
new file mode 100644
index 000000000..7f3ebe45a
--- /dev/null
+++ b/gcc-4.9/gcc/ada/s-soflin.ads
@@ -0,0 +1,408 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . S O F T _ L I N K S --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2013, 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 3, 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. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package contains a set of subprogram access variables that access
+-- some low-level primitives that are different depending whether tasking is
+-- involved or not (e.g. the Get/Set_Jmpbuf_Address that needs to provide a
+-- different value for each task). To avoid dragging in the tasking runtimes
+-- all the time, we use a system of soft links where the links are
+-- initialized to non-tasking versions, and then if the tasking support is
+-- initialized, they are set to the real tasking versions.
+
+pragma Compiler_Unit_Warning;
+
+with Ada.Exceptions;
+with System.Stack_Checking;
+
+package System.Soft_Links is
+ pragma Preelaborate;
+
+ subtype EOA is Ada.Exceptions.Exception_Occurrence_Access;
+ subtype EO is Ada.Exceptions.Exception_Occurrence;
+
+ function Current_Target_Exception return EO;
+ pragma Import
+ (Ada, Current_Target_Exception, "__gnat_current_target_exception");
+ -- Import this subprogram from the private part of Ada.Exceptions
+
+ -- First we have the access subprogram types used to establish the links.
+ -- The approach is to establish variables containing access subprogram
+ -- values, which by default point to dummy no tasking versions of routines.
+
+ type No_Param_Proc is access procedure;
+ pragma Favor_Top_Level (No_Param_Proc);
+ pragma Suppress_Initialization (No_Param_Proc);
+ -- Some uninitialized objects of that type are initialized by the Binder
+ -- so it is important that such objects are not reset to null during
+ -- elaboration.
+
+ type Addr_Param_Proc is access procedure (Addr : Address);
+ pragma Favor_Top_Level (Addr_Param_Proc);
+ type EO_Param_Proc is access procedure (Excep : EO);
+ pragma Favor_Top_Level (EO_Param_Proc);
+
+ type Get_Address_Call is access function return Address;
+ pragma Favor_Top_Level (Get_Address_Call);
+ type Set_Address_Call is access procedure (Addr : Address);
+ pragma Favor_Top_Level (Set_Address_Call);
+ type Set_Address_Call2 is access procedure
+ (Self_ID : Address; Addr : Address);
+ pragma Favor_Top_Level (Set_Address_Call2);
+
+ type Get_Integer_Call is access function return Integer;
+ pragma Favor_Top_Level (Get_Integer_Call);
+ type Set_Integer_Call is access procedure (Len : Integer);
+ pragma Favor_Top_Level (Set_Integer_Call);
+
+ type Get_EOA_Call is access function return EOA;
+ pragma Favor_Top_Level (Get_EOA_Call);
+ type Set_EOA_Call is access procedure (Excep : EOA);
+ pragma Favor_Top_Level (Set_EOA_Call);
+ type Set_EO_Call is access procedure (Excep : EO);
+ pragma Favor_Top_Level (Set_EO_Call);
+
+ type Special_EO_Call is access
+ procedure (Excep : EO := Current_Target_Exception);
+ pragma Favor_Top_Level (Special_EO_Call);
+
+ type Timed_Delay_Call is access
+ procedure (Time : Duration; Mode : Integer);
+ pragma Favor_Top_Level (Timed_Delay_Call);
+
+ type Get_Stack_Access_Call is access
+ function return Stack_Checking.Stack_Access;
+ pragma Favor_Top_Level (Get_Stack_Access_Call);
+
+ type Task_Name_Call is access
+ function return String;
+ pragma Favor_Top_Level (Task_Name_Call);
+
+ -- Suppress checks on all these types, since we know the corresponding
+ -- values can never be null (the soft links are always initialized).
+
+ pragma Suppress (Access_Check, No_Param_Proc);
+ pragma Suppress (Access_Check, Addr_Param_Proc);
+ pragma Suppress (Access_Check, EO_Param_Proc);
+ pragma Suppress (Access_Check, Get_Address_Call);
+ pragma Suppress (Access_Check, Set_Address_Call);
+ pragma Suppress (Access_Check, Set_Address_Call2);
+ pragma Suppress (Access_Check, Get_Integer_Call);
+ pragma Suppress (Access_Check, Set_Integer_Call);
+ pragma Suppress (Access_Check, Get_EOA_Call);
+ pragma Suppress (Access_Check, Set_EOA_Call);
+ pragma Suppress (Access_Check, Timed_Delay_Call);
+ pragma Suppress (Access_Check, Get_Stack_Access_Call);
+ pragma Suppress (Access_Check, Task_Name_Call);
+
+ -- The following one is not related to tasking/no-tasking but to the
+ -- traceback decorators for exceptions.
+
+ type Traceback_Decorator_Wrapper_Call is access
+ function (Traceback : System.Address;
+ Len : Natural)
+ return String;
+ pragma Favor_Top_Level (Traceback_Decorator_Wrapper_Call);
+
+ -- Declarations for the no tasking versions of the required routines
+
+ procedure Abort_Defer_NT;
+ -- Defer task abort (non-tasking case, does nothing)
+
+ procedure Abort_Undefer_NT;
+ -- Undefer task abort (non-tasking case, does nothing)
+
+ procedure Abort_Handler_NT;
+ -- Handle task abort (non-tasking case, does nothing). Currently, only VMS
+ -- uses this.
+
+ procedure Update_Exception_NT (X : EO := Current_Target_Exception);
+ -- Handle exception setting. This routine is provided for targets that
+ -- have built-in exception handling such as the Java Virtual Machine.
+ -- Currently, only JGNAT uses this. See 4jexcept.ads for an explanation on
+ -- how this routine is used.
+
+ function Check_Abort_Status_NT return Integer;
+ -- Returns Boolean'Pos (True) iff abort signal should raise
+ -- Standard'Abort_Signal.
+
+ procedure Task_Lock_NT;
+ -- Lock out other tasks (non-tasking case, does nothing)
+
+ procedure Task_Unlock_NT;
+ -- Release lock set by Task_Lock (non-tasking case, does nothing)
+
+ procedure Task_Termination_NT (Excep : EO);
+ -- Handle task termination routines for the environment task (non-tasking
+ -- case, does nothing).
+
+ procedure Adafinal_NT;
+ -- Shuts down the runtime system (non-tasking case)
+
+ Abort_Defer : No_Param_Proc := Abort_Defer_NT'Access;
+ pragma Suppress (Access_Check, Abort_Defer);
+ -- Defer task abort (task/non-task case as appropriate)
+
+ Abort_Undefer : No_Param_Proc := Abort_Undefer_NT'Access;
+ pragma Suppress (Access_Check, Abort_Undefer);
+ -- Undefer task abort (task/non-task case as appropriate)
+
+ Abort_Handler : No_Param_Proc := Abort_Handler_NT'Access;
+ -- Handle task abort (task/non-task case as appropriate)
+
+ Update_Exception : Special_EO_Call := Update_Exception_NT'Access;
+ -- Handle exception setting and tasking polling when appropriate
+
+ Check_Abort_Status : Get_Integer_Call := Check_Abort_Status_NT'Access;
+ -- Called when Abort_Signal is delivered to the process. Checks to
+ -- see if signal should result in raising Standard'Abort_Signal.
+
+ Lock_Task : No_Param_Proc := Task_Lock_NT'Access;
+ -- Locks out other tasks. Preceding a section of code by Task_Lock and
+ -- following it by Task_Unlock creates a critical region. This is used
+ -- for ensuring that a region of non-tasking code (such as code used to
+ -- allocate memory) is tasking safe. Note that it is valid for calls to
+ -- Task_Lock/Task_Unlock to be nested, and this must work properly, i.e.
+ -- only the corresponding outer level Task_Unlock will actually unlock.
+ -- This routine also prevents against asynchronous aborts (abort is
+ -- deferred).
+
+ Unlock_Task : No_Param_Proc := Task_Unlock_NT'Access;
+ -- Releases lock previously set by call to Lock_Task. In the nested case,
+ -- all nested locks must be released before other tasks competing for the
+ -- tasking lock are released.
+ --
+ -- In the non nested case, this routine terminates the protection against
+ -- asynchronous aborts introduced by Lock_Task (unless abort was already
+ -- deferred before the call to Lock_Task (e.g in a protected procedures).
+ --
+ -- Note: the recommended protocol for using Lock_Task and Unlock_Task
+ -- is as follows:
+ --
+ -- Locked_Processing : begin
+ -- System.Soft_Links.Lock_Task.all;
+ -- ...
+ -- System.Soft_Links.Unlock_Task.all;
+ --
+ -- exception
+ -- when others =>
+ -- System.Soft_Links.Unlock_Task.all;
+ -- raise;
+ -- end Locked_Processing;
+ --
+ -- This ensures that the lock is not left set if an exception is raised
+ -- explicitly or implicitly during the critical locked region.
+
+ Task_Termination_Handler : EO_Param_Proc := Task_Termination_NT'Access;
+ -- Handle task termination routines (task/non-task case as appropriate)
+
+ Finalize_Library_Objects : No_Param_Proc;
+ pragma Export (C, Finalize_Library_Objects,
+ "__gnat_finalize_library_objects");
+ -- Will be initialized by the binder
+
+ Adafinal : No_Param_Proc := Adafinal_NT'Access;
+ -- Performs the finalization of the Ada Runtime
+
+ function Get_Jmpbuf_Address_NT return Address;
+ procedure Set_Jmpbuf_Address_NT (Addr : Address);
+
+ Get_Jmpbuf_Address : Get_Address_Call := Get_Jmpbuf_Address_NT'Access;
+ Set_Jmpbuf_Address : Set_Address_Call := Set_Jmpbuf_Address_NT'Access;
+
+ function Get_Sec_Stack_Addr_NT return Address;
+ procedure Set_Sec_Stack_Addr_NT (Addr : Address);
+
+ Get_Sec_Stack_Addr : Get_Address_Call := Get_Sec_Stack_Addr_NT'Access;
+ Set_Sec_Stack_Addr : Set_Address_Call := Set_Sec_Stack_Addr_NT'Access;
+
+ function Get_Current_Excep_NT return EOA;
+
+ Get_Current_Excep : Get_EOA_Call := Get_Current_Excep_NT'Access;
+
+ function Get_Stack_Info_NT return Stack_Checking.Stack_Access;
+
+ Get_Stack_Info : Get_Stack_Access_Call := Get_Stack_Info_NT'Access;
+
+ --------------------------
+ -- Master_Id Soft-Links --
+ --------------------------
+
+ -- Soft-Links are used for procedures that manipulate Master_Ids because
+ -- a Master_Id must be generated for access to limited class-wide types,
+ -- whose root may be extended with task components.
+
+ function Current_Master_NT return Integer;
+ procedure Enter_Master_NT;
+ procedure Complete_Master_NT;
+
+ Current_Master : Get_Integer_Call := Current_Master_NT'Access;
+ Enter_Master : No_Param_Proc := Enter_Master_NT'Access;
+ Complete_Master : No_Param_Proc := Complete_Master_NT'Access;
+
+ ----------------------
+ -- Delay Soft-Links --
+ ----------------------
+
+ -- Soft-Links are used for procedures that manipulate time to avoid
+ -- dragging the tasking run time when using delay statements.
+
+ Timed_Delay : Timed_Delay_Call;
+
+ --------------------------
+ -- Task Name Soft-Links --
+ --------------------------
+
+ function Task_Name_NT return String;
+
+ Task_Name : Task_Name_Call := Task_Name_NT'Access;
+
+ -------------------------------------
+ -- Exception Tracebacks Soft-Links --
+ -------------------------------------
+
+ Library_Exception : EO;
+ -- Library-level finalization routines use this common reference to store
+ -- the first library-level exception which occurs during finalization.
+
+ Library_Exception_Set : Boolean := False;
+ -- Used in conjunction with Library_Exception, set when an exception has
+ -- been stored.
+
+ Traceback_Decorator_Wrapper : Traceback_Decorator_Wrapper_Call;
+ -- Wrapper to the possible user specified traceback decorator to be
+ -- called during automatic output of exception data.
+
+ -- The nullity of this wrapper shall correspond to the nullity of the
+ -- current actual decorator. This is ensured first by the null initial
+ -- value of the corresponding variables, and then by Set_Trace_Decorator
+ -- in g-exctra.adb.
+
+ pragma Atomic (Traceback_Decorator_Wrapper);
+ -- Since concurrent read/write operations may occur on this variable.
+ -- See the body of Tailored_Exception_Traceback in Ada.Exceptions for
+ -- a more detailed description of the potential problems.
+
+ procedure Save_Library_Occurrence (E : EOA);
+ -- When invoked, this routine saves an exception occurrence into a hidden
+ -- reference. Subsequent calls will have no effect.
+
+ ------------------------
+ -- Task Specific Data --
+ ------------------------
+
+ -- Here we define a single type that encapsulates the various task
+ -- specific data. This type is used to store the necessary data into the
+ -- Task_Control_Block or into a global variable in the non tasking case.
+
+ type TSD is record
+ Pri_Stack_Info : aliased Stack_Checking.Stack_Info;
+ -- Information on stack (Base/Limit/Size) used by System.Stack_Checking.
+ -- If this TSD does not belong to the environment task, the Size field
+ -- must be initialized to the tasks requested stack size before the task
+ -- can do its first stack check.
+
+ pragma Warnings (Off);
+ -- Needed because we are giving a non-static default to an object in
+ -- a preelaborated unit, which is formally not permitted, but OK here.
+
+ Jmpbuf_Address : System.Address := System.Null_Address;
+ -- Address of jump buffer used to store the address of the current
+ -- longjmp/setjmp buffer for exception management. These buffers are
+ -- threaded into a stack, and the address here is the top of the stack.
+ -- A null address means that no exception handler is currently active.
+
+ Sec_Stack_Addr : System.Address := System.Null_Address;
+ pragma Warnings (On);
+ -- Address of currently allocated secondary stack
+
+ Current_Excep : aliased EO;
+ -- Exception occurrence that contains the information for the current
+ -- exception. Note that any exception in the same task destroys this
+ -- information, so the data in this variable must be copied out before
+ -- another exception can occur.
+ --
+ -- Also act as a list of the active exceptions in the case of the GCC
+ -- exception mechanism, organized as a stack with the most recent first.
+ end record;
+
+ procedure Create_TSD (New_TSD : in out TSD);
+ pragma Inline (Create_TSD);
+ -- Called from s-tassta when a new thread is created to perform
+ -- any required initialization of the TSD.
+
+ procedure Destroy_TSD (Old_TSD : in out TSD);
+ pragma Inline (Destroy_TSD);
+ -- Called from s-tassta just before a thread is destroyed to perform
+ -- any required finalization.
+
+ function Get_GNAT_Exception return Ada.Exceptions.Exception_Id;
+ pragma Inline (Get_GNAT_Exception);
+ -- This function obtains the Exception_Id from the Exception_Occurrence
+ -- referenced by the Current_Excep field of the task specific data, i.e.
+ -- the call is equivalent to
+ -- Exception_Identity (Get_Current_Exception.all)
+
+ -- Export the Get/Set routines for the various Task Specific Data (TSD)
+ -- elements as callable subprograms instead of objects of access to
+ -- subprogram types.
+
+ function Get_Jmpbuf_Address_Soft return Address;
+ procedure Set_Jmpbuf_Address_Soft (Addr : Address);
+ pragma Inline (Get_Jmpbuf_Address_Soft);
+ pragma Inline (Set_Jmpbuf_Address_Soft);
+
+ function Get_Sec_Stack_Addr_Soft return Address;
+ procedure Set_Sec_Stack_Addr_Soft (Addr : Address);
+ pragma Inline (Get_Sec_Stack_Addr_Soft);
+ pragma Inline (Set_Sec_Stack_Addr_Soft);
+
+ -- The following is a dummy record designed to mimic Communication_Block as
+ -- defined in s-tpobop.ads:
+
+ -- type Communication_Block is record
+ -- Self : Task_Id; -- An access type
+ -- Enqueued : Boolean := True;
+ -- Cancelled : Boolean := False;
+ -- end record;
+
+ -- The record is used in the construction of the predefined dispatching
+ -- primitive _disp_asynchronous_select in order to avoid the import of
+ -- System.Tasking.Protected_Objects.Operations. Note that this package
+ -- is always imported in the presence of interfaces since the dispatch
+ -- table uses entities from here.
+
+ type Dummy_Communication_Block is record
+ Comp_1 : Address; -- Address and access have the same size
+ Comp_2 : Boolean;
+ Comp_3 : Boolean;
+ end record;
+
+end System.Soft_Links;