The Posix method of calculating absolute deadlines is adopted in
favor of latching the monotonic clock to a known epoch, as the Posix
method is simpler and meets all the requirements of the Ada LRM.
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-10-20 Doug Rupp <r...@adacore.com>
* libgnarl/s-osinte__linux.ads (Relative_Timed_Wait): Add variable
needed for using monotonic clock.
* libgnarl/s-taprop__linux.adb: Revert previous monotonic clock
changes.
* libgnarl/s-taprop__linux.adb, s-taprop__posix.adb: Unify and factor
out monotonic clock related functions body.
(Timed_Sleep, Timed_Delay, Montonic_Clock, RT_Resolution,
Compute_Deadline): Move to...
* libgnarl/s-tpopmo.adb: ... here. New separate package body.
Index: libgnarl/s-osinte__linux.ads
===================================================================
--- libgnarl/s-osinte__linux.ads (revision 253938)
+++ libgnarl/s-osinte__linux.ads (working copy)
@@ -448,6 +448,9 @@
abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
+ Relative_Timed_Wait : constant Boolean := False;
+ -- pthread_cond_timedwait requires an absolute delay time
+
--------------------------
-- POSIX.1c Section 13 --
--------------------------
Index: libgnarl/s-taprop__posix.adb
===================================================================
--- libgnarl/s-taprop__posix.adb (revision 253938)
+++ libgnarl/s-taprop__posix.adb (working copy)
@@ -145,6 +145,38 @@
package body Specific is separate;
-- The body of this package is target specific
+ package Monotonic is
+
+ function Monotonic_Clock return Duration;
+ pragma Inline (Monotonic_Clock);
+ -- Returns "absolute" time, represented as an offset relative to "the
+ -- Epoch", which is Jan 1, 1970. This clock implementation is immune to
+ -- the system's clock changes.
+
+ function RT_Resolution return Duration;
+ pragma Inline (RT_Resolution);
+ -- Returns resolution of the underlying clock used to implement RT_Clock
+
+ procedure Timed_Sleep
+ (Self_ID : ST.Task_Id;
+ Time : Duration;
+ Mode : ST.Delay_Modes;
+ Reason : System.Tasking.Task_States;
+ Timedout : out Boolean;
+ Yielded : out Boolean);
+ -- Combination of Sleep (above) and Timed_Delay
+
+ procedure Timed_Delay
+ (Self_ID : ST.Task_Id;
+ Time : Duration;
+ Mode : ST.Delay_Modes);
+ -- Implement the semantics of the delay statement.
+ -- The caller should be abort-deferred and should not hold any locks.
+
+ end Monotonic;
+
+ package body Monotonic is separate;
+
----------------------------------
-- ATCB allocation/deallocation --
----------------------------------
@@ -183,18 +215,6 @@
pragma Import (C,
GNAT_pthread_condattr_setup, "__gnat_pthread_condattr_setup");
- procedure Compute_Deadline
- (Time : Duration;
- Mode : ST.Delay_Modes;
- Check_Time : out Duration;
- Abs_Time : out Duration;
- Rel_Time : out Duration);
- -- Helper for Timed_Sleep and Timed_Delay: given a deadline specified by
- -- Time and Mode, compute the current clock reading (Check_Time), and the
- -- target absolute and relative clock readings (Abs_Time, Rel_Time). The
- -- epoch for Time depends on Mode; the epoch for Check_Time and Abs_Time
- -- is always that of CLOCK_RT_Ada.
-
-------------------
-- Abort_Handler --
-------------------
@@ -253,67 +273,6 @@
end if;
end Abort_Handler;
- ----------------------
- -- Compute_Deadline --
- ----------------------
-
- procedure Compute_Deadline
- (Time : Duration;
- Mode : ST.Delay_Modes;
- Check_Time : out Duration;
- Abs_Time : out Duration;
- Rel_Time : out Duration)
- is
- begin
- Check_Time := Monotonic_Clock;
-
- -- Relative deadline
-
- if Mode = Relative then
- Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time;
-
- if Relative_Timed_Wait then
- Rel_Time := Duration'Min (Max_Sensible_Delay, Time);
- end if;
-
- pragma Warnings (Off);
- -- Comparison "OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME" is compile
- -- time known.
-
- -- Absolute deadline specified using the tasking clock (CLOCK_RT_Ada)
-
- elsif Mode = Absolute_RT
- or else OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME
- then
- pragma Warnings (On);
- Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
-
- if Relative_Timed_Wait then
- Rel_Time := Duration'Min (Max_Sensible_Delay, Time - Check_Time);
- end if;
-
- -- Absolute deadline specified using the calendar clock, in the
- -- case where it is not the same as the tasking clock: compensate for
- -- difference between clock epochs (Base_Time - Base_Cal_Time).
-
- else
- declare
- Cal_Check_Time : constant Duration := OS_Primitives.Clock;
- RT_Time : constant Duration :=
- Time + Check_Time - Cal_Check_Time;
-
- begin
- Abs_Time :=
- Duration'Min (Check_Time + Max_Sensible_Delay, RT_Time);
-
- if Relative_Timed_Wait then
- Rel_Time :=
- Duration'Min (Max_Sensible_Delay, RT_Time - Check_Time);
- end if;
- end;
- end if;
- end Compute_Deadline;
-
-----------------
-- Stack_Guard --
-----------------
@@ -600,61 +559,8 @@
Mode : ST.Delay_Modes;
Reason : Task_States;
Timedout : out Boolean;
- Yielded : out Boolean)
- is
- pragma Unreferenced (Reason);
+ Yielded : out Boolean) renames Monotonic.Timed_Sleep;
- Base_Time : Duration;
- Check_Time : Duration;
- Abs_Time : Duration;
- Rel_Time : Duration;
-
- Request : aliased timespec;
- Result : Interfaces.C.int;
-
- begin
- Timedout := True;
- Yielded := False;
-
- Compute_Deadline
- (Time => Time,
- Mode => Mode,
- Check_Time => Check_Time,
- Abs_Time => Abs_Time,
- Rel_Time => Rel_Time);
- Base_Time := Check_Time;
-
- if Abs_Time > Check_Time then
- Request :=
- To_Timespec (if Relative_Timed_Wait then Rel_Time else Abs_Time);
-
- loop
- exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
-
- Result :=
- pthread_cond_timedwait
- (cond => Self_ID.Common.LL.CV'Access,
- mutex => (if Single_Lock
- then Single_RTS_Lock'Access
- else Self_ID.Common.LL.L'Access),
- abstime => Request'Access);
-
- Check_Time := Monotonic_Clock;
- exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
-
- if Result = 0 or Result = EINTR then
-
- -- Somebody may have called Wakeup for us
-
- Timedout := False;
- exit;
- end if;
-
- pragma Assert (Result = ETIMEDOUT);
- end loop;
- end if;
- end Timed_Sleep;
-
-----------------
-- Timed_Delay --
-----------------
@@ -665,96 +571,20 @@
procedure Timed_Delay
(Self_ID : Task_Id;
Time : Duration;
- Mode : ST.Delay_Modes)
- is
- Base_Time : Duration;
- Check_Time : Duration;
- Abs_Time : Duration;
- Rel_Time : Duration;
- Request : aliased timespec;
+ Mode : ST.Delay_Modes) renames Monotonic.Timed_Delay;
- Result : Interfaces.C.int;
- pragma Warnings (Off, Result);
-
- begin
- if Single_Lock then
- Lock_RTS;
- end if;
-
- Write_Lock (Self_ID);
-
- Compute_Deadline
- (Time => Time,
- Mode => Mode,
- Check_Time => Check_Time,
- Abs_Time => Abs_Time,
- Rel_Time => Rel_Time);
- Base_Time := Check_Time;
-
- if Abs_Time > Check_Time then
- Request :=
- To_Timespec (if Relative_Timed_Wait then Rel_Time else Abs_Time);
- Self_ID.Common.State := Delay_Sleep;
-
- loop
- exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
-
- Result :=
- pthread_cond_timedwait
- (cond => Self_ID.Common.LL.CV'Access,
- mutex => (if Single_Lock
- then Single_RTS_Lock'Access
- else Self_ID.Common.LL.L'Access),
- abstime => Request'Access);
-
- Check_Time := Monotonic_Clock;
- exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
-
- pragma Assert (Result = 0
- or else Result = ETIMEDOUT
- or else Result = EINTR);
- end loop;
-
- Self_ID.Common.State := Runnable;
- end if;
-
- Unlock (Self_ID);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
- Result := sched_yield;
- end Timed_Delay;
-
---------------------
-- Monotonic_Clock --
---------------------
- function Monotonic_Clock return Duration is
- TS : aliased timespec;
- 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);
- end Monotonic_Clock;
+ function Monotonic_Clock return Duration renames Monotonic.Monotonic_Clock;
-------------------
-- RT_Resolution --
-------------------
- function RT_Resolution return Duration is
- TS : aliased timespec;
- Result : Interfaces.C.int;
- begin
- Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access);
- pragma Assert (Result = 0);
+ function RT_Resolution return Duration renames Monotonic.RT_Resolution;
- return To_Duration (TS);
- end RT_Resolution;
-
------------
-- Wakeup --
------------
Index: libgnarl/s-tpopmo.adb
===================================================================
--- libgnarl/s-tpopmo.adb (revision 0)
+++ libgnarl/s-tpopmo.adb (revision 0)
@@ -0,0 +1,283 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
+-- --
+-- SYSTEM.TASK_PRIMITIVES.OPERATIONS.MONOTONIC --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2017, Free Software Foundation, Inc. --
+-- --
+-- GNARL is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNARL was developed by the GNARL team at Florida State University. --
+-- Extensive contributions were provided by Ada Core Technologies, Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This is the Monotonic version of this package for Posix and Linux targets.
+
+separate (System.Task_Primitives.Operations)
+package body Monotonic is
+
+ -----------------------
+ -- Local Subprograms --
+ -----------------------
+
+ procedure Compute_Deadline
+ (Time : Duration;
+ Mode : ST.Delay_Modes;
+ Check_Time : out Duration;
+ Abs_Time : out Duration;
+ Rel_Time : out Duration);
+ -- Helper for Timed_Sleep and Timed_Delay: given a deadline specified by
+ -- Time and Mode, compute the current clock reading (Check_Time), and the
+ -- target absolute and relative clock readings (Abs_Time, Rel_Time). The
+ -- epoch for Time depends on Mode; the epoch for Check_Time and Abs_Time
+ -- is always that of CLOCK_RT_Ada.
+
+ ---------------------
+ -- Monotonic_Clock --
+ ---------------------
+
+ function Monotonic_Clock return Duration is
+ TS : aliased timespec;
+ 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);
+ end Monotonic_Clock;
+
+ -------------------
+ -- RT_Resolution --
+ -------------------
+
+ function RT_Resolution return Duration is
+ TS : aliased timespec;
+ Result : Interfaces.C.int;
+
+ begin
+ Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access);
+ pragma Assert (Result = 0);
+
+ return To_Duration (TS);
+ end RT_Resolution;
+
+ ----------------------
+ -- Compute_Deadline --
+ ----------------------
+
+ procedure Compute_Deadline
+ (Time : Duration;
+ Mode : ST.Delay_Modes;
+ Check_Time : out Duration;
+ Abs_Time : out Duration;
+ Rel_Time : out Duration)
+ is
+ begin
+ Check_Time := Monotonic_Clock;
+
+ -- Relative deadline
+
+ if Mode = Relative then
+ Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time;
+
+ if Relative_Timed_Wait then
+ Rel_Time := Duration'Min (Max_Sensible_Delay, Time);
+ end if;
+
+ pragma Warnings (Off);
+ -- Comparison "OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME" is compile
+ -- time known.
+
+ -- Absolute deadline specified using the tasking clock (CLOCK_RT_Ada)
+
+ elsif Mode = Absolute_RT
+ or else OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME
+ then
+ pragma Warnings (On);
+ Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
+
+ if Relative_Timed_Wait then
+ Rel_Time := Duration'Min (Max_Sensible_Delay, Time - Check_Time);
+ end if;
+
+ -- Absolute deadline specified using the calendar clock, in the
+ -- case where it is not the same as the tasking clock: compensate for
+ -- difference between clock epochs (Base_Time - Base_Cal_Time).
+
+ else
+ declare
+ Cal_Check_Time : constant Duration := OS_Primitives.Clock;
+ RT_Time : constant Duration :=
+ Time + Check_Time - Cal_Check_Time;
+
+ begin
+ Abs_Time :=
+ Duration'Min (Check_Time + Max_Sensible_Delay, RT_Time);
+
+ if Relative_Timed_Wait then
+ Rel_Time :=
+ Duration'Min (Max_Sensible_Delay, RT_Time - Check_Time);
+ end if;
+ end;
+ end if;
+ end Compute_Deadline;
+
+ -----------------
+ -- Timed_Sleep --
+ -----------------
+
+ -- This is for use within the run-time system, so abort is
+ -- assumed to be already deferred, and the caller should be
+ -- holding its own ATCB lock.
+
+ procedure Timed_Sleep
+ (Self_ID : ST.Task_Id;
+ Time : Duration;
+ Mode : ST.Delay_Modes;
+ Reason : System.Tasking.Task_States;
+ Timedout : out Boolean;
+ Yielded : out Boolean)
+ is
+ pragma Unreferenced (Reason);
+
+ Base_Time : Duration;
+ Check_Time : Duration;
+ Abs_Time : Duration;
+ Rel_Time : Duration;
+
+ Request : aliased timespec;
+ Result : Interfaces.C.int;
+
+ begin
+ Timedout := True;
+ Yielded := False;
+
+ Compute_Deadline
+ (Time => Time,
+ Mode => Mode,
+ Check_Time => Check_Time,
+ Abs_Time => Abs_Time,
+ Rel_Time => Rel_Time);
+ Base_Time := Check_Time;
+
+ if Abs_Time > Check_Time then
+ Request :=
+ To_Timespec (if Relative_Timed_Wait then Rel_Time else Abs_Time);
+
+ loop
+ exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
+
+ Result :=
+ pthread_cond_timedwait
+ (cond => Self_ID.Common.LL.CV'Access,
+ mutex => (if Single_Lock
+ then Single_RTS_Lock'Access
+ else Self_ID.Common.LL.L'Access),
+ abstime => Request'Access);
+
+ Check_Time := Monotonic_Clock;
+ exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
+
+ if Result in 0 | EINTR then
+
+ -- Somebody may have called Wakeup for us
+
+ Timedout := False;
+ exit;
+ end if;
+
+ pragma Assert (Result = ETIMEDOUT);
+ end loop;
+ end if;
+ end Timed_Sleep;
+
+ -----------------
+ -- Timed_Delay --
+ -----------------
+
+ -- This is for use in implementing delay statements, so we assume the
+ -- caller is abort-deferred but is holding no locks.
+
+ procedure Timed_Delay
+ (Self_ID : ST.Task_Id;
+ Time : Duration;
+ Mode : ST.Delay_Modes)
+ is
+ Base_Time : Duration;
+ Check_Time : Duration;
+ Abs_Time : Duration;
+ Rel_Time : Duration;
+ Request : aliased timespec;
+
+ Result : Interfaces.C.int;
+ pragma Warnings (Off, Result);
+
+ begin
+ if Single_Lock then
+ Lock_RTS;
+ end if;
+
+ Write_Lock (Self_ID);
+
+ Compute_Deadline
+ (Time => Time,
+ Mode => Mode,
+ Check_Time => Check_Time,
+ Abs_Time => Abs_Time,
+ Rel_Time => Rel_Time);
+ Base_Time := Check_Time;
+
+ if Abs_Time > Check_Time then
+ Request :=
+ To_Timespec (if Relative_Timed_Wait then Rel_Time else Abs_Time);
+ Self_ID.Common.State := Delay_Sleep;
+
+ loop
+ exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
+
+ Result :=
+ pthread_cond_timedwait
+ (cond => Self_ID.Common.LL.CV'Access,
+ mutex => (if Single_Lock
+ then Single_RTS_Lock'Access
+ else Self_ID.Common.LL.L'Access),
+ abstime => Request'Access);
+
+ Check_Time := Monotonic_Clock;
+ exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
+
+ pragma Assert (Result in 0 | ETIMEDOUT | EINTR);
+ end loop;
+
+ Self_ID.Common.State := Runnable;
+ end if;
+
+ Unlock (Self_ID);
+
+ if Single_Lock then
+ Unlock_RTS;
+ end if;
+
+ Result := sched_yield;
+ end Timed_Delay;
+
+end Monotonic;
Index: libgnarl/s-taprop__linux.adb
===================================================================
--- libgnarl/s-taprop__linux.adb (revision 253938)
+++ libgnarl/s-taprop__linux.adb (working copy)
@@ -38,9 +38,7 @@
-- Turn off polling, we do not want ATC polling to take place during tasking
-- operations. It causes infinite loops and other problems.
-with Interfaces.C; use Interfaces;
-use type Interfaces.C.int;
-use type Interfaces.C.long;
+with Interfaces.C; use Interfaces; use type Interfaces.C.int;
with System.Task_Info;
with System.Tasking.Debug;
@@ -112,8 +110,6 @@
-- Constant to indicate that the thread identifier has not yet been
-- initialized.
- Base_Monotonic_Clock : Duration := 0.0;
-
--------------------
-- Local Packages --
--------------------
@@ -141,6 +137,38 @@
package body Specific is separate;
-- The body of this package is target specific
+ package Monotonic is
+
+ function Monotonic_Clock return Duration;
+ pragma Inline (Monotonic_Clock);
+ -- Returns "absolute" time, represented as an offset relative to "the
+ -- Epoch", which is Jan 1, 1970. This clock implementation is immune to
+ -- the system's clock changes.
+
+ function RT_Resolution return Duration;
+ pragma Inline (RT_Resolution);
+ -- Returns resolution of the underlying clock used to implement RT_Clock
+
+ procedure Timed_Sleep
+ (Self_ID : ST.Task_Id;
+ Time : Duration;
+ Mode : ST.Delay_Modes;
+ Reason : System.Tasking.Task_States;
+ Timedout : out Boolean;
+ Yielded : out Boolean);
+ -- Combination of Sleep (above) and Timed_Delay
+
+ procedure Timed_Delay
+ (Self_ID : ST.Task_Id;
+ Time : Duration;
+ Mode : ST.Delay_Modes);
+ -- Implement the semantics of the delay statement.
+ -- The caller should be abort-deferred and should not hold any locks.
+
+ end Monotonic;
+
+ package body Monotonic is separate;
+
----------------------------------
-- ATCB allocation/deallocation --
----------------------------------
@@ -169,11 +197,6 @@
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
@@ -275,100 +298,6 @@
end if;
end Abort_Handler;
- ----------------------------------
- -- Compute_Base_Monotonic_Clock --
- ----------------------------------
-
- function Compute_Base_Monotonic_Clock return Duration is
- Aft : Duration;
- Bef : Duration;
- Mon : Duration;
- Res_A : Interfaces.C.int;
- Res_B : Interfaces.C.int;
- Res_M : Interfaces.C.int;
- TS_Aft : aliased timespec;
- TS_Aft0 : aliased timespec;
- TS_Bef : aliased timespec;
- TS_Bef0 : aliased timespec;
- TS_Mon : aliased timespec;
- TS_Mon0 : aliased timespec;
-
- 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 that will cause CLOCK_REALTIME to jump
- -- backwards. In the extrenmely unlikely event we call clock_gettime
- -- before and after the jump the epoch, the 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);
-
- -- The calls to clock_gettime before the loop were no good
-
- if (TS_Bef0.tv_sec /= TS_Aft0.tv_sec
- and then TS_Bef.tv_sec = TS_Aft.tv_sec)
-
- -- The most recent calls to clock_gettime were better
-
- 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))
- then
- TS_Bef0 := TS_Bef;
- TS_Aft0 := TS_Aft;
- TS_Mon0 := TS_Mon;
- end if;
- end loop;
-
- Bef := To_Duration (TS_Bef0);
- Mon := To_Duration (TS_Mon0);
- Aft := To_Duration (TS_Aft0);
-
- -- Distribute the division, to avoid potential type overflow someday
-
- return Bef / 2 + Aft / 2 - Mon;
- end Compute_Base_Monotonic_Clock;
-
--------------
-- Lock_RTS --
--------------
@@ -690,57 +619,8 @@
Mode : ST.Delay_Modes;
Reason : System.Tasking.Task_States;
Timedout : out Boolean;
- Yielded : out Boolean)
- is
- pragma Unreferenced (Reason);
+ Yielded : out Boolean) renames Monotonic.Timed_Sleep;
- Base_Time : constant Duration := Monotonic_Clock;
- Check_Time : Duration := Base_Time - Base_Monotonic_Clock;
- Abs_Time : Duration;
- Request : aliased timespec;
- Result : C.int;
-
- begin
- Timedout := True;
- Yielded := False;
-
- Abs_Time :=
- (if Mode = Relative
- then Duration'Min (Time, Max_Sensible_Delay) + Check_Time
- else Duration'Min (Check_Time + Max_Sensible_Delay,
- Time - Base_Monotonic_Clock));
-
- if Abs_Time > Check_Time then
- Request := To_Timespec (Abs_Time);
-
- loop
- exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
-
- Result :=
- pthread_cond_timedwait
- (cond => Self_ID.Common.LL.CV'Access,
- mutex => (if Single_Lock
- then Single_RTS_Lock'Access
- else Self_ID.Common.LL.L'Access),
- abstime => Request'Access);
-
- Check_Time := Monotonic_Clock;
- exit when Abs_Time + Base_Monotonic_Clock <= Check_Time
- or else Check_Time < Base_Time;
-
- if Result in 0 | EINTR then
-
- -- Somebody may have called Wakeup for us
-
- Timedout := False;
- exit;
- end if;
-
- pragma Assert (Result = ETIMEDOUT);
- end loop;
- end if;
- end Timed_Sleep;
-
-----------------
-- Timed_Delay --
-----------------
@@ -751,93 +631,20 @@
procedure Timed_Delay
(Self_ID : Task_Id;
Time : Duration;
- Mode : ST.Delay_Modes)
- is
- Base_Time : constant Duration := Monotonic_Clock;
- Check_Time : Duration := Base_Time - Base_Monotonic_Clock;
- Abs_Time : Duration;
- Request : aliased timespec;
+ Mode : ST.Delay_Modes) renames Monotonic.Timed_Delay;
- Result : C.int;
- pragma Warnings (Off, Result);
-
- begin
- if Single_Lock then
- Lock_RTS;
- end if;
-
- Write_Lock (Self_ID);
-
- Abs_Time :=
- (if Mode = Relative
- then Time + Check_Time
- else Duration'Min (Check_Time + Max_Sensible_Delay,
- Time - Base_Monotonic_Clock));
-
- if Abs_Time > Check_Time then
- Request := To_Timespec (Abs_Time);
- Self_ID.Common.State := Delay_Sleep;
-
- loop
- exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
-
- Result :=
- pthread_cond_timedwait
- (cond => Self_ID.Common.LL.CV'Access,
- mutex => (if Single_Lock
- then Single_RTS_Lock'Access
- else Self_ID.Common.LL.L'Access),
- abstime => Request'Access);
-
- Check_Time := Monotonic_Clock;
- exit when Abs_Time + Base_Monotonic_Clock <= Check_Time
- or else Check_Time < Base_Time;
-
- pragma Assert (Result in 0 | ETIMEDOUT | EINTR);
- end loop;
-
- Self_ID.Common.State := Runnable;
- end if;
-
- Unlock (Self_ID);
-
- if Single_Lock then
- Unlock_RTS;
- end if;
-
- Result := sched_yield;
- end Timed_Delay;
-
---------------------
-- Monotonic_Clock --
---------------------
- function Monotonic_Clock return Duration is
- TS : aliased timespec;
- Result : Interfaces.C.int;
- begin
- Result := clock_gettime
- (clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access);
- pragma Assert (Result = 0);
+ function Monotonic_Clock return Duration renames Monotonic.Monotonic_Clock;
- return Base_Monotonic_Clock + To_Duration (TS);
- end Monotonic_Clock;
-
-------------------
-- RT_Resolution --
-------------------
- function RT_Resolution return Duration is
- TS : aliased timespec;
- Result : C.int;
+ function RT_Resolution return Duration renames Monotonic.RT_Resolution;
- begin
- Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access);
- pragma Assert (Result = 0);
-
- return To_Duration (TS);
- end RT_Resolution;
-
------------
-- Wakeup --
------------
@@ -1612,8 +1419,6 @@
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);
