|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT RUN-TIME COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- A D A . C A L E N D A R --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
|
|
111
|
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 with Ada.Unchecked_Conversion;
|
|
|
33
|
|
|
34 with Interfaces.C;
|
|
|
35
|
|
|
36 with System.OS_Primitives;
|
|
|
37
|
|
|
38 package body Ada.Calendar with
|
|
|
39 SPARK_Mode => Off
|
|
|
40 is
|
|
|
41
|
|
|
42 --------------------------
|
|
|
43 -- Implementation Notes --
|
|
|
44 --------------------------
|
|
|
45
|
|
|
46 -- In complex algorithms, some variables of type Ada.Calendar.Time carry
|
|
|
47 -- suffix _S or _N to denote units of seconds or nanoseconds.
|
|
|
48 --
|
|
|
49 -- Because time is measured in different units and from different origins
|
|
|
50 -- on various targets, a system independent model is incorporated into
|
|
|
51 -- Ada.Calendar. The idea behind the design is to encapsulate all target
|
|
|
52 -- dependent machinery in a single package, thus providing a uniform
|
|
|
53 -- interface to all existing and any potential children.
|
|
|
54
|
|
|
55 -- package Ada.Calendar
|
|
|
56 -- procedure Split (5 parameters) -------+
|
|
|
57 -- | Call from local routine
|
|
|
58 -- private |
|
|
|
59 -- package Formatting_Operations |
|
|
|
60 -- procedure Split (11 parameters) <--+
|
|
|
61 -- end Formatting_Operations |
|
|
|
62 -- end Ada.Calendar |
|
|
|
63 -- |
|
|
|
64 -- package Ada.Calendar.Formatting | Call from child routine
|
|
|
65 -- procedure Split (9 or 10 parameters) -+
|
|
|
66 -- end Ada.Calendar.Formatting
|
|
|
67
|
|
|
68 -- The behavior of the interfacing routines is controlled via various
|
|
|
69 -- flags. All new Ada 2005 types from children of Ada.Calendar are
|
|
|
70 -- emulated by a similar type. For instance, type Day_Number is replaced
|
|
|
71 -- by Integer in various routines. One ramification of this model is that
|
|
|
72 -- the caller site must perform validity checks on returned results.
|
|
|
73 -- The end result of this model is the lack of target specific files per
|
|
|
74 -- child of Ada.Calendar (e.g. a-calfor).
|
|
|
75
|
|
|
76 -----------------------
|
|
|
77 -- Local Subprograms --
|
|
|
78 -----------------------
|
|
|
79
|
|
|
80 procedure Check_Within_Time_Bounds (T : Time_Rep);
|
|
|
81 -- Ensure that a time representation value falls withing the bounds of Ada
|
|
|
82 -- time. Leap seconds support is taken into account.
|
|
|
83
|
|
|
84 procedure Cumulative_Leap_Seconds
|
|
|
85 (Start_Date : Time_Rep;
|
|
|
86 End_Date : Time_Rep;
|
|
|
87 Elapsed_Leaps : out Natural;
|
|
|
88 Next_Leap : out Time_Rep);
|
|
|
89 -- Elapsed_Leaps is the sum of the leap seconds that have occurred on or
|
|
|
90 -- after Start_Date and before (strictly before) End_Date. Next_Leap_Sec
|
|
|
91 -- represents the next leap second occurrence on or after End_Date. If
|
|
|
92 -- there are no leaps seconds after End_Date, End_Of_Time is returned.
|
|
|
93 -- End_Of_Time can be used as End_Date to count all the leap seconds that
|
|
|
94 -- have occurred on or after Start_Date.
|
|
|
95 --
|
|
|
96 -- Note: Any sub seconds of Start_Date and End_Date are discarded before
|
|
|
97 -- the calculations are done. For instance: if 113 seconds is a leap
|
|
|
98 -- second (it isn't) and 113.5 is input as an End_Date, the leap second
|
|
|
99 -- at 113 will not be counted in Leaps_Between, but it will be returned
|
|
|
100 -- as Next_Leap_Sec. Thus, if the caller wants to know if the End_Date is
|
|
|
101 -- a leap second, the comparison should be:
|
|
|
102 --
|
|
|
103 -- End_Date >= Next_Leap_Sec;
|
|
|
104 --
|
|
|
105 -- After_Last_Leap is designed so that this comparison works without
|
|
|
106 -- having to first check if Next_Leap_Sec is a valid leap second.
|
|
|
107
|
|
|
108 function Duration_To_Time_Rep is
|
|
|
109 new Ada.Unchecked_Conversion (Duration, Time_Rep);
|
|
|
110 -- Convert a duration value into a time representation value
|
|
|
111
|
|
|
112 function Time_Rep_To_Duration is
|
|
|
113 new Ada.Unchecked_Conversion (Time_Rep, Duration);
|
|
|
114 -- Convert a time representation value into a duration value
|
|
|
115
|
|
|
116 function UTC_Time_Offset
|
|
|
117 (Date : Time;
|
|
|
118 Is_Historic : Boolean) return Long_Integer;
|
|
|
119 -- This routine acts as an Ada wrapper around __gnat_localtime_tzoff which
|
|
|
120 -- in turn utilizes various OS-dependent mechanisms to calculate the time
|
|
|
121 -- zone offset of a date. Formal parameter Date represents an arbitrary
|
|
|
122 -- time stamp, either in the past, now, or in the future. If the flag
|
|
|
123 -- Is_Historic is set, this routine would try to calculate to the best of
|
|
|
124 -- the OS's abilities the time zone offset that was or will be in effect
|
|
|
125 -- on Date. If the flag is set to False, the routine returns the current
|
|
|
126 -- time zone with Date effectively set to Clock.
|
|
|
127 --
|
|
|
128 -- NOTE: Targets which support localtime_r will aways return a historic
|
|
|
129 -- time zone even if flag Is_Historic is set to False because this is how
|
|
|
130 -- localtime_r operates.
|
|
|
131
|
|
|
132 -----------------
|
|
|
133 -- Local Types --
|
|
|
134 -----------------
|
|
|
135
|
|
|
136 -- An integer time duration. The type is used whenever a positive elapsed
|
|
|
137 -- duration is needed, for instance when splitting a time value. Here is
|
|
|
138 -- how Time_Rep and Time_Dur are related:
|
|
|
139
|
|
|
140 -- 'First Ada_Low Ada_High 'Last
|
|
|
141 -- Time_Rep: +-------+------------------------+---------+
|
|
|
142 -- Time_Dur: +------------------------+---------+
|
|
|
143 -- 0 'Last
|
|
|
144
|
|
|
145 type Time_Dur is range 0 .. 2 ** 63 - 1;
|
|
|
146
|
|
|
147 --------------------------
|
|
|
148 -- Leap seconds control --
|
|
|
149 --------------------------
|
|
|
150
|
|
|
151 Flag : Integer;
|
|
|
152 pragma Import (C, Flag, "__gl_leap_seconds_support");
|
|
|
153 -- This imported value is used to determine whether the compilation had
|
|
|
154 -- binder flag "-y" present which enables leap seconds. A value of zero
|
|
|
155 -- signifies no leap seconds support while a value of one enables support.
|
|
|
156
|
|
|
157 Leap_Support : constant Boolean := (Flag = 1);
|
|
|
158 -- Flag to controls the usage of leap seconds in all Ada.Calendar routines
|
|
|
159
|
|
|
160 Leap_Seconds_Count : constant Natural := 25;
|
|
|
161
|
|
|
162 ---------------------
|
|
|
163 -- Local Constants --
|
|
|
164 ---------------------
|
|
|
165
|
|
|
166 Ada_Min_Year : constant Year_Number := Year_Number'First;
|
|
|
167 Secs_In_Four_Years : constant := (3 * 365 + 366) * Secs_In_Day;
|
|
|
168 Secs_In_Non_Leap_Year : constant := 365 * Secs_In_Day;
|
|
|
169 Nanos_In_Four_Years : constant := Secs_In_Four_Years * Nano;
|
|
|
170
|
|
|
171 -- Lower and upper bound of Ada time. The zero (0) value of type Time is
|
|
|
172 -- positioned at year 2150. Note that the lower and upper bound account
|
|
|
173 -- for the non-leap centennial years.
|
|
|
174
|
|
|
175 Ada_Low : constant Time_Rep := -(61 * 366 + 188 * 365) * Nanos_In_Day;
|
|
|
176 Ada_High : constant Time_Rep := (60 * 366 + 190 * 365) * Nanos_In_Day;
|
|
|
177
|
|
|
178 -- Even though the upper bound of time is 2399-12-31 23:59:59.999999999
|
|
|
179 -- UTC, it must be increased to include all leap seconds.
|
|
|
180
|
|
|
181 Ada_High_And_Leaps : constant Time_Rep :=
|
|
|
182 Ada_High + Time_Rep (Leap_Seconds_Count) * Nano;
|
|
|
183
|
|
|
184 -- Two constants used in the calculations of elapsed leap seconds.
|
|
|
185 -- End_Of_Time is later than Ada_High in time zone -28. Start_Of_Time
|
|
|
186 -- is earlier than Ada_Low in time zone +28.
|
|
|
187
|
|
|
188 End_Of_Time : constant Time_Rep :=
|
|
|
189 Ada_High + Time_Rep (3) * Nanos_In_Day;
|
|
|
190 Start_Of_Time : constant Time_Rep :=
|
|
|
191 Ada_Low - Time_Rep (3) * Nanos_In_Day;
|
|
|
192
|
|
|
193 -- The Unix lower time bound expressed as nanoseconds since the start of
|
|
|
194 -- Ada time in UTC.
|
|
|
195
|
|
|
196 Unix_Min : constant Time_Rep :=
|
|
|
197 Ada_Low + Time_Rep (17 * 366 + 52 * 365) * Nanos_In_Day;
|
|
|
198
|
|
|
199 -- The Unix upper time bound expressed as nanoseconds since the start of
|
|
|
200 -- Ada time in UTC.
|
|
|
201
|
|
|
202 Unix_Max : constant Time_Rep :=
|
|
|
203 Ada_Low + Time_Rep (34 * 366 + 102 * 365) * Nanos_In_Day +
|
|
|
204 Time_Rep (Leap_Seconds_Count) * Nano;
|
|
|
205
|
|
|
206 Cumulative_Days_Before_Month :
|
|
|
207 constant array (Month_Number) of Natural :=
|
|
|
208 (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
|
|
|
209
|
|
|
210 -- The following table contains the hard time values of all existing leap
|
|
|
211 -- seconds. The values are produced by the utility program xleaps.adb. This
|
|
|
212 -- must be updated when additional leap second times are defined.
|
|
|
213
|
|
|
214 Leap_Second_Times : constant array (1 .. Leap_Seconds_Count) of Time_Rep :=
|
|
|
215 (-5601484800000000000,
|
|
|
216 -5585587199000000000,
|
|
|
217 -5554051198000000000,
|
|
|
218 -5522515197000000000,
|
|
|
219 -5490979196000000000,
|
|
|
220 -5459356795000000000,
|
|
|
221 -5427820794000000000,
|
|
|
222 -5396284793000000000,
|
|
|
223 -5364748792000000000,
|
|
|
224 -5317487991000000000,
|
|
|
225 -5285951990000000000,
|
|
|
226 -5254415989000000000,
|
|
|
227 -5191257588000000000,
|
|
|
228 -5112287987000000000,
|
|
|
229 -5049129586000000000,
|
|
|
230 -5017593585000000000,
|
|
|
231 -4970332784000000000,
|
|
|
232 -4938796783000000000,
|
|
|
233 -4907260782000000000,
|
|
|
234 -4859827181000000000,
|
|
|
235 -4812566380000000000,
|
|
|
236 -4765132779000000000,
|
|
|
237 -4544207978000000000,
|
|
|
238 -4449513577000000000,
|
|
|
239 -4339180776000000000);
|
|
|
240
|
|
|
241 ---------
|
|
|
242 -- "+" --
|
|
|
243 ---------
|
|
|
244
|
|
|
245 function "+" (Left : Time; Right : Duration) return Time is
|
|
|
246 pragma Unsuppress (Overflow_Check);
|
|
|
247 Left_N : constant Time_Rep := Time_Rep (Left);
|
|
|
248 begin
|
|
|
249 return Time (Left_N + Duration_To_Time_Rep (Right));
|
|
|
250 exception
|
|
|
251 when Constraint_Error =>
|
|
|
252 raise Time_Error;
|
|
|
253 end "+";
|
|
|
254
|
|
|
255 function "+" (Left : Duration; Right : Time) return Time is
|
|
|
256 begin
|
|
|
257 return Right + Left;
|
|
|
258 end "+";
|
|
|
259
|
|
|
260 ---------
|
|
|
261 -- "-" --
|
|
|
262 ---------
|
|
|
263
|
|
|
264 function "-" (Left : Time; Right : Duration) return Time is
|
|
|
265 pragma Unsuppress (Overflow_Check);
|
|
|
266 Left_N : constant Time_Rep := Time_Rep (Left);
|
|
|
267 begin
|
|
|
268 return Time (Left_N - Duration_To_Time_Rep (Right));
|
|
|
269 exception
|
|
|
270 when Constraint_Error =>
|
|
|
271 raise Time_Error;
|
|
|
272 end "-";
|
|
|
273
|
|
|
274 function "-" (Left : Time; Right : Time) return Duration is
|
|
|
275 pragma Unsuppress (Overflow_Check);
|
|
|
276
|
|
|
277 Dur_Low : constant Time_Rep := Duration_To_Time_Rep (Duration'First);
|
|
|
278 Dur_High : constant Time_Rep := Duration_To_Time_Rep (Duration'Last);
|
|
|
279 -- The bounds of type Duration expressed as time representations
|
|
|
280
|
|
|
281 Res_N : Time_Rep;
|
|
|
282
|
|
|
283 begin
|
|
|
284 Res_N := Time_Rep (Left) - Time_Rep (Right);
|
|
|
285
|
|
|
286 -- Due to the extended range of Ada time, "-" is capable of producing
|
|
|
287 -- results which may exceed the range of Duration. In order to prevent
|
|
|
288 -- the generation of bogus values by the Unchecked_Conversion, we apply
|
|
|
289 -- the following check.
|
|
|
290
|
|
|
291 if Res_N < Dur_Low or else Res_N > Dur_High then
|
|
|
292 raise Time_Error;
|
|
|
293 end if;
|
|
|
294
|
|
|
295 return Time_Rep_To_Duration (Res_N);
|
|
|
296
|
|
|
297 exception
|
|
|
298 when Constraint_Error =>
|
|
|
299 raise Time_Error;
|
|
|
300 end "-";
|
|
|
301
|
|
|
302 ---------
|
|
|
303 -- "<" --
|
|
|
304 ---------
|
|
|
305
|
|
|
306 function "<" (Left, Right : Time) return Boolean is
|
|
|
307 begin
|
|
|
308 return Time_Rep (Left) < Time_Rep (Right);
|
|
|
309 end "<";
|
|
|
310
|
|
|
311 ----------
|
|
|
312 -- "<=" --
|
|
|
313 ----------
|
|
|
314
|
|
|
315 function "<=" (Left, Right : Time) return Boolean is
|
|
|
316 begin
|
|
|
317 return Time_Rep (Left) <= Time_Rep (Right);
|
|
|
318 end "<=";
|
|
|
319
|
|
|
320 ---------
|
|
|
321 -- ">" --
|
|
|
322 ---------
|
|
|
323
|
|
|
324 function ">" (Left, Right : Time) return Boolean is
|
|
|
325 begin
|
|
|
326 return Time_Rep (Left) > Time_Rep (Right);
|
|
|
327 end ">";
|
|
|
328
|
|
|
329 ----------
|
|
|
330 -- ">=" --
|
|
|
331 ----------
|
|
|
332
|
|
|
333 function ">=" (Left, Right : Time) return Boolean is
|
|
|
334 begin
|
|
|
335 return Time_Rep (Left) >= Time_Rep (Right);
|
|
|
336 end ">=";
|
|
|
337
|
|
|
338 ------------------------------
|
|
|
339 -- Check_Within_Time_Bounds --
|
|
|
340 ------------------------------
|
|
|
341
|
|
|
342 procedure Check_Within_Time_Bounds (T : Time_Rep) is
|
|
|
343 begin
|
|
|
344 if Leap_Support then
|
|
|
345 if T < Ada_Low or else T > Ada_High_And_Leaps then
|
|
|
346 raise Time_Error;
|
|
|
347 end if;
|
|
|
348 else
|
|
|
349 if T < Ada_Low or else T > Ada_High then
|
|
|
350 raise Time_Error;
|
|
|
351 end if;
|
|
|
352 end if;
|
|
|
353 end Check_Within_Time_Bounds;
|
|
|
354
|
|
|
355 -----------
|
|
|
356 -- Clock --
|
|
|
357 -----------
|
|
|
358
|
|
|
359 function Clock return Time is
|
|
|
360 Elapsed_Leaps : Natural;
|
|
|
361 Next_Leap_N : Time_Rep;
|
|
|
362
|
|
|
363 -- The system clock returns the time in UTC since the Unix Epoch of
|
|
|
364 -- 1970-01-01 00:00:00.0. We perform an origin shift to the Ada Epoch
|
|
|
365 -- by adding the number of nanoseconds between the two origins.
|
|
|
366
|
|
|
367 Res_N : Time_Rep :=
|
|
|
368 Duration_To_Time_Rep (System.OS_Primitives.Clock) + Unix_Min;
|
|
|
369
|
|
|
370 begin
|
|
|
371 -- If the target supports leap seconds, determine the number of leap
|
|
|
372 -- seconds elapsed until this moment.
|
|
|
373
|
|
|
374 if Leap_Support then
|
|
|
375 Cumulative_Leap_Seconds
|
|
|
376 (Start_Of_Time, Res_N, Elapsed_Leaps, Next_Leap_N);
|
|
|
377
|
|
|
378 -- The system clock may fall exactly on a leap second
|
|
|
379
|
|
|
380 if Res_N >= Next_Leap_N then
|
|
|
381 Elapsed_Leaps := Elapsed_Leaps + 1;
|
|
|
382 end if;
|
|
|
383
|
|
|
384 -- The target does not support leap seconds
|
|
|
385
|
|
|
386 else
|
|
|
387 Elapsed_Leaps := 0;
|
|
|
388 end if;
|
|
|
389
|
|
|
390 Res_N := Res_N + Time_Rep (Elapsed_Leaps) * Nano;
|
|
|
391
|
|
|
392 return Time (Res_N);
|
|
|
393 end Clock;
|
|
|
394
|
|
|
395 -----------------------------
|
|
|
396 -- Cumulative_Leap_Seconds --
|
|
|
397 -----------------------------
|
|
|
398
|
|
|
399 procedure Cumulative_Leap_Seconds
|
|
|
400 (Start_Date : Time_Rep;
|
|
|
401 End_Date : Time_Rep;
|
|
|
402 Elapsed_Leaps : out Natural;
|
|
|
403 Next_Leap : out Time_Rep)
|
|
|
404 is
|
|
|
405 End_Index : Positive;
|
|
|
406 End_T : Time_Rep := End_Date;
|
|
|
407 Start_Index : Positive;
|
|
|
408 Start_T : Time_Rep := Start_Date;
|
|
|
409
|
|
|
410 begin
|
|
|
411 -- Both input dates must be normalized to UTC
|
|
|
412
|
|
|
413 pragma Assert (Leap_Support and then End_Date >= Start_Date);
|
|
|
414
|
|
|
415 Next_Leap := End_Of_Time;
|
|
|
416
|
|
|
417 -- Make sure that the end date does not exceed the upper bound
|
|
|
418 -- of Ada time.
|
|
|
419
|
|
|
420 if End_Date > Ada_High then
|
|
|
421 End_T := Ada_High;
|
|
|
422 end if;
|
|
|
423
|
|
|
424 -- Remove the sub seconds from both dates
|
|
|
425
|
|
|
426 Start_T := Start_T - (Start_T mod Nano);
|
|
|
427 End_T := End_T - (End_T mod Nano);
|
|
|
428
|
|
|
429 -- Some trivial cases:
|
|
|
430 -- Leap 1 . . . Leap N
|
|
|
431 -- ---+========+------+############+-------+========+-----
|
|
|
432 -- Start_T End_T Start_T End_T
|
|
|
433
|
|
|
434 if End_T < Leap_Second_Times (1) then
|
|
|
435 Elapsed_Leaps := 0;
|
|
|
436 Next_Leap := Leap_Second_Times (1);
|
|
|
437 return;
|
|
|
438
|
|
|
439 elsif Start_T > Leap_Second_Times (Leap_Seconds_Count) then
|
|
|
440 Elapsed_Leaps := 0;
|
|
|
441 Next_Leap := End_Of_Time;
|
|
|
442 return;
|
|
|
443 end if;
|
|
|
444
|
|
|
445 -- Perform the calculations only if the start date is within the leap
|
|
|
446 -- second occurrences table.
|
|
|
447
|
|
|
448 if Start_T <= Leap_Second_Times (Leap_Seconds_Count) then
|
|
|
449
|
|
|
450 -- 1 2 N - 1 N
|
|
|
451 -- +----+----+-- . . . --+-------+---+
|
|
|
452 -- | T1 | T2 | | N - 1 | N |
|
|
|
453 -- +----+----+-- . . . --+-------+---+
|
|
|
454 -- ^ ^
|
|
|
455 -- | Start_Index | End_Index
|
|
|
456 -- +-------------------+
|
|
|
457 -- Leaps_Between
|
|
|
458
|
|
|
459 -- The idea behind the algorithm is to iterate and find two
|
|
|
460 -- closest dates which are after Start_T and End_T. Their
|
|
|
461 -- corresponding index difference denotes the number of leap
|
|
|
462 -- seconds elapsed.
|
|
|
463
|
|
|
464 Start_Index := 1;
|
|
|
465 loop
|
|
|
466 exit when Leap_Second_Times (Start_Index) >= Start_T;
|
|
|
467 Start_Index := Start_Index + 1;
|
|
|
468 end loop;
|
|
|
469
|
|
|
470 End_Index := Start_Index;
|
|
|
471 loop
|
|
|
472 exit when End_Index > Leap_Seconds_Count
|
|
|
473 or else Leap_Second_Times (End_Index) >= End_T;
|
|
|
474 End_Index := End_Index + 1;
|
|
|
475 end loop;
|
|
|
476
|
|
|
477 if End_Index <= Leap_Seconds_Count then
|
|
|
478 Next_Leap := Leap_Second_Times (End_Index);
|
|
|
479 end if;
|
|
|
480
|
|
|
481 Elapsed_Leaps := End_Index - Start_Index;
|
|
|
482
|
|
|
483 else
|
|
|
484 Elapsed_Leaps := 0;
|
|
|
485 end if;
|
|
|
486 end Cumulative_Leap_Seconds;
|
|
|
487
|
|
|
488 ---------
|
|
|
489 -- Day --
|
|
|
490 ---------
|
|
|
491
|
|
|
492 function Day (Date : Time) return Day_Number is
|
|
|
493 D : Day_Number;
|
|
|
494 Y : Year_Number;
|
|
|
495 M : Month_Number;
|
|
|
496 S : Day_Duration;
|
|
|
497 pragma Unreferenced (Y, M, S);
|
|
|
498 begin
|
|
|
499 Split (Date, Y, M, D, S);
|
|
|
500 return D;
|
|
|
501 end Day;
|
|
|
502
|
|
131
|
503 ------------------
|
|
|
504 -- Epoch_Offset --
|
|
|
505 ------------------
|
|
|
506
|
|
|
507 function Epoch_Offset return Time_Rep is
|
|
|
508 begin
|
|
|
509 return (136 * 365 + 44 * 366) * Nanos_In_Day;
|
|
|
510 end Epoch_Offset;
|
|
|
511
|
|
111
|
512 -------------
|
|
|
513 -- Is_Leap --
|
|
|
514 -------------
|
|
|
515
|
|
|
516 function Is_Leap (Year : Year_Number) return Boolean is
|
|
|
517 begin
|
|
|
518 -- Leap centennial years
|
|
|
519
|
|
|
520 if Year mod 400 = 0 then
|
|
|
521 return True;
|
|
|
522
|
|
|
523 -- Non-leap centennial years
|
|
|
524
|
|
|
525 elsif Year mod 100 = 0 then
|
|
|
526 return False;
|
|
|
527
|
|
|
528 -- Regular years
|
|
|
529
|
|
|
530 else
|
|
|
531 return Year mod 4 = 0;
|
|
|
532 end if;
|
|
|
533 end Is_Leap;
|
|
|
534
|
|
|
535 -----------
|
|
|
536 -- Month --
|
|
|
537 -----------
|
|
|
538
|
|
|
539 function Month (Date : Time) return Month_Number is
|
|
|
540 Y : Year_Number;
|
|
|
541 M : Month_Number;
|
|
|
542 D : Day_Number;
|
|
|
543 S : Day_Duration;
|
|
|
544 pragma Unreferenced (Y, D, S);
|
|
|
545 begin
|
|
|
546 Split (Date, Y, M, D, S);
|
|
|
547 return M;
|
|
|
548 end Month;
|
|
|
549
|
|
|
550 -------------
|
|
|
551 -- Seconds --
|
|
|
552 -------------
|
|
|
553
|
|
|
554 function Seconds (Date : Time) return Day_Duration is
|
|
|
555 Y : Year_Number;
|
|
|
556 M : Month_Number;
|
|
|
557 D : Day_Number;
|
|
|
558 S : Day_Duration;
|
|
|
559 pragma Unreferenced (Y, M, D);
|
|
|
560 begin
|
|
|
561 Split (Date, Y, M, D, S);
|
|
|
562 return S;
|
|
|
563 end Seconds;
|
|
|
564
|
|
|
565 -----------
|
|
|
566 -- Split --
|
|
|
567 -----------
|
|
|
568
|
|
|
569 procedure Split
|
|
|
570 (Date : Time;
|
|
|
571 Year : out Year_Number;
|
|
|
572 Month : out Month_Number;
|
|
|
573 Day : out Day_Number;
|
|
|
574 Seconds : out Day_Duration)
|
|
|
575 is
|
|
|
576 H : Integer;
|
|
|
577 M : Integer;
|
|
|
578 Se : Integer;
|
|
|
579 Ss : Duration;
|
|
|
580 Le : Boolean;
|
|
|
581
|
|
|
582 pragma Unreferenced (H, M, Se, Ss, Le);
|
|
|
583
|
|
|
584 begin
|
|
|
585 -- Even though the input time zone is UTC (0), the flag Use_TZ will
|
|
|
586 -- ensure that Split picks up the local time zone.
|
|
|
587
|
|
|
588 Formatting_Operations.Split
|
|
|
589 (Date => Date,
|
|
|
590 Year => Year,
|
|
|
591 Month => Month,
|
|
|
592 Day => Day,
|
|
|
593 Day_Secs => Seconds,
|
|
|
594 Hour => H,
|
|
|
595 Minute => M,
|
|
|
596 Second => Se,
|
|
|
597 Sub_Sec => Ss,
|
|
|
598 Leap_Sec => Le,
|
|
|
599 Use_TZ => False,
|
|
|
600 Is_Historic => True,
|
|
|
601 Time_Zone => 0);
|
|
|
602
|
|
|
603 -- Validity checks
|
|
|
604
|
|
|
605 if not Year'Valid or else
|
|
|
606 not Month'Valid or else
|
|
|
607 not Day'Valid or else
|
|
|
608 not Seconds'Valid
|
|
|
609 then
|
|
|
610 raise Time_Error;
|
|
|
611 end if;
|
|
|
612 end Split;
|
|
|
613
|
|
|
614 -------------
|
|
|
615 -- Time_Of --
|
|
|
616 -------------
|
|
|
617
|
|
|
618 function Time_Of
|
|
|
619 (Year : Year_Number;
|
|
|
620 Month : Month_Number;
|
|
|
621 Day : Day_Number;
|
|
|
622 Seconds : Day_Duration := 0.0) return Time
|
|
|
623 is
|
|
|
624 -- The values in the following constants are irrelevant, they are just
|
|
|
625 -- placeholders; the choice of constructing a Day_Duration value is
|
|
|
626 -- controlled by the Use_Day_Secs flag.
|
|
|
627
|
|
|
628 H : constant Integer := 1;
|
|
|
629 M : constant Integer := 1;
|
|
|
630 Se : constant Integer := 1;
|
|
|
631 Ss : constant Duration := 0.1;
|
|
|
632
|
|
|
633 begin
|
|
|
634 -- Validity checks
|
|
|
635
|
|
|
636 if not Year'Valid or else
|
|
|
637 not Month'Valid or else
|
|
|
638 not Day'Valid or else
|
|
|
639 not Seconds'Valid
|
|
|
640 then
|
|
|
641 raise Time_Error;
|
|
|
642 end if;
|
|
|
643
|
|
|
644 -- Even though the input time zone is UTC (0), the flag Use_TZ will
|
|
|
645 -- ensure that Split picks up the local time zone.
|
|
|
646
|
|
|
647 return
|
|
|
648 Formatting_Operations.Time_Of
|
|
|
649 (Year => Year,
|
|
|
650 Month => Month,
|
|
|
651 Day => Day,
|
|
|
652 Day_Secs => Seconds,
|
|
|
653 Hour => H,
|
|
|
654 Minute => M,
|
|
|
655 Second => Se,
|
|
|
656 Sub_Sec => Ss,
|
|
|
657 Leap_Sec => False,
|
|
|
658 Use_Day_Secs => True,
|
|
|
659 Use_TZ => False,
|
|
|
660 Is_Historic => True,
|
|
|
661 Time_Zone => 0);
|
|
|
662 end Time_Of;
|
|
|
663
|
|
|
664 ---------------------
|
|
|
665 -- UTC_Time_Offset --
|
|
|
666 ---------------------
|
|
|
667
|
|
|
668 function UTC_Time_Offset
|
|
|
669 (Date : Time;
|
|
|
670 Is_Historic : Boolean) return Long_Integer
|
|
|
671 is
|
|
|
672 -- The following constants denote February 28 during non-leap centennial
|
|
|
673 -- years, the units are nanoseconds.
|
|
|
674
|
|
|
675 T_2100_2_28 : constant Time_Rep := Ada_Low +
|
|
|
676 (Time_Rep (49 * 366 + 150 * 365 + 59) * Secs_In_Day +
|
|
|
677 Time_Rep (Leap_Seconds_Count)) * Nano;
|
|
|
678
|
|
|
679 T_2200_2_28 : constant Time_Rep := Ada_Low +
|
|
|
680 (Time_Rep (73 * 366 + 226 * 365 + 59) * Secs_In_Day +
|
|
|
681 Time_Rep (Leap_Seconds_Count)) * Nano;
|
|
|
682
|
|
|
683 T_2300_2_28 : constant Time_Rep := Ada_Low +
|
|
|
684 (Time_Rep (97 * 366 + 302 * 365 + 59) * Secs_In_Day +
|
|
|
685 Time_Rep (Leap_Seconds_Count)) * Nano;
|
|
|
686
|
|
|
687 -- 56 years (14 leap years + 42 non-leap years) in nanoseconds:
|
|
|
688
|
|
|
689 Nanos_In_56_Years : constant := (14 * 366 + 42 * 365) * Nanos_In_Day;
|
|
|
690
|
|
|
691 type int_Pointer is access all Interfaces.C.int;
|
|
|
692 type long_Pointer is access all Interfaces.C.long;
|
|
|
693
|
|
|
694 type time_t is
|
|
|
695 range -(2 ** (Standard'Address_Size - Integer'(1))) ..
|
|
|
696 +(2 ** (Standard'Address_Size - Integer'(1)) - 1);
|
|
|
697 type time_t_Pointer is access all time_t;
|
|
|
698
|
|
|
699 procedure localtime_tzoff
|
|
|
700 (timer : time_t_Pointer;
|
|
|
701 is_historic : int_Pointer;
|
|
|
702 off : long_Pointer);
|
|
|
703 pragma Import (C, localtime_tzoff, "__gnat_localtime_tzoff");
|
|
|
704 -- This routine is a interfacing wrapper around the library function
|
|
|
705 -- __gnat_localtime_tzoff. Parameter 'timer' represents a Unix-based
|
|
|
706 -- time equivalent of the input date. If flag 'is_historic' is set, this
|
|
|
707 -- routine would try to calculate to the best of the OS's abilities the
|
|
|
708 -- time zone offset that was or will be in effect on 'timer'. If the
|
|
|
709 -- flag is set to False, the routine returns the current time zone
|
|
|
710 -- regardless of what 'timer' designates. Parameter 'off' captures the
|
|
|
711 -- UTC offset of 'timer'.
|
|
|
712
|
|
|
713 Adj_Cent : Integer;
|
|
|
714 Date_N : Time_Rep;
|
|
|
715 Flag : aliased Interfaces.C.int;
|
|
|
716 Offset : aliased Interfaces.C.long;
|
|
|
717 Secs_T : aliased time_t;
|
|
|
718
|
|
|
719 -- Start of processing for UTC_Time_Offset
|
|
|
720
|
|
|
721 begin
|
|
|
722 Date_N := Time_Rep (Date);
|
|
|
723
|
|
|
724 -- Dates which are 56 years apart fall on the same day, day light saving
|
|
|
725 -- and so on. Non-leap centennial years violate this rule by one day and
|
|
|
726 -- as a consequence, special adjustment is needed.
|
|
|
727
|
|
|
728 Adj_Cent :=
|
|
|
729 (if Date_N <= T_2100_2_28 then 0
|
|
|
730 elsif Date_N <= T_2200_2_28 then 1
|
|
|
731 elsif Date_N <= T_2300_2_28 then 2
|
|
|
732 else 3);
|
|
|
733
|
|
|
734 if Adj_Cent > 0 then
|
|
|
735 Date_N := Date_N - Time_Rep (Adj_Cent) * Nanos_In_Day;
|
|
|
736 end if;
|
|
|
737
|
|
|
738 -- Shift the date within bounds of Unix time
|
|
|
739
|
|
|
740 while Date_N < Unix_Min loop
|
|
|
741 Date_N := Date_N + Nanos_In_56_Years;
|
|
|
742 end loop;
|
|
|
743
|
|
|
744 while Date_N >= Unix_Max loop
|
|
|
745 Date_N := Date_N - Nanos_In_56_Years;
|
|
|
746 end loop;
|
|
|
747
|
|
|
748 -- Perform a shift in origins from Ada to Unix
|
|
|
749
|
|
|
750 Date_N := Date_N - Unix_Min;
|
|
|
751
|
|
|
752 -- Convert the date into seconds
|
|
|
753
|
|
|
754 Secs_T := time_t (Date_N / Nano);
|
|
|
755
|
|
|
756 -- Determine whether to treat the input date as historical or not. A
|
|
|
757 -- value of "0" signifies that the date is NOT historic.
|
|
|
758
|
|
|
759 Flag := (if Is_Historic then 1 else 0);
|
|
|
760
|
|
|
761 localtime_tzoff
|
|
|
762 (Secs_T'Unchecked_Access,
|
|
|
763 Flag'Unchecked_Access,
|
|
|
764 Offset'Unchecked_Access);
|
|
|
765
|
|
|
766 return Long_Integer (Offset);
|
|
|
767 end UTC_Time_Offset;
|
|
|
768
|
|
|
769 ----------
|
|
|
770 -- Year --
|
|
|
771 ----------
|
|
|
772
|
|
|
773 function Year (Date : Time) return Year_Number is
|
|
|
774 Y : Year_Number;
|
|
|
775 M : Month_Number;
|
|
|
776 D : Day_Number;
|
|
|
777 S : Day_Duration;
|
|
|
778 pragma Unreferenced (M, D, S);
|
|
|
779 begin
|
|
|
780 Split (Date, Y, M, D, S);
|
|
|
781 return Y;
|
|
|
782 end Year;
|
|
|
783
|
|
|
784 -- The following packages assume that Time is a signed 64 bit integer
|
|
|
785 -- type, the units are nanoseconds and the origin is the start of Ada
|
|
|
786 -- time (1901-01-01 00:00:00.0 UTC).
|
|
|
787
|
|
|
788 ---------------------------
|
|
|
789 -- Arithmetic_Operations --
|
|
|
790 ---------------------------
|
|
|
791
|
|
|
792 package body Arithmetic_Operations is
|
|
|
793
|
|
|
794 ---------
|
|
|
795 -- Add --
|
|
|
796 ---------
|
|
|
797
|
|
|
798 function Add (Date : Time; Days : Long_Integer) return Time is
|
|
|
799 pragma Unsuppress (Overflow_Check);
|
|
|
800 Date_N : constant Time_Rep := Time_Rep (Date);
|
|
|
801 begin
|
|
|
802 return Time (Date_N + Time_Rep (Days) * Nanos_In_Day);
|
|
|
803 exception
|
|
|
804 when Constraint_Error =>
|
|
|
805 raise Time_Error;
|
|
|
806 end Add;
|
|
|
807
|
|
|
808 ----------------
|
|
|
809 -- Difference --
|
|
|
810 ----------------
|
|
|
811
|
|
|
812 procedure Difference
|
|
|
813 (Left : Time;
|
|
|
814 Right : Time;
|
|
|
815 Days : out Long_Integer;
|
|
|
816 Seconds : out Duration;
|
|
|
817 Leap_Seconds : out Integer)
|
|
|
818 is
|
|
|
819 Res_Dur : Time_Dur;
|
|
|
820 Earlier : Time_Rep;
|
|
|
821 Elapsed_Leaps : Natural;
|
|
|
822 Later : Time_Rep;
|
|
|
823 Negate : Boolean := False;
|
|
|
824 Next_Leap_N : Time_Rep;
|
|
|
825 Sub_Secs : Duration;
|
|
|
826 Sub_Secs_Diff : Time_Rep;
|
|
|
827
|
|
|
828 begin
|
|
|
829 -- Both input time values are assumed to be in UTC
|
|
|
830
|
|
|
831 if Left >= Right then
|
|
|
832 Later := Time_Rep (Left);
|
|
|
833 Earlier := Time_Rep (Right);
|
|
|
834 else
|
|
|
835 Later := Time_Rep (Right);
|
|
|
836 Earlier := Time_Rep (Left);
|
|
|
837 Negate := True;
|
|
|
838 end if;
|
|
|
839
|
|
|
840 -- If the target supports leap seconds, process them
|
|
|
841
|
|
|
842 if Leap_Support then
|
|
|
843 Cumulative_Leap_Seconds
|
|
|
844 (Earlier, Later, Elapsed_Leaps, Next_Leap_N);
|
|
|
845
|
|
|
846 if Later >= Next_Leap_N then
|
|
|
847 Elapsed_Leaps := Elapsed_Leaps + 1;
|
|
|
848 end if;
|
|
|
849
|
|
|
850 -- The target does not support leap seconds
|
|
|
851
|
|
|
852 else
|
|
|
853 Elapsed_Leaps := 0;
|
|
|
854 end if;
|
|
|
855
|
|
|
856 -- Sub seconds processing. We add the resulting difference to one
|
|
|
857 -- of the input dates in order to account for any potential rounding
|
|
|
858 -- of the difference in the next step.
|
|
|
859
|
|
|
860 Sub_Secs_Diff := Later mod Nano - Earlier mod Nano;
|
|
|
861 Earlier := Earlier + Sub_Secs_Diff;
|
|
|
862 Sub_Secs := Duration (Sub_Secs_Diff) / Nano_F;
|
|
|
863
|
|
|
864 -- Difference processing. This operation should be able to calculate
|
|
|
865 -- the difference between opposite values which are close to the end
|
|
|
866 -- and start of Ada time. To accommodate the large range, we convert
|
|
|
867 -- to seconds. This action may potentially round the two values and
|
|
|
868 -- either add or drop a second. We compensate for this issue in the
|
|
|
869 -- previous step.
|
|
|
870
|
|
|
871 Res_Dur :=
|
|
|
872 Time_Dur (Later / Nano - Earlier / Nano) - Time_Dur (Elapsed_Leaps);
|
|
|
873
|
|
|
874 Days := Long_Integer (Res_Dur / Secs_In_Day);
|
|
|
875 Seconds := Duration (Res_Dur mod Secs_In_Day) + Sub_Secs;
|
|
|
876 Leap_Seconds := Integer (Elapsed_Leaps);
|
|
|
877
|
|
|
878 if Negate then
|
|
|
879 Days := -Days;
|
|
|
880 Seconds := -Seconds;
|
|
|
881
|
|
|
882 if Leap_Seconds /= 0 then
|
|
|
883 Leap_Seconds := -Leap_Seconds;
|
|
|
884 end if;
|
|
|
885 end if;
|
|
|
886 end Difference;
|
|
|
887
|
|
|
888 --------------
|
|
|
889 -- Subtract --
|
|
|
890 --------------
|
|
|
891
|
|
|
892 function Subtract (Date : Time; Days : Long_Integer) return Time is
|
|
|
893 pragma Unsuppress (Overflow_Check);
|
|
|
894 Date_N : constant Time_Rep := Time_Rep (Date);
|
|
|
895 begin
|
|
|
896 return Time (Date_N - Time_Rep (Days) * Nanos_In_Day);
|
|
|
897 exception
|
|
|
898 when Constraint_Error =>
|
|
|
899 raise Time_Error;
|
|
|
900 end Subtract;
|
|
|
901
|
|
|
902 end Arithmetic_Operations;
|
|
|
903
|
|
|
904 ---------------------------
|
|
|
905 -- Conversion_Operations --
|
|
|
906 ---------------------------
|
|
|
907
|
|
|
908 package body Conversion_Operations is
|
|
|
909
|
|
|
910 -----------------
|
|
|
911 -- To_Ada_Time --
|
|
|
912 -----------------
|
|
|
913
|
|
|
914 function To_Ada_Time (Unix_Time : Long_Integer) return Time is
|
|
|
915 pragma Unsuppress (Overflow_Check);
|
|
|
916 Unix_Rep : constant Time_Rep := Time_Rep (Unix_Time) * Nano;
|
|
|
917 begin
|
|
|
918 return Time (Unix_Rep - Epoch_Offset);
|
|
|
919 exception
|
|
|
920 when Constraint_Error =>
|
|
|
921 raise Time_Error;
|
|
|
922 end To_Ada_Time;
|
|
|
923
|
|
|
924 -----------------
|
|
|
925 -- To_Ada_Time --
|
|
|
926 -----------------
|
|
|
927
|
|
|
928 function To_Ada_Time
|
|
|
929 (tm_year : Integer;
|
|
|
930 tm_mon : Integer;
|
|
|
931 tm_day : Integer;
|
|
|
932 tm_hour : Integer;
|
|
|
933 tm_min : Integer;
|
|
|
934 tm_sec : Integer;
|
|
|
935 tm_isdst : Integer) return Time
|
|
|
936 is
|
|
|
937 pragma Unsuppress (Overflow_Check);
|
|
|
938 Year : Year_Number;
|
|
|
939 Month : Month_Number;
|
|
|
940 Day : Day_Number;
|
|
|
941 Second : Integer;
|
|
|
942 Leap : Boolean;
|
|
|
943 Result : Time_Rep;
|
|
|
944
|
|
|
945 begin
|
|
|
946 -- Input processing
|
|
|
947
|
|
|
948 Year := Year_Number (1900 + tm_year);
|
|
|
949 Month := Month_Number (1 + tm_mon);
|
|
|
950 Day := Day_Number (tm_day);
|
|
|
951
|
|
|
952 -- Step 1: Validity checks of input values
|
|
|
953
|
|
|
954 if not Year'Valid or else not Month'Valid or else not Day'Valid
|
|
|
955 or else tm_hour not in 0 .. 24
|
|
|
956 or else tm_min not in 0 .. 59
|
|
|
957 or else tm_sec not in 0 .. 60
|
|
|
958 or else tm_isdst not in -1 .. 1
|
|
|
959 then
|
|
|
960 raise Time_Error;
|
|
|
961 end if;
|
|
|
962
|
|
|
963 -- Step 2: Potential leap second
|
|
|
964
|
|
|
965 if tm_sec = 60 then
|
|
|
966 Leap := True;
|
|
|
967 Second := 59;
|
|
|
968 else
|
|
|
969 Leap := False;
|
|
|
970 Second := tm_sec;
|
|
|
971 end if;
|
|
|
972
|
|
|
973 -- Step 3: Calculate the time value
|
|
|
974
|
|
|
975 Result :=
|
|
|
976 Time_Rep
|
|
|
977 (Formatting_Operations.Time_Of
|
|
|
978 (Year => Year,
|
|
|
979 Month => Month,
|
|
|
980 Day => Day,
|
|
|
981 Day_Secs => 0.0, -- Time is given in h:m:s
|
|
|
982 Hour => tm_hour,
|
|
|
983 Minute => tm_min,
|
|
|
984 Second => Second,
|
|
|
985 Sub_Sec => 0.0, -- No precise sub second given
|
|
|
986 Leap_Sec => Leap,
|
|
|
987 Use_Day_Secs => False, -- Time is given in h:m:s
|
|
|
988 Use_TZ => True, -- Force usage of explicit time zone
|
|
|
989 Is_Historic => True,
|
|
|
990 Time_Zone => 0)); -- Place the value in UTC
|
|
|
991
|
|
|
992 -- Step 4: Daylight Savings Time
|
|
|
993
|
|
|
994 if tm_isdst = 1 then
|
|
|
995 Result := Result + Time_Rep (3_600) * Nano;
|
|
|
996 end if;
|
|
|
997
|
|
|
998 return Time (Result);
|
|
|
999
|
|
|
1000 exception
|
|
|
1001 when Constraint_Error =>
|
|
|
1002 raise Time_Error;
|
|
|
1003 end To_Ada_Time;
|
|
|
1004
|
|
|
1005 -----------------
|
|
|
1006 -- To_Duration --
|
|
|
1007 -----------------
|
|
|
1008
|
|
|
1009 function To_Duration
|
|
|
1010 (tv_sec : Long_Integer;
|
|
|
1011 tv_nsec : Long_Integer) return Duration
|
|
|
1012 is
|
|
|
1013 pragma Unsuppress (Overflow_Check);
|
|
|
1014 begin
|
|
|
1015 return Duration (tv_sec) + Duration (tv_nsec) / Nano_F;
|
|
|
1016 end To_Duration;
|
|
|
1017
|
|
|
1018 ------------------------
|
|
|
1019 -- To_Struct_Timespec --
|
|
|
1020 ------------------------
|
|
|
1021
|
|
|
1022 procedure To_Struct_Timespec
|
|
|
1023 (D : Duration;
|
|
|
1024 tv_sec : out Long_Integer;
|
|
|
1025 tv_nsec : out Long_Integer)
|
|
|
1026 is
|
|
|
1027 pragma Unsuppress (Overflow_Check);
|
|
|
1028 Secs : Duration;
|
|
|
1029 Nano_Secs : Duration;
|
|
|
1030
|
|
|
1031 begin
|
|
|
1032 -- Seconds extraction, avoid potential rounding errors
|
|
|
1033
|
|
|
1034 Secs := D - 0.5;
|
|
|
1035 tv_sec := Long_Integer (Secs);
|
|
|
1036
|
|
|
1037 -- Nanoseconds extraction
|
|
|
1038
|
|
|
1039 Nano_Secs := D - Duration (tv_sec);
|
|
|
1040 tv_nsec := Long_Integer (Nano_Secs * Nano);
|
|
|
1041 end To_Struct_Timespec;
|
|
|
1042
|
|
|
1043 ------------------
|
|
|
1044 -- To_Struct_Tm --
|
|
|
1045 ------------------
|
|
|
1046
|
|
|
1047 procedure To_Struct_Tm
|
|
|
1048 (T : Time;
|
|
|
1049 tm_year : out Integer;
|
|
|
1050 tm_mon : out Integer;
|
|
|
1051 tm_day : out Integer;
|
|
|
1052 tm_hour : out Integer;
|
|
|
1053 tm_min : out Integer;
|
|
|
1054 tm_sec : out Integer)
|
|
|
1055 is
|
|
|
1056 pragma Unsuppress (Overflow_Check);
|
|
|
1057 Year : Year_Number;
|
|
|
1058 Month : Month_Number;
|
|
|
1059 Second : Integer;
|
|
|
1060 Day_Secs : Day_Duration;
|
|
|
1061 Sub_Sec : Duration;
|
|
|
1062 Leap_Sec : Boolean;
|
|
|
1063
|
|
|
1064 begin
|
|
|
1065 -- Step 1: Split the input time
|
|
|
1066
|
|
|
1067 Formatting_Operations.Split
|
|
|
1068 (Date => T,
|
|
|
1069 Year => Year,
|
|
|
1070 Month => Month,
|
|
|
1071 Day => tm_day,
|
|
|
1072 Day_Secs => Day_Secs,
|
|
|
1073 Hour => tm_hour,
|
|
|
1074 Minute => tm_min,
|
|
|
1075 Second => Second,
|
|
|
1076 Sub_Sec => Sub_Sec,
|
|
|
1077 Leap_Sec => Leap_Sec,
|
|
|
1078 Use_TZ => True,
|
|
|
1079 Is_Historic => False,
|
|
|
1080 Time_Zone => 0);
|
|
|
1081
|
|
|
1082 -- Step 2: Correct the year and month
|
|
|
1083
|
|
|
1084 tm_year := Year - 1900;
|
|
|
1085 tm_mon := Month - 1;
|
|
|
1086
|
|
|
1087 -- Step 3: Handle leap second occurrences
|
|
|
1088
|
|
|
1089 tm_sec := (if Leap_Sec then 60 else Second);
|
|
|
1090 end To_Struct_Tm;
|
|
|
1091
|
|
|
1092 ------------------
|
|
|
1093 -- To_Unix_Time --
|
|
|
1094 ------------------
|
|
|
1095
|
|
|
1096 function To_Unix_Time (Ada_Time : Time) return Long_Integer is
|
|
|
1097 pragma Unsuppress (Overflow_Check);
|
|
|
1098 Ada_Rep : constant Time_Rep := Time_Rep (Ada_Time);
|
|
|
1099 begin
|
|
|
1100 return Long_Integer ((Ada_Rep + Epoch_Offset) / Nano);
|
|
|
1101 exception
|
|
|
1102 when Constraint_Error =>
|
|
|
1103 raise Time_Error;
|
|
|
1104 end To_Unix_Time;
|
|
|
1105 end Conversion_Operations;
|
|
|
1106
|
|
|
1107 ----------------------
|
|
|
1108 -- Delay_Operations --
|
|
|
1109 ----------------------
|
|
|
1110
|
|
|
1111 package body Delay_Operations is
|
|
|
1112
|
|
|
1113 -----------------
|
|
|
1114 -- To_Duration --
|
|
|
1115 -----------------
|
|
|
1116
|
|
|
1117 function To_Duration (Date : Time) return Duration is
|
|
|
1118 pragma Unsuppress (Overflow_Check);
|
|
|
1119
|
|
|
1120 Safe_Ada_High : constant Time_Rep := Ada_High - Epoch_Offset;
|
|
|
1121 -- This value represents a "safe" end of time. In order to perform a
|
|
|
1122 -- proper conversion to Unix duration, we will have to shift origins
|
|
|
1123 -- at one point. For very distant dates, this means an overflow check
|
|
|
1124 -- failure. To prevent this, the function returns the "safe" end of
|
|
|
1125 -- time (roughly 2219) which is still distant enough.
|
|
|
1126
|
|
|
1127 Elapsed_Leaps : Natural;
|
|
|
1128 Next_Leap_N : Time_Rep;
|
|
|
1129 Res_N : Time_Rep;
|
|
|
1130
|
|
|
1131 begin
|
|
|
1132 Res_N := Time_Rep (Date);
|
|
|
1133
|
|
|
1134 -- Step 1: If the target supports leap seconds, remove any leap
|
|
|
1135 -- seconds elapsed up to the input date.
|
|
|
1136
|
|
|
1137 if Leap_Support then
|
|
|
1138 Cumulative_Leap_Seconds
|
|
|
1139 (Start_Of_Time, Res_N, Elapsed_Leaps, Next_Leap_N);
|
|
|
1140
|
|
|
1141 -- The input time value may fall on a leap second occurrence
|
|
|
1142
|
|
|
1143 if Res_N >= Next_Leap_N then
|
|
|
1144 Elapsed_Leaps := Elapsed_Leaps + 1;
|
|
|
1145 end if;
|
|
|
1146
|
|
|
1147 -- The target does not support leap seconds
|
|
|
1148
|
|
|
1149 else
|
|
|
1150 Elapsed_Leaps := 0;
|
|
|
1151 end if;
|
|
|
1152
|
|
|
1153 Res_N := Res_N - Time_Rep (Elapsed_Leaps) * Nano;
|
|
|
1154
|
|
|
1155 -- Step 2: Perform a shift in origins to obtain a Unix equivalent of
|
|
|
1156 -- the input. Guard against very large delay values such as the end
|
|
|
1157 -- of time since the computation will overflow.
|
|
|
1158
|
|
|
1159 Res_N := (if Res_N > Safe_Ada_High then Safe_Ada_High
|
|
|
1160 else Res_N + Epoch_Offset);
|
|
|
1161
|
|
|
1162 return Time_Rep_To_Duration (Res_N);
|
|
|
1163 end To_Duration;
|
|
|
1164
|
|
|
1165 end Delay_Operations;
|
|
|
1166
|
|
|
1167 ---------------------------
|
|
|
1168 -- Formatting_Operations --
|
|
|
1169 ---------------------------
|
|
|
1170
|
|
|
1171 package body Formatting_Operations is
|
|
|
1172
|
|
|
1173 -----------------
|
|
|
1174 -- Day_Of_Week --
|
|
|
1175 -----------------
|
|
|
1176
|
|
|
1177 function Day_Of_Week (Date : Time) return Integer is
|
|
|
1178 Date_N : constant Time_Rep := Time_Rep (Date);
|
|
|
1179 Time_Zone : constant Long_Integer := UTC_Time_Offset (Date, True);
|
|
|
1180 Ada_Low_N : Time_Rep;
|
|
|
1181 Day_Count : Long_Integer;
|
|
|
1182 Day_Dur : Time_Dur;
|
|
|
1183 High_N : Time_Rep;
|
|
|
1184 Low_N : Time_Rep;
|
|
|
1185
|
|
|
1186 begin
|
|
|
1187 -- As declared, the Ada Epoch is set in UTC. For this calculation to
|
|
|
1188 -- work properly, both the Epoch and the input date must be in the
|
|
|
1189 -- same time zone. The following places the Epoch in the input date's
|
|
|
1190 -- time zone.
|
|
|
1191
|
|
|
1192 Ada_Low_N := Ada_Low - Time_Rep (Time_Zone) * Nano;
|
|
|
1193
|
|
|
1194 if Date_N > Ada_Low_N then
|
|
|
1195 High_N := Date_N;
|
|
|
1196 Low_N := Ada_Low_N;
|
|
|
1197 else
|
|
|
1198 High_N := Ada_Low_N;
|
|
|
1199 Low_N := Date_N;
|
|
|
1200 end if;
|
|
|
1201
|
|
|
1202 -- Determine the elapsed seconds since the start of Ada time
|
|
|
1203
|
|
|
1204 Day_Dur := Time_Dur (High_N / Nano - Low_N / Nano);
|
|
|
1205
|
|
|
1206 -- Count the number of days since the start of Ada time. 1901-01-01
|
|
|
1207 -- GMT was a Tuesday.
|
|
|
1208
|
|
|
1209 Day_Count := Long_Integer (Day_Dur / Secs_In_Day) + 1;
|
|
|
1210
|
|
|
1211 return Integer (Day_Count mod 7);
|
|
|
1212 end Day_Of_Week;
|
|
|
1213
|
|
|
1214 -----------
|
|
|
1215 -- Split --
|
|
|
1216 -----------
|
|
|
1217
|
|
|
1218 procedure Split
|
|
|
1219 (Date : Time;
|
|
|
1220 Year : out Year_Number;
|
|
|
1221 Month : out Month_Number;
|
|
|
1222 Day : out Day_Number;
|
|
|
1223 Day_Secs : out Day_Duration;
|
|
|
1224 Hour : out Integer;
|
|
|
1225 Minute : out Integer;
|
|
|
1226 Second : out Integer;
|
|
|
1227 Sub_Sec : out Duration;
|
|
|
1228 Leap_Sec : out Boolean;
|
|
|
1229 Use_TZ : Boolean;
|
|
|
1230 Is_Historic : Boolean;
|
|
|
1231 Time_Zone : Long_Integer)
|
|
|
1232 is
|
|
|
1233 -- The following constants represent the number of nanoseconds
|
|
|
1234 -- elapsed since the start of Ada time to and including the non
|
|
|
1235 -- leap centennial years.
|
|
|
1236
|
|
|
1237 Year_2101 : constant Time_Rep := Ada_Low +
|
|
|
1238 Time_Rep (49 * 366 + 151 * 365) * Nanos_In_Day;
|
|
|
1239 Year_2201 : constant Time_Rep := Ada_Low +
|
|
|
1240 Time_Rep (73 * 366 + 227 * 365) * Nanos_In_Day;
|
|
|
1241 Year_2301 : constant Time_Rep := Ada_Low +
|
|
|
1242 Time_Rep (97 * 366 + 303 * 365) * Nanos_In_Day;
|
|
|
1243
|
|
|
1244 Date_Dur : Time_Dur;
|
|
|
1245 Date_N : Time_Rep;
|
|
|
1246 Day_Seconds : Natural;
|
|
|
1247 Elapsed_Leaps : Natural;
|
|
|
1248 Four_Year_Segs : Natural;
|
|
|
1249 Hour_Seconds : Natural;
|
|
|
1250 Is_Leap_Year : Boolean;
|
|
|
1251 Next_Leap_N : Time_Rep;
|
|
|
1252 Rem_Years : Natural;
|
|
|
1253 Sub_Sec_N : Time_Rep;
|
|
|
1254 Year_Day : Natural;
|
|
|
1255
|
|
|
1256 begin
|
|
|
1257 Date_N := Time_Rep (Date);
|
|
|
1258
|
|
|
1259 -- Step 1: Leap seconds processing in UTC
|
|
|
1260
|
|
|
1261 if Leap_Support then
|
|
|
1262 Cumulative_Leap_Seconds
|
|
|
1263 (Start_Of_Time, Date_N, Elapsed_Leaps, Next_Leap_N);
|
|
|
1264
|
|
|
1265 Leap_Sec := Date_N >= Next_Leap_N;
|
|
|
1266
|
|
|
1267 if Leap_Sec then
|
|
|
1268 Elapsed_Leaps := Elapsed_Leaps + 1;
|
|
|
1269 end if;
|
|
|
1270
|
|
|
1271 -- The target does not support leap seconds
|
|
|
1272
|
|
|
1273 else
|
|
|
1274 Elapsed_Leaps := 0;
|
|
|
1275 Leap_Sec := False;
|
|
|
1276 end if;
|
|
|
1277
|
|
|
1278 Date_N := Date_N - Time_Rep (Elapsed_Leaps) * Nano;
|
|
|
1279
|
|
|
1280 -- Step 2: Time zone processing. This action converts the input date
|
|
|
1281 -- from GMT to the requested time zone. Applies from Ada 2005 on.
|
|
|
1282
|
|
|
1283 if Use_TZ then
|
|
|
1284 if Time_Zone /= 0 then
|
|
|
1285 Date_N := Date_N + Time_Rep (Time_Zone) * 60 * Nano;
|
|
|
1286 end if;
|
|
|
1287
|
|
|
1288 -- Ada 83 and 95
|
|
|
1289
|
|
|
1290 else
|
|
|
1291 declare
|
|
|
1292 Off : constant Long_Integer :=
|
|
|
1293 UTC_Time_Offset (Time (Date_N), Is_Historic);
|
|
|
1294
|
|
|
1295 begin
|
|
|
1296 Date_N := Date_N + Time_Rep (Off) * Nano;
|
|
|
1297 end;
|
|
|
1298 end if;
|
|
|
1299
|
|
|
1300 -- Step 3: Non-leap centennial year adjustment in local time zone
|
|
|
1301
|
|
|
1302 -- In order for all divisions to work properly and to avoid more
|
|
|
1303 -- complicated arithmetic, we add fake February 29s to dates which
|
|
|
1304 -- occur after a non-leap centennial year.
|
|
|
1305
|
|
|
1306 if Date_N >= Year_2301 then
|
|
|
1307 Date_N := Date_N + Time_Rep (3) * Nanos_In_Day;
|
|
|
1308
|
|
|
1309 elsif Date_N >= Year_2201 then
|
|
|
1310 Date_N := Date_N + Time_Rep (2) * Nanos_In_Day;
|
|
|
1311
|
|
|
1312 elsif Date_N >= Year_2101 then
|
|
|
1313 Date_N := Date_N + Time_Rep (1) * Nanos_In_Day;
|
|
|
1314 end if;
|
|
|
1315
|
|
|
1316 -- Step 4: Sub second processing in local time zone
|
|
|
1317
|
|
|
1318 Sub_Sec_N := Date_N mod Nano;
|
|
|
1319 Sub_Sec := Duration (Sub_Sec_N) / Nano_F;
|
|
|
1320 Date_N := Date_N - Sub_Sec_N;
|
|
|
1321
|
|
|
1322 -- Convert Date_N into a time duration value, changing the units
|
|
|
1323 -- to seconds.
|
|
|
1324
|
|
|
1325 Date_Dur := Time_Dur (Date_N / Nano - Ada_Low / Nano);
|
|
|
1326
|
|
|
1327 -- Step 5: Year processing in local time zone. Determine the number
|
|
|
1328 -- of four year segments since the start of Ada time and the input
|
|
|
1329 -- date.
|
|
|
1330
|
|
|
1331 Four_Year_Segs := Natural (Date_Dur / Secs_In_Four_Years);
|
|
|
1332
|
|
|
1333 if Four_Year_Segs > 0 then
|
|
|
1334 Date_Dur := Date_Dur - Time_Dur (Four_Year_Segs) *
|
|
|
1335 Secs_In_Four_Years;
|
|
|
1336 end if;
|
|
|
1337
|
|
|
1338 -- Calculate the remaining non-leap years
|
|
|
1339
|
|
|
1340 Rem_Years := Natural (Date_Dur / Secs_In_Non_Leap_Year);
|
|
|
1341
|
|
|
1342 if Rem_Years > 3 then
|
|
|
1343 Rem_Years := 3;
|
|
|
1344 end if;
|
|
|
1345
|
|
|
1346 Date_Dur := Date_Dur - Time_Dur (Rem_Years) * Secs_In_Non_Leap_Year;
|
|
|
1347
|
|
|
1348 Year := Ada_Min_Year + Natural (4 * Four_Year_Segs + Rem_Years);
|
|
|
1349 Is_Leap_Year := Is_Leap (Year);
|
|
|
1350
|
|
|
1351 -- Step 6: Month and day processing in local time zone
|
|
|
1352
|
|
|
1353 Year_Day := Natural (Date_Dur / Secs_In_Day) + 1;
|
|
|
1354
|
|
|
1355 Month := 1;
|
|
|
1356
|
|
|
1357 -- Processing for months after January
|
|
|
1358
|
|
|
1359 if Year_Day > 31 then
|
|
|
1360 Month := 2;
|
|
|
1361 Year_Day := Year_Day - 31;
|
|
|
1362
|
|
|
1363 -- Processing for a new month or a leap February
|
|
|
1364
|
|
|
1365 if Year_Day > 28
|
|
|
1366 and then (not Is_Leap_Year or else Year_Day > 29)
|
|
|
1367 then
|
|
|
1368 Month := 3;
|
|
|
1369 Year_Day := Year_Day - 28;
|
|
|
1370
|
|
|
1371 if Is_Leap_Year then
|
|
|
1372 Year_Day := Year_Day - 1;
|
|
|
1373 end if;
|
|
|
1374
|
|
|
1375 -- Remaining months
|
|
|
1376
|
|
|
1377 while Year_Day > Days_In_Month (Month) loop
|
|
|
1378 Year_Day := Year_Day - Days_In_Month (Month);
|
|
|
1379 Month := Month + 1;
|
|
|
1380 end loop;
|
|
|
1381 end if;
|
|
|
1382 end if;
|
|
|
1383
|
|
|
1384 -- Step 7: Hour, minute, second and sub second processing in local
|
|
|
1385 -- time zone.
|
|
|
1386
|
|
|
1387 Day := Day_Number (Year_Day);
|
|
|
1388 Day_Seconds := Integer (Date_Dur mod Secs_In_Day);
|
|
|
1389 Day_Secs := Duration (Day_Seconds) + Sub_Sec;
|
|
|
1390 Hour := Day_Seconds / 3_600;
|
|
|
1391 Hour_Seconds := Day_Seconds mod 3_600;
|
|
|
1392 Minute := Hour_Seconds / 60;
|
|
|
1393 Second := Hour_Seconds mod 60;
|
|
|
1394
|
|
|
1395 exception
|
|
|
1396 when Constraint_Error =>
|
|
|
1397 raise Time_Error;
|
|
|
1398 end Split;
|
|
|
1399
|
|
|
1400 -------------
|
|
|
1401 -- Time_Of --
|
|
|
1402 -------------
|
|
|
1403
|
|
|
1404 function Time_Of
|
|
|
1405 (Year : Year_Number;
|
|
|
1406 Month : Month_Number;
|
|
|
1407 Day : Day_Number;
|
|
|
1408 Day_Secs : Day_Duration;
|
|
|
1409 Hour : Integer;
|
|
|
1410 Minute : Integer;
|
|
|
1411 Second : Integer;
|
|
|
1412 Sub_Sec : Duration;
|
|
|
1413 Leap_Sec : Boolean;
|
|
|
1414 Use_Day_Secs : Boolean;
|
|
|
1415 Use_TZ : Boolean;
|
|
|
1416 Is_Historic : Boolean;
|
|
|
1417 Time_Zone : Long_Integer) return Time
|
|
|
1418 is
|
|
|
1419 Count : Integer;
|
|
|
1420 Elapsed_Leaps : Natural;
|
|
|
1421 Next_Leap_N : Time_Rep;
|
|
|
1422 Res_N : Time_Rep;
|
|
|
1423 Rounded_Res_N : Time_Rep;
|
|
|
1424
|
|
|
1425 begin
|
|
|
1426 -- Step 1: Check whether the day, month and year form a valid date
|
|
|
1427
|
|
|
1428 if Day > Days_In_Month (Month)
|
|
|
1429 and then (Day /= 29 or else Month /= 2 or else not Is_Leap (Year))
|
|
|
1430 then
|
|
|
1431 raise Time_Error;
|
|
|
1432 end if;
|
|
|
1433
|
|
|
1434 -- Start accumulating nanoseconds from the low bound of Ada time
|
|
|
1435
|
|
|
1436 Res_N := Ada_Low;
|
|
|
1437
|
|
|
1438 -- Step 2: Year processing and centennial year adjustment. Determine
|
|
|
1439 -- the number of four year segments since the start of Ada time and
|
|
|
1440 -- the input date.
|
|
|
1441
|
|
|
1442 Count := (Year - Year_Number'First) / 4;
|
|
|
1443
|
|
|
1444 for Four_Year_Segments in 1 .. Count loop
|
|
|
1445 Res_N := Res_N + Nanos_In_Four_Years;
|
|
|
1446 end loop;
|
|
|
1447
|
|
|
1448 -- Note that non-leap centennial years are automatically considered
|
|
|
1449 -- leap in the operation above. An adjustment of several days is
|
|
|
1450 -- required to compensate for this.
|
|
|
1451
|
|
|
1452 if Year > 2300 then
|
|
|
1453 Res_N := Res_N - Time_Rep (3) * Nanos_In_Day;
|
|
|
1454
|
|
|
1455 elsif Year > 2200 then
|
|
|
1456 Res_N := Res_N - Time_Rep (2) * Nanos_In_Day;
|
|
|
1457
|
|
|
1458 elsif Year > 2100 then
|
|
|
1459 Res_N := Res_N - Time_Rep (1) * Nanos_In_Day;
|
|
|
1460 end if;
|
|
|
1461
|
|
|
1462 -- Add the remaining non-leap years
|
|
|
1463
|
|
|
1464 Count := (Year - Year_Number'First) mod 4;
|
|
|
1465 Res_N := Res_N + Time_Rep (Count) * Secs_In_Non_Leap_Year * Nano;
|
|
|
1466
|
|
|
1467 -- Step 3: Day of month processing. Determine the number of days
|
|
|
1468 -- since the start of the current year. Do not add the current
|
|
|
1469 -- day since it has not elapsed yet.
|
|
|
1470
|
|
|
1471 Count := Cumulative_Days_Before_Month (Month) + Day - 1;
|
|
|
1472
|
|
|
1473 -- The input year is leap and we have passed February
|
|
|
1474
|
|
|
1475 if Is_Leap (Year)
|
|
|
1476 and then Month > 2
|
|
|
1477 then
|
|
|
1478 Count := Count + 1;
|
|
|
1479 end if;
|
|
|
1480
|
|
|
1481 Res_N := Res_N + Time_Rep (Count) * Nanos_In_Day;
|
|
|
1482
|
|
|
1483 -- Step 4: Hour, minute, second and sub second processing
|
|
|
1484
|
|
|
1485 if Use_Day_Secs then
|
|
|
1486 Res_N := Res_N + Duration_To_Time_Rep (Day_Secs);
|
|
|
1487
|
|
|
1488 else
|
|
|
1489 Res_N :=
|
|
|
1490 Res_N + Time_Rep (Hour * 3_600 + Minute * 60 + Second) * Nano;
|
|
|
1491
|
|
|
1492 if Sub_Sec = 1.0 then
|
|
|
1493 Res_N := Res_N + Time_Rep (1) * Nano;
|
|
|
1494 else
|
|
|
1495 Res_N := Res_N + Duration_To_Time_Rep (Sub_Sec);
|
|
|
1496 end if;
|
|
|
1497 end if;
|
|
|
1498
|
|
|
1499 -- At this point, the generated time value should be withing the
|
|
|
1500 -- bounds of Ada time.
|
|
|
1501
|
|
|
1502 Check_Within_Time_Bounds (Res_N);
|
|
|
1503
|
|
|
1504 -- Step 4: Time zone processing. At this point we have built an
|
|
|
1505 -- arbitrary time value which is not related to any time zone.
|
|
|
1506 -- For simplicity, the time value is normalized to GMT, producing
|
|
|
1507 -- a uniform representation which can be treated by arithmetic
|
|
|
1508 -- operations for instance without any additional corrections.
|
|
|
1509
|
|
|
1510 if Use_TZ then
|
|
|
1511 if Time_Zone /= 0 then
|
|
|
1512 Res_N := Res_N - Time_Rep (Time_Zone) * 60 * Nano;
|
|
|
1513 end if;
|
|
|
1514
|
|
|
1515 -- Ada 83 and 95
|
|
|
1516
|
|
|
1517 else
|
|
|
1518 declare
|
|
|
1519 Cur_Off : constant Long_Integer :=
|
|
|
1520 UTC_Time_Offset (Time (Res_N), Is_Historic);
|
|
|
1521 Cur_Res_N : constant Time_Rep :=
|
|
|
1522 Res_N - Time_Rep (Cur_Off) * Nano;
|
|
|
1523 Off : constant Long_Integer :=
|
|
|
1524 UTC_Time_Offset (Time (Cur_Res_N), Is_Historic);
|
|
|
1525
|
|
|
1526 begin
|
|
|
1527 Res_N := Res_N - Time_Rep (Off) * Nano;
|
|
|
1528 end;
|
|
|
1529 end if;
|
|
|
1530
|
|
|
1531 -- Step 5: Leap seconds processing in GMT
|
|
|
1532
|
|
|
1533 if Leap_Support then
|
|
|
1534 Cumulative_Leap_Seconds
|
|
|
1535 (Start_Of_Time, Res_N, Elapsed_Leaps, Next_Leap_N);
|
|
|
1536
|
|
|
1537 Res_N := Res_N + Time_Rep (Elapsed_Leaps) * Nano;
|
|
|
1538
|
|
|
1539 -- An Ada 2005 caller requesting an explicit leap second or an
|
|
|
1540 -- Ada 95 caller accounting for an invisible leap second.
|
|
|
1541
|
|
|
1542 if Leap_Sec or else Res_N >= Next_Leap_N then
|
|
|
1543 Res_N := Res_N + Time_Rep (1) * Nano;
|
|
|
1544 end if;
|
|
|
1545
|
|
|
1546 -- Leap second validity check
|
|
|
1547
|
|
|
1548 Rounded_Res_N := Res_N - (Res_N mod Nano);
|
|
|
1549
|
|
|
1550 if Use_TZ
|
|
|
1551 and then Leap_Sec
|
|
|
1552 and then Rounded_Res_N /= Next_Leap_N
|
|
|
1553 then
|
|
|
1554 raise Time_Error;
|
|
|
1555 end if;
|
|
|
1556 end if;
|
|
|
1557
|
|
|
1558 return Time (Res_N);
|
|
|
1559 end Time_Of;
|
|
|
1560
|
|
|
1561 end Formatting_Operations;
|
|
|
1562
|
|
|
1563 ---------------------------
|
|
|
1564 -- Time_Zones_Operations --
|
|
|
1565 ---------------------------
|
|
|
1566
|
|
|
1567 package body Time_Zones_Operations is
|
|
|
1568
|
|
|
1569 ---------------------
|
|
|
1570 -- UTC_Time_Offset --
|
|
|
1571 ---------------------
|
|
|
1572
|
|
|
1573 function UTC_Time_Offset (Date : Time) return Long_Integer is
|
|
|
1574 begin
|
|
|
1575 return UTC_Time_Offset (Date, True);
|
|
|
1576 end UTC_Time_Offset;
|
|
|
1577
|
|
|
1578 end Time_Zones_Operations;
|
|
|
1579
|
|
|
1580 -- Start of elaboration code for Ada.Calendar
|
|
|
1581
|
|
|
1582 begin
|
|
|
1583 System.OS_Primitives.Initialize;
|
|
|
1584
|
|
|
1585 end Ada.Calendar;
|
