diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a5213ebdea835fc1e7f18d9770635064d7365126..4f496a84065ae60c6011f488aff757036a597139 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +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 diff --git a/gcc/ada/s-osinte-aix.ads b/gcc/ada/s-osinte-aix.ads index c8e660826042b503f4e0eaa241a74f22d48d7072..586d42f8f0a799b14996b2aa21aad5a20667bc5d 100644 --- a/gcc/ada/s-osinte-aix.ads +++ b/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 -- ----------- diff --git a/gcc/ada/s-osinte-darwin.ads b/gcc/ada/s-osinte-darwin.ads index fe2a10a33152b872ba602bb3efaec3cc9b871232..2bd15a8b211abc3e6b910bcd771c6b8629f32108 100644 --- a/gcc/ada/s-osinte-darwin.ads +++ b/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 -- ----------- diff --git a/gcc/ada/s-osinte-freebsd.ads b/gcc/ada/s-osinte-freebsd.ads index d3d5c8763e410bfd814a404759a5d42f98732d5e..5c46c29b983a0f8895170b2314d08f824b97ec74 100644 --- a/gcc/ada/s-osinte-freebsd.ads +++ b/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 -- ----------- diff --git a/gcc/ada/s-osinte-hpux.ads b/gcc/ada/s-osinte-hpux.ads index bc9a7091d6fba4279ad7164d68d3d1a485bb385a..716d821654a02d8b1aba47bdb25ae7b008a82a37 100644 --- a/gcc/ada/s-osinte-hpux.ads +++ b/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 -- ----------- diff --git a/gcc/ada/s-osinte-irix.ads b/gcc/ada/s-osinte-irix.ads index ddeadcb61476d28242076f2e05b432bee60a6e46..fb1bbb5c55cf859c861cc63f6cafd956b05a2a2a 100644 --- a/gcc/ada/s-osinte-irix.ads +++ b/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 -- ----------- diff --git a/gcc/ada/s-osinte-solaris-posix.ads b/gcc/ada/s-osinte-solaris-posix.ads index 8781a12dd6782f54b64743c8449729856079960a..6c266f9babfb56a56a57b7b3ba415d3d7d18f19d 100644 --- a/gcc/ada/s-osinte-solaris-posix.ads +++ b/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; diff --git a/gcc/ada/s-taprob.adb b/gcc/ada/s-taprob.adb index 5c48a473236c053d81821cf6183e571fda80690c..ab0557d86dd0c8165e94ba1c7820da7d21d77756 100644 --- a/gcc/ada/s-taprob.adb +++ b/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); diff --git a/gcc/ada/s-taprob.ads b/gcc/ada/s-taprob.ads index de1d0dca6719169eb0f3c86ac90714cea7288358..fa2a99fa79423c7e36ab564892cdcf9891dfb9dc 100644 --- a/gcc/ada/s-taprob.ads +++ b/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 diff --git a/gcc/ada/s-taprop-dummy.adb b/gcc/ada/s-taprop-dummy.adb index f48306611295e0efb995d80ca0bdf37f7cd4b622..f6e9a64cdc7a31a71fa8093fbdbe7fb2c687fc35 100644 --- a/gcc/ada/s-taprop-dummy.adb +++ b/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; @@ -222,14 +217,6 @@ package body System.Task_Primitives.Operations is null; 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 @@ -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) @@ -519,14 +501,6 @@ package body System.Task_Primitives.Operations is Ceiling_Violation := False; 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) diff --git a/gcc/ada/s-taprop-hpux-dce.adb b/gcc/ada/s-taprop-hpux-dce.adb index db1eaf48edfa2f26e53027b2be06605f0cc0be52..346de43ba0521c7616aac67650e29ba2c4207b9d 100644 --- a/gcc/ada/s-taprop-hpux-dce.adb +++ b/gcc/ada/s-taprop-hpux-dce.adb @@ -253,14 +253,6 @@ package body System.Task_Primitives.Operations is pragma Assert (Result = 0); 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) @@ -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 @@ -336,14 +323,6 @@ package body System.Task_Primitives.Operations is Ceiling_Violation := False; 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) @@ -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) diff --git a/gcc/ada/s-taprop-irix.adb b/gcc/ada/s-taprop-irix.adb index 5fd0ca4241ba79d6101ee8eb5002e35d95574c35..264690499203161a142704ae2d55142e5b772626 100644 --- a/gcc/ada/s-taprop-irix.adb +++ b/gcc/ada/s-taprop-irix.adb @@ -267,14 +267,6 @@ package body System.Task_Primitives.Operations is pragma Assert (Result = 0); 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) @@ -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 @@ -356,13 +343,6 @@ package body System.Task_Primitives.Operations is 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 - 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) @@ -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) diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb index 415cbdcbf7cd27c5363ad356cd8a3e79a8c415ed..c63d5531b622466fffc13a86518964b559e74b9a 100644 --- a/gcc/ada/s-taprop-linux.adb +++ b/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; diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb index 2b5ca16aaa8931ae073d5d51915986c49c8aca2b..7fc505e30bc69ed9b296f5f0162367cbbf409bb8 100644 --- a/gcc/ada/s-taprop-mingw.adb +++ b/gcc/ada/s-taprop-mingw.adb @@ -414,14 +414,6 @@ package body System.Task_Primitives.Operations is L.Priority := Prio; 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 @@ -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); @@ -468,12 +455,6 @@ package body System.Task_Primitives.Operations is Ceiling_Violation := False; 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) @@ -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 diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb index f70ae8d70d5ecb45ddccdf38a38415b978add7f8..af0a597e5fc36766b953bb7834b466a206f7fafc 100644 --- a/gcc/ada/s-taprop-posix.adb +++ b/gcc/ada/s-taprop-posix.adb @@ -322,14 +322,6 @@ package body System.Task_Primitives.Operations is pragma Assert (Result = 0); 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 @@ -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 @@ -414,13 +401,6 @@ package body System.Task_Primitives.Operations is 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 - 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) @@ -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 diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb index 17fb955e9fd463fb28206ca7c9f7eb54df2fd57f..b5fe1ee9d42c05be8338e91589d3675f41394a7d 100644 --- a/gcc/ada/s-taprop-solaris.adb +++ b/gcc/ada/s-taprop-solaris.adb @@ -563,14 +563,6 @@ package body System.Task_Primitives.Operations is end if; 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) @@ -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 @@ -659,14 +646,6 @@ package body System.Task_Primitives.Operations is pragma Assert (Record_Lock (Lock_Ptr (L))); 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) @@ -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) diff --git a/gcc/ada/s-taprop-tru64.adb b/gcc/ada/s-taprop-tru64.adb index 28dabc5581ce8db30621705e0d6bb5e1c3956d90..b0b727d9bb1005eb7057fbecdae4cdb5f813faf9 100644 --- a/gcc/ada/s-taprop-tru64.adb +++ b/gcc/ada/s-taprop-tru64.adb @@ -265,14 +265,6 @@ package body System.Task_Primitives.Operations is pragma Assert (Result = 0); 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) @@ -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 @@ -362,14 +349,6 @@ package body System.Task_Primitives.Operations is Ceiling_Violation := False; 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) @@ -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) diff --git a/gcc/ada/s-taprop-vms.adb b/gcc/ada/s-taprop-vms.adb index a2b1d802866396f948f9b7f3f9269f6ccba9eddf..92b6023bdff3c63080de3901bfb308b4ee6db693 100644 --- a/gcc/ada/s-taprop-vms.adb +++ b/gcc/ada/s-taprop-vms.adb @@ -225,13 +225,6 @@ package body System.Task_Primitives.Operations is pragma Assert (Result = 0); 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) @@ -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 @@ -331,14 +319,6 @@ package body System.Task_Primitives.Operations is -- Set_Priority (Self_ID, System.Any_Priority (L.Prio)); 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) @@ -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) diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb index 2faee8cfcb7dba173ef32ed6436f684925d74ed6..be76162b284d26f061105cadb6d9cf5715de6334 100644 --- a/gcc/ada/s-taprop-vxworks.adb +++ b/gcc/ada/s-taprop-vxworks.adb @@ -308,14 +308,6 @@ package body System.Task_Primitives.Operations is pragma Assert (L.Mutex /= 0); 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) @@ -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 @@ -375,14 +362,6 @@ package body System.Task_Primitives.Operations is pragma Assert (Result = 0); 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) @@ -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) diff --git a/gcc/ada/s-taprop.ads b/gcc/ada/s-taprop.ads index a25c8bf979e02447aee8e704dca06d7b79791e41..12fbd71386e73a5d735c3fd1988e53cc266ffb99 100644 --- a/gcc/ada/s-taprop.ads +++ b/gcc/ada/s-taprop.ads @@ -148,9 +148,6 @@ package System.Task_Primitives.Operations is procedure Initialize_Lock (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); @@ -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 @@ -185,9 +181,6 @@ package System.Task_Primitives.Operations is procedure Write_Lock (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); @@ -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, @@ -242,8 +235,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); diff --git a/gcc/ada/s-taspri-dummy.ads b/gcc/ada/s-taspri-dummy.ads index 3a6b46caf395e1c04f2a093f38e2ea63cc1b68ca..5fe9fa342770044e2382084025635b71c8171672 100644 --- a/gcc/ada/s-taspri-dummy.ads +++ b/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; diff --git a/gcc/ada/s-taspri-hpux-dce.ads b/gcc/ada/s-taspri-hpux-dce.ads index aaec48b0a36f40dedc19d4a668ae8f6ec04ab115..9d51d5c45176940cd33bcff2dbb3d266a0cee299 100644 --- a/gcc/ada/s-taspri-hpux-dce.ads +++ b/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 diff --git a/gcc/ada/s-taspri-mingw.ads b/gcc/ada/s-taspri-mingw.ads index 0fd185c21c5e2221bd3d4d0e112e3738ef99eeef..cc4f4019fa9638a0565c099c383608d33b626bd6 100644 --- a/gcc/ada/s-taspri-mingw.ads +++ b/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; diff --git a/gcc/ada/s-taspri-posix-noaltstack.ads b/gcc/ada/s-taspri-posix-noaltstack.ads index 8958cbee02fb65f5dcb05fa832c798e0d3d51936..6b279eb63c2edc7478bd263fa1bd4d5232d2be59 100644 --- a/gcc/ada/s-taspri-posix-noaltstack.ads +++ b/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 diff --git a/gcc/ada/s-taspri-posix.ads b/gcc/ada/s-taspri-posix.ads index f9205d82c712172647b54bb271ca139791e65336..9f40693aa74f279ff6963428bad80765f7656b82 100644 --- a/gcc/ada/s-taspri-posix.ads +++ b/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 diff --git a/gcc/ada/s-taspri-solaris.ads b/gcc/ada/s-taspri-solaris.ads index d5d87e7e0101bed11d4833d3afe51c7b9098674c..0c9c43267fc60b5991e6e2ee127a212217e5f64e 100644 --- a/gcc/ada/s-taspri-solaris.ads +++ b/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 diff --git a/gcc/ada/s-taspri-tru64.ads b/gcc/ada/s-taspri-tru64.ads index 1ccde3a3cf7ba0b6eadb3453c336f433d7a8c888..41c9aeaa3cd9359a94c5881a29934703bdbb3e1a 100644 --- a/gcc/ada/s-taspri-tru64.ads +++ b/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 diff --git a/gcc/ada/s-taspri-vms.ads b/gcc/ada/s-taspri-vms.ads index d0cc429d7e455f35b1ed67b5411d11db33b82087..891dee28c9d6f03706fd1ec6e1b4a24a88783d97 100644 --- a/gcc/ada/s-taspri-vms.ads +++ b/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 diff --git a/gcc/ada/s-taspri-vxworks.ads b/gcc/ada/s-taspri-vxworks.ads index d1d676bf0c33d596430e6edad4822086c43f9af4..9b67dd91c28b16c7541ac65f31cc4f0678c3054e 100644 --- a/gcc/ada/s-taspri-vxworks.ads +++ b/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 diff --git a/gcc/ada/s-tpoben.adb b/gcc/ada/s-tpoben.adb index 5c1ebe725818fd996b4585aa3893e500a79adef8..88527315e4268a992da4cae1128b76b1c9fa90e3 100644 --- a/gcc/ada/s-tpoben.adb +++ b/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; diff --git a/gcc/ada/s-tpoben.ads b/gcc/ada/s-tpoben.ads index f0684113f200c87af4346bd9381be5185ba6a314..ce7045cf56e2a96fb4d5237d7a97c26fd4871b0f 100644 --- a/gcc/ada/s-tpoben.ads +++ b/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.