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;
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,
-- 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
-- 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);
use System.Parameters;
use System.OS_Primitives;
use System.Task_Info;
+ use type Interfaces.C.long;
----------------
-- Local Data --
-- Constant to indicate that the thread identifier has not yet been
-- initialized.
+ Base_Monotonic_Clock : Duration := 0.0;
+
--------------------
-- Local Packages --
--------------------
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
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 --
--------------
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;
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);
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
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;
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);
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;
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;
-------------------
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);
projects / gcc.git / commitdiff