diff options
author | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2017-09-25 08:46:40 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2017-09-25 08:46:40 +0000 |
commit | f7fb5c08f36ea1c1aeebe1710839d1c0d5e68674 (patch) | |
tree | b4cdb910fe7ef003d34d219972e910f4bc14e910 /gcc/ada/libgnarl | |
parent | aa11d1dd992874c1286d29343d499aa7c7855dd6 (diff) | |
download | gcc-f7fb5c08f36ea1c1aeebe1710839d1c0d5e68674.zip gcc-f7fb5c08f36ea1c1aeebe1710839d1c0d5e68674.tar.gz gcc-f7fb5c08f36ea1c1aeebe1710839d1c0d5e68674.tar.bz2 |
[multiple changes]
2017-09-25 Bob Duff <duff@adacore.com>
* exp_ch3.adb: Rename Comp_Type_Simple to be Comp_Simple_Init.
2017-09-25 Doug Rupp <rupp@adacore.com>
* libgnarl/s-taprop__linux.adb (Base_Monotonic_Clock): New variable.
(Compute_Base_Monotonic_Clock): New function.
(Timed_Sleep): Adjust to use Base_Monotonic_Clock.
(Timed_Delay): Likewise.
(Monotonic_Clock): Likewise.
* s-oscons-tmplt.c (CLOCK_MONOTONIC): Use on Linux.
From-SVN: r253136
Diffstat (limited to 'gcc/ada/libgnarl')
-rw-r--r-- | gcc/ada/libgnarl/s-taprop__linux.adb | 98 |
1 files changed, 90 insertions, 8 deletions
diff --git a/gcc/ada/libgnarl/s-taprop__linux.adb b/gcc/ada/libgnarl/s-taprop__linux.adb index cc49205..4f83d73 100644 --- a/gcc/ada/libgnarl/s-taprop__linux.adb +++ b/gcc/ada/libgnarl/s-taprop__linux.adb @@ -64,6 +64,7 @@ package body System.Task_Primitives.Operations is use System.Parameters; use System.OS_Primitives; use System.Task_Info; + use type Interfaces.C.long; ---------------- -- Local Data -- @@ -110,6 +111,8 @@ package body System.Task_Primitives.Operations is -- Constant to indicate that the thread identifier has not yet been -- initialized. + Base_Monotonic_Clock : Duration := 0.0; + -------------------- -- Local Packages -- -------------------- @@ -160,6 +163,12 @@ package body System.Task_Primitives.Operations is procedure Abort_Handler (signo : Signal); + function Compute_Base_Monotonic_Clock return Duration; + -- The monotonic clock epoch is set to some undetermined time + -- in the past (typically system boot time). In order to use the + -- monotonic clock for absolute time, the offset from a known epoch + -- is needed. + function GNAT_pthread_condattr_setup (attr : access pthread_condattr_t) return C.int; pragma Import @@ -257,6 +266,73 @@ package body System.Task_Primitives.Operations is end if; end Abort_Handler; + ---------------------------------- + -- Compute_Base_Monotonic_Clock -- + ---------------------------------- + + function Compute_Base_Monotonic_Clock return Duration is + TS_Bef0, TS_Mon0, TS_Aft0 : aliased timespec; + TS_Bef, TS_Mon, TS_Aft : aliased timespec; + Bef, Mon, Aft : Duration; + Res_B, Res_M, Res_A : Interfaces.C.int; + begin + Res_B := clock_gettime + (clock_id => OSC.CLOCK_REALTIME, tp => TS_Bef0'Unchecked_Access); + pragma Assert (Res_B = 0); + Res_M := clock_gettime + (clock_id => OSC.CLOCK_RT_Ada, tp => TS_Mon0'Unchecked_Access); + pragma Assert (Res_M = 0); + Res_A := clock_gettime + (clock_id => OSC.CLOCK_REALTIME, tp => TS_Aft0'Unchecked_Access); + pragma Assert (Res_A = 0); + + for I in 1 .. 10 loop + -- Guard against a leap second which will cause CLOCK_REALTIME + -- to jump backwards. In the extrenmely unlikely event we call + -- clock_gettime before and after the jump the epoch result will + -- be off slightly. + -- Use only results where the tv_sec values match for the sake + -- of convenience. + -- Also try to calculate the most accurate + -- epoch by taking the minimum difference of 10 tries. + + Res_B := clock_gettime + (clock_id => OSC.CLOCK_REALTIME, tp => TS_Bef'Unchecked_Access); + pragma Assert (Res_B = 0); + Res_M := clock_gettime + (clock_id => OSC.CLOCK_RT_Ada, tp => TS_Mon'Unchecked_Access); + pragma Assert (Res_M = 0); + Res_A := clock_gettime + (clock_id => OSC.CLOCK_REALTIME, tp => TS_Aft'Unchecked_Access); + pragma Assert (Res_A = 0); + + if (TS_Bef0.tv_sec /= TS_Aft0.tv_sec and then + TS_Bef.tv_sec = TS_Aft.tv_sec) + -- The calls to clock_gettime before the loop were no good. + or else + (TS_Bef0.tv_sec = TS_Aft0.tv_sec and then + TS_Bef.tv_sec = TS_Aft.tv_sec and then + (TS_Aft.tv_nsec - TS_Bef.tv_nsec < + TS_Aft0.tv_nsec - TS_Bef0.tv_nsec)) + -- The most recent calls to clock_gettime were more better. + then + TS_Bef0.tv_sec := TS_Bef.tv_sec; + TS_Bef0.tv_nsec := TS_Bef.tv_nsec; + TS_Aft0.tv_sec := TS_Aft.tv_sec; + TS_Aft0.tv_nsec := TS_Aft.tv_nsec; + TS_Mon0.tv_sec := TS_Mon.tv_sec; + TS_Mon0.tv_nsec := TS_Mon.tv_nsec; + end if; + end loop; + + Bef := To_Duration (TS_Bef0); + Mon := To_Duration (TS_Mon0); + Aft := To_Duration (TS_Aft0); + + return Bef / 2 + Aft / 2 - Mon; + -- Distribute the division to avoid potential type overflow someday. + end Compute_Base_Monotonic_Clock; + -------------- -- Lock_RTS -- -------------- @@ -583,7 +659,7 @@ package body System.Task_Primitives.Operations is pragma Unreferenced (Reason); Base_Time : constant Duration := Monotonic_Clock; - Check_Time : Duration := Base_Time; + Check_Time : Duration := Base_Time - Base_Monotonic_Clock; Abs_Time : Duration; Request : aliased timespec; Result : C.int; @@ -595,7 +671,8 @@ package body System.Task_Primitives.Operations is Abs_Time := (if Mode = Relative then Duration'Min (Time, Max_Sensible_Delay) + Check_Time - else Duration'Min (Check_Time + Max_Sensible_Delay, Time)); + else Duration'Min (Check_Time + Max_Sensible_Delay, + Time - Base_Monotonic_Clock)); if Abs_Time > Check_Time then Request := To_Timespec (Abs_Time); @@ -612,7 +689,8 @@ package body System.Task_Primitives.Operations is abstime => Request'Access); Check_Time := Monotonic_Clock; - exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; + exit when Abs_Time + Base_Monotonic_Clock <= Check_Time + or else Check_Time < Base_Time; if Result in 0 | EINTR then @@ -640,7 +718,7 @@ package body System.Task_Primitives.Operations is Mode : ST.Delay_Modes) is Base_Time : constant Duration := Monotonic_Clock; - Check_Time : Duration := Base_Time; + Check_Time : Duration := Base_Time - Base_Monotonic_Clock; Abs_Time : Duration; Request : aliased timespec; @@ -657,7 +735,8 @@ package body System.Task_Primitives.Operations is Abs_Time := (if Mode = Relative then Time + Check_Time - else Duration'Min (Check_Time + Max_Sensible_Delay, Time)); + else Duration'Min (Check_Time + Max_Sensible_Delay, + Time - Base_Monotonic_Clock)); if Abs_Time > Check_Time then Request := To_Timespec (Abs_Time); @@ -675,7 +754,8 @@ package body System.Task_Primitives.Operations is abstime => Request'Access); Check_Time := Monotonic_Clock; - exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; + exit when Abs_Time + Base_Monotonic_Clock <= Check_Time + or else Check_Time < Base_Time; pragma Assert (Result in 0 | ETIMEDOUT | EINTR); end loop; @@ -698,13 +778,13 @@ package body System.Task_Primitives.Operations is function Monotonic_Clock return Duration is TS : aliased timespec; - Result : C.int; + Result : Interfaces.C.int; begin Result := clock_gettime (clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access); pragma Assert (Result = 0); - return To_Duration (TS); + return Base_Monotonic_Clock + To_Duration (TS); end Monotonic_Clock; ------------------- @@ -1496,6 +1576,8 @@ package body System.Task_Primitives.Operations is Interrupt_Management.Initialize; + Base_Monotonic_Clock := Compute_Base_Monotonic_Clock; + -- Prepare the set of signals that should be unblocked in all tasks Result := sigemptyset (Unblocked_Signal_Mask'Access); |