Skip to content

R
riscv-gcc-1
Commit 64a63cd5 by Pascal Obry Committed by Arnaud Charlet
Options

s-osinte-hpux.ads, [...]: Revert previous changes. 

2011-09-27  Pascal Obry  <obry@adacore.com>

	* s-osinte-hpux.ads, s-taprop-vxworks.adb, s-taspri-vxworks.ads,
	s-taprop-tru64.adb, s-osinte-aix.ads, s-taspri-posix-noaltstack.ads,
	s-taspri-mingw.ads, s-taprop-vms.adb, s-tpoben.adb, s-tpoben.ads,
	s-taprop-mingw.adb, s-taprob.adb, s-taprob.ads,
	s-osinte-solaris-posix.ads, s-taprop-solaris.adb, s-taspri-solaris.ads,
	s-osinte-irix.ads, s-taprop-irix.adb, s-osinte-darwin.ads,
	s-taspri-dummy.ads, s-taspri-posix.ads, s-taprop.ads,
	s-taspri-vms.ads, s-osinte-freebsd.ads, s-taprop-hpux-dce.adb,
	s-taspri-hpux-dce.ads, s-taspri-tru64.ads, s-taprop-dummy.adb,
	s-taprop-posix.adb: Revert previous changes.
	(Lock): Now a record containing the two possible lock
	(mutex and read/write) defined in OS_Interface.
	* s-taprop-linux.adb (Finalize_Protection): Use r/w lock for
	'R' locking policy.
	(Initialize_Protection): Likewise.
	(Lock): Likewise.
	(Lock_Read_Only): Likewise.
	(Unlock): Likewise.

From-SVN: r179253
parent f672a756
Showing with 90 additions and 431 deletions
gcc/ada/ChangeLog
2011-09-27 Pascal Obry <obry@adacore.com>
* s-osinte-hpux.ads, s-taprop-vxworks.adb, s-taspri-vxworks.ads,
s-taprop-tru64.adb, s-osinte-aix.ads, s-taspri-posix-noaltstack.ads,
s-taspri-mingw.ads, s-taprop-vms.adb, s-tpoben.adb, s-tpoben.ads,
s-taprop-mingw.adb, s-taprob.adb, s-taprob.ads,
s-osinte-solaris-posix.ads, s-taprop-solaris.adb, s-taspri-solaris.ads,
s-osinte-irix.ads, s-taprop-irix.adb, s-osinte-darwin.ads,
s-taspri-dummy.ads, s-taspri-posix.ads, s-taprop.ads,
s-taspri-vms.ads, s-osinte-freebsd.ads, s-taprop-hpux-dce.adb,
s-taspri-hpux-dce.ads, s-taspri-tru64.ads, s-taprop-dummy.adb,
s-taprop-posix.adb: Revert previous changes.
(Lock): Now a record containing the two possible lock
(mutex and read/write) defined in OS_Interface.
* s-taprop-linux.adb (Finalize_Protection): Use r/w lock for
'R' locking policy.
(Initialize_Protection): Likewise.
(Lock): Likewise.
(Lock_Read_Only): Likewise.
(Unlock): Likewise.
2011-09-27 Pascal Obry <obry@adacore.com>
* s-taspri-posix-noaltstack.ads (RW_Lock): This type is now defined as
OS_Interface.pthread_rwlock_t.
......
gcc/ada/s-osinte-aix.ads
......@@ -276,14 +276,6 @@ package System.OS_Interface is
PTHREAD_SCOPE_PROCESS : constant := 1;
PTHREAD_SCOPE_SYSTEM : constant := 0;
-- Read/Write lock not supported on AIX. To add support both types
-- pthread_rwlock_t and pthread_rwlockattr_t must properly be defined
-- with the associated routines pthread_rwlock_[init/destroy] and
-- pthread_rwlock_[rdlock/wrlock/unlock].
subtype pthread_rwlock_t is pthread_mutex_t;
subtype pthread_rwlockattr_t is pthread_mutexattr_t;
-----------
-- Stack --
-----------
......
gcc/ada/s-osinte-darwin.ads
......@@ -256,14 +256,6 @@ package System.OS_Interface is
PTHREAD_SCOPE_PROCESS : constant := 2;
PTHREAD_SCOPE_SYSTEM : constant := 1;
-- Read/Write lock not supported on Darwin. To add support both types
-- pthread_rwlock_t and pthread_rwlockattr_t must properly be defined
-- with the associated routines pthread_rwlock_[init/destroy] and
-- pthread_rwlock_[rdlock/wrlock/unlock].
subtype pthread_rwlock_t is pthread_mutex_t;
subtype pthread_rwlockattr_t is pthread_mutexattr_t;
-----------
-- Stack --
-----------
......
gcc/ada/s-osinte-freebsd.ads
......@@ -289,14 +289,6 @@ package System.OS_Interface is
PTHREAD_SCOPE_PROCESS : constant := 0;
PTHREAD_SCOPE_SYSTEM : constant := 2;
-- Read/Write lock not supported on freebsd. To add support both types
-- pthread_rwlock_t and pthread_rwlockattr_t must properly be defined
-- with the associated routines pthread_rwlock_[init/destroy] and
-- pthread_rwlock_[rdlock/wrlock/unlock].
subtype pthread_rwlock_t is pthread_mutex_t;
subtype pthread_rwlockattr_t is pthread_mutexattr_t;
-----------
-- Stack --
-----------
......
gcc/ada/s-osinte-hpux.ads
......@@ -265,14 +265,6 @@ package System.OS_Interface is
PTHREAD_SCOPE_PROCESS : constant := 2;
PTHREAD_SCOPE_SYSTEM : constant := 1;
-- Read/Write lock not supported on HPUX. To add support both types
-- pthread_rwlock_t and pthread_rwlockattr_t must properly be defined
-- with the associated routines pthread_rwlock_[init/destroy] and
-- pthread_rwlock_[rdlock/wrlock/unlock].
subtype pthread_rwlock_t is pthread_mutex_t;
subtype pthread_rwlockattr_t is pthread_mutexattr_t;
-----------
-- Stack --
-----------
......
gcc/ada/s-osinte-irix.ads
......@@ -250,14 +250,6 @@ package System.OS_Interface is
PTHREAD_CREATE_DETACHED : constant := 1;
-- Read/Write lock not supported on SGI. To add support both types
-- pthread_rwlock_t and pthread_rwlockattr_t must properly be defined
-- with the associated routines pthread_rwlock_[init/destroy] and
-- pthread_rwlock_[rdlock/wrlock/unlock].
subtype pthread_rwlock_t is pthread_mutex_t;
subtype pthread_rwlockattr_t is pthread_mutexattr_t;
-----------
-- Stack --
-----------
......
gcc/ada/s-osinte-solaris-posix.ads
......@@ -255,14 +255,6 @@ package System.OS_Interface is
type pthread_condattr_t is limited private;
type pthread_key_t is private;
-- Read/Write lock not supported on Solaris. To add support both types
-- pthread_rwlock_t and pthread_rwlockattr_t must properly be defined
-- with the associated routines pthread_rwlock_[init/destroy] and
-- pthread_rwlock_[rdlock/wrlock/unlock].
subtype pthread_rwlock_t is pthread_mutex_t;
subtype pthread_rwlockattr_t is pthread_mutexattr_t;
PTHREAD_CREATE_DETACHED : constant := 16#40#;
PTHREAD_SCOPE_PROCESS : constant := 0;
......
gcc/ada/s-taprob.adb
......@@ -57,11 +57,7 @@ package body System.Tasking.Protected_Objects is
procedure Finalize_Protection (Object : in out Protection) is
begin
if Locking_Policy = 'R' then
Finalize_Lock (Object.RWL'Unrestricted_Access);
else
Finalize_Lock (Object.L'Unrestricted_Access);
end if;
end Finalize_Protection;
---------------------------
......@@ -79,11 +75,7 @@ package body System.Tasking.Protected_Objects is
Init_Priority := System.Priority'Last;
end if;
if Locking_Policy = 'R' then
Initialize_Lock (Init_Priority, Object.RWL'Access);
else
Initialize_Lock (Init_Priority, Object.L'Access);
end if;
Object.Ceiling := System.Any_Priority (Init_Priority);
Object.New_Ceiling := System.Any_Priority (Init_Priority);
Object.Owner := Null_Task;
......@@ -128,11 +120,7 @@ package body System.Tasking.Protected_Objects is
raise Program_Error;
end if;
if Locking_Policy = 'R' then
Write_Lock (Object.RWL'Access, Ceiling_Violation);
else
Write_Lock (Object.L'Access, Ceiling_Violation);
end if;
if Parameters.Runtime_Traces then
Send_Trace_Info (PO_Lock);
......@@ -189,11 +177,7 @@ package body System.Tasking.Protected_Objects is
raise Program_Error;
end if;
if Locking_Policy = 'R' then
Read_Lock (Object.RWL'Access, Ceiling_Violation);
else
Write_Lock (Object.L'Access, Ceiling_Violation);
end if;
Read_Lock (Object.L'Access, Ceiling_Violation);
if Parameters.Runtime_Traces then
Send_Trace_Info (PO_Lock);
......@@ -279,11 +263,7 @@ package body System.Tasking.Protected_Objects is
Object.Ceiling := Object.New_Ceiling;
end if;
if Locking_Policy = 'R' then
Unlock (Object.RWL'Access);
else
Unlock (Object.L'Access);
end if;
if Parameters.Runtime_Traces then
Send_Trace_Info (PO_Unlock);
......
gcc/ada/s-taprob.ads
......@@ -212,9 +212,6 @@ private
L : aliased Task_Primitives.Lock;
-- Lock used to ensure mutual exclusive access to the protected object
RWL : aliased Task_Primitives.RW_Lock;
-- Lock used to support conccurent readers to the protected object
Ceiling : System.Any_Priority;
-- Ceiling priority associated to the protected object
......
gcc/ada/s-taprop-dummy.adb
......@@ -158,11 +158,6 @@ package body System.Task_Primitives.Operations is
null;
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RW_Lock) is
begin
null;
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RTS_Lock) is
begin
null;
......@@ -223,14 +218,6 @@ package body System.Task_Primitives.Operations is
end Initialize_Lock;
procedure Initialize_Lock
(Prio : System.Any_Priority;
L : not null access RW_Lock)
is
begin
null;
end Initialize_Lock;
procedure Initialize_Lock
(L : not null access RTS_Lock; Level : Lock_Level) is
begin
null;
......@@ -277,7 +264,7 @@ package body System.Task_Primitives.Operations is
---------------
procedure Read_Lock
(L : not null access RW_Lock;
(L : not null access Lock;
Ceiling_Violation : out Boolean)
is
begin
......@@ -472,11 +459,6 @@ package body System.Task_Primitives.Operations is
null;
end Unlock;
procedure Unlock (L : not null access RW_Lock) is
begin
null;
end Unlock;
procedure Unlock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
......@@ -520,14 +502,6 @@ package body System.Task_Primitives.Operations is
end Write_Lock;
procedure Write_Lock
(L : not null access RW_Lock;
Ceiling_Violation : out Boolean)
is
begin
Ceiling_Violation := False;
end Write_Lock;
procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
......
gcc/ada/s-taprop-hpux-dce.adb
......@@ -254,14 +254,6 @@ package body System.Task_Primitives.Operations is
end Initialize_Lock;
procedure Initialize_Lock
(Prio : System.Any_Priority;
L : not null access RW_Lock)
is
begin
Initialize_Lock (Prio, Lock (L.all)'Unrestricted_Access);
end Initialize_Lock;
procedure Initialize_Lock
(L : not null access RTS_Lock;
Level : Lock_Level)
is
......@@ -301,11 +293,6 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RW_Lock) is
begin
Finalize_Lock (Lock (L.all)'Unrestricted_Access);
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
......@@ -337,14 +324,6 @@ package body System.Task_Primitives.Operations is
end Write_Lock;
procedure Write_Lock
(L : not null access RW_Lock;
Ceiling_Violation : out Boolean)
is
begin
Write_Lock (Lock (L.all)'Unrestricted_Access, Ceiling_Violation);
end Write_Lock;
procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
......@@ -370,7 +349,7 @@ package body System.Task_Primitives.Operations is
---------------
procedure Read_Lock
(L : not null access RW_Lock;
(L : not null access Lock;
Ceiling_Violation : out Boolean)
is
begin
......@@ -388,11 +367,6 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end Unlock;
procedure Unlock (L : not null access RW_Lock) is
begin
Unlock (Lock (L.all)'Unrestricted_Access);
end Unlock;
procedure Unlock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
......
gcc/ada/s-taprop-irix.adb
......@@ -268,14 +268,6 @@ package body System.Task_Primitives.Operations is
end Initialize_Lock;
procedure Initialize_Lock
(Prio : System.Any_Priority;
L : not null access RW_Lock)
is
begin
Initialize_Lock (Prio, Lock (L.all)'Unrestricted_Access);
end Initialize_Lock;
procedure Initialize_Lock
(L : not null access RTS_Lock;
Level : Lock_Level)
is
......@@ -326,11 +318,6 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RW_Lock) is
begin
Finalize_Lock (Lock (L.all)'Unrestricted_Access);
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
......@@ -357,13 +344,6 @@ package body System.Task_Primitives.Operations is
end Write_Lock;
procedure Write_Lock
(L : not null access RW_Lock; Ceiling_Violation : out Boolean)
is
begin
Write_Lock (Lock (L.all)'Unrestricted_Access, Ceiling_Violation);
end Write_Lock;
procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
......@@ -389,7 +369,7 @@ package body System.Task_Primitives.Operations is
---------------
procedure Read_Lock
(L : not null access RW_Lock; Ceiling_Violation : out Boolean) is
(L : not null access Lock; Ceiling_Violation : out Boolean) is
begin
Write_Lock (L, Ceiling_Violation);
end Read_Lock;
......@@ -405,11 +385,6 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end Unlock;
procedure Unlock (L : not null access RW_Lock) is
begin
Unlock (Lock (L.all)'Unrestricted_Access);
end Unlock;
procedure Unlock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
......
gcc/ada/s-taprop-linux.adb
......@@ -95,6 +95,9 @@ package body System.Task_Primitives.Operations is
Dispatching_Policy : Character;
pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
Locking_Policy : Character;
pragma Import (C, Locking_Policy, "__gl_locking_policy");
Foreign_Task_Elaborated : aliased Boolean := True;
-- Used to identified fake tasks (i.e., non-Ada Threads)
......@@ -260,48 +263,50 @@ package body System.Task_Primitives.Operations is
is
pragma Unreferenced (Prio);
Mutex_Attr : aliased pthread_mutexattr_t;
begin
if Locking_Policy = 'R' then
declare
RWlock_Attr : aliased pthread_rwlockattr_t;
Result : Interfaces.C.int;
begin
Result := pthread_mutexattr_init (Mutex_Attr'Access);
-- Set the rwlock to prefer writer to avoid writers starvation
Result := pthread_rwlockattr_init (RWlock_Attr'Access);
pragma Assert (Result = 0);
Result := pthread_mutex_init (L, Mutex_Attr'Access);
Result := pthread_rwlockattr_setkind_np
(RWlock_Attr'Access,
PTHREAD_RWLOCK_PREFER_WRITER_NONRECURSIVE_NP);
pragma Assert (Result = 0);
Result := pthread_rwlock_init (L.RW'Access, RWlock_Attr'Access);
pragma Assert (Result = 0 or else Result = ENOMEM);
if Result = ENOMEM then
raise Storage_Error with "Failed to allocate a lock";
end if;
end Initialize_Lock;
procedure Initialize_Lock
(Prio : System.Any_Priority;
L : not null access RW_Lock)
is
pragma Unreferenced (Prio);
end;
RWlock_Attr : aliased pthread_rwlockattr_t;
else
declare
Mutex_Attr : aliased pthread_mutexattr_t;
Result : Interfaces.C.int;
begin
-- Set the rwlock to prefer writer to avoid writers starvation
Result := pthread_rwlockattr_init (RWlock_Attr'Access);
pragma Assert (Result = 0);
Result := pthread_rwlockattr_setkind_np
(RWlock_Attr'Access, PTHREAD_RWLOCK_PREFER_WRITER_NONRECURSIVE_NP);
Result := pthread_mutexattr_init (Mutex_Attr'Access);
pragma Assert (Result = 0);
Result := pthread_rwlock_init (L, RWlock_Attr'Access);
Result := pthread_mutex_init (L.WO'Access, Mutex_Attr'Access);
pragma Assert (Result = 0 or else Result = ENOMEM);
if Result = ENOMEM then
raise Storage_Error with "Failed to allocate a lock";
end if;
end;
end if;
end Initialize_Lock;
procedure Initialize_Lock
......@@ -333,14 +338,11 @@ package body System.Task_Primitives.Operations is
procedure Finalize_Lock (L : not null access Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_destroy (L);
pragma Assert (Result = 0);
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RW_Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_rwlock_destroy (L);
if Locking_Policy = 'R' then
Result := pthread_rwlock_destroy (L.RW'Access);
else
Result := pthread_mutex_destroy (L.WO'Access);
end if;
pragma Assert (Result = 0);
end Finalize_Lock;
......@@ -361,21 +363,12 @@ package body System.Task_Primitives.Operations is
is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_lock (L);
Ceiling_Violation := Result = EINVAL;
-- Assume the cause of EINVAL is a priority ceiling violation
pragma Assert (Result = 0 or else Result = EINVAL);
end Write_Lock;
if Locking_Policy = 'R' then
Result := pthread_rwlock_wrlock (L.RW'Access);
else
Result := pthread_mutex_lock (L.WO'Access);
end if;
procedure Write_Lock
(L : not null access RW_Lock;
Ceiling_Violation : out Boolean)
is
Result : Interfaces.C.int;
begin
Result := pthread_rwlock_wrlock (L);
Ceiling_Violation := Result = EINVAL;
-- Assume the cause of EINVAL is a priority ceiling violation
......@@ -409,12 +402,17 @@ package body System.Task_Primitives.Operations is
---------------
procedure Read_Lock
(L : not null access RW_Lock;
(L : not null access Lock;
Ceiling_Violation : out Boolean)
is
Result : Interfaces.C.int;
begin
Result := pthread_rwlock_rdlock (L);
if Locking_Policy = 'R' then
Result := pthread_rwlock_rdlock (L.RW'Access);
else
Result := pthread_mutex_lock (L.WO'Access);
end if;
Ceiling_Violation := Result = EINVAL;
-- Assume the cause of EINVAL is a priority ceiling violation
......@@ -429,14 +427,11 @@ package body System.Task_Primitives.Operations is
procedure Unlock (L : not null access Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_unlock (L);
pragma Assert (Result = 0);
end Unlock;
procedure Unlock (L : not null access RW_Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_rwlock_unlock (L);
if Locking_Policy = 'R' then
Result := pthread_rwlock_unlock (L.RW'Access);
else
Result := pthread_mutex_unlock (L.WO'Access);
end if;
pragma Assert (Result = 0);
end Unlock;
......
gcc/ada/s-taprop-mingw.adb
......@@ -415,14 +415,6 @@ package body System.Task_Primitives.Operations is
end Initialize_Lock;
procedure Initialize_Lock
(Prio : System.Any_Priority;
L : not null access RW_Lock)
is
begin
Initialize_Lock (Prio, Lock (L.all)'Unrestricted_Access);
end Initialize_Lock;
procedure Initialize_Lock
(L : not null access RTS_Lock; Level : Lock_Level)
is
pragma Unreferenced (Level);
......@@ -439,11 +431,6 @@ package body System.Task_Primitives.Operations is
DeleteCriticalSection (L.Mutex'Access);
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RW_Lock) is
begin
Finalize_Lock (Lock (L.all)'Unrestricted_Access);
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RTS_Lock) is
begin
DeleteCriticalSection (L);
......@@ -469,12 +456,6 @@ package body System.Task_Primitives.Operations is
end Write_Lock;
procedure Write_Lock
(L : not null access RW_Lock; Ceiling_Violation : out Boolean) is
begin
Write_Lock (Lock (L.all)'Unrestricted_Access, Ceiling_Violation);
end Write_Lock;
procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
......@@ -496,7 +477,7 @@ package body System.Task_Primitives.Operations is
---------------
procedure Read_Lock
(L : not null access RW_Lock; Ceiling_Violation : out Boolean) is
(L : not null access Lock; Ceiling_Violation : out Boolean) is
begin
Write_Lock (L, Ceiling_Violation);
end Read_Lock;
......@@ -510,11 +491,6 @@ package body System.Task_Primitives.Operations is
LeaveCriticalSection (L.Mutex'Access);
end Unlock;
procedure Unlock (L : not null access RW_Lock) is
begin
Unlock (Lock (L.all)'Unrestricted_Access);
end Unlock;
procedure Unlock
(L : not null access RTS_Lock; Global_Lock : Boolean := False) is
begin
......
gcc/ada/s-taprop-posix.adb
......@@ -323,14 +323,6 @@ package body System.Task_Primitives.Operations is
end Initialize_Lock;
procedure Initialize_Lock
(Prio : System.Any_Priority;
L : not null access RW_Lock)
is
begin
Initialize_Lock (Prio, Lock (L.all)'Unrestricted_Access);
end Initialize_Lock;
procedure Initialize_Lock
(L : not null access RTS_Lock; Level : Lock_Level)
is
pragma Unreferenced (Level);
......@@ -384,11 +376,6 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RW_Lock) is
begin
Finalize_Lock (Lock (L.all)'Unrestricted_Access);
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
......@@ -415,13 +402,6 @@ package body System.Task_Primitives.Operations is
end Write_Lock;
procedure Write_Lock
(L : not null access RW_Lock; Ceiling_Violation : out Boolean)
is
begin
Write_Lock (Lock (L.all)'Unrestricted_Access, Ceiling_Violation);
end Write_Lock;
procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
......@@ -447,7 +427,7 @@ package body System.Task_Primitives.Operations is
---------------
procedure Read_Lock
(L : not null access RW_Lock; Ceiling_Violation : out Boolean) is
(L : not null access Lock; Ceiling_Violation : out Boolean) is
begin
Write_Lock (L, Ceiling_Violation);
end Read_Lock;
......@@ -463,11 +443,6 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end Unlock;
procedure Unlock (L : not null access RW_Lock) is
begin
Unlock (Lock (L.all)'Unrestricted_Access);
end Unlock;
procedure Unlock
(L : not null access RTS_Lock; Global_Lock : Boolean := False)
is
......
gcc/ada/s-taprop-solaris.adb
......@@ -564,14 +564,6 @@ package body System.Task_Primitives.Operations is
end Initialize_Lock;
procedure Initialize_Lock
(Prio : System.Any_Priority;
L : not null access RW_Lock)
is
begin
Initialize_Lock (Prio, Lock (L.all)'Unrestricted_Access);
end Initialize_Lock;
procedure Initialize_Lock
(L : not null access RTS_Lock;
Level : Lock_Level)
is
......@@ -600,11 +592,6 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RW_Lock) is
begin
Finalize_Lock (Lock (L.all)'Unrestricted_Access);
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
......@@ -660,14 +647,6 @@ package body System.Task_Primitives.Operations is
end Write_Lock;
procedure Write_Lock
(L : not null access RW_Lock;
Ceiling_Violation : out Boolean)
is
begin
Write_Lock (Lock (L.all)'Unrestricted_Access, Ceiling_Violation);
end Write_Lock;
procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
......@@ -697,7 +676,7 @@ package body System.Task_Primitives.Operations is
---------------
procedure Read_Lock
(L : not null access RW_Lock;
(L : not null access Lock;
Ceiling_Violation : out Boolean) is
begin
Write_Lock (L, Ceiling_Violation);
......@@ -731,11 +710,6 @@ package body System.Task_Primitives.Operations is
end if;
end Unlock;
procedure Unlock (L : not null access RW_Lock) is
begin
Unlock (Lock (L.all)'Unrestricted_Access);
end Unlock;
procedure Unlock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
......
gcc/ada/s-taprop-tru64.adb
......@@ -266,14 +266,6 @@ package body System.Task_Primitives.Operations is
end Initialize_Lock;
procedure Initialize_Lock
(Prio : System.Any_Priority;
L : not null access RW_Lock)
is
begin
Initialize_Lock (Prio, Lock (L.all)'Unrestricted_Access);
end Initialize_Lock;
procedure Initialize_Lock
(L : not null access RTS_Lock;
Level : Lock_Level)
is
......@@ -313,11 +305,6 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RW_Lock) is
begin
Finalize_Lock (Lock (L.all)'Unrestricted_Access);
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
......@@ -363,14 +350,6 @@ package body System.Task_Primitives.Operations is
end Write_Lock;
procedure Write_Lock
(L : not null access RW_Lock;
Ceiling_Violation : out Boolean)
is
begin
Write_Lock (Lock (L.all)'Unrestricted_Access, Ceiling_Violation);
end Write_Lock;
procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
......@@ -396,7 +375,7 @@ package body System.Task_Primitives.Operations is
---------------
procedure Read_Lock
(L : not null access RW_Lock;
(L : not null access Lock;
Ceiling_Violation : out Boolean)
is
begin
......@@ -414,11 +393,6 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end Unlock;
procedure Unlock (L : not null access RW_Lock) is
begin
Unlock (Lock (L.all)'Unrestricted_Access);
end Unlock;
procedure Unlock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
......
gcc/ada/s-taprop-vms.adb
......@@ -226,13 +226,6 @@ package body System.Task_Primitives.Operations is
end Initialize_Lock;
procedure Initialize_Lock
(Prio : System.Any_Priority;
L : not null access RW_Lock) is
begin
Initialize_Lock (Prio, Lock (L.all)'Unrestricted_Access);
end Initialize_Lock;
procedure Initialize_Lock
(L : not null access RTS_Lock;
Level : Lock_Level)
is
......@@ -285,11 +278,6 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RW_Lock) is
begin
Finalize_Lock (Lock (L.all)'Unrestricted_Access);
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
......@@ -332,14 +320,6 @@ package body System.Task_Primitives.Operations is
end Write_Lock;
procedure Write_Lock
(L : not null access RW_Lock;
Ceiling_Violation : out Boolean)
is
begin
Write_Lock (Lock (L.all)'Unrestricted_Access, Ceiling_Violation);
end Write_Lock;
procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
......@@ -365,7 +345,7 @@ package body System.Task_Primitives.Operations is
---------------
procedure Read_Lock
(L : not null access RW_Lock;
(L : not null access Lock;
Ceiling_Violation : out Boolean)
is
begin
......@@ -383,11 +363,6 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end Unlock;
procedure Unlock (L : not null access RW_Lock) is
begin
Unlock (Lock (L.all)'Unrestricted_Access);
end Unlock;
procedure Unlock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
......
gcc/ada/s-taprop-vxworks.adb
......@@ -309,14 +309,6 @@ package body System.Task_Primitives.Operations is
end Initialize_Lock;
procedure Initialize_Lock
(Prio : System.Any_Priority;
L : not null access RW_Lock)
is
begin
Initialize_Lock (Prio, Lock (L.all)'Unrestricted_Access);
end Initialize_Lock;
procedure Initialize_Lock
(L : not null access RTS_Lock;
Level : Lock_Level)
is
......@@ -339,11 +331,6 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RW_Lock) is
begin
Finalize_Lock (Lock (L.all)'Unrestricted_Access);
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : int;
begin
......@@ -376,14 +363,6 @@ package body System.Task_Primitives.Operations is
end Write_Lock;
procedure Write_Lock
(L : not null access RW_Lock;
Ceiling_Violation : out Boolean)
is
begin
Write_Lock (Lock (L.all)'Unrestricted_Access, Ceiling_Violation);
end Write_Lock;
procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
......@@ -409,7 +388,7 @@ package body System.Task_Primitives.Operations is
---------------
procedure Read_Lock
(L : not null access RW_Lock;
(L : not null access Lock;
Ceiling_Violation : out Boolean)
is
begin
......@@ -427,11 +406,6 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end Unlock;
procedure Unlock (L : not null access RW_Lock) is
begin
Unlock (Lock (L.all)'Unrestricted_Access);
end Unlock;
procedure Unlock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
......
gcc/ada/s-taprop.ads
......@@ -149,9 +149,6 @@ package System.Task_Primitives.Operations is
(Prio : System.Any_Priority;
L : not null access Lock);
procedure Initialize_Lock
(Prio : System.Any_Priority;
L : not null access RW_Lock);
procedure Initialize_Lock
(L : not null access RTS_Lock;
Level : Lock_Level);
pragma Inline (Initialize_Lock);
......@@ -176,7 +173,6 @@ package System.Task_Primitives.Operations is
-- These operations raise Storage_Error if a lack of storage is detected
procedure Finalize_Lock (L : not null access Lock);
procedure Finalize_Lock (L : not null access RW_Lock);
procedure Finalize_Lock (L : not null access RTS_Lock);
pragma Inline (Finalize_Lock);
-- Finalize a lock object, freeing any resources allocated by the
......@@ -186,9 +182,6 @@ package System.Task_Primitives.Operations is
(L : not null access Lock;
Ceiling_Violation : out Boolean);
procedure Write_Lock
(L : not null access RW_Lock;
Ceiling_Violation : out Boolean);
procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False);
procedure Write_Lock
......@@ -217,7 +210,7 @@ package System.Task_Primitives.Operations is
-- per-task lock is implicit in Exit_Task.
procedure Read_Lock
(L : not null access RW_Lock;
(L : not null access Lock;
Ceiling_Violation : out Boolean);
pragma Inline (Read_Lock);
-- Lock a lock object for read access. After this operation returns,
......@@ -243,8 +236,6 @@ package System.Task_Primitives.Operations is
procedure Unlock
(L : not null access Lock);
procedure Unlock
(L : not null access RW_Lock);
procedure Unlock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False);
procedure Unlock
......
gcc/ada/s-taspri-dummy.ads
......@@ -40,8 +40,6 @@ package System.Task_Primitives is
type Lock is new Integer;
type RW_Lock is new Integer;
type RTS_Lock is new Integer;
type Suspension_Object is new Integer;
......
gcc/ada/s-taspri-hpux-dce.ads
......@@ -43,7 +43,6 @@ package System.Task_Primitives is
pragma Preelaborate;
type Lock is limited private;
type RW_Lock is limited private;
-- Should be used for implementation of protected objects
type RTS_Lock is limited private;
......@@ -82,8 +81,6 @@ private
Owner_Priority : Integer;
end record;
type RW_Lock is new Lock;
type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
type Suspension_Object is record
......
gcc/ada/s-taspri-mingw.ads
......@@ -42,7 +42,6 @@ package System.Task_Primitives is
pragma Preelaborate;
type Lock is limited private;
type RW_Lock is limited private;
-- Should be used for implementation of protected objects
type RTS_Lock is limited private;
......@@ -82,8 +81,6 @@ private
Owner_Priority : Integer;
end record;
type RW_Lock is new Lock;
type Condition_Variable is new System.Win32.HANDLE;
type RTS_Lock is new System.OS_Interface.CRITICAL_SECTION;
......
gcc/ada/s-taspri-posix-noaltstack.ads
......@@ -45,7 +45,6 @@ package System.Task_Primitives is
pragma Preelaborate;
type Lock is limited private;
type RW_Lock is limited private;
-- Should be used for implementation of protected objects
type RTS_Lock is limited private;
......@@ -79,8 +78,11 @@ package System.Task_Primitives is
private
type Lock is new System.OS_Interface.pthread_mutex_t;
type RW_Lock is new System.OS_Interface.pthread_rwlock_t;
type Lock is record
WO : System.OS_Interface.pthread_mutex_t;
RW : System.OS_Interface.pthread_rwlock_t;
end record;
type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
type Suspension_Object is record
......
gcc/ada/s-taspri-posix.ads
......@@ -44,7 +44,6 @@ package System.Task_Primitives is
pragma Preelaborate;
type Lock is limited private;
type RW_Lock is limited private;
-- Should be used for implementation of protected objects
type RTS_Lock is limited private;
......@@ -78,8 +77,11 @@ package System.Task_Primitives is
private
type Lock is new System.OS_Interface.pthread_mutex_t;
type RW_Lock is new System.OS_Interface.pthread_rwlock_t;
type Lock is record
RW : aliased System.OS_Interface.pthread_rwlock_t;
WO : aliased System.OS_Interface.pthread_mutex_t;
end record;
type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
type Suspension_Object is record
......
gcc/ada/s-taspri-solaris.ads
......@@ -46,7 +46,6 @@ package System.Task_Primitives is
type Lock is limited private;
type Lock_Ptr is access all Lock;
type RW_Lock is limited private;
-- Should be used for implementation of protected objects
type RTS_Lock is limited private;
......@@ -108,8 +107,6 @@ private
Frozen : Boolean := False;
end record;
type RW_Lock is new Lock;
type RTS_Lock is new Lock;
type Suspension_Object is record
......
gcc/ada/s-taspri-tru64.ads
......@@ -45,7 +45,6 @@ package System.Task_Primitives is
pragma Preelaborate;
type Lock is limited private;
type RW_Lock is limited private;
-- Should be used for implementation of protected objects
type RTS_Lock is limited private;
......@@ -83,8 +82,6 @@ private
Ceiling : Interfaces.C.int;
end record;
type RW_Lock is new Lock;
type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
type Suspension_Object is record
......
gcc/ada/s-taspri-vms.ads
......@@ -46,7 +46,6 @@ package System.Task_Primitives is
pragma Preelaborate;
type Lock is limited private;
type RW_Lock is limited private;
-- Should be used for implementation of protected objects
type RTS_Lock is limited private;
......@@ -85,8 +84,6 @@ private
Prio_Save : Interfaces.C.int;
end record;
type RW_Lock is new Lock;
type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
type Suspension_Object is record
......
gcc/ada/s-taspri-vxworks.ads
......@@ -41,7 +41,6 @@ package System.Task_Primitives is
pragma Preelaborate;
type Lock is limited private;
type RW_Lock is limited private;
-- Should be used for implementation of protected objects
type RTS_Lock is limited private;
......@@ -85,8 +84,6 @@ private
-- Priority ceiling of lock
end record;
type RW_Lock is new Lock;
type RTS_Lock is new Lock;
type Suspension_Object is record
......
gcc/ada/s-tpoben.adb
......@@ -88,11 +88,7 @@ package body System.Tasking.Protected_Objects.Entries is
return;
end if;
if Locking_Policy = 'R' then
STPO.Write_Lock (Object.RWL'Unrestricted_Access, Ceiling_Violation);
else
STPO.Write_Lock (Object.L'Unrestricted_Access, Ceiling_Violation);
end if;
if Single_Lock then
Lock_RTS;
......@@ -113,12 +109,7 @@ package body System.Tasking.Protected_Objects.Entries is
Unlock_RTS;
end if;
if Locking_Policy = 'R' then
STPO.Write_Lock
(Object.RWL'Unrestricted_Access, Ceiling_Violation);
else
STPO.Write_Lock (Object.L'Unrestricted_Access, Ceiling_Violation);
end if;
if Ceiling_Violation then
raise Program_Error with "Ceiling Violation";
......@@ -158,13 +149,9 @@ package body System.Tasking.Protected_Objects.Entries is
Unlock_RTS;
end if;
if Locking_Policy = 'R' then
STPO.Unlock (Object.RWL'Unrestricted_Access);
STPO.Finalize_Lock (Object.RWL'Unrestricted_Access);
else
STPO.Unlock (Object.L'Unrestricted_Access);
STPO.Finalize_Lock (Object.L'Unrestricted_Access);
end if;
end Finalize;
----------------------
......@@ -247,13 +234,7 @@ package body System.Tasking.Protected_Objects.Entries is
-- pragma Assert (Self_Id.Deferral_Level = 0);
Initialization.Defer_Abort_Nestable (Self_ID);
if Locking_Policy = 'R' then
Initialize_Lock (Init_Priority, Object.RWL'Access);
else
Initialize_Lock (Init_Priority, Object.L'Access);
end if;
Initialization.Undefer_Abort_Nestable (Self_ID);
Object.Ceiling := System.Any_Priority (Init_Priority);
......@@ -329,11 +310,7 @@ package body System.Tasking.Protected_Objects.Entries is
(STPO.Self.Deferral_Level > 0
or else not Restrictions.Abort_Allowed);
if Locking_Policy = 'R' then
Write_Lock (Object.RWL'Access, Ceiling_Violation);
else
Write_Lock (Object.L'Access, Ceiling_Violation);
end if;
-- We are entering in a protected action, so that we increase the
-- protected object nesting level (if pragma Detect_Blocking is
......@@ -387,11 +364,7 @@ package body System.Tasking.Protected_Objects.Entries is
raise Program_Error;
end if;
if Locking_Policy = 'R' then
Read_Lock (Object.RWL'Access, Ceiling_Violation);
else
Write_Lock (Object.L'Access, Ceiling_Violation);
end if;
Read_Lock (Object.L'Access, Ceiling_Violation);
if Ceiling_Violation then
raise Program_Error with "Ceiling Violation";
......@@ -487,11 +460,7 @@ package body System.Tasking.Protected_Objects.Entries is
Object.Ceiling := Object.New_Ceiling;
end if;
if Locking_Policy = 'R' then
Unlock (Object.RWL'Access);
else
Unlock (Object.L'Access);
end if;
end Unlock_Entries;
end System.Tasking.Protected_Objects.Entries;
gcc/ada/s-tpoben.ads
......@@ -77,7 +77,6 @@ package System.Tasking.Protected_Objects.Entries is
Ada.Finalization.Limited_Controlled
with record
L : aliased Task_Primitives.Lock;
RWL : aliased Task_Primitives.RW_Lock;
-- The underlying lock associated with a Protection_Entries.
-- Note that you should never (un)lock Object.L directly, but instead
-- use Lock_Entries/Unlock_Entries.
......
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