diff options
Diffstat (limited to 'gcc/ada/s-taprop-posix.adb')
| -rw-r--r-- | gcc/ada/s-taprop-posix.adb | 24 |
1 files changed, 22 insertions, 2 deletions
diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb index 425508a32c2..667603b73b7 100644 --- a/gcc/ada/s-taprop-posix.adb +++ b/gcc/ada/s-taprop-posix.adb @@ -50,6 +50,7 @@ with Interfaces.C; with System.Tasking.Debug; with System.Interrupt_Management; +with System.OS_Constants; with System.OS_Primitives; with System.Task_Info; @@ -61,6 +62,7 @@ with System.Soft_Links; package body System.Task_Primitives.Operations is + package OSC renames System.OS_Constants; package SSL renames System.Soft_Links; use System.Tasking.Debug; @@ -171,6 +173,11 @@ package body System.Task_Primitives.Operations is function To_Address is new Ada.Unchecked_Conversion (Task_Id, System.Address); + function GNAT_pthread_condattr_setup + (attr : access pthread_condattr_t) return int; + pragma Import (C, + GNAT_pthread_condattr_setup, "__gnat_pthread_condattr_setup"); + ------------------- -- Abort_Handler -- ------------------- @@ -666,7 +673,7 @@ package body System.Task_Primitives.Operations is Result : Interfaces.C.int; begin Result := clock_gettime - (clock_id => CLOCK_MONOTONIC, tp => TS'Unchecked_Access); + (clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access); pragma Assert (Result = 0); return To_Duration (TS); end Monotonic_Clock; @@ -869,6 +876,9 @@ package body System.Task_Primitives.Operations is pragma Assert (Result = 0 or else Result = ENOMEM); if Result = 0 then + Result := GNAT_pthread_condattr_setup (Cond_Attr'Access); + pragma Assert (Result = 0); + Result := pthread_cond_init (Self_ID.Common.LL.CV'Access, Cond_Attr'Access); @@ -975,8 +985,14 @@ package body System.Task_Primitives.Operations is -- do not need to manipulate caller's signal mask at this point. -- All tasks in RTS will have All_Tasks_Mask initially. + -- Note: the use of Unrestricted_Access in the following call is needed + -- because otherwise we have an error of getting a access-to-volatile + -- value which points to a non-volatile object. But in this case it is + -- safe to do this, since we know we have no problems with aliasing and + -- Unrestricted_Access bypasses this check. + Result := pthread_create - (T.Common.LL.Thread'Access, + (T.Common.LL.Thread'Unrestricted_Access, Attributes'Access, Thread_Body_Access (Wrapper), To_Address (T)); @@ -1093,6 +1109,10 @@ package body System.Task_Primitives.Operations is -- underlying OS entities fails. raise Storage_Error; + + else + Result := GNAT_pthread_condattr_setup (Cond_Attr'Access); + pragma Assert (Result = 0); end if; Result := pthread_cond_init (S.CV'Access, Cond_Attr'Access); |