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

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;
+      Finalize_Lock (Object.L'Unrestricted_Access);
    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;
+      Initialize_Lock (Init_Priority, Object.L'Access);
       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;
+      Write_Lock (Object.L'Access, Ceiling_Violation);
 
       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;
+      Unlock (Object.L'Access);
 
       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,47 +263,49 @@ package body System.Task_Primitives.Operations is
    is
       pragma Unreferenced (Prio);
 
-      Mutex_Attr : aliased pthread_mutexattr_t;
-      Result     : Interfaces.C.int;
-
    begin
-      Result := pthread_mutexattr_init (Mutex_Attr'Access);
-      pragma Assert (Result = 0);
+      if Locking_Policy = 'R' then
+         declare
+            RWlock_Attr : aliased pthread_rwlockattr_t;
+            Result      : Interfaces.C.int;
 
-      Result := pthread_mutex_init (L, Mutex_Attr'Access);
+         begin
+            --  Set the rwlock to prefer writer to avoid writers starvation
 
-      pragma Assert (Result = 0 or else Result = ENOMEM);
+            Result := pthread_rwlockattr_init (RWlock_Attr'Access);
+            pragma Assert (Result = 0);
 
-      if Result = ENOMEM then
-         raise Storage_Error with "Failed to allocate a lock";
-      end if;
-   end Initialize_Lock;
+            Result := pthread_rwlockattr_setkind_np
+              (RWlock_Attr'Access,
+               PTHREAD_RWLOCK_PREFER_WRITER_NONRECURSIVE_NP);
+            pragma Assert (Result = 0);
 
-   procedure Initialize_Lock
-     (Prio : System.Any_Priority;
-      L    : not null access RW_Lock)
-   is
-      pragma Unreferenced (Prio);
+            Result := pthread_rwlock_init (L.RW'Access, RWlock_Attr'Access);
 
-      RWlock_Attr : aliased pthread_rwlockattr_t;
-      Result      : Interfaces.C.int;
+            pragma Assert (Result = 0 or else Result = ENOMEM);
 
-   begin
-      --  Set the rwlock to prefer writer to avoid writers starvation
+            if Result = ENOMEM then
+               raise Storage_Error with "Failed to allocate a lock";
+            end if;
+         end;
 
-      Result := pthread_rwlockattr_init (RWlock_Attr'Access);
-      pragma Assert (Result = 0);
+      else
+         declare
+            Mutex_Attr : aliased pthread_mutexattr_t;
+            Result     : Interfaces.C.int;
 
-      Result := pthread_rwlockattr_setkind_np
-        (RWlock_Attr'Access, PTHREAD_RWLOCK_PREFER_WRITER_NONRECURSIVE_NP);
-      pragma Assert (Result = 0);
+         begin
+            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);
+            pragma Assert (Result = 0 or else Result = ENOMEM);
 
-      if Result = ENOMEM then
-         raise Storage_Error with "Failed to allocate a lock";
+            if Result = ENOMEM then
+               raise Storage_Error with "Failed to allocate a lock";
+            end if;
+         end;
       end if;
    end 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;
+      STPO.Write_Lock (Object.L'Unrestricted_Access, Ceiling_Violation);
 
       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;
+         STPO.Write_Lock (Object.L'Unrestricted_Access, Ceiling_Violation);
 
          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;
+      STPO.Unlock (Object.L'Unrestricted_Access);
+
+      STPO.Finalize_Lock (Object.L'Unrestricted_Access);
    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;
-
+      Initialize_Lock (Init_Priority, Object.L'Access);
       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;
+      Write_Lock (Object.L'Access, Ceiling_Violation);
 
       --  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;
+      Unlock (Object.L'Access);
    end Unlock_Entries;
 
 end System.Tasking.Protected_Objects.Entries;

gcc/ada/s-tpoben.ads

@@ -76,8 +76,7 @@ package System.Tasking.Protected_Objects.Entries is
    type Protection_Entries (Num_Entries : Protected_Entry_Index) is new
      Ada.Finalization.Limited_Controlled
    with record
-      L   : aliased Task_Primitives.Lock;
-      RWL : aliased Task_Primitives.RW_Lock;
+      L                 : aliased Task_Primitives.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.