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
);