| ------------------------------------------------------------------------------ |
| -- -- |
| -- 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-2014, 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, no port |
| -- makes use of this, but we retain the interface for possible future use. |
| |
| 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 null value of this wrapper correspond sto the null value 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; |
