Skip to content

R
riscv-gcc-1
Commit 72774950 by Jose Ruiz Committed by Arnaud Charlet
Options

s-taprop-irix.adb, [...] (Set_False, [...]): Add Abort_Defer/Undefer pairs to… 

s-taprop-irix.adb, [...] (Set_False, [...]): Add Abort_Defer/Undefer pairs to avoid the possibility of a task being aborted...

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.

From-SVN: r111184
parent aea625dd
Showing with 261 additions and 25 deletions
gcc/ada/s-taprop-hpux-dce.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -69,11 +69,21 @@ with System.Parameters; ...@@ -69,11 +69,21 @@ with System.Parameters;
with System.Task_Primitives.Interrupt_Operations; with System.Task_Primitives.Interrupt_Operations;
-- used for Get_Interrupt_ID -- 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_Conversion;
with Unchecked_Deallocation; with Unchecked_Deallocation;
package body System.Task_Primitives.Operations is package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
use System.Tasking.Debug; use System.Tasking.Debug;
use System.Tasking; use System.Tasking;
use Interfaces.C; use Interfaces.C;
...@@ -955,6 +965,8 @@ package body System.Task_Primitives.Operations is ...@@ -955,6 +965,8 @@ package body System.Task_Primitives.Operations is
procedure Set_False (S : in out Suspension_Object) is procedure Set_False (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -962,6 +974,8 @@ package body System.Task_Primitives.Operations is ...@@ -962,6 +974,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end Set_False; end Set_False;
-------------- --------------
...@@ -971,6 +985,8 @@ package body System.Task_Primitives.Operations is ...@@ -971,6 +985,8 @@ package body System.Task_Primitives.Operations is
procedure Set_True (S : in out Suspension_Object) is procedure Set_True (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -991,6 +1007,8 @@ package body System.Task_Primitives.Operations is ...@@ -991,6 +1007,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end Set_True; end Set_True;
------------------------ ------------------------
...@@ -1000,6 +1018,8 @@ package body System.Task_Primitives.Operations is ...@@ -1000,6 +1018,8 @@ package body System.Task_Primitives.Operations is
procedure Suspend_Until_True (S : in out Suspension_Object) is procedure Suspend_Until_True (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -1011,6 +1031,8 @@ package body System.Task_Primitives.Operations is ...@@ -1011,6 +1031,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
raise Program_Error; raise Program_Error;
else else
-- Suspend the task if the state is False. Otherwise, the task -- Suspend the task if the state is False. Otherwise, the task
...@@ -1023,10 +1045,12 @@ package body System.Task_Primitives.Operations is ...@@ -1023,10 +1045,12 @@ package body System.Task_Primitives.Operations is
S.Waiting := True; S.Waiting := True;
Result := pthread_cond_wait (S.CV'Access, S.L'Access); Result := pthread_cond_wait (S.CV'Access, S.L'Access);
end if; end if;
end if;
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end if;
end Suspend_Until_True; end Suspend_Until_True;
---------------- ----------------
......
gcc/ada/s-taprop-irix.adb
...@@ -60,11 +60,21 @@ with System.OS_Primitives; ...@@ -60,11 +60,21 @@ with System.OS_Primitives;
with System.IO; with System.IO;
-- used for Put_Line -- 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_Conversion;
with Unchecked_Deallocation; with Unchecked_Deallocation;
package body System.Task_Primitives.Operations is package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
use System.Tasking; use System.Tasking;
use System.Tasking.Debug; use System.Tasking.Debug;
use Interfaces.C; use Interfaces.C;
...@@ -1019,6 +1029,8 @@ package body System.Task_Primitives.Operations is ...@@ -1019,6 +1029,8 @@ package body System.Task_Primitives.Operations is
procedure Set_False (S : in out Suspension_Object) is procedure Set_False (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -1026,6 +1038,8 @@ package body System.Task_Primitives.Operations is ...@@ -1026,6 +1038,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end Set_False; end Set_False;
-------------- --------------
...@@ -1035,6 +1049,8 @@ package body System.Task_Primitives.Operations is ...@@ -1035,6 +1049,8 @@ package body System.Task_Primitives.Operations is
procedure Set_True (S : in out Suspension_Object) is procedure Set_True (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -1055,6 +1071,8 @@ package body System.Task_Primitives.Operations is ...@@ -1055,6 +1071,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end Set_True; end Set_True;
------------------------ ------------------------
...@@ -1064,6 +1082,8 @@ package body System.Task_Primitives.Operations is ...@@ -1064,6 +1082,8 @@ package body System.Task_Primitives.Operations is
procedure Suspend_Until_True (S : in out Suspension_Object) is procedure Suspend_Until_True (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -1075,6 +1095,8 @@ package body System.Task_Primitives.Operations is ...@@ -1075,6 +1095,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
raise Program_Error; raise Program_Error;
else else
-- Suspend the task if the state is False. Otherwise, the task -- Suspend the task if the state is False. Otherwise, the task
...@@ -1087,10 +1109,12 @@ package body System.Task_Primitives.Operations is ...@@ -1087,10 +1109,12 @@ package body System.Task_Primitives.Operations is
S.Waiting := True; S.Waiting := True;
Result := pthread_cond_wait (S.CV'Access, S.L'Access); Result := pthread_cond_wait (S.CV'Access, S.L'Access);
end if; end if;
end if;
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end if;
end Suspend_Until_True; end Suspend_Until_True;
---------------- ----------------
......
gcc/ada/s-taprop-linux.adb
...@@ -58,6 +58,11 @@ with System.OS_Primitives; ...@@ -58,6 +58,11 @@ with System.OS_Primitives;
with System.Soft_Links; with System.Soft_Links;
-- used for Abort_Defer/Undefer -- 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; with Ada.Exceptions;
-- used for Raise_Exception -- used for Raise_Exception
-- Raise_From_Signal_Handler -- Raise_From_Signal_Handler
...@@ -68,6 +73,8 @@ with Unchecked_Deallocation; ...@@ -68,6 +73,8 @@ with Unchecked_Deallocation;
package body System.Task_Primitives.Operations is package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
use System.Tasking.Debug; use System.Tasking.Debug;
use System.Tasking; use System.Tasking;
use Interfaces.C; use Interfaces.C;
...@@ -913,6 +920,8 @@ package body System.Task_Primitives.Operations is ...@@ -913,6 +920,8 @@ package body System.Task_Primitives.Operations is
procedure Set_False (S : in out Suspension_Object) is procedure Set_False (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -920,6 +929,8 @@ package body System.Task_Primitives.Operations is ...@@ -920,6 +929,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end Set_False; end Set_False;
-------------- --------------
...@@ -929,6 +940,8 @@ package body System.Task_Primitives.Operations is ...@@ -929,6 +940,8 @@ package body System.Task_Primitives.Operations is
procedure Set_True (S : in out Suspension_Object) is procedure Set_True (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -949,6 +962,8 @@ package body System.Task_Primitives.Operations is ...@@ -949,6 +962,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end Set_True; end Set_True;
------------------------ ------------------------
...@@ -958,6 +973,8 @@ package body System.Task_Primitives.Operations is ...@@ -958,6 +973,8 @@ package body System.Task_Primitives.Operations is
procedure Suspend_Until_True (S : in out Suspension_Object) is procedure Suspend_Until_True (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -969,6 +986,8 @@ package body System.Task_Primitives.Operations is ...@@ -969,6 +986,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
raise Program_Error; raise Program_Error;
else else
-- Suspend the task if the state is False. Otherwise, the task -- Suspend the task if the state is False. Otherwise, the task
...@@ -981,10 +1000,12 @@ package body System.Task_Primitives.Operations is ...@@ -981,10 +1000,12 @@ package body System.Task_Primitives.Operations is
S.Waiting := True; S.Waiting := True;
Result := pthread_cond_wait (S.CV'Access, S.L'Access); Result := pthread_cond_wait (S.CV'Access, S.L'Access);
end if; end if;
end if;
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end if;
end Suspend_Until_True; end Suspend_Until_True;
---------------- ----------------
......
gcc/ada/s-taprop-lynxos.adb
...@@ -59,10 +59,20 @@ with Interfaces.C; ...@@ -59,10 +59,20 @@ with Interfaces.C;
-- used for int -- used for int
-- size_t -- 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; with Unchecked_Deallocation;
package body System.Task_Primitives.Operations is package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
use System.Tasking.Debug; use System.Tasking.Debug;
use System.Tasking; use System.Tasking;
use Interfaces.C; use Interfaces.C;
...@@ -1089,6 +1099,8 @@ package body System.Task_Primitives.Operations is ...@@ -1089,6 +1099,8 @@ package body System.Task_Primitives.Operations is
procedure Set_False (S : in out Suspension_Object) is procedure Set_False (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -1096,6 +1108,8 @@ package body System.Task_Primitives.Operations is ...@@ -1096,6 +1108,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end Set_False; end Set_False;
-------------- --------------
...@@ -1105,6 +1119,8 @@ package body System.Task_Primitives.Operations is ...@@ -1105,6 +1119,8 @@ package body System.Task_Primitives.Operations is
procedure Set_True (S : in out Suspension_Object) is procedure Set_True (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -1125,6 +1141,8 @@ package body System.Task_Primitives.Operations is ...@@ -1125,6 +1141,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end Set_True; end Set_True;
------------------------ ------------------------
...@@ -1134,6 +1152,8 @@ package body System.Task_Primitives.Operations is ...@@ -1134,6 +1152,8 @@ package body System.Task_Primitives.Operations is
procedure Suspend_Until_True (S : in out Suspension_Object) is procedure Suspend_Until_True (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -1145,6 +1165,8 @@ package body System.Task_Primitives.Operations is ...@@ -1145,6 +1165,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
raise Program_Error; raise Program_Error;
else else
-- Suspend the task if the state is False. Otherwise, the task -- Suspend the task if the state is False. Otherwise, the task
...@@ -1157,10 +1179,12 @@ package body System.Task_Primitives.Operations is ...@@ -1157,10 +1179,12 @@ package body System.Task_Primitives.Operations is
S.Waiting := True; S.Waiting := True;
Result := pthread_cond_wait (S.CV'Access, S.L'Access); Result := pthread_cond_wait (S.CV'Access, S.L'Access);
end if; end if;
end if;
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end if;
end Suspend_Until_True; end Suspend_Until_True;
---------------- ----------------
......
gcc/ada/s-taprop-mingw.adb
...@@ -56,10 +56,23 @@ with Interfaces.C.Strings; ...@@ -56,10 +56,23 @@ with Interfaces.C.Strings;
with System.Task_Info; with System.Task_Info;
-- used for Unspecified_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; with Unchecked_Deallocation;
package body System.Task_Primitives.Operations is package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
use System.Tasking.Debug; use System.Tasking.Debug;
use System.Tasking; use System.Tasking;
use Interfaces.C; use Interfaces.C;
...@@ -983,6 +996,7 @@ package body System.Task_Primitives.Operations is ...@@ -983,6 +996,7 @@ package body System.Task_Primitives.Operations is
begin begin
Environment_Task_Id := Environment_Task; Environment_Task_Id := Environment_Task;
OS_Primitives.Initialize; OS_Primitives.Initialize;
Interrupt_Management.Initialize;
if Time_Slice_Val = 0 or else Dispatching_Policy = 'F' then if Time_Slice_Val = 0 or else Dispatching_Policy = 'F' then
...@@ -1083,11 +1097,15 @@ package body System.Task_Primitives.Operations is ...@@ -1083,11 +1097,15 @@ package body System.Task_Primitives.Operations is
procedure Set_False (S : in out Suspension_Object) is procedure Set_False (S : in out Suspension_Object) is
begin begin
SSL.Abort_Defer.all;
EnterCriticalSection (S.L'Access); EnterCriticalSection (S.L'Access);
S.State := False; S.State := False;
LeaveCriticalSection (S.L'Access); LeaveCriticalSection (S.L'Access);
SSL.Abort_Undefer.all;
end Set_False; end Set_False;
-------------- --------------
...@@ -1097,6 +1115,8 @@ package body System.Task_Primitives.Operations is ...@@ -1097,6 +1115,8 @@ package body System.Task_Primitives.Operations is
procedure Set_True (S : in out Suspension_Object) is procedure Set_True (S : in out Suspension_Object) is
Result : BOOL; Result : BOOL;
begin begin
SSL.Abort_Defer.all;
EnterCriticalSection (S.L'Access); EnterCriticalSection (S.L'Access);
-- If there is already a task waiting on this suspension object then -- If there is already a task waiting on this suspension object then
...@@ -1115,6 +1135,8 @@ package body System.Task_Primitives.Operations is ...@@ -1115,6 +1135,8 @@ package body System.Task_Primitives.Operations is
end if; end if;
LeaveCriticalSection (S.L'Access); LeaveCriticalSection (S.L'Access);
SSL.Abort_Undefer.all;
end Set_True; end Set_True;
------------------------ ------------------------
...@@ -1125,6 +1147,8 @@ package body System.Task_Primitives.Operations is ...@@ -1125,6 +1147,8 @@ package body System.Task_Primitives.Operations is
Result : DWORD; Result : DWORD;
Result_Bool : BOOL; Result_Bool : BOOL;
begin begin
SSL.Abort_Defer.all;
EnterCriticalSection (S.L'Access); EnterCriticalSection (S.L'Access);
if S.Waiting then if S.Waiting then
...@@ -1134,6 +1158,8 @@ package body System.Task_Primitives.Operations is ...@@ -1134,6 +1158,8 @@ package body System.Task_Primitives.Operations is
LeaveCriticalSection (S.L'Access); LeaveCriticalSection (S.L'Access);
SSL.Abort_Undefer.all;
raise Program_Error; raise Program_Error;
else else
-- Suspend the task if the state is False. Otherwise, the task -- Suspend the task if the state is False. Otherwise, the task
...@@ -1144,6 +1170,8 @@ package body System.Task_Primitives.Operations is ...@@ -1144,6 +1170,8 @@ package body System.Task_Primitives.Operations is
S.State := False; S.State := False;
LeaveCriticalSection (S.L'Access); LeaveCriticalSection (S.L'Access);
SSL.Abort_Undefer.all;
else else
S.Waiting := True; S.Waiting := True;
...@@ -1154,6 +1182,8 @@ package body System.Task_Primitives.Operations is ...@@ -1154,6 +1182,8 @@ package body System.Task_Primitives.Operations is
LeaveCriticalSection (S.L'Access); LeaveCriticalSection (S.L'Access);
SSL.Abort_Undefer.all;
Result := WaitForSingleObject (S.CV, Wait_Infinite); Result := WaitForSingleObject (S.CV, Wait_Infinite);
pragma Assert (Result = 0); pragma Assert (Result = 0);
end if; end if;
......
gcc/ada/s-taprop-posix.adb
...@@ -64,11 +64,21 @@ with Interfaces.C; ...@@ -64,11 +64,21 @@ with Interfaces.C;
-- used for int -- used for int
-- size_t -- 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_Conversion;
with Unchecked_Deallocation; with Unchecked_Deallocation;
package body System.Task_Primitives.Operations is package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
use System.Tasking.Debug; use System.Tasking.Debug;
use System.Tasking; use System.Tasking;
use Interfaces.C; use Interfaces.C;
...@@ -1111,6 +1121,8 @@ package body System.Task_Primitives.Operations is ...@@ -1111,6 +1121,8 @@ package body System.Task_Primitives.Operations is
procedure Set_False (S : in out Suspension_Object) is procedure Set_False (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -1118,6 +1130,8 @@ package body System.Task_Primitives.Operations is ...@@ -1118,6 +1130,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end Set_False; end Set_False;
-------------- --------------
...@@ -1127,6 +1141,8 @@ package body System.Task_Primitives.Operations is ...@@ -1127,6 +1141,8 @@ package body System.Task_Primitives.Operations is
procedure Set_True (S : in out Suspension_Object) is procedure Set_True (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -1147,6 +1163,8 @@ package body System.Task_Primitives.Operations is ...@@ -1147,6 +1163,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end Set_True; end Set_True;
------------------------ ------------------------
...@@ -1156,6 +1174,8 @@ package body System.Task_Primitives.Operations is ...@@ -1156,6 +1174,8 @@ package body System.Task_Primitives.Operations is
procedure Suspend_Until_True (S : in out Suspension_Object) is procedure Suspend_Until_True (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -1167,6 +1187,8 @@ package body System.Task_Primitives.Operations is ...@@ -1167,6 +1187,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
raise Program_Error; raise Program_Error;
else else
-- Suspend the task if the state is False. Otherwise, the task -- Suspend the task if the state is False. Otherwise, the task
...@@ -1179,10 +1201,12 @@ package body System.Task_Primitives.Operations is ...@@ -1179,10 +1201,12 @@ package body System.Task_Primitives.Operations is
S.Waiting := True; S.Waiting := True;
Result := pthread_cond_wait (S.CV'Access, S.L'Access); Result := pthread_cond_wait (S.CV'Access, S.L'Access);
end if; end if;
end if;
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end if;
end Suspend_Until_True; end Suspend_Until_True;
---------------- ----------------
......
gcc/ada/s-taprop-solaris.adb
...@@ -64,10 +64,20 @@ with Interfaces.C; ...@@ -64,10 +64,20 @@ with Interfaces.C;
with System.Task_Info; with System.Task_Info;
-- to initialize Task_Info for a C thread, in function Self -- 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; with Unchecked_Deallocation;
package body System.Task_Primitives.Operations is package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
use System.Tasking.Debug; use System.Tasking.Debug;
use System.Tasking; use System.Tasking;
use Interfaces.C; use Interfaces.C;
...@@ -1720,6 +1730,8 @@ package body System.Task_Primitives.Operations is ...@@ -1720,6 +1730,8 @@ package body System.Task_Primitives.Operations is
procedure Set_False (S : in out Suspension_Object) is procedure Set_False (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := mutex_lock (S.L'Access); Result := mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -1727,6 +1739,8 @@ package body System.Task_Primitives.Operations is ...@@ -1727,6 +1739,8 @@ package body System.Task_Primitives.Operations is
Result := mutex_unlock (S.L'Access); Result := mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end Set_False; end Set_False;
-------------- --------------
...@@ -1736,6 +1750,8 @@ package body System.Task_Primitives.Operations is ...@@ -1736,6 +1750,8 @@ package body System.Task_Primitives.Operations is
procedure Set_True (S : in out Suspension_Object) is procedure Set_True (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := mutex_lock (S.L'Access); Result := mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -1756,6 +1772,8 @@ package body System.Task_Primitives.Operations is ...@@ -1756,6 +1772,8 @@ package body System.Task_Primitives.Operations is
Result := mutex_unlock (S.L'Access); Result := mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end Set_True; end Set_True;
------------------------ ------------------------
...@@ -1765,6 +1783,8 @@ package body System.Task_Primitives.Operations is ...@@ -1765,6 +1783,8 @@ package body System.Task_Primitives.Operations is
procedure Suspend_Until_True (S : in out Suspension_Object) is procedure Suspend_Until_True (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := mutex_lock (S.L'Access); Result := mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -1776,6 +1796,8 @@ package body System.Task_Primitives.Operations is ...@@ -1776,6 +1796,8 @@ package body System.Task_Primitives.Operations is
Result := mutex_unlock (S.L'Access); Result := mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
raise Program_Error; raise Program_Error;
else else
-- Suspend the task if the state is False. Otherwise, the task -- Suspend the task if the state is False. Otherwise, the task
...@@ -1788,10 +1810,12 @@ package body System.Task_Primitives.Operations is ...@@ -1788,10 +1810,12 @@ package body System.Task_Primitives.Operations is
S.Waiting := True; S.Waiting := True;
Result := cond_wait (S.CV'Access, S.L'Access); Result := cond_wait (S.CV'Access, S.L'Access);
end if; end if;
end if;
Result := mutex_unlock (S.L'Access); Result := mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end if;
end Suspend_Until_True; end Suspend_Until_True;
---------------- ----------------
......
gcc/ada/s-taprop-tru64.adb
...@@ -61,10 +61,20 @@ with Interfaces.C; ...@@ -61,10 +61,20 @@ with Interfaces.C;
-- used for int -- used for int
-- size_t -- 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; with Unchecked_Deallocation;
package body System.Task_Primitives.Operations is package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
use System.Tasking.Debug; use System.Tasking.Debug;
use System.Tasking; use System.Tasking;
use Interfaces.C; use Interfaces.C;
...@@ -1026,6 +1036,8 @@ package body System.Task_Primitives.Operations is ...@@ -1026,6 +1036,8 @@ package body System.Task_Primitives.Operations is
procedure Set_False (S : in out Suspension_Object) is procedure Set_False (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -1033,6 +1045,8 @@ package body System.Task_Primitives.Operations is ...@@ -1033,6 +1045,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end Set_False; end Set_False;
-------------- --------------
...@@ -1042,6 +1056,8 @@ package body System.Task_Primitives.Operations is ...@@ -1042,6 +1056,8 @@ package body System.Task_Primitives.Operations is
procedure Set_True (S : in out Suspension_Object) is procedure Set_True (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -1062,6 +1078,8 @@ package body System.Task_Primitives.Operations is ...@@ -1062,6 +1078,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end Set_True; end Set_True;
------------------------ ------------------------
...@@ -1071,6 +1089,8 @@ package body System.Task_Primitives.Operations is ...@@ -1071,6 +1089,8 @@ package body System.Task_Primitives.Operations is
procedure Suspend_Until_True (S : in out Suspension_Object) is procedure Suspend_Until_True (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -1082,6 +1102,8 @@ package body System.Task_Primitives.Operations is ...@@ -1082,6 +1102,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
raise Program_Error; raise Program_Error;
else else
-- Suspend the task if the state is False. Otherwise, the task -- Suspend the task if the state is False. Otherwise, the task
...@@ -1094,10 +1116,12 @@ package body System.Task_Primitives.Operations is ...@@ -1094,10 +1116,12 @@ package body System.Task_Primitives.Operations is
S.Waiting := True; S.Waiting := True;
Result := pthread_cond_wait (S.CV'Access, S.L'Access); Result := pthread_cond_wait (S.CV'Access, S.L'Access);
end if; end if;
end if;
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end if;
end Suspend_Until_True; end Suspend_Until_True;
---------------- ----------------
......
gcc/ada/s-taprop-vms.adb
...@@ -52,6 +52,7 @@ with Interfaces.C; ...@@ -52,6 +52,7 @@ with Interfaces.C;
with System.Soft_Links; with System.Soft_Links;
-- used for Get_Exc_Stack_Addr -- used for Get_Exc_Stack_Addr
-- Abort_Defer/Undefer
with Unchecked_Conversion; with Unchecked_Conversion;
with Unchecked_Deallocation; with Unchecked_Deallocation;
...@@ -985,6 +986,8 @@ package body System.Task_Primitives.Operations is ...@@ -985,6 +986,8 @@ package body System.Task_Primitives.Operations is
procedure Set_False (S : in out Suspension_Object) is procedure Set_False (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -992,6 +995,8 @@ package body System.Task_Primitives.Operations is ...@@ -992,6 +995,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end Set_False; end Set_False;
-------------- --------------
...@@ -1001,6 +1006,8 @@ package body System.Task_Primitives.Operations is ...@@ -1001,6 +1006,8 @@ package body System.Task_Primitives.Operations is
procedure Set_True (S : in out Suspension_Object) is procedure Set_True (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -1021,6 +1028,8 @@ package body System.Task_Primitives.Operations is ...@@ -1021,6 +1028,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end Set_True; end Set_True;
------------------------ ------------------------
...@@ -1030,6 +1039,8 @@ package body System.Task_Primitives.Operations is ...@@ -1030,6 +1039,8 @@ package body System.Task_Primitives.Operations is
procedure Suspend_Until_True (S : in out Suspension_Object) is procedure Suspend_Until_True (S : in out Suspension_Object) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
SSL.Abort_Defer.all;
Result := pthread_mutex_lock (S.L'Access); Result := pthread_mutex_lock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
...@@ -1041,6 +1052,8 @@ package body System.Task_Primitives.Operations is ...@@ -1041,6 +1052,8 @@ package body System.Task_Primitives.Operations is
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
raise Program_Error; raise Program_Error;
else else
-- Suspend the task if the state is False. Otherwise, the task -- Suspend the task if the state is False. Otherwise, the task
...@@ -1053,10 +1066,12 @@ package body System.Task_Primitives.Operations is ...@@ -1053,10 +1066,12 @@ package body System.Task_Primitives.Operations is
S.Waiting := True; S.Waiting := True;
Result := pthread_cond_wait (S.CV'Access, S.L'Access); Result := pthread_cond_wait (S.CV'Access, S.L'Access);
end if; end if;
end if;
Result := pthread_mutex_unlock (S.L'Access); Result := pthread_mutex_unlock (S.L'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
end if;
end Suspend_Until_True; end Suspend_Until_True;
---------------- ----------------
......
gcc/ada/s-taprop-vxworks.adb
...@@ -51,11 +51,21 @@ with System.Interrupt_Management; ...@@ -51,11 +51,21 @@ with System.Interrupt_Management;
with Interfaces.C; 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_Conversion;
with Unchecked_Deallocation; with Unchecked_Deallocation;
package body System.Task_Primitives.Operations is package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
use System.Tasking.Debug; use System.Tasking.Debug;
use System.Tasking; use System.Tasking;
use System.OS_Interface; use System.OS_Interface;
...@@ -1030,6 +1040,8 @@ package body System.Task_Primitives.Operations is ...@@ -1030,6 +1040,8 @@ package body System.Task_Primitives.Operations is
procedure Set_False (S : in out Suspension_Object) is procedure Set_False (S : in out Suspension_Object) is
Result : STATUS; Result : STATUS;
begin begin
SSL.Abort_Defer.all;
Result := semTake (S.L, WAIT_FOREVER); Result := semTake (S.L, WAIT_FOREVER);
pragma Assert (Result = OK); pragma Assert (Result = OK);
...@@ -1037,6 +1049,8 @@ package body System.Task_Primitives.Operations is ...@@ -1037,6 +1049,8 @@ package body System.Task_Primitives.Operations is
Result := semGive (S.L); Result := semGive (S.L);
pragma Assert (Result = OK); pragma Assert (Result = OK);
SSL.Abort_Undefer.all;
end Set_False; end Set_False;
-------------- --------------
...@@ -1046,6 +1060,8 @@ package body System.Task_Primitives.Operations is ...@@ -1046,6 +1060,8 @@ package body System.Task_Primitives.Operations is
procedure Set_True (S : in out Suspension_Object) is procedure Set_True (S : in out Suspension_Object) is
Result : STATUS; Result : STATUS;
begin begin
SSL.Abort_Defer.all;
Result := semTake (S.L, WAIT_FOREVER); Result := semTake (S.L, WAIT_FOREVER);
pragma Assert (Result = OK); pragma Assert (Result = OK);
...@@ -1066,6 +1082,8 @@ package body System.Task_Primitives.Operations is ...@@ -1066,6 +1082,8 @@ package body System.Task_Primitives.Operations is
Result := semGive (S.L); Result := semGive (S.L);
pragma Assert (Result = OK); pragma Assert (Result = OK);
SSL.Abort_Undefer.all;
end Set_True; end Set_True;
------------------------ ------------------------
...@@ -1075,6 +1093,8 @@ package body System.Task_Primitives.Operations is ...@@ -1075,6 +1093,8 @@ package body System.Task_Primitives.Operations is
procedure Suspend_Until_True (S : in out Suspension_Object) is procedure Suspend_Until_True (S : in out Suspension_Object) is
Result : STATUS; Result : STATUS;
begin begin
SSL.Abort_Defer.all;
Result := semTake (S.L, WAIT_FOREVER); Result := semTake (S.L, WAIT_FOREVER);
if S.Waiting then if S.Waiting then
...@@ -1085,6 +1105,8 @@ package body System.Task_Primitives.Operations is ...@@ -1085,6 +1105,8 @@ package body System.Task_Primitives.Operations is
Result := semGive (S.L); Result := semGive (S.L);
pragma Assert (Result = OK); pragma Assert (Result = OK);
SSL.Abort_Undefer.all;
raise Program_Error; raise Program_Error;
else else
-- Suspend the task if the state is False. Otherwise, the task -- Suspend the task if the state is False. Otherwise, the task
...@@ -1096,6 +1118,8 @@ package body System.Task_Primitives.Operations is ...@@ -1096,6 +1118,8 @@ package body System.Task_Primitives.Operations is
Result := semGive (S.L); Result := semGive (S.L);
pragma Assert (Result = 0); pragma Assert (Result = 0);
SSL.Abort_Undefer.all;
else else
S.Waiting := True; S.Waiting := True;
...@@ -1104,6 +1128,8 @@ package body System.Task_Primitives.Operations is ...@@ -1104,6 +1128,8 @@ package body System.Task_Primitives.Operations is
Result := semGive (S.L); Result := semGive (S.L);
pragma Assert (Result = OK); pragma Assert (Result = OK);
SSL.Abort_Undefer.all;
Result := semTake (S.CV, WAIT_FOREVER); Result := semTake (S.CV, WAIT_FOREVER);
pragma Assert (Result = 0); pragma Assert (Result = 0);
end if; end if;
......
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