s-taprop.ads (Initialize_Lock): New spec for r/w lock.

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

	* s-taprop.ads (Initialize_Lock)[RW_Lock]: New spec for r/w lock.
	(Finalize_Lock)[RW_Lock]: Likewise.
	(Write_Lock)[RW_Lock]: Likewise.
	(Unlock)[RW_Lock]: Likewise.
	(Read_Lock): Define L as RW_Lock (instead of Lock).
	* s-taprop-linux.adb (Initialize_Lock)[RW_Lock]: New
	routine for r/w lock.
	(Finalize_Lock)[RW_Lock]: Likewise.
	(Write_Lock)[RW_Lock]: Likewise.
	(Unlock)[RW_Lock]: Likewise.
	(Read_Lock): Define L as RW_Lock (instead of Lock).

	* s-taprop-vxworks.adb, s-taprop-tru64.adb, s-taprop-vms.adb,
	s-taprop-mingw.adb, s-taprop-solaris.adb, s-taprop-irix.adb,
	s-taprop-hpux-dce.adb, s-taprop-dummy.adb, s-taprop-posix.adb
	(Initialize_Lock)[RW_Lock]: Same implementation as corresponding
	routine for standard lock.
	(Finalize_Lock)[RW_Lock]: Likewise.
	(Write_Lock)[RW_Lock]: Likewise.
	(Unlock)[RW_Lock]: Likewise.
	(Read_Lock): Define L as RW_Lock (instead of Lock).
	* s-taprob.ads, s-tpoben.ads (Protection): Add RWL (RW_Lock)
	in the record definition.
	* s-taprob.adb, s-taproben.adb (Finalize_Protection): Use r/w
	lock for 'R' locking policy.
	(Initialize_Protection): Likewise.
	(Lock): Likewise.
	(Lock_Read_Only): Likewise.
	(Unlock): Likewise.
	* s-taspri-posix.ads (RW_Lock): New type defined as
	OS_Interface.pthread_rwlock_t.

	* s-taspri-vxworks.ads, s-taspri-posix-noaltstack.ads,
	s-taspri-mingw.ads, s-taspri-solaris.ads, s-taspri-dummy.ads,
	s-taspri-posix.ads, s-taspri-vms.ads, s-taspri-hpux-dce.ads,
	s-taspri-tru64.ads (RW_Lock): New type defined as alias to Lock.

From-SVN: r179251

1 files changed, 64 insertions, 2 deletions

diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb
index 84c663a..415cbdc 100644
--- a/gcc/ada/s-taprop-linux.adb
+++ b/gcc/ada/s-taprop-linux.adb
@@ -277,6 +277,34 @@ package body System.Task_Primitives.Operations is
    end Initialize_Lock;
 
    procedure Initialize_Lock
+     (Prio : System.Any_Priority;
+      L    : not null access RW_Lock)
+   is
+      pragma Unreferenced (Prio);
+
+      RWlock_Attr : aliased pthread_rwlockattr_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);
+      pragma Assert (Result = 0);
+
+      Result := pthread_rwlock_init (L, 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
      (L     : not null access RTS_Lock;
       Level : Lock_Level)
    is
@@ -309,6 +337,13 @@ package body System.Task_Primitives.Operations is
       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);
+      pragma Assert (Result = 0);
+   end Finalize_Lock;
+
    procedure Finalize_Lock (L : not null access RTS_Lock) is
       Result : Interfaces.C.int;
    begin
@@ -335,6 +370,20 @@ package body System.Task_Primitives.Operations is
    end Write_Lock;
 
    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
+
+      pragma Assert (Result = 0 or else Result = EINVAL);
+   end Write_Lock;
+
+   procedure Write_Lock
      (L           : not null access RTS_Lock;
       Global_Lock : Boolean := False)
    is
@@ -360,11 +409,17 @@ package body System.Task_Primitives.Operations is
    ---------------
 
    procedure Read_Lock
-     (L                 : not null access Lock;
+     (L                 : not null access RW_Lock;
       Ceiling_Violation : out Boolean)
    is
+      Result : Interfaces.C.int;
    begin
-      Write_Lock (L, Ceiling_Violation);
+      Result := pthread_rwlock_rdlock (L);
+      Ceiling_Violation := Result = EINVAL;
+
+      --  Assume the cause of EINVAL is a priority ceiling violation
+
+      pragma Assert (Result = 0 or else Result = EINVAL);
    end Read_Lock;
 
    ------------
@@ -378,6 +433,13 @@ package body System.Task_Primitives.Operations is
       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);
+      pragma Assert (Result = 0);
+   end Unlock;
+
    procedure Unlock
      (L           : not null access RTS_Lock;
       Global_Lock : Boolean := False)