[multiple changes]
2009-09-18 Arnaud Charlet <charlet@adacore.com> * s-taprop-tru64.adb, s-taprop-linux.adb, s-taprop-solaris.adb, s-taprop-irix.adb, s-taprop-posix.adb (Abort_Task): Do nothing if no signal handler is installed. * s-tassta.adb (Finalize_Global_Tasks): Do not wait for independent tasks if Abort_Task_Interrupt cannot be used. 2009-09-18 Vincent Celier <celier@adacore.com> * prj-tree.ads: Minor comment update From-SVN: r151841
This commit is contained in:
Arnaud Charlet
parent
2b5bcdeec8
commit
658cea5b3e
8 changed files with 126 additions and 59 deletions
|
|
@ -1,3 +1,15 @@
|
|||
2009-09-18 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* s-taprop-tru64.adb, s-taprop-linux.adb, s-taprop-solaris.adb,
|
||||
s-taprop-irix.adb, s-taprop-posix.adb (Abort_Task): Do nothing if no
|
||||
signal handler is installed.
|
||||
* s-tassta.adb (Finalize_Global_Tasks): Do not wait for independent
|
||||
tasks if Abort_Task_Interrupt cannot be used.
|
||||
|
||||
2009-09-18 Vincent Celier <celier@adacore.com>
|
||||
|
||||
* prj-tree.ads: Minor comment update
|
||||
|
||||
2009-09-17 Bob Duff <duff@adacore.com>
|
||||
|
||||
* g-socket.ads: Document the fact that Close_Selector has no effect on
|
||||
|
|
|
|||
|
|
@ -1377,7 +1377,8 @@ package Prj.Tree is
|
|||
Key => Name_Id,
|
||||
Hash => Hash,
|
||||
Equal => "=");
|
||||
-- Comment required describing what this table is used for ???
|
||||
-- General type for htables associating name_id to name_id.
|
||||
-- This is in particular used to store the values of external references
|
||||
|
||||
type Project_Node_Tree_Data is record
|
||||
Project_Nodes : Tree_Private_Part.Project_Node_Table.Instance;
|
||||
|
|
|
|||
|
|
@ -100,6 +100,9 @@ package body System.Task_Primitives.Operations is
|
|||
Foreign_Task_Elaborated : aliased Boolean := True;
|
||||
-- Used to identified fake tasks (i.e., non-Ada Threads)
|
||||
|
||||
Abort_Handler_Installed : Boolean := False;
|
||||
-- True if a handler for the abort signal is installed
|
||||
|
||||
--------------------
|
||||
-- Local Packages --
|
||||
--------------------
|
||||
|
|
@ -159,8 +162,10 @@ package body System.Task_Primitives.Operations is
|
|||
Old_Set : aliased sigset_t;
|
||||
|
||||
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;
|
||||
|
|
@ -956,11 +961,13 @@ package body System.Task_Primitives.Operations is
|
|||
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;
|
||||
|
||||
----------------
|
||||
|
|
@ -1332,8 +1339,6 @@ package body System.Task_Primitives.Operations is
|
|||
end if;
|
||||
end loop;
|
||||
|
||||
-- Install the abort-signal handler
|
||||
|
||||
if State
|
||||
(System.Interrupt_Management.Abort_Task_Interrupt) /= Default
|
||||
then
|
||||
|
|
@ -1350,6 +1355,7 @@ package body System.Task_Primitives.Operations is
|
|||
act'Unchecked_Access,
|
||||
old_act'Unchecked_Access);
|
||||
pragma Assert (Result = 0);
|
||||
Abort_Handler_Installed := True;
|
||||
end if;
|
||||
end Initialize;
|
||||
|
||||
|
|
|
|||
|
|
@ -68,9 +68,6 @@ package body System.Task_Primitives.Operations is
|
|||
use System.OS_Primitives;
|
||||
use System.Task_Info;
|
||||
|
||||
Use_Alternate_Stack : constant Boolean := Alternate_Stack_Size /= 0;
|
||||
-- Whether to use an alternate signal stack for stack overflows
|
||||
|
||||
----------------
|
||||
-- Local Data --
|
||||
----------------
|
||||
|
|
@ -112,6 +109,12 @@ package body System.Task_Primitives.Operations is
|
|||
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 --
|
||||
--------------------
|
||||
|
|
@ -172,6 +175,11 @@ package body System.Task_Primitives.Operations is
|
|||
Old_Set : aliased sigset_t;
|
||||
|
||||
begin
|
||||
-- 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;
|
||||
end if;
|
||||
|
|
@ -916,11 +924,13 @@ package body System.Task_Primitives.Operations is
|
|||
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;
|
||||
|
||||
----------------
|
||||
|
|
@ -1264,8 +1274,6 @@ package body System.Task_Primitives.Operations is
|
|||
|
||||
Enter_Task (Environment_Task);
|
||||
|
||||
-- Install the abort-signal handler
|
||||
|
||||
if State
|
||||
(System.Interrupt_Management.Abort_Task_Interrupt) /= Default
|
||||
then
|
||||
|
|
@ -1282,6 +1290,7 @@ package body System.Task_Primitives.Operations is
|
|||
act'Unchecked_Access,
|
||||
old_act'Unchecked_Access);
|
||||
pragma Assert (Result = 0);
|
||||
Abort_Handler_Installed := True;
|
||||
end if;
|
||||
end Initialize;
|
||||
|
||||
|
|
|
|||
|
|
@ -71,9 +71,6 @@ package body System.Task_Primitives.Operations is
|
|||
use System.Parameters;
|
||||
use System.OS_Primitives;
|
||||
|
||||
Use_Alternate_Stack : constant Boolean := Alternate_Stack_Size /= 0;
|
||||
-- Whether to use an alternate signal stack for stack overflows
|
||||
|
||||
----------------
|
||||
-- Local Data --
|
||||
----------------
|
||||
|
|
@ -117,6 +114,12 @@ package body System.Task_Primitives.Operations is
|
|||
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 --
|
||||
--------------------
|
||||
|
|
@ -198,8 +201,10 @@ package body System.Task_Primitives.Operations is
|
|||
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;
|
||||
|
|
@ -1066,11 +1071,13 @@ package body System.Task_Primitives.Operations is
|
|||
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;
|
||||
|
||||
----------------
|
||||
|
|
@ -1447,8 +1454,6 @@ package body System.Task_Primitives.Operations is
|
|||
|
||||
Enter_Task (Environment_Task);
|
||||
|
||||
-- Install the abort-signal handler
|
||||
|
||||
if State
|
||||
(System.Interrupt_Management.Abort_Task_Interrupt) /= Default
|
||||
then
|
||||
|
|
@ -1465,6 +1470,7 @@ package body System.Task_Primitives.Operations is
|
|||
act'Unchecked_Access,
|
||||
old_act'Unchecked_Access);
|
||||
pragma Assert (Result = 0);
|
||||
Abort_Handler_Installed := True;
|
||||
end if;
|
||||
end Initialize;
|
||||
|
||||
|
|
|
|||
|
|
@ -97,6 +97,9 @@ package body System.Task_Primitives.Operations is
|
|||
-- using in error checking.
|
||||
-- The following are internal configuration constants needed.
|
||||
|
||||
Abort_Handler_Installed : Boolean := False;
|
||||
-- True if a handler for the abort signal is installed
|
||||
|
||||
----------------------
|
||||
-- Priority Support --
|
||||
----------------------
|
||||
|
|
@ -256,8 +259,10 @@ package body System.Task_Primitives.Operations is
|
|||
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;
|
||||
|
|
@ -487,7 +492,7 @@ package body System.Task_Primitives.Operations is
|
|||
|
||||
Enter_Task (Environment_Task);
|
||||
|
||||
-- Install the abort-signal handler
|
||||
Configure_Processors;
|
||||
|
||||
if State
|
||||
(System.Interrupt_Management.Abort_Task_Interrupt) /= Default
|
||||
|
|
@ -513,9 +518,8 @@ package body System.Task_Primitives.Operations is
|
|||
act'Unchecked_Access,
|
||||
old_act'Unchecked_Access);
|
||||
pragma Assert (Result = 0);
|
||||
Abort_Handler_Installed := True;
|
||||
end if;
|
||||
|
||||
Configure_Processors;
|
||||
end Initialize;
|
||||
|
||||
---------------------
|
||||
|
|
@ -1095,12 +1099,14 @@ package body System.Task_Primitives.Operations is
|
|||
procedure Abort_Task (T : Task_Id) is
|
||||
Result : Interfaces.C.int;
|
||||
begin
|
||||
pragma Assert (T /= Self);
|
||||
Result :=
|
||||
thr_kill
|
||||
(T.Common.LL.Thread,
|
||||
Signal (System.Interrupt_Management.Abort_Task_Interrupt));
|
||||
pragma Assert (Result = 0);
|
||||
if Abort_Handler_Installed then
|
||||
pragma Assert (T /= Self);
|
||||
Result :=
|
||||
thr_kill
|
||||
(T.Common.LL.Thread,
|
||||
Signal (System.Interrupt_Management.Abort_Task_Interrupt));
|
||||
pragma Assert (Result = 0);
|
||||
end if;
|
||||
end Abort_Task;
|
||||
|
||||
-----------
|
||||
|
|
|
|||
|
|
@ -100,6 +100,9 @@ package body System.Task_Primitives.Operations is
|
|||
Foreign_Task_Elaborated : aliased Boolean := True;
|
||||
-- Used to identified fake tasks (i.e., non-Ada Threads)
|
||||
|
||||
Abort_Handler_Installed : Boolean := False;
|
||||
-- True if a handler for the abort signal is installed
|
||||
|
||||
--------------------
|
||||
-- Local Packages --
|
||||
--------------------
|
||||
|
|
@ -162,8 +165,10 @@ package body System.Task_Primitives.Operations is
|
|||
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;
|
||||
|
|
@ -990,9 +995,11 @@ package body System.Task_Primitives.Operations is
|
|||
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;
|
||||
|
||||
----------------
|
||||
|
|
@ -1349,8 +1356,6 @@ package body System.Task_Primitives.Operations is
|
|||
|
||||
Enter_Task (Environment_Task);
|
||||
|
||||
-- Install the abort-signal handler
|
||||
|
||||
if State
|
||||
(System.Interrupt_Management.Abort_Task_Interrupt) /= Default
|
||||
then
|
||||
|
|
@ -1367,6 +1372,7 @@ package body System.Task_Primitives.Operations is
|
|||
act'Unchecked_Access,
|
||||
old_act'Unchecked_Access);
|
||||
pragma Assert (Result = 0);
|
||||
Abort_Handler_Installed := True;
|
||||
end if;
|
||||
end Initialize;
|
||||
|
||||
|
|
|
|||
|
|
@ -36,6 +36,7 @@ pragma Polling (Off);
|
|||
with Ada.Exceptions;
|
||||
with Ada.Unchecked_Deallocation;
|
||||
|
||||
with System.Interrupt_Management;
|
||||
with System.Tasking.Debug;
|
||||
with System.Address_Image;
|
||||
with System.Task_Primitives;
|
||||
|
|
@ -739,6 +740,17 @@ package body System.Tasking.Stages is
|
|||
Ignore : Boolean;
|
||||
pragma Unreferenced (Ignore);
|
||||
|
||||
function State
|
||||
(Int : System.Interrupt_Management.Interrupt_ID) return Character;
|
||||
pragma Import (C, State, "__gnat_get_interrupt_state");
|
||||
-- Get interrupt state. Defined in a-init.c
|
||||
-- The input argument is the interrupt number,
|
||||
-- and the result is one of the following:
|
||||
|
||||
Default : constant Character := 's';
|
||||
-- 's' Interrupt_State pragma set state to System (use "default"
|
||||
-- system handler)
|
||||
|
||||
begin
|
||||
if Self_ID.Deferral_Level = 0 then
|
||||
-- ???
|
||||
|
|
@ -781,17 +793,26 @@ package body System.Tasking.Stages is
|
|||
|
||||
Write_Lock (Self_ID);
|
||||
|
||||
loop
|
||||
exit when Utilities.Independent_Task_Count = 0;
|
||||
-- If the Abort_Task signal is set to system, it means that we may not
|
||||
-- have been able to abort all independent tasks (in particular
|
||||
-- Server_Task may be blocked, waiting for a signal), in which case,
|
||||
-- do not wait for Independent_Task_Count to go down to 0.
|
||||
|
||||
-- We used to yield here, but this did not take into account low
|
||||
-- priority tasks that would cause dead lock in some cases (true
|
||||
-- FIFO scheduling).
|
||||
if State
|
||||
(System.Interrupt_Management.Abort_Task_Interrupt) /= Default
|
||||
then
|
||||
loop
|
||||
exit when Utilities.Independent_Task_Count = 0;
|
||||
|
||||
Timed_Sleep
|
||||
(Self_ID, 0.01, System.OS_Primitives.Relative,
|
||||
Self_ID.Common.State, Ignore, Ignore);
|
||||
end loop;
|
||||
-- We used to yield here, but this did not take into account low
|
||||
-- priority tasks that would cause dead lock in some cases (true
|
||||
-- FIFO scheduling).
|
||||
|
||||
Timed_Sleep
|
||||
(Self_ID, 0.01, System.OS_Primitives.Relative,
|
||||
Self_ID.Common.State, Ignore, Ignore);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
-- ??? On multi-processor environments, it seems that the above loop
|
||||
-- isn't sufficient, so we need to add an additional delay.
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue