2010-01-04 Tobias Burnus <burnus@net-b.de>

[pf3gnuchains/gcc-fork.git] / gcc / ada / s-tassta.adb

diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index e26a09d..a78b0d8 100644 (file)
--- 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,15 @@ 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 for interrupt number Int. Defined in init.c
+
+      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 +791,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.
@@ -1807,10 +1826,10 @@ package body System.Tasking.Stages is
          T := To_Be_Freed;
          To_Be_Freed := T.Common.All_Tasks_Link;
 
-         --  ??? On SGI there is currently no Interrupt_Manager, that's
-         --  why we need to check if the Interrupt_Manager_ID is null
+         --  ??? On SGI there is currently no Interrupt_Manager, that's why we
+         --  need to check if the Interrupt_Manager_ID is null.
 
-         if T.Interrupt_Entry and Interrupt_Manager_ID /= null then
+         if T.Interrupt_Entry and then Interrupt_Manager_ID /= null then
             declare
                Detach_Interrupt_Entries_Index : constant Task_Entry_Index := 1;
                --  Corresponds to the entry index of System.Interrupts.