1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . C A L E N D A R --
11 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- As a special exception, if other files instantiate generics from this --
25 -- unit, or you link this unit with other files to produce an executable, --
26 -- this unit does not by itself cause the resulting executable to be --
27 -- covered by the GNU General Public License. This exception does not --
28 -- however invalidate any other reasons why the executable file might be --
29 -- covered by the GNU Public License. --
31 -- GNAT was originally developed by the GNAT team at New York University. --
32 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
34 ------------------------------------------------------------------------------
36 with Unchecked_Conversion;
38 with System.OS_Primitives;
41 package body Ada.Calendar is
43 ------------------------------
44 -- Use of Pragma Unsuppress --
45 ------------------------------
47 -- This implementation of Calendar takes advantage of the permission in
48 -- Ada 95 of using arithmetic overflow checks to check for out of bounds
49 -- time values. This means that we must catch the constraint error that
50 -- results from arithmetic overflow, so we use pragma Unsuppress to make
51 -- sure that overflow is enabled, using software overflow checking if
52 -- necessary. That way, compiling Calendar with options to suppress this
53 -- checking will not affect its correctness.
55 ------------------------
56 -- Local Declarations --
57 ------------------------
59 type Char_Pointer is access Character;
60 subtype int is Integer;
61 subtype long is Long_Integer;
62 -- Synonyms for C types. We don't want to get them from Interfaces.C
63 -- because there is no point in loading that unit just for calendar.
66 tm_sec : int; -- seconds after the minute (0 .. 60)
67 tm_min : int; -- minutes after the hour (0 .. 59)
68 tm_hour : int; -- hours since midnight (0 .. 24)
69 tm_mday : int; -- day of the month (1 .. 31)
70 tm_mon : int; -- months since January (0 .. 11)
71 tm_year : int; -- years since 1900
72 tm_wday : int; -- days since Sunday (0 .. 6)
73 tm_yday : int; -- days since January 1 (0 .. 365)
74 tm_isdst : int; -- Daylight Savings Time flag (-1 .. +1)
75 tm_gmtoff : long; -- offset from CUT in seconds
76 tm_zone : Char_Pointer; -- timezone abbreviation
79 type tm_Pointer is access all tm;
81 subtype time_t is long;
83 type time_t_Pointer is access all time_t;
85 procedure localtime_r (C : time_t_Pointer; res : tm_Pointer);
86 pragma Import (C, localtime_r, "__gnat_localtime_r");
88 function mktime (TM : tm_Pointer) return time_t;
89 pragma Import (C, mktime);
90 -- mktime returns -1 in case the calendar time given by components of
91 -- TM.all cannot be represented.
93 -- The following constants are used in adjusting Ada dates so that they
94 -- fit into the range that can be handled by Unix (1970 - 2038). The trick
95 -- is that the number of days in any four year period in the Ada range of
96 -- years (1901 - 2099) has a constant number of days. This is because we
97 -- have the special case of 2000 which, contrary to the normal exception
98 -- for centuries, is a leap year after all.
100 Unix_Year_Min : constant := 1970;
101 Unix_Year_Max : constant := 2038;
103 Ada_Year_Min : constant := 1901;
104 Ada_Year_Max : constant := 2099;
106 -- Some basic constants used throughout
108 Days_In_Month : constant array (Month_Number) of Day_Number :=
109 (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
111 Days_In_4_Years : constant := 365 * 3 + 366;
112 Seconds_In_4_Years : constant := 86_400 * Days_In_4_Years;
113 Seconds_In_4_YearsD : constant Duration := Duration (Seconds_In_4_Years);
119 function "+" (Left : Time; Right : Duration) return Time is
120 pragma Unsuppress (Overflow_Check);
122 return (Left + Time (Right));
125 when Constraint_Error =>
129 function "+" (Left : Duration; Right : Time) return Time is
130 pragma Unsuppress (Overflow_Check);
132 return (Time (Left) + Right);
135 when Constraint_Error =>
143 function "-" (Left : Time; Right : Duration) return Time is
144 pragma Unsuppress (Overflow_Check);
146 return Left - Time (Right);
149 when Constraint_Error =>
153 function "-" (Left : Time; Right : Time) return Duration is
154 pragma Unsuppress (Overflow_Check);
156 return Duration (Left) - Duration (Right);
159 when Constraint_Error =>
167 function "<" (Left, Right : Time) return Boolean is
169 return Duration (Left) < Duration (Right);
176 function "<=" (Left, Right : Time) return Boolean is
178 return Duration (Left) <= Duration (Right);
185 function ">" (Left, Right : Time) return Boolean is
187 return Duration (Left) > Duration (Right);
194 function ">=" (Left, Right : Time) return Boolean is
196 return Duration (Left) >= Duration (Right);
203 function Clock return Time is
205 return Time (System.OS_Primitives.Clock);
212 function Day (Date : Time) return Day_Number is
219 Split (Date, DY, DM, DD, DS);
227 function Month (Date : Time) return Month_Number is
234 Split (Date, DY, DM, DD, DS);
242 function Seconds (Date : Time) return Day_Duration is
249 Split (Date, DY, DM, DD, DS);
259 Year : out Year_Number;
260 Month : out Month_Number;
261 Day : out Day_Number;
262 Seconds : out Day_Duration)
264 -- The following declare bounds for duration that are comfortably
265 -- wider than the maximum allowed output result for the Ada range
266 -- of representable split values. These are used for a quick check
267 -- that the value is not wildly out of range.
269 Low : constant := (Ada_Year_Min - Unix_Year_Min - 2) * 365 * 86_400;
270 High : constant := (Ada_Year_Max - Unix_Year_Min + 2) * 365 * 86_400;
272 LowD : constant Duration := Duration (Low);
273 HighD : constant Duration := Duration (High);
275 -- The following declare the maximum duration value that can be
276 -- successfully converted to a 32-bit integer suitable for passing
277 -- to the localtime_r function. Note that we cannot assume that the
278 -- localtime_r function expands to accept 64-bit input on a 64-bit
279 -- machine, but we can count on a 32-bit range on all machines.
281 Max_Time : constant := 2 ** 31 - 1;
282 Max_TimeD : constant Duration := Duration (Max_Time);
284 -- Finally the actual variables used in the computation
289 Adjusted_Seconds : aliased time_t;
293 -- For us a time is simply a signed duration value, so we work with
294 -- this duration value directly. Note that it can be negative.
296 D := Duration (Date);
298 -- First of all, filter out completely ludicrous values. Remember
299 -- that we use the full stored range of duration values, which may
300 -- be significantly larger than the allowed range of Ada times. Note
301 -- that these checks are wider than required to make absolutely sure
302 -- that there are no end effects from time zone differences.
304 if D < LowD or else D > HighD then
308 -- The unix localtime_r function is more or less exactly what we need
309 -- here. The less comes from the fact that it does not support the
310 -- required range of years (the guaranteed range available is only
311 -- EPOCH through EPOCH + N seconds). N is in practice 2 ** 31 - 1.
313 -- If we have a value outside this range, then we first adjust it
314 -- to be in the required range by adding multiples of four years.
315 -- For the range we are interested in, the number of days in any
316 -- consecutive four year period is constant. Then we do the split
317 -- on the adjusted value, and readjust the years value accordingly.
322 D := D + Seconds_In_4_YearsD;
323 Year_Val := Year_Val - 4;
326 while D > Max_TimeD loop
327 D := D - Seconds_In_4_YearsD;
328 Year_Val := Year_Val + 4;
331 -- Now we need to take the value D, which is now non-negative, and
332 -- break it down into seconds (to pass to the localtime_r function)
333 -- and fractions of seconds (for the adjustment below).
335 -- Surprisingly there is no easy way to do this in Ada, and certainly
336 -- no easy way to do it and generate efficient code. Therefore we
337 -- do it at a low level, knowing that it is really represented as
338 -- an integer with units of Small
341 type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
342 for D_Int'Size use Duration'Size;
344 Small_Div : constant D_Int := D_Int (1.0 / Duration'Small);
347 function To_D_As_Int is new Unchecked_Conversion (Duration, D_Int);
348 function To_Duration is new Unchecked_Conversion (D_Int, Duration);
351 D_As_Int := To_D_As_Int (D);
352 Adjusted_Seconds := time_t (D_As_Int / Small_Div);
353 Frac_Sec := To_Duration (D_As_Int rem Small_Div);
356 localtime_r (Adjusted_Seconds'Unchecked_Access, Tm_Val'Unchecked_Access);
358 Year_Val := Tm_Val.tm_year + 1900 + Year_Val;
359 Month := Tm_Val.tm_mon + 1;
360 Day := Tm_Val.tm_mday;
362 -- The Seconds value is a little complex. The localtime function
363 -- returns the integral number of seconds, which is what we want,
364 -- but we want to retain the fractional part from the original
365 -- Time value, since this is typically stored more accurately.
367 Seconds := Duration (Tm_Val.tm_hour * 3600 +
372 -- Note: the above expression is pretty horrible, one of these days
373 -- we should stop using time_of and do everything ourselves to avoid
374 -- these unnecessary divides and multiplies???.
376 -- The Year may still be out of range, since our entry test was
377 -- deliberately crude. Trying to make this entry test accurate is
378 -- tricky due to time zone adjustment issues affecting the exact
379 -- boundary. It is interesting to note that whether or not a given
380 -- Calendar.Time value gets Time_Error when split depends on the
381 -- current time zone setting.
383 if Year_Val not in Ada_Year_Min .. Ada_Year_Max then
396 Month : Month_Number;
398 Seconds : Day_Duration := 0.0)
401 Result_Secs : aliased time_t;
403 Int_Secs : constant Integer := Integer (Seconds);
405 Year_Val : Integer := Year;
406 Duration_Adjust : Duration := 0.0;
409 -- The following checks are redundant with respect to the constraint
410 -- error checks that should normally be made on parameters, but we
411 -- decide to raise Constraint_Error in any case if bad values come
412 -- in (as a result of checks being off in the caller, or for other
413 -- erroneous or bounded error cases).
416 or else not Month 'Valid
417 or else not Day 'Valid
418 or else not Seconds'Valid
420 raise Constraint_Error;
423 -- Check for Day value too large (one might expect mktime to do this
424 -- check, as well as the basi checks we did with 'Valid, but it seems
425 -- that at least on some systems, this built-in check is too weak).
427 if Day > Days_In_Month (Month)
428 and then (Day /= 29 or Month /= 2 or Year mod 4 /= 0)
433 TM_Val.tm_sec := Int_Secs mod 60;
434 TM_Val.tm_min := (Int_Secs / 60) mod 60;
435 TM_Val.tm_hour := (Int_Secs / 60) / 60;
436 TM_Val.tm_mday := Day;
437 TM_Val.tm_mon := Month - 1;
439 -- For the year, we have to adjust it to a year that Unix can handle.
440 -- We do this in four year steps, since the number of days in four
441 -- years is constant, so the timezone effect on the conversion from
442 -- local time to GMT is unaffected.
444 while Year_Val <= Unix_Year_Min loop
445 Year_Val := Year_Val + 4;
446 Duration_Adjust := Duration_Adjust - Seconds_In_4_YearsD;
449 while Year_Val >= Unix_Year_Max loop
450 Year_Val := Year_Val - 4;
451 Duration_Adjust := Duration_Adjust + Seconds_In_4_YearsD;
454 TM_Val.tm_year := Year_Val - 1900;
456 -- Since we do not have information on daylight savings,
457 -- rely on the default information.
459 TM_Val.tm_isdst := -1;
460 Result_Secs := mktime (TM_Val'Unchecked_Access);
462 -- That gives us the basic value in seconds. Two adjustments are
463 -- needed. First we must undo the year adjustment carried out above.
464 -- Second we put back the fraction seconds value since in general the
465 -- Day_Duration value we received has additional precision which we
466 -- do not want to lose in the constructed result.
469 Time (Duration (Result_Secs) +
471 (Seconds - Duration (Int_Secs)));
479 function Year (Date : Time) return Year_Number is
486 Split (Date, DY, DM, DD, DS);