2006-02-17 Jose Ruiz <ruiz@adacore.com>

	* s-taprop-irix.adb, s-taprop-hpux-dce.adb, s-taprop-linux.adb,
	s-taprop-solaris.adb, s-taprop-vms.adb, s-taprop-mingw.adb,
	s-taprop-posix.adb, s-taprop-vxworks.adb, s-taprop-lynxos.adb,
	s-taprop-tru64.adb (Set_False, Set_True, Suspend_Until_True): Add
	Abort_Defer/Undefer pairs to avoid the possibility of a task being
	aborted while owning a lock.

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

diff --git a/gcc/ada/s-taprop-hpux-dce.adb b/gcc/ada/s-taprop-hpux-dce.adb
index b72a82c..838f54e 100644 (file)
--- a/gcc/ada/s-taprop-hpux-dce.adb
+++ b/gcc/ada/s-taprop-hpux-dce.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2006, 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- --
@@ -69,11 +69,21 @@ with System.Parameters;
 with System.Task_Primitives.Interrupt_Operations;
 --  used for Get_Interrupt_ID
 
+with System.Soft_Links;
+--  used for Defer/Undefer_Abort
+
+--  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 Unchecked_Conversion;
 with Unchecked_Deallocation;
 
 package body System.Task_Primitives.Operations is
 
+   package SSL renames System.Soft_Links;
+
    use System.Tasking.Debug;
    use System.Tasking;
    use Interfaces.C;
@@ -955,6 +965,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_False (S : in out Suspension_Object) is
       Result  : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -962,6 +974,8 @@ package body System.Task_Primitives.Operations is
 
       Result := pthread_mutex_unlock (S.L'Access);
       pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
    end Set_False;
 
    --------------
@@ -971,6 +985,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_True (S : in out Suspension_Object) is
       Result : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -991,6 +1007,8 @@ package body System.Task_Primitives.Operations is
 
       Result := pthread_mutex_unlock (S.L'Access);
       pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
    end Set_True;
 
    ------------------------
@@ -1000,6 +1018,8 @@ package body System.Task_Primitives.Operations is
    procedure Suspend_Until_True (S : in out Suspension_Object) is
       Result : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1011,6 +1031,8 @@ package body System.Task_Primitives.Operations is
          Result := pthread_mutex_unlock (S.L'Access);
          pragma Assert (Result = 0);
 
+         SSL.Abort_Undefer.all;
+
          raise Program_Error;
       else
          --  Suspend the task if the state is False. Otherwise, the task
@@ -1023,10 +1045,12 @@ package body System.Task_Primitives.Operations is
             S.Waiting := True;
             Result := pthread_cond_wait (S.CV'Access, S.L'Access);
          end if;
-      end if;
 
-      Result := pthread_mutex_unlock (S.L'Access);
-      pragma Assert (Result = 0);
+         Result := pthread_mutex_unlock (S.L'Access);
+         pragma Assert (Result = 0);
+
+         SSL.Abort_Undefer.all;
+      end if;
    end Suspend_Until_True;
 
    ----------------

diff --git a/gcc/ada/s-taprop-irix.adb b/gcc/ada/s-taprop-irix.adb
index 8b048e4..efae882 100644 (file)
--- a/gcc/ada/s-taprop-irix.adb
+++ b/gcc/ada/s-taprop-irix.adb
@@ -60,11 +60,21 @@ with System.OS_Primitives;
 with System.IO;
 --  used for Put_Line
 
+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 Unchecked_Conversion;
 with Unchecked_Deallocation;
 
 package body System.Task_Primitives.Operations is
 
+   package SSL renames System.Soft_Links;
+
    use System.Tasking;
    use System.Tasking.Debug;
    use Interfaces.C;
@@ -1019,6 +1029,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_False (S : in out Suspension_Object) is
       Result  : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1026,6 +1038,8 @@ package body System.Task_Primitives.Operations is
 
       Result := pthread_mutex_unlock (S.L'Access);
       pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
    end Set_False;
 
    --------------
@@ -1035,6 +1049,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_True (S : in out Suspension_Object) is
       Result : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1055,6 +1071,8 @@ package body System.Task_Primitives.Operations is
 
       Result := pthread_mutex_unlock (S.L'Access);
       pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
    end Set_True;
 
    ------------------------
@@ -1064,6 +1082,8 @@ package body System.Task_Primitives.Operations is
    procedure Suspend_Until_True (S : in out Suspension_Object) is
       Result : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1075,6 +1095,8 @@ package body System.Task_Primitives.Operations is
          Result := pthread_mutex_unlock (S.L'Access);
          pragma Assert (Result = 0);
 
+         SSL.Abort_Undefer.all;
+
          raise Program_Error;
       else
          --  Suspend the task if the state is False. Otherwise, the task
@@ -1087,10 +1109,12 @@ package body System.Task_Primitives.Operations is
             S.Waiting := True;
             Result := pthread_cond_wait (S.CV'Access, S.L'Access);
          end if;
-      end if;
 
-      Result := pthread_mutex_unlock (S.L'Access);
-      pragma Assert (Result = 0);
+         Result := pthread_mutex_unlock (S.L'Access);
+         pragma Assert (Result = 0);
+
+         SSL.Abort_Undefer.all;
+      end if;
    end Suspend_Until_True;
 
    ----------------

diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb
index 6a3596e..6455748 100644 (file)
--- a/gcc/ada/s-taprop-linux.adb
+++ b/gcc/ada/s-taprop-linux.adb
@@ -58,6 +58,11 @@ with System.OS_Primitives;
 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.Exceptions;
 --  used for Raise_Exception
 --           Raise_From_Signal_Handler
@@ -68,6 +73,8 @@ with Unchecked_Deallocation;
 
 package body System.Task_Primitives.Operations is
 
+   package SSL renames System.Soft_Links;
+
    use System.Tasking.Debug;
    use System.Tasking;
    use Interfaces.C;
@@ -913,6 +920,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_False (S : in out Suspension_Object) is
       Result  : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -920,6 +929,8 @@ package body System.Task_Primitives.Operations is
 
       Result := pthread_mutex_unlock (S.L'Access);
       pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
    end Set_False;
 
    --------------
@@ -929,6 +940,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_True (S : in out Suspension_Object) is
       Result : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -949,6 +962,8 @@ package body System.Task_Primitives.Operations is
 
       Result := pthread_mutex_unlock (S.L'Access);
       pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
    end Set_True;
 
    ------------------------
@@ -958,6 +973,8 @@ package body System.Task_Primitives.Operations is
    procedure Suspend_Until_True (S : in out Suspension_Object) is
       Result : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -969,6 +986,8 @@ package body System.Task_Primitives.Operations is
          Result := pthread_mutex_unlock (S.L'Access);
          pragma Assert (Result = 0);
 
+         SSL.Abort_Undefer.all;
+
          raise Program_Error;
       else
          --  Suspend the task if the state is False. Otherwise, the task
@@ -981,10 +1000,12 @@ package body System.Task_Primitives.Operations is
             S.Waiting := True;
             Result := pthread_cond_wait (S.CV'Access, S.L'Access);
          end if;
-      end if;
 
-      Result := pthread_mutex_unlock (S.L'Access);
-      pragma Assert (Result = 0);
+         Result := pthread_mutex_unlock (S.L'Access);
+         pragma Assert (Result = 0);
+
+         SSL.Abort_Undefer.all;
+      end if;
    end Suspend_Until_True;
 
    ----------------

diff --git a/gcc/ada/s-taprop-lynxos.adb b/gcc/ada/s-taprop-lynxos.adb
index a9b4cbb..8f53ad4 100644 (file)
--- a/gcc/ada/s-taprop-lynxos.adb
+++ b/gcc/ada/s-taprop-lynxos.adb
@@ -59,10 +59,20 @@ 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 Unchecked_Deallocation;
 
 package body System.Task_Primitives.Operations is
 
+   package SSL renames System.Soft_Links;
+
    use System.Tasking.Debug;
    use System.Tasking;
    use Interfaces.C;
@@ -1089,6 +1099,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_False (S : in out Suspension_Object) is
       Result  : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1096,6 +1108,8 @@ package body System.Task_Primitives.Operations is
 
       Result := pthread_mutex_unlock (S.L'Access);
       pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
    end Set_False;
 
    --------------
@@ -1105,6 +1119,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_True (S : in out Suspension_Object) is
       Result : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1125,6 +1141,8 @@ package body System.Task_Primitives.Operations is
 
       Result := pthread_mutex_unlock (S.L'Access);
       pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
    end Set_True;
 
    ------------------------
@@ -1134,6 +1152,8 @@ package body System.Task_Primitives.Operations is
    procedure Suspend_Until_True (S : in out Suspension_Object) is
       Result : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1145,6 +1165,8 @@ package body System.Task_Primitives.Operations is
          Result := pthread_mutex_unlock (S.L'Access);
          pragma Assert (Result = 0);
 
+         SSL.Abort_Undefer.all;
+
          raise Program_Error;
       else
          --  Suspend the task if the state is False. Otherwise, the task
@@ -1157,10 +1179,12 @@ package body System.Task_Primitives.Operations is
             S.Waiting := True;
             Result := pthread_cond_wait (S.CV'Access, S.L'Access);
          end if;
-      end if;
 
-      Result := pthread_mutex_unlock (S.L'Access);
-      pragma Assert (Result = 0);
+         Result := pthread_mutex_unlock (S.L'Access);
+         pragma Assert (Result = 0);
+
+         SSL.Abort_Undefer.all;
+      end if;
    end Suspend_Until_True;
 
    ----------------

diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb
index 7280f64..953e19e 100644 (file)
--- a/gcc/ada/s-taprop-mingw.adb
+++ b/gcc/ada/s-taprop-mingw.adb
@@ -56,10 +56,23 @@ with Interfaces.C.Strings;
 with System.Task_Info;
 --  used for Unspecified_Task_Info
 
+with System.Interrupt_Management;
+--  used for Initialize
+
+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 Unchecked_Deallocation;
 
 package body System.Task_Primitives.Operations is
 
+   package SSL renames System.Soft_Links;
+
    use System.Tasking.Debug;
    use System.Tasking;
    use Interfaces.C;
@@ -983,6 +996,7 @@ package body System.Task_Primitives.Operations is
    begin
       Environment_Task_Id := Environment_Task;
       OS_Primitives.Initialize;
+      Interrupt_Management.Initialize;
 
       if Time_Slice_Val = 0 or else Dispatching_Policy = 'F' then
 
@@ -1083,11 +1097,15 @@ package body System.Task_Primitives.Operations is
 
    procedure Set_False (S : in out Suspension_Object) is
    begin
+      SSL.Abort_Defer.all;
+
       EnterCriticalSection (S.L'Access);
 
       S.State := False;
 
       LeaveCriticalSection (S.L'Access);
+
+      SSL.Abort_Undefer.all;
    end Set_False;
 
    --------------
@@ -1097,6 +1115,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_True (S : in out Suspension_Object) is
       Result : BOOL;
    begin
+      SSL.Abort_Defer.all;
+
       EnterCriticalSection (S.L'Access);
 
       --  If there is already a task waiting on this suspension object then
@@ -1115,6 +1135,8 @@ package body System.Task_Primitives.Operations is
       end if;
 
       LeaveCriticalSection (S.L'Access);
+
+      SSL.Abort_Undefer.all;
    end Set_True;
 
    ------------------------
@@ -1125,6 +1147,8 @@ package body System.Task_Primitives.Operations is
       Result      : DWORD;
       Result_Bool : BOOL;
    begin
+      SSL.Abort_Defer.all;
+
       EnterCriticalSection (S.L'Access);
 
       if S.Waiting then
@@ -1134,6 +1158,8 @@ package body System.Task_Primitives.Operations is
 
          LeaveCriticalSection (S.L'Access);
 
+         SSL.Abort_Undefer.all;
+
          raise Program_Error;
       else
          --  Suspend the task if the state is False. Otherwise, the task
@@ -1144,6 +1170,8 @@ package body System.Task_Primitives.Operations is
             S.State := False;
 
             LeaveCriticalSection (S.L'Access);
+
+            SSL.Abort_Undefer.all;
          else
             S.Waiting := True;
 
@@ -1154,6 +1182,8 @@ package body System.Task_Primitives.Operations is
 
             LeaveCriticalSection (S.L'Access);
 
+            SSL.Abort_Undefer.all;
+
             Result := WaitForSingleObject (S.CV, Wait_Infinite);
             pragma Assert (Result = 0);
          end if;

diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb
index 6195f24..ebe495d 100644 (file)
--- a/gcc/ada/s-taprop-posix.adb
+++ b/gcc/ada/s-taprop-posix.adb
@@ -64,11 +64,21 @@ 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 Unchecked_Conversion;
 with Unchecked_Deallocation;
 
 package body System.Task_Primitives.Operations is
 
+   package SSL renames System.Soft_Links;
+
    use System.Tasking.Debug;
    use System.Tasking;
    use Interfaces.C;
@@ -1111,6 +1121,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_False (S : in out Suspension_Object) is
       Result  : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1118,6 +1130,8 @@ package body System.Task_Primitives.Operations is
 
       Result := pthread_mutex_unlock (S.L'Access);
       pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
    end Set_False;
 
    --------------
@@ -1127,6 +1141,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_True (S : in out Suspension_Object) is
       Result : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1147,6 +1163,8 @@ package body System.Task_Primitives.Operations is
 
       Result := pthread_mutex_unlock (S.L'Access);
       pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
    end Set_True;
 
    ------------------------
@@ -1156,6 +1174,8 @@ package body System.Task_Primitives.Operations is
    procedure Suspend_Until_True (S : in out Suspension_Object) is
       Result : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1167,6 +1187,8 @@ package body System.Task_Primitives.Operations is
          Result := pthread_mutex_unlock (S.L'Access);
          pragma Assert (Result = 0);
 
+         SSL.Abort_Undefer.all;
+
          raise Program_Error;
       else
          --  Suspend the task if the state is False. Otherwise, the task
@@ -1179,10 +1201,12 @@ package body System.Task_Primitives.Operations is
             S.Waiting := True;
             Result := pthread_cond_wait (S.CV'Access, S.L'Access);
          end if;
-      end if;
 
-      Result := pthread_mutex_unlock (S.L'Access);
-      pragma Assert (Result = 0);
+         Result := pthread_mutex_unlock (S.L'Access);
+         pragma Assert (Result = 0);
+
+         SSL.Abort_Undefer.all;
+      end if;
    end Suspend_Until_True;
 
    ----------------

diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb
index aa816b6..002064c 100644 (file)
--- a/gcc/ada/s-taprop-solaris.adb
+++ b/gcc/ada/s-taprop-solaris.adb
@@ -64,10 +64,20 @@ with Interfaces.C;
 with System.Task_Info;
 --  to initialize Task_Info for a C thread, in function Self
 
+with System.Soft_Links;
+--  used for Defer/Undefer_Abort
+
+--  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 Unchecked_Deallocation;
 
 package body System.Task_Primitives.Operations is
 
+   package SSL renames System.Soft_Links;
+
    use System.Tasking.Debug;
    use System.Tasking;
    use Interfaces.C;
@@ -1720,6 +1730,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_False (S : in out Suspension_Object) is
       Result  : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1727,6 +1739,8 @@ package body System.Task_Primitives.Operations is
 
       Result := mutex_unlock (S.L'Access);
       pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
    end Set_False;
 
    --------------
@@ -1736,6 +1750,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_True (S : in out Suspension_Object) is
       Result : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1756,6 +1772,8 @@ package body System.Task_Primitives.Operations is
 
       Result := mutex_unlock (S.L'Access);
       pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
    end Set_True;
 
    ------------------------
@@ -1765,6 +1783,8 @@ package body System.Task_Primitives.Operations is
    procedure Suspend_Until_True (S : in out Suspension_Object) is
       Result : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1776,6 +1796,8 @@ package body System.Task_Primitives.Operations is
          Result := mutex_unlock (S.L'Access);
          pragma Assert (Result = 0);
 
+         SSL.Abort_Undefer.all;
+
          raise Program_Error;
       else
          --  Suspend the task if the state is False. Otherwise, the task
@@ -1788,10 +1810,12 @@ package body System.Task_Primitives.Operations is
             S.Waiting := True;
             Result := cond_wait (S.CV'Access, S.L'Access);
          end if;
-      end if;
 
-      Result := mutex_unlock (S.L'Access);
-      pragma Assert (Result = 0);
+         Result := mutex_unlock (S.L'Access);
+         pragma Assert (Result = 0);
+
+         SSL.Abort_Undefer.all;
+      end if;
    end Suspend_Until_True;
 
    ----------------

diff --git a/gcc/ada/s-taprop-tru64.adb b/gcc/ada/s-taprop-tru64.adb
index d7e602a..120657f 100644 (file)
--- a/gcc/ada/s-taprop-tru64.adb
+++ b/gcc/ada/s-taprop-tru64.adb
@@ -61,10 +61,20 @@ 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 Unchecked_Deallocation;
 
 package body System.Task_Primitives.Operations is
 
+   package SSL renames System.Soft_Links;
+
    use System.Tasking.Debug;
    use System.Tasking;
    use Interfaces.C;
@@ -1026,6 +1036,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_False (S : in out Suspension_Object) is
       Result  : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1033,6 +1045,8 @@ package body System.Task_Primitives.Operations is
 
       Result := pthread_mutex_unlock (S.L'Access);
       pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
    end Set_False;
 
    --------------
@@ -1042,6 +1056,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_True (S : in out Suspension_Object) is
       Result : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1062,6 +1078,8 @@ package body System.Task_Primitives.Operations is
 
       Result := pthread_mutex_unlock (S.L'Access);
       pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
    end Set_True;
 
    ------------------------
@@ -1071,6 +1089,8 @@ package body System.Task_Primitives.Operations is
    procedure Suspend_Until_True (S : in out Suspension_Object) is
       Result : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1082,6 +1102,8 @@ package body System.Task_Primitives.Operations is
          Result := pthread_mutex_unlock (S.L'Access);
          pragma Assert (Result = 0);
 
+         SSL.Abort_Undefer.all;
+
          raise Program_Error;
       else
          --  Suspend the task if the state is False. Otherwise, the task
@@ -1094,10 +1116,12 @@ package body System.Task_Primitives.Operations is
             S.Waiting := True;
             Result := pthread_cond_wait (S.CV'Access, S.L'Access);
          end if;
-      end if;
 
-      Result := pthread_mutex_unlock (S.L'Access);
-      pragma Assert (Result = 0);
+         Result := pthread_mutex_unlock (S.L'Access);
+         pragma Assert (Result = 0);
+
+         SSL.Abort_Undefer.all;
+      end if;
    end Suspend_Until_True;
 
    ----------------

diff --git a/gcc/ada/s-taprop-vms.adb b/gcc/ada/s-taprop-vms.adb
index 95a93b4..755a2c9 100644 (file)
--- a/gcc/ada/s-taprop-vms.adb
+++ b/gcc/ada/s-taprop-vms.adb
@@ -52,6 +52,7 @@ with Interfaces.C;
 
 with System.Soft_Links;
 --  used for Get_Exc_Stack_Addr
+--           Abort_Defer/Undefer
 
 with Unchecked_Conversion;
 with Unchecked_Deallocation;
@@ -985,6 +986,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_False (S : in out Suspension_Object) is
       Result  : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -992,6 +995,8 @@ package body System.Task_Primitives.Operations is
 
       Result := pthread_mutex_unlock (S.L'Access);
       pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
    end Set_False;
 
    --------------
@@ -1001,6 +1006,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_True (S : in out Suspension_Object) is
       Result : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1021,6 +1028,8 @@ package body System.Task_Primitives.Operations is
 
       Result := pthread_mutex_unlock (S.L'Access);
       pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
    end Set_True;
 
    ------------------------
@@ -1030,6 +1039,8 @@ package body System.Task_Primitives.Operations is
    procedure Suspend_Until_True (S : in out Suspension_Object) is
       Result : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1041,6 +1052,8 @@ package body System.Task_Primitives.Operations is
          Result := pthread_mutex_unlock (S.L'Access);
          pragma Assert (Result = 0);
 
+         SSL.Abort_Undefer.all;
+
          raise Program_Error;
       else
          --  Suspend the task if the state is False. Otherwise, the task
@@ -1053,10 +1066,12 @@ package body System.Task_Primitives.Operations is
             S.Waiting := True;
             Result := pthread_cond_wait (S.CV'Access, S.L'Access);
          end if;
-      end if;
 
-      Result := pthread_mutex_unlock (S.L'Access);
-      pragma Assert (Result = 0);
+         Result := pthread_mutex_unlock (S.L'Access);
+         pragma Assert (Result = 0);
+
+         SSL.Abort_Undefer.all;
+      end if;
    end Suspend_Until_True;
 
    ----------------

diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb
index 56a02dd..186e8c2 100644 (file)
--- a/gcc/ada/s-taprop-vxworks.adb
+++ b/gcc/ada/s-taprop-vxworks.adb
@@ -51,11 +51,21 @@ with System.Interrupt_Management;
 
 with Interfaces.C;
 
+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 Unchecked_Conversion;
 with Unchecked_Deallocation;
 
 package body System.Task_Primitives.Operations is
 
+   package SSL renames System.Soft_Links;
+
    use System.Tasking.Debug;
    use System.Tasking;
    use System.OS_Interface;
@@ -1030,6 +1040,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_False (S : in out Suspension_Object) is
       Result  : STATUS;
    begin
+      SSL.Abort_Defer.all;
+
       Result := semTake (S.L, WAIT_FOREVER);
       pragma Assert (Result = OK);
 
@@ -1037,6 +1049,8 @@ package body System.Task_Primitives.Operations is
 
       Result := semGive (S.L);
       pragma Assert (Result = OK);
+
+      SSL.Abort_Undefer.all;
    end Set_False;
 
    --------------
@@ -1046,6 +1060,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_True (S : in out Suspension_Object) is
       Result : STATUS;
    begin
+      SSL.Abort_Defer.all;
+
       Result := semTake (S.L, WAIT_FOREVER);
       pragma Assert (Result = OK);
 
@@ -1066,6 +1082,8 @@ package body System.Task_Primitives.Operations is
 
       Result := semGive (S.L);
       pragma Assert (Result = OK);
+
+      SSL.Abort_Undefer.all;
    end Set_True;
 
    ------------------------
@@ -1075,6 +1093,8 @@ package body System.Task_Primitives.Operations is
    procedure Suspend_Until_True (S : in out Suspension_Object) is
       Result : STATUS;
    begin
+      SSL.Abort_Defer.all;
+
       Result := semTake (S.L, WAIT_FOREVER);
 
       if S.Waiting then
@@ -1085,6 +1105,8 @@ package body System.Task_Primitives.Operations is
          Result := semGive (S.L);
          pragma Assert (Result = OK);
 
+         SSL.Abort_Undefer.all;
+
          raise Program_Error;
       else
          --  Suspend the task if the state is False. Otherwise, the task
@@ -1096,6 +1118,8 @@ package body System.Task_Primitives.Operations is
 
             Result := semGive (S.L);
             pragma Assert (Result = 0);
+
+            SSL.Abort_Undefer.all;
          else
             S.Waiting := True;
 
@@ -1104,6 +1128,8 @@ package body System.Task_Primitives.Operations is
             Result := semGive (S.L);
             pragma Assert (Result = OK);
 
+            SSL.Abort_Undefer.all;
+
             Result := semTake (S.CV, WAIT_FOREVER);
             pragma Assert (Result = 0);
          end if;