Skip to content

R
riscv-gcc-1
Commit f7fb5c08 by Pierre-Marie de Rodat
Options

[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
parent aa11d1dd
Showing with 114 additions and 13 deletions
gcc/ada/ChangeLog
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.
2017-09-25 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Save_References_In_Aggregate): Small correction to
......
gcc/ada/exp_ch3.adb
......@@ -517,11 +517,16 @@ package body Exp_Ch3 is
procedure Build_Array_Init_Proc (A_Type : Entity_Id; Nod : Node_Id) is
Comp_Type : constant Entity_Id := Component_Type (A_Type);
Comp_Type_Simple : constant Boolean :=
Comp_Simple_Init : constant Boolean :=
Needs_Simple_Initialization
(T => Comp_Type,
Consider_IS =>
not (Validity_Check_Copies and Is_Bit_Packed_Array (A_Type)));
-- True if the component needs simple initialization, based on its type,
-- plus the fact that we do not do simple initialization for components
-- of bit-packed arrays when validity checks are enabled, because the
-- initialization with deliberately out-of-range values would raise
-- Constraint_Error.
Body_Stmts : List_Id;
Has_Default_Init : Boolean;
......@@ -563,7 +568,7 @@ package body Exp_Ch3 is
Convert_To (Comp_Type,
Default_Aspect_Component_Value (First_Subtype (A_Type)))));
elsif Comp_Type_Simple then
elsif Comp_Simple_Init then
Set_Assignment_OK (Comp);
return New_List (
Make_Assignment_Statement (Loc,
......@@ -595,7 +600,7 @@ package body Exp_Ch3 is
-- the dummy Init_Proc needed for Initialize_Scalars processing.
if not Has_Non_Null_Base_Init_Proc (Comp_Type)
and then not Comp_Type_Simple
and then not Comp_Simple_Init
and then not Has_Task (Comp_Type)
and then not Has_Default_Aspect (A_Type)
then
......@@ -685,7 +690,7 @@ package body Exp_Ch3 is
-- init_proc.
Has_Default_Init := Has_Non_Null_Base_Init_Proc (Comp_Type)
or else Comp_Type_Simple
or else Comp_Simple_Init
or else Has_Task (Comp_Type)
or else Has_Default_Aspect (A_Type);
......
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);
......
gcc/ada/s-oscons-tmplt.c
......@@ -1440,7 +1440,8 @@ CND(CLOCK_FASTEST, "Fastest clock")
#endif
CND(CLOCK_THREAD_CPUTIME_ID, "Thread CPU clock")
#if defined(__FreeBSD__) || (defined(_AIX) && defined(_AIXVERSION_530)) \
#if defined(__linux__) || defined(__FreeBSD__) \
|| (defined(_AIX) && defined(_AIXVERSION_530)) \
|| defined(__DragonFly__)
/** On these platforms use system provided monotonic clock instead of
** the default CLOCK_REALTIME. We then need to set up cond var attributes
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment