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, 40 insertions, 9 deletions

diff --git a/gcc/ada/s-tpoben.adb b/gcc/ada/s-tpoben.adb
index 88527315e42..5c1ebe72581 100644
--- a/gcc/ada/s-tpoben.adb
+++ b/gcc/ada/s-tpoben.adb
@@ -88,7 +88,11 @@ package body System.Tasking.Protected_Objects.Entries is
          return;
       end if;
 
-      STPO.Write_Lock (Object.L'Unrestricted_Access, Ceiling_Violation);
+      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;
@@ -109,7 +113,12 @@ package body System.Tasking.Protected_Objects.Entries is
             Unlock_RTS;
          end if;
 
-         STPO.Write_Lock (Object.L'Unrestricted_Access, Ceiling_Violation);
+         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";
@@ -149,9 +158,13 @@ package body System.Tasking.Protected_Objects.Entries is
          Unlock_RTS;
       end if;
 
-      STPO.Unlock (Object.L'Unrestricted_Access);
-
-      STPO.Finalize_Lock (Object.L'Unrestricted_Access);
+      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;
 
    ----------------------
@@ -234,7 +247,13 @@ package body System.Tasking.Protected_Objects.Entries is
       --  pragma Assert (Self_Id.Deferral_Level = 0);
 
       Initialization.Defer_Abort_Nestable (Self_ID);
-      Initialize_Lock (Init_Priority, Object.L'Access);
+
+      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);
@@ -310,7 +329,11 @@ package body System.Tasking.Protected_Objects.Entries is
         (STPO.Self.Deferral_Level > 0
           or else not Restrictions.Abort_Allowed);
 
-      Write_Lock (Object.L'Access, Ceiling_Violation);
+      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
@@ -364,7 +387,11 @@ package body System.Tasking.Protected_Objects.Entries is
          raise Program_Error;
       end if;
 
-      Read_Lock (Object.L'Access, Ceiling_Violation);
+      if Locking_Policy = 'R' then
+         Read_Lock (Object.RWL'Access, Ceiling_Violation);
+      else
+         Write_Lock (Object.L'Access, Ceiling_Violation);
+      end if;
 
       if Ceiling_Violation then
          raise Program_Error with "Ceiling Violation";
@@ -460,7 +487,11 @@ package body System.Tasking.Protected_Objects.Entries is
          Object.Ceiling := Object.New_Ceiling;
       end if;
 
-      Unlock (Object.L'Access);
+      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;