Skip to content

R
riscv-gcc-1
Commit 658cea5b by Arnaud Charlet
Options

[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
parent 2b5bcdee
Showing with 126 additions and 59 deletions
gcc/ada/ChangeLog
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
......
gcc/ada/prj-tree.ads
......@@ -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;
......
gcc/ada/s-taprop-irix.adb
......@@ -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;
......
gcc/ada/s-taprop-linux.adb
......@@ -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;
......
gcc/ada/s-taprop-posix.adb
......@@ -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;
......
gcc/ada/s-taprop-solaris.adb
......@@ -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;
-----------
......
gcc/ada/s-taprop-tru64.adb
......@@ -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;
......
gcc/ada/s-tassta.adb
......@@ -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.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment