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



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@151841 138bc75d-0d04-0410-961f-82ee72b054a4

8 files changed, 126 insertions, 59 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1e4d3db4f95..f763a28b7f7 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads
index 53f2eefc8b8..96a28279c32 100644
--- a/gcc/ada/prj-tree.ads
+++ b/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;
diff --git a/gcc/ada/s-taprop-irix.adb b/gcc/ada/s-taprop-irix.adb
index 69a43153907..83439214259 100644
--- a/gcc/ada/s-taprop-irix.adb
+++ b/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;
 
diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb
index 6d197f76d1d..46b10a3f1f5 100644
--- a/gcc/ada/s-taprop-linux.adb
+++ b/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;
 
diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb
index ac147000b7a..db385c8c589 100644
--- a/gcc/ada/s-taprop-posix.adb
+++ b/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;
 
diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb
index cf2a09e2a24..1e47b9486ed 100644
--- a/gcc/ada/s-taprop-solaris.adb
+++ b/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;
 
    -----------
diff --git a/gcc/ada/s-taprop-tru64.adb b/gcc/ada/s-taprop-tru64.adb
index da9cca88b9c..c5a68b7a4e2 100644
--- a/gcc/ada/s-taprop-tru64.adb
+++ b/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;
 
diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index 1ae5b651ebf..f56614ca7bd 100644
--- a/gcc/ada/s-tassta.adb
+++ b/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.