From patchwork Tue Sep 27 09:45:23 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 116560 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 9BB4EB6F7E for ; Tue, 27 Sep 2011 19:45:55 +1000 (EST) Received: (qmail 4751 invoked by alias); 27 Sep 2011 09:45:52 -0000 Received: (qmail 4723 invoked by uid 22791); 27 Sep 2011 09:45:44 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL,BAYES_00,TW_RW X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 27 Sep 2011 09:45:24 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 3A6452BB1DC; Tue, 27 Sep 2011 05:45:23 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id n6vq+Yq54MoB; Tue, 27 Sep 2011 05:45:23 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 1F69B2BB1D4; Tue, 27 Sep 2011 05:45:23 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 1C49492BF6; Tue, 27 Sep 2011 05:45:23 -0400 (EDT) Date: Tue, 27 Sep 2011 05:45:23 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Pascal Obry Subject: [Ada] Better implementation for the read/write lock support Message-ID: <20110927094523.GA4903@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org This new implementation do not introduced a new API in s-taprop. It is then simpler and will be nicer with cross platforms. It will also be easier to introduce new locking policies if needed. Tested on x86_64-pc-linux-gnu, committed on trunk 2011-09-27 Pascal Obry * 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. Index: s-osinte-hpux.ads =================================================================== --- s-osinte-hpux.ads (revision 179250) +++ s-osinte-hpux.ads (working copy) @@ -265,14 +265,6 @@ 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 -- ----------- Index: s-taprop-vxworks.adb =================================================================== --- s-taprop-vxworks.adb (revision 179251) +++ s-taprop-vxworks.adb (working copy) @@ -309,14 +309,6 @@ 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 @@ 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 @@ 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 @@ --------------- procedure Read_Lock - (L : not null access RW_Lock; + (L : not null access Lock; Ceiling_Violation : out Boolean) is begin @@ -427,11 +406,6 @@ 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) Index: s-taspri-vxworks.ads =================================================================== --- s-taspri-vxworks.ads (revision 179251) +++ s-taspri-vxworks.ads (working copy) @@ -41,7 +41,6 @@ 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 @@ -- Priority ceiling of lock end record; - type RW_Lock is new Lock; - type RTS_Lock is new Lock; type Suspension_Object is record Index: s-taprop-tru64.adb =================================================================== --- s-taprop-tru64.adb (revision 179251) +++ s-taprop-tru64.adb (working copy) @@ -266,14 +266,6 @@ 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 @@ 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 @@ 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 @@ --------------- procedure Read_Lock - (L : not null access RW_Lock; + (L : not null access Lock; Ceiling_Violation : out Boolean) is begin @@ -414,11 +393,6 @@ 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) Index: s-osinte-aix.ads =================================================================== --- s-osinte-aix.ads (revision 179250) +++ s-osinte-aix.ads (working copy) @@ -276,14 +276,6 @@ 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 -- ----------- Index: s-taspri-posix-noaltstack.ads =================================================================== --- s-taspri-posix-noaltstack.ads (revision 179252) +++ s-taspri-posix-noaltstack.ads (working copy) @@ -45,7 +45,6 @@ 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 @@ 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 Index: s-taspri-mingw.ads =================================================================== --- s-taspri-mingw.ads (revision 179251) +++ s-taspri-mingw.ads (working copy) @@ -42,7 +42,6 @@ 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 @@ 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; Index: s-taprop-vms.adb =================================================================== --- s-taprop-vms.adb (revision 179251) +++ s-taprop-vms.adb (working copy) @@ -226,13 +226,6 @@ 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 @@ 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 @@ 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 @@ --------------- procedure Read_Lock - (L : not null access RW_Lock; + (L : not null access Lock; Ceiling_Violation : out Boolean) is begin @@ -383,11 +363,6 @@ 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) Index: s-tpoben.adb =================================================================== --- s-tpoben.adb (revision 179251) +++ s-tpoben.adb (working copy) @@ -88,11 +88,7 @@ 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 @@ 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 @@ 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 @@ -- 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 @@ (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 @@ 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 @@ 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; Index: s-tpoben.ads =================================================================== --- s-tpoben.ads (revision 179251) +++ s-tpoben.ads (working copy) @@ -76,8 +76,7 @@ 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. Index: s-taprop-mingw.adb =================================================================== --- s-taprop-mingw.adb (revision 179251) +++ s-taprop-mingw.adb (working copy) @@ -415,14 +415,6 @@ 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 @@ 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 @@ 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 @@ --------------- 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 @@ 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 Index: s-taprob.adb =================================================================== --- s-taprob.adb (revision 179251) +++ s-taprob.adb (working copy) @@ -57,11 +57,7 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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); Index: s-taprop-linux.adb =================================================================== --- s-taprop-linux.adb (revision 179251) +++ s-taprop-linux.adb (working copy) @@ -95,6 +95,9 @@ 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 @@ 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,17 +338,14 @@ procedure Finalize_Lock (L : not null access Lock) is Result : Interfaces.C.int; begin - Result := pthread_mutex_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; - 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 @@ -361,21 +363,12 @@ is Result : Interfaces.C.int; begin - Result := pthread_mutex_lock (L); - Ceiling_Violation := Result = EINVAL; + if Locking_Policy = 'R' then + Result := pthread_rwlock_wrlock (L.RW'Access); + else + Result := pthread_mutex_lock (L.WO'Access); + end if; - -- 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 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 @@ --------------- 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,17 +427,14 @@ procedure Unlock (L : not null access Lock) is Result : Interfaces.C.int; begin - Result := pthread_mutex_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; - 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) Index: s-taprob.ads =================================================================== --- s-taprob.ads (revision 179251) +++ s-taprob.ads (working copy) @@ -212,9 +212,6 @@ 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 Index: s-osinte-solaris-posix.ads =================================================================== --- s-osinte-solaris-posix.ads (revision 179250) +++ s-osinte-solaris-posix.ads (working copy) @@ -255,14 +255,6 @@ 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; Index: s-taprop-solaris.adb =================================================================== --- s-taprop-solaris.adb (revision 179251) +++ s-taprop-solaris.adb (working copy) @@ -564,14 +564,6 @@ 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 @@ 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 @@ 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 @@ --------------- 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 @@ 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) Index: s-taspri-solaris.ads =================================================================== --- s-taspri-solaris.ads (revision 179251) +++ s-taspri-solaris.ads (working copy) @@ -46,7 +46,6 @@ 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 @@ Frozen : Boolean := False; end record; - type RW_Lock is new Lock; - type RTS_Lock is new Lock; type Suspension_Object is record Index: s-osinte-irix.ads =================================================================== --- s-osinte-irix.ads (revision 179250) +++ s-osinte-irix.ads (working copy) @@ -250,14 +250,6 @@ 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 -- ----------- Index: s-taprop-irix.adb =================================================================== --- s-taprop-irix.adb (revision 179251) +++ s-taprop-irix.adb (working copy) @@ -268,14 +268,6 @@ 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 @@ 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 @@ 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 @@ --------------- 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 @@ 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) Index: s-osinte-darwin.ads =================================================================== --- s-osinte-darwin.ads (revision 179250) +++ s-osinte-darwin.ads (working copy) @@ -256,14 +256,6 @@ 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 -- ----------- Index: s-taspri-dummy.ads =================================================================== --- s-taspri-dummy.ads (revision 179251) +++ s-taspri-dummy.ads (working copy) @@ -40,8 +40,6 @@ type Lock is new Integer; - type RW_Lock is new Integer; - type RTS_Lock is new Integer; type Suspension_Object is new Integer; Index: s-taspri-posix.ads =================================================================== --- s-taspri-posix.ads (revision 179251) +++ s-taspri-posix.ads (working copy) @@ -44,7 +44,6 @@ 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 @@ 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 Index: s-taprop.ads =================================================================== --- s-taprop.ads (revision 179251) +++ s-taprop.ads (working copy) @@ -149,9 +149,6 @@ (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 @@ -- 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 @@ (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 @@ -- 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 @@ 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 Index: s-taspri-vms.ads =================================================================== --- s-taspri-vms.ads (revision 179251) +++ s-taspri-vms.ads (working copy) @@ -46,7 +46,6 @@ 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 @@ 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 Index: s-osinte-freebsd.ads =================================================================== --- s-osinte-freebsd.ads (revision 179250) +++ s-osinte-freebsd.ads (working copy) @@ -289,14 +289,6 @@ 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 -- ----------- Index: s-taprop-hpux-dce.adb =================================================================== --- s-taprop-hpux-dce.adb (revision 179251) +++ s-taprop-hpux-dce.adb (working copy) @@ -254,14 +254,6 @@ 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 @@ 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 @@ 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 @@ --------------- procedure Read_Lock - (L : not null access RW_Lock; + (L : not null access Lock; Ceiling_Violation : out Boolean) is begin @@ -388,11 +367,6 @@ 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) Index: s-taspri-hpux-dce.ads =================================================================== --- s-taspri-hpux-dce.ads (revision 179251) +++ s-taspri-hpux-dce.ads (working copy) @@ -43,7 +43,6 @@ 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 @@ 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 Index: s-taspri-tru64.ads =================================================================== --- s-taspri-tru64.ads (revision 179251) +++ s-taspri-tru64.ads (working copy) @@ -45,7 +45,6 @@ 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 @@ 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 Index: s-taprop-dummy.adb =================================================================== --- s-taprop-dummy.adb (revision 179251) +++ s-taprop-dummy.adb (working copy) @@ -158,11 +158,6 @@ 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 @@ 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 @@ --------------- procedure Read_Lock - (L : not null access RW_Lock; + (L : not null access Lock; Ceiling_Violation : out Boolean) is begin @@ -472,11 +459,6 @@ 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 @@ 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 Index: s-taprop-posix.adb =================================================================== --- s-taprop-posix.adb (revision 179251) +++ s-taprop-posix.adb (working copy) @@ -323,14 +323,6 @@ 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 @@ 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 @@ 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 @@ --------------- 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 @@ 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