diff options
Diffstat (limited to 'gcc/ada/s-taprop-linux.adb')
| -rw-r--r-- | gcc/ada/s-taprop-linux.adb | 117 |
1 files changed, 56 insertions, 61 deletions
diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb index 415cbdcbf7c..c63d5531b62 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; |