File : a-reatim-c.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
4 -- --
5 -- A D A . R E A L _ T I M E --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2015, 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 -- --
19 -- --
20 -- --
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 -- GNARL was developed by the GNARL team at Florida State University. --
28 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
29 -- --
30 ------------------------------------------------------------------------------
31
32 -- This is the Ravenscar/HI-E version of this package for C targets
33
34 with Unchecked_Conversion;
35
36 package body Ada.Real_Time with
37 SPARK_Mode => Off
38 is
39 function To_Integer is new Unchecked_Conversion (Duration, Integer);
40
41 function Convert_To_Duration is new
42 Unchecked_Conversion (Integer, Duration);
43
44 function Monotonic_Clock return Time;
45 pragma Import (C, Monotonic_Clock, "rts_monotonic_clock");
46 -- Returns time from the board/OS.
47 -- This clock implementation is immune to the system's clock changes.
48
49 function RT_Resolution return Integer;
50 pragma Import (C, RT_Resolution, "rts_rt_resolution");
51 -- Returns resolution of the underlying clock used to implement
52 -- Monotonic_Clock.
53
54 function Rounded_Div (L, R : Time_Span) return Time_Span;
55 pragma Inline_Always (Rounded_Div);
56 -- Return L / R rounded to the nearest integer (to implement ARM D.8 26).
57
58 ---------
59 -- "*" --
60 ---------
61
62 function "*" (Left : Time_Span; Right : Integer) return Time_Span is
63 begin
64 return Left * Time_Span (Right);
65 end "*";
66
67 function "*" (Left : Integer; Right : Time_Span) return Time_Span is
68 begin
69 return Time_Span (Left) * Right;
70 end "*";
71
72 ---------
73 -- "+" --
74 ---------
75
76 function "+" (Left : Time; Right : Time_Span) return Time is
77 begin
78 return Left + Time (Right);
79 end "+";
80
81 function "+" (Left : Time_Span; Right : Time) return Time is
82 begin
83 return Time (Left) + Right;
84 end "+";
85
86 function "+" (Left, Right : Time_Span) return Time_Span is
87 begin
88 return Time_Span (Integer (Left) + Integer (Right));
89 end "+";
90
91 ---------
92 -- "-" --
93 ---------
94
95 function "-" (Left : Time; Right : Time_Span) return Time is
96 begin
97 return Left - Time (Right);
98 end "-";
99
100 function "-" (Left, Right : Time) return Time_Span is
101 begin
102 return Time_Span (Integer (Left) - Integer (Right));
103 end "-";
104
105 function "-" (Left, Right : Time_Span) return Time_Span is
106 begin
107 return Time_Span (Integer (Left) - Integer (Right));
108 end "-";
109
110 function "-" (Right : Time_Span) return Time_Span is
111 begin
112 return Time_Span (-Integer (Right));
113 end "-";
114
115 ---------
116 -- "/" --
117 ---------
118
119 function "/" (Left, Right : Time_Span) return Integer is
120 begin
121 return Integer (Left) / Integer (Right);
122 end "/";
123
124 function "/" (Left : Time_Span; Right : Integer) return Time_Span is
125 begin
126 return Left / Time_Span (Right);
127 end "/";
128
129 -----------
130 -- Clock --
131 -----------
132
133 function Clock return Time is
134 begin
135 return Monotonic_Clock;
136 end Clock;
137
138 ------------------
139 -- Microseconds --
140 ------------------
141
142 function Microseconds (US : Integer) return Time_Span is
143 begin
144 return Rounded_Div (Time_Span (US * RT_Resolution), 10#1#E6);
145 end Microseconds;
146
147 ------------------
148 -- Milliseconds --
149 ------------------
150
151 function Milliseconds (MS : Integer) return Time_Span is
152 begin
153 return Rounded_Div (Time_Span (MS * RT_Resolution), 10#1#E3);
154 end Milliseconds;
155
156 -------------
157 -- Minutes --
158 -------------
159
160 function Minutes (M : Integer) return Time_Span is
161 begin
162 return Milliseconds (M) * Integer'(60_000);
163 end Minutes;
164
165 -----------------
166 -- Nanoseconds --
167 -----------------
168
169 function Nanoseconds (NS : Integer) return Time_Span is
170 begin
171 return Rounded_Div (Time_Span (NS * RT_Resolution), 10#1#E9);
172 end Nanoseconds;
173
174 -----------------
175 -- Rounded_Div --
176 -----------------
177
178 function Rounded_Div (L, R : Time_Span) return Time_Span is
179 Left : Time_Span;
180 begin
181 if L >= 0 then
182 Left := L + Time_Span (Long_Integer (R) / 2);
183 else
184 Left := L - Time_Span (Long_Integer (R) / 2);
185 end if;
186
187 return Left / R;
188 end Rounded_Div;
189
190 -------------
191 -- Seconds --
192 -------------
193
194 function Seconds (S : Integer) return Time_Span is
195 begin
196 return Milliseconds (S) * Integer'(1000);
197 end Seconds;
198
199 -----------
200 -- Split --
201 -----------
202
203 procedure Split (T : Time; SC : out Seconds_Count; TS : out Time_Span) is
204 Res : constant Time := Time (RT_Resolution);
205
206 begin
207 SC := Seconds_Count (T / Res);
208
209 -- TS will always be non-negative, as required by ARM D.8 (29), because
210 -- T is non-negative.
211
212 TS := Time_Span (T) - Time_Span (Time (SC) * Res);
213 end Split;
214
215 -------------
216 -- Time_Of --
217 -------------
218
219 function Time_Of (SC : Seconds_Count; TS : Time_Span) return Time is
220 begin
221 -- We want to return SC * RT_Resolution + TS. To avoid spurious
222 -- overflows in the intermediate result (SC * RT_Resolution) we take
223 -- advantage of the different signs in SC and TS, when that is the case.
224
225 -- If the signs of SC and TS are different then we avoid converting SC
226 -- to Time (as we do in the else part). The reason for that is that SC
227 -- converted to Time may overflow the range of Time, while the addition
228 -- of SC plus TS does not overflow (because of their different signs).
229 -- The approach is to add and remove the greatest value of time
230 -- (greatest absolute value) to both SC and TS. SC and TS have different
231 -- signs, so we add the positive constant to the negative value, and the
232 -- negative constant to the positive value, to prevent overflows.
233
234 if SC > 0 and then TS < 0 then
235 declare
236 Closest_Boundary : constant Seconds_Count :=
237 (if TS >= 0 then Seconds_Count (Time_Span_Last / RT_Resolution)
238 else Seconds_Count (Time_Span_First / RT_Resolution));
239 -- Value representing the number of seconds of the Time_Span
240 -- boundary closest to TS. The sign of Closest_Boundary is always
241 -- different from the sign of SC, hence avoiding overflow in the
242 -- expression (SC + Closest_Boundary) * RT_Resolution which
243 -- is part of the return statement.
244
245 Dist_To_Boundary : constant Time_Span :=
246 TS - Time_Span (Closest_Boundary) * Time_Span (RT_Resolution);
247 -- Distance between TS and Closest_Boundary expressed in Time_Span
248 -- Both operands in the subtraction have different signs, hence
249 -- avoiding overflow.
250
251 begin
252 -- Both operands in the inner addition have different signs,
253 -- hence avoiding overflow. The Time () conversion and the outer
254 -- addition can overflow only if SC + TC is not within Time'Range.
255
256 return Time (SC + Closest_Boundary) * Time (RT_Resolution) +
257 Dist_To_Boundary;
258 end;
259
260 -- Both operands have the same sign, so we can convert SC into Time
261 -- right away; if this conversion overflows then the result of adding SC
262 -- and TS would overflow anyway (so we would just be detecting the
263 -- overflow a bit earlier).
264
265 else
266 return Time (SC) * Time (RT_Resolution) + TS;
267 end if;
268 end Time_Of;
269
270 -----------------
271 -- To_Duration --
272 -----------------
273
274 function To_Duration (TS : Time_Span) return Duration is
275 Result : constant Integer := (Integer (TS) * 10000) / RT_Resolution;
276 -- ??? where does this 10000 come from?
277
278 begin
279 return Convert_To_Duration (Result);
280 end To_Duration;
281
282 ------------------
283 -- To_Time_Span --
284 ------------------
285
286 function To_Time_Span (D : Duration) return Time_Span is
287 begin
288 -- Where does this 10000 come from ???
289 return Time_Span (To_Integer (D) * RT_Resolution / 10000);
290 end To_Time_Span;
291
292 end Ada.Real_Time;