+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- A D A . C A L E N D A R --
--- --
--- B o d y --
--- --
--- $Revision: 1.1.16.1 $
--- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
--- --
--- GNAT is free software; you can redistribute it and/or modify it under --
--- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
--- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
-with Unchecked_Conversion;
-
-with System.OS_Primitives;
--- used for Clock
-
-package body Ada.Calendar is
-
- ------------------------------
- -- Use of Pragma Unsuppress --
- ------------------------------
-
- -- This implementation of Calendar takes advantage of the permission in
- -- Ada 95 of using arithmetic overflow checks to check for out of bounds
- -- time values. This means that we must catch the constraint error that
- -- results from arithmetic overflow, so we use pragma Unsuppress to make
- -- sure that overflow is enabled, using software overflow checking if
- -- necessary. That way, compiling Calendar with options to suppress this
- -- checking will not affect its correctness.
-
- ------------------------
- -- Local Declarations --
- ------------------------
-
- type Char_Pointer is access Character;
- subtype int is Integer;
- subtype long is Long_Integer;
- -- Synonyms for C types. We don't want to get them from Interfaces.C
- -- because there is no point in loading that unit just for calendar.
-
- type tm is record
- tm_sec : int; -- seconds after the minute (0 .. 60)
- tm_min : int; -- minutes after the hour (0 .. 59)
- tm_hour : int; -- hours since midnight (0 .. 24)
- tm_mday : int; -- day of the month (1 .. 31)
- tm_mon : int; -- months since January (0 .. 11)
- tm_year : int; -- years since 1900
- tm_wday : int; -- days since Sunday (0 .. 6)
- tm_yday : int; -- days since January 1 (0 .. 365)
- tm_isdst : int; -- Daylight Savings Time flag (-1 .. +1)
- tm_gmtoff : long; -- offset from CUT in seconds
- tm_zone : Char_Pointer; -- timezone abbreviation
- end record;
-
- type tm_Pointer is access all tm;
-
- subtype time_t is long;
-
- type time_t_Pointer is access all time_t;
-
- procedure localtime_r (C : time_t_Pointer; res : tm_Pointer);
- pragma Import (C, localtime_r, "__gnat_localtime_r");
-
- function mktime (TM : tm_Pointer) return time_t;
- pragma Import (C, mktime);
- -- mktime returns -1 in case the calendar time given by components of
- -- TM.all cannot be represented.
-
- -- The following constants are used in adjusting Ada dates so that they
- -- fit into the range that can be handled by Unix (1970 - 2038). The trick
- -- is that the number of days in any four year period in the Ada range of
- -- years (1901 - 2099) has a constant number of days. This is because we
- -- have the special case of 2000 which, contrary to the normal exception
- -- for centuries, is a leap year after all.
-
- Unix_Year_Min : constant := 1970;
- Unix_Year_Max : constant := 2038;
-
- Ada_Year_Min : constant := 1901;
- Ada_Year_Max : constant := 2099;
-
- -- Some basic constants used throughout
-
- Days_In_Month : constant array (Month_Number) of Day_Number :=
- (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
-
- Days_In_4_Years : constant := 365 * 3 + 366;
- Seconds_In_4_Years : constant := 86_400 * Days_In_4_Years;
- Seconds_In_4_YearsD : constant Duration := Duration (Seconds_In_4_Years);
-
- ---------
- -- "+" --
- ---------
-
- function "+" (Left : Time; Right : Duration) return Time is
- pragma Unsuppress (Overflow_Check);
- begin
- return (Left + Time (Right));
-
- exception
- when Constraint_Error =>
- raise Time_Error;
- end "+";
-
- function "+" (Left : Duration; Right : Time) return Time is
- pragma Unsuppress (Overflow_Check);
- begin
- return (Time (Left) + Right);
-
- exception
- when Constraint_Error =>
- raise Time_Error;
- end "+";
-
- ---------
- -- "-" --
- ---------
-
- function "-" (Left : Time; Right : Duration) return Time is
- pragma Unsuppress (Overflow_Check);
- begin
- return Left - Time (Right);
-
- exception
- when Constraint_Error =>
- raise Time_Error;
- end "-";
-
- function "-" (Left : Time; Right : Time) return Duration is
- pragma Unsuppress (Overflow_Check);
- begin
- return Duration (Left) - Duration (Right);
-
- exception
- when Constraint_Error =>
- raise Time_Error;
- end "-";
-
- ---------
- -- "<" --
- ---------
-
- function "<" (Left, Right : Time) return Boolean is
- begin
- return Duration (Left) < Duration (Right);
- end "<";
-
- ----------
- -- "<=" --
- ----------
-
- function "<=" (Left, Right : Time) return Boolean is
- begin
- return Duration (Left) <= Duration (Right);
- end "<=";
-
- ---------
- -- ">" --
- ---------
-
- function ">" (Left, Right : Time) return Boolean is
- begin
- return Duration (Left) > Duration (Right);
- end ">";
-
- ----------
- -- ">=" --
- ----------
-
- function ">=" (Left, Right : Time) return Boolean is
- begin
- return Duration (Left) >= Duration (Right);
- end ">=";
-
- -----------
- -- Clock --
- -----------
-
- function Clock return Time is
- begin
- return Time (System.OS_Primitives.Clock);
- end Clock;
-
- ---------
- -- Day --
- ---------
-
- function Day (Date : Time) return Day_Number is
- DY : Year_Number;
- DM : Month_Number;
- DD : Day_Number;
- DS : Day_Duration;
-
- begin
- Split (Date, DY, DM, DD, DS);
- return DD;
- end Day;
-
- -----------
- -- Month --
- -----------
-
- function Month (Date : Time) return Month_Number is
- DY : Year_Number;
- DM : Month_Number;
- DD : Day_Number;
- DS : Day_Duration;
-
- begin
- Split (Date, DY, DM, DD, DS);
- return DM;
- end Month;
-
- -------------
- -- Seconds --
- -------------
-
- function Seconds (Date : Time) return Day_Duration is
- DY : Year_Number;
- DM : Month_Number;
- DD : Day_Number;
- DS : Day_Duration;
-
- begin
- Split (Date, DY, DM, DD, DS);
- return DS;
- end Seconds;
-
- -----------
- -- Split --
- -----------
-
- procedure Split
- (Date : Time;
- Year : out Year_Number;
- Month : out Month_Number;
- Day : out Day_Number;
- Seconds : out Day_Duration)
- is
- -- The following declare bounds for duration that are comfortably
- -- wider than the maximum allowed output result for the Ada range
- -- of representable split values. These are used for a quick check
- -- that the value is not wildly out of range.
-
- Low : constant := (Ada_Year_Min - Unix_Year_Min - 2) * 365 * 86_400;
- High : constant := (Ada_Year_Max - Unix_Year_Min + 2) * 365 * 86_400;
-
- LowD : constant Duration := Duration (Low);
- HighD : constant Duration := Duration (High);
-
- -- The following declare the maximum duration value that can be
- -- successfully converted to a 32-bit integer suitable for passing
- -- to the localtime_r function. Note that we cannot assume that the
- -- localtime_r function expands to accept 64-bit input on a 64-bit
- -- machine, but we can count on a 32-bit range on all machines.
-
- Max_Time : constant := 2 ** 31 - 1;
- Max_TimeD : constant Duration := Duration (Max_Time);
-
- -- Finally the actual variables used in the computation
-
- D : Duration;
- Frac_Sec : Duration;
- Year_Val : Integer;
- Adjusted_Seconds : aliased time_t;
- Tm_Val : aliased tm;
-
- begin
- -- For us a time is simply a signed duration value, so we work with
- -- this duration value directly. Note that it can be negative.
-
- D := Duration (Date);
-
- -- First of all, filter out completely ludicrous values. Remember
- -- that we use the full stored range of duration values, which may
- -- be significantly larger than the allowed range of Ada times. Note
- -- that these checks are wider than required to make absolutely sure
- -- that there are no end effects from time zone differences.
-
- if D < LowD or else D > HighD then
- raise Time_Error;
- end if;
-
- -- The unix localtime_r function is more or less exactly what we need
- -- here. The less comes from the fact that it does not support the
- -- required range of years (the guaranteed range available is only
- -- EPOCH through EPOCH + N seconds). N is in practice 2 ** 31 - 1.
-
- -- If we have a value outside this range, then we first adjust it
- -- to be in the required range by adding multiples of four years.
- -- For the range we are interested in, the number of days in any
- -- consecutive four year period is constant. Then we do the split
- -- on the adjusted value, and readjust the years value accordingly.
-
- Year_Val := 0;
-
- while D < 0.0 loop
- D := D + Seconds_In_4_YearsD;
- Year_Val := Year_Val - 4;
- end loop;
-
- while D > Max_TimeD loop
- D := D - Seconds_In_4_YearsD;
- Year_Val := Year_Val + 4;
- end loop;
-
- -- Now we need to take the value D, which is now non-negative, and
- -- break it down into seconds (to pass to the localtime_r function)
- -- and fractions of seconds (for the adjustment below).
-
- -- Surprisingly there is no easy way to do this in Ada, and certainly
- -- no easy way to do it and generate efficient code. Therefore we
- -- do it at a low level, knowing that it is really represented as
- -- an integer with units of Small
-
- declare
- type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
- for D_Int'Size use Duration'Size;
-
- Small_Div : constant D_Int := D_Int (1.0 / Duration'Small);
- D_As_Int : D_Int;
-
- function To_D_As_Int is new Unchecked_Conversion (Duration, D_Int);
- function To_Duration is new Unchecked_Conversion (D_Int, Duration);
-
- begin
- D_As_Int := To_D_As_Int (D);
- Adjusted_Seconds := time_t (D_As_Int / Small_Div);
- Frac_Sec := To_Duration (D_As_Int rem Small_Div);
- end;
-
- localtime_r (Adjusted_Seconds'Unchecked_Access, Tm_Val'Unchecked_Access);
-
- Year_Val := Tm_Val.tm_year + 1900 + Year_Val;
- Month := Tm_Val.tm_mon + 1;
- Day := Tm_Val.tm_mday;
-
- -- The Seconds value is a little complex. The localtime function
- -- returns the integral number of seconds, which is what we want,
- -- but we want to retain the fractional part from the original
- -- Time value, since this is typically stored more accurately.
-
- Seconds := Duration (Tm_Val.tm_hour * 3600 +
- Tm_Val.tm_min * 60 +
- Tm_Val.tm_sec)
- + Frac_Sec;
-
- -- Note: the above expression is pretty horrible, one of these days
- -- we should stop using time_of and do everything ourselves to avoid
- -- these unnecessary divides and multiplies???.
-
- -- The Year may still be out of range, since our entry test was
- -- deliberately crude. Trying to make this entry test accurate is
- -- tricky due to time zone adjustment issues affecting the exact
- -- boundary. It is interesting to note that whether or not a given
- -- Calendar.Time value gets Time_Error when split depends on the
- -- current time zone setting.
-
- if Year_Val not in Ada_Year_Min .. Ada_Year_Max then
- raise Time_Error;
- else
- Year := Year_Val;
- end if;
- end Split;
-
- -------------
- -- Time_Of --
- -------------
-
- function Time_Of
- (Year : Year_Number;
- Month : Month_Number;
- Day : Day_Number;
- Seconds : Day_Duration := 0.0)
- return Time
- is
- Result_Secs : aliased time_t;
- TM_Val : aliased tm;
- Int_Secs : constant Integer := Integer (Seconds);
-
- Year_Val : Integer := Year;
- Duration_Adjust : Duration := 0.0;
-
- begin
- -- The following checks are redundant with respect to the constraint
- -- error checks that should normally be made on parameters, but we
- -- decide to raise Constraint_Error in any case if bad values come
- -- in (as a result of checks being off in the caller, or for other
- -- erroneous or bounded error cases).
-
- if not Year 'Valid
- or else not Month 'Valid
- or else not Day 'Valid
- or else not Seconds'Valid
- then
- raise Constraint_Error;
- end if;
-
- -- Check for Day value too large (one might expect mktime to do this
- -- check, as well as the basi checks we did with 'Valid, but it seems
- -- that at least on some systems, this built-in check is too weak).
-
- if Day > Days_In_Month (Month)
- and then (Day /= 29 or Month /= 2 or Year mod 4 /= 0)
- then
- raise Time_Error;
- end if;
-
- TM_Val.tm_sec := Int_Secs mod 60;
- TM_Val.tm_min := (Int_Secs / 60) mod 60;
- TM_Val.tm_hour := (Int_Secs / 60) / 60;
- TM_Val.tm_mday := Day;
- TM_Val.tm_mon := Month - 1;
-
- -- For the year, we have to adjust it to a year that Unix can handle.
- -- We do this in four year steps, since the number of days in four
- -- years is constant, so the timezone effect on the conversion from
- -- local time to GMT is unaffected.
-
- while Year_Val <= Unix_Year_Min loop
- Year_Val := Year_Val + 4;
- Duration_Adjust := Duration_Adjust - Seconds_In_4_YearsD;
- end loop;
-
- while Year_Val >= Unix_Year_Max loop
- Year_Val := Year_Val - 4;
- Duration_Adjust := Duration_Adjust + Seconds_In_4_YearsD;
- end loop;
-
- TM_Val.tm_year := Year_Val - 1900;
-
- -- Since we do not have information on daylight savings,
- -- rely on the default information.
-
- TM_Val.tm_isdst := -1;
- Result_Secs := mktime (TM_Val'Unchecked_Access);
-
- -- That gives us the basic value in seconds. Two adjustments are
- -- needed. First we must undo the year adjustment carried out above.
- -- Second we put back the fraction seconds value since in general the
- -- Day_Duration value we received has additional precision which we
- -- do not want to lose in the constructed result.
-
- return
- Time (Duration (Result_Secs) +
- Duration_Adjust +
- (Seconds - Duration (Int_Secs)));
-
- end Time_Of;
-
- ----------
- -- Year --
- ----------
-
- function Year (Date : Time) return Year_Number is
- DY : Year_Number;
- DM : Month_Number;
- DD : Day_Number;
- DS : Day_Duration;
-
- begin
- Split (Date, DY, DM, DD, DS);
- return DY;
- end Year;
-
-end Ada.Calendar;
projects / msp430-gcc.git / blobdiff