-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- --
-- GNARL 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. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- 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. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNARL; see file COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
--- 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. --
+-- 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/>. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- This is a POSIX-like version of this package
--- This package contains all the GNULL primitives that interface directly
--- with the underlying OS.
+-- This package contains all the GNULL primitives that interface directly with
+-- the underlying OS.
--- Note: this file can only be used for POSIX compliant systems that
--- implement SCHED_FIFO and Ceiling Locking correctly.
+-- Note: this file can only be used for POSIX compliant systems that implement
+-- SCHED_FIFO and Ceiling Locking correctly.
-- For configurations where SCHED_FIFO and priority ceiling are not a
-- requirement, this file can also be used (e.g AiX threads)
pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during
--- tasking operations. It causes infinite loops and other problems.
+-- Turn off polling, we do not want ATC polling to take place during tasking
+-- operations. It causes infinite loops and other problems.
-with System.Tasking.Debug;
--- used for Known_Tasks
+with Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
-with System.Interrupt_Management;
--- used for Keep_Unmasked
--- Abort_Task_Interrupt
--- Interrupt_ID
+with Interfaces.C;
+with System.Tasking.Debug;
+with System.Interrupt_Management;
with System.OS_Primitives;
--- used for Delay_Modes
-
with System.Task_Info;
--- used for Task_Info_Type
-
-with Interfaces.C;
--- used for int
--- size_t
with System.Soft_Links;
--- used for Abort_Defer/Undefer
-
-- We use System.Soft_Links instead of System.Tasking.Initialization
-- because the later is a higher level package that we shouldn't depend on.
-- For example when using the restricted run time, it is replaced by
-- System.Tasking.Restricted.Stages.
-with Ada.Unchecked_Conversion;
-with Ada.Unchecked_Deallocation;
-
package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
Foreign_Task_Elaborated : aliased Boolean := True;
-- Used to identified fake tasks (i.e., non-Ada Threads)
+ Use_Alternate_Stack : constant Boolean := Alternate_Stack_Size /= 0;
+ -- Whether to use an alternate signal stack for stack overflows
+
+ Abort_Handler_Installed : Boolean := False;
+ -- True if a handler for the abort signal is installed
+
--------------------
-- Local Packages --
--------------------
pragma Unreferenced (Sig);
T : constant Task_Id := Self;
- Result : Interfaces.C.int;
Old_Set : aliased sigset_t;
+ Result : Interfaces.C.int;
+ pragma Warnings (Off, Result);
+
begin
- -- It is not safe to raise an exception when using ZCX and the GCC
- -- exception handling mechanism.
+ -- It's not safe to raise an exception when using GCC ZCX mechanism.
+ -- Note that we still need to install a signal handler, since in some
+ -- cases (e.g. shutdown of the Server_Task in System.Interrupts) we
+ -- need to send the Abort signal to a task.
if ZCX_By_Default and then GCC_ZCX_Support then
return;
-- Make sure signals used for RTS internal purpose are unmasked
Result := pthread_sigmask (SIG_UNBLOCK,
- Unblocked_Signal_Mask'Unchecked_Access, Old_Set'Unchecked_Access);
+ Unblocked_Signal_Mask'Access, Old_Set'Access);
pragma Assert (Result = 0);
raise Standard'Abort_Signal;
---------------------
-- Note: mutexes and cond_variables needed per-task basis are
- -- initialized in Intialize_TCB and the Storage_Error is
+ -- initialized in Initialize_TCB and the Storage_Error is
-- handled. Other mutexes (such as RTS_Lock, Memory_Lock...)
-- used in RTS is initialized before any status change of RTS.
- -- Therefore rasing Storage_Error in the following routines
+ -- Therefore raising Storage_Error in the following routines
-- should be able to be handled safely.
procedure Initialize_Lock
Specific.Set (Self_ID);
- Lock_RTS;
-
- for J in Known_Tasks'Range loop
- if Known_Tasks (J) = null then
- Known_Tasks (J) := Self_ID;
- Self_ID.Known_Tasks_Index := J;
- exit;
- end if;
- end loop;
-
- Unlock_RTS;
+ if Use_Alternate_Stack then
+ declare
+ Stack : aliased stack_t;
+ Result : Interfaces.C.int;
+ begin
+ Stack.ss_sp := Self_ID.Common.Task_Alternate_Stack;
+ Stack.ss_size := Alternate_Stack_Size;
+ Stack.ss_flags := 0;
+ Result := sigaltstack (Stack'Access, null);
+ pragma Assert (Result = 0);
+ end;
+ end if;
end Enter_Task;
--------------
is
Attributes : aliased pthread_attr_t;
Adjusted_Stack_Size : Interfaces.C.size_t;
+ Page_Size : constant Interfaces.C.size_t := Get_Page_Size;
Result : Interfaces.C.int;
function Thread_Body_Access is new
use System.Task_Info;
begin
- Adjusted_Stack_Size := Interfaces.C.size_t (Stack_Size);
+ Adjusted_Stack_Size :=
+ Interfaces.C.size_t (Stack_Size + Alternate_Stack_Size);
if Stack_Base_Available then
-- to be sure the effective stack size is greater than what
-- has been asked.
- Adjusted_Stack_Size := Adjusted_Stack_Size + 2 * Get_Page_Size;
+ Adjusted_Stack_Size := Adjusted_Stack_Size + 2 * Page_Size;
end if;
+ -- Round stack size as this is required by some OSes (Darwin)
+
+ Adjusted_Stack_Size := Adjusted_Stack_Size + Page_Size - 1;
+ Adjusted_Stack_Size :=
+ Adjusted_Stack_Size - Adjusted_Stack_Size mod Page_Size;
+
Result := pthread_attr_init (Attributes'Access);
pragma Assert (Result = 0 or else Result = ENOMEM);
Result := pthread_attr_destroy (Attributes'Access);
pragma Assert (Result = 0);
- Set_Priority (T, Priority);
+ if Succeeded then
+ Set_Priority (T, Priority);
+ end if;
end Create_Task;
------------------
procedure Abort_Task (T : Task_Id) is
Result : Interfaces.C.int;
begin
- Result :=
- pthread_kill
- (T.Common.LL.Thread,
- Signal (System.Interrupt_Management.Abort_Task_Interrupt));
- pragma Assert (Result = 0);
+ if Abort_Handler_Installed then
+ Result :=
+ pthread_kill
+ (T.Common.LL.Thread,
+ Signal (System.Interrupt_Management.Abort_Task_Interrupt));
+ pragma Assert (Result = 0);
+ end if;
end Abort_Task;
----------------
S.State := False;
else
S.Waiting := True;
- Result := pthread_cond_wait (S.CV'Access, S.L'Access);
+
+ loop
+ -- Loop in case pthread_cond_wait returns earlier than expected
+ -- (e.g. in case of EINTR caused by a signal).
+
+ Result := pthread_cond_wait (S.CV'Access, S.L'Access);
+ pragma Assert (Result = 0 or else Result = EINTR);
+
+ exit when not S.Waiting;
+ end loop;
end if;
Result := pthread_mutex_unlock (S.L'Access);
Specific.Initialize (Environment_Task);
- Enter_Task (Environment_Task);
+ if Use_Alternate_Stack then
+ Environment_Task.Common.Task_Alternate_Stack :=
+ Alternate_Stack'Address;
+ end if;
+
+ -- Make environment task known here because it doesn't go through
+ -- Activate_Tasks, which does it for all other tasks.
- -- Install the abort-signal handler
+ Known_Tasks (Known_Tasks'First) := Environment_Task;
+ Environment_Task.Known_Tasks_Index := Known_Tasks'First;
+
+ Enter_Task (Environment_Task);
if State
(System.Interrupt_Management.Abort_Task_Interrupt) /= Default
act'Unchecked_Access,
old_act'Unchecked_Access);
pragma Assert (Result = 0);
+ Abort_Handler_Installed := True;
end if;
end Initialize;
OSDN Git Service
