1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT RUN-TIME COMPONENTS                         --
4--                                                                          --
5--     S Y S T E M . O S _ P R I M I T I V E S. T I M E D _ D E L A Y       --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--                     Copyright (C) 2012-2019, AdaCore                     --
10--                                                                          --
11-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12-- terms of the  GNU General Public License as published  by the Free Soft- --
13-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
17--                                                                          --
18-- As a special exception under Section 7 of GPL version 3, you are granted --
19-- additional permissions described in the GCC Runtime Library Exception,   --
20-- version 3.1, as published by the Free Software Foundation.               --
21--                                                                          --
22-- You should have received a copy of the GNU General Public License and    --
23-- a copy of the GCC Runtime Library Exception along with this program;     --
24-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25-- <http://www.gnu.org/licenses/>.                                          --
26--                                                                          --
27-- GNAT was originally developed  by the GNAT team at  New York University. --
28-- Extensive contributions were provided by Ada Core Technologies Inc.      --
29--                                                                          --
30------------------------------------------------------------------------------
31
32--  This is the Posix, Posix2008, and LynxOS version of this procedure.
33
34separate (System.OS_Primitives)
35procedure Timed_Delay
36  (Time : Duration;
37   Mode : Integer)
38is
39   Request    : aliased timespec;
40   Remaind    : aliased timespec;
41   Rel_Time   : Duration;
42   Abs_Time   : Duration;
43   Base_Time  : constant Duration := Clock;
44   Check_Time : Duration := Base_Time;
45   Time_Chunk : Duration;
46
47   Result : Integer;
48   pragma Unreferenced (Result);
49
50begin
51   if Mode = Relative then
52      Rel_Time := Time;
53      Abs_Time := Time + Check_Time;
54   else
55      Rel_Time := Time - Check_Time;
56      Abs_Time := Time;
57   end if;
58
59   --  To keep a sensible Max_Sensible_Delay on a target whose system
60   --  maximum is less than sensible, we split the delay into manageable
61   --  chunks of time less than or equal to the Max_System_Delay.
62
63   if Rel_Time > 0.0 then
64      Time_Chunk := Rel_Time;
65      loop
66         pragma Warnings (Off, "condition is always *");
67         if Max_System_Delay < Max_Sensible_Delay and then
68            Time_Chunk > Max_System_Delay
69         then
70            Time_Chunk := Max_System_Delay;
71         end if;
72         pragma Warnings (On);
73
74         Request := To_Timespec (Time_Chunk);
75         Result := nanosleep (Request'Access, Remaind'Access);
76
77         Check_Time := Clock;
78
79         exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
80
81         Time_Chunk := Abs_Time - Check_Time;
82      end loop;
83   end if;
84end Timed_Delay;
85